X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fcall.lisp;h=a0be04811ca0c69a7610a6e7086b52f24cec7e18;hb=2253ebaef8a0a1527d2282a1c10f48c62e0d4a83;hp=6d8098ee2c22d4553b0b04e5fb222a86db63d363;hpb=ea775867d48327bf1179eb570263427f28083880;p=sbcl.git diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp index 6d8098e..a0be048 100644 --- a/src/compiler/sparc/call.lisp +++ b/src/compiler/sparc/call.lisp @@ -34,9 +34,9 @@ (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; 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 +;;; 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) @@ -87,9 +87,9 @@ (make-normal-tn *fixnum-primitive-type*))) -;;; 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 +;;; 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)) @@ -182,7 +182,7 @@ ;;; 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). @@ -317,8 +317,6 @@ default-value-8 (values)) -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call ;;; for an arbitrary number of values. ;;; @@ -330,12 +328,12 @@ default-value-8 ;;; returning the old SP and 1. ;;; ;;; When there is a variable number of values, we move all of the -;;; argument registers onto the stack, and return Args and Nargs. +;;; argument registers onto the stack, and return ARGS and NARGS. ;;; -;;; Args and Nargs are TNs wired to the named locations. We must +;;; 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). +;;; 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)) @@ -592,7 +590,7 @@ default-value-8 ;;; 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)))) + (aver (not (and variable (eq return :tail)))) `(define-vop (,name ,@(when (eq return :unknown) '(unknown-values-receiver))) @@ -1070,8 +1068,10 @@ default-value-8 (:variant 0 0) (:translate %more-arg)) - ;;; Turn more arg (context, count) into a list. +(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args)) + t) + (define-vop (listify-rest-args) (:args (context-arg :target context :scs (descriptor-reg)) (count-arg :target count :scs (any-reg))) @@ -1083,32 +1083,39 @@ default-value-8 (:results (result :scs (descriptor-reg))) (:translate %listify-rest-args) (:policy :safe) + (:node-var node) (:generator 20 - (move context context-arg) - (move count count-arg) - ;; Check to see if there are any arguments. - (inst cmp count) - (inst b :eq done) - (move result null-tn) - - ;; We need to do this atomically. - (pseudo-atomic () - (assemble () + (let* ((enter (gen-label)) + (loop (gen-label)) + (done (gen-label)) + (dx-p (node-stack-allocate-p node)) + (alloc-area-tn (if dx-p csp-tn alloc-tn))) + (move context context-arg) + (move count count-arg) + ;; Check to see if there are any arguments. + (inst cmp count) + (inst b :eq done) + (move result null-tn) + + ;; We need to do this atomically. + (pseudo-atomic () + (when dx-p + (align-csp temp)) ;; Allocate a cons (2 words) for each item. - (inst andn result alloc-tn lowtag-mask) + (inst andn result alloc-area-tn lowtag-mask) (inst or result list-pointer-lowtag) (move dst result) (inst sll temp count 1) (inst b enter) - (inst add alloc-tn temp) + (inst add alloc-area-tn temp) ;; Compute the next cons and store it in the current one. - LOOP + (emit-label loop) (inst add dst dst (* 2 n-word-bytes)) (storew dst dst -1 list-pointer-lowtag) ;; Grab one value. - ENTER + (emit-label enter) (loadw temp context) (inst add context context n-word-bytes) @@ -1121,8 +1128,8 @@ default-value-8 (storew temp dst 0 list-pointer-lowtag) ;; NIL out the last cons. - (storew null-tn dst 1 list-pointer-lowtag))) - DONE)) + (storew null-tn dst 1 list-pointer-lowtag)) + (emit-label done)))) ;;; Return the location and size of the more arg glob created by Copy-More-Arg.