(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)))
"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)))
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))
(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)
;;; 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 ()
+
+(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))