Revert "Clean up %more-arg-values."

This reverts commit 1e5296127f5b384a2171646747021ebeee73b801.
It breaks slime, a better solution to come in the next release cycle.

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index 765ded9..0ce3209 100644 (file)
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -1409,7 +1409,9 @@ functions during statistical profiling."
                   (incf (the (unsigned-byte 59)
                           (car info)))
                   (multiple-value-call original-fun
-                    (sb-c:%more-arg-values more-context more-count)))))))))
+                    (sb-c:%more-arg-values more-context
+                                           0
+                                           more-count)))))))))
 
 \f
 ;;; silly examples

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 38dcf42..e8a188d 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2656,6 +2656,7 @@ register."
              (let ((count-var (fourth bind)))
                (specs `(,name (multiple-value-list
                                (sb!c:%more-arg-values (debug-var-value ',var ,n-frame)
+                                                      0
                                                       (debug-var-value ',count-var ,n-frame)))))))
             (:unknown
              (specs `(,name (debug-signal 'invalid-value

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index f7138e3..588419a 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -508,7 +508,7 @@ thread, NIL otherwise."
                            (setf reversed-result
                                  (append (reverse
                                           (multiple-value-list
-                                           (sb!c::%more-arg-values context count)))
+                                           (sb!c::%more-arg-values context 0 count)))
                                          reversed-result))
                            (return-from enumerating))
                          (push (make-unprintable-object "unavailable &MORE argument")
@@ -559,7 +559,7 @@ thread, NIL otherwise."
                  (butlast args 2)
                  (if (fixnump count)
                      (multiple-value-list
-                      (sb!c:%more-arg-values context count))
+                      (sb!c:%more-arg-values context 0 count))
                      (list
                       (make-unprintable-object "more unavailable arguments")))))
               args)
@@ -1595,7 +1595,7 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
           (when (and more-context more-count)
             (format *debug-io* "~S  =  ~S~%"
                     'more
-                    (multiple-value-list (sb!c:%more-arg-values more-context more-count))))
+                    (multiple-value-list (sb!c:%more-arg-values more-context 0 more-count))))
           (cond
            ((not any-p)
             (format *debug-io*

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index ec881ba..da4f0b6 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -180,8 +180,7 @@
              (dconsing 0)
              (inner-enclosed-profiles 0)
              (dgc-run-time 0))
-         (declare (truly-dynamic-extent dticks dconsing
-                                        inner-enclosed-profiles))
+         (declare (truly-dynamic-extent dticks dconsing inner-enclosed-profiles))
          (unwind-protect
              (let* ((start-ticks (get-internal-ticks))
                     (start-gc-run-time *gc-run-time*)
@@ -191,12 +190,11 @@
                     (nbf0 *n-bytes-freed-or-purified*)
                     (dynamic-usage-0 (sb-kernel:dynamic-usage))
                     (*enclosed-gc-run-time* (make-counter)))
-               (declare (dynamic-extent *enclosed-ticks* *enclosed-consing*
-                                        *enclosed-profiles*
-                                        *enclosed-gc-run-time*))
+               (declare (dynamic-extent *enclosed-ticks* *enclosed-consing* *enclosed-profiles* *enclosed-gc-run-time*))
                (unwind-protect
                    (multiple-value-call encapsulated-fun
                                         (sb-c:%more-arg-values arg-context
+                                                               0
                                                                arg-count))
                  (let ((*computing-profiling-data-for* encapsulated-fun)
                        (dynamic-usage-1 (sb-kernel:dynamic-usage)))

diff --git a/src/compiler/alpha/values.lisp b/src/compiler/alpha/values.lisp
index 766f1f0..c0fc37f 100644 (file)
--- a/src/compiler/alpha/values.lisp
+++ b/src/compiler/alpha/values.lisp
@@ -123,8 +123,9 @@
 ;;; them as function arguments.
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg zero immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :from (:argument 0)) src)
   (:temporary (:sc any-reg :from (:argument 2)) dst)
   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
@@ -132,7 +133,13 @@
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move context src)
+    (sc-case skip
+      (zero
+       (move context src))
+      (immediate
+       (inst lda src (* (tn-value skip) n-word-bytes) context))
+      (any-reg
+       (inst addq context skip src)))
     (move num count)
     (inst move csp-tn start)
     (inst beq num done)

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 2945554..4089b77 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1446,7 +1446,7 @@
 ;;; FIXME: The second argument here should really be NEGATIVE-INDEX, but doing that
 ;;; breaks the build, and I cannot seem to figure out why. --NS 2006-06-29
 (defknown %more-kw-arg (t fixnum) (values t t))
-(defknown %more-arg-values (t index) * (flushable))
+(defknown %more-arg-values (t index index) * (flushable))
 (defknown %verify-arg-count (index index) (values))
 (defknown %arg-count-error (t) nil)
 (defknown %unknown-values () *)

diff --git a/src/compiler/hppa/values.lisp b/src/compiler/hppa/values.lisp
index 96af71f..44df9fe 100644 (file)
--- a/src/compiler/hppa/values.lisp
+++ b/src/compiler/hppa/values.lisp
@@ -127,15 +127,22 @@
 ;;;
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg zero immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :from (:argument 0)) src)
   (:temporary (:sc any-reg :from (:argument 2)) dst end)
   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move context src)
