X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmacros.lisp;h=230bde16554e994e6bb04817c24b7514ec191940;hb=c7de1989d006e0b3a4f26143b7a81c9bdb754101;hp=2dfb14be891c802b7396eb64f886661f418bca3f;hpb=7ce4dc62a7b03590b127bb950738e771e33341a7;p=sbcl.git diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index 2dfb14b..230bde1 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -102,10 +102,7 @@ ;;;; Stack TN's -;;; Load-Stack-TN, Store-Stack-TN -- Interface -;;; -;;; Move a stack TN to a register and vice-versa. -;;; +;;; Move a stack TN to a register and vice-versa. (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -113,7 +110,6 @@ (sc-case stack ((control-stack) (loadw reg cfp-tn offset)))))) - (defmacro store-stack-tn (stack reg) `(let ((stack ,stack) (reg ,reg)) @@ -122,9 +118,6 @@ ((control-stack) (storew reg cfp-tn offset)))))) - -;;; MAYBE-LOAD-STACK-TN -- Interface -;;; (defmacro maybe-load-stack-tn (reg reg-or-stack) "Move the TN Reg-Or-Stack into Reg if it isn't already there." (once-only ((n-reg reg) @@ -139,7 +132,6 @@ ;;;; Storage allocation: - (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -157,22 +149,6 @@ ;;;; Error Code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) @@ -221,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*) @@ -230,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))