Make primutl.o single-threaded.

Most of this module's variables are modified, after initialization, by
declare_primitive_internal or find_primitive_cname.  Serialize the
former and eliminate the hack in the latter.

diff --git a/src/microcode/primutl.c b/src/microcode/primutl.c
index 653c644797e917f950191418bbb056a620c5a54b..6d65047e1a39f5c5012cc0bbf75bb968e3a6293d 100644 (file)
--- a/src/microcode/primutl.c
+++ b/src/microcode/primutl.c
@@ -33,7 +33,6 @@ USA.
  * duration of a single Scheme session.
  */
 
-#include "scheme.h"
 #include "prims.h"
 #include "os.h"
 #include "usrdef.h"
@@ -43,6 +42,13 @@ USA.
 #include "cmpgc.h"
 #include <ctype.h>
 
+#ifdef ENABLE_SMP
+static pthread_mutex_t mutex = MUTEX_INITIALIZER;
+#  ifdef ENABLE_DEBUGGING_TOOLS
+static bool locked_p = false;
+#  endif
+#endif
+
 #ifndef UPDATE_PRIMITIVE_TABLE_HOOK
 #  define UPDATE_PRIMITIVE_TABLE_HOOK(low, high) do { } while (0)
 #endif
@@ -138,6 +144,9 @@ static void
 grow_primitive_tables (void)
 {
   unsigned long new_size = (MAX_PRIMITIVE + (MAX_PRIMITIVE / 10));
+#if defined(ENABLE_SMP) && defined(ENABLE_DEBUGGING_TOOLS)
+  assert (locked_p == true);
+#endif
   COPY_TABLE (Primitive_Arity_Table, Static_Primitive_Arity_Table, int, int);
   COPY_TABLE (Primitive_Count_Table, Static_Primitive_Count_Table, int, int);
   COPY_TABLE (Primitive_Name_Table,
@@ -166,7 +175,14 @@ initialize_primitives (void)
   /* MAX_STATIC_PRIMITIVE is the index of the last primitive */
 
   MAX_PRIMITIVE = (MAX_STATIC_PRIMITIVE + 1);
+#if defined(ENABLE_SMP) && defined(ENABLE_DEBUGGING_TOOLS)
+  /* Avoid annoying the assert. */
+  locked_p = true;
   grow_primitive_tables ();
+  locked_p = false;
+#else
+  grow_primitive_tables ();
+#endif
 
   tree_error_message = ((char *) NULL);
   prim_procedure_tree = (tree_build (MAX_PRIMITIVE, Primitive_Name_Table, 0));
@@ -224,7 +240,10 @@ declare_primitive_internal (bool override_p,
   unsigned long index;
   SCHEME_OBJECT primitive;
   const char * ndocstr = docstr;
-  tree_node prim = (tree_lookup (prim_procedure_tree, name));
+  tree_node prim;
+
+  LOCK();
+  prim = (tree_lookup (prim_procedure_tree, name));
 
   if (prim != ((tree_node) NULL))
   {
@@ -233,7 +252,10 @@ declare_primitive_internal (bool override_p,
     if ((((PRIMITIVE_ARITY (primitive)) != nargs_hi)
         && ((PRIMITIVE_ARITY (primitive)) != UNKNOWN_PRIMITIVE_ARITY))
        || ((IMPLEMENTED_PRIMITIVE_P (primitive)) && (! override_p)))
-      return (LONG_TO_UNSIGNED_FIXNUM (PRIMITIVE_NUMBER (primitive)));
+      {
+       UNLOCK();
+       return (LONG_TO_UNSIGNED_FIXNUM (PRIMITIVE_NUMBER (primitive)));
+      }
     if (docstr == 0)
       ndocstr = (Primitive_Documentation_Table[index]);
   }
@@ -250,6 +272,7 @@ declare_primitive_internal (bool override_p,
     {
       outf_error (tree_error_message, tree_error_noise);
       tree_error_message = ((char *) NULL);
+      UNLOCK();
       return (SHARP_F);
     }
     prim_procedure_tree = prim;
@@ -264,6 +287,7 @@ declare_primitive_internal (bool override_p,
   Primitive_Count_Table[index]         = (nargs_hi * (sizeof (SCHEME_OBJECT)));
   Primitive_Documentation_Table[index] = ndocstr;
   UPDATE_PRIMITIVE_TABLE_HOOK (index, (index + 1));
+  UNLOCK();
   return (primitive);
 }
 \f
@@ -344,13 +368,6 @@ find_primitive_cname (const char * name, bool intern_p, bool allow_p, int arity)
          || (arity == (PRIMITIVE_ARITY (primitive))))
        return (primitive);
 
-      if ((PRIMITIVE_ARITY (primitive)) == UNKNOWN_PRIMITIVE_ARITY)
-       {
-         /* We've just learned the arity of the primitive. */
-         (Primitive_Arity_Table[PRIMITIVE_NUMBER (primitive)]) = arity;
-         return (primitive);
-       }
-
       /* Arity mismatch, notify the runtime system. */
       return (LONG_TO_FIXNUM (PRIMITIVE_ARITY (primitive)));
     }