X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Falpha%2Fmacros.lisp;h=d472eefa81b9560945ba2319a890c14dcc03e5e4;hb=f9ef8b045b60ae064c7bd40af599b46707ea4d8a;hp=26ac591d632c6ed3a9313500bf7f0da082cac9a2;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 26ac591..d472eef 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") -;;; a handy macro for defining top-level forms that depend on the +;;; a handy macro for defining top level forms that depend on the ;;; compile environment (defmacro expand (expr) (let ((gensym (gensym))) @@ -167,7 +167,7 @@ ;;; 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. -(defmacro with-fixed-allocation ((result-tn temp-tn widetagsize) +(defmacro with-fixed-allocation ((result-tn temp-tn widetag size) &body body) `(pseudo-atomic (:extra (pad-data-block ,size)) (inst bis alloc-tn other-pointer-lowtag ,result-tn) @@ -176,21 +176,6 @@ ,@body)) ;;;; 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)))) - (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))) @@ -200,12 +185,12 @@ (inst gentrap ,kind) (with-adjustable-vector (,vector) (write-var-integer (error-number-or-lose ',code) ,vector) - ,@(mapcar #'(lambda (tn) - `(let ((tn ,tn)) - (write-var-integer (make-sc-offset (sc-number - (tn-sc tn)) - (tn-offset tn)) - ,vector))) + ,@(mapcar (lambda (tn) + `(let ((tn ,tn)) + (write-var-integer (make-sc-offset (sc-number + (tn-sc tn)) + (tn-offset tn)) + ,vector))) values) (inst byte (length ,vector)) (dotimes (i (length ,vector)) @@ -250,28 +235,15 @@ ,error))))) -;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic. -;;; +;;; a handy macro for making sequences look atomic (defmacro pseudo-atomic ((&key (extra 0)) &rest forms) `(progn (inst addq alloc-tn 1 alloc-tn) ,@forms (inst lda alloc-tn (1- ,extra) alloc-tn) (inst stl zero-tn 0 alloc-tn))) - - -;;;; Memory accessor vop generators - -(deftype load/store-index (scale lowtag min-offset - &optional (max-offset min-offset)) - `(integer ,(- (truncate (+ (ash 1 16) - (* min-offset n-word-bytes) - (- lowtag)) - scale)) - ,(truncate (- (+ (1- (ash 1 16)) lowtag) - (* max-offset n-word-bytes)) - scale))) +;;;; memory accessor vop generators (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) @@ -309,7 +281,7 @@ '((inst mskll value 4 value))))))) (defmacro define-full-setter (name type offset lowtag scs el-type - &optional translate #+gengc (remember t)) + &optional translate #!+gengc (remember t)) `(progn (define-vop (,name) ,@(when translate