0.9.1.52:

[sbcl.git] / src / compiler / alpha / call.lisp

diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp
index 3807d6e..fd82448 100644 (file)
--- 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)))
@@ -315,16 +315,15 @@ default-value-8
            (move ocfp-tn csp-tn)
            
            (let ((defaults (defaults)))
-             (assert defaults)
+             (aver defaults)
              (assemble (*elsewhere*)
                (emit-label default-stack-vals)
                (do ((remaining defaults (cdr remaining)))
                    ((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))))
@@ -595,7 +594,7 @@ default-value-8
 ;;; 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))))
+  (aver (not (and variable (eq return :tail))))
   `(define-vop (,name
                ,@(when (eq return :unknown)
                    '(unknown-values-receiver)))
@@ -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))
@@ -1102,6 +1106,9 @@ default-value-8
 (define-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %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)))
@@ -1112,10 +1119,13 @@ default-value-8
   (:results (result :scs (descriptor-reg)))
   (:translate %listify-rest-args)
   (:policy :safe)
+  (:node-var node)
   (:generator 20
-    (let ((enter (gen-label))
-         (loop (gen-label))
-         (done (gen-label)))
+    (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-arg context)
       (move count-arg count)
       ;; Check to see if there are any arguments.
@@ -1124,11 +1134,13 @@ default-value-8
 
       ;; We need to do this atomically.
       (pseudo-atomic ()
+        ;; align CSP
+        (when dx-p (align-csp temp))
        ;; Allocate a cons (2 words) for each item.
-       (inst bis alloc-tn list-pointer-lowtag result)
+       (inst bis alloc-area-tn list-pointer-lowtag result)
        (move result dst)
        (inst sll count 1 temp)
-       (inst addq alloc-tn temp alloc-tn)
+       (inst addq alloc-area-tn temp alloc-area-tn)
        (inst br zero-tn enter)
 
        ;; Store the current cons in the cdr of the previous cons.