From f85e38e0e49e3c9cda31546fa4af9e72c71c94cc Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Tue, 18 Nov 1997 16:56:02 +0000
Subject: [PATCH] Implement a pseudo-atomic macro for the x86 backend.

---
 code/lispinit.lisp       |  4 +++-
 compiler/x86/macros.lisp | 27 ++++++++++++++++++++++++++-
 compiler/x86/parms.lisp  |  8 ++++----
 lisp/lisp.c              | 14 ++++++++++----
 lisp/x86-arch.c          | 13 +++----------
 5 files changed, 46 insertions(+), 20 deletions(-)

diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index 72fa50820..3b12b6c1e 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.51 1997/11/04 09:10:45 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.52 1997/11/18 16:55:57 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -47,6 +47,8 @@
   (special *gc-inhibit* *already-maybe-gcing*
 	   *need-to-collect-garbage* *gc-verbose*
 	   *before-gc-hooks* *after-gc-hooks*
+	   #+x86 *pseudo-atomic-atomic*
+	   #+x86 *pseudo-atomic-interrupted*
 	   unix::*interrupts-enabled*
 	   unix::*interrupt-pending*
 	   *type-system-initialized*)
diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp
index c0a957eec..8e51db630 100644
--- a/compiler/x86/macros.lisp
+++ b/compiler/x86/macros.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.6 1997/11/05 14:59:58 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.7 1997/11/18 16:55:52 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -279,6 +279,31 @@
        ,error)))
 
 
+
+;;;; PSEUDO-ATOMIC.
+
+;;; PSEUDO-ATOMIC -- Internal Interface.
+;;;
+(defmacro pseudo-atomic (&rest forms)
+  (let ((label (gensym "LABEL-")))
+    `(let ((,label (gen-label)))
+      (store-symbol-value 0 lisp::*pseudo-atomic-interrupted*)
+      ;; Note: we just use cfp as some not-zero value.
+      (store-symbol-value ebp-tn lisp::*pseudo-atomic-atomic*)
+      ,@forms
+      (store-symbol-value 0 lisp::*pseudo-atomic-atomic*)
+      (inst cmp (make-ea :dword
+		 :disp (+ nil-value
+			  (static-symbol-offset
+			   'lisp::*pseudo-atomic-interrupted*)
+			  (ash symbol-value-slot word-shift)
+			  (- other-pointer-type)))
+       0)
+      (inst jmp :eq ,label)
+      (inst int 3)
+      (inst byte pending-interrupt-trap)
+      (emit-label ,label))))
+
 
 ;;;; Indexed references:
 
diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 18f8ee51b..dfc53a5da 100644
--- a/compiler/x86/parms.lisp
+++ b/compiler/x86/parms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.8 1997/11/04 09:11:13 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.9 1997/11/18 16:55:53 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -243,9 +243,11 @@
       *alien-stack*
 
       ;; Interrupt Handling
-      lisp::*free-interrupt-context-index*
+      lisp::*pseudo-atomic-atomic*
+      lisp::*pseudo-atomic-interrupted*
       unix::*interrupts-enabled*
       unix::*interrupt-pending*
+      lisp::*free-interrupt-context-index*
 
       *allocation-pointer*
       *binding-stack-pointer*
@@ -264,8 +266,6 @@
       *control-stacks*
 
       ;; Spare symbols
-      spare-13
-      spare-12
       spare-11
       spare-10
       spare-9
diff --git a/lisp/lisp.c b/lisp/lisp.c
index a910102dc..8baf1a68b 100644
--- a/lisp/lisp.c
+++ b/lisp/lisp.c
@@ -1,7 +1,7 @@
 /*
  * main() entry point for a stand alone lisp image.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.11 1997/01/21 00:28:13 ram Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.12 1997/11/18 16:56:01 dtc Exp $
  *
  */
 
@@ -184,7 +184,7 @@ void main(int argc, char *argv[], char *envp[])
     SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
 #endif
 #if defined INTERNAL_GC_TRIGGER && !defined i386
-    SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1));
+    SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1));
 #endif
 
     interrupt_init();
@@ -197,9 +197,15 @@ void main(int argc, char *argv[], char *envp[])
     SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
 
 #ifdef PSEUDO_ATOMIC_ATOMIC
+#ifdef i386
     /* Turn on pseudo atomic for when we call into lisp. */
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, fixnum(1));
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, fixnum(0));
+    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
+#else
+    /* Turn on pseudo atomic for when we call into lisp. */
+    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
+#endif
 #endif
 
     /* Pick off sigint until the lisp system gets far enough along to */
diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c
index 7951e7964..51933427e 100644
--- a/lisp/x86-arch.c
+++ b/lisp/x86-arch.c
@@ -110,22 +110,15 @@ arch_internal_error_arguments(struct sigcontext *context)
 boolean 
 arch_pseudo_atomic_atomic(struct sigcontext *context)
 {
-#ifdef fixme
-  return (context->sc_regs[reg_ALLOC] & 1);
-#else
-  return 0;
-#endif
+  return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
 }
 
-#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
-
 void 
 arch_set_pseudo_atomic_interrupted(struct sigcontext *context)
 {
-#ifdef fixme
-  context->sc_regs[reg_ALLOC] |= 2;
-#endif
+  SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
 }
+
 
 /* This stuff seems to get called for TRACE and debug activity */
 unsigned long 
-- 
GitLab