Changeset 13506


Ignore:
Timestamp:
Mar 9, 2010, 7:43:31 PM (10 years ago)
Author:
gz
Message:

From trunk: faster %iasr/%ilsr, less boxing/unboxing for 32-bit values (r13407 r13457 r13443 r13445)

Location:
branches/working-0711/ccl
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl

  • branches/working-0711/ccl/compiler/X86/X8632/x8632-vinsns.lisp

    r13502 r13506  
    22222222  (movl (:%l count) (:%l temp))
    22232223  (sarl (:$ub x8632::fixnumshift) (:%l temp))
    2224   (rcmpl (:%l temp) (:$l 31))
    2225   (cmovbw (:%w temp) (:%w shiftcount))
     2224  (movl (:$l 31) (:%l shiftcount))
     2225  (rcmpl (:%l temp) (:%l shiftcount))
     2226  (cmovbel (:%l temp) (:%l shiftcount))
    22262227  (movl (:%l src) (:%l temp))
    2227   (jae :shift-max)
    22282228  (sarl (:%shift x8632::cl) (:%l temp))
    2229   (jmp :done)
    2230   :shift-max
    2231   (sarl (:$ub 31) (:%l temp))
    2232   :done
    22332229  (andl (:$l (lognot x8632::fixnummask)) (:%l temp))
    22342230  (movl (:%l temp) (:%l dest)))
     
    22412237  (movl (:%l count) (:%l temp))
    22422238  (sarl (:$ub x8632::fixnumshift) (:%l temp))
    2243   (rcmpl (:%l temp) (:$l 31))
    2244   (cmovbw (:%w temp) (:%w shiftcount))
     2239  (movl (:$l 31) (:%l shiftcount))
     2240  (rcmpl (:%l temp) (:%l shiftcount))
     2241  (cmovbel (:%l temp) (:%l shiftcount))
    22452242  (movl (:%l src) (:%l temp))
    2246   (jae :shift-max)
    22472243  (shrl (:%shift x8632::cl) (:%l temp))
    2248   (jmp :done)
    2249   :shift-max
    2250   (shrl (:$ub 31) (:%l temp))
    2251   :done
    2252   (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
     2244  (andl (:$b (lognot x8632::fixnummask)) (:%l temp))
    22532245  (movl (:%l temp) (:%l dest)))
    22542246
  • branches/working-0711/ccl/compiler/X86/X8664/x8664-arch.lisp

    r13070 r13506  
    456456(defconstant max-16-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) -1))
    457457(defconstant max-8-bit-constant-index (+ #x7fffffff x8664::misc-data-offset))
    458 (defconstant max-1-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) 5))
     458(defconstant max-1-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) 3))
    459459
    460460)
  • branches/working-0711/ccl/compiler/X86/X8664/x8664-vinsns.lisp

    r13332 r13506  
    27152715  (movq (:%q count) (:%q temp))
    27162716  (sarq (:$ub x8664::fixnumshift) (:%q temp))
    2717   (rcmpq (:%q temp) (:$l 63))
    2718   (cmovbw (:%w temp) (:%w shiftcount))
     2717  (movl (:$l 63) (:%l shiftcount))
     2718  (rcmpq (:%q temp) (:%q shiftcount))
     2719  (cmovbel (:%l temp) (:%l shiftcount))
    27192720  (movq (:%q src) (:%q temp))
    2720   (jae :shift-max)
    27212721  (sarq (:%shift x8664::cl) (:%q temp))
    2722   (jmp :done)
    2723   :shift-max
    2724   (sarq (:$ub 63) (:%q temp))
    2725   :done
    2726   (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
     2722  (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
    27272723  (movq (:%q temp) (:%q dest)))
    27282724
     
    27342730  (movq (:%q count) (:%q temp))
    27352731  (sarq (:$ub x8664::fixnumshift) (:%q temp))
    2736   (rcmpq (:%q temp) (:$l 63))
    2737   (cmovbw (:%w temp) (:%w shiftcount))
     2732  (movl (:$l 63) (:%l shiftcount))
     2733  (rcmpq (:%q temp) (:%q shiftcount))
     2734  (cmovbel (:%l temp) (:%l shiftcount))
    27382735  (movq (:%q src) (:%q temp))
    2739   (jae :shift-max)
    27402736  (shrq (:%shift x8664::cl) (:%q temp))
    2741   (jmp :done)
    2742   :shift-max
    2743   (shrq (:$ub 63) (:%q temp))
    2744   :done
    2745   (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
     2737  (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
    27462738  (movq (:%q temp) (:%q dest)))
     2739
    27472740
    27482741(define-x8664-vinsn %iasr-c (((dest :imm))
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r13332 r13506  
    15231523(defun x862-box-s32 (seg node-dest s32-src)
    15241524  (with-x86-local-vinsn-macros (seg)
    1525     (if (target-arch-case
    1526          (:x8632 nil)
    1527          (:x8664 t))
    1528       (! box-fixnum node-dest s32-src)
     1525    (target-arch-case
     1526     (:x8632
    15291527      (let* ((arg_z ($ *x862-arg-z*))
    1530              (imm0 ($ *x862-imm0* :mode :s32)))
    1531         (x862-copy-register seg imm0 s32-src)
    1532         (! call-subprim (subprim-name->offset '.SPmakes32))
    1533         (x862-copy-register seg node-dest arg_z)))))
     1528             (imm0 ($ *x862-imm0* :mode :s32)))
     1529        (x862-copy-register seg imm0 s32-src)
     1530        (! call-subprim (subprim-name->offset '.SPmakes32))
     1531        (x862-copy-register seg node-dest arg_z)))
     1532     (:x8664
     1533      (! box-fixnum node-dest s32-src)))))
    15341534
    15351535(defun x862-box-s64 (seg node-dest s64-src)
     
    16281628          (is-32-bit
    16291629           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))
    1630              (cond ((eq type-keyword :single-float-vector)
    1631                     (with-fp-target () (fp-val :single-float)
    1632                       (if (and (eql vreg-class hard-reg-class-fpr)
    1633                                (eql vreg-mode hard-reg-class-fpr-mode-single))
    1634                         (setq fp-val vreg))
    1635                       (! misc-ref-c-single-float fp-val src index-known-fixnum)
    1636                       (if (eql vreg-class hard-reg-class-fpr)
    1637                         (<- fp-val)
    1638                         (ensuring-node-target (target vreg)
    1639                           (target-arch-case
    1640                            (:x8632 (x862-single->heap seg target fp-val))
    1641                            (:x8664 (! single->node target fp-val)))))))
    1642                    (t
    1643                     (with-additional-imm-reg ()
    1644                       (with-imm-target () temp
    1645                         (if is-signed
    1646                           (! misc-ref-c-s32 temp src index-known-fixnum)
    1647                           (! misc-ref-c-u32 temp src index-known-fixnum))
    1648                         (ensuring-node-target (target vreg)
    1649                           (if (eq type-keyword :simple-string)
    1650                             (! u32->char target temp)
    1651                             (target-arch-case
    1652                              (:x8632
    1653                               (if is-signed
    1654                                 (x862-box-s32 seg target temp)
    1655                                 (x862-box-u32 seg target temp)))
    1656                              (:x8664
    1657                               (! box-fixnum target temp)))))))))
     1630             (case type-keyword
     1631               (:single-float-vector
     1632                (with-fp-target () (fp-val :single-float)
     1633                  (if (and (eql vreg-class hard-reg-class-fpr)
     1634                           (eql vreg-mode hard-reg-class-fpr-mode-single))
     1635                    (setq fp-val vreg))
     1636                  (! misc-ref-c-single-float fp-val src index-known-fixnum)
     1637                  (if (eql vreg-class hard-reg-class-fpr)
     1638                    (<- fp-val)
     1639                    (ensuring-node-target (target vreg)
     1640                      (target-arch-case
     1641                       (:x8632 (x862-single->heap seg target fp-val))
     1642                       (:x8664 (! single->node target fp-val)))))))
     1643               (:signed-32-bit-vector
     1644                (with-imm-target () (s32-reg :s32)
     1645                  (if (eql vreg-mode hard-reg-class-gpr-mode-s32)
     1646                    (setq s32-reg vreg))
     1647                  (! misc-ref-c-s32 s32-reg src index-known-fixnum)
     1648                  (unless (eq vreg s32-reg)
     1649                    (ensuring-node-target (target vreg)
     1650                      (x862-box-s32 seg target s32-reg)))))
     1651               (:unsigned-32-bit-vector
     1652                (with-imm-target () (u32-reg :u32)
     1653                  (if (eql vreg-mode hard-reg-class-gpr-mode-u32)
     1654                    (setq u32-reg vreg))
     1655                  (! misc-ref-c-u32 u32-reg src index-known-fixnum)
     1656                  (unless (eq vreg u32-reg)
     1657                    (ensuring-node-target (target vreg)
     1658                      (x862-box-u32 seg target u32-reg)))))
     1659               (t
     1660                (with-imm-target () temp
     1661                  (if is-signed
     1662                    (! misc-ref-c-s32 temp src index-known-fixnum)
     1663                    (! misc-ref-c-u32 temp src index-known-fixnum))
     1664                  (ensuring-node-target (target vreg)
     1665                    (if (eq type-keyword :simple-string)
     1666                      (! u32->char target temp)
     1667                      (if is-signed
     1668                        (x862-box-s32 seg target temp)
     1669                        (x862-box-u32 seg target temp)))))))
    16581670             (with-imm-target () idx-reg
    16591671               (if index-known-fixnum
    16601672                 (x862-absolute-natural seg idx-reg nil (ash index-known-fixnum 2))
    16611673                 (! scale-32bit-misc-index idx-reg unscaled-idx))
    1662                (cond ((eq type-keyword :single-float-vector)
    1663                       (with-fp-target () (fp-val :single-float)
    1664                         (if (and (eql vreg-class hard-reg-class-fpr)
    1665                                  (eql vreg-mode hard-reg-class-fpr-mode-single))
    1666                           (setq fp-val vreg))
    1667                         (! misc-ref-single-float fp-val src idx-reg)
    1668                         (if (eq vreg-class hard-reg-class-fpr)
    1669                           (<- fp-val)
    1670                           (ensuring-node-target (target vreg)
    1671                             (target-arch-case
    1672                              (:x8632 (x862-single->heap seg target fp-val))
    1673                              (:x8664 (! single->node target fp-val)))))))
    1674                      (t
    1675                       (with-imm-target () temp
     1674               (case type-keyword
     1675                 (:single-float-vector
     1676                  (with-fp-target () (fp-val :single-float)
     1677                    (if (and (eql vreg-class hard-reg-class-fpr)
     1678                             (eql vreg-mode hard-reg-class-fpr-mode-single))
     1679                      (setq fp-val vreg))
     1680                    (! misc-ref-single-float fp-val src idx-reg)
     1681                    (if (eq vreg-class hard-reg-class-fpr)
     1682                      (<- fp-val)
     1683                      (ensuring-node-target (target vreg)
     1684                        (target-arch-case
     1685                         (:x8632 (x862-single->heap seg target fp-val))
     1686                         (:x8664 (! single->node target fp-val)))))))
     1687                 (:signed-32-bit-vector
     1688                  (with-imm-target () (s32-reg :s32)
     1689                    (if (eql vreg-mode hard-reg-class-gpr-mode-s32)
     1690                      (setq s32-reg vreg))
     1691                    (! misc-ref-s32 s32-reg src idx-reg)
     1692                    (unless (eq vreg s32-reg)
     1693                      (ensuring-node-target (target vreg)
     1694                        (x862-box-s32 seg target s32-reg)))))
     1695                 (:unsigned-32-bit-vector
     1696                  (with-imm-target () (u32-reg :u32)
     1697                    (if (eql vreg-mode hard-reg-class-gpr-mode-u32)
     1698                      (setq u32-reg vreg))
     1699                    (! misc-ref-u32 u32-reg src idx-reg)
     1700                    (unless (eq vreg u32-reg)
     1701                      (ensuring-node-target (target vreg)
     1702                        (x862-box-u32 seg target u32-reg)))))
     1703                 (t
     1704                  (with-imm-target () temp
     1705                    (if is-signed
     1706                      (! misc-ref-s32 temp src idx-reg)
     1707                      (! misc-ref-u32 temp src idx-reg))
     1708                    (ensuring-node-target (target vreg)
     1709                      (if (eq type-keyword :simple-string)
     1710                        (! u32->char target temp)
    16761711                        (if is-signed
    1677                           (! misc-ref-s32 temp src idx-reg)
    1678                           (! misc-ref-u32 temp src idx-reg))
    1679                         (ensuring-node-target (target vreg)
    1680                           (if (eq type-keyword :simple-string)
    1681                             (! u32->char target temp)
    1682                             (target-arch-case
    1683                              (:x8632 (if is-signed
    1684                                        (x862-box-s32 seg target temp)
    1685                                        (x862-box-u32 seg target temp)))
    1686                              (:x8664 (! box-fixnum target temp)))))))))))
     1712                          (x862-box-s32 seg target temp)
     1713                          (x862-box-u32 seg target temp))))))))))
    16871714          (is-8-bit
    16881715           (with-imm-target () temp
     
    23782405                   (! misc-set-node val-reg src unscaled-idx)))))
    23792406            (t
    2380              (with-additional-imm-reg (src unscaled-idx val-reg)
    2381                (with-imm-target (unboxed-val-reg) scaled-idx
    2382                  (cond
    2383                    (is-64-bit
    2384                     (if (and index-known-fixnum
    2385                              (<= index-known-fixnum
    2386                                  (arch::target-max-64-bit-constant-index arch)))
    2387                       (if (eq type-keyword :double-float-vector)
    2388                         (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
    2389                         (if is-signed
    2390                           (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
    2391                           (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
    2392                       (progn
     2407             (cond
     2408               (is-64-bit
     2409                (if (and index-known-fixnum
     2410                         (<= index-known-fixnum
     2411                             (arch::target-max-64-bit-constant-index arch)))
     2412                  (if (eq type-keyword :double-float-vector)
     2413                    (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
     2414                    (if is-signed
     2415                      (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
     2416                      (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
     2417                  (progn
     2418                    (if index-known-fixnum
     2419                      (x862-absolute-natural seg unscaled-idx nil (ash index-known-fixnum 3)))
     2420                    (if (eq type-keyword :double-float-vector)
     2421                      (! misc-set-double-float unboxed-val-reg src unscaled-idx)
     2422                      (if is-signed
     2423                        (! misc-set-s64 unboxed-val-reg src unscaled-idx)
     2424                        (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
     2425               (is-32-bit
     2426                (if (and index-known-fixnum
     2427                         (<= index-known-fixnum
     2428                             (arch::target-max-32-bit-constant-index arch)))
     2429                  (if (eq type-keyword :single-float-vector)
     2430                    (if (eq (hard-regspec-class unboxed-val-reg)
     2431                            hard-reg-class-fpr)
     2432                      (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
     2433                      (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
     2434                    (if is-signed
     2435                      (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
     2436                      (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
     2437                  (progn
     2438                    (target-arch-case
     2439                     (:x8632
     2440                      (with-node-target (src) scaled-idx
    23932441                        (if index-known-fixnum
    2394                           (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
    2395                         (if (eq type-keyword :double-float-vector)
    2396                           (! misc-set-double-float unboxed-val-reg src unscaled-idx)
    2397                           (if is-signed
    2398                             (! misc-set-s64 unboxed-val-reg src unscaled-idx)
    2399                             (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
    2400                    (is-32-bit
    2401                     (if (and index-known-fixnum
    2402                              (<= index-known-fixnum
    2403                                  (arch::target-max-32-bit-constant-index arch)))
    2404                       (if (eq type-keyword :single-float-vector)
    2405                         (if (eq (hard-regspec-class unboxed-val-reg)
    2406                                 hard-reg-class-fpr)
    2407                           (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
    2408                           (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
    2409                         (if is-signed
    2410                           (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
    2411                           (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
    2412                       (progn
    2413                         (if index-known-fixnum
    2414                           (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     2442                          (x862-lri seg scaled-idx (ash index-known-fixnum 2))
    24152443                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
    24162444                        (if (and (eq type-keyword :single-float-vector)
     
    24202448                          (if is-signed
    24212449                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
    2422                             (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
    2423                    (is-16-bit
     2450                            (! misc-set-u32 unboxed-val-reg src scaled-idx)))))
     2451                     (:x8664
     2452                      (with-imm-target (unboxed-val-reg) scaled-idx
     2453                        (if index-known-fixnum
     2454                          (x862-lri seg scaled-idx (ash index-known-fixnum 2))
     2455                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2456                        (if (and (eq type-keyword :single-float-vector)
     2457                                 (eql (hard-regspec-class unboxed-val-reg)
     2458                                      hard-reg-class-fpr))
     2459                          (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2460                          (if is-signed
     2461                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2462                            (! misc-set-u32 unboxed-val-reg src scaled-idx)))))))))
     2463               (is-16-bit
     2464                (with-additional-imm-reg (src unscaled-idx val-reg)
     2465                  (with-imm-target (unboxed-val-reg) scaled-idx
    24242466                    (if (and index-known-fixnum
    24252467                             (<= index-known-fixnum
     
    24302472                      (progn
    24312473                        (if index-known-fixnum
    2432                           (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2474                          (x862-lri seg scaled-idx (ash index-known-fixnum 1))
    24332475                          (! scale-16bit-misc-index scaled-idx unscaled-idx))
    24342476                        (if is-signed
    24352477                          (! misc-set-s16 unboxed-val-reg src scaled-idx)
    2436                           (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
    2437                    (is-8-bit
     2478                          (! misc-set-u16 unboxed-val-reg src scaled-idx)))))))
     2479               (is-8-bit
     2480                (with-additional-imm-reg (src unscaled-idx val-reg)
     2481                  (with-imm-target (unboxed-val-reg) scaled-idx
    24382482                    (if (and index-known-fixnum
    24392483                             (<= index-known-fixnum
     
    24412485                      (if is-signed
    24422486                        (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
    2443                         (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
     2487                        (! misc-set-c-u8 unboxed-val-reg src index-known-fixnum))
    24442488                      (progn
    24452489                        (if index-known-fixnum
    2446                           (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2490                          (x862-lri seg scaled-idx index-known-fixnum)
    24472491                          (! scale-8bit-misc-index scaled-idx unscaled-idx))
    24482492                        (if is-signed
    24492493                          (! misc-set-s8 unboxed-val-reg src scaled-idx)
    2450                           (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
    2451                    (is-1-bit
    2452                     (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     2494                          (! misc-set-u8 unboxed-val-reg src scaled-idx)))))))
     2495               (is-1-bit
     2496                (with-additional-imm-reg (src unscaled-idx val-reg)
     2497                  (with-imm-target (unboxed-val-reg) scaled-idx
     2498                    (if (and index-known-fixnum
     2499                             (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    24532500                      (if constval
    24542501                        (if (zerop constval)
Note: See TracChangeset for help on using the changeset viewer.