From f83e27370c827773722739fdf764cb231bd9d330 Mon Sep 17 00:00:00 2001
From: Mikael Djurfeldt <djurfeldt@nada.kth.se>
Date: Sun, 19 Apr 1998 20:16:36 +0000
Subject: [PATCH] * continuations.c (scm_make_cont), debug.c
 (scm_make_memoized, scm_make_debugobj), eval.c (scm_makprom):
 SCM_DEFER/ALLOW_INTS --> A section.

* __scm.h: Start the long-term project of moving to POSIX threads.
Phase 1: Classification of all critical sections.
(SCM_ENTER_A_SECTION, SCM_EXIT_A_SECTION): New macros: Delimiters
for A sections.  (See comments in __scm.h for details.)
---
 libguile/__scm.h         | 38 ++++++++++++++++++++++++++++++++++++++
 libguile/continuations.c | 12 ++++++------
 libguile/debug.c         | 14 +++++++-------
 libguile/eval.c          |  4 ++--
 4 files changed, 53 insertions(+), 15 deletions(-)

diff --git a/libguile/__scm.h b/libguile/__scm.h
index a3e867d88..2e78fca73 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -359,6 +359,44 @@ extern unsigned int scm_async_clock;
 
 
 
+/* Classification of critical sections
+ *
+ * When Guile moves to POSIX threads, it won't be possible to prevent
+ * context switching.  In fact, the whole idea of context switching is
+ * bogus if threads are run by different processors.  Therefore, we
+ * must ultimately eliminate all critical sections or enforce them by
+ * use of mutecis.
+ *
+ * All instances of SCM_DEFER_INTS and SCM_ALLOW_INTS should therefore
+ * be classified and replaced by one of the delimiters below.  If you
+ * understand what this is all about, I'd like to encourage you to
+ * help with this task.  The set of classes below must of course be
+ * incrementally augmented.
+ *
+ * MDJ 980419 <djurfeldt@nada.kth.se>
+ */
+
+/* A sections
+ *
+ * Allocation of a cell with type tag in the CAR.
+ *
+ * With POSIX threads, each thread will have a private pool of free
+ * cells.  Therefore, this type of section can be removed.  But!  It
+ * is important that the CDR is initialized first (with the CAR still
+ * indicating a free cell) so that we can guarantee a consistent heap
+ * at all times.
+ */
+
+#ifdef SCM_POSIX_THREADS
+#define SCM_ENTER_A_SECTION
+#define SCM_EXIT_A_SECTION
+#else
+#define SCM_ENTER_A_SECTION SCM_DEFER_INTS
+#define SCM_EXIT_A_SECTION SCM_ALLOW_INTS
+#endif
+
+
+
 /** SCM_ASSERT
  ** 
  **/
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 846f68fdd..853a5589c 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -67,14 +67,14 @@ scm_make_cont (answer)
 #ifdef CHEAP_CONTINUATIONS
   SCM_NEWCELL (cont);
   *answer = cont;
-  SCM_DEFER_INTS;
+  SCM_ENTER_A_SECTION;
   SCM_SETJMPBUF (cont, scm_must_malloc ((long) sizeof (scm_contregs), s_cont));
-  SCM_SETCAR (cont, scm_tc7_contin);
   SCM_DYNENV (cont) = scm_dynwinds;
   SCM_THROW_VALUE = SCM_EOL;
   SCM_BASE (cont) = SCM_BASE (rootcont);
   SCM_SEQ (cont) = SCM_SEQ (rootcont);
-  SCM_ALLOW_INTS;
+  SCM_SETCAR (cont, scm_tc7_contin);
+  SCM_EXIT_A_SECTION;
 #else
   register SCM_STACKITEM *src, *dst;
 
@@ -94,18 +94,18 @@ scm_make_cont (answer)
 
   SCM_NEWCELL (cont);
   *answer = cont;
-  SCM_DEFER_INTS;
+  SCM_ENTER_A_SECTION;
   SCM_FLUSH_REGISTER_WINDOWS;
   j = scm_stack_size (SCM_BASE (scm_rootcont));
   SCM_SETJMPBUF (cont,
 	     scm_must_malloc ((long) (sizeof (scm_contregs) + j * sizeof (SCM_STACKITEM)),
 			      s_cont));
-  SCM_SETLENGTH (cont, j, scm_tc7_contin);
   SCM_DYNENV (cont) = scm_dynwinds;
   SCM_THROW_VALUE (cont) = SCM_EOL;
   src = SCM_BASE (cont) = SCM_BASE (scm_rootcont);
   SCM_SEQ (cont) = SCM_SEQ (scm_rootcont);
-  SCM_ALLOW_INTS;
+  SCM_SETLENGTH (cont, j, scm_tc7_contin);
+  SCM_EXIT_A_SECTION;
 #ifndef SCM_STACK_GROWS_UP
   src -= SCM_LENGTH (cont);
 #endif /* ndef SCM_STACK_GROWS_UP */
diff --git a/libguile/debug.c b/libguile/debug.c
index a2d148587..4c95a8a92 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -154,14 +154,14 @@ scm_make_memoized (exp, env)
 {
   /* *fixme* Check that env is a valid environment. */
   register SCM z, ans;
-  SCM_DEFER_INTS;
+  SCM_ENTER_A_SECTION;
   SCM_NEWCELL (z);
-  SCM_SETCAR (z, exp);
   SCM_SETCDR (z, env);
+  SCM_SETCAR (z, exp);
   SCM_NEWCELL (ans);
-  SCM_SETCAR (ans, scm_tc16_memoized);
   SCM_SETCDR (ans, z);
-  SCM_ALLOW_INTS;
+  SCM_SETCAR (ans, scm_tc16_memoized);
+  SCM_EXIT_A_SECTION;
   return ans;
 }
 
@@ -570,11 +570,11 @@ scm_make_debugobj (frame)
      scm_debug_frame *frame;
 {
   register SCM z;
-  SCM_DEFER_INTS;
   SCM_NEWCELL (z);
-  SCM_SETCAR (z, scm_tc16_debugobj);
+  SCM_ENTER_A_SECTION;
   SCM_SET_DEBUGOBJ_FRAME (z, (SCM) frame);
-  SCM_ALLOW_INTS;
+  SCM_SETCAR (z, scm_tc16_debugobj);
+  SCM_EXIT_A_SECTION;
   return z;
 }
 
diff --git a/libguile/eval.c b/libguile/eval.c
index d1848a528..403f54cc3 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3128,10 +3128,10 @@ scm_makprom (code)
 {
   register SCM z;
   SCM_NEWCELL (z);
-  SCM_DEFER_INTS;
+  SCM_ENTER_A_SECTION;
   SCM_SETCDR (z, code);
   SCM_SETCAR (z, scm_tc16_promise);
-  SCM_ALLOW_INTS;
+  SCM_EXIT_A_SECTION;
   return z;
 }