Commit 01331c56 authored by Nathan Froyd's avatar Nathan Froyd
Browse files

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.
parent 1479483c

src/compiler/fndb.lisp

+3 −0
Original line number Diff line number Diff line
@@ -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)

src/compiler/ir1tran-lambda.lisp

+26 −3
Original line number Diff line number Diff line
@@ -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))

src/compiler/x86-64/call.lisp

+10 −25
Original line number Diff line number Diff line
@@ -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))

src/compiler/x86/call.lisp

+16 −26
Original line number Diff line number Diff line
@@ -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))

version.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -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"