- (type-code type-code) (size size))
- `(pseudo-atomic (:extra (pad-data-block ,size))
- (inst move alloc-tn ,result-tn)
- (inst dep other-pointer-lowtag 31 3 ,result-tn)
- (inst li (logior (ash (1- ,size) n-widetag-bits) ,type-code) ,temp-tn)
- (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
- ,@body)))
+ (type-code type-code) (size size)
+ (lowtag lowtag))
+ (let ((write-body `((inst li (logior (ash (1- ,size) n-widetag-bits) ,type-code) ,temp-tn)
+ (storew ,temp-tn ,result-tn 0 ,lowtag))))
+ `(if ,dynamic-extent-p
+ (pseudo-atomic ()
+ (align-csp ,temp-tn)
+ (set-lowtag ,lowtag csp-tn ,result-tn)
+ (inst addi (pad-data-block ,size) csp-tn csp-tn)
+ ,@(if maybe-write
+ `((when ,type-code ,@write-body))
+ write-body)
+ ,@body)
+ (pseudo-atomic (:extra (pad-data-block ,size))
+ (set-lowtag ,lowtag alloc-tn ,result-tn)
+ ,@(if maybe-write
+ `((when ,type-code ,@write-body))
+ write-body)
+ ,@body)))))
+
+;;; is used for stack allocation of dynamic-extent objects
+;;; FIXME-lav, if using defun, atleast surround in assembly-form ? macro better ?
+(defun align-csp (temp)
+ (declare (ignore temp))
+ (let ((aligned (gen-label)))
+ (inst extru csp-tn 31 n-lowtag-bits zero-tn :<>)
+ (inst b aligned :nullify t)
+ (inst addi n-word-bytes csp-tn csp-tn)
+ (storew zero-tn csp-tn -1)
+ (emit-label aligned)))