;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-(!def-vm-support-routine standard-arg-location (n)
+(defun standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type*
;;; true, then use the standard (full call) location, otherwise use any legal
;;; location. Even in the non-standard case, this may be restricted by a
;;; desire to use a subroutine call instruction.
-(!def-vm-support-routine make-return-pc-passing-location (standard)
+(defun make-return-pc-passing-location (standard)
(if standard
(make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset)
(make-restricted-tn *backend-t-primitive-type* register-arg-scn)))
;;; standard convention, but is totally unrestricted in non-standard
;;; conventions, since we can always fetch it off of the stack using
;;; the arg pointer.
-(!def-vm-support-routine make-old-fp-passing-location (standard)
+(defun make-old-fp-passing-location (standard)
(if standard
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)
(make-normal-tn *fixnum-primitive-type*)))
;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
;;; function. We treat these specially so that the debugger can find
;;; them at a known location.
-(!def-vm-support-routine make-old-fp-save-location (env)
+(defun make-old-fp-save-location (env)
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
(make-wired-tn *fixnum-primitive-type*
control-stack-arg-scn
ocfp-save-offset)))
-(!def-vm-support-routine make-return-pc-save-location (env)
+(defun make-return-pc-save-location (env)
(let ((ptype *backend-t-primitive-type*))
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn ptype) env)
;;; Make a TN for the standard argument count passing location. We only
;;; need to make the standard location, since a count is never passed when we
;;; are using non-standard conventions.
-(!def-vm-support-routine make-arg-count-location ()
+(defun make-arg-count-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
;;; Make a TN to hold the number-stack frame pointer. This is allocated
;;; once per component, and is component-live.
-(!def-vm-support-routine make-nfp-tn ()
+(defun make-nfp-tn ()
(component-live-tn
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset)))
-(!def-vm-support-routine make-stack-pointer-tn ()
+(defun make-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-(!def-vm-support-routine make-number-stack-pointer-tn ()
+(defun make-number-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
;;; Return a list of TNs that can be used to represent an unknown-values
;;; continuation within a function.
-(!def-vm-support-routine make-unknown-values-locations ()
+(defun make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
;;; VM-dependent initialization of the IR2-COMPONENT structure. We push
;;; placeholder entries in the Constants to leave room for additional
;;; noise in the code object header.
-(!def-vm-support-routine select-component-format (component)
+(defun select-component-format (component)
(declare (type component component))
(dotimes (i code-constants-offset)
(vector-push-extend nil
(when nfp
(inst addu val nfp (bytes-needed-for-non-descriptor-stack-frame))))))
+;;; Accessing a slot from an earlier stack frame is definite hackery.
+(define-vop (ancestor-frame-ref)
+ (:args (frame-pointer :scs (descriptor-reg))
+ (variable-home-tn :load-if nil))
+ (:results (value :scs (descriptor-reg any-reg)))
+ (:policy :fast-safe)
+ (:generator 4
+ (aver (sc-is variable-home-tn control-stack))
+ (loadw value frame-pointer (tn-offset variable-home-tn))))
+(define-vop (ancestor-frame-set)
+ (:args (frame-pointer :scs (descriptor-reg))
+ (value :scs (descriptor-reg any-reg)))
+ (:results (variable-home-tn :load-if nil))
+ (:policy :fast-safe)
+ (:generator 4
+ (aver (sc-is variable-home-tn control-stack))
+ (storew value frame-pointer (tn-offset variable-home-tn))))
(define-vop (xep-allocate-frame)
(:info start-lab copy-more-arg-follows)
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points. The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
\f
;;;; Local call with unknown values convention return:
(insert-step-instrumenting (callable-tn)
;; Conditionally insert a conditional trap:
(when step-instrumenting
- ;; Get the symbol-value of SB!IMPL::*STEPPING*
- (inst lw stepping null-tn
- (- (+ symbol-value-slot
- (truncate (static-symbol-offset 'sb!impl::*stepping*)
- n-word-bytes))
- other-pointer-lowtag))
+ (load-symbol-value stepping sb!impl::*stepping*)
;; If it's not NIL, trap.
(inst beq stepping null-tn step-done-label)
(inst nop)
(move context context-arg)
(move count count-arg)
;; Check to see if there are any arguments.
- (inst beq count zero-tn done)
+ (inst beq count done)
(move result null-tn t)
;; We need to do this atomically.
;; Dec count, and if != zero, go back for more.
(inst addu count count (fixnumize -1))
- (inst bne count zero-tn loop)
+ (inst bne count loop)
;; Store the value in the car (in delay slot)
(storew temp dst 0 list-pointer-lowtag)
(let ((err-lab
(generate-error-code vop invalid-arg-count-error nargs)))
(cond ((zerop count)
- (inst bne nargs zero-tn err-lab)
+ (inst bne nargs err-lab)
(inst nop))
(t
(inst li temp (fixnumize count))
(:policy :fast-safe)
(:vop-var vop)
(:generator 3
- ;; Get the symbol-value of SB!IMPL::*STEPPING*
- (inst lw stepping null-tn
- (- (+ symbol-value-slot
- (truncate (static-symbol-offset 'sb!impl::*stepping*)
- n-word-bytes))
- other-pointer-lowtag))
+ (load-symbol-value stepping sb!impl::*stepping*)
;; If it's not NIL, trap.
(inst beq stepping null-tn DONE)
(inst nop)