check-mod-fixnum: correct the test for power-of-two.
[sbcl.git] / src / compiler / x86 / cell.lisp
index d89f989..44d2760 100644 (file)
@@ -30,6 +30,8 @@
   (:generator 1
      (storew (encode-value-if-immediate value) object offset lowtag)))
 
+(define-vop (init-slot set-slot))
+
 (define-vop (compare-and-swap-slot)
   (:args (object :scs (descriptor-reg) :to :eval)
          (old :scs (descriptor-reg any-reg) :target eax)
@@ -71,7 +73,8 @@
       (progn
         (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
         ;; Thread-local area, no LOCK needed.
-        (inst cmpxchg (make-ea :dword :base tls) new :fs)
+        (with-tls-ea (EA :base tls :base-already-live-p t)
+          (inst cmpxchg EA new :maybe-fs))
         (inst cmp eax no-tls-value-marker-widetag)
         (inst jmp :ne check)
         (move eax old))
       (let ((global-val (gen-label))
             (done (gen-label)))
         (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag)
-        (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag :fs)
-        (inst jmp :z global-val)
-        (inst mov (make-ea :dword :base tls) value :fs)
+        (with-tls-ea (EA :base tls :base-already-live-p t)
+          (inst cmp EA no-tls-value-marker-widetag :maybe-fs)
+          (inst jmp :z global-val)
+          (inst mov EA value :maybe-fs))
         (inst jmp done)
         (emit-label global-val)
         (storew value symbol symbol-value-slot other-pointer-lowtag)
              (err-lab (generate-error-code vop 'unbound-symbol-error object))
              (ret-lab (gen-label)))
         (loadw value object symbol-tls-index-slot other-pointer-lowtag)
-        (inst mov value (make-ea :dword :base value) :fs)
+        (with-tls-ea (EA :base value :base-already-live-p t)
+          (inst mov value EA :maybe-fs))
         (inst cmp value no-tls-value-marker-widetag)
         (inst jmp :ne check-unbound-label)
         (loadw value object symbol-value-slot other-pointer-lowtag)
     (:generator 8
       (let ((ret-lab (gen-label)))
         (loadw value object symbol-tls-index-slot other-pointer-lowtag)
-        (inst mov value (make-ea :dword :base value) :fs)
+        (with-tls-ea (EA :base value :base-already-live-p t)
+          (inst mov value EA :maybe-fs))
         (inst cmp value no-tls-value-marker-widetag)
         (inst jmp :ne ret-lab)
         (loadw value object symbol-value-slot other-pointer-lowtag)
   (:generator 9
     (let ((check-unbound-label (gen-label)))
       (loadw value object symbol-tls-index-slot other-pointer-lowtag)
-      (inst mov value (make-ea :dword :base value) :fs)
+      (with-tls-ea (EA :base value :base-already-live-p t)
+        (inst mov value EA :maybe-fs))
       (inst cmp value no-tls-value-marker-widetag)
       (inst jmp :ne check-unbound-label)
       (loadw value object symbol-value-slot other-pointer-lowtag)
       (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
       (inst add bsp (* binding-size n-word-bytes))
       (store-binding-stack-pointer bsp)
-      (inst or tls-index tls-index)
+      (inst test tls-index tls-index)
       (inst jmp :ne tls-index-valid)
       (inst mov tls-index symbol)
       (inst call (make-fixup
                     (#.esi-offset 'alloc-tls-index-in-esi))
                   :assembly-routine))
       (emit-label tls-index-valid)
-      (inst push (make-ea :dword :base tls-index) :fs)
-      (popw bsp (- binding-value-slot binding-size))
-      (storew symbol bsp (- binding-symbol-slot binding-size))
-      (inst mov (make-ea :dword :base tls-index) val :fs))))
+      (with-tls-ea (EA :base tls-index :base-already-live-p t)
+        (inst push EA :maybe-fs)
+        (popw bsp (- binding-value-slot binding-size))
+        (storew symbol bsp (- binding-symbol-slot binding-size))
+        (inst mov EA val :maybe-fs)))))
 
 #!-sb-thread
 (define-vop (bind)
     (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag)
     ;; Load VALUE from stack, then restore it to the TLS area.
     (loadw temp bsp (- binding-value-slot binding-size))
-    (inst mov (make-ea :dword :base tls-index) temp :fs)
+    (with-tls-ea (EA :base tls-index :base-already-live-p t)
+      (inst mov EA temp :maybe-fs))
     ;; Zero out the stack.
     (storew 0 bsp (- binding-symbol-slot binding-size))
     (storew 0 bsp (- binding-value-slot binding-size))
 
     LOOP
     (loadw symbol bsp (- binding-symbol-slot binding-size))
-    (inst or symbol symbol)
+    (inst test symbol symbol)
     (inst jmp :z skip)
     ;; Bind stack debug sentinels have the unbound marker in the symbol slot
     (inst cmp symbol unbound-marker-widetag)
 
     #!+sb-thread (loadw
                   tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
-    #!+sb-thread (inst mov (make-ea :dword :base tls-index) value :fs)
+    #!+sb-thread (with-tls-ea (EA :base tls-index :base-already-live-p t)
+                   (inst mov EA value :maybe-fs))
     (storew 0 bsp (- binding-symbol-slot binding-size))
 
     SKIP
 
 (define-vop (closure-init slot-set)
   (:variant closure-info-offset fun-pointer-lowtag))
+
+(define-vop (closure-init-from-fp)
+  (:args (object :scs (descriptor-reg)))
+  (:info offset)
+  (:generator 4
+    (storew ebp-tn object (+ closure-info-offset offset) fun-pointer-lowtag)))
 \f
 ;;;; value cell hackery
 
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
          (index :scs (any-reg immediate))
-         (diff :scs (signed-reg) :target result))
-  (:arg-types * tagged-num signed-num)
+         (diff :scs (unsigned-reg) :target result))
+  (:arg-types * tagged-num unsigned-num)
   (:temporary (:sc unsigned-reg) tmp)
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)