X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=d960a9fb867dfc2f8b076e24ae1fc3dc068b7395;hb=51cf665f514935c8067f86f3850fd917731cada0;hp=6fc2e5e91f9826bbcadd951bd8c4d8a6cb197ae6;hpb=f9ef8b045b60ae064c7bd40af599b46707ea4d8a;p=sbcl.git

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 6fc2e5e..d960a9f 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -84,7 +84,36 @@
 			   (- other-pointer-lowtag)))
 	 ,reg))
 
+#!+sb-thread
+(defmacro load-tl-symbol-value (reg symbol)
+  `(progn
+    (inst mov ,reg
+     (make-ea :dword
+      :disp (+ nil-value
+	       (static-symbol-offset ',symbol)
+	       (ash symbol-tls-index-slot word-shift)
+	       (- other-pointer-lowtag))))
+    (inst fs-segment-prefix)
+    (inst mov ,reg (make-ea :dword :scale 1 :index ,reg))))
+#!-sb-thread
+(defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol))
 
+#!+sb-thread
+(defmacro store-tl-symbol-value (reg symbol temp)
+  `(progn
+    (inst mov ,temp
+     (make-ea :dword
+      :disp (+ nil-value
+	       (static-symbol-offset ',symbol)
+	       (ash symbol-tls-index-slot word-shift)
+	       (- other-pointer-lowtag))))
+    (inst fs-segment-prefix)
+    (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg)))
+#!-sb-thread
+(defmacro store-tl-symbol-value (reg symbol temp)
+  (declare (ignore temp))
+  `(store-symbol-value ,reg ,symbol))
+  
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc
   "Loads the type bits of a pointer into target independent of
@@ -141,6 +170,9 @@
 ;;; formalized, in documentation and in macro definition,
 ;;; with the macro becoming e.g. PSEUDO-ATOMIC-ALLOCATION.
 (defun allocation (alloc-tn size &optional inline)
+  ;; FIXME: since it appears that inline allocation is gone, we should
+  ;; remove the INLINE parameter, and all the above comments.
+  (declare (ignore inline))  
   (flet ((load-size (dst-tn size)
 	   (unless (and (tn-p size) (location= alloc-tn size))
 	     (inst mov dst-tn size))))
@@ -225,7 +257,7 @@
     ,@forms))
 
 ;;;; error code
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun emit-error-break (vop kind code values)
     (let ((vector (gensym)))
       `((inst int 3)				; i386 breakpoint instruction
@@ -277,31 +309,53 @@
 
 ;;; FIXME: It appears that PSEUDO-ATOMIC is used to wrap operations which leave
 ;;; untagged memory lying around, but some documentation would be nice.
+#!+sb-thread
+(defmacro pseudo-atomic (&rest forms)
+  (with-unique-names (label)
+    `(let ((,label (gen-label)))
+      (inst fs-segment-prefix)
+      (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
+      (inst fs-segment-prefix)
+      (inst mov (make-ea :byte 
+		 :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) 
+      ,@forms
+      (inst fs-segment-prefix)
+      (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0)
+      (inst fs-segment-prefix)
+      (inst cmp (make-ea :byte
+		 :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
+      (inst jmp :eq ,label)
+      ;; if PAI was set, interrupts were disabled at the same time
+      ;; using the process signal mask.  
+      (inst break pending-interrupt-trap)
+      (emit-label ,label))))
+
+#!-sb-thread
 (defmacro pseudo-atomic (&rest forms)
-  (let ((label (gensym "LABEL-")))
+  (with-unique-names (label)
     `(let ((,label (gen-label)))
       ;; FIXME: The MAKE-EA noise should become a MACROLET macro or
       ;; something. (perhaps SVLB, for static variable low byte)
       (inst mov (make-ea :byte :disp (+ nil-value
-					(static-symbol-offset
-					 '*pseudo-atomic-interrupted*)
-					(ash symbol-value-slot word-shift)
-					;; FIXME: Use mask, not minus, to
-					;; take out type bits.
-					(- other-pointer-lowtag)))
+                                        (static-symbol-offset
+                                         '*pseudo-atomic-interrupted*)
+                                        (ash symbol-value-slot word-shift)
+                                        ;; FIXME: Use mask, not minus, to
+                                        ;; take out type bits.
+                                        (- other-pointer-lowtag)))
        0)
       (inst mov (make-ea :byte :disp (+ nil-value
-					(static-symbol-offset
-					 '*pseudo-atomic-atomic*)
-					(ash symbol-value-slot word-shift)
-					(- other-pointer-lowtag)))
+                                        (static-symbol-offset
+                                         '*pseudo-atomic-atomic*)
+                                        (ash symbol-value-slot word-shift)
+                                        (- other-pointer-lowtag)))
        (fixnumize 1))
       ,@forms
       (inst mov (make-ea :byte :disp (+ nil-value
-					(static-symbol-offset
-					 '*pseudo-atomic-atomic*)
-					(ash symbol-value-slot word-shift)
-					(- other-pointer-lowtag)))
+                                        (static-symbol-offset
+                                         '*pseudo-atomic-atomic*)
+                                        (ash symbol-value-slot word-shift)
+                                        (- other-pointer-lowtag)))
        0)
       ;; KLUDGE: Is there any requirement for interrupts to be
       ;; handled in order? It seems as though an interrupt coming
@@ -310,17 +364,19 @@
       ;; are pending? I wish I could find the documentation for
       ;; pseudo-atomics.. -- WHN 19991130
       (inst cmp (make-ea :byte
-		 :disp (+ nil-value
-			  (static-symbol-offset
-			   '*pseudo-atomic-interrupted*)
-			  (ash symbol-value-slot word-shift)
-			  (- other-pointer-lowtag)))
+                 :disp (+ nil-value
+                          (static-symbol-offset
+                           '*pseudo-atomic-interrupted*)
+                          (ash symbol-value-slot word-shift)
+                          (- other-pointer-lowtag)))
        0)
       (inst jmp :eq ,label)
       ;; if PAI was set, interrupts were disabled at the same time
       ;; using the process signal mask.  
       (inst break pending-interrupt-trap)
       (emit-label ,label))))
+
+
 
 ;;;; indexed references