smp: share: string.o
authorMatt Birkholz <puck@birchwood-abbey.net>
Sat, 6 Dec 2014 00:34:10 +0000 (17:34 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Sun, 21 Dec 2014 19:19:10 +0000 (12:19 -0700)
README.txt
src/microcode/string.c

index 842de1e32eee4247e1ccf231c93125e8cc9a70a8..7977e37a3051036867eec77f25fddfcc38452f99 100644 (file)
@@ -542,7 +542,10 @@ command line.  The remaining 12 belong to the 7 microcode modules and
        Prim_primitive_purify.
 
   string.o:
-  00000000 b external_strings
+  00000000 b external_strings          locked
+
+       OK.  Serialized arg_extended_string and the primitives that
+       do not use it.
 
   syntax.o:
   00000080 D syntax_code_spec
index 33d6ed45ad79eec8687ea08fe41cb48170dc5ea2..eaed42ae37ab38a37a9cc3281a522b988db50154 100644 (file)
@@ -509,6 +509,13 @@ DEFINE_PRIMITIVE ("SUBSTRING-MATCH-BACKWARD-CI", Prim_match_backward_ci, 6, 6, 0
    registered in a hash table when it is allocated so that we can
    validate the incoming integers.  */
 
+#ifdef ENABLE_SMP
+static pthread_mutex_t mutex = MUTEX_INITIALIZER;
+#  ifdef ENABLE_DEBUGGING_TOOLS
+static bool locked_p = false;
+#  endif
+#endif
+
 typedef struct ht_record_s ht_record_t;
 struct ht_record_s
 {
@@ -553,12 +560,18 @@ DEFINE_PRIMITIVE ("ALLOCATE-EXTERNAL-STRING", Prim_alloc_external_string, 1, 1,
     ht_record_t * result = (malloc (n_bytes + 1 + (sizeof (ht_record_t))));
     if (result == 0)
       error_bad_range_arg (1);
-    if (external_strings == 0)
-      external_strings = (make_hash_table ());
     (HT_RECORD_N_BYTES (result)) = n_bytes;
     /* Guarantee zero termination in case used as C string.  */
     (((char *) (HT_RECORD_PTR (result))) [n_bytes]) = '\0';
-    PRIMITIVE_RETURN (ulong_to_integer (ht_insert (external_strings, result)));
+    {
+      ulong val;
+      LOCK();
+      if (external_strings == 0)
+       external_strings = (make_hash_table ());
+      val = ht_insert (external_strings, result);
+      UNLOCK();
+      PRIMITIVE_RETURN (ulong_to_integer (val));
+    }
   }
 }
 
@@ -570,9 +583,11 @@ DEFINE_PRIMITIVE ("EXTERNAL-STRING?", Prim_external_string_p, 1, 1, 0)
     if ((INTEGER_P (x)) && (integer_to_ulong_p (x)))
       {
        ht_record_t * record;
+       LOCK();
        if (external_strings == 0)
          external_strings = (make_hash_table ());
        record = (ht_lookup (external_strings, (integer_to_ulong (x))));
+       UNLOCK();
        PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (record != 0));
       }
     else
@@ -586,12 +601,17 @@ DEFINE_PRIMITIVE ("DEALLOCATE-EXTERNAL-STRING", Prim_dealloc_external_string, 1,
   {
     unsigned long n = (arg_ulong_integer (1));
     ht_record_t * record;
+    LOCK();
     if (external_strings == 0)
       external_strings = (make_hash_table ());
     record = (ht_delete (external_strings, n));
     if (record == 0)
-      error_wrong_type_arg (1);
+      {
+       UNLOCK();
+       error_wrong_type_arg (1);
+      }
     free (record);
+    UNLOCK();
     PRIMITIVE_RETURN (UNSPECIFIC);
   }
 }
@@ -610,13 +630,18 @@ unsigned char *
 lookup_external_string (SCHEME_OBJECT descriptor, unsigned long * lp)
 {
   ht_record_t * record;
+  LOCK();
   if (external_strings == 0)
     external_strings = (make_hash_table ());
   record = (ht_lookup (external_strings, (integer_to_ulong (descriptor))));
   if (record == 0)
-    return (0);
+    {
+      UNLOCK();
+      return (0);
+    }
   if (lp != 0)
     (*lp) = (HT_RECORD_N_BYTES (record));
+  UNLOCK();
   return (HT_RECORD_PTR (record));
 }