(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)
(defun allocation (alloc-tn size &optional ignored)
(declare (ignore ignored))
- (let ((not-inline (gen-label))
- (done (gen-label))
+ (let ((NOT-INLINE (gen-label))
+ (DONE (gen-label))
;; Yuck.
(in-elsewhere (eq *elsewhere* sb!assem::**current-segment**))
(free-pointer
;;; header having the specified WIDETAG value. The result is placed in
;;; RESULT-TN.
(defmacro with-fixed-allocation ((result-tn widetag size &optional inline)
- &rest forms)
- `(pseudo-atomic
- (allocation ,result-tn (pad-data-block ,size) ,inline)
- (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
- ,result-tn)
- (inst lea ,result-tn
- (make-ea :qword :base ,result-tn :disp other-pointer-lowtag))
- ,@forms))
+ &body forms)
+ (unless forms
+ (bug "empty &body in WITH-FIXED-ALLOCATION"))
+ (once-only ((result-tn result-tn) (size size))
+ `(pseudo-atomic
+ (allocation ,result-tn (pad-data-block ,size) ,inline)
+ (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
+ ,result-tn)
+ (inst lea ,result-tn
+ (make-ea :qword :base ,result-tn :disp other-pointer-lowtag))
+ ,@forms)))
\f
;;;; error code
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)