X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran-lambda.lisp;h=a15394aefd8cfe375a3270c87179cfc16cc9002e;hb=a0c5831b3a74118cf41a848300200a1acdb48dcf;hp=2a92b9894a4957c0cfb60931fdc1e845d1a400fe;hpb=665eea819b61f87f401ff0a9ff82f6cbdcc5c636;p=sbcl.git

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 2a92b98..a15394a 100644
--- 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))