0.9.16.33:

	Micro-optimize keyword argument parsing on x86 and x86-64.

	* Change %MORE-ARG to take a negative offset, so we can perform
	  the negation once outside the parsing loop instead of twice
	  each time through the loop;
	* Combine the retrieval of the keyword and its associated value
	  into a single VOP, so we can take advantage of base+index+disp
	  addressing.

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 68036a2..71eb272 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1407,7 +1407,10 @@
 (defknown %special-unbind (t) t)
 (defknown %listify-rest-args (t index) list (flushable))
 (defknown %more-arg-context (t t) (values t index) (flushable))
+#!-stack-grows-downward-not-upward
 (defknown %more-arg (t index) t)
+#!+stack-grows-downward-not-upward
+(defknown %more-kw-arg (t index) (values t t))
 (defknown %more-arg-values (t index index) * (flushable))
 (defknown %verify-arg-count (index index) (values))
 (defknown %arg-count-error (t) nil)

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 2a92b98..a15394a 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -537,6 +537,12 @@
         (arg-vals n-context)
         (arg-vals n-count))
 
+      ;; The reason for all the noise with
+      ;; STACK-GROWS-DOWNWARD-NOT-UPWARD is to enable generation of
+      ;; slightly more efficient code on x86oid processors.  (We can
+      ;; hoist the negation of the index outside the main parsing loop
+      ;; and take advantage of the base+index+displacement addressing
+      ;; mode on x86oids.)
       (when (optional-dispatch-keyp res)
         (let ((n-index (gensym "N-INDEX-"))
               (n-key (gensym "N-KEY-"))
@@ -547,8 +553,15 @@
                           (policy *lexenv* (zerop safety))))
               (found-allow-p nil))
 
-          (temps `(,n-index (1- ,n-count)) n-key n-value-temp)
-          (body `(declare (fixnum ,n-index) (ignorable ,n-key ,n-value-temp)))
+          (temps #!-stack-grows-downward-not-upward
+                 `(,n-index (1- ,n-count))
+                 #!+stack-grows-downward-not-upward
+                 `(,n-index (- (1- ,n-count)))
+                 #!-stack-grows-downward-not-upward n-value-temp
+                 #!-stack-grows-downward-not-upward n-key)
+          (body `(declare (fixnum ,n-index)
+                          #!-stack-grows-downward-not-upward
+                          (ignorable ,n-value-temp ,n-key)))
 
           (collect ((tests))
             (dolist (key keys)
@@ -589,6 +602,7 @@
                 (%odd-key-args-error)))
 
             (body
+             #!-stack-grows-downward-not-upward
              `(locally
                 (declare (optimize (safety 0)))
                 (loop
@@ -597,7 +611,16 @@
                   (decf ,n-index)
                   (setq ,n-key (%more-arg ,n-context ,n-index))
                   (decf ,n-index)
-                  (cond ,@(tests)))))
+                  (cond ,@(tests))))
+             #!+stack-grows-downward-not-upward
+             `(locally (declare (optimize (safety 0)))
+                (loop
+                  (when (plusp ,n-index) (return))
+                  (multiple-value-bind (,n-value-temp ,n-key)
+                      (%more-kw-arg ,n-context ,n-index)
+                    (declare (ignorable ,n-value-temp ,n-key))
+                    (incf ,n-index 2)
+                    (cond ,@(tests))))))
 
             (unless allowp
               (body `(when (and ,n-losep (not ,n-allowp))

diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index 5488403..f4125b0 100644 (file)
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -1257,34 +1257,19 @@
 
     DONE))
 
-;;; &MORE args are stored contiguously on the stack, starting
-;;; immediately at the context pointer. The context pointer is not
-;;; typed, so the lowtag is 0.
-(define-vop (more-arg)
-  (:translate %more-arg)
+(define-vop (more-kw-arg)
+  (:translate sb!c::%more-kw-arg)
   (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg) :target temp))
+  (:args (object :scs (descriptor-reg) :to (:result 1))
+         (index :scs (any-reg) :to (:result 1) :target keyword))
   (:arg-types * tagged-num)
-  (:temporary (:sc unsigned-reg :from (:argument 1) :to :result) temp)
-  (:results (value :scs (any-reg descriptor-reg)))
-  (:result-types *)
-  (:generator 5
-    (move temp index)
-    (inst neg temp)
-    (inst mov value (make-ea :qword :base object :index temp))))
-
-(define-vop (more-arg-c)
-  (:translate %more-arg)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types * (:constant (signed-byte 30)))
-  (:results (value :scs (any-reg descriptor-reg)))
-  (:result-types *)
+  (:results (value :scs (descriptor-reg any-reg))
+            (keyword :scs (descriptor-reg any-reg)))
+  (:result-types * *)
   (:generator 4
-   (inst mov value
-         (make-ea :qword :base object :disp (- (* index n-word-bytes))))))
+     (inst mov value (make-ea :qword :base object :index index))
+     (inst mov keyword (make-ea :qword :base object :index index
+                                :disp n-word-bytes))))))
 
 ;;; Turn more arg (context, count) into a list.
 (defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))

diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index c080a6e..5f4f80a 100644 (file)
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/call.lisp
@@ -1288,35 +1288,25 @@
 
     DONE))
 
-;;; &MORE args are stored contiguously on the stack, starting
-;;; immediately at the context pointer. The context pointer is not
-;;; typed, so the lowtag is 0.
-(define-vop (more-arg)
-  (:translate %more-arg)
+(define-vop (more-kw-arg)
+  (:translate sb!c::%more-kw-arg)
   (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg) :target temp))
+  (:args (object :scs (descriptor-reg) :to (:result 1))
+         (index :scs (any-reg immediate) :to (:result 1) :target keyword))
   (:arg-types * tagged-num)
-  (:temporary (:sc unsigned-reg :from (:argument 1) :to :result) temp)
-  (:results (value :scs (any-reg descriptor-reg)))
-  (:result-types *)
-  (:generator 5
-    (move temp index)
-    (inst neg temp)
-    (inst mov value (make-ea :dword :base object :index temp))))
-
-(define-vop (more-arg-c)
-  (:translate %more-arg)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types * (:constant (signed-byte 30)))
-  (:results (value :scs (any-reg descriptor-reg)))
-  (:result-types *)
+  (:results (value :scs (descriptor-reg any-reg))
+            (keyword :scs (descriptor-reg any-reg)))
+  (:result-types * *)
   (:generator 4
-   (inst mov value
-         (make-ea :dword :base object :disp (- (* index n-word-bytes))))))
-
+    (sc-case index
+      (immediate
+       (inst mov value (make-ea :dword :base object :disp (tn-value index)))
+       (inst mov keyword (make-ea :dword :base object
+                                  :disp (+ (tn-value index) n-word-bytes))))
+      (t
+       (inst mov value (make-ea :dword :base object :index index))
+       (inst mov keyword (make-ea :dword :base object :index index
+                                  :disp n-word-bytes))))))
 
 ;;; Turn more arg (context, count) into a list.
 (defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))

diff --git a/version.lisp-expr b/version.lisp-expr
index 248324a..47a3786 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.16.32"
+"0.9.16.33"