0.9.10.30:

[sbcl.git] / src / compiler / x86 / macros.lisp

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 0b8f234..8a1dc87 100644 (file)
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -108,6 +108,25 @@
   (declare (ignore temp))
   `(store-symbol-value ,reg ,symbol))
 
+(defmacro load-binding-stack-pointer (reg)
+  #!+sb-thread
+  `(progn
+     (inst fs-segment-prefix)
+     (inst mov ,reg (make-ea :dword
+                             :disp (* 4 thread-binding-stack-pointer-slot))))
+  #!-sb-thread
+  `(load-symbol-value ,reg *binding-stack-pointer*))
+
+(defmacro store-binding-stack-pointer (reg)
+  #!+sb-thread
+  `(progn
+     (inst fs-segment-prefix)
+     (inst mov (make-ea :dword
+                        :disp (* 4 thread-binding-stack-pointer-slot))
+           ,reg))
+  #!-sb-thread
+  `(store-symbol-value ,reg *binding-stack-pointer*))
+
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc
   "Loads the type bits of a pointer into target independent of
@@ -257,7 +276,15 @@
 (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
+      `((progn
+          #-darwin (inst int 3)         ; i386 breakpoint instruction
+          ;; CLH 20060314
+          ;; On Darwin, we need to use #x0b0f instead of int3 in order
+          ;; to generate a SIGILL instead of a SIGTRAP as darwin/x86
+          ;; doesn't seem to be reliably firing SIGTRAP
+          ;; handlers. Hopefully this will be fixed by Apple at a
+          ;; later date.
+          #+darwin (inst word #x0b0f))
         ;; The return PC points here; note the location for the debugger.
         (let ((vop ,vop))
           (when vop
@@ -324,9 +351,6 @@
   (with-unique-names (label)
     `(let ((,label (gen-label)))
        (inst fs-segment-prefix)
-       (inst mov (make-ea :byte
-                          :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
-       (inst fs-segment-prefix)
        (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot))
             (fixnumize 1))
        ,@forms
@@ -350,14 +374,6 @@
        ;; 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)))
-             0)
-       (inst mov (make-ea :byte :disp (+ nil-value
-                                         (static-symbol-offset
                                           '*pseudo-atomic-atomic*)
                                          (ash symbol-value-slot word-shift)
                                          (- other-pointer-lowtag)))
@@ -369,12 +385,6 @@
                                          (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
-       ;; in at this point will be executed before any pending
-       ;; interrupts.  Or do incoming interrupts check to see
-       ;; whether any interrupts 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
@@ -397,27 +407,21 @@
            `((:translate ,translate)))
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg))
-              (index :scs (any-reg)))
+              (index :scs (any-reg immediate)))
        (:arg-types ,type tagged-num)
        (:results (value :scs ,scs))
        (:result-types ,el-type)
        (:generator 3                    ; pw was 5
-         (inst mov value (make-ea :dword :base object :index index
-                                  :disp (- (* ,offset n-word-bytes)
-                                           ,lowtag)))))
-     (define-vop (,(symbolicate name "-C"))
-       ,@(when translate
-           `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg)))
-       (:info index)
-       (:arg-types ,type (:constant (signed-byte 30)))
-       (:results (value :scs ,scs))
-       (:result-types ,el-type)
-       (:generator 2                    ; pw was 5
-         (inst mov value (make-ea :dword :base object
-                                  :disp (- (* (+ ,offset index) n-word-bytes)
-                                           ,lowtag)))))))
+         (sc-case index
+           (immediate
+            (inst mov value (make-ea :dword :base object
+                                     :disp (- (* (+ ,offset (tn-value index))
+                                                 n-word-bytes)
+                                              ,lowtag))))
+           (t
+            (inst mov value (make-ea :dword :base object :index index
+                                     :disp (- (* ,offset n-word-bytes)
+                                              ,lowtag)))))))))
 
 (defmacro define-full-setter (name type offset lowtag scs el-type &optional translate)
   `(progn
@@ -426,32 +430,24 @@
            `((:translate ,translate)))
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg))
-              (index :scs (any-reg))
+              (index :scs (any-reg immediate))
               (value :scs ,scs :target result))
        (:arg-types ,type tagged-num ,el-type)
        (:results (result :scs ,scs))
        (:result-types ,el-type)
        (:generator 4                    ; was 5
-         (inst mov (make-ea :dword :base object :index index
-                            :disp (- (* ,offset n-word-bytes) ,lowtag))
-               value)
-         (move result value)))
-     (define-vop (,(symbolicate name "-C"))
-       ,@(when translate
-           `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg))
-              (value :scs ,scs :target result))
-       (:info index)
-       (:arg-types ,type (:constant (signed-byte 30)) ,el-type)
-       (:results (result :scs ,scs))
-       (:result-types ,el-type)
-       (:generator 3                    ; was 5
-         (inst mov (make-ea :dword :base object
-                            :disp (- (* (+ ,offset index) n-word-bytes)
-                                     ,lowtag))
-               value)
-         (move result value)))))
+         (sc-case index
+           (immediate
+            (inst mov (make-ea :dword :base object
+                               :disp (- (* (+ ,offset (tn-value index))
+                                           n-word-bytes)
+                                        ,lowtag))
+                  value))
+           (t
+            (inst mov (make-ea :dword :base object :index index
+                               :disp (- (* ,offset n-word-bytes) ,lowtag))
+                  value)))
+        (move result value)))))
 
 ;;; helper for alien stuff.
 (defmacro with-pinned-objects ((&rest objects) &body body)