From: Nathan Froyd Date: Sun, 17 Sep 2006 02:26:41 +0000 (+0000) Subject: 0.9.16.33: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=01331c56ab264381fd0e2afb758365112737806b;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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"