0.9.17.8:

[sbcl.git] / src / compiler / mips / cell.lisp

diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp
index 7a80016..40ac92c 100644 (file)
--- a/src/compiler/mips/cell.lisp
+++ b/src/compiler/mips/cell.lisp
@@ -24,7 +24,7 @@
 
 (define-vop (set-slot)
   (:args (object :scs (descriptor-reg))
-        (value :scs (descriptor-reg any-reg null zero)))
+         (value :scs (descriptor-reg any-reg null zero)))
   (:info name offset lowtag)
   (:ignore name)
   (:results)
@@ -78,8 +78,8 @@
     (loadw value object symbol-value-slot other-pointer-lowtag)
     (inst xor temp value unbound-marker-widetag)
     (if not-p
-       (inst beq temp zero-tn target)
-       (inst bne temp zero-tn target))
+        (inst beq temp zero-tn target)
+        (inst bne temp zero-tn target))
     (inst nop)))
 
 (define-vop (fast-symbol-value cell-ref)
@@ -127,7 +127,7 @@
   (:policy :fast-safe)
   (:translate (setf fdefn-fun))
   (:args (function :scs (descriptor-reg) :target result)
-        (fdefn :scs (descriptor-reg)))
+         (fdefn :scs (descriptor-reg)))
   (:temporary (:scs (interior-reg)) lip)
   (:temporary (:scs (non-descriptor-reg)) type)
   (:results (result :scs (descriptor-reg)))
@@ -138,8 +138,8 @@
       (inst xor type simple-fun-header-widetag)
       (inst beq type zero-tn normal-fn)
       (inst addu lip function
-           (- (ash simple-fun-code-offset word-shift)
-              fun-pointer-lowtag))
+            (- (ash simple-fun-code-offset word-shift)
+               fun-pointer-lowtag))
       (inst li lip (make-fixup "closure_tramp" :foreign))
       (emit-label normal-fn)
       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
@@ -168,7 +168,7 @@
 
 (define-vop (bind)
   (:args (val :scs (any-reg descriptor-reg))
-        (symbol :scs (descriptor-reg)))
+         (symbol :scs (descriptor-reg)))
   (:temporary (:scs (descriptor-reg)) temp)
   (:generator 5
     (loadw temp symbol symbol-value-slot other-pointer-lowtag)
@@ -184,6 +184,7 @@
     (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
     (loadw value bsp-tn (- binding-value-slot binding-size))
     (storew value symbol symbol-value-slot other-pointer-lowtag)
+    (storew zero-tn bsp-tn (- binding-value-slot binding-size))
     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
     (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))))
 
@@ -194,8 +195,8 @@
   (:temporary (:scs (descriptor-reg)) symbol value)
   (:generator 0
     (let ((loop (gen-label))
-         (skip (gen-label))
-         (done (gen-label)))
+          (skip (gen-label))
+          (done (gen-label)))
       (move where arg)
       (inst beq where bsp-tn done)
       (inst nop)
@@ -205,6 +206,7 @@
       (inst beq symbol zero-tn skip)
       (loadw value bsp-tn (- binding-value-slot binding-size))
       (storew value symbol symbol-value-slot other-pointer-lowtag)
+      (storew zero-tn bsp-tn (- binding-value-slot binding-size))
       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
 
       (emit-label skip)
@@ -230,15 +232,11 @@
   funcallable-instance-info-offset fun-pointer-lowtag
   (descriptor-reg any-reg) * %funcallable-instance-info)
 
-(define-vop (funcallable-instance-lexenv cell-ref)
-  (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag))
-
 (define-vop (closure-ref slot-ref)
   (:variant closure-info-offset fun-pointer-lowtag))
 
 (define-vop (closure-init slot-set)
   (:variant closure-info-offset fun-pointer-lowtag))
-
 \f
 ;;;; Value Cell hackery.
 
@@ -262,19 +260,6 @@
     (loadw res struct 0 instance-pointer-lowtag)
     (inst srl res n-widetag-bits)))
 
