Changeset 15495


Ignore:
Timestamp:
Nov 10, 2012, 11:20:48 AM (7 years ago)
Author:
gb
Message:

Inline ASH in more cases when the shift count isn't a constant,
specifically:

  • when the result type is asserted to be a subtype of FIXNUM, the value being shifted is asserted to be a subtype of FIXNUM, and the shift count is asserted to be of an integer type whose bounds are less than the machine word size (e.g., (SIGNED-BYTE 5) on 32-bit platforms.)
  • when the same constraints are true of the shift count and we know enough about the type of the value to know that the result will be a FIXNUM.

This doesn't depend on any new runtime support and should bootstrap
cleanly.

Location:
trunk/source/compiler
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm-vinsns.lisp

    r15492 r15495  
    29592959   (mov dest (:lsr src (:$ count)))))
    29602960
     2961(define-arm-vinsn fixnum-ash-left (((dest :lisp))
     2962                                   ((num :lisp)
     2963                                    (amt :lisp))
     2964                                   ((temp :s32)))
     2965  (mov temp (:asr amt (:$ arm::fixnumshift)))
     2966  (mov dest (:lsl num temp)))
     2967
     2968(define-arm-vinsn fixnum-ash (((dest :lisp))
     2969                              ((num :lisp)
     2970                               (amt :lisp))
     2971                              ((temp :s32)))
     2972  (movs temp (:asr amt (:$ arm::fixnumshift)))
     2973  (movge dest (:lsl num temp))
     2974  (bge :done)
     2975  (rsb temp temp (:$ 0))
     2976  (mov temp (:asr num temp))
     2977  (bic dest temp (:$ arm::fixnummask))
     2978  :done)
     2979
    29612980
    29622981(define-arm-vinsn trap-unless-simple-array-2 (()
  • trunk/source/compiler/ARM/arm2.lisp

    r15431 r15495  
    94309430        (arm2-fixed-call-builtin seg vreg xfer '.SPbuiltin-ash))))
    94319431
     9432
     9433(defarm2 arm2-fixnum-ash fixnum-ash (seg vreg xfer num amt)
     9434  (multiple-value-bind (rnum ramt) (arm2-two-untargeted-reg-forms seg num ($ arm::arg_y) amt ($ arm::arg_z))
     9435    (let* ((amttype (specifier-type (acode-form-type amt *arm2-trust-declarations*))))
     9436      (ensuring-node-target (target vreg)
     9437        (if (and (typep amttype 'numeric-ctype)
     9438                 (>= (numeric-ctype-low amttype) 0))
     9439          (! fixnum-ash-left target rnum ramt)
     9440          (! fixnum-ash target rnum ramt)))
     9441      (^))))
     9442
     9443
    94329444(defarm2 arm2-fixnum-ref-double-float %fixnum-ref-double-float (seg vreg xfer base index)
    94339445  (if (null vreg)
  • trunk/source/compiler/PPC/PPC32/ppc32-vinsns.lisp

    r15017 r15495  
    28222822  (rlwinm dest src (:apply - 32 count) count 31))
    28232823
     2824(define-ppc32-vinsn fixnum-ash-left (((dest :lisp))
     2825                                     ((num :lisp)
     2826                                      (amt :lisp))
     2827                                     ((count :s32)))
     2828  (srawi count amt ppc32::fixnumshift)
     2829  (slw dest num count))
     2830
     2831(define-ppc32-vinsn fixnum-ash (((dest :lisp))
     2832                                ((num :lisp)
     2833                                 (amt :lisp))
     2834                                ((count :s32)
     2835                                 (crf0 (:crf 0))))
     2836  (srawi. count amt ppc32::fixnumshift)
     2837  (blt :right)
     2838  (slw dest num count)
     2839  (b :done)
     2840  :right
     2841  (neg count count)
     2842  (sraw count num count)
     2843  (clrrwi dest count ppc32::fixnumshift)
     2844  :done)
     2845 
    28242846
    28252847(define-ppc32-vinsn trap-unless-simple-array-2 (()
  • trunk/source/compiler/PPC/PPC64/ppc64-vinsns.lisp

    r15017 r15495  
    28272827                                          (count :u8const)))
    28282828  (rldicr dest src (:apply - 64 count) count))
     2829
     2830
     2831(define-ppc64-vinsn fixnum-ash-left (((dest :lisp))
     2832                                     ((num :lisp)
     2833                                      (amt :lisp))
     2834                                     ((count :s64)))
     2835  (sradi count amt ppc64::fixnumshift)
     2836  (sld dest num count))
     2837
     2838(define-ppc64-vinsn fixnum-ash (((dest :lisp))
     2839                                ((num :lisp)
     2840                                 (amt :lisp))
     2841                                ((count :s32)
     2842                                 (crf0 (:crf 0))))
     2843  (sradi. count amt ppc64::fixnumshift)
     2844  (blt :right)
     2845  (sld dest num count)
     2846  (b :done)
     2847  :right
     2848  (neg count count)
     2849  (srad count num count)
     2850  (clrrdi dest count ppc64::fixnumshift)
     2851  :done)
    28292852
    28302853(define-ppc64-vinsn sign-extend-halfword (((dest :imm))
  • trunk/source/compiler/PPC/ppc2.lisp

    r15151 r15495  
    92339233        (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPbuiltin-ash)))))
    92349234
     9235(defppc2 ppc2-fixnum-ash fixnum-ash (seg vreg xfer num amt)
     9236  (multiple-value-bind (rnum ramt) (ppc2-two-untargeted-reg-forms seg num ($ ppc::arg_y) amt ($ ppc::arg_z))
     9237    (let* ((amttype (specifier-type (acode-form-type amt *ppc2-trust-declarations*))))
     9238      (ensuring-node-target (target vreg)
     9239        (if (and (typep amttype 'numeric-ctype)
     9240                 (>= (numeric-ctype-low amttype) 0))
     9241          (! fixnum-ash-left target rnum ramt)
     9242          (! fixnum-ash target rnum ramt)))
     9243      (^))))
     9244
    92359245(defun show-function-constants (f)
    92369246  (cond ((typep f 'function)
  • trunk/source/compiler/X86/X8632/x8632-vinsns.lisp

    r15455 r15495  
    23392339  (shll (:$ub count) (:%l dest)))
    23402340
     2341(define-x8632-vinsn fixnum-ash-left (((dest :lisp))
     2342                                     ((num :lisp)
     2343                                      (amt :lisp))
     2344                                     ((shiftcount (:s32 #.x8632::ecx))))
     2345  (movl (:%l amt) (:%l shiftcount))
     2346  (sarl (:$ub x8632::fixnumshift) (:%l shiftcount))
     2347  ((:not (:pred =
     2348                (:apply %hard-regspec-value num)
     2349                (:apply %hard-regspec-value dest)))
     2350   (movl (:%l num) (:%l dest)))
     2351  (shll (:%shift x8632::cl) (:%l dest)))
     2352
     2353(define-x8632-vinsn fixnum-ash (((dest :lisp))
     2354                                ((num :lisp)
     2355                                 (amt :lisp))
     2356                                ((shiftcount (:s32 #.x8632::ecx))
     2357                                 (temp (:s32))))
     2358  (movl (:%l amt) (:%l shiftcount))
     2359  (sarl (:$ub x8632::fixnumshift) (:%l shiftcount))
     2360  (jns :left)
     2361  (negl (:%l shiftcount))
     2362  (movl (:%l num) (:%l temp))
     2363  (sarl (:$ub x8632::fixnumshift) (:%l temp))
     2364  (sarl (:%shift x8632::cl) (:%l temp))
     2365  (imull  (:$b x8632::fixnumone) (:%l temp)(:%l dest))
     2366  (jmp :done)
     2367  :left
     2368  ((:not (:pred =
     2369                (:apply %hard-regspec-value num)
     2370                (:apply %hard-regspec-value dest)))
     2371   (movl (:%l num) (:%l dest)))
     2372  (shll (:%shift x8632::cl) (:%l dest))
     2373  :done)
     2374
    23412375;;; In safe code, something else has ensured that the value is of type
    23422376;;; BIT.
  • trunk/source/compiler/X86/X8664/x8664-vinsns.lisp

    r15455 r15495  
    27962796   (movq (:%q src) (:%q dest)))
    27972797  (shlq (:$ub count) (:%q dest)))
     2798
     2799(define-x8664-vinsn fixnum-ash-left (((dest :lisp))
     2800                                     ((num :lisp)
     2801                                      (amt :lisp))
     2802                                     ((shiftcount (:s64 #.x8664::rcx))))
     2803  (movq (:%q amt) (:%q shiftcount))
     2804  (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
     2805  ((:not (:pred =
     2806                (:apply %hard-regspec-value num)
     2807                (:apply %hard-regspec-value dest)))
     2808   (movq (:%q num) (:%q dest)))
     2809  (shlq (:%shift x8664::cl) (:%q dest)))
     2810
     2811(define-x8664-vinsn fixnum-ash (((dest :lisp))
     2812                                ((num :lisp)
     2813                                 (amt :lisp))
     2814                                ((shiftcount (:s64 #.x8664::rcx))
     2815                                 (temp (:s64))))
     2816  (movq (:%q amt) (:%q shiftcount))
     2817  (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
     2818  (jns :left)
     2819  (negq (:%q shiftcount))
     2820  (movq (:%q num) (:%q temp))
     2821  (sarq (:$ub x8664::fixnumshift) (:%q temp))
     2822  (sarq (:%shift x8664::cl) (:%q temp))
     2823  (imulq  (:$b x8664::fixnumone) (:%q temp)(:%q dest))
     2824  (jmp :done)
     2825  :left
     2826  ((:not (:pred =
     2827                (:apply %hard-regspec-value num)
     2828                (:apply %hard-regspec-value dest)))
     2829   (movq (:%q num) (:%q dest)))
     2830  (shlq (:%shift x8664::cl) (:%q dest))
     2831  :done)
     2832                                   
    27982833
    27992834;;; In safe code, something else has ensured that the value is of type
  • trunk/source/compiler/X86/x862.lisp

    r15460 r15495  
    1090510905        (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPbuiltin-ash)))))
    1090610906     
    10907    
     10907(defx862 x862-fixnum-ash fixnum-ash (seg vreg xfer num amt)
     10908  (multiple-value-bind (rnum ramt) (x862-two-untargeted-reg-forms seg num *x862-arg-y* amt *x862-arg-z* *x862-variable-shift-count-mask*)
     10909    (let* ((amttype (specifier-type (acode-form-type amt *x862-trust-declarations*))))
     10910      (ensuring-node-target (target vreg)
     10911        (if (and (typep amttype 'numeric-ctype)
     10912                 (>= (numeric-ctype-low amttype) 0))
     10913          (! fixnum-ash-left target rnum ramt)
     10914          (! fixnum-ash target rnum ramt)))
     10915      (^))))
    1090810916
    1090910917
  • trunk/source/compiler/nx1.lisp

    r15335 r15495  
    24332433
    24342434   
    2435 (defnx1 nx1-ash (ash) context (&whole call &environment env num amt)
    2436   (flet ((defer-to-backend ()
    2437              ;; Bootstrapping nonsense
    2438              (if (svref (backend-p2-dispatch *target-backend*)
    2439                         (logand operator-id-mask (%nx1-operator ash)))
    2440                (make-acode (%nx1-operator typed-form)
     2435(defnx1 nx1-ash (ash) context (&environment env num amt)
     2436  (flet ((generic-case ()
     2437             (make-acode (%nx1-operator typed-form)
    24412438                           'integer
    24422439                           (make-acode
    24432440                            (%nx1-operator ash)
    24442441                            (nx1-form :value num)
    2445                             (nx1-form :value amt)))
    2446                (nx1-treat-as-call context call))))
     2442                            (nx1-form :value amt)))))
    24472443    (let* ((unsigned-natural-type *nx-target-natural-type*)
    24482444           (max (target-word-size-case (32 32) (64 64)))
     
    24652461                                           (- amt)))
    24662462                   (nx1-form context `(progn (require-type ,num 'integer) 0) env))
    2467                  (defer-to-backend))))
     2463                 (generic-case))))
    24682464            ((and (fixnump amt)
    24692465                  (<= 0 amt maxbits)
     
    24872483               (if (nx-form-typep amt `(mod ,(1+ max-shift)) env)
    24882484                 (nx1-form context `(%ilsl ,amt ,num))
    2489                  (defer-to-backend))))
    2490             (t (defer-to-backend))))))
     2485                 (generic-case))))
     2486            ((and (nx-trust-declarations env)
     2487                  (subtypep *nx-form-type* *nx-target-fixnum-type*)
     2488                  (nx-form-typep num *nx-target-fixnum-type* env)
     2489                  (target-word-size-case
     2490                   (32 (nx-form-typep amt '(signed-byte 5) env))
     2491                   (64 (nx-form-typep amt '(signed-byte 6) env))))
     2492             (make-acode (%nx1-operator typed-form)
     2493                         *nx-target-fixnum-type*
     2494                           (make-acode
     2495                            (%nx1-operator fixnum-ash)
     2496                            (nx1-form :value num)
     2497                            (nx1-form :value amt))))
     2498            (t (generic-case))))))
    24912499
    24922500   
  • trunk/source/compiler/nx2.lisp

    r15078 r15495  
    490490                                                   const-num))
    491491                 t)))
    492           (t nil))))
     492          (t
     493           (let* ((numtype (specifier-type (acode-form-type num trust-decls)))
     494                  (amttype (specifier-type (acode-form-type amt trust-decls)))
     495                  (fixtype (specifier-type target-fixnum-type)))
     496             (if (and (csubtypep numtype fixtype)
     497                      (csubtypep amttype fixtype))
     498               (let* ((highnum (numeric-ctype-high numtype))
     499                      (lownum (numeric-ctype-low numtype))
     500                      (widenum (if (> (integer-length highnum)
     501                                      (integer-length lownum))
     502                                 highnum
     503                                 lownum))
     504                      (maxleft (numeric-ctype-high amttype)))
     505                 (when (and (>= (numeric-ctype-low amttype)
     506                                (target-word-size-case
     507                                 (32 -31)
     508                                 (64 -63)))
     509                            (< maxleft
     510                               (arch::target-nbits-in-word (backend-target-arch *target-backend*)))
     511                            (typep (ignore-errors (ash widenum maxleft))
     512                                   target-fixnum-type))
     513                   (backend-use-operator (%nx1-operator fixnum-ash)
     514                                         seg
     515                                         vreg
     516                                         xfer
     517                                         num
     518                                         amt)
     519                   t))))))))
    493520
    494521
  • trunk/source/compiler/nxenv.lisp

    r15038 r15495  
    144144     (%fixnum-set-natural . #.operator-single-valued-mask)
    145145     (type-asserted-form . 0)
    146      (spushp . #.operator-single-valued-mask)
     146     (fixnum-ash .  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    147147     (simple-function . #.operator-single-valued-mask)
    148148     (closed-function . #.operator-single-valued-mask)
Note: See TracChangeset for help on using the changeset viewer.