1.0.9.10: make tests clean up after themselves a bit better

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

diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp
index dd32fdc..ca9f359 100644 (file)
--- a/src/compiler/mips/macros.lisp
+++ b/src/compiler/mips/macros.lisp
@@ -70,7 +70,7 @@
       (:little-endian
        `(inst lbu ,n-target ,n-source ,n-offset))
       (:big-endian
-       `(inst lbu ,n-target ,n-source (+ ,n-offset 3))))))
+       `(inst lbu ,n-target ,n-source (+ ,n-offset (1- n-word-bytes)))))))
 
 
 ;;; Macros to handle the fact that we cannot use the machine native call and
@@ -153,6 +153,16 @@
        (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
        ,@body)))
 
+(defun align-csp (temp)
+  ;; is used for stack allocation of dynamic-extent objects
+  (let ((aligned (gen-label)))
+    (inst and temp csp-tn lowtag-mask)
+    (inst beq temp aligned)
+    (inst nop)
+    (inst addu csp-tn n-word-bytes)
+    (storew zero-tn csp-tn -1)
+    (emit-label aligned)))
+
 \f
 ;;;; Three Way Comparison
 (defun three-way-comparison (x y condition flavor not-p target temp)
@@ -190,7 +200,7 @@
       `((let ((vop ,vop))
           (when vop
             (note-this-location vop :internal-error)))
-        (inst break ,kind)
+        (inst break 0 ,kind)
         (with-adjustable-vector (,vector)
           (write-var-integer (error-number-or-lose ',code) ,vector)
           ,@(mapcar #'(lambda (tn)
@@ -215,8 +225,9 @@
   "Cause a continuable error.  If the error is continued, execution resumes at
   LABEL."
   `(progn
-     (inst b ,label)
-     ,@(emit-error-break vop cerror-trap error-code values)))
+     (without-scheduling ()
+       (inst b ,label)
+       ,@(emit-error-break vop cerror-trap error-code values))))
 
 (defmacro generate-error-code (vop error-code &rest values)
   "Generate-Error-Code Error-code Value*
@@ -256,7 +267,7 @@
        (let ((label (gen-label)))
          (inst bgez ,flag-tn label)
          (inst addu alloc-tn (1- ,extra))
-         (inst break 16)
+         (inst break 0 16)
          (emit-label label)))))
 \f
 ;;;; memory accessor vop generators
@@ -285,9 +296,8 @@
        (:results (value :scs ,scs))
        (:result-types ,el-type)
        (:generator 5
-         (inst add lip object index)
-         (inst lw value lip (- (* ,offset n-word-bytes) ,lowtag))
-         (inst nop)))
+         (inst addu lip object index)
+         (loadw value lip ,offset ,lowtag)))
      (define-vop (,(symbolicate name "-C"))
        ,@(when translate
            `((:translate ,translate)))
@@ -300,8 +310,7 @@
        (:results (value :scs ,scs))
        (:result-types ,el-type)
        (:generator 4
-         (inst lw value object (- (* (+ ,offset index) n-word-bytes) ,lowtag))
-         (inst nop)))))
+         (loadw value object (+ ,offset index) ,lowtag)))))
 
 (defmacro define-full-setter (name type offset lowtag scs el-type
                                    &optional translate)
@@ -318,8 +327,8 @@
        (:results (result :scs ,scs))
        (:result-types ,el-type)
        (:generator 2
-         (inst add lip object index)
-         (inst sw value lip (- (* ,offset n-word-bytes) ,lowtag))
+         (inst addu lip object index)
+         (storew value lip ,offset ,lowtag)
          (move result value)))
      (define-vop (,(symbolicate name "-C"))
        ,@(when translate
@@ -335,7 +344,7 @@
        (:results (result :scs ,scs))
        (:result-types ,el-type)
        (:generator 1
-         (inst sw value object (- (* (+ ,offset index) n-word-bytes) ,lowtag))
+         (storew value object (+ ,offset index) ,lowtag)
          (move result value)))))
 
 
@@ -425,7 +434,7 @@
            (move result value))))))
 
 
-(defmacro sb!sys::with-pinned-objects ((&rest objects) &body body)
+(def!macro with-pinned-objects ((&rest objects) &body body)
   "Arrange with the garbage collector that the pages occupied by
 OBJECTS will not be moved in memory for the duration of BODY.
 Useful for e.g. foreign calls where another thread may trigger