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
{
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));
+ }
}
}
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
{
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);
}
}
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));
}