Skip to content
This repository
Browse code

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.
  • Loading branch information...
commit 4578e13fb087400cc682d8cded4d28ffcfdcecf1 1 parent 89823a0
patrikn patrikn authored
9 src/assembly/ppc/arith.lisp
@@ -152,18 +152,17 @@
152 152 (inst bns GO-HOME)
153 153
154 154 CONS-BIGNUM
155   - ;; Allocate a BIGNUM for the result.
156   - (pseudo-atomic (pa-flag :extra (pad-data-block (1+ bignum-digits-offset)))
  155 + ;; Allocate a BIGNUM for the result. Note that we always allocate
  156 + ;; two words, even if only one is needed. This is so we can use the
  157 + ;; standard allocation macros.
  158 + (with-fixed-allocation (res pa-flag temp bignum-widetag (pad-data-block (+ bignum-digits-offset 2)))
157 159 (let ((one-word (gen-label)))
158   - (inst ori res alloc-tn other-pointer-lowtag)
159 160 ;; We start out assuming that we need one word. Is that correct?
160 161 (inst srawi temp lo 31)
161 162 (inst xor. temp temp hi)
162 163 (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
163 164 (inst beq one-word)
164 165 ;; Nope, we need two, so allocate the additional space.
165   - (inst addi alloc-tn alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset))
166   - (pad-data-block (1+ bignum-digits-offset))))
167 166 (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
168 167 (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
169 168 (emit-label one-word)
3  src/assembly/ppc/array.lisp
@@ -27,10 +27,9 @@
27 27 (:temp pa-flag non-descriptor-reg nl3-offset)
28 28 (:temp vector descriptor-reg a3-offset))
29 29 (pseudo-atomic (pa-flag)
30   - (inst ori vector alloc-tn sb!vm:other-pointer-lowtag)
31 30 (inst addi ndescr words (* (1+ sb!vm:vector-data-offset) sb!vm:n-word-bytes))
32 31 (inst clrrwi ndescr ndescr n-lowtag-bits)
33   - (inst add alloc-tn alloc-tn ndescr)
  32 + (allocation vector ndescr sb!vm:other-pointer-lowtag)
34 33 (inst srwi ndescr type sb!vm:word-shift)
35 34 (storew ndescr vector 0 sb!vm:other-pointer-lowtag)
36 35 (storew length vector sb!vm:vector-length-slot sb!vm:other-pointer-lowtag))
34 src/compiler/ppc/alloc.lisp
@@ -35,9 +35,8 @@
35 35 temp)))))
36 36 (let* ((cons-cells (if star (1- num) num))
37 37 (alloc (* (pad-data-block cons-size) cons-cells)))
38   - (pseudo-atomic (pa-flag :extra alloc)
39   - (inst clrrwi res alloc-tn n-lowtag-bits)
40   - (inst ori res res list-pointer-lowtag)
  38 + (pseudo-atomic (pa-flag)
  39 + (allocation res alloc list-pointer-lowtag)
41 40 (move ptr res)
42 41 (dotimes (i (1- cons-cells))
43 42 (storew (maybe-load (tn-ref-tn things)) ptr
@@ -69,6 +68,7 @@
69 68 (unboxed-arg :scs (any-reg)))
70 69 (:results (result :scs (descriptor-reg)))
71 70 (:temporary (:scs (non-descriptor-reg)) ndescr)
  71 + (:temporary (:scs (non-descriptor-reg)) size)
72 72 (:temporary (:scs (any-reg) :from (:argument 0)) boxed)
73 73 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed)
74 74 (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
@@ -82,9 +82,8 @@
82 82 ;; Note: we don't have to subtract off the 4 that was added by
83 83 ;; pseudo-atomic, because oring in other-pointer-lowtag just adds
84 84 ;; it right back.
85   - (inst ori result alloc-tn other-pointer-lowtag)
86   - (inst add alloc-tn alloc-tn boxed)
87   - (inst add alloc-tn alloc-tn unboxed)
  85 + (inst add size boxed unboxed)
  86 + (allocation result size other-pointer-lowtag)
88 87 (inst slwi ndescr boxed (- n-widetag-bits word-shift))
89 88 (inst ori ndescr ndescr code-header-widetag)
90 89 (storew ndescr result 0 other-pointer-lowtag)
@@ -115,9 +114,9 @@
115 114 (:results (result :scs (descriptor-reg)))
116 115 (:generator 10
117 116 (let ((size (+ length closure-info-offset)))
118   - (pseudo-atomic (pa-flag :extra (pad-data-block size))
119   - (inst clrrwi. result alloc-tn n-lowtag-bits)
120   - (inst ori result result fun-pointer-lowtag)
  117 + (pseudo-atomic (pa-flag)
  118 + (allocation result (pad-data-block size)
  119 + fun-pointer-lowtag)
121 120 (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag))
122 121 (storew temp result 0 fun-pointer-lowtag)))
123 122 ;(inst lis temp (ash 18 10))
@@ -154,12 +153,8 @@
154 153 (:temporary (:scs (non-descriptor-reg)) temp)
155 154 (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
156 155 (:generator 4
157   - (pseudo-atomic (pa-flag :extra (pad-data-block words))
158   - (cond ((logbitp 2 lowtag)
159   - (inst ori result alloc-tn lowtag))
160   - (t
161   - (inst clrrwi result alloc-tn n-lowtag-bits)
162   - (inst ori result result lowtag)))
  156 + (pseudo-atomic (pa-flag)
  157 + (allocation result (pad-data-block words) lowtag)
163 158 (when type
164 159 (inst lr temp (logior (ash (1- words) n-widetag-bits) type))
165 160 (storew temp result 0 lowtag)))))
@@ -178,10 +173,5 @@
178 173 (inst addi header header (+ (ash -2 n-widetag-bits) type))
179 174 (inst clrrwi bytes bytes n-lowtag-bits)
180 175 (pseudo-atomic (pa-flag)
181   - (cond ((logbitp 2 lowtag)
182   - (inst ori result alloc-tn lowtag))
183   - (t
184   - (inst clrrwi result alloc-tn n-lowtag-bits)
185   - (inst ori result result lowtag)))
186   - (storew header result 0 lowtag)
187   - (inst add alloc-tn alloc-tn bytes))))
  176 + (allocation result bytes lowtag)
  177 + (storew header result 0 lowtag))))
11 src/compiler/ppc/array.lisp
@@ -26,15 +26,14 @@
26 26 (:results (result :scs (descriptor-reg)))
27 27 (:generator 0
28 28 (pseudo-atomic (pa-flag)
29   - (inst ori header alloc-tn other-pointer-lowtag)
30   - (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes))
  29 + (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
31 30 (inst clrrwi ndescr ndescr n-lowtag-bits)
32   - (inst add alloc-tn alloc-tn ndescr)
33   - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset)))
34   - (inst slwi ndescr ndescr sb!vm:n-widetag-bits)
  31 + (allocation header ndescr other-pointer-lowtag)
  32 + (inst addi ndescr rank (fixnumize (1- array-dimensions-offset)))
  33 + (inst slwi ndescr ndescr n-widetag-bits)
