(inst ori ,result-tn ,result-tn ,lowtag)))
(defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size
- &key (lowtag other-pointer-lowtag))
+ &key (lowtag other-pointer-lowtag)
+ stack-allocate-p)
&body body)
"Do stuff to allocate an other-pointer object of fixed Size with a single
word header having the specified Type-Code. The result is placed in
(once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn)
(type-code type-code) (size size) (lowtag lowtag))
`(pseudo-atomic (,flag-tn)
- (allocation ,result-tn (pad-data-block ,size) ,lowtag
- :temp-tn ,temp-tn
- :flag-tn ,flag-tn)
+ (if ,stack-allocate-p
+ (progn
+ (align-csp ,temp-tn)
+ (inst ori ,result-tn csp-tn ,lowtag)
+ (inst addi csp-tn csp-tn (pad-data-block ,size)))
+ (allocation ,result-tn (pad-data-block ,size) ,lowtag
+ :temp-tn ,temp-tn
+ :flag-tn ,flag-tn))
(when ,type-code
(inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
(storew ,temp-tn ,result-tn 0 ,lowtag))
;;; trap if ALLOC-TN's negative (handling the deferred interrupt) and
;;; using FLAG-TN - minus the large constant - to correct ALLOC-TN.
(defmacro pseudo-atomic ((flag-tn) &body forms)
+ #!+sb-safepoint-strictly
+ `(progn ,flag-tn ,@forms (emit-safepoint))
+ #!-sb-safepoint-strictly
`(progn
(without-scheduling ()
;; Extra debugging stuff:
,@body)
#!+gencgc
`(let ((*pinned-objects* (list* ,@objects *pinned-objects*)))
+ (declare (truly-dynamic-extent *pinned-objects*))
,@body))