From ac5ae4bbdd7b1275eb5029fad85eda43b0ac9766 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sun, 19 Jul 2015 11:40:19 -0700 Subject: [PATCH] Make intern.o state single-threaded. Serialize operations on the obarray using a pthread mutex. Drop the mutex while consing the symbol's entry. --- src/microcode/intern.c | 120 ++++++++++++++++++++++++++++++++--------- 1 file changed, 95 insertions(+), 25 deletions(-) diff --git a/src/microcode/intern.c b/src/microcode/intern.c index a4808a035..37ee37343 100644 --- a/src/microcode/intern.c +++ b/src/microcode/intern.c @@ -26,9 +26,15 @@ USA. /* String hash functions and interning of symbols. */ -#include "scheme.h" #include "prims.h" #include "trap.h" + +#ifdef ENABLE_SMP +static pthread_mutex_t mutex = MUTEX_INITIALIZER; +# ifdef ENABLE_DEBUGGING_TOOLS +static bool locked_p = false; +# endif +#endif /* The FNV hash, short for Fowler/Noll/Vo in honor of its creators. */ @@ -123,17 +129,21 @@ replace_symbol_bucket_type (SCHEME_OBJECT symbol, unsigned int type) void strengthen_symbol (SCHEME_OBJECT symbol) { + LOCK(); replace_symbol_bucket_type (symbol, TC_LIST); + UNLOCK(); } void weaken_symbol (SCHEME_OBJECT symbol) { + LOCK(); replace_symbol_bucket_type (symbol, TC_WEAK_CONS); + UNLOCK(); } static SCHEME_OBJECT -make_symbol (SCHEME_OBJECT string, SCHEME_OBJECT * cell) +make_symbol_entry (SCHEME_OBJECT string) { Primitive_GC_If_Needed (4); { @@ -141,26 +151,47 @@ make_symbol (SCHEME_OBJECT string, SCHEME_OBJECT * cell) Free += 2; MEMORY_SET (symbol, SYMBOL_NAME, string); MEMORY_SET (symbol, SYMBOL_GLOBAL_VALUE, UNBOUND_OBJECT); - (*cell) = (system_pair_cons (TC_WEAK_CONS, symbol, EMPTY_LIST)); - return (symbol); + return (system_pair_cons (TC_WEAK_CONS, symbol, EMPTY_LIST)); } } SCHEME_OBJECT find_symbol (unsigned long length, const char * string) { - SCHEME_OBJECT * cell = (find_symbol_internal (length, string)); - return ((INTERNED_SYMBOL_P (*cell)) ? (*cell) : SHARP_F); + SCHEME_OBJECT * cell, result; + LOCK(); + cell = (find_symbol_internal (length, string)); + result = ((INTERNED_SYMBOL_P (*cell)) ? (*cell) : SHARP_F); + UNLOCK(); + return (result); } SCHEME_OBJECT memory_to_symbol (unsigned long length, const void * string) { - SCHEME_OBJECT * cell = (find_symbol_internal (length, string)); - return - ((INTERNED_SYMBOL_P (*cell)) - ? (*cell) - : (make_symbol ((memory_to_string (length, string)), cell))); + SCHEME_OBJECT * cell, result; + LOCK(); + cell = (find_symbol_internal (length, string)); + if (INTERNED_SYMBOL_P (*cell)) + result = (*cell); + else + { + SCHEME_OBJECT entry; + UNLOCK(); + /* May abort for GC. */ + entry = (make_symbol_entry (memory_to_string (length, string))); + LOCK(); + cell = (find_symbol_internal (length, string)); + if (INTERNED_SYMBOL_P (*cell)) + result = (*cell); + else + { + (*cell) = entry; + result = PAIR_CAR (entry); + } + } + UNLOCK(); + return (result); } SCHEME_OBJECT @@ -172,29 +203,60 @@ char_pointer_to_symbol (const char * string) SCHEME_OBJECT string_to_symbol (SCHEME_OBJECT string) { - SCHEME_OBJECT * cell - = (find_symbol_internal ((STRING_LENGTH (string)), - (STRING_POINTER (string)))); - return ((INTERNED_SYMBOL_P (*cell)) - ? (*cell) - : (make_symbol (string, cell))); + unsigned long length = (STRING_LENGTH (string)); + const char * chars = (STRING_POINTER (string)); + SCHEME_OBJECT * cell, result; + LOCK(); + cell = (find_symbol_internal (length, chars)); + if (INTERNED_SYMBOL_P (*cell)) + result = (*cell); + else + { + SCHEME_OBJECT entry; + UNLOCK(); + /* May abort for GC. */ + entry = (make_symbol_entry (string)); + LOCK(); + cell = (find_symbol_internal (length, chars)); + if (INTERNED_SYMBOL_P (*cell)) + result = (*cell); + else + { + (*cell) = entry; + result = PAIR_CAR (entry); + } + } + UNLOCK(); + return (result); } SCHEME_OBJECT intern_symbol (SCHEME_OBJECT symbol) { - SCHEME_OBJECT name = (MEMORY_REF (symbol, SYMBOL_NAME)); - SCHEME_OBJECT * cell - = (find_symbol_internal ((STRING_LENGTH (name)), - (STRING_POINTER (name)))); + SCHEME_OBJECT string = (MEMORY_REF (symbol, SYMBOL_NAME)); + unsigned long length = (STRING_LENGTH (string)); + const char * chars = (STRING_POINTER (string)); + SCHEME_OBJECT * cell, result; + LOCK(); + cell = (find_symbol_internal (length, chars)); if (INTERNED_SYMBOL_P (*cell)) - return (*cell); + result = (*cell); else { - SCHEME_OBJECT result = (OBJECT_NEW_TYPE (TC_INTERNED_SYMBOL, symbol)); - (*cell) = (system_pair_cons (TC_WEAK_CONS, result, EMPTY_LIST)); - return (result); + SCHEME_OBJECT entry; + UNLOCK(); + /* May abort for GC. */ + result = (OBJECT_NEW_TYPE (TC_INTERNED_SYMBOL, symbol)); + entry = (system_pair_cons (TC_WEAK_CONS, result, EMPTY_LIST)); + LOCK(); + cell = (find_symbol_internal (length, chars)); + if (INTERNED_SYMBOL_P (*cell)) + result = (*cell); + else + (*cell) = entry; } + UNLOCK(); + return (result); } const char * @@ -272,5 +334,13 @@ When LOCK? is #F/non-#F, unlock/lock the pthread mutex serializing\n\ access to the obarray. Value is #T unless there was an error.") { PRIMITIVE_HEADER (1); + { +#ifdef ENABLE_SMP + if (ARG_REF (1) != SHARP_F) + LOCK(); + else + UNLOCK(); +#endif + } PRIMITIVE_RETURN (SHARP_T); } -- 2.25.1