35 34 (inst or ndescr ndescr type)
36 35 (inst srwi ndescr ndescr 2)
37   - (storew ndescr header 0 sb!vm:other-pointer-lowtag))
  36 + (storew ndescr header 0 other-pointer-lowtag))
38 37 (move result header)))
39 38
40 39
6 src/compiler/ppc/call.lisp
@@ -1122,11 +1122,9 @@ default-value-8
1122 1122 (pseudo-atomic (pa-flag)
1123 1123 (assemble ()
1124 1124 ;; Allocate a cons (2 words) for each item.
1125   - (inst clrrwi result alloc-tn n-lowtag-bits)
1126   - (inst ori result result list-pointer-lowtag)
1127   - (move dst result)
1128 1125 (inst slwi temp count 1)
1129   - (inst add alloc-tn alloc-tn temp)
  1126 + (allocation result temp list-pointer-lowtag)
  1127 + (move dst result)
1130 1128 (inst b enter)
1131 1129
1132 1130 ;; Compute the next cons and store it in the current one.
50 src/compiler/ppc/macros.lisp
@@ -132,6 +132,45 @@
132 132
133 133
134 134 ;;;; Storage allocation:
  135 +
  136 +;; Allocation macro
  137 +;;
  138 +;; This macro does the appropriate stuff to allocate space.
  139 +;;
  140 +;; The allocated space is stored in RESULT-TN with the lowtag LOWTAG
  141 +;; applied. The amount of space to be allocated is SIZE bytes (which
  142 +;; must be a multiple of the lisp object size).
  143 +;;
  144 +;; If STACK-P is given, then allocation occurs on the control stack
  145 +;; (for dynamic-extent). In this case, you MUST also specify NODE, so
  146 +;; that the appropriate compiler policy can be used, and TEMP-TN,
  147 +;; which is needed for work-space. TEMP-TN MUST be a non-descriptor
  148 +;; reg.
  149 +;;
  150 +;; If generational GC is enabled, you MUST supply a value for TEMP-TN
  151 +;; because a temp register is needed to do inline allocation.
  152 +;; TEMP-TN, in this case, can be any register, since it holds a
  153 +;; double-word aligned address (essentially a fixnum).
  154 +(defmacro allocation (result-tn size lowtag &key stack-p node temp-tn)
  155 + ;; We assume we're in a pseudo-atomic so the pseudo-atomic bit is
  156 + ;; set. If the lowtag also has a 1 bit in the same position, we're all
  157 + ;; set. Otherwise, we need to zap out the lowtag from alloc-tn, and
  158 + ;; then or in the lowtag.
  159 + ;; Normal allocation to the heap.
  160 + `(let ((size ,size))
  161 + (if (logbitp (1- n-lowtag-bits) ,lowtag)
  162 + (progn
  163 + (inst ori ,result-tn alloc-tn ,lowtag)
  164 + (if (numberp size)
  165 + (inst addi alloc-tn alloc-tn size)
  166 + (inst add alloc-tn alloc-tn size)))
  167 + (progn
  168 + (inst clrrwi ,result-tn alloc-tn n-lowtag-bits)
  169 + (inst ori ,result-tn ,result-tn ,lowtag)
  170 + (if (numberp size)
  171 + (inst addi alloc-tn alloc-tn size)
  172 + (inst add alloc-tn alloc-tn size))))))
  173 +
135 174 (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size)
136 175 &body body)
137 176 "Do stuff to allocate an other-pointer object of fixed Size with a single
@@ -141,10 +180,11 @@
141 180 initializes the object."
142 181 (once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn)
143 182 (type-code type-code) (size size))
144   - `(pseudo-atomic (,flag-tn :extra (pad-data-block ,size))
145   - (inst ori ,result-tn alloc-tn other-pointer-lowtag)
146   - (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
147   - (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
  183 + `(pseudo-atomic (,flag-tn)
  184 + (allocation ,result-tn (pad-data-block ,size) other-pointer-lowtag)
  185 + (when ,type-code
  186 + (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
  187 + (storew ,temp-tn ,result-tn 0 other-pointer-lowtag))
148 188 ,@body)))
149 189
150 190
@@ -247,3 +287,5 @@ garbage collection. This is currently implemented by disabling GC"
247 287 (declare (ignore objects)) ;should we eval these for side-effect?
248 288 `(without-gcing
249 289 ,@body))
  290 +
  291 +
11 src/compiler/ppc/move.lisp
@@ -235,22 +235,19 @@
235 235 (move x arg)
236 236 (let ((done (gen-label))
237 237 (one-word (gen-label))
238   - (initial-alloc (pad-data-block (1+ bignum-digits-offset))))
  238 + ;; We always allocate 2 words even if we only need one it. (The
  239 + ;; copying GC will take care of freeing the unused extra word.)
  240 + (initial-alloc (+ bignum-digits-offset 2)))
239 241 (inst srawi. temp x 29)
240 242 (inst slwi y x 2)
241 243 (inst beq done)
242 244
243   - (pseudo-atomic (pa-flag :extra initial-alloc)
  245 + (with-fixed-allocation (y pa-flag temp bignum-widetag initial-alloc)
244 246 (inst cmpwi x 0)
245   - (inst ori y alloc-tn other-pointer-lowtag)
246 247 (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
247 248 (inst bge one-word)
248   - (inst addi alloc-tn alloc-tn
249   - (- (pad-data-block (+ bignum-digits-offset 2))
250   - (pad-data-block (+ bignum-digits-offset 1))))
251 249 (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
252 250 (emit-label one-word)
253   - (storew temp y 0 other-pointer-lowtag)
254 251 (storew x y bignum-digits-offset other-pointer-lowtag))
255 252 (emit-label done))))
256 253 ;;;
2  version.lisp-expr
@@ -17,4 +17,4 @@
17 17 ;;; checkins which aren't released. (And occasionally for internal
18 18 ;;; versions, especially for internal versions off the main CVS
19 19 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
20   -"0.8.3.90"
  20 +"0.8.3.90.ppc_gencgc_branch.1"

0 comments on commit 4578e13

Please sign in to comment.
Something went wrong with that request. Please try again.