X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmacros.lisp;h=c84757d9a790b322982ab43cb24117968d8dda83;hb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;hp=bb8a7347e1c9f9f86e40b741e2053d9f506f1244;hpb=e55399309ccb6c40b7ec4841c610d31c3fd487b6;p=sbcl.git diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index bb8a734..c84757d 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -201,53 +201,68 @@ (inst addi alloc-tn alloc-tn ,alloc-size) (inst add alloc-tn alloc-tn ,alloc-size)))) #!+gencgc - (let ((fix-addr (gensym)) - (inline-alloc (gensym))) - `(let ((,fix-addr (gen-label)) - (,inline-alloc (gen-label))) - ;; Make temp-tn be the size - (cond ((numberp ,size) - (inst lr ,temp-tn ,size)) - (t - (move ,temp-tn ,size))) - - (inst lr ,flag-tn (make-fixup "boxed_region" :foreign)) - (inst lwz ,result-tn ,flag-tn 0) - - ;; we can optimize this to only use one fixup here, once we get - ;; it working - ;; (inst lr ,flag-tn (make-fixup "boxed_region" :foreign 4)) - ;; (inst lwz ,flag-tn ,flag-tn 0) - (inst lwz ,flag-tn ,flag-tn 4) - - (without-scheduling () - ;; CAUTION: The C code depends on the exact order of - ;; instructions here. In particular, three instructions before - ;; the TW instruction must be an ADD or ADDI instruction, so it - ;; can figure out the size of the desired allocation. - ;; Now make result-tn point at the end of the object, to - ;; figure out if we overflowed the current region. - (inst add ,result-tn ,result-tn ,temp-tn) - ;; result-tn points to the new end of the region. Did we go past - ;; the actual end of the region? If so, we need a full alloc. - ;; The C code depends on this exact form of instruction. If - ;; either changes, you have to change the other appropriately! - (inst cmpw ,result-tn ,flag-tn) - - (inst bng ,inline-alloc) - (inst tw :lge ,result-tn ,flag-tn)) - (inst b ,fix-addr) - - (emit-label ,inline-alloc) + `(progn + ;; Make temp-tn be the size + (cond ((numberp ,size) + (inst lr ,temp-tn ,size)) + (t + (move ,temp-tn ,size))) + + #!-sb-thread + (inst lr ,flag-tn (make-fixup "boxed_region" :foreign)) + #!-sb-thread + (inst lwz ,result-tn ,flag-tn 0) + #!+sb-thread + (inst lwz ,result-tn thread-base-tn (* thread-alloc-region-slot + n-word-bytes)) + + ;; we can optimize this to only use one fixup here, once we get + ;; it working + ;; (inst lr ,flag-tn (make-fixup "boxed_region" :foreign 4)) + ;; (inst lwz ,flag-tn ,flag-tn 0) + #!-sb-thread + (inst lwz ,flag-tn ,flag-tn 4) + #!+sb-thread + (inst lwz ,flag-tn thread-base-tn (* (1+ thread-alloc-region-slot) + n-word-bytes)) + + (without-scheduling () + ;; CAUTION: The C code depends on the exact order of + ;; instructions here. In particular, immediately before the + ;; TW instruction must be an ADD or ADDI instruction, so it + ;; can figure out the size of the desired allocation and + ;; storing the new base pointer back to the allocation region + ;; must take two instructions (one on threaded targets). + + ;; Now make result-tn point at the end of the object, to + ;; figure out if we overflowed the current region. + (inst add ,result-tn ,result-tn ,temp-tn) + ;; result-tn points to the new end of the region. Did we go past + ;; the actual end of the region? If so, we need a full alloc. + ;; The C code depends on this exact form of instruction. If + ;; either changes, you have to change the other appropriately! + (inst tw :lge ,result-tn ,flag-tn) + + ;; The C code depends on this instruction sequence taking up + ;; #!-sb-thread three #!+sb-thread one machine instruction. + ;; The lr of a fixup counts as two instructions. + #!-sb-thread (inst lr ,flag-tn (make-fixup "boxed_region" :foreign)) + #!-sb-thread (inst stw ,result-tn ,flag-tn 0) + #!+sb-thread + (inst stw ,result-tn thread-base-tn (* thread-alloc-region-slot + n-word-bytes))) + + ;; Should the allocation trap above have fired, the runtime + ;; arranges for execution to resume here, just after where we + ;; would have updated the free pointer in the alloc region. - (emit-label ,fix-addr) - ;; At this point, result-tn points at the end of the object. - ;; Adjust to point to the beginning. - (inst sub ,result-tn ,result-tn ,temp-tn) - ;; Set the lowtag appropriately - (inst ori ,result-tn ,result-tn ,lowtag)))) + ;; At this point, result-tn points at the end of the object. + ;; Adjust to point to the beginning. + (inst sub ,result-tn ,result-tn ,temp-tn) + ;; Set the lowtag appropriately + (inst ori ,result-tn ,result-tn ,lowtag))) (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size &key (lowtag other-pointer-lowtag)) @@ -326,19 +341,18 @@ ;; Extra debugging stuff: #+debug (progn - (inst andi. ,flag-tn alloc-tn 7) + (inst andi. ,flag-tn alloc-tn lowtag-mask) (inst twi :ne ,flag-tn 0)) - (inst ori alloc-tn alloc-tn 4)) + (inst ori alloc-tn alloc-tn pseudo-atomic-flag)) ,@forms (without-scheduling () - (inst li ,flag-tn -5) - (inst and alloc-tn alloc-tn ,flag-tn) + (inst subi alloc-tn alloc-tn pseudo-atomic-flag) ;; Now test to see if the pseudo-atomic interrupted bit is set. - (inst andi. ,flag-tn alloc-tn 1) + (inst andi. ,flag-tn alloc-tn pseudo-atomic-interrupted-flag) (inst twi :ne ,flag-tn 0)) #+debug (progn - (inst andi. ,flag-tn alloc-tn 7) + (inst andi. ,flag-tn alloc-tn lowtag-mask) (inst twi :ne ,flag-tn 0)))) (def!macro with-pinned-objects ((&rest objects) &body body)