X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fcall.lisp;h=538853bf18b9a595796f2c6e691d60e1b20a4770;hb=fe36a56422d474a00a58812ec886eb14f024ba0d;hp=f59202c56763a889d160937101c019d587cddcb3;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index f59202c..538853b 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -15,7 +15,7 @@ ;;; 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-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) (make-wired-tn *backend-t-primitive-type* @@ -62,7 +62,7 @@ ;;; 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-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) @@ -132,7 +132,7 @@ ;; Make sure the function is aligned, and drop a label pointing to ;; this function header. (align n-lowtag-bits) - (trace-table-entry trace-table-function-prologue) + (trace-table-entry trace-table-fun-prologue) (emit-label start-lab) ;; Allocate function header. (inst simple-fun-header-word) @@ -163,7 +163,7 @@ (nfp :scs (any-reg))) (:info callee) (:generator 2 - (trace-table-entry trace-table-function-prologue) + (trace-table-entry trace-table-fun-prologue) (move csp-tn res) (inst lda csp-tn @@ -187,7 +187,7 @@ (inst lda csp-tn (* nargs n-word-bytes) csp-tn)))) ;;; 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). @@ -306,7 +306,7 @@ default-value-8 (tn (tn-ref-tn val))) (defaults (cons default-lab tn)) - (inst blt temp default-lab) + (inst ble temp default-lab) (inst ldl move-temp (* i n-word-bytes) ocfp-tn) (inst subq temp (fixnumize 1) temp) (store-stack-tn tn move-temp))) @@ -322,9 +322,8 @@ default-value-8 ((null remaining)) (let ((def (car remaining))) (emit-label (car def)) - (when (null (cdr remaining)) - (inst br zero-tn defaulting-done)) - (store-stack-tn (cdr def) null-tn))))))) + (store-stack-tn (cdr def) null-tn))) + (inst br zero-tn defaulting-done))))) (when lra-label (inst compute-code-from-lra code-tn code-tn lra-label temp)))) @@ -541,7 +540,7 @@ default-value-8 (:ignore val-locs vals) (:vop-var vop) (:generator 6 - (trace-table-entry trace-table-function-epilogue) + (trace-table-entry trace-table-fun-epilogue) (maybe-load-stack-tn ocfp-temp ocfp) (maybe-load-stack-tn return-pc-temp return-pc) (move cfp-tn csp-tn) @@ -575,20 +574,20 @@ default-value-8 ;;; 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 -;;; the standard passing locations (passed as result operands). -;;; -- 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 +;;; 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 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 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 +;;; cannot be specified with :TAIL return. TR variable argument call ;;; is implemented separately. ;;; ;;; In tail call with fixed arguments, the passing locations are @@ -885,7 +884,7 @@ default-value-8 (:vop-var vop) (:generator 6 ;; Clear the number stack. - (trace-table-entry trace-table-function-epilogue) + (trace-table-entry trace-table-fun-epilogue) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame) @@ -936,7 +935,7 @@ default-value-8 (:vop-var vop) (:generator 6 ;; Clear the number stack. - (trace-table-entry trace-table-function-epilogue) + (trace-table-entry trace-table-fun-epilogue) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame) @@ -947,7 +946,12 @@ default-value-8 ;; restore the frame pointer and clear as much of the control ;; stack as possible. (move ocfp cfp-tn) - (inst addq val-ptr (* nvals n-word-bytes) csp-tn) + ;; ADDQ only accepts immediates of type (UNSIGNED-BYTE 8). Here, + ;; instead of adding (* NVALS N-WORD-BYTES), we use NARGS that + ;; we've carefully set up, but protect ourselves by averring that + ;; FIXNUMIZEation and multiplication by N-WORD-BYTES is the same. + (aver (= (* nvals n-word-bytes) (fixnumize nvals))) + (inst addq val-ptr nargs csp-tn) ;; pre-default any argument register that need it. (when (< nvals register-arg-count) (dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals)) @@ -983,7 +987,7 @@ default-value-8 (:vop-var vop) (:generator 13 - (trace-table-entry trace-table-function-epilogue) + (trace-table-entry trace-table-fun-epilogue) (let ((not-single (gen-label))) ;; Clear the number stack. (let ((cur-nfp (current-nfp-tn vop))) @@ -1105,7 +1109,9 @@ default-value-8 (define-vop (listify-rest-args) (:args (context-arg :target context :scs (descriptor-reg)) (count-arg :target count :scs (any-reg))) - (:arg-types * tagged-num) + (:info dx) + (:ignore dx) + (:arg-types * tagged-num (:constant t)) (:temporary (:scs (any-reg) :from (:argument 0)) context) (:temporary (:scs (any-reg) :from (:argument 1)) count) (:temporary (:scs (descriptor-reg) :from :eval) temp dst) @@ -1177,9 +1183,9 @@ default-value-8 (inst subq csp-tn count context))) ;;; Signal wrong argument count error if NARGS isn't equal to COUNT. -(define-vop (verify-argument-count) +(define-vop (verify-arg-count) (:policy :fast-safe) - (:translate sb!c::%verify-argument-count) + (:translate sb!c::%verify-arg-count) (:args (nargs :scs (any-reg))) (:arg-types positive-fixnum (:constant t)) (:temporary (:scs (any-reg) :type fixnum) temp) @@ -1188,7 +1194,7 @@ default-value-8 (:save-p :compute-only) (:generator 3 (let ((err-lab - (generate-error-code vop invalid-argument-count-error nargs))) + (generate-error-code vop invalid-arg-count-error nargs))) (cond ((zerop count) (inst bne nargs err-lab)) (t @@ -1208,14 +1214,14 @@ default-value-8 (:save-p :compute-only) (:generator 1000 (error-call vop ,error ,@args))))) - (frob argument-count-error invalid-argument-count-error - sb!c::%argument-count-error nargs) + (frob arg-count-error invalid-arg-count-error + sb!c::%arg-count-error nargs) (frob type-check-error object-not-type-error sb!c::%type-check-error object type) (frob layout-invalid-error layout-invalid-error sb!c::%layout-invalid-error object layout) - (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 odd-key-args-error odd-key-args-error + sb!c::%odd-key-args-error) + (frob unknown-key-arg-error unknown-key-arg-error + sb!c::%unknown-key-arg-error key) (frob nil-fun-returned-error nil-fun-returned-error nil fun))