X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fcell.lisp;h=024d1c71d488979abe3041bf82a35c9a2b01d0cc;hb=cb254941e176badff31a16a11509e1ac288ae249;hp=a9eb1899f0aee571e5c3a48e1b24b1f6ec782036;hpb=7a896fb715ceac43581a9a3835418e615002f9ec;p=sbcl.git

diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp
index a9eb189..024d1c7 100644
--- 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)
@@ -292,4 +294,347 @@
   (descriptor-reg any-reg null zero) * code-header-set)
 
 
+
+;;;; raw instance slot accessors
 
+(define-vop (raw-instance-ref/word)
+  (:translate %raw-instance-ref/word)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg)))
+  (:arg-types * positive-fixnum)
+  (:results (value :scs (unsigned-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types unsigned-num)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset n-word-bytes)
+    (inst addu lip offset object)
+    (inst lw value lip (- (* instance-slots-offset n-word-bytes)
+                          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))
+         (value :scs (unsigned-reg) :target result))
+  (:arg-types * positive-fixnum unsigned-num)
+  (:results (result :scs (unsigned-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types unsigned-num)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset n-word-bytes)
+    (inst addu lip offset object)
+    (inst sw value lip (- (* instance-slots-offset n-word-bytes)
+                          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)))
+  (:arg-types * positive-fixnum)
+  (:results (value :scs (single-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types single-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset n-word-bytes)
+    (inst addu lip offset object)
+    (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes)
+                            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))
+         (value :scs (single-reg) :target result))
+  (:arg-types * positive-fixnum single-float)
+  (:results (result :scs (single-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types single-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset n-word-bytes)
+    (inst addu lip offset object)
+    (inst swc1 value lip (- (* instance-slots-offset n-word-bytes)
+                            instance-pointer-lowtag))
+    (unless (location= result value)
+      (inst fmove :single result value))))
+
+(define-vop (raw-instance-ref/double)
+  (:translate %raw-instance-ref/double)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg)))
+  (:arg-types * positive-fixnum)
+  (:results (value :scs (double-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types double-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset (* 2 n-word-bytes))
+    (inst addu lip offset object)
+    (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
+                               instance-pointer-lowtag)))
+      (ecase *backend-byte-order*
+        (: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)))
+      (ecase *backend-byte-order*
+        (: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))
+         (value :scs (double-reg) :target result))
+  (:arg-types * positive-fixnum double-float)
+  (:results (result :scs (double-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types double-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset (* 2 n-word-bytes))
+    (inst addu lip offset object)
+    (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
+                               instance-pointer-lowtag)))
+      (ecase *backend-byte-order*
+        (: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)))
+      (ecase *backend-byte-order*
+        (: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))))
+
+(define-vop (raw-instance-ref/complex-single)
+  (:translate %raw-instance-ref/complex-single)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg)))
+  (:arg-types * positive-fixnum)
+  (:results (value :scs (complex-single-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types complex-single-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (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)
+             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))
+         (value :scs (complex-single-reg) :target result))
+  (:arg-types * positive-fixnum complex-single-float)
+  (:results (result :scs (complex-single-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types complex-single-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset (* 2 n-word-bytes))
+    (inst addu lip offset object)
+    (let ((value-real (complex-single-reg-real-tn value))
+          (result-real (complex-single-reg-real-tn result)))
+      (inst swc1
+            value-real
+            lip
+            (- (* instance-slots-offset n-word-bytes)
+               instance-pointer-lowtag))
+      (unless (location= 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
+            lip
+            (- (* (1+ instance-slots-offset) n-word-bytes)
+               instance-pointer-lowtag))
+      (unless (location= 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)))
+  (:arg-types * positive-fixnum)
+  (:results (value :scs (complex-double-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types complex-double-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset (* 4 n-word-bytes))
+    (inst addu lip offset object)
+    (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
+                               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))))
+    (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes)
+                               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))))
+    (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes)
+                               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))))
+    (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes)
+                               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))))))
+
+(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))
+         (value :scs (complex-double-reg) :target result))
+  (:arg-types * positive-fixnum complex-double-float)
+  (:results (result :scs (complex-double-reg)))
+  (:temporary (:scs (non-descriptor-reg)) offset)
+  (:temporary (:scs (interior-reg)) lip)
+  (:result-types complex-double-float)
+  (:generator 5
+    (loadw offset object 0 instance-pointer-lowtag)
+    (inst srl offset n-widetag-bits)
+    (inst sll offset 2)
+    (inst subu offset index)
+    (inst subu offset (* 4 n-word-bytes))
+    (inst addu lip offset object)
+    (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))))
+      (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))))
+      (unless (location= 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))))
+      (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))))
+      (unless (location= result-imag value-imag)
+        (inst fmove :double result-imag value-imag)))))