"*ASSEMBLY-OPTIMIZE*"
"LARGE-ALLOC"
"%SET-SIMPLE-FUN-SELF"
- "VM-SUPPORT-ROUTINES-IMMEDIATE-CONSTANT-SC"
- "VM-SUPPORT-ROUTINES-BOXED-IMMEDIATE-SC-P"
- "VM-SUPPORT-ROUTINES-LOCATION-PRINT-NAME"
- "VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE-OF"
- "VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE"
- "VM-SUPPORT-ROUTINES-MAKE-CALL-OUT-TNS"
- "VM-SUPPORT-ROUTINES-STANDARD-ARG-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-PASSING-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-OLD-FP-PASSING-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-OLD-FP-SAVE-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-SAVE-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-ARG-COUNT-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-NFP-TN"
- "VM-SUPPORT-ROUTINES-MAKE-STACK-POINTER-TN"
- "VM-SUPPORT-ROUTINES-MAKE-NUMBER-STACK-POINTER-TN"
- "VM-SUPPORT-ROUTINES-MAKE-UNKNOWN-VALUES-LOCATIONS"
- "VM-SUPPORT-ROUTINES-SELECT-COMPONENT-FORMAT"
- "VM-SUPPORT-ROUTINES-MAKE-NLX-SP-TN"
- "VM-SUPPORT-ROUTINES-MAKE-DYNAMIC-STATE-TNS"
- "VM-SUPPORT-ROUTINES-MAKE-NLX-ENTRY-ARG-START-LOCATION"
- "VM-SUPPORT-ROUTINES-GENERATE-CALL-SEQUENCE"
- "VM-SUPPORT-ROUTINES-GENERATE-RETURN-SEQUENCE"
- "VM-SUPPORT-ROUTINES-EMIT-NOP"
- "VM-SUPPORT-ROUTINES-LOCATION-NUMBER"
+
+ "IMMEDIATE-CONSTANT-SC"
+ "BOXED-IMMEDIATE-SC-P"
+ "COMBINATION-IMPLEMENTATION-STYLE"
+ "CONVERT-CONDITIONAL-MOVE-P"
+ "LOCATION-PRINT-NAME"
+ "PRIMITIVE-TYPE-OF"
+ "PRIMITIVE-TYPE"
+ "MAKE-CALL-OUT-TNS"
+ "STANDARD-ARG-LOCATION"
+ "MAKE-RETURN-PC-PASSING-LOCATION"
+ "MAKE-OLD-FP-PASSING-LOCATION"
+ "MAKE-OLD-FP-SAVE-LOCATION"
+ "MAKE-RETURN-PC-SAVE-LOCATION"
+ "MAKE-ARG-COUNT-LOCATION"
+ "MAKE-NFP-TN"
+ "MAKE-STACK-POINTER-TN"
+ "MAKE-NUMBER-STACK-POINTER-TN"
+ "MAKE-UNKNOWN-VALUES-LOCATIONS"
+ "SELECT-COMPONENT-FORMAT"
+ "MAKE-NLX-SP-TN"
+ "MAKE-DYNAMIC-STATE-TNS"
+ "MAKE-NLX-ENTRY-ARG-START-LOCATION"
+ "GENERATE-CALL-SEQUENCE"
+ "GENERATE-RETURN-SEQUENCE"
+ "EMIT-NOP"
+ "LOCATION-NUMBER"
"WITH-SOURCE-LOCATION"
"*SOURCE-LOCATION-THUNKS*"
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(values
(:temporary (:scs (non-descriptor-reg)) temp1)
(:save-p t)))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`((inst ret zero-tn lip-tn)))
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(with-unique-names (fixup)
,nfp-save)
(:save-p t)))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`((inst bv lip-tn :nullify t)))
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(values
,nfp-save)
(:save-p t)))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`((inst j lip-tn)
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(let ((jump (make-symbol "JUMP")))
(:temporary (:sc any-reg) ,jump)
(:save-p :compute-only)))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`((inst blr)))
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(let ((temp (make-symbol "TEMP"))
,nfp-save)
(:save-p :compute-only)))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`((inst j
(in-package "SB!VM")
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
(:raw
(values
(inst jmp temp-reg-tn))
nil))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`(inst ret))
;;; value, which again simplifies the return path.
;;; -- AB, 2006/Feb/05.
-(!def-vm-support-routine generate-call-sequence (name style vop)
+(defun generate-call-sequence (name style vop)
(ecase style
((:raw :none)
(values
(emit-label single-value)))))
'((:save-p :compute-only))))))
-(!def-vm-support-routine generate-return-sequence (style)
+(defun generate-return-sequence (style)
(ecase style
(:raw
`(inst ret))
(when values
(invoke-alien-type-method :result-tn (car values) state))))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
(dolist (arg-type (alien-fun-type-arg-types type))
;;; 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*
;;; is 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*)))
;;; These functions 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
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
;;; Make a TN for the argument count passing location for a
;;; non-local entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
;;;; save and restoring the dynamic environment
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
\f
;;; If value can be represented as an immediate constant, then return
;;; the appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
(sc-number-or-lose 'fp-double-zero )
nil))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
;;; This function is called by debug output routines that want a
;;; pretty name for a TN's location. It returns a thing that can be
;;; printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
; (declare (type tn tn))
(let ((sb (sb-name (sc-sb (tn-sc tn))))
(offset (tn-offset tn)))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node) (ignore node))
(values :default nil))
(defvar *backend-internal-errors* nil)
(declaim (type (or simple-vector null) *backend-internal-errors*))
\f
-;;;; VM support routines
-
-;;; FIXME: Do we need this kind of indirection for the VM support
-;;; routines any more?
-
-;;; forward declaration
-(defvar *backend-support-routines*)
-
-(macrolet ((def-vm-support-routines (&rest routines)
- `(progn
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *vm-support-routines* ',routines))
- (defstruct (vm-support-routines (:copier nil))
- ,@(mapcar (lambda (routine)
- `(,routine nil :type (or function null)))
- routines))
- ,@(mapcar
- (lambda (name)
- `(defun ,name (&rest args)
- (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-"
- name)
- *backend-support-routines*)
- (error "machine-specific support ~S ~
- routine undefined"
- ',name))
- args)))
- routines))))
-
- (def-vm-support-routines
-
- ;; from vm.lisp
- immediate-constant-sc
- location-print-name
- combination-implementation-style
- boxed-immediate-sc-p
-
- ;; from primtype.lisp
- primitive-type-of
- primitive-type
-
- ;; from c-call.lisp
- make-call-out-tns
-
- ;; from call.lisp
- standard-arg-location
- make-return-pc-passing-location
- make-old-fp-passing-location
- make-old-fp-save-location
- make-return-pc-save-location
- make-arg-count-location
- make-nfp-tn
- make-stack-pointer-tn
- make-number-stack-pointer-tn
- make-unknown-values-locations
- select-component-format
-
- ;; from nlx.lisp
- make-nlx-sp-tn
- make-dynamic-state-tns
- make-nlx-entry-arg-start-location
-
- ;; from pred.lisp
- convert-conditional-move-p
-
- ;; from support.lisp
- generate-call-sequence
- generate-return-sequence
-
- ;; for use with scheduler
- emit-nop
- location-number))
-
-(defprinter (vm-support-routines))
-
-(defmacro !def-vm-support-routine (name ll &body body)
- (unless (member (intern (string name) (find-package "SB!C"))
- *vm-support-routines*)
- (warn "unknown VM support routine: ~A" name))
- (let ((local-name (symbolicate "IMPL-OF-VM-SUPPORT-ROUTINE-" name)))
- `(progn
- (defun ,local-name ,ll ,@body)
- (setf (,(intern (concatenate 'simple-string
- "VM-SUPPORT-ROUTINES-"
- (string name))
- (find-package "SB!C"))
- *backend-support-routines*)
- #',local-name))))
-
-;;; the VM support routines
-(defvar *backend-support-routines* (make-vm-support-routines))
-(declaim (type vm-support-routines *backend-support-routines*))
+;;;; VM support routines which backends need to implement
+
+;;; from vm.lisp
+;;; immediate-constant-sc
+;;; location-print-name
+;;; combination-implementation-style
+;;; convert-conditional-move-p
+;;; boxed-immediate-sc-p
+
+;;; from primtype.lisp
+;;; primitive-type-of
+;;; primitive-type
+
+;;; from c-call.lisp
+;;; make-call-out-tns
+
+;;; from call.lisp
+;;; standard-arg-location
+;;; make-return-pc-passing-location
+;;; make-old-fp-passing-location
+;;; make-old-fp-save-location
+;;; make-return-pc-save-location
+;;; make-arg-count-location
+;;; make-nfp-tn
+;;; make-stack-pointer-tn
+;;; make-number-stack-pointer-tn
+;;; make-unknown-values-locations
+;;; select-component-format
+
+;;; from nlx.lisp
+;;; make-nlx-sp-tn
+;;; make-dynamic-state-tns
+;;; make-nlx-entry-arg-start-location
+
+;;; from pred.lisp
+;;; convert-conditional-move-p
+
+;;; from support.lisp
+;;; generate-call-sequence
+;;; generate-return-sequence
+
+;;; for use with scheduler
+;;; emit-nop
+;;; location-number
+
\f
;;;; This is a prototype interface to support Christophe Rhodes' new
;;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which
\f
;;; Return a list of TNs that can be used to snapshot the dynamic
;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs.
-(!def-vm-support-routine make-dynamic-state-tns ()
+(defun make-dynamic-state-tns ()
(make-n-tns #.(let ((nsave
(sb!c::vop-info-num-results
(template-or-lose 'save-dynamic-state)))
;;; Return the most restrictive primitive type that contains OBJECT.
(/show0 "primtype.lisp 147")
-(!def-vm-support-routine primitive-type-of (object)
+(defun primitive-type-of (object)
(let ((type (ctype-of object)))
(cond ((not (member-type-p type)) (primitive-type type))
((and (eql 1 (member-type-size type))
;;; We need an aux function because we need to use both
;;; !DEF-VM-SUPPORT-ROUTINE and DEFUN-CACHED.
(/show0 "primtype.lisp 188")
-(!def-vm-support-routine primitive-type (type)
+(defun primitive-type (type)
(sb!kernel::maybe-reparse-specifier! type)
(primitive-type-aux type))
(/show0 "primtype.lisp 191")
(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state))
(nargs 0))
(dolist (arg-type (alien-fun-type-arg-types type))
;;; 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
; immediate or anything else.
; this routine will return an location-number
; this number must be less than *assem-max-locations*
-(!def-vm-support-routine location-number (loc)
+(defun location-number (loc)
(etypecase loc
(null)
(number)
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
;;; Make a TN for the argument count passing location for a
;;; non-local entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
;;; Save and restore dynamic environment.
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
\f
;;; If VALUE can be represented as an immediate constant, then return
;;; the appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
(sc-number-or-lose 'fp-double-zero)
nil))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
\f
;;; This function is called by debug output routines that want a pretty name
;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn))
(let ((sb (sb-name (sc-sb (tn-sc tn))))
(offset (tn-offset tn)))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node) (ignore node))
(values :default nil))
(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
(dolist (arg-type (alien-fun-type-arg-types type))
;;; 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
(defvar *disassem-use-lisp-reg-names* t)
-(!def-vm-support-routine location-number (loc)
+(defun location-number (loc)
(etypecase loc
(null)
(number)
(:emitter
(emit-word segment 0)))
-(!def-vm-support-routine emit-nop (segment)
+(defun emit-nop (segment)
(emit-word segment 0))
(define-instruction word (segment word)
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
;;; Make a TN for the argument count passing location for a
;;; non-local entry.
;;;
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
;;; Save and restore dynamic environment.
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
\f
;;; If VALUE can be represented as an immediate constant, then return the
;;; appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
(character
(sc-number-or-lose 'immediate))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
\f
;;; This function is called by debug output routines that want a pretty name
;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn))
(let ((sb (sb-name (sc-sb (tn-sc tn))))
(offset (tn-offset tn)))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node) (ignore node))
(values :default nil))
(values 'unsigned-byte-32 'unsigned-reg))
(my-make-wired-tn ptype reg-sc (result-reg-offset num-results)))))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(declare (type alien-fun-type type))
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
;;; 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* register-arg-scn
;;; 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)
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env)
(make-wired-tn *backend-t-primitive-type*
;;; 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
(defvar *disassem-use-lisp-reg-names* t)
-(!def-vm-support-routine location-number (loc)
+(defun location-number (loc)
(etypecase loc
(null)
(number)
`(inst nor. ,ra ,rs ,rs))
- (!def-vm-support-routine emit-nop (segment)
+ (defun emit-nop (segment)
(emit-word segment #x60000000))
(define-instruction-macro extlwi (ra rs n b)
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
;;; Make a TN for the argument count passing location for a
;;; non-local entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
\f
;;; If VALUE can be represented as an immediate constant, then return the
;;; appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
(sc-number-or-lose 'immediate)
nil))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
\f
;;; This function is called by debug output routines that want a pretty name
;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn))
(let ((sb (sb-name (sc-sb (tn-sc tn))))
(offset (tn-offset tn)))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node))
(flet ((valid-funtype (args result)
(sb!c::valid-fun-use node
(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(declare (type alien-fun-type type))
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
;;; 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* register-arg-scn
;;; 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)
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env)
(make-wired-tn *backend-t-primitive-type*
;;; 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
"If non-NIL, print registers using the Lisp register names.
Otherwise, use the Sparc register names")
-(!def-vm-support-routine location-number (loc)
+(defun location-number (loc)
(etypecase loc
(null)
(number)
(:delay 0)
(:emitter (emit-format-2-immed segment 0 0 #b100 0)))
-(!def-vm-support-routine emit-nop (segment)
+(defun emit-nop (segment)
(emit-format-2-immed segment 0 0 #b100 0))
(define-instruction cmp (segment src1 &optional src2)
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
;;; Make a TN for the argument count passing location for a non-local
;;; entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
;;; save and restore dynamic environment.
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
\f
;;; If VALUE can be represented as an immediate constant, then return the
;;; appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
(sc-number-or-lose 'immediate)
nil))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
;;; This function is called by debug output routines that want a
;;; pretty name for a TN's location. It returns a thing that can be
;;; printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn)) ; FIXME: commented out on alpha
(let ((sb (sb-name (sc-sb (tn-sc tn))))
(offset (tn-offset tn)))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node) (ignore node))
(values :default nil))
(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
(dolist (arg-type (alien-fun-type-arg-types type))
;;; 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* descriptor-reg-sc-number
;;;
;;; Always wire the return PC location to the stack in its standard
;;; location.
-(!def-vm-support-routine make-return-pc-passing-location (standard)
+(defun make-return-pc-passing-location (standard)
(declare (ignore standard))
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset))
;;; because we want to be able to assume it's always there. Besides,
;;; the x86 doesn't have enough registers to really make it profitable
;;; to pass it in a register.
-(!def-vm-support-routine make-old-fp-passing-location (standard)
+(defun make-old-fp-passing-location (standard)
(declare (ignore standard))
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
;;;
;;; Without using a save-tn - which does not make much sense if it is
;;; wired to the stack?
-(!def-vm-support-routine make-old-fp-save-location (physenv)
+(defun make-old-fp-save-location (physenv)
(physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
physenv))
-(!def-vm-support-routine make-return-pc-save-location (physenv)
+(defun make-return-pc-save-location (physenv)
(physenv-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
;;; 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* any-reg-sc-number rcx-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 ()
(make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
-(!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-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
;;; 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
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* any-reg-sc-number)
env))
;;; Make a TN for the argument count passing location for a non-local entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* any-reg-sc-number rbx-offset))
(defun catch-block-ea (tn)
the values, and VOP-name the name of the VOP that will be used
to execute the conditional move.")
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node))
(let* ((ptype (sb!c::tn-primitive-type dst-tn))
;;; If value can be represented as an immediate constant, then return
;;; the appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
#-sb-xc-host simd-pack
(sc-number-or-lose 'int-sse-immediate))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(eql sc (sc-number-or-lose 'immediate)))
\f
;;;; miscellaneous function call parameters
\f
;;; This function is called by debug output routines that want a pretty name
;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn))
(let* ((sc (tn-sc tn))
(sb (sb-name (sc-sb sc)))
(def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node))
(flet ((valid-funtype (args result)
(sb!c::valid-fun-use node
(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
(dolist (arg-type (alien-fun-type-arg-types type))
;;; 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* descriptor-reg-sc-number
;;;
;;; Always wire the return PC location to the stack in its standard
;;; location.
-(!def-vm-support-routine make-return-pc-passing-location (standard)
+(defun make-return-pc-passing-location (standard)
(declare (ignore standard))
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset))
;;; because we want to be able to assume it's always there. Besides,
;;; the x86 doesn't have enough registers to really make it profitable
;;; to pass it in a register.
-(!def-vm-support-routine make-old-fp-passing-location (standard)
+(defun make-old-fp-passing-location (standard)
(declare (ignore standard))
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
;;;
;;; Without using a save-tn - which does not make much sense if it is
;;; wired to the stack?
-(!def-vm-support-routine make-old-fp-save-location (physenv)
+(defun make-old-fp-save-location (physenv)
(physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
physenv))
-(!def-vm-support-routine make-return-pc-save-location (physenv)
+(defun make-return-pc-save-location (physenv)
(physenv-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
;;; 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* any-reg-sc-number ecx-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 ()
(make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
-(!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-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
;;; 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))
;; The 1+ here is because for the x86 the first constant is a
;; pointer to a list of fixups, or NIL if the code object has none.
(in-package "SB!VM")
;;; Make an environment-live stack TN for saving the SP for NLX entry.
-(!def-vm-support-routine make-nlx-sp-tn (env)
+(defun make-nlx-sp-tn (env)
(physenv-live-tn
(make-representation-tn *fixnum-primitive-type* any-reg-sc-number)
env))
;;; Make a TN for the argument count passing location for a non-local entry.
-(!def-vm-support-routine make-nlx-entry-arg-start-location ()
+(defun make-nlx-entry-arg-start-location ()
(make-wired-tn *fixnum-primitive-type* any-reg-sc-number ebx-offset))
(defun catch-block-ea (tn)
the values, and VOP-name the name of the VOP that will be used
to execute the conditional move.")
-(!def-vm-support-routine
+(defun
convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node))
(let* ((ptype (sb!c::tn-primitive-type dst-tn))
\f
;;; If value can be represented as an immediate constant, then return
;;; the appropriate SC number, otherwise return NIL.
-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)
(typecase value
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(eql value (log 2l0 2.718281828459045235360287471352662L0)))
(sc-number-or-lose 'fp-constant)))))
-(!def-vm-support-routine boxed-immediate-sc-p (sc)
+(defun boxed-immediate-sc-p (sc)
(eql sc (sc-number-or-lose 'immediate)))
;; For an immediate TN, return its value encoded for use as a literal.
\f
;;; This function is called by debug output routines that want a pretty name
;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)
(declare (type tn tn))
(let* ((sc (tn-sc tn))
(sb (sb-name (sc-sb sc)))
(noise (symbol-name (sc-name sc))))))
;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
-(!def-vm-support-routine combination-implementation-style (node)
+(defun combination-implementation-style (node)
(declare (type sb!c::combination node))
(flet ((valid-funtype (args result)
(sb!c::valid-fun-use node
(flet ((yes (x)
(assert
(eql (sc-number-or-lose 'immediate)
- (impl-of-vm-support-routine-immediate-constant-sc x))))
+ (immediate-constant-sc x))))
(no (x)
(assert
- (not (impl-of-vm-support-routine-immediate-constant-sc x)))))
+ (not (immediate-constant-sc x)))))
;; target fixnums can be dealt with as immediates; target bignums
;; can not.
(yes #.sb-xc:most-positive-fixnum)
projects / sbcl.git / commitdiff