+    (sc-case skip
+      (zero
+       (move context src))
+      (immediate
+       (inst addi (* (tn-value skip) n-word-bytes) context src))
+      (any-reg
+       (inst add skip context src)))
     (move num count)
     (inst comb := num zero-tn done)
     (move csp-tn start t)

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 399b948..ce06727 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -688,7 +688,7 @@
       (unless (lambda-var-ignorep rest)
         ;; Make up two extra variables, and squirrel them away in
         ;; ARG-INFO-DEFAULT for transforming (VALUES-LIST REST) into
-        ;; (%MORE-ARG-VALUES CONTEXT COUNT) when possible.
+        ;; (%MORE-ARG-VALUES CONTEXT 0 COUNT) when possible.
         (let* ((context-name (sb!xc:gensym "REST-CONTEXT-"))
                (context (make-lambda-var :%source-name context-name
                                          :arg-info (make-arg-info :kind :more-context)))

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 568c898..026dd5f 100644 (file)
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1518,7 +1518,7 @@
                        (eq (ir2-lvar-kind 2lvar) :fixed)))
              (ir2-convert-full-call node block)))))
 
-(defoptimizer (%more-arg-values ir2-convert) ((context count) node block)
+(defoptimizer (%more-arg-values ir2-convert) ((context start count) node block)
   (binding* ((lvar (node-lvar node) :exit-if-null)
              (2lvar (lvar-info lvar)))
     (ecase (ir2-lvar-kind 2lvar)
@@ -1537,6 +1537,7 @@
        (let ((locs (ir2-lvar-locs 2lvar)))
          (vop* %more-arg-values node block
                ((lvar-tn node block context)
+                (lvar-tn node block start)
                 (lvar-tn node block count)
                 nil)
                ((reference-tn-list locs t))))))))

diff --git a/src/compiler/mips/values.lisp b/src/compiler/mips/values.lisp
index da85978..a04921b 100644 (file)
--- a/src/compiler/mips/values.lisp
+++ b/src/compiler/mips/values.lisp
@@ -144,15 +144,22 @@
 ;;; as function arguments.
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg zero immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :from (:argument 0)) src)
   (:temporary (:sc any-reg :from (:argument 2)) dst)
   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move src context)
+    (sc-case skip
+      (zero
+       (move src context))
+      (immediate
+       (inst addu src context (* (tn-value skip) n-word-bytes)))
+      (any-reg
+       (inst addu src context skip)))
     (move count num)
     (inst beq num done)
     (move start csp-tn t)

diff --git a/src/compiler/ppc/values.lisp b/src/compiler/ppc/values.lisp
index ddead7c..7f868c1 100644 (file)
--- a/src/compiler/ppc/values.lisp
+++ b/src/compiler/ppc/values.lisp
@@ -116,8 +116,9 @@
 ;;;
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg zero immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :from (:argument 0)) src)
   (:temporary (:sc any-reg :from (:argument 2)) dst)
   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
@@ -125,7 +126,13 @@
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (inst mr src context)
+    (sc-case skip
+      (zero
+       (inst mr src context))
+      (immediate
+       (inst addi src context (* (tn-value skip) n-word-bytes)))
+      (any-reg
+       (inst add src context skip)))
     (inst mr. count num)
     (inst mr start csp-tn)
     (inst beq done)

diff --git a/src/compiler/sparc/values.lisp b/src/compiler/sparc/values.lisp
index 468176e..a7ac2b1 100644 (file)
--- a/src/compiler/sparc/values.lisp
+++ b/src/compiler/sparc/values.lisp
@@ -141,8 +141,9 @@
 ;;; as function arguments.
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg zero immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :from (:argument 0)) src)
   (:temporary (:sc any-reg :from (:argument 2)) dst)
   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
