From: Nikodemus S. <de...@us...> - 2005-05-06 18:58:46
|
Update of /cvsroot/sbcl/sbcl/src/compiler/mips In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv794/src/compiler/mips Modified Files: alloc.lisp 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: alloc.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/alloc.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- alloc.lisp 4 May 2005 10:35:51 -0000 1.4 +++ alloc.lisp 6 May 2005 18:58:36 -0000 1.5 @@ -129,9 +129,8 @@ (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:results (result :scs (descriptor-reg))) (:generator 10 - (with-fixed-allocation - (result pa-flag temp value-cell-header-widetag value-cell-size)) - (storew value result value-cell-value-slot other-pointer-lowtag))) + (with-fixed-allocation (result pa-flag temp value-cell-header-widetag value-cell-size) + (storew value result value-cell-value-slot other-pointer-lowtag)))) ;;;; Automatic allocators for primitive objects. Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/macros.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- macros.lisp 4 May 2005 10:35:51 -0000 1.7 +++ macros.lisp 6 May 2005 18:58:37 -0000 1.8 @@ -142,12 +142,14 @@ Result-TN, Flag-Tn must be wired to NL4-OFFSET, 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." - `(pseudo-atomic (,flag-tn :extra (pad-data-block ,size)) - (inst or ,result-tn alloc-tn other-pointer-lowtag) - (inst li ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code)) - (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 (,flag-tn :extra (pad-data-block ,size)) + (inst or ,result-tn alloc-tn other-pointer-lowtag) + (inst li ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code)) + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) + ,@body))) ;;;; Three Way Comparison |