Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
  • 1 commit
  • 8 files changed
  • 0 commit comments
  • 1 contributor
Commits on Sep 24, 2003
@patrikn patrikn 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.
4578e13
View
9 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)
View
3  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))
View
34 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))))
View
11 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)))
View
6 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.
View
50 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))
+
+
View
11 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))))
;;;
View
2  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"

No commit comments for this range

Something went wrong with that request. Please try again.