X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fcall.lisp;h=99a9a4b1faba41896e9495ea71a4a9aa02ae9a87;hb=63817d29028c8551cda23f432a3328acd7fdd62f;hp=2087a317aee6a28578b94794875f551750b6b10a;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index 2087a31..99a9a4b 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -15,7 +15,6 @@ ;;; Return a wired TN describing the N'th full call argument passing ;;; location. -;;; (!def-vm-support-routine standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) @@ -29,37 +28,30 @@ ;;; 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) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; Make-Old-FP-Passing-Location -- Interface -;;; -;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; Old-FP in. This is (obviously) wired in the standard convention, but is -;;; totally unrestricted in non-standard conventions, since we can always fetch -;;; it off of the stack using the arg pointer. -;;; +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass OLD-FP in. This is (obviously) wired in the +;;; 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) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) -;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface -;;; -;;; 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. -;;; +;;; 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) (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) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env) @@ -86,51 +78,34 @@ (!def-vm-support-routine make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; Make-Unknown-Values-Locations -- Interface -;;; -;;; Return a list of TNs that can be used to represent an unknown-values +;;; 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 () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) - -;;; Select-Component-Format -- Interface -;;; -;;; This function is called by the Entry-Analyze phase, allowing -;;; VM-dependent initialization of the IR2-Component structure. We push +;;; This function is called by the ENTRY-ANALYZE phase, allowing +;;; 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) (declare (type component component)) (dotimes (i code-constants-offset) (vector-push-extend nil (ir2-component-constants (component-info component)))) (values)) - ;;;; Frame hackery: -;;; Return the number of bytes needed for the current non-descriptor stack -;;; frame. Non-descriptor stack frames must be multiples of 16 bytes under -;;; the PPC SVr4 ABI (though the EABI may be less restrictive.) Two words -;;; are reserved for the stack backlink and saved LR (see SB!VM::NUMBER-STACK- -;;; DISPLACEMENT.) -;;; -;;; Duh. PPC Linux (and VxWorks) adhere to the EABI. - ;;; this is the first function in this file that differs materially from ;;; ../alpha/call.lisp (defun bytes-needed-for-non-descriptor-stack-frame () - (logandc2 (+ 7 number-stack-displacement - (* (sb-allocated-size 'non-descriptor-stack) sb!vm:n-word-bytes)) - 7)) + (logandc2 (+ +stack-alignment-bytes+ number-stack-displacement + (* (sb-allocated-size 'non-descriptor-stack) n-word-bytes)) + +stack-alignment-bytes+)) ;;; Used for setting up the Old-FP in local call. -;;; (define-vop (current-fp) (:results (val :scs (any-reg))) (:generator 1 @@ -138,7 +113,6 @@ ;;; Used for computing the caller's NFP for use in known-values return. Only ;;; works assuming there is no variable size stuff on the nstack. -;;; (define-vop (compute-old-nfp) (:results (val :scs (any-reg))) (:vop-var vop) @@ -147,7 +121,6 @@ (when nfp (inst addi val nfp (bytes-needed-for-non-descriptor-stack-frame)))))) - (define-vop (xep-allocate-frame) (:info start-lab copy-more-arg-follows) (:ignore copy-more-arg-follows) @@ -161,7 +134,7 @@ (emit-label start-lab) ;; Allocate function header. (inst simple-fun-header-word) - (dotimes (i (1- sb!vm:simple-fun-code-offset)) + (dotimes (i (1- simple-fun-code-offset)) (inst word 0)) (let* ((entry-point (gen-label))) (emit-label entry-point) @@ -198,7 +171,6 @@ ;;; Allocate a partial frame for passing stack arguments in a full call. Nargs ;;; is the number of arguments passed. If no stack arguments are passed, then ;;; we don't have to do anything. -;;; (define-vop (allocate-full-call-frame) (:info nargs) (:results (res :scs (any-reg))) @@ -207,14 +179,13 @@ (move res csp-tn) (inst addi csp-tn csp-tn (* nargs n-word-bytes))))) - ;;; Emit code needed at the return-point from an unknown-values call -;;; for a fixed number of values. Values is the head of the TN-Ref +;;; for a fixed number of values. Values is the head of the TN-REF ;;; list for the locations that the values are to be received into. ;;; Nvals is the number of values that are to be received (should ;;; equal the length of Values). ;;; -;;; Move-Temp is a Descriptor-Reg TN used as a temporary. +;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary. ;;; ;;; This code exploits the fact that in the unknown-values convention, ;;; a single value return returns at the return PC + 8, whereas a @@ -339,9 +310,8 @@ default-value-8 ((null remaining)) (let ((def (car remaining))) (emit-label (car def)) - (when (null (cdr remaining)) - (inst b defaulting-done)) (store-stack-tn (cdr def) null-tn))) + (inst b defaulting-done) (trace-table-entry trace-table-normal)))))) (inst compute-code-from-lra code-tn code-tn lra-label temp))) @@ -350,8 +320,6 @@ default-value-8 ;;;; Unknown values receiving: -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call for an ;;; arbitrary number of values. ;;; @@ -368,7 +336,6 @@ default-value-8 ;;; Args and Nargs are TNs wired to the named locations. We must ;;; explicitly allocate these TNs, since their lifetimes overlap with the ;;; results Start and Count (also, it's nice to be able to target them). -;;; (defun receive-unknown-values (args nargs start count lra-label temp) (declare (type tn args nargs start count temp)) (let ((variable-values (gen-label)) @@ -400,9 +367,8 @@ default-value-8 (values)) -;;; VOP that can be inherited by unknown values receivers. The main thing this -;;; handles is allocation of the result temporaries. -;;; +;;; VOP that can be inherited by unknown values receivers. The main +;;; thing this handles is allocation of the result temporaries. (define-vop (unknown-values-receiver) (:results (start :scs (any-reg)) @@ -436,7 +402,6 @@ default-value-8 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all ;;; registers may be tied up by the more operand. Instead, we use ;;; MAYBE-LOAD-STACK-TN. -;;; (define-vop (call-local) (:args (fp) (nfp) @@ -481,7 +446,6 @@ default-value-8 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all ;;; registers may be tied up by the more operand. Instead, we use ;;; MAYBE-LOAD-STACK-TN. -;;; (define-vop (multiple-call-local unknown-values-receiver) (:args (fp) (nfp) @@ -524,7 +488,6 @@ default-value-8 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all ;;; registers may be tied up by the more operand. Instead, we use ;;; MAYBE-LOAD-STACK-TN. -;;; (define-vop (known-call-local) (:args (fp) (nfp) @@ -564,7 +527,6 @@ default-value-8 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all ;;; registers may be tied up by the more operand. Instead, we use ;;; MAYBE-LOAD-STACK-TN. -;;; (define-vop (known-return) (:args (old-fp :target old-fp-temp) (return-pc :target return-pc-temp) @@ -603,35 +565,32 @@ default-value-8 ;;; arguments, we don't bother allocating a partial frame, and instead set FP ;;; to SP just before the call. -;;; Define-Full-Call -- Internal -;;; ;;; This macro helps in the definition of full call VOPs by avoiding code ;;; replication in defining the cross-product VOPs. ;;; -;;; Name is the name of the VOP to define. +;;; NAME is the name of the VOP to define. ;;; -;;; Named is true if the first argument is a symbol whose global function +;;; NAMED is true if the first argument is a symbol whose global function ;;; definition is to be called. ;;; -;;; Return is either :Fixed, :Unknown or :Tail: -;;; -- If :Fixed, then the call is for a fixed number of values, returned in +;;; RETURN is either :FIXED, :UNKNOWN or :TAIL: +;;; -- If :FIXED, then the call is for a fixed number of values, returned in ;;; the standard passing locations (passed as result operands). -;;; -- If :Unknown, then the result values are pushed on the stack, and the +;;; -- If :UNKNOWN, then the result values are pushed on the stack, and the ;;; result values are specified by the Start and Count as in the ;;; unknown-values continuation representation. -;;; -- If :Tail, then do a tail-recursive call. No values are returned. +;;; -- If :TAIL, then do a tail-recursive call. No values are returned. ;;; The Old-Fp and Return-PC are passed as the second and third arguments. ;;; ;;; In non-tail calls, the pointer to the stack arguments is passed as the last -;;; fixed argument. If Variable is false, then the passing locations are -;;; passed as a more arg. Variable is true if there are a variable number of -;;; arguments passed on the stack. Variable cannot be specified with :Tail +;;; fixed argument. If VARIABLE is false, then the passing locations are +;;; passed as a more arg. VARIABLE is true if there are a variable number of +;;; arguments passed on the stack. VARIABLE cannot be specified with :TAIL ;;; return. TR variable argument call is implemented separately. ;;; ;;; In tail call with fixed arguments, the passing locations are passed as a ;;; more arg, but there is no new-FP, since the arguments have been set up in ;;; the current frame. -;;; (defmacro define-full-call (name named return variable) (assert (not (and variable (eq return :tail)))) `(define-vop (,name @@ -690,9 +649,9 @@ default-value-8 :from (:argument ,(if (eq return :tail) 0 1)) :to :eval) lexenv)) - ;; alpha code suggests that function tn is not needed for named call - (:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval) - function) + ,@(unless named + '((:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval) + function))) (:temporary (:sc any-reg :offset nargs-offset :to :eval) nargs-pass) @@ -803,10 +762,10 @@ default-value-8 (do-next-filler)) (constant (loadw lexenv code-tn (tn-offset arg-fun) - sb!vm:other-pointer-lowtag) + other-pointer-lowtag) (do-next-filler))) - (loadw function lexenv sb!vm:closure-fun-slot - sb!vm:fun-pointer-lowtag) + (loadw function lexenv closure-fun-slot + fun-pointer-lowtag) (do-next-filler) (inst addi entry-point function (- (ash simple-fun-code-offset word-shift) @@ -853,9 +812,8 @@ default-value-8 (define-full-call multiple-call-variable nil :unknown t) -;;; Defined separately, since needs special code that BLT's the arguments -;;; down. -;;; +;;; Defined separately, since needs special code that BLT's the +;;; arguments down. (define-vop (tail-call-variable) (:args (args-arg :scs (any-reg) :target args) @@ -893,9 +851,7 @@ default-value-8 ;;;; Unknown values return: - ;;; Return a single value using the unknown-values convention. -;;; (define-vop (return-single) (:args (old-fp :scs (any-reg)) (return-pc :scs (descriptor-reg)) @@ -930,7 +886,6 @@ default-value-8 ;;; When there are stack values, we must initialize the argument pointer to ;;; point to the beginning of the values block (which is the beginning of the ;;; current frame.) -;;; (define-vop (return) (:args (old-fp :scs (any-reg)) @@ -976,11 +931,11 @@ default-value-8 (lisp-return return-pc lip))) (trace-table-entry trace-table-normal))) -;;; Do unknown-values return of an arbitrary number of values (passed on the -;;; stack.) We check for the common case of a single return value, and do that -;;; inline using the normal single value return convention. Otherwise, we -;;; branch off to code that calls an assembly-routine. -;;; +;;; Do unknown-values return of an arbitrary number of values (passed +;;; on the stack.) We check for the common case of a single return +;;; value, and do that inline using the normal single value return +;;; convention. Otherwise, we branch off to code that calls an +;;; assembly-routine. (define-vop (return-multiple) (:args (old-fp-arg :scs (any-reg) :to (:eval 1)) @@ -1026,14 +981,10 @@ default-value-8 (move nvals nvals-arg) (inst ba (make-fixup 'return-multiple :assembly-routine))) (trace-table-entry trace-table-normal))) - - ;;;; XEP hackery: - ;;; We don't need to do anything special for regular functions. -;;; (define-vop (setup-environment) (:info label) (:ignore label) @@ -1042,7 +993,6 @@ default-value-8 )) ;;; Get the lexical environment from its passing location. -;;; (define-vop (setup-closure-environment) (:temporary (:sc descriptor-reg :offset lexenv-offset :target closure :to (:result 0)) @@ -1056,7 +1006,6 @@ default-value-8 ;;; Copy a more arg from the argument area to the end of the current frame. ;;; Fixed is the number of non-more arguments. -;;; (define-vop (copy-more-arg) (:temporary (:sc any-reg :offset nl0-offset) result) (:temporary (:sc any-reg :offset nl1-offset) count) @@ -1094,10 +1043,10 @@ default-value-8 (emit-label loop) ;; *--dst = *--src, --count - (inst addi src src (- sb!vm:n-word-bytes)) + (inst addi src src (- n-word-bytes)) (inst addic. count count (- (fixnumize 1))) (loadw temp src) - (inst addi dst dst (- sb!vm:n-word-bytes)) + (inst addi dst dst (- n-word-bytes)) (storew temp dst) (inst bgt loop) @@ -1115,16 +1064,14 @@ default-value-8 (emit-label done)))) -;;; More args are stored consecutively on the stack, starting immediately at -;;; the context pointer. The context pointer is not typed, so the lowtag is 0. -;;; +;;; More args are stored consecutively on the stack, starting +;;; immediately at the context pointer. The context pointer is not +;;; typed, so the lowtag is 0. (define-vop (more-arg word-index-ref) (:variant 0 0) (:translate %more-arg)) - ;;; Turn more arg (context, count) into a list. -;;; (define-vop (listify-rest-args) (:args (context-arg :target context :scs (descriptor-reg)) (count-arg :target count :scs (any-reg))) @@ -1179,16 +1126,16 @@ default-value-8 DONE)) -;;; Return the location and size of the more arg glob created by Copy-More-Arg. -;;; Supplied is the total number of arguments supplied (originally passed in -;;; NARGS.) Fixed is the number of non-rest arguments. -;;; -;;; We must duplicate some of the work done by Copy-More-Arg, since at that -;;; time the environment is in a pretty brain-damaged state, preventing this -;;; info from being returned as values. What we do is compute -;;; supplied - fixed, and return a pointer that many words below the current -;;; stack top. +;;; Return the location and size of the more arg glob created by +;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied +;;; (originally passed in NARGS.) Fixed is the number of non-rest +;;; arguments. ;;; +;;; We must duplicate some of the work done by COPY-MORE-ARG, since at +;;; that time the environment is in a pretty brain-damaged state, +;;; preventing this info from being returned as values. What we do is +;;; compute (- SUPPLIED FIXED), and return a pointer that many words +;;; below the current stack top. (define-vop (more-arg-context) (:policy :fast-safe) (:translate sb!c::%more-arg-context) @@ -1203,24 +1150,6 @@ default-value-8 (inst subi count supplied (fixnumize fixed)) (inst sub context csp-tn count))) - -;;; Signal wrong argument count error if Nargs isn't = to Count. -;;; -#| -(define-vop (verify-argument-count) - (:policy :fast-safe) - (:translate sb!c::%verify-argument-count) - (:args (nargs :scs (any-reg))) - (:arg-types positive-fixnum (:constant t)) - (:info count) - (:vop-var vop) - (:save-p :compute-only) - (:generator 3 - (let ((err-lab - (generate-error-code vop invalid-argument-count-error nargs))) - (inst cmpwi nargs (fixnumize count)) - (inst bne err-lab)))) -|# (define-vop (verify-arg-count) (:policy :fast-safe) (:translate sb!c::%verify-arg-count) @@ -1232,9 +1161,7 @@ default-value-8 (:generator 3 (inst twi :ne nargs (fixnumize count)))) - ;;; Signal various errors. -;;; (macrolet ((frob (name error translate &rest args) `(define-vop (,name) ,@(when translate