0.9.2.26: refactoring internals of foreign linkage

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

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index a4293d2..9c19f5c 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -21,11 +21,11 @@
        (inst mr ,n-dst ,n-src))))
 
 (macrolet
-    ((frob (op inst shift)
+    ((def (op inst shift)
        `(defmacro ,op (object base &optional (offset 0) (lowtag 0))
          `(inst ,',inst ,object ,base (- (ash ,offset ,,shift) ,lowtag)))))
-  (frob loadw lwz word-shift)
-  (frob storew stw word-shift))
+  (def loadw lwz word-shift)
+  (def storew stw word-shift))
 
 (defmacro load-symbol (reg symbol)
   `(inst addi ,reg null-tn (static-symbol-offset ,symbol)))
@@ -149,6 +149,15 @@
        (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 andi. temp csp-tn lowtag-mask)
+    (inst beq aligned)
+    (inst addi csp-tn csp-tn n-word-bytes)
+    (storew zero-tn csp-tn -1)
+    (emit-label aligned)))
+
 \f
 ;;;; Error Code
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -218,7 +227,7 @@
 ;;; aligns ALLOC-TN again and (b) makes ALLOC-TN go negative. We then
 ;;; trap if ALLOC-TN's negative (handling the deferred interrupt) and
 ;;; using FLAG-TN - minus the large constant - to correct ALLOC-TN.
-(defmacro pseudo-atomic ((flag-tn &key (extra 0)) &rest forms)
+(defmacro pseudo-atomic ((flag-tn &key (extra 0)) &body forms)
   (let ((n-extra (gensym)))
     `(let ((,n-extra ,extra))
        (without-scheduling ()