From 92f0ce474660fa51f33126f07ef7103b8b8843c3 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 25 Aug 2013 01:37:17 +0400 Subject: [PATCH] Revert "Clean up %more-arg-values." This reverts commit 1e5296127f5b384a2171646747021ebeee73b801. It breaks slime, a better solution to come in the next release cycle. --- contrib/sb-sprof/sb-sprof.lisp | 4 +++- src/code/debug-int.lisp | 1 + src/code/debug.lisp | 6 +++--- src/code/profile.lisp | 8 +++----- src/compiler/alpha/values.lisp | 11 +++++++++-- src/compiler/fndb.lisp | 2 +- src/compiler/hppa/values.lisp | 11 +++++++++-- src/compiler/ir1tran-lambda.lisp | 2 +- src/compiler/ir2tran.lisp | 3 ++- src/compiler/mips/values.lisp | 11 +++++++++-- src/compiler/ppc/values.lisp | 11 +++++++++-- src/compiler/sparc/values.lisp | 11 +++++++++-- src/compiler/srctran.lisp | 2 +- src/compiler/x86-64/values.lisp | 36 ++++++++++++++++++++++++++++++------ src/compiler/x86/values.lisp | 25 +++++++++++++++++++++---- src/pcl/boot.lisp | 2 +- src/pcl/dlisp.lisp | 1 + 17 files changed, 113 insertions(+), 34 deletions(-) diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index 765ded9..0ce3209 100644 --- 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))))))))) ;;; silly examples diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 38dcf42..e8a188d 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))) -- 1.7.10.4