From: Nikodemus S. <de...@us...> - 2005-05-06 18:58:45
|
Update of /cvsroot/sbcl/sbcl/src/compiler/alpha In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv794/src/compiler/alpha Modified Files: macros.lisp Log Message: 0.9.0.22: more fixed allocation * fix remaining WITH-FIXED-ALLOCATIONS with empty bodies. NB: there seems to be some doubt whether this is actually the right thing to do, as CMUCL has at least in sparc/float.lisp in MOVE-FOO-FLOAT a commit message by William Lott indicating that this was intentional "to avoid handling a trap within P-A". Which trap that would be is unclear, but hopefully we will eventually rediscover the cases where this is intentional. * make WITH-FIXED-ALLOCATION signal a BUG if body is empty to catch this in the future. * sprinkle WITH-FIXED-ALLOCATION with FAIRY-D^WONCE-ONLY on platforms that didn't have it yet. Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/macros.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- macros.lisp 10 Nov 2003 23:26:37 -0000 1.18 +++ macros.lisp 6 May 2005 18:58:36 -0000 1.19 @@ -169,11 +169,14 @@ ;;; presumably initializes the object. (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) - (inst li (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,temp-tn) - (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) - ,@body)) + (unless body + (bug "empty &body in WITH-FIXED-ALLOCATION")) + (once-only ((result-tn result-tn) (temp-tn temp-tn) (size size)) + `(pseudo-atomic (:extra (pad-data-block ,size)) + (inst bis alloc-tn other-pointer-lowtag ,result-tn) + (inst li (logior (ash (1- ,size) n-widetag-bits) ,widetag) ,temp-tn) + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) + ,@body))) ;;;; error code (eval-when (:compile-toplevel :load-toplevel :execute) |