+
+;;;; 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).
+(defmacro allocation (result-tn size lowtag &key stack-p temp-tn)
+ #!+gencgc
+ ;; 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).
+ (assert temp-tn)
+ ;; We assume we're in a pseudo-atomic so the pseudo-atomic bit is
+ ;; set.
+ `(cond
+ (,stack-p
+ ;; Stack allocation
+ ;;
+ ;; The control stack grows up, so round up CSP to a
+ ;; multiple of 8 (lispobj size). Use that as the
+ ;; allocation pointer. Then add SIZE bytes to the
+ ;; allocation and set CSP to that, so we have the desired
+ ;; space.
+
+ ;; Make sure the temp-tn is a non-descriptor register!
+ (assert (and ,temp-tn (sc-is ,temp-tn non-descriptor-reg)))
+
+ ;; temp-tn is csp-tn rounded up to a multiple of 8 (lispobj size)
+ (align-csp ,temp-tn)
+ ;; For the benefit of future historians, this is how CMUCL does the
+ ;; align-csp (I think their version is branch free only because
+ ;; they simply don't worry about zeroing the pad word):
+ #+nil (inst add ,temp-tn csp-tn sb!vm:lowtag-mask)
+ #+nil (inst andn ,temp-tn sb!vm:lowtag-mask)
+
+ ;; Set the result to temp-tn, with appropriate lowtag
+ (inst or ,result-tn csp-tn ,lowtag)
+
+ ;; Allocate the desired space on the stack.
+ ;;
+ ;; FIXME: Can't allocate on stack if SIZE is too large.
+ ;; Need to rearrange this code.
+ (inst add csp-tn ,size))
+
+ #!-gencgc
+ ;; Normal allocation to the heap -- cheneygc version.
+ ;;
+ ;; On cheneygc, the alloc-tn currently has the pseudo-atomic bit.
+ ;; If the lowtag also has a 1 bit in the same position, we're all set.
+ ;;
+ ;; See comment in PSEUDO-ATOMIC-FLAG.
+ ((logbitp (1- n-lowtag-bits) ,lowtag)
+ (inst or ,result-tn alloc-tn ,lowtag)
+ (inst add alloc-tn ,size))
+ ;;
+ ;; Otherwise, we need to zap out the lowtag from alloc-tn, and then
+ ;; or in the lowtag.
+ #!-gencgc
+ (t
+ (inst andn ,result-tn alloc-tn lowtag-mask)
+ (inst or ,result-tn ,lowtag)
+ (inst add alloc-tn ,size))
+
+ ;; Normal allocation to the heap -- gencgc version.
+ ;;
+ ;; No need to worry about lowtag bits matching up here, since
+ ;; alloc-tn is just a "pseudo-atomic-bit-tn" now and we don't read
+ ;; it.
+ #!+gencgc
+ (t
+ (inst li ,temp-tn (make-fixup "boxed_region" :foreign))
+ (loadw ,result-tn ,temp-tn 0) ;boxed_region.free_pointer
+ (loadw ,temp-tn ,temp-tn 1) ;boxed_region.end_addr
+
+ (without-scheduling ()
+ (let ((done (gen-label))
+ (full-alloc (gen-label)))
+ ;; See if we can do an inline allocation. The updated
+ ;; free pointer should not point past the end of the
+ ;; current region. If it does, a full alloc needs to be
+ ;; done.
+ (inst add ,result-tn ,size)
+
+ ;; result-tn points to the new end of region. Did we go
+ ;; past the actual end of the region? If so, we need a
+ ;; full alloc.
+ (inst cmp ,result-tn ,temp-tn)
+ (if (member :sparc-v9 *backend-subfeatures*)
+ (inst b :gtu full-alloc :pn)
+ (inst b :gtu full-alloc))
+ (inst nop)
+ ;; Inline allocation worked, so update the free pointer
+ ;; and go. Should really do a swap instruction here to
+ ;; swap memory with a register.
+
+ ;; Kludge: We ought to have two distinct FLAG-TN and TEMP-TN
+ ;; here, to avoid the SUB and the TEMP-TN reload which is
+ ;; causing it. PPC gets it right.
+ (inst li ,temp-tn (make-fixup "boxed_region" :foreign))
+ (storew ,result-tn ,temp-tn 0)
+
+ (inst b done)
+ (inst sub ,result-tn ,size)
+
+ (emit-label full-alloc)
+ ;; Full alloc via trap to the C allocator. Tell the
+ ;; allocator what the result-tn and size are, using the
+ ;; OR instruction. Then trap to the allocator.
+ (inst or zero-tn ,result-tn ,size)
+ ;; DFL: Not certain why we use two kinds of traps: T for p/a
+ ;; and UNIMP for all other traps. But the C code in the runtime
+ ;; for the UNIMP case is a lot nicer, so I'm hooking into that.
+ ;; (inst t :t allocation-trap)
+ (inst unimp allocation-trap)
+
+ (emit-label done)
+ ;; Set lowtag appropriately
+ (inst or ,result-tn ,lowtag))))))
+