Adjusted thread checking to use __func__; added more checks (from

Winston Chang via Kevin Ushey).


git-svn-id: https://svn.r-project.org/R/trunk@75618 00db46b3-68df-0310-9c12-caf00c1e9a41

src/include/Rinlinedfuns.h

@@ -462,6 +462,7 @@ extern SEXP* R_PPStack;
 
 INLINE_FUN SEXP protect(SEXP s)
 {
+    R_CHECK_THREAD;
     if (R_PPStackTop < R_PPStackSize)
 	R_PPStack[R_PPStackTop++] = s;
     else R_signal_protect_error();
@@ -470,6 +471,7 @@ INLINE_FUN SEXP protect(SEXP s)
 
 INLINE_FUN void unprotect(int l)
 {
+    R_CHECK_THREAD;
 #ifdef PROTECT_PARANOID
     if (R_PPStackTop >=  l)
 	R_PPStackTop -= l;
@@ -487,6 +489,7 @@ INLINE_FUN void R_ProtectWithIndex(SEXP s, PROTECT_INDEX *pi)
 
 INLINE_FUN void R_Reprotect(SEXP s, PROTECT_INDEX i)
 {
+    R_CHECK_THREAD;
     if (i >= R_PPStackTop || i < 0)
 	R_signal_reprotect_error(i);
     R_PPStack[i] = s;

src/include/Rinternals.h

@@ -749,9 +749,9 @@ SEXP R_tryUnwrap(SEXP);
 #endif
 #ifdef THREADCHECK
 void R_check_thread(const char *s);
-# define R_CHECK_THREAD(s) R_check_thread(s)
+# define R_CHECK_THREAD R_check_thread(__func__)
 #else
-# define R_CHECK_THREAD(x) do {} while (0)
+# define R_CHECK_THREAD do {} while (0)
 #endif
 
 /* List Access Functions */

src/main/altrep.c

@@ -333,7 +333,7 @@ static R_INLINE void *ALTVEC_DATAPTR_EX(SEXP x, Rboolean writeable)
     /**** move GC disabling into methods? */
     if (R_in_gc)
 	error("cannot get ALTVEC DATAPTR during GC");
-    R_CHECK_THREAD("ALTVEC_DATAPTR_EX");
+    R_CHECK_THREAD;
     int enabled = R_GCEnabled;
     R_GCEnabled = FALSE;
 
@@ -494,7 +494,7 @@ SEXP /*attribute_hidden*/ ALTSTRING_ELT(SEXP x, R_xlen_t i)
     /**** move GC disabling into method? */
     if (R_in_gc)
 	error("cannot get ALTSTRING_ELT during GC");
-    R_CHECK_THREAD("ALTSTRING_ELT");
+    R_CHECK_THREAD;
     int enabled = R_GCEnabled;
     R_GCEnabled = FALSE;
 
@@ -509,7 +509,7 @@ void attribute_hidden ALTSTRING_SET_ELT(SEXP x, R_xlen_t i, SEXP v)
     /**** move GC disabling into method? */
     if (R_in_gc)
 	error("cannot set ALTSTRING_ELT during GC");
-    R_CHECK_THREAD("ALTSTRING_SET_ELT");
+    R_CHECK_THREAD;
     int enabled = R_GCEnabled;
     R_GCEnabled = FALSE;
 

src/main/errors.c

@@ -2041,7 +2041,7 @@ R_BadValueInRCode(SEXP value, SEXP call, SEXP rho, const char *rawmsg,
 {
     /* disable GC so that use of this temporary checking code does not
        introduce new PROTECT errors e.g. in asLogical() use */
-    R_CHECK_THREAD("R_BadValueInRCode");
+    R_CHECK_THREAD;
     int enabled = R_GCEnabled;
     R_GCEnabled = FALSE;
     int nprotect = 0;

src/main/memory.c

@@ -1440,6 +1440,7 @@ void R_RunWeakRefFinalizer(SEXP w)
 
 static Rboolean RunFinalizers(void)
 {
+    R_CHECK_THREAD;
     /* Prevent this function from running again when already in
        progress. Jumps can only occur inside the top level context
        where they will be caught, so the flag is guaranteed to be
@@ -3058,7 +3059,7 @@ void attribute_hidden R_check_thread(const char *s) {}
 
 static void R_gc_internal(R_size_t size_needed)
 {
-    R_CHECK_THREAD("R_gc_internal");
+    R_CHECK_THREAD;
     if (!R_GCEnabled) {
       if (NO_FREE_NODES())
 	R_NSize = R_NodesInUse + 1;
@@ -3263,6 +3264,7 @@ void NORET R_signal_unprotect_error(void)
 #ifndef INLINE_PROTECT
 SEXP protect(SEXP s)
 {
+    R_CHECK_THREAD;
     if (R_PPStackTop >= R_PPStackSize)
 	R_signal_protect_error();
     R_PPStack[R_PPStackTop++] = CHK(s);
@@ -3274,6 +3276,7 @@ SEXP protect(SEXP s)
 
 void unprotect(int l)
 {
+    R_CHECK_THREAD;
     if (R_PPStackTop >=  l)
 	R_PPStackTop -= l;
     else R_signal_unprotect_error();
@@ -3284,6 +3287,7 @@ void unprotect(int l)
 
 void unprotect_ptr(SEXP s)
 {
+    R_CHECK_THREAD;
     int i = R_PPStackTop;
 
     /* go look for  s  in  R_PPStack */
@@ -3305,6 +3309,7 @@ void unprotect_ptr(SEXP s)
 
 int Rf_isProtected(SEXP s)
 {
+    R_CHECK_THREAD;
     int i = R_PPStackTop;
 
     /* go look for  s  in  R_PPStack */
@@ -3337,6 +3342,7 @@ void NORET R_signal_reprotect_error(PROTECT_INDEX i)
 #ifndef INLINE_PROTECT
 void R_Reprotect(SEXP s, PROTECT_INDEX i)
 {
+    R_CHECK_THREAD;
     if (i >= R_PPStackTop || i < 0)
 	R_signal_reprotect_error(i);
     R_PPStack[i] = s;
@@ -3349,6 +3355,7 @@ void R_Reprotect(SEXP s, PROTECT_INDEX i)
    to old. */
 SEXP R_CollectFromIndex(PROTECT_INDEX i)
 {
+    R_CHECK_THREAD;
     SEXP res;
     int top = R_PPStackTop, j = 0;
     if (i > top) i = top;
@@ -3411,6 +3418,7 @@ void R_chk_free(void *ptr)
 
 void R_PreserveObject(SEXP object)
 {
+    R_CHECK_THREAD;
     R_PreciousList = CONS(object, R_PreciousList);
 }
 
@@ -3427,6 +3435,7 @@ static SEXP RecursiveRelease(SEXP object, SEXP list)
 
 void R_ReleaseObject(SEXP object)
 {
+    R_CHECK_THREAD;
     R_PreciousList =  RecursiveRelease(object, R_PreciousList);
 }