(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)
(defmacro storew (value ptr &optional (slot 0) (lowtag 0))
(once-only ((value value))
`(cond ((and (integerp ,value)
- (not (typep ,value
- '(or (signed-byte 32) (unsigned-byte 32)))))
+ (not (typep ,value '(signed-byte 32))))
(multiple-value-bind (lo hi) (dwords-for-quad ,value)
(inst mov (make-ea-for-object-slot-half
,ptr ,slot ,lowtag) lo)
(declare (ignore ignored))
(inst push size)
(inst lea r13-tn (make-ea :qword
- :disp (make-fixup (extern-alien-name "alloc_tramp")
- :foreign)))
+ :disp (make-fixup "alloc_tramp" :foreign)))
(inst call r13-tn)
(inst pop alloc-tn)
(values))
(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
(make-ea :qword :disp
#!+sb-thread (* n-word-bytes thread-alloc-region-slot)
- #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
- :foreign)
+ #!-sb-thread (make-fixup "boxed_region" :foreign)
:scale 1)) ; thread->alloc_region.free_pointer
(end-addr
(make-ea :qword :disp
#!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot))
- #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
- :foreign 8)
+ #!-sb-thread (make-fixup "boxed_region" :foreign 8)
:scale 1))) ; thread->alloc_region.end_addr
(cond (in-elsewhere
(allocation-tramp alloc-tn size))
(declare (ignore ignored))
(inst push size)
(inst lea r13-tn (make-ea :qword
- :disp (make-fixup (extern-alien-name "alloc_tramp")
- :foreign)))
+ :disp (make-fixup "alloc_tramp" :foreign)))
(inst call r13-tn)
(inst pop alloc-tn)
(values))
;;; 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)