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 230bde1..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)))
@@ -76,8 +76,8 @@
   "Jump to the lisp function FUNCTION.  LIP is an interior-reg temporary."
   `(progn
     ;; something is deeply bogus.  look at this
-    ;; (loadw ,lip ,function sb!vm:function-code-offset sb!vm:function-pointer-type)
-    (inst addi ,lip ,function (- (* n-word-bytes sb!vm:simple-fun-code-offset) sb!vm:fun-pointer-lowtag))
+    ;; (loadw ,lip ,function function-code-offset function-pointer-type)
+    (inst addi ,lip ,function (- (* n-word-bytes simple-fun-code-offset) fun-pointer-lowtag))
     (inst mtctr ,lip)
     (move code-tn ,function)
     (inst bctr)))
@@ -139,6 +139,8 @@
   Result-TN, 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) (temp-tn temp-tn) (flag-tn flag-tn)
              (type-code type-code) (size size))
     `(pseudo-atomic (,flag-tn :extra (pad-data-block ,size))
@@ -147,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)
@@ -216,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 ()
@@ -238,3 +249,12 @@
 
 
 
+
+(defmacro sb!sys::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?
+  `(without-gcing
+    ,@body))