X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmacros.lisp;h=a4da8d3a0b9ec53bc4701e67ee854f1b269fb2f2;hb=eb5265ab22a2b1cae18bbdf43c871dba9b5927ea;hp=e8c5cdfe1798964660985d3b524efdcd7bcb9376;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index e8c5cdf..a4da8d3 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -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))) @@ -197,8 +197,7 @@ 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." - (let ((continue (gensym "CONTINUE-LABEL-")) - (error (gensym "ERROR-LABEL-"))) + (with-unique-names (continue error) `(let ((,continue (gen-label))) (emit-label ,continue) (assemble (*elsewhere*) @@ -206,18 +205,17 @@ (emit-label ,error) (cerror-call ,vop ,continue ,error-code ,@values) ,error))))) - - -;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic. +;;;; PSEUDO-ATOMIC + +;;; handy macro for making sequences look atomic ;;; -;;; flag-tn must be wired to NL3. If a deferred interrupt happens -;;; while we have the low bits of alloc-tn set, we add a "large" -;;; constant to flag-tn. On exit, we add flag-tn to alloc-tn -;;; which (a) 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. +;;; FLAG-TN must be wired to NL3. If a deferred interrupt happens +;;; while we have the low bits of ALLOC-TN set, we add a "large" +;;; constant to FLAG-TN. On exit, we add FLAG-TN to ALLOC-TN which (a) +;;; 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) (let ((n-extra (gensym))) `(let ((,n-extra ,extra)) @@ -240,3 +238,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))