From 4578e13fb087400cc682d8cded4d28ffcfdcecf1 Mon Sep 17 00:00:00 2001 From: Patrik Nordebo Date: Wed, 24 Sep 2003 20:03:12 +0000 Subject: [PATCH] 0.8.3.90.ppc_gencgc_branch.1: * Replaced all allocation in vops/assembly with a single allocation macro. Both nice for somewhat cleaning up code, and making it far easier to change how allocation is done. --- src/assembly/ppc/arith.lisp | 9 +++---- src/assembly/ppc/array.lisp | 3 +-- src/compiler/ppc/alloc.lisp | 34 +++++++++--------------- src/compiler/ppc/array.lisp | 11 ++++---- src/compiler/ppc/call.lisp | 6 ++--- src/compiler/ppc/macros.lisp | 50 +++++++++++++++++++++++++++++++++--- src/compiler/ppc/move.lisp | 11 +++----- version.lisp-expr | 2 +- 8 files changed, 75 insertions(+), 51 deletions(-) diff --git a/src/assembly/ppc/arith.lisp b/src/assembly/ppc/arith.lisp index 8cb8c42bb..7e90010ce 100644 --- a/src/assembly/ppc/arith.lisp +++ b/src/assembly/ppc/arith.lisp @@ -152,18 +152,17 @@ (inst bns GO-HOME) CONS-BIGNUM - ;; Allocate a BIGNUM for the result. - (pseudo-atomic (pa-flag :extra (pad-data-block (1+ bignum-digits-offset))) + ;; Allocate a BIGNUM for the result. Note that we always allocate + ;; two words, even if only one is needed. This is so we can use the + ;; standard allocation macros. + (with-fixed-allocation (res pa-flag temp bignum-widetag (pad-data-block (+ bignum-digits-offset 2))) (let ((one-word (gen-label))) - (inst ori res alloc-tn other-pointer-lowtag) ;; We start out assuming that we need one word. Is that correct? (inst srawi temp lo 31) (inst xor. temp temp hi) (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) (inst beq one-word) ;; Nope, we need two, so allocate the additional space. - (inst addi alloc-tn alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset)) - (pad-data-block (1+ bignum-digits-offset)))) (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag) (emit-label one-word) diff --git a/src/assembly/ppc/array.lisp b/src/assembly/ppc/array.lisp index 4b68ace9c..edcdd3e7b 100644 --- a/src/assembly/ppc/array.lisp +++ b/src/assembly/ppc/array.lisp @@ -27,10 +27,9 @@ (:temp pa-flag non-descriptor-reg nl3-offset) (:temp vector descriptor-reg a3-offset)) (pseudo-atomic (pa-flag) - (inst ori vector alloc-tn sb!vm:other-pointer-lowtag) (inst addi ndescr words (* (1+ sb!vm:vector-data-offset) sb!vm:n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) + (allocation vector ndescr sb!vm:other-pointer-lowtag) (inst srwi ndescr type sb!vm:word-shift) (storew ndescr vector 0 sb!vm:other-pointer-lowtag) (storew length vector sb!vm:vector-length-slot sb!vm:other-pointer-lowtag)) diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp index 43f3bc9fa..d527b4aab 100644 --- a/src/compiler/ppc/alloc.lisp +++ b/src/compiler/ppc/alloc.lisp @@ -35,9 +35,8 @@ temp))))) (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) - (pseudo-atomic (pa-flag :extra alloc) - (inst clrrwi res alloc-tn n-lowtag-bits) - (inst ori res res list-pointer-lowtag) + (pseudo-atomic (pa-flag) + (allocation res alloc list-pointer-lowtag) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -69,6 +68,7 @@ (unboxed-arg :scs (any-reg))) (:results (result :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) size) (:temporary (:scs (any-reg) :from (:argument 0)) boxed) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) @@ -82,9 +82,8 @@ ;; Note: we don't have to subtract off the 4 that was added by ;; pseudo-atomic, because oring in other-pointer-lowtag just adds ;; it right back. - (inst ori result alloc-tn other-pointer-lowtag) - (inst add alloc-tn alloc-tn boxed) - (inst add alloc-tn alloc-tn unboxed) + (inst add size boxed unboxed) + (allocation result size other-pointer-lowtag) (inst slwi ndescr boxed (- n-widetag-bits word-shift)) (inst ori ndescr ndescr code-header-widetag) (storew ndescr result 0 other-pointer-lowtag) @@ -115,9 +114,9 @@ (:results (result :scs (descriptor-reg))) (:generator 10 (let ((size (+ length closure-info-offset))) - (pseudo-atomic (pa-flag :extra (pad-data-block size)) - (inst clrrwi. result alloc-tn n-lowtag-bits) - (inst ori result result fun-pointer-lowtag) + (pseudo-atomic (pa-flag) + (allocation result (pad-data-block size) + fun-pointer-lowtag) (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag)) (storew temp result 0 fun-pointer-lowtag))) ;(inst lis temp (ash 18 10)) @@ -154,12 +153,8 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:generator 4 - (pseudo-atomic (pa-flag :extra (pad-data-block words)) - (cond ((logbitp 2 lowtag) - (inst ori result alloc-tn lowtag)) - (t - (inst clrrwi result alloc-tn n-lowtag-bits) - (inst ori result result lowtag))) + (pseudo-atomic (pa-flag) + (allocation result (pad-data-block words) lowtag) (when type (inst lr temp (logior (ash (1- words) n-widetag-bits) type)) (storew temp result 0 lowtag))))) @@ -178,10 +173,5 @@ (inst addi header header (+ (ash -2 n-widetag-bits) type)) (inst clrrwi bytes bytes n-lowtag-bits) (pseudo-atomic (pa-flag) - (cond ((logbitp 2 lowtag) - (inst ori result alloc-tn lowtag)) - (t - (inst clrrwi result alloc-tn n-lowtag-bits) - (inst ori result result lowtag))) - (storew header result 0 lowtag) - (inst add alloc-tn alloc-tn bytes)))) + (allocation result bytes lowtag) + (storew header result 0 lowtag)))) diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index a00f0adfd..3890be5bd 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -26,15 +26,14 @@ (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic (pa-flag) - (inst ori header alloc-tn other-pointer-lowtag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes)) + (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset))) - (inst slwi ndescr ndescr sb!vm:n-widetag-bits) + (allocation header ndescr other-pointer-lowtag) + (inst addi ndescr rank (fixnumize (1- array-dimensions-offset))) + (inst slwi ndescr ndescr n-widetag-bits) (inst or ndescr ndescr type) (inst srwi ndescr ndescr 2) - (storew ndescr header 0 sb!vm:other-pointer-lowtag)) + (storew ndescr header 0 other-pointer-lowtag)) (move result header))) diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index 28f90882b..9acb3796b 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -1122,11 +1122,9 @@ default-value-8 (pseudo-atomic (pa-flag) (assemble () ;; Allocate a cons (2 words) for each item. - (inst clrrwi result alloc-tn n-lowtag-bits) - (inst ori result result list-pointer-lowtag) - (move dst result) (inst slwi temp count 1) - (inst add alloc-tn alloc-tn temp) + (allocation result temp list-pointer-lowtag) + (move dst result) (inst b enter) ;; Compute the next cons and store it in the current one. diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index bb38e530f..df49f2ffe 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -132,6 +132,45 @@ ;;;; Storage allocation: + +;; Allocation macro +;; +;; This macro does the appropriate stuff to allocate space. +;; +;; The allocated space is stored in RESULT-TN with the lowtag LOWTAG +;; applied. The amount of space to be allocated is SIZE bytes (which +;; must be a multiple of the lisp object size). +;; +;; If STACK-P is given, then allocation occurs on the control stack +;; (for dynamic-extent). In this case, you MUST also specify NODE, so +;; that the appropriate compiler policy can be used, and TEMP-TN, +;; which is needed for work-space. TEMP-TN MUST be a non-descriptor +;; reg. +;; +;; If generational GC is enabled, you MUST supply a value for TEMP-TN +;; because a temp register is needed to do inline allocation. +;; TEMP-TN, in this case, can be any register, since it holds a +;; double-word aligned address (essentially a fixnum). +(defmacro allocation (result-tn size lowtag &key stack-p node temp-tn) + ;; We assume we're in a pseudo-atomic so the pseudo-atomic bit is + ;; set. If the lowtag also has a 1 bit in the same position, we're all + ;; set. Otherwise, we need to zap out the lowtag from alloc-tn, and + ;; then or in the lowtag. + ;; Normal allocation to the heap. + `(let ((size ,size)) + (if (logbitp (1- n-lowtag-bits) ,lowtag) + (progn + (inst ori ,result-tn alloc-tn ,lowtag) + (if (numberp size) + (inst addi alloc-tn alloc-tn size) + (inst add alloc-tn alloc-tn size))) + (progn + (inst clrrwi ,result-tn alloc-tn n-lowtag-bits) + (inst ori ,result-tn ,result-tn ,lowtag) + (if (numberp size) + (inst addi alloc-tn alloc-tn size) + (inst add alloc-tn alloc-tn size)))))) + (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 @@ -141,10 +180,11 @@ initializes the object." (once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn) (type-code type-code) (size size)) - `(pseudo-atomic (,flag-tn :extra (pad-data-block ,size)) - (inst ori ,result-tn alloc-tn other-pointer-lowtag) - (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code)) - (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) + `(pseudo-atomic (,flag-tn) + (allocation ,result-tn (pad-data-block ,size) other-pointer-lowtag) + (when ,type-code + (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code)) + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)) ,@body))) @@ -247,3 +287,5 @@ garbage collection. This is currently implemented by disabling GC" (declare (ignore objects)) ;should we eval these for side-effect? `(without-gcing ,@body)) + + diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp index 8d00afcb9..b0ea87e8e 100644 --- a/src/compiler/ppc/move.lisp +++ b/src/compiler/ppc/move.lisp @@ -235,22 +235,19 @@ (move x arg) (let ((done (gen-label)) (one-word (gen-label)) - (initial-alloc (pad-data-block (1+ bignum-digits-offset)))) + ;; We always allocate 2 words even if we only need one it. (The + ;; copying GC will take care of freeing the unused extra word.) + (initial-alloc (+ bignum-digits-offset 2))) (inst srawi. temp x 29) (inst slwi y x 2) (inst beq done) - (pseudo-atomic (pa-flag :extra initial-alloc) + (with-fixed-allocation (y pa-flag temp bignum-widetag initial-alloc) (inst cmpwi x 0) - (inst ori y alloc-tn other-pointer-lowtag) (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) (inst bge one-word) - (inst addi alloc-tn alloc-tn - (- (pad-data-block (+ bignum-digits-offset 2)) - (pad-data-block (+ bignum-digits-offset 1)))) (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) (emit-label one-word) - (storew temp y 0 other-pointer-lowtag) (storew x y bignum-digits-offset other-pointer-lowtag)) (emit-label done)))) ;;; diff --git a/version.lisp-expr b/version.lisp-expr index 47d55fcf8..f59d180da 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.90" +"0.8.3.90.ppc_gencgc_branch.1"