X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fcall.lisp;h=9b402ae4763f4f3193bb8ad60026cca72cf65de7;hb=f143939b1dbaf38ebd4f92c851fbc4ecddf37af1;hp=1da7c1c6b6fca611f4589f5ebbe5e016d65a462a;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 1da7c1c..9b402ae 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -1,29 +1,20 @@ -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; - -;;; -;;; ********************************************************************** -;;; -;;; This file contains the VM definition of function call for the Alpha. -;;; -;;; Written by Rob MacLachlan -;;; -;;; Converted for the Alpha by Sean Hallgren -;;; -(in-package "SB!VM") +;;;; the VM definition of function call for the Alpha +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") -;;;; Interfaces to IR2 conversion: +;;;; interfaces to IR2 conversion -;;; Standard-Argument-Location -- Interface -;;; -;;; Return a wired TN describing the N'th full call argument passing +;;; Return a wired TN describing the N'th full call argument passing ;;; location. -;;; (!def-vm-support-routine standard-argument-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) @@ -34,101 +25,70 @@ control-stack-arg-scn n))) -;;; Make-Return-PC-Passing-Location -- Interface -;;; -;;; Make a passing location TN for a local call return PC. If standard 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. -;;; +;;; Make a passing location TN for a local call return PC. If standard +;;; 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) - #!+gengc (declare (ignore standard)) - #!-gengc (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) - (make-restricted-tn *backend-t-primitive-type* register-arg-scn)) - #!+gengc - (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ra-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. -;;; +;;; 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) (specify-save-tn - (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) + (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) - (let ((ptype #!-gengc *backend-t-primitive-type* - #!+gengc *fixnum-primitive-type*)) + (let ((ptype *backend-t-primitive-type*)) (specify-save-tn - (environment-debug-live-tn (make-normal-tn ptype) env) - (make-wired-tn ptype control-stack-arg-scn - #!-gengc lra-save-offset #!+gengc ra-save-offset)))) + (physenv-debug-live-tn (make-normal-tn ptype) env) + (make-wired-tn ptype control-stack-arg-scn lra-save-offset)))) -;;; Make-Argument-Count-Location -- Interface -;;; -;;; 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. -;;; +;;; 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 () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-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. -;;; +;;; 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 () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -;;; MAKE-STACK-POINTER-TN () -;;; (!def-vm-support-routine make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; MAKE-NUMBER-STACK-POINTER-TN () -;;; (!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 -;;; continuation within a function. -;;; +;;; 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 -;;; placeholder entries in the Constants to leave room for additional -;;; noise in the code object header. -;;; +;;; 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) @@ -137,28 +97,24 @@ (values)) -;;;; Frame hackery: +;;;; frame hackery -;;; BYTES-NEEDED-FOR-NON-DESCRIPTOR-STACK-FRAME -- internal -;;; -;;; Return the number of bytes needed for the current non-descriptor stack -;;; frame. Non-descriptor stack frames must be multiples of 8 bytes on -;;; the PMAX. -;;; +;;; Return the number of bytes needed for the current non-descriptor +;;; stack frame. Non-descriptor stack frames must be multiples of 8 +;;; bytes on the PMAX. (defun bytes-needed-for-non-descriptor-stack-frame () (* (logandc2 (1+ (sb-allocated-size 'non-descriptor-stack)) 1) word-bytes)) -;;; Used for setting up the Old-FP in local call. -;;; +;;; This is used for setting up the Old-FP in local call. (define-vop (current-fp) (:results (val :scs (any-reg))) (:generator 1 (move cfp-tn val))) -;;; 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. -;;; +;;; This is used for computing the caller's NFP for use in +;;; known-values return. It 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) @@ -167,29 +123,28 @@ (when nfp (inst addq nfp (bytes-needed-for-non-descriptor-stack-frame) val))))) - (define-vop (xep-allocate-frame) (:info start-lab copy-more-arg-follows) (:ignore copy-more-arg-follows) (:vop-var vop) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 1 - ;; Make sure the function is aligned, and drop a label pointing to this - ;; function header. + ;; Make sure the function is aligned, and drop a label pointing to + ;; this function header. (align lowtag-bits) (trace-table-entry trace-table-function-prologue) (emit-label start-lab) ;; Allocate function header. - (inst function-header-word) - (dotimes (i (1- function-code-offset)) + (inst simple-fun-header-word) + (dotimes (i (1- simple-fun-code-offset)) (inst lword 0)) ;; The start of the actual code. ;; Compute CODE from the address of this entry point. (let ((entry-point (gen-label))) (emit-label entry-point) (inst compute-code-from-fn code-tn lip-tn entry-point temp) - ;; ### We should also save it on the stack so that the garbage collector - ;; won't forget about us if we call anyone else. + ;; ### We should also save it on the stack so that the garbage + ;; collector won't forget about us if we call anyone else. ) ;; Build our stack frames. (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) cfp-tn) @@ -208,16 +163,15 @@ (trace-table-entry trace-table-function-prologue) (move csp-tn res) (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) csp-tn) - (when (ir2-environment-number-stack-p callee) + (when (ir2-physenv-number-stack-p callee) (inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame) nsp-tn) (move nsp-tn nfp)) (trace-table-entry trace-table-normal))) -;;; 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. -;;; +;;; 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))) @@ -226,23 +180,21 @@ (move csp-tn res) (inst lda csp-tn (* nargs word-bytes) csp-tn)))) - - -;;; Default-Unknown-Values -- Internal -;;; -;;; 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 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). +;;; 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 +;;; 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 return of other -;;; than one value returns directly at the return PC. +;;; This code exploits the fact that in the unknown-values convention, +;;; a single value return returns at the return PC + 8, whereas a +;;; return of other than one value returns directly at the return PC. ;;; -;;; If 0 or 1 values are expected, then we just emit an instruction to reset -;;; the SP (which will only be executed when other than 1 value is returned.) +;;; If 0 or 1 values are expected, then we just emit an instruction to +;;; reset the SP (which will only be executed when other than 1 value +;;; is returned.) ;;; ;;; In the general case, we have to do three things: ;;; -- Default unsupplied register values. This need only be done when a @@ -294,23 +246,21 @@ default-value-8 br defaulting-done nop |# -;;; (defun default-unknown-values (vop values nvals move-temp temp lra-label) (declare (type (or tn-ref null) values) (type unsigned-byte nvals) (type tn move-temp temp)) (if (<= nvals 1) (progn - ;; Note that this is a single-value return point. This is actually - ;; the multiple-value entry point for a single desired value, but - ;; the code location has to be here, or the debugger backtrace - ;; gets confused. + ;; Note that this is a single-value return point. This is + ;; actually the multiple-value entry point for a single + ;; desired value, but the code location has to be here, or the + ;; debugger backtrace gets confused. (without-scheduling () (note-this-location vop :single-value-return) (move ocfp-tn csp-tn) (inst nop)) (when lra-label - #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp) - #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))) + (inst compute-code-from-lra code-tn code-tn lra-label temp))) (let ((regs-defaulted (gen-label)) (defaulting-done (gen-label)) (default-stack-vals (gen-label))) @@ -371,32 +321,28 @@ default-value-8 (store-stack-tn (cdr def) null-tn))))))) (when lra-label - #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp) - #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp)))) + (inst compute-code-from-lra code-tn code-tn lra-label temp)))) (values)) - -;;;; Unknown values receiving: +;;;; 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. -;;; -;;; We do the single and non-single cases with no shared code: there doesn't -;;; seem to be any potential overlap, and receiving a single value is more -;;; important efficiency-wise. +;;; Emit code needed at the return point for an unknown-values call +;;; for an arbitrary number of values. ;;; -;;; When there is a single value, we just push it on the stack, returning -;;; the old SP and 1. +;;; We do the single and non-single cases with no shared code: there +;;; doesn't seem to be any potential overlap, and receiving a single +;;; value is more important efficiency-wise. ;;; -;;; When there is a variable number of values, we move all of the argument -;;; registers onto the stack, and return Args and Nargs. +;;; When there is a single value, we just push it on the stack, +;;; returning the old SP and 1. ;;; -;;; 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). +;;; When there is a variable number of values, we move all of the +;;; argument registers onto the stack, and return Args and Nargs. ;;; +;;; 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)) @@ -406,8 +352,7 @@ default-value-8 (inst nop)) (when lra-label - #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp) - #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp)) + (inst compute-code-from-lra code-tn code-tn lra-label temp)) (inst addq csp-tn 4 csp-tn) (storew (first *register-arg-tns*) csp-tn -1) (inst subq csp-tn 4 start) @@ -418,8 +363,7 @@ default-value-8 (assemble (*elsewhere*) (emit-label variable-values) (when lra-label - #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp) - #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp)) + (inst compute-code-from-lra code-tn code-tn lra-label temp)) (do ((arg *register-arg-tns* (rest arg)) (i 0 (1+ i))) ((null arg)) @@ -429,10 +373,8 @@ default-value-8 (inst br zero-tn done))) (values)) - -;;; VOP that can be inherited by unknown values receivers. The main thing this -;;; handles is allocation of the result temporaries. -;;; +;;; a 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)) @@ -444,10 +386,8 @@ default-value-8 :from :eval :to (:result 1)) nvals) (:temporary (:scs (non-descriptor-reg)) temp)) - - -;;;; Local call with unknown values convention return: +;;;; local call with unknown values convention return ;;; Non-TR local call for a fixed number of values passed according to the ;;; unknown values convention. @@ -458,15 +398,14 @@ default-value-8 ;;; Values are the return value locations (wired to the standard passing ;;; locations). ;;; -;;; Save is the save info, which we can ignore since saving has been done. -;;; Return-PC is the TN that the return PC should be passed in. -;;; Target is a continuation pointing to the start of the called function. -;;; Nvals is the number of values received. -;;; -;;; 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. +;;; Save is the save info, which we can ignore since saving has been +;;; done. Return-PC is the TN that the return PC should be passed in. +;;; Target is a continuation pointing to the start of the called +;;; function. Nvals is the number of values received. ;;; +;;; 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) @@ -500,14 +439,13 @@ default-value-8 (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))) -;;; Non-TR local call for a variable number of return values passed according -;;; to the unknown values convention. The results are the start of the values -;;; glob and the number of values received. -;;; -;;; 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. +;;; Non-TR local call for a variable number of return values passed +;;; according to the unknown values convention. The results are the +;;; start of the values glob and the number of values received. ;;; +;;; 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) @@ -539,15 +477,14 @@ default-value-8 (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))) -;;;; Local call with known values return: +;;;; local call with known values return -;;; Non-TR local call with known return locations. Known-value return works -;;; just like argument passing in local call. +;;; Non-TR local call with known return locations. Known-value return +;;; works just like argument passing in local call. ;;; ;;; 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) @@ -561,7 +498,7 @@ default-value-8 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 5 - (let (#!-gengc (label (gen-label)) + (let ((label (gen-label)) (cur-nfp (current-nfp-tn vop))) (when cur-nfp (store-stack-tn nfp-save cur-nfp)) @@ -578,22 +515,21 @@ default-value-8 (note-this-location vop :known-return) (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))) -;;; Return from known values call. We receive the return locations as -;;; arguments to terminate their lifetimes in the returning function. We -;;; restore FP and CSP and jump to the Return-PC. -;;; -;;; 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. +;;; Return from known values call. We receive the return locations as +;;; arguments to terminate their lifetimes in the returning function. +;;; We restore FP and CSP and jump to the Return-PC. ;;; +;;; 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 (ocfp :target ocfp-temp) (return-pc :target return-pc-temp) (vals :more t)) (:temporary (:sc any-reg :from (:argument 0)) ocfp-temp) - (:temporary (:sc #!-gengc descriptor-reg #!+gengc any-reg :from (:argument 1)) + (:temporary (:sc descriptor-reg any-reg :from (:argument 1)) return-pc-temp) - #!-gengc (:temporary (:scs (interior-reg)) lip) + (:temporary (:scs (interior-reg)) lip) (:move-args :known-return) (:info val-locs) (:ignore val-locs vals) @@ -611,30 +547,27 @@ default-value-8 (move ocfp-temp cfp-tn) (inst ret zero-tn lip 1) (trace-table-entry trace-table-normal))) - -;;;; Full call: -;;; -;;; There is something of a cross-product effect with full calls. Different -;;; 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 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 -;;; -;;; This macro helps in the definition of full call VOPs by avoiding code -;;; replication in defining the cross-product VOPs. +;;;; full call: +;;;; +;;;; There is something of a cross-product effect with full calls. +;;;; Different 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 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. + +;;; 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. ;;; -;;; Named is true if the first argument is a symbol whose global function -;;; definition is to be called. +;;; 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 @@ -645,16 +578,16 @@ default-value-8 ;;; -- If :Tail, then do a tail-recursive call. No values are returned. ;;; The Ocfp 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. -;;; -;;; 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. +;;; 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. ;;; +;;; 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 @@ -846,18 +779,18 @@ default-value-8 (do-next-filler))) #!-gengc (inst ldl function - (- (ash closure-function-slot word-shift) - function-pointer-type) lexenv) + (- (ash closure-fun-slot word-shift) + fun-pointer-type) lexenv) #!-gengc (do-next-filler) #!-gengc (inst addq function - (- (ash function-code-offset word-shift) - function-pointer-type) entry-point) + (- (ash simple-fun-code-offset word-shift) + fun-pointer-type) entry-point) #!+gengc (inst ldl entry-point (- (ash closure-entry-point-slot word-shift) - function-pointer-type) lexenv) + fun-pointer-type) lexenv) #!+gengc (do-next-filler))) (loop @@ -885,7 +818,6 @@ default-value-8 (maybe-load-stack-nfp-tn cur-nfp nfp-save temp))) (:tail)))))) - (define-full-call call nil :fixed nil) (define-full-call call-named t :fixed nil) (define-full-call multiple-call nil :unknown nil) @@ -896,10 +828,8 @@ default-value-8 (define-full-call call-variable nil :fixed t) (define-full-call multiple-call-variable nil :unknown t) - -;;; Defined separately, since needs special code that BLT's the arguments -;;; down. -;;; +;;; This is defined separately, since it needs special code that blits +;;; the arguments down. (define-vop (tail-call-variable) (:args (args-arg :scs (any-reg) :target args) @@ -933,12 +863,10 @@ default-value-8 ;; And jump to the assembly-routine that does the bliting. (inst li (make-fixup 'tail-call-variable :assembly-routine) temp) (inst jmp zero-tn temp))) - -;;;; Unknown values return: +;;;; unknown values return ;;; Return a single value using the unknown-values convention. -;;; (define-vop (return-single) (:args (ocfp :scs (any-reg)) #!-gengc (return-pc :scs (descriptor-reg)) @@ -969,23 +897,22 @@ default-value-8 (inst ret zero-tn temp 1)) (trace-table-entry trace-table-normal))) - -;;; Do unknown-values return of a fixed number of values. The Values are -;;; required to be set up in the standard passing locations. Nvals is the -;;; number of values returned. +;;; Do unknown-values return of a fixed number of values. The Values +;;; are required to be set up in the standard passing locations. Nvals +;;; is the number of values returned. ;;; -;;; If returning a single value, then deallocate the current frame, restore -;;; FP and jump to the single-value entry at Return-PC + 8. -;;; -;;; If returning other than one value, then load the number of values returned, -;;; 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.) +;;; If returning a single value, then deallocate the current frame, +;;; restore FP and jump to the single-value entry at Return-PC + 8. ;;; +;;; If returning other than one value, then load the number of values +;;; returned, 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 (ocfp :scs (any-reg)) - (return-pc :scs (#!-gengc descriptor-reg #!+gengc any-reg) :to (:eval 1) + (return-pc :scs (#!-gengc descriptor-reg #!+gengc any-reg) + :to (:eval 1) #!+gengc :target #!+gengc ra) (values :more t)) (:ignore values) @@ -1023,11 +950,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 (ocfp-arg :scs (any-reg) :target ocfp) #!-gengc (lra-arg :scs (descriptor-reg) :target lra) @@ -1078,14 +1005,10 @@ default-value-8 (inst li (make-fixup 'return-multiple :assembly-routine) temp) (inst jmp zero-tn temp)) (trace-table-entry trace-table-normal))) - - -;;;; XEP hackery: - +;;;; XEP hackery ;;; We don't need to do anything special for regular functions. -;;; (define-vop (setup-environment) (:info label) (:ignore label) @@ -1094,7 +1017,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)) @@ -1106,9 +1028,8 @@ default-value-8 ;; Get result. (move lexenv closure))) -;;; Copy a more arg from the argument area to the end of the current frame. -;;; Fixed is the number of non-more arguments. -;;; +;;; 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) @@ -1121,8 +1042,9 @@ default-value-8 (do-regs (gen-label)) (done (gen-label))) (when (< fixed register-arg-count) - ;; Save a pointer to the results so we can fill in register args. - ;; We don't need this if there are more fixed args than reg args. + ;; Save a pointer to the results so we can fill in register + ;; args. We don't need this if there are more fixed args than + ;; reg args. (move csp-tn result)) ;; Allocate the space on the stack. (cond ((zerop fixed) @@ -1133,14 +1055,14 @@ default-value-8 (inst ble count done) (inst addq csp-tn count csp-tn))) (when (< fixed register-arg-count) - ;; We must stop when we run out of stack args, not when we run out of - ;; more args. + ;; We must stop when we run out of stack args, not when we run + ;; out of &MORE args. (inst subq nargs-tn (fixnumize register-arg-count) count)) ;; Initialize dst to be end of stack. (move csp-tn dst) ;; Everything of interest in registers. (inst ble count do-regs) - ;; Initialize src to be end of args. + ;; Initialize SRC to be end of args. (inst addq cfp-tn nargs-tn src) (emit-label loop) @@ -1154,9 +1076,9 @@ default-value-8 (emit-label do-regs) (when (< fixed register-arg-count) - ;; Now we have to deposit any more args that showed up in registers. - ;; We know there is at least one more arg, otherwise we would have - ;; branched to done up at the top. + ;; Now we have to deposit any more args that showed up in + ;; registers. We know there is at least one &MORE arg, + ;; otherwise we would have branched to DONE up at the top. (inst subq nargs-tn (fixnumize (1+ fixed)) count) (do ((i fixed (1+ i))) ((>= i register-arg-count)) @@ -1168,15 +1090,12 @@ default-value-8 (inst subq count (fixnumize 1) count))) (emit-label done)))) - -;;; More args are stored consequtively 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-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %more-arg) - -;;; Turn more arg (context, count) into a list. -;;; +;;; 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))) @@ -1219,7 +1138,7 @@ default-value-8 ;; Store the value in the car (in delay slot) (storew temp dst 0 list-pointer-type) - ;; Dec count, and if != zero, go back for more. + ;; Decrement count, and if != zero, go back for more. (inst subq count (fixnumize 1) count) (inst bne count loop) @@ -1227,16 +1146,16 @@ default-value-8 (storew null-tn dst 1 list-pointer-type)) (emit-label 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) @@ -1251,9 +1170,7 @@ default-value-8 (inst subq supplied (fixnumize fixed) count) (inst subq csp-tn count context))) - -;;; Signal wrong argument count error if Nargs isn't = to Count. -;;; +;;; Signal wrong argument count error if NARGS isn't equal to COUNT. (define-vop (verify-argument-count) (:policy :fast-safe) (:translate sb!c::%verify-argument-count) @@ -1272,8 +1189,7 @@ default-value-8 (inst subq nargs (fixnumize count) temp) (inst bne temp err-lab)))))) -;;; Various other error signalers. -;;; +;;; various other error signalers (macrolet ((frob (name error translate &rest args) `(define-vop (,name) ,@(when translate