From e7e30384e15af838e05d07b47849f70de8f73cc2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 31 Mar 2010 10:59:49 +0000
Subject: [PATCH] per-regstry lock for lazy module instantiation (fixes
 DrScheme start-up problems); adjust configure for better pthread flags; merge
 to 4.2.5

svn: r18688
---
 src/configure             | 30 +++++++++++++-----------------
 src/mzscheme/configure.ac | 24 ++++++++++++------------
 src/mzscheme/src/module.c | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 29 deletions(-)

diff --git a/src/configure b/src/configure
index 9a2e8798ae..40e6229ce0 100755
--- a/src/configure
+++ b/src/configure
@@ -5839,8 +5839,9 @@ case $OS in
     EXTRALIBS="-Wl,-brtl,-bE:\$(srcdir)/../mzscheme/include/mzscheme.exp"
     ;;
   FreeBSD)
-    LIBS="$LIBS -rdynamic -pthread"
+    LIBS="$LIBS -rdynamic"
     DYN_CFLAGS="-fPIC"
+    enable_pthread=yes
     ;;
   OpenBSD)
     LIBS="$LIBS -rdynamic -Wl,--export-dynamic"
@@ -10712,18 +10713,6 @@ if test "${enable_gl}" = "yes" ; then
   MROPTIONS="$MROPTIONS -DUSE_GL"
 fi
 
-############### pthread ###################
-
-if test "${enable_pthread}" = "yes" ; then
-  PREFLAGS="$PREFLAGS -D_THREAD_SAFE"
-  X_EXTRA_LIBS="$X_EXTRA_LIBS -pthread"
-
-cat >>confdefs.h <<\_ACEOF
-#define USE_PTHREAD_INSTEAD_OF_ITIMER 1
-_ACEOF
-
-fi
-
 ############### places ###################
 
 if test "${enable_places}" = "yes" ; then
@@ -10732,7 +10721,6 @@ cat >>confdefs.h <<\_ACEOF
 #define MZ_USE_PLACES 1
 _ACEOF
 
-  LDFLAGS="$LDFLAGS -pthread"
   enable_mzrt=yes
 fi
 
@@ -10756,14 +10744,22 @@ fi
 ############### OS threads ###################
 
 if test "${enable_mzrt}" = "yes" ; then
+  MZRT_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
+  LIBATOM="LIBATOM_USE"
+  enable_pthread=yes
+fi
+
+############### pthread ###################
+
+if test "${enable_pthread}" = "yes" ; then
+  # FIXME: the following two flags are GCC-specific:
+  PREFLAGS="$PREFLAGS -pthread"
+  LDFLAGS="$LDFLAGS -pthread"
 
 cat >>confdefs.h <<\_ACEOF
 #define USE_PTHREAD_INSTEAD_OF_ITIMER 1
 _ACEOF
 
-  LDFLAGS="$LDFLAGS -pthread"
-  MZRT_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
-  LIBATOM="LIBATOM_USE"
 fi
 
 ################ Xrender ##################
diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac
index 354e16487f..bf8c72adcf 100644
--- a/src/mzscheme/configure.ac
+++ b/src/mzscheme/configure.ac
@@ -549,8 +549,9 @@ case $OS in
     EXTRALIBS="-Wl,-brtl,-bE:\$(srcdir)/../mzscheme/include/mzscheme.exp"
     ;;
   FreeBSD)
-    LIBS="$LIBS -rdynamic -pthread"
+    LIBS="$LIBS -rdynamic"
     DYN_CFLAGS="-fPIC"
+    enable_pthread=yes
     ;;
   OpenBSD)
     LIBS="$LIBS -rdynamic -Wl,--export-dynamic"
@@ -1142,19 +1143,10 @@ if test "${enable_gl}" = "yes" ; then
   MROPTIONS="$MROPTIONS -DUSE_GL"
 fi
 
-############### pthread ###################
-
-if test "${enable_pthread}" = "yes" ; then
-  PREFLAGS="$PREFLAGS -D_THREAD_SAFE"
-  X_EXTRA_LIBS="$X_EXTRA_LIBS -pthread"
-  AC_DEFINE(USE_PTHREAD_INSTEAD_OF_ITIMER, 1, [Pthread timer enabled])
-fi
-
 ############### places ###################
 
 if test "${enable_places}" = "yes" ; then
   AC_DEFINE(MZ_USE_PLACES,1,[Places enabled])
-  LDFLAGS="$LDFLAGS -pthread"
   enable_mzrt=yes
 fi
 
@@ -1174,10 +1166,18 @@ fi
 ############### OS threads ###################
 
 if test "${enable_mzrt}" = "yes" ; then
-  AC_DEFINE(USE_PTHREAD_INSTEAD_OF_ITIMER, 1, [Pthread timer enabled])
-  LDFLAGS="$LDFLAGS -pthread"
   MZRT_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC"
   LIBATOM="LIBATOM_USE"
+  enable_pthread=yes
+fi
+
+############### pthread ###################
+
+if test "${enable_pthread}" = "yes" ; then
+  # FIXME: the following two flags are GCC-specific:
+  PREFLAGS="$PREFLAGS -pthread"
+  LDFLAGS="$LDFLAGS -pthread"
+  AC_DEFINE(USE_PTHREAD_INSTEAD_OF_ITIMER, 1, [Pthread timer enabled])
 fi
 
 ################ Xrender ##################
diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c
index 624e6a94df..dc24280353 100644
--- a/src/mzscheme/src/module.c
+++ b/src/mzscheme/src/module.c
@@ -3748,6 +3748,37 @@ void scheme_module_force_lazy(Scheme_Env *env, int previous)
   /* not anymore */
 }
 
+static void wait_registry(Scheme_Env *env)
+{
+  Scheme_Object *lock, *a[1];
+
+  while (1) {
+    lock = scheme_hash_get(env->module_registry, scheme_false);
+    if (!lock)
+      return;
+
+    a[0] = SCHEME_CAR(lock);
+    a[1] = SCHEME_CDR(lock);
+    (void)scheme_sync(1, a);
+  }
+}
+
+static void lock_registry(Scheme_Env *env)
+{
+  Scheme_Object *lock;
+  lock = scheme_make_pair(scheme_make_sema(0),
+                          scheme_current_thread);
+  scheme_hash_set(env->module_registry, scheme_false, lock);
+}
+
+static void unlock_registry(Scheme_Env *env)
+{
+  Scheme_Object *lock;
+  lock = scheme_hash_get(env->module_registry, scheme_false);
+  scheme_post_sema(SCHEME_CAR(lock));
+  scheme_hash_set(env->module_registry, scheme_false, NULL);
+}
+
 XFORM_NONGCING static long make_key(int base_phase, int eval_exp, int eval_run)
 {
   return ((base_phase << 3) 
@@ -4364,6 +4395,8 @@ static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
   Scheme_Object *v, *prev;
   Scheme_Env *menv;
 
+  wait_registry(env);
+
   v = MODCHAIN_AVAIL(env->modchain, pos);
   if (!SCHEME_FALSEP(v)) {
     MODCHAIN_AVAIL(env->modchain, pos) = scheme_false;
@@ -4380,6 +4413,8 @@ static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
     }
     v = prev;
 
+    lock_registry(env);
+
     while (SCHEME_NAMESPACEP(v)) {
       menv = (Scheme_Env *)v;
       v = menv->available_next[pos];
@@ -4388,6 +4423,8 @@ static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
                    NULL, 1, 0, base_phase,
                    scheme_null);
     }
+
+    unlock_registry(env);
   }
 }