-(define-vop (instance-ref slot-ref)
-  (:variant instance-slots-offset instance-pointer-lowtag)
-  (:policy :fast-safe)
-  (:translate %instance-ref)
-  (:arg-types instance (:constant index)))
-
-#+nil
-(define-vop (instance-set slot-set)
-  (:policy :fast-safe)
-  (:translate %instance-set)
-  (:variant instance-slots-offset instance-pointer-lowtag)
-  (:arg-types instance (:constant index) *))
-
 (define-full-reffer instance-index-ref * instance-slots-offset
   instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref)
 
@@ -299,7 +284,7 @@
   (:translate %raw-instance-ref/word)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg)))
+         (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (unsigned-reg)))
   (:temporary (:scs (non-descriptor-reg)) offset)
@@ -313,13 +298,13 @@
     (inst subu offset n-word-bytes)
     (inst addu lip offset object)
     (inst lw value lip (- (* instance-slots-offset n-word-bytes)
-                         instance-pointer-lowtag))))
+                          instance-pointer-lowtag))))
 
 (define-vop (raw-instance-set/word)
   (:translate %raw-instance-set/word)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg))
+         (index :scs (any-reg))
          (value :scs (unsigned-reg) :target result))
   (:arg-types * positive-fixnum unsigned-num)
   (:results (result :scs (unsigned-reg)))
@@ -334,15 +319,14 @@
     (inst subu offset n-word-bytes)
     (inst addu lip offset object)
     (inst sw value lip (- (* instance-slots-offset n-word-bytes)
-                         instance-pointer-lowtag))
-    (unless (location= result value)
-      (move result value))))
+                          instance-pointer-lowtag))
+    (move result value)))
 
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg)))
+         (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (single-reg)))
   (:temporary (:scs (non-descriptor-reg)) offset)
@@ -356,13 +340,13 @@
     (inst subu offset n-word-bytes)
     (inst addu lip offset object)
     (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes)
-                           instance-pointer-lowtag))))
+                            instance-pointer-lowtag))))
 
 (define-vop (raw-instance-set/single)
   (:translate %raw-instance-set/single)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg))
+         (index :scs (any-reg))
          (value :scs (single-reg) :target result))
   (:arg-types * positive-fixnum single-float)
   (:results (result :scs (single-reg)))
@@ -377,7 +361,7 @@
     (inst subu offset n-word-bytes)
     (inst addu lip offset object)
     (inst swc1 value lip (- (* instance-slots-offset n-word-bytes)
-                           instance-pointer-lowtag))
+                            instance-pointer-lowtag))
     (unless (location= result value)
       (inst fmove :single result value))))
 
@@ -385,7 +369,7 @@
   (:translate %raw-instance-ref/double)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg)))
+         (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (double-reg)))
   (:temporary (:scs (non-descriptor-reg)) offset)
@@ -399,21 +383,21 @@
     (inst subu offset (* 2 n-word-bytes))
     (inst addu lip offset object)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1 value lip immediate-offset))
-       (:little-endian (inst lwc1-odd value lip immediate-offset))))
+        (:big-endian (inst lwc1 value lip immediate-offset))
+        (:little-endian (inst lwc1-odd value lip immediate-offset))))
     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1-odd value lip immediate-offset))
-       (:little-endian (inst lwc1 value lip immediate-offset))))))
+        (:big-endian (inst lwc1-odd value lip immediate-offset))
+        (:little-endian (inst lwc1 value lip immediate-offset))))))
 
 (define-vop (raw-instance-set/double)
   (:translate %raw-instance-set/double)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg))
+         (index :scs (any-reg))
          (value :scs (double-reg) :target result))
   (:arg-types * positive-fixnum double-float)
   (:results (result :scs (double-reg)))
@@ -428,15 +412,15 @@
     (inst subu offset (* 2 n-word-bytes))
     (inst addu lip offset object)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst swc1 value lip immediate-offset))
-       (:little-endian (inst swc1-odd value lip immediate-offset))))
+        (:big-endian (inst swc1 value lip immediate-offset))
+        (:little-endian (inst swc1-odd value lip immediate-offset))))
     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst swc1-odd value lip immediate-offset))
-       (:little-endian (inst swc1 value lip immediate-offset))))
+        (:big-endian (inst swc1-odd value lip immediate-offset))
+        (:little-endian (inst swc1 value lip immediate-offset))))
     (unless (location= result value)
       (inst fmove :double result value))))
 
