(in-package "SB!VM")
-;;; We can load/store into fp registers through the top of stack
-;;; %st(0) (fr0 here). Loads imply a push to an empty register which
-;;; then changes all the reg numbers. These macros help manage that.
-
-;;; Use this when we don't have to load anything. It preserves old tos
-;;; value, but probably destroys tn with operation.
-(defmacro with-tn@fp-top((tn) &body body)
- `(progn
- (unless (zerop (tn-offset ,tn))
- (inst fxch ,tn))
- ,@body
- (unless (zerop (tn-offset ,tn))
- (inst fxch ,tn))))
-
-;;; Use this to prepare for load of new value from memory. This
-;;; changes the register numbering so the next instruction had better
-;;; be a FP load from memory; a register load from another register
-;;; will probably be loading the wrong register!
-(defmacro with-empty-tn@fp-top((tn) &body body)
- `(progn
- (inst fstp ,tn)
- ,@body
- (unless (zerop (tn-offset ,tn))
- (inst fxch ,tn)))) ; save into new dest and restore st(0)
-\f
;;;; instruction-like macros
(defmacro move (dst src)
;;; node-var then it is used to make an appropriate speed vs size
;;; decision.
+(defun allocation-dynamic-extent (alloc-tn size)
+ (inst sub rsp-tn size)
+ ;; see comment in x86/macros.lisp implementation of this
+ (inst and rsp-tn #.(lognot lowtag-mask))
+ (aver (not (location= alloc-tn rsp-tn)))
+ (inst mov alloc-tn rsp-tn)
+ (values))
+
;;; This macro should only be used inside a pseudo-atomic section,
;;; which should also cover subsequent initialization of the
;;; object.
(inst pop alloc-tn)
(values))
-(defun allocation (alloc-tn size &optional ignored)
+(defun allocation (alloc-tn size &optional ignored dynamic-extent)
(declare (ignore ignored))
+ (when dynamic-extent
+ (allocation-dynamic-extent alloc-tn size)
+ (return-from allocation (values)))
(let ((NOT-INLINE (gen-label))
(DONE (gen-label))
;; Yuck.
;;; the ATOMIC bit is bit 0, the INTERRUPTED bit is bit 1, and you check
;;; the C flag after the shift to see whether you were interrupted.
+;;; FIXME: THIS NAME IS BACKWARDS!
+(defmacro maybe-pseudo-atomic (really-p &body body)
+ `(if ,really-p
+ (progn ,@body)
+ (pseudo-atomic ,@body)))
+
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
`(let ((,label (gen-label)))