;;;; files for more information.
(in-package "SB!VM")
-
-(file-comment
- "$Header$")
\f
;;;; interfaces to IR2 conversion
;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-(def-vm-support-routine standard-argument-location (n)
+(!def-vm-support-routine standard-argument-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number
- (nth n register-arg-offsets))
+ (nth n *register-arg-offsets*))
(make-wired-tn *backend-t-primitive-type* control-stack-sc-number n)))
;;; Make a passing location TN for a local call return PC.
;;;
;;; No problems.
;#+nil
-(def-vm-support-routine make-return-pc-passing-location (standard)
+(!def-vm-support-routine 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))
;;;
;;; No problems.
#+nil
-(def-vm-support-routine make-return-pc-passing-location (standard)
+(!def-vm-support-routine make-return-pc-passing-location (standard)
(let ((ptype (primitive-type-or-lose 'system-area-pointer)))
(if standard
(make-wired-tn ptype sap-stack-sc-number return-pc-save-offset)
;;;
;;; No problems
;#+nil
-(def-vm-support-routine make-old-fp-passing-location (standard)
+(!def-vm-support-routine make-old-fp-passing-location (standard)
(declare (ignore standard))
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
;;;
;;; No problems.
#+nil
-(def-vm-support-routine make-old-fp-passing-location (standard)
+(!def-vm-support-routine make-old-fp-passing-location (standard)
(if 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
;;; wire to the stack? No problems.
-(def-vm-support-routine make-old-fp-save-location (env)
+(!def-vm-support-routine make-old-fp-save-location (env)
(environment-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
env))
;;; Using a save-tn. No problems.
#+nil
-(def-vm-support-routine make-old-fp-save-location (env)
+(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
(environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
;;; Without using a save-tn - which does not make much sense if it is
;;; wire to the stack? No problems.
-(def-vm-support-routine make-return-pc-save-location (env)
+(!def-vm-support-routine make-return-pc-save-location (env)
(environment-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
env))
;;; Using a save-tn. No problems.
#+nil
-(def-vm-support-routine make-return-pc-save-location (env)
+(!def-vm-support-routine make-return-pc-save-location (env)
(let ((ptype (primitive-type-or-lose 'system-area-pointer)))
(specify-save-tn
(environment-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-argument-count-location ()
+(!def-vm-support-routine make-argument-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 ()
+(!def-vm-support-routine make-nfp-tn ()
(make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number))
-(def-vm-support-routine make-stack-pointer-tn ()
+(!def-vm-support-routine make-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-(def-vm-support-routine make-number-stack-pointer-tn ()
+(!def-vm-support-routine 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 ()
+(!def-vm-support-routine make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
;;;
;;; For the x86 the first constant is a pointer to a list of fixups,
;;; or nil if the code object has none.
-(def-vm-support-routine select-component-format (component)
+(!def-vm-support-routine select-component-format (component)
(declare (type component component))
(dotimes (i (1+ code-constants-offset))
(vector-push-extend nil
;; of the (new) stack frame before doing the call. Therefore,
;; we have to tell the lifetime stuff that we need to use them.
,@(when variable
- (mapcar #'(lambda (name offset)
- `(:temporary (:sc descriptor-reg
- :offset ,offset
- :from (:argument 0)
- :to :eval)
- ,name))
- register-arg-names register-arg-offsets))
+ (mapcar #'(lambda (name offset)
+ `(:temporary (:sc descriptor-reg
+ :offset ,offset
+ :from (:argument 0)
+ :to :eval)
+ ,name))
+ *register-arg-names* *register-arg-offsets*))
,@(when (eq return :tail)
- '((:temporary (:sc unsigned-reg
- :from (:argument 1) :to (:argument 2)) old-fp-tmp)))
+ '((:temporary (:sc unsigned-reg
+ :from (:argument 1)
+ :to (:argument 2))
+ old-fp-tmp)))
(:generator ,(+ (if named 5 0)
(if variable 19 1)
,@(if variable
- ;; For variable call, compute the number of arguments and
- ;; move some of the arguments to registers.
+ ;; For variable call, compute the number of
+ ;; arguments and move some of the arguments to
+ ;; registers.
(collect ((noise))
;; Compute the number of arguments.
(noise '(inst mov ecx new-fp))
(noise '(inst sub ecx esp-tn))
- ;; Move the necessary args to registers, this
- ;; moves them all even if they are not all needed.
+ ;; Move the necessary args to registers,
+ ;; this moves them all even if they are
+ ;; not all needed.
(loop
- for name in register-arg-names
+ for name in *register-arg-names*
for index downfrom -1
do (noise `(loadw ,name new-fp ,index)))
(noise))
(inst xor ecx ecx)
(inst mov ecx (fixnumize nargs)))))
,@(cond ((eq return :tail)
- '(;; Python has figured out what frame we should return
- ;; to so might as well use that clue. This seems
- ;; really important to the implementation of things
- ;; like (without-interrupts ...)
-
+ '(;; Python has figured out what frame we should
+ ;; return to so might as well use that clue.
+ ;; This seems really important to the
+ ;; implementation of things like
+ ;; (without-interrupts ...)
+ ;;
;; dtc; Could be doing a tail call from a
- ;; known-local-call etc in which the old-fp or ret-pc
- ;; are in regs or in non-standard places. If the
- ;; passing location were wired to the stack in
- ;; standard locations then these moves will be
- ;; un-necessary; this is probably best for the x86.
+ ;; known-local-call etc in which the old-fp
+ ;; or ret-pc are in regs or in non-standard
+ ;; places. If the passing location were
+ ;; wired to the stack in standard locations
+ ;; then these moves will be un-necessary;
+ ;; this is probably best for the x86.
(sc-case old-fp
((control-stack)
(unless (= ocfp-save-offset
(tn-offset old-fp))
- ;; FIXME: FORMAT T for stale diagnostic
- ;; output (several of them around here),
- ;; ick
+ ;; FIXME: FORMAT T for stale
+ ;; diagnostic output (several of
+ ;; them around here), ick
(format t "** tail-call old-fp not S0~%")
(move old-fp-tmp old-fp)
(storew old-fp-tmp
ebp-tn
(- (1+ ocfp-save-offset)))))
- ;; For tail call, we have to push the return-pc so
- ;; that it looks like we CALLed despite the fact that
- ;; we are going to JMP.
+ ;; For tail call, we have to push the
+ ;; return-pc so that it looks like we CALLed
+ ;; despite the fact that we are going to JMP.
(inst push return-pc)
))
(t
- ;; For non-tail call, we have to save our frame pointer
- ;; and install the new frame pointer. We can't load
- ;; stack tns after this point.
- `(;; Python doesn't seem to allocate a frame here which
- ;; doesn't leave room for the ofp/ret stuff.
+ ;; For non-tail call, we have to save our
+ ;; frame pointer and install the new frame
+ ;; pointer. We can't load stack tns after this
+ ;; point.
+ `(;; Python doesn't seem to allocate a frame
+ ;; here which doesn't leave room for the
+ ;; ofp/ret stuff.
- ;; The variable args are on the stack and become the
- ;; frame, but there may be <3 args and 3 stack slots
- ;; are assumed allocate on the call. So need to
- ;; ensure there are at least 3 slots. This hack just
- ;; adds 3 more.
+ ;; The variable args are on the stack and
+ ;; become the frame, but there may be <3
+ ;; args and 3 stack slots are assumed
+ ;; allocate on the call. So need to ensure
+ ;; there are at least 3 slots. This hack
+ ;; just adds 3 more.
,(if variable
'(inst sub esp-tn (fixnumize 3)))
;; We need to stretch the lifetime of return-pc past the argument
;; registers so that we can default the argument registers without
;; trashing return-pc.
- (:temporary (:sc unsigned-reg :offset (first register-arg-offsets)
+ (:temporary (:sc unsigned-reg :offset (first *register-arg-offsets*)
:from :eval) a0)
- (:temporary (:sc unsigned-reg :offset (second register-arg-offsets)
+ (:temporary (:sc unsigned-reg :offset (second *register-arg-offsets*)
:from :eval) a1)
- (:temporary (:sc unsigned-reg :offset (third register-arg-offsets)
+ (:temporary (:sc unsigned-reg :offset (third *register-arg-offsets*)
:from :eval) a2)
(:generator 6
(:temporary (:sc unsigned-reg :offset esi-offset :from (:argument 2)) esi)
(:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 3)) ecx)
(:temporary (:sc unsigned-reg :offset ebx-offset :from (:eval 0)) ebx)
- (:temporary (:sc descriptor-reg :offset (first register-arg-offsets)
+ (:temporary (:sc descriptor-reg :offset (first *register-arg-offsets*)
:from (:eval 0)) a0)
(:temporary (:sc unsigned-reg :from (:eval 1)) old-fp-temp)
(:node-var node)
object type)
(frob layout-invalid-error layout-invalid-error sb!c::%layout-invalid-error
object layout)
- (frob odd-keyword-arguments-error odd-keyword-arguments-error
- sb!c::%odd-keyword-arguments-error)
- (frob unknown-keyword-argument-error unknown-keyword-argument-error
- sb!c::%unknown-keyword-argument-error key)
+ (frob odd-key-arguments-error odd-key-arguments-error
+ sb!c::%odd-key-arguments-error)
+ (frob unknown-key-argument-error unknown-key-argument-error
+ sb!c::%unknown-key-argument-error key)
(frob nil-function-returned-error nil-function-returned-error nil fun))
projects / sbcl.git / blobdiff