1.0.32.34: remove curious-hacker-cruft from constraints.lisp

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

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index 4a5d2dc..e566001 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -67,7 +67,7 @@
       (:little-endian
        `(inst lbz ,n-target ,n-source ,n-offset))
       (:big-endian
-       `(inst lbz ,n-target ,n-source (+ ,n-offset 3))))))
+       `(inst lbz ,n-target ,n-source (+ ,n-offset (1- n-word-bytes)))))))
 
 ;;; Macros to handle the fact that we cannot use the machine native call and
 ;;; return instructions.
@@ -94,7 +94,7 @@
 (defmacro emit-return-pc (label)
   "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)))
 
@@ -252,62 +252,36 @@
 
 \f
 ;;;; Error Code
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun emit-error-break (vop kind code values)
-    (let ((vector (gensym)))
-      `((let ((vop ,vop))
-          (when vop
-            (note-this-location vop :internal-error)))
-        (inst unimp ,kind)
-        (with-adjustable-vector (,vector)
-          (write-var-integer (error-number-or-lose ',code) ,vector)
-          ,@(mapcar #'(lambda (tn)
-                        `(let ((tn ,tn))
-                           (write-var-integer (make-sc-offset (sc-number
-                                                               (tn-sc tn))
-                                                              (tn-offset tn))
-                                              ,vector)))
-                    values)
-          (inst byte (length ,vector))
-          (dotimes (i (length ,vector))
-            (inst byte (aref ,vector i))))
-        (align word-shift)))))
-
-(defmacro error-call (vop error-code &rest values)
+(defun emit-error-break (vop kind code values)
+  (assemble ()
+    (when vop
+      (note-this-location vop :internal-error))
+    (inst unimp kind)
+    (with-adjustable-vector (vector)
+      (write-var-integer code vector)
+      (dolist (tn values)
+        (write-var-integer (make-sc-offset (sc-number (tn-sc tn))
+                                           (or (tn-offset tn) 0))
+                           vector))
+      (inst byte (length vector))
+      (dotimes (i (length vector))
+        (inst byte (aref vector i)))
+      (emit-alignment word-shift))))
+
+(defun error-call (vop error-code &rest values)
+  #!+sb-doc
   "Cause an error.  ERROR-CODE is the error to cause."
-  (cons 'progn
-        (emit-error-break vop error-trap error-code values)))
-
-
-(defmacro cerror-call (vop label error-code &rest values)
-  "Cause a continuable error.  If the error is continued, execution resumes at
-  LABEL."
-  `(progn
-     ,@(emit-error-break vop cerror-trap error-code values)
-     (inst b ,label)))
+  (emit-error-break vop error-trap (error-number-or-lose error-code) values))
 
-(defmacro generate-error-code (vop error-code &rest values)
+(defun generate-error-code (vop error-code &rest values)
+  #!+sb-doc
   "Generate-Error-Code Error-code Value*
   Emit code for an error with the specified Error-Code and context Values."
-  `(assemble (*elsewhere*)
-     (let ((start-lab (gen-label)))
-       (emit-label start-lab)
-       (error-call ,vop ,error-code ,@values)
-       start-lab)))
-
-(defmacro generate-cerror-code (vop error-code &rest values)
-  "Generate-CError-Code Error-code Value*
-  Emit code for a continuable error with the specified Error-Code and
-  context Values.  If the error is continued, execution resumes after
-  the GENERATE-CERROR-CODE form."
-  (with-unique-names (continue error)
-    `(let ((,continue (gen-label)))
-       (emit-label ,continue)
-       (assemble (*elsewhere*)
-         (let ((,error (gen-label)))
-           (emit-label ,error)
-           (cerror-call ,vop ,continue ,error-code ,@values)
-           ,error)))))
+  (assemble (*elsewhere*)
+    (let ((start-lab (gen-label)))
+      (emit-label start-lab)
+      (emit-error-break vop error-trap (error-number-or-lose error-code) values)
+      start-lab)))
 \f
 ;;;; PSEUDO-ATOMIC
 
@@ -340,13 +314,11 @@
        (inst andi. ,flag-tn alloc-tn 7)
        (inst twi :ne ,flag-tn 0))))
 
-
-
-(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
 garbage collection.  This is currently implemented by disabling GC"
-  (declare (ignore objects))            ;should we eval these for side-effect?
+  (declare (ignore objects))            ; should we eval these for side-effect?
   `(without-gcing
     ,@body))