Fix (compile '(setf function)).

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

diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp
index 9c60db9..da719e2 100644 (file)
--- a/src/compiler/mips/macros.lisp
+++ b/src/compiler/mips/macros.lisp
@@ -26,7 +26,7 @@
 (defmacro move (dst src &optional (always-emit-code-p nil))
   #!+sb-doc
   "Move SRC into DST (unless they are location= and ALWAYS-EMIT-CODE-P
 (defmacro move (dst src &optional (always-emit-code-p nil))
   #!+sb-doc
   "Move SRC into DST (unless they are location= and ALWAYS-EMIT-CODE-P

-  is nil)."
+is nil)."

   (once-only ((n-dst dst)
               (n-src src))
     `(if (location= ,n-dst ,n-src)
   (once-only ((n-dst dst)
               (n-src src))
     `(if (location= ,n-dst ,n-src)

@@ -64,7 +64,7 @@
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc
   "Loads the type bits of a pointer into target independent of
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc
   "Loads the type bits of a pointer into target independent of

-  byte-ordering issues."
+byte-ordering issues."

   (once-only ((n-target target)
               (n-source source)
               (n-offset offset))
   (once-only ((n-target target)
               (n-source source)
               (n-offset offset))

@@ -103,7 +103,7 @@
   #!+sb-doc
   "Emit a return-pc header word.  LABEL is the label to use for this return-pc."
   `(progn
   #!+sb-doc
   "Emit a return-pc header word.  LABEL is the label to use for this return-pc."
   `(progn

-     (align n-lowtag-bits)
+     (emit-alignment n-lowtag-bits)

      (emit-label ,label)
      (inst lra-header-word)))
 
      (emit-label ,label)
      (inst lra-header-word)))
 

@@ -149,10 +149,10 @@
                                  &body body)
   #!+sb-doc
   "Do stuff to allocate an other-pointer object of fixed Size with a single
                                  &body body)
   #!+sb-doc
   "Do stuff to allocate an other-pointer object of fixed Size with a single

-   word header having the specified Type-Code.  The result is placed in
-   Result-TN, Flag-Tn must be wired to NL4-OFFSET, and Temp-TN is a non-
-   descriptor temp (which may be randomly used by the body.)  The body is
-   placed inside the PSEUDO-ATOMIC, and presumably initializes the object."
+word header having the specified Type-Code.  The result is placed in
+Result-TN, Flag-Tn must be wired to NL4-OFFSET, and Temp-TN is a non-
+descriptor temp (which may be randomly used by the body.)  The body is
+placed inside the PSEUDO-ATOMIC, and presumably initializes the object."

   (unless body
     (bug "empty &body in WITH-FIXED-ALLOCATION"))
   (once-only ((result-tn result-tn) (flag-tn flag-tn) (temp-tn temp-tn)
   (unless body
     (bug "empty &body in WITH-FIXED-ALLOCATION"))
   (once-only ((result-tn result-tn) (flag-tn flag-tn) (temp-tn temp-tn)

@@ -172,8 +172,7 @@
            ;; has a 1 bit in the same position, we're all set.  Otherwise,
            ;; we need to subtract the pseudo-atomic bit.
            (inst or ,result-tn alloc-tn ,lowtag)
            ;; has a 1 bit in the same position, we're all set.  Otherwise,
            ;; we need to subtract the pseudo-atomic bit.
            (inst or ,result-tn alloc-tn ,lowtag)

-           (unless (logbitp (1- n-lowtag-bits) ,lowtag)
-                   (inst sub ,result-tn 1))
+           (unless (logbitp 0 ,lowtag) (inst sub ,result-tn 1))

            (inst li ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
            (storew ,temp-tn ,result-tn 0 ,lowtag)
            ,@body))))
            (inst li ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
            (storew ,temp-tn ,result-tn 0 ,lowtag)
            ,@body))))

@@ -203,8 +202,8 @@
        (:signed
         (inst slt temp x y)))
      (if not-p
        (:signed
         (inst slt temp x y)))
      (if not-p

-         (inst beq temp zero-tn target)
-         (inst bne temp zero-tn target)))
+         (inst beq temp target)
+         (inst bne temp target)))

     (:gt
      (ecase flavor
        (:unsigned
     (:gt
      (ecase flavor
        (:unsigned

@@ -212,8 +211,8 @@
        (:signed
         (inst slt temp y x)))
      (if not-p
        (:signed
         (inst slt temp y x)))
      (if not-p

-         (inst beq temp zero-tn target)
-         (inst bne temp zero-tn target))))
+         (inst beq temp target)
+         (inst bne temp target))))

   (inst nop))
 
 
   (inst nop))
 
 

@@ -238,7 +237,7 @@
           (inst byte (length ,vector))
           (dotimes (i (length ,vector))
             (inst byte (aref ,vector i))))
           (inst byte (length ,vector))
           (dotimes (i (length ,vector))
             (inst byte (aref ,vector i))))

-        (align word-shift)))))
+        (emit-alignment word-shift)))))

 
 (defmacro error-call (vop error-code &rest values)
   #!+sb-doc
 
 (defmacro error-call (vop error-code &rest values)
   #!+sb-doc