From d9dee664acc242ff7117221a72c5cd37e3ea24b8 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 13 Apr 1990 12:54:46 +0000 Subject: [PATCH] Changed stuff for new argument passing convention. --- compiler/old-rt/call.lisp | 468 +++++++++++++++++--------------------- 1 file changed, 214 insertions(+), 254 deletions(-) diff --git a/compiler/old-rt/call.lisp b/compiler/old-rt/call.lisp index 6bd737574..9e30dbe16 100644 --- a/compiler/old-rt/call.lisp +++ b/compiler/old-rt/call.lisp @@ -24,9 +24,8 @@ (defun standard-argument-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) - (make-wired-tn *any-primitive-type* register-arg-scn - (elt register-arg-offsets n)) - (make-wired-tn *any-primitive-type* stack-arg-scn n))) + (make-wired-tn register-arg-scn (elt register-arg-offsets n)) + (make-wired-tn stack-arg-scn n))) ;;; Make-Return-PC-Passing-Location -- Interface @@ -38,52 +37,38 @@ ;;; (defun make-return-pc-passing-location (standard) (if standard - (make-wired-tn *any-primitive-type* register-arg-scn return-pc-offset) - (make-restricted-tn *any-primitive-type* (list register-arg-scn)))) + (make-wired-tn register-arg-scn return-pc-offset) + (make-restricted-tn register-arg-scn))) -;;; Make-Old-Cont-Passing-Location -- Interface +;;; Make-Old-Fp-Passing-Location -- Interface ;;; ;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; Old-Cont in. This is (obviously) wired in the standard convention, but is +;;; 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. ;;; -(defun make-old-cont-passing-location (standard) +(defun make-old-fp-passing-location (standard) (if standard - (make-wired-tn *any-primitive-type* register-arg-scn old-cont-offset) + (make-wired-tn register-arg-scn old-fp-offset) (make-normal-tn *any-primitive-type*))) -;;; Make-Old-Cont-Save-Location, Make-Return-PC-Save-Location -- Interface +;;; Make-Old-Fp-Save-Location, Make-Return-PC-Save-Location -- Interface ;;; -;;; Make the TNs used to hold Old-Cont and Return-PC within the current +;;; 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. ;;; -(defun make-old-cont-save-location (env) - (make-wired-environment-tn *any-primitive-type* - stack-arg-scn old-cont-save-offset - env)) +(defun make-old-fp-save-location (env) + (environment-live-tn + (make-wired-tn stack-arg-scn old-fp-save-offset) + env)) ;;; (defun make-return-pc-save-location (env) - (make-wired-environment-tn *any-primitive-type* - stack-arg-scn return-pc-save-offset - env)) - - -;;; Make-Argument-Pointer-Location -- Interface -;;; -;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; an argument pointer in. Even when non-standard locations are allowed, this -;;; must be restricted to a register, since the argument pointer is used to -;;; fetch stack arguments. -;;; -(defun make-argument-pointer-location (standard) - (if standard - (make-wired-tn *any-primitive-type* register-arg-scn - argument-pointer-offset) - (make-restricted-tn *any-primitive-type* (list register-arg-scn)))) + (environment-live-tn + (make-wired-tn stack-arg-scn return-pc-save-offset) + env)) ;;; Make-Argument-Count-Location -- Interface @@ -93,7 +78,16 @@ ;;; are using non-standard conventions. ;;; (defun make-argument-count-location () - (make-wired-tn *any-primitive-type* register-arg-scn argument-count-offset)) + (make-wired-tn register-arg-scn argument-count-offset)) + + +;;; MAKE-NFP-TN -- Interface +;;; +;;; Make a TN to hold the number-stack frame pointer. This is allocated +;;; once per component, and is component-live. +;;; +(defun make-nfp-tn () + (component-live-tn (make-restricted-tn register-arg-scn))) ;;; Select-Component-Format -- Interface @@ -111,58 +105,64 @@ (undefined-value)) -;;;; Argument/value passing, frame hackery: +;;;; Frame hackery: -;;; Fetch the argument Arg using the argument pointer Argp, yeilding the value -;;; Val. This operation is used at function entry to move the arguments from -;;; their passing locations to the appropriate variable. +;;; Used for setting up the Old-Fp in local call. ;;; -(define-vop (move-argument) - (:args (arg :scs (any-reg descriptor-reg) :load nil :target val) - (argp :scs (descriptor-reg))) +(define-vop (current-fp) (:results (val :scs (any-reg descriptor-reg))) - (:generator 0 - (sc-case arg - (stack - (loadw val argp (tn-offset arg))) - ((any-reg descriptor-reg) - (unless (location= arg val) - (inst lr val arg)))))) - - -;;; Similar to Move-Argument, but is used to store known values into the frame -;;; being returned into. In this case, it is Loc that is potentially on the -;;; stack in a different frame. -;;; -(define-vop (move-value) - (:args (value :scs (any-reg descriptor-reg) - :target loc) - (old-cont :scs (descriptor-reg))) - (:results (loc :scs (any-reg descriptor-reg) :load nil)) - (:generator 0 - (sc-case loc - (stack - (storew value old-cont (tn-offset loc))) - ((any-reg descriptor-reg) - (unless (location= loc value) - (inst lr loc value)))))) + (:generator 1 + (inst lr val fp-tn))) + +#| Since we don't have a number stack yet, shouldn't be emitted. -;;; Used for setting up the Old-Cont in local call. +;;; 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 (current-cont) +(define-vop (compute-old-nfp) (:results (val :scs (any-reg descriptor-reg))) + (:vop-var vop) (:generator 1 - (inst lr val cont-tn))) + (let ((nfp (current-nfp-tn vop))) + (when nfp + (inst cal val nfp (- (* 4 (sb-allocated-size 'number-stack)))))))) +|# -;;; Notes the place at which the environment is properly initialized, for -;;; debug-info purposes. +;;; In an XEP, allocate frames for this function on the control stack (and +;;; number stack if any). We get to emit the start label, since we might need +;;; to emit variable cruft to align it, etc. ;;; -(define-vop (note-environment-start) +(define-vop (xep-allocate-frame) (:info start-lab) - (:generator 0 - (emit-label start-lab))) + (:generator 1 + (emit-label start-lab) + (inst cal sp-tn fp-tn (* 4 (sb-allocated-size 'stack))))) + + +;;; Allocate the frame for the function we are about to call, returning the +;;; frame pointer(s). +;;; +(define-vop (allocate-frame) + (:results (res :scs (any-reg descriptor-reg)) (nfp)) + (:ignore nfp) + (:generator 2 + (inst lr res sp-tn) + (inst cal sp-tn sp-tn (* 4 (sb-allocated-size 'stack))))) + + +;;; 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 descriptor-reg))) + (:generator 2 + (when (> nargs register-arg-count) + (inst lr res sp-tn) + (inst cal sp-tn sp-tn (* 4 nargs))))) ;;; Default-Unknown-Values -- Internal @@ -204,12 +204,12 @@ regs-defaulted cmpi nargs 3 ; If 4'th value unsupplied... blex default-value-4 ; jump to default code - loadw move-temp args-tn 3 ; Move value to correct location. + loadw move-temp old-fp-tn 3 ; Move value to correct location. store-stack-tn val4-tn move-temp cmpi nargs 4 ; Check 5'th value, etc. blex default-value-5 - loadw move-temp args-tn 4 + loadw move-temp old-fp-tn 4 store-stack-tn val5-tn move-temp ... @@ -235,7 +235,7 @@ default-value-5 (type unsigned-byte nvals) (type tn move-temp nil-temp)) (assemble node (if (<= nvals 1) - (inst ai sp-tn args-tn 0) + (inst ai sp-tn old-fp-tn 0) (let ((regs-defaulted (gen-label)) (defaulting-done (gen-label))) (inst bnb :pz regs-defaulted) @@ -246,7 +246,7 @@ default-value-5 (inst cau (tn-ref-tn val) zero-tn clc::nil-16)) (when (> nvals register-arg-count) (loadi nargs-tn 1) - (inst lr args-tn sp-tn)) + (inst lr old-fp-tn sp-tn)) (emit-label regs-defaulted) @@ -266,11 +266,11 @@ default-value-5 (defaults (cons default-lab tn)) (cmpi nargs-tn i) (inst bnbx :gt default-lab) - (loadw move-temp args-tn i) + (loadw move-temp old-fp-tn i) (store-stack-tn tn move-temp))) (emit-label defaulting-done) - (inst lr sp-tn args-tn) + (inst lr sp-tn old-fp-tn) (unassemble (assemble-elsewhere node @@ -340,7 +340,7 @@ default-value-5 (count :scs (descriptor-reg))) (:node-var node) (:temporary (:sc descriptor-reg - :offset argument-pointer-offset + :offset old-fp-offset :from :eval :to (:result 0)) values-start) (:temporary (:sc any-reg @@ -348,29 +348,16 @@ default-value-5 :from :eval :to (:result 1)) nvals)) - -;;;; Tail-recursive local call: - -;;; We just do the control transfer. The other stuff is done with explicit -;;; move VOPs. -;;; -(define-vop (tail-call-local) - (:args - (args :more t)) - (:info start) - (:ignore args) - (:generator 5 - (when start - (inst bnb :pz start)))) - ;;;; Local call with unknown values convention return: ;;; Non-TR local call for a fixed number of values passed according to the ;;; unknown values convention. ;;; -;;; Args are the argument passing locations, which are specified only to -;;; terminate their lifetimes in the caller. +;;; When initially emitted, Args reference the values to be passed. +;;; Representation selection changes the Args to reference the passing +;;; locations when it inserts the move-argument VOPs. Arg-Locs is the list of +;;; passing locations used by representation selection. ;;; ;;; Values are the return value locations (wired to the standard passing ;;; locations). @@ -381,11 +368,14 @@ default-value-5 ;;; Nvals is the number of values received. ;;; (define-vop (call-local) - (:args (args :more t)) + (:args (fp :scs (any-reg descriptor-reg)) + (nfp) + (args :more t)) (:results (values :more t)) (:save-p t) - (:info save return-pc target nvals) - (:ignore args save) + (:move-args :local-call) + (:info arg-locs return-pc target nvals) + (:ignore arg-locs args nfp) (:node-var node) (:vop-var vop) (:temporary (:scs (descriptor-reg)) move-temp nil-temp) @@ -394,9 +384,9 @@ default-value-5 env-save) (:generator 5 (store-stack-tn env-save env-tn) - (inst lr cont-tn sp-tn) (inst balix return-pc target) - (inst cal sp-tn sp-tn (current-frame-size)) + (inst lr fp-tn fp) + (no-op) (note-this-location vop :unknown-return) (unassemble (default-unknown-values node values nvals move-temp nil-temp)) @@ -408,19 +398,22 @@ default-value-5 ;;; glob and the number of values received. ;;; (define-vop (multiple-call-local unknown-values-receiver) - (:args (args :more t)) + (:args (fp :scs (any-reg descriptor-reg)) + (nfp) + (args :more t)) (:save-p t) - (:info save return-pc target) - (:ignore args save) + (:move-args :local-call) + (:info arg-locs return-pc target) + (:ignore arg-locs args nfp) (:vop-var vop) (:temporary (:sc stack :offset env-save-offset) env-save) (:generator 20 (store-stack-tn env-save env-tn) - (inst lr cont-tn sp-tn) (inst balix return-pc target) - (inst cal sp-tn sp-tn (current-frame-size)) + (inst lr fp-tn fp) + (no-op) (note-this-location vop :unknown-return) (unassemble (receive-unknown-values node values-start nvals start count)) @@ -433,35 +426,39 @@ default-value-5 ;;; just like argument passing in local call. ;;; (define-vop (known-call-local) - (:args - (args :more t)) + (:args (fp :scs (any-reg descriptor-reg)) + (nfp) + (args :more t)) (:results (res :more t)) + (:move-args :local-call) (:save-p t) - (:info save return-pc target) - (:ignore args res save) + (:info arg-locs return-pc target) + (:ignore arg-locs args res nfp) (:vop-var vop) (:generator 5 - (inst lr cont-tn sp-tn) (inst balix return-pc target) - (inst cal sp-tn sp-tn (current-frame-size)) + (inst lr fp-tn fp) + (no-op) (note-this-location vop :known-return))) ;;; Return from known values call. We receive the return locations as ;;; arguments to terminate their lifetimes in the returning function. We -;;; restore CONT and SP and jump to the Return-PC. +;;; restore FP and SP and jump to the Return-PC. ;;; (define-vop (known-return) (:args - (old-cont :scs (descriptor-reg)) + (old-fp :scs (descriptor-reg)) (return-pc :scs (descriptor-reg)) - (locs :more t)) - (:ignore locs) + (vals :more t)) + (:move-args :known-return) + (:info val-locs) + (:ignore val-locs vals) (:generator 6 - (inst lr sp-tn cont-tn) + (inst lr sp-tn fp-tn) (inst bnbrx :pz return-pc) - (inst lr cont-tn old-cont))) + (inst lr fp-tn old-fp))) ;;;; Full call: @@ -470,10 +467,12 @@ default-value-5 ;;; versions are used depending on whether we know the number of arguments or ;;; the name of the called function, and whether we want fixed values, unknown ;;; values, or a tail call. - -;;; In full call, the arguments are passed by placing them in TNs wired to the -;;; beginning of the current frame (as done by Standard-Argument-Location). A -;;; pointer to these arguments is then passed as the argument pointer. +;;; +;;; In full call, the arguments are passed creating a partial frame on the +;;; stack top and storing stack arguments into that frame. On entry to the +;;; callee, this partial frame is pointed to by FP. If there are no stack +;;; arguments, we don't bother allocating a partial frame, and instead set FP +;;; to SP just before the call. ;;; Define-Full-Call -- Internal @@ -493,14 +492,17 @@ default-value-5 ;;; 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. -;;; The Old-Cont and Return-PC are passed as the second and third arguments. +;;; 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 +;;; return. TR variable argument call is implemented separately. ;;; -;;; Variable is true if there are a variable number of arguments passed on the -;;; stack, with the last argument pointing to the beginning of the arguments. -;;; If Variable is false, the arguments are set up in the standard passing -;;; locations and are passed as the remaining arguments. 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)))) @@ -508,47 +510,47 @@ default-value-5 ,@(when (eq return :unknown) '(unknown-values-receiver))) (:args + ,@(unless (eq return :tail) + '((new-fp :scs (descriptor-reg) :to :eval))) + ,(if named '(name :scs (descriptor-reg) :target name-pass) - '(arg-fun :scs (descriptor-reg) - :target function)) + '(function :scs (descriptor-reg) :to :eval)) ,@(when (eq return :tail) - '((old-cont :scs (descriptor-reg) - :target old-cont-pass) + '((old-fp :scs (descriptor-reg) + :target old-fp-pass) (return-pc :scs (descriptor-reg) :target return-pc-pass))) - ,(if variable - '(args :scs (descriptor-reg) - :target args-pass) - '(args :more t))) - + ,@(unless variable '((args :more t)))) + ,@(when (eq return :fixed) '((:results (values :more t)))) - + ,@(unless (eq return :tail) - '((:save-p t) + `((:save-p t) (:node-var node) (:vop-var vop) (:temporary (:sc stack :offset env-save-offset) - env-save))) + env-save) + ,@(unless variable + '((:move-args :full-call))))) - (:info ,@(unless (eq return :tail) '(save)) + (:info ,@(unless (or variable (eq return :tail)) '(arg-locs)) ,@(unless variable '(nargs)) ,@(when (eq return :fixed) '(nvals))) - (:ignore - ,@(unless (eq return :tail) '(save)) - ,@(unless variable '(args))) + (:ignore ,@(unless (or variable (eq return :tail)) '(arg-locs)) + ,@(unless variable '(args))) (:temporary (:sc descriptor-reg - :offset old-cont-offset + :offset old-fp-offset :from (:argument ,(if (eq return :tail) 1 0)) :to :eval) - old-cont-pass) + old-fp-pass) (:temporary (:sc descriptor-reg :offset return-pc-offset @@ -561,18 +563,11 @@ default-value-5 :offset call-name-offset :from (:argument 0) :to :eval) - name-pass))) - - (:temporary (:scs (descriptor-reg) - :from (:argument 0) - :to :eval) - function) - - (:temporary (:sc descriptor-reg - :offset argument-pointer-offset - :from (:argument ,(if variable 1 0)) - :to :eval) - args-pass) + name-pass) + (:temporary (:scs (descriptor-reg) + :from (:argument 0) + :to :eval) + function))) (:temporary (:sc descriptor-reg :offset argument-count-offset @@ -608,39 +603,38 @@ default-value-5 15 (if (eq return :unknown) 25 0)) - ,@(if named - `((unless (location= name name-pass) - (inst lr name-pass name)) - (loadw function name-pass (/ clc::symbol-definition 4))) - `((unless (location= arg-fun function) - (inst lr function arg-fun)))) + ,@(when named + `((unless (location= name name-pass) + (inst lr name-pass name)) + (loadw function name-pass (/ clc::symbol-definition 4)))) ,@(if variable - `((unless (location= args args-pass) - (inst lr args-pass args)) - (inst lr nargs-pass sp-tn) - (inst s nargs-pass args-pass) + `((inst lr nargs-pass sp-tn) + (inst s nargs-pass new-fp) (inst sari nargs-pass 2) - (loadw a0 args-pass 0) - (loadw a1 args-pass 1) - (loadw a2 args-pass 2)) - `((loadi nargs-pass nargs) - (inst lr args-pass cont-tn))) + (loadw a0 new-fp 0) + (loadw a1 new-fp 1) + (loadw a2 new-fp 2)) + `((loadi nargs-pass nargs))) (load-slot code function system:%function-code-slot) (load-slot offset function system:%function-offset-slot) (inst cas code code offset) ,@(if (eq return :tail) - '((unless (location= old-cont old-cont-pass) - (inst lr old-cont-pass old-cont)) + '((unless (location= old-fp old-fp-pass) + (inst lr old-fp-pass old-fp)) (unless (location= return-pc return-pc-pass) (inst lr return-pc-pass return-pc)) (inst bnbrx :pz code) (inst lr env-tn function)) - '((store-stack-tn env-save env-tn) - (inst lr old-cont-pass cont-tn) - (inst lr cont-tn sp-tn) + `((store-stack-tn env-save env-tn) + (inst lr old-fp-pass fp-tn) + ,(if variable + '(inst lr fp-tn new-fp) + '(if (> nargs register-arg-count) + (inst lr fp-tn new-fp) + (inst lr fp-tn sp-tn))) (inst balrx return-pc-pass code) (inst lr env-tn function) (no-op))) @@ -675,43 +669,41 @@ default-value-5 ;;; down. ;;; ;;; This miscop uses a non-standard calling convention so that the argument -;;; registers are free for loading of stack arguments. Old-Cont, Args and the -;;; function are passed in the registers that they will ultimately go in: -;;; OLD-CONT, ARGS and ENV. The Return-PC is passed in A3 rather than PC -;;; because the BALA trashes PC. We use BALA even though the miscop never -;;; returns, since there isn't any BA. +;;; registers are free for loading of stack arguments. Old-Fp and the function +;;; are passed in the registers that they will ultimately go in: OLD-FP and +;;; ENV. Args is a pointer to the start of the arguments on the stack, and is +;;; passed in the special ARGS passing location. The Return-PC is passed in +;;; A3 rather than PC because the BALA trashes PC. We use BALA even though the +;;; miscop never returns, since there isn't any BA. ;;; ;;; [### We could easily code inline the special case of nargs <= 3.] ;;; (define-vop (tail-call-variable) (:args + (args :scs (descriptor-reg) :target args-pass) (function :scs (descriptor-reg)) - (old-cont :scs (descriptor-reg) - :target old-cont-pass) - (return-pc :scs (descriptor-reg) - :target a3) - (args :scs (descriptor-reg) - :target args-pass)) + (old-fp :scs (descriptor-reg) :target old-fp-pass) + (return-pc :scs (descriptor-reg) :target a3)) (:temporary (:sc descriptor-reg - :offset old-cont-offset - :from (:argument 1)) - old-cont-pass) + :offset old-fp-offset + :from (:argument 2)) + old-fp-pass) (:temporary (:sc descriptor-reg :offset a3-offset - :from (:argument 2)) + :from (:argument 3)) a3) (:temporary (:sc descriptor-reg :offset argument-pointer-offset - :from (:argument 3)) + :from (:argument 0)) args-pass) (:generator 75 (inst lr env-tn function) - (unless (location= old-cont old-cont-pass) - (inst lr old-cont-pass old-cont)) - (unless (location= return-pc a3) - (inst lr a3 return-pc)) (unless (location= args args-pass) (inst lr args-pass args)) + (unless (location= old-fp old-fp-pass) + (inst lr old-fp-pass old-fp)) + (unless (location= return-pc a3) + (inst lr a3 return-pc)) (inst miscop 'clc::tail-call-variable))) @@ -723,17 +715,17 @@ default-value-5 ;;; number of values returned. ;;; ;;; If returning a single value, then deallocate the current frame, restore -;;; CONT and jump to the single-value entry at Return-PC + 4. +;;; FP and jump to the single-value entry at Return-PC + 4. ;;; ;;; If returning other than one value, then load the number of values returned, -;;; NIL out unsupplied values registers, restore CONT and return at Return-PC. +;;; NIL out unsupplied values registers, restore FP and return at Return-PC. ;;; 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-cont :scs (descriptor-reg any-reg)) + (old-fp :scs (descriptor-reg any-reg)) (return-pc :scs (descriptor-reg) :target pc-save) (values :more t)) (:ignore values) @@ -758,19 +750,19 @@ default-value-5 :offset argument-count-offset) nvals-loc) (:temporary (:sc descriptor-reg - :offset argument-pointer-offset) + :offset old-fp-offset) vals-loc) (:generator 6 (cond ((= nvals 1) - (inst lr sp-tn cont-tn) + (inst lr sp-tn fp-tn) (inst inc return-pc 4) (inst bnbrx :pz return-pc) - (inst lr cont-tn old-cont)) + (inst lr fp-tn old-fp)) (t (loadi nvals-loc nvals) - (inst lr vals-loc cont-tn) + (inst lr vals-loc fp-tn) (inst cal sp-tn vals-loc (* nvals 4)) - (inst lr cont-tn old-cont) + (inst lr fp-tn old-fp) (unless (location= pc-save return-pc) (inst lr pc-save return-pc)) @@ -792,14 +784,15 @@ default-value-5 ;;; ;;; The Return-Multiple miscop uses a non-standard calling convention. For one ;;; thing, it doesn't return. We only use BALA because there isn't a BA -;;; instruction. Also, we don't use A0..A2 for argument passing, since the +;;; instruction. Also, we don't use A0..A2 for argument passing, since the ;;; miscop will want to load these with values off of the stack. Instead, we -;;; pass Old-Cont, Start and Count in the normal locations for these values. -;;; Return-PC is passed in A3 since PC is trashed by the BALA. +;;; pass Old-Fp and Count in the normal locations for these values. The +;;; pointer to the start of the return values is passed in the special ARGS +;;; location. Return-PC is passed in A3 since PC is trashed by the BALA. ;;; (define-vop (return-multiple) (:args - (old-cont :scs (descriptor-reg) :target old-cont-pass) + (old-fp :scs (descriptor-reg) :target old-fp-pass) (return-pc :scs (descriptor-reg) :target a3) (start :scs (descriptor-reg) @@ -807,9 +800,9 @@ default-value-5 (count :scs (descriptor-reg) :target nvals-loc)) (:temporary (:sc descriptor-reg - :offset old-cont-offset + :offset old-fp-offset :from (:argument 0)) - old-cont-pass) + old-fp-pass) (:temporary (:sc descriptor-reg :offset a3-offset :from (:argument 1)) @@ -831,16 +824,16 @@ default-value-5 (cmpi count 1) (inst bnbx :eq non-single) (loadw a0 start) - (inst lr sp-tn cont-tn) + (inst lr sp-tn fp-tn) (inst inc return-pc 4) (inst bnbrx :pz return-pc) - (inst lr cont-tn old-cont) + (inst lr fp-tn old-fp) (unassemble (assemble-elsewhere node (emit-label non-single) - (unless (location= old-cont-pass old-cont) - (inst lr old-cont-pass old-cont)) + (unless (location= old-fp-pass old-fp) + (inst lr old-fp-pass old-fp)) (unless (location= a3 return-pc) (inst lr a3 return-pc)) (unless (location= vals-loc start) @@ -852,17 +845,6 @@ default-value-5 ;;;; XEP hackery: - -;;; We get to emit the start label, since we might need to emit variable cruft -;;; to align it, etc. -;;; -(define-vop (allocate-frame) - (:info start-lab) - (:generator 1 - (emit-label start-lab) - (inst cal sp-tn cont-tn (current-frame-size)))) - - ;;; Fetch the constant pool from the function entry structure. ;;; (define-vop (setup-environment) @@ -906,32 +888,10 @@ default-value-5 (:translate %more-arg)) -;;; Turn more arg (context, count) into a list. Context and count are passed -;;; in ARGS and NARGS. +;;; Turn more arg (context, count) into a list. ;;; -(define-vop (listify-rest-args zero-arg-miscop) - (:args (context :target args :scs (any-reg descriptor-reg)) - (count :target nargs :scs (any-reg descriptor-reg))) - (:temporary (:sc any-reg - :offset argument-pointer-offset - :from (:argument 0) - :to :eval) - args) - (:temporary (:sc any-reg - :offset argument-count-offset - :from (:argument 1) - :to :eval) - nargs) - (:variant-vars) - (:translate %listify-rest-args) - (:generator 50 - (unless (location= context args) - (inst lr args context)) - (unless (location= count nargs) - (inst lr nargs count)) - (inst miscop 'clc::listify-rest-args) - (unless (location= a0 r) - (inst lr r a0)))) +(define-miscop listify-rest-args (context count) + :translate %listify-rest-args) ;;; Return the location and size of the more arg glob created by Copy-More-Arg. -- GitLab