@@ -150,7 +151,13 @@
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move src context)
+    (sc-case skip
+      (zero
+       (move src context))
+      (immediate
+       (inst add src context (* (tn-value skip) n-word-bytes)))
+      (any-reg
+       (inst add src context skip)))
     (inst orcc count zero-tn num)
     (inst b :eq done)
     (inst move start csp-tn)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index c7207d6..69275ff 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -4340,7 +4340,7 @@
 
 (deftransform %rest-values ((list context count))
   (if (rest-var-more-context-ok list)
-      `(%more-arg-values context count)
+      `(%more-arg-values context 0 count)
       `(values-list list)))
 
 (deftransform %rest-ref ((n list context count))

diff --git a/src/compiler/x86-64/values.lisp b/src/compiler/x86-64/values.lisp
index 3c9b4cf..624483b 100644 (file)
--- a/src/compiler/x86-64/values.lisp
+++ b/src/compiler/x86-64/values.lisp
@@ -107,19 +107,43 @@
 ;;; defining a new stack frame.
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
-  (:temporary (:sc any-reg :from (:argument 0)) src)
-  (:temporary (:sc descriptor-reg) temp)
+  (:arg-types * positive-fixnum positive-fixnum)
+  (:temporary (:sc any-reg :offset rsi-offset :from (:argument 0)) src)
+  (:temporary (:sc descriptor-reg :offset rax-offset) temp)
   (:temporary (:sc unsigned-reg :offset rcx-offset) loop-index)
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move src context)
-    (move count num)
+    (sc-case skip
+      (immediate
+       (cond ((zerop (tn-value skip))
+              (move src context)
+              (move count num))
+             (t
+              (inst lea src (make-ea :dword :base context
+                                     :disp (- (* (tn-value skip)
+                                                 n-word-bytes))))
+              (move count num)
+              (inst sub count (* (tn-value skip) n-word-bytes)))))
+
+      (any-reg
+       (move src context)
+       #!+#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+       (inst sub src skip)
+       #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or))
+       (progn
+         ;; FIXME: This can't be efficient, but LEA (my first choice)
+         ;; doesn't do subtraction.
+         (inst shl skip (- word-shift n-fixnum-tag-bits))
+         (inst sub src skip)
+         (inst shr skip (- word-shift n-fixnum-tag-bits)))
+       (move count num)
+       (inst sub count skip)))
 
     (inst lea loop-index (make-ea :byte :index count
-                                        :scale (ash 1 (- word-shift n-fixnum-tag-bits))))
+                                  :scale (ash 1 (- word-shift n-fixnum-tag-bits))))
     (inst mov start rsp-tn)
     (inst jrcxz DONE)  ; check for 0 count?
 

diff --git a/src/compiler/x86/values.lisp b/src/compiler/x86/values.lisp
index c7c294b..082ad2c 100644 (file)
--- a/src/compiler/x86/values.lisp
+++ b/src/compiler/x86/values.lisp
@@ -109,16 +109,32 @@
 ;;; defining a new stack frame.
 (define-vop (%more-arg-values)
   (:args (context :scs (descriptor-reg any-reg) :target src)
+         (skip :scs (any-reg immediate))
          (num :scs (any-reg) :target count))
-  (:arg-types * positive-fixnum)
+  (:arg-types * positive-fixnum positive-fixnum)
   (:temporary (:sc any-reg :offset esi-offset :from (:argument 0)) src)
   (:temporary (:sc descriptor-reg :offset eax-offset) temp)
   (:temporary (:sc unsigned-reg :offset ecx-offset) loop-index)
   (:results (start :scs (any-reg))
             (count :scs (any-reg)))
   (:generator 20
-    (move src context)
-    (move count num)
+    (sc-case skip
+      (immediate
+       (cond ((zerop (tn-value skip))
+              (move src context)
+              (move count num))
+             (t
+              (inst lea src (make-ea :dword :base context
+                                     :disp (- (* (tn-value skip)
+                                                 n-word-bytes))))
+              (move count num)
+              (inst sub count (* (tn-value skip) n-word-bytes)))))
+
+      (any-reg
+       (move src context)
+       (inst sub src skip)
+       (move count num)
+       (inst sub count skip)))
 
     (move loop-index count)
     (inst mov start esp-tn)
@@ -133,5 +149,6 @@
     (inst mov (make-ea :dword :base esp-tn :index loop-index) temp)
     (inst jmp :nz LOOP)
 
-    DONE))
+    DONE
+    ))
 

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index cbf6259..e470eb4 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1076,7 +1076,7 @@ bootstrapping.
             (values (fast-method-call-pv ,method-call))
             (values (fast-method-call-next-method-call ,method-call))
             ,@required-args
-            (sb-c::%more-arg-values ,more-context ,more-count))))))
+            (sb-c::%more-arg-values ,more-context 0 ,more-count))))))
 
 (defstruct (fast-instance-boundp (:copier nil))
   (index 0 :type fixnum))

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index b568cf3..27f601c 100644 (file)
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -300,6 +300,7 @@
   (if applyp
       `(multiple-value-call ,miss-fn ,@args
                             (sb-c::%more-arg-values .more-context.
+                                                    0
                                                     .more-count.))
       `(funcall ,miss-fn ,@args)))