X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcall.lisp;h=67f5215deac67f6e4ff829652192051eba24ad1a;hb=7c07a6f965c51828d8f452b47e0620d8e6cf2959;hp=53ca4cb32181d98ff2b0e356aeaf506ff1ab62da;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 53ca4cb..67f5215 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -15,11 +15,11 @@ ;;; 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. @@ -29,16 +29,16 @@ ;;; ;;; 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)) -;;; If standard is true, then use the standard (full call) location, +;;; If STANDARD is true, then use the standard (full call) location, ;;; otherwise use any legal location. ;;; ;;; 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) @@ -54,7 +54,7 @@ ;;; ;;; 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)) @@ -63,7 +63,7 @@ ;;; ;;; 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) @@ -75,14 +75,14 @@ ;;; ;;; 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 @@ -90,14 +90,14 @@ ;;; 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) @@ -106,24 +106,24 @@ ;;; 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*))) @@ -135,7 +135,7 @@ ;;; ;;; 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 @@ -254,7 +254,7 @@ for tn-ref = (tn-ref-across 2nd-tn-ref) then (tn-ref-across tn-ref) for count from 2 below register-arg-count - do count (inst mov (tn-ref-tn tn-ref) 2nd-tn)))) + do (inst mov (tn-ref-tn tn-ref) 2nd-tn)))) (inst mov ebx-tn esp-tn) (emit-label regs-defaulted) (inst mov esp-tn ebx-tn))) @@ -748,7 +748,7 @@ ;;; more arg, but there is no new-FP, since the arguments have been set up in ;;; the current frame. (macrolet ((define-full-call (name named return variable) - (assert (not (and variable (eq return :tail)))) + (aver (not (and variable (eq return :tail)))) `(define-vop (,name ,@(when (eq return :unknown) '(unknown-values-receiver))) @@ -799,17 +799,19 @@ ;; 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) @@ -824,16 +826,18 @@ ,@(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)) @@ -841,24 +845,26 @@ (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 @@ -870,23 +876,26 @@ 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))) @@ -1006,11 +1015,11 @@ ;; 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 @@ -1070,7 +1079,7 @@ (: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) @@ -1386,8 +1395,8 @@ 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))