@@ -444,7 +428,7 @@
   (:translate %raw-instance-ref/complex-single)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg)))
+         (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (complex-single-reg)))
   (:temporary (:scs (non-descriptor-reg)) offset)
@@ -457,22 +441,22 @@
     (inst subu offset index)
     (inst subu offset (* 2 n-word-bytes))
     (inst addu lip offset object)
-    (inst lwc1 
-         (complex-single-reg-real-tn value)
-         lip
-         (- (* instance-slots-offset n-word-bytes)
-            instance-pointer-lowtag))
     (inst lwc1
-         (complex-single-reg-imag-tn value)
-         lip
-         (- (* (1+ instance-slots-offset) n-word-bytes)
+          (complex-single-reg-real-tn value)
+          lip
+          (- (* instance-slots-offset n-word-bytes)
+             instance-pointer-lowtag))
+    (inst lwc1
+          (complex-single-reg-imag-tn value)
+          lip
+          (- (* (1+ instance-slots-offset) n-word-bytes)
              instance-pointer-lowtag))))
 
 (define-vop (raw-instance-set/complex-single)
   (:translate %raw-instance-set/complex-single)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg))
+         (index :scs (any-reg))
          (value :scs (complex-single-reg) :target result))
   (:arg-types * positive-fixnum complex-single-float)
   (:results (result :scs (complex-single-reg)))
@@ -489,27 +473,27 @@
     (let ((value-real (complex-single-reg-real-tn value))
           (result-real (complex-single-reg-real-tn result)))
       (inst swc1
-           value-real
+            value-real
             lip
-           (- (* instance-slots-offset n-word-bytes)
-              instance-pointer-lowtag))
+            (- (* instance-slots-offset n-word-bytes)
+               instance-pointer-lowtag))
       (unless (location= result-real value-real)
-       (inst fmove :single result-real value-real)))
+        (inst fmove :single result-real value-real)))
     (let ((value-imag (complex-single-reg-imag-tn value))
           (result-imag (complex-single-reg-imag-tn result)))
       (inst swc1
-           value-imag
+            value-imag
             lip
-           (- (* (1+ instance-slots-offset) n-word-bytes)
-              instance-pointer-lowtag))
+            (- (* (1+ instance-slots-offset) n-word-bytes)
+               instance-pointer-lowtag))
       (unless (location= result-imag value-imag)
-       (inst fmove :single result-imag value-imag)))))
+        (inst fmove :single result-imag value-imag)))))
 
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg)))
+         (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (complex-double-reg)))
   (:temporary (:scs (non-descriptor-reg)) offset)
@@ -523,55 +507,55 @@
     (inst subu offset (* 4 n-word-bytes))
     (inst addu lip offset object)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1
-                          (complex-double-reg-real-tn value)
-                          lip
-                          immediate-offset))
-       (:little-endian (inst lwc1-odd
-                             (complex-double-reg-real-tn value)
-                             lip
-                             immediate-offset))))
+        (:big-endian (inst lwc1
+                           (complex-double-reg-real-tn value)
+                           lip
+                           immediate-offset))
+        (:little-endian (inst lwc1-odd
+                              (complex-double-reg-real-tn value)
+                              lip
+                              immediate-offset))))
     (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1-odd
-                          (complex-double-reg-real-tn value)
-                          lip
-                          immediate-offset))
-       (:little-endian (inst lwc1
-                             (complex-double-reg-real-tn value)
-                             lip
-                             immediate-offset))))
+        (:big-endian (inst lwc1-odd
+                           (complex-double-reg-real-tn value)
+                           lip
+                           immediate-offset))
+        (:little-endian (inst lwc1
+                              (complex-double-reg-real-tn value)
+                              lip
+                              immediate-offset))))
     (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1
-                          (complex-double-reg-imag-tn value)
-                          lip
-                          immediate-offset))
-       (:little-endian (inst lwc1-odd
-                             (complex-double-reg-imag-tn value)
-                             lip
-                             immediate-offset))))
+        (:big-endian (inst lwc1
+                           (complex-double-reg-imag-tn value)
+                           lip
+                           immediate-offset))
+        (:little-endian (inst lwc1-odd
+                              (complex-double-reg-imag-tn value)
+                              lip
+                              immediate-offset))))
     (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
-                              instance-pointer-lowtag)))
+                               instance-pointer-lowtag)))
       (ecase *backend-byte-order*
-       (:big-endian (inst lwc1-odd
-                          (complex-double-reg-imag-tn value)
-                          lip
-                          immediate-offset))
-       (:little-endian (inst lwc1
-                             (complex-double-reg-imag-tn value)
-                             lip
-                             immediate-offset))))))
+        (:big-endian (inst lwc1-odd
+                           (complex-double-reg-imag-tn value)
+                           lip
+                           immediate-offset))
+        (:little-endian (inst lwc1
+                              (complex-double-reg-imag-tn value)
+                              lip
+                              immediate-offset))))))
 
 (define-vop (raw-instance-set/complex-double)
   (:translate %raw-instance-set/complex-double)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-        (index :scs (any-reg))
+         (index :scs (any-reg))
          (value :scs (complex-double-reg) :target result))
   (:arg-types * positive-fixnum complex-double-float)
   (:results (result :scs (complex-double-reg)))
@@ -588,52 +572,52 @@
     (let ((value-real (complex-double-reg-real-tn value))
           (result-real (complex-double-reg-real-tn result)))
       (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
-                                instance-pointer-lowtag)))
-       (ecase *backend-byte-order*
-         (:big-endian (inst swc1
-                            value-real
-                            lip
-                            immediate-offset))
-         (:little-endian (inst swc1-odd
-                               value-real
-                               lip
-                               immediate-offset))))
+                                 instance-pointer-lowtag)))
+        (ecase *backend-byte-order*
+          (:big-endian (inst swc1
+                             value-real
+                             lip
+                             immediate-offset))
+          (:little-endian (inst swc1-odd
+                                value-real
+                                lip
+                                immediate-offset))))
       (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
-                                instance-pointer-lowtag)))
-       (ecase *backend-byte-order*
-         (:big-endian (inst swc1-odd
-                            value-real
-                            lip
-                            immediate-offset))
-         (:little-endian (inst swc1
-                               value-real
-                               lip
-                               immediate-offset))))
+                                 instance-pointer-lowtag)))
+        (ecase *backend-byte-order*
+          (:big-endian (inst swc1-odd
+                             value-real
+                             lip
+                             immediate-offset))
+          (:little-endian (inst swc1
+                                value-real
+                                lip
+                                immediate-offset))))
       (unless (location= result-real value-real)
-       (inst fmove :double result-real value-real)))
+        (inst fmove :double result-real value-real)))
     (let ((value-imag (complex-double-reg-imag-tn value))
           (result-imag (complex-double-reg-imag-tn result)))
       (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
-                                instance-pointer-lowtag)))
-       (ecase *backend-byte-order*
-         (:big-endian (inst swc1
-                            value-imag
-                            lip
-                            immediate-offset))
-         (:little-endian (inst swc1-odd
-                               value-imag
-                               lip
-                               immediate-offset))))
+                                 instance-pointer-lowtag)))
+        (ecase *backend-byte-order*
+          (:big-endian (inst swc1
+                             value-imag
+                             lip
+                             immediate-offset))
+          (:little-endian (inst swc1-odd
+                                value-imag
+                                lip
+                                immediate-offset))))
       (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
-                                instance-pointer-lowtag)))
-       (ecase *backend-byte-order*
-         (:big-endian (inst swc1-odd
-                            value-imag
-                            lip
-                            immediate-offset))
-         (:little-endian (inst swc1
-                               value-imag
-                               lip
-                               immediate-offset))))
+                                 instance-pointer-lowtag)))
+        (ecase *backend-byte-order*
+          (:big-endian (inst swc1-odd
+                             value-imag
+                             lip
+                             immediate-offset))
+          (:little-endian (inst swc1
+                                value-imag
+                                lip
+                                immediate-offset))))
       (unless (location= result-imag value-imag)
-       (inst fmove :double result-imag value-imag)))))
+        (inst fmove :double result-imag value-imag)))))