X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fcall.lisp;h=538853bf18b9a595796f2c6e691d60e1b20a4770;hb=fe36a56422d474a00a58812ec886eb14f024ba0d;hp=3807d6e478d756623c274709aebd3cff9d29cfc4;hpb=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;p=sbcl.git diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 3807d6e..538853b 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -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)))) @@ -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)) @@ -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)