Changeset 14015 for branches


Ignore:
Timestamp:
Jul 22, 2010, 12:39:34 PM (9 years ago)
Author:
gb
Message:

More UUOs (for N-dimensional AREF.)
vinsns for N-d aref; backend support for N-d aref.
Careful doing ASET to DOUBLE-FLOAT vectors.

Location:
branches/arm/compiler/ARM
Files:
2 edited

Legend:

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

    r14004 r14015  
    480480 
    481481
    482 #+can-encode-array-rank-trap
    483 (define-arm-vinsn check-arrayH-rank (()
    484                                      ((header :lisp)
    485                                       (expected :u32const))
    486                                      ((rank :imm)))
    487   (ldr rank (:@ header (:$ arm::arrayH.rank)))
    488   (cmp rank (:apply ash expected arm::fixnumshift))
    489   (uuo-error-bad-array-rank (:? ne) expected header))
    490 
    491 #+can-remember-what-this-means
    492 (define-arm-vinsn check-arrayH-flags (()
    493                                       ((header :lisp)
    494                                        (expected :u16const))
    495                                       ((flags :imm)
    496                                        (xreg :u32)))
    497   (lis xreg (:apply ldb (byte 16 16) (:apply ash expected arm::fixnumshift)))
    498   (ori xreg xreg (:apply ldb (byte 16 0) (:apply ash expected arm::fixnumshift)))
    499   (lwz flags arm::arrayH.flags header)
    500   (tw 27 flags xreg))
     482
     483
    501484
    502485 
     
    27252708(define-arm-vinsn trap-unless-simple-array-2 (()
    27262709                                              ((object :lisp)
    2727                                                (expected-flags :u32const)
    2728                                                (type-error :u8const))
     2710                                               (rexpected-flags :imm))
     2711                                              ((tag :u8)
     2712                                               (flags :u32)))
     2713  (and tag object (:$ arm::tagmask))
     2714  (cmp tag (:$ arm::tag-misc))
     2715  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     2716  (cmp tag (:$ arm::subtag-arrayH))
     2717  (bne :bad-if-ne)
     2718  (mov flags (:$ (ash 2 arm::fixnumshift)))
     2719  (ldr tag (:@ object (:$ arm::arrayH.rank)))
     2720  (cmp tag flags)
     2721  (uuo-error-array-rank (:? ne) flags object)
     2722  (ldr flags (:@ object (:$ arm::arrayH.flags)))
     2723  (cmp flags rexpected-flags)
     2724  :bad-if-ne
     2725  (uuo-error-array-flags (:? ne) rexpected-flags object ))
     2726
     2727(define-arm-vinsn trap-unless-simple-array-3 (()
     2728                                              ((object :lisp)
     2729                                               (rexpected-flags :imm))
    27292730                                              ((tag :u8)
    27302731                                               (flags :u32)))
     
    27352736  (bne :bad-if-ne)
    27362737  (ldr tag (:@ object (:$ arm::arrayH.rank)))
    2737   (cmp tag (:$ (ash 2 arm::fixnumshift)))
    2738   (bne :bad-if-ne)
    2739   (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
    2740   (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
     2738  (mov flags (:$ (ash 3 arm::fixnumshift)))
     2739  (cmp tag flags)
     2740  (uuo-error-array-rank (:? ne) flags object)
    27412741  (ldr flags (:@ object (:$ arm::arrayH.flags)))
    2742   (cmp tag flags)
     2742  (cmp rexpected-flags flags)
    27432743  :bad-if-ne
    2744   (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
    2745 
    2746 (define-arm-vinsn trap-unless-simple-array-3 (()
    2747                                               ((object :lisp)
    2748                                                (expected-flags :u16const)
    2749                                                (type-error :u8const))
    2750                                               ((tag :u8)
    2751                                                (flags :u32)))
    2752   (and tag object (:$ arm::tagmask))
    2753   (cmp tag (:$ arm::tag-misc))
    2754   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    2755   (cmp tag (:$ arm::subtag-arrayH))
    2756   (bne :bad-if-ne)
    2757   (ldr tag (:@ object (:$ arm::arrayH.rank)))
    2758   (cmp tag (:$ (ash 3 arm::fixnumshift)))
    2759   (bne :bad-if-ne)
    2760   (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
    2761   (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
    2762   (ldr flags (:@ object (:$ arm::arrayH.flags)))
    2763   (cmp tag flags)
    2764   :bad-if-ne
    2765   (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
     2744  (uuo-error-array-flags (:? ne) rexpected-flags object))
    27662745 
    27672746 
     
    37543733(define-arm-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
    37553734
    3756 #+notyet
     3735
    37573736(define-arm-vinsn bind-interrupt-level-0-inline (()
    37583737                                                 ()
     
    37643743  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
    37653744  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
    3766   (cmpwi value 0)
    3767   (li temp arm::interrupt-level-binding-index)
    3768   (stwu value -4 vsp)
    3769   (stwu temp -4 vsp)
    3770   (stwu link -4 vsp)
    3771   (str arm::rzero (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3745  (cmp value (:$ 0))
     3746  (mov temp (:$ arm::interrupt-level-binding-index))
     3747  (str value (:@! vsp (:$ -4)))
     3748  (str temp (:@! vsp (:$ -4)))
     3749  (str link (:@! vsp (:$ -4)))
     3750  (mov temp (:$ 0))
     3751  (str temp (:@ tlb (:$ arm::interrupt-level-binding-index)))
    37723752  (str vsp  (:@ rcontext (:$ arm::tcr.db-link)))
    3773   (beq+ :done)
    3774   (mr nargs value)
    3775   (bgt :do-trap)
     3753  (bge :done)
    37763754  (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
    3777   :do-trap
    3778   (twgti nargs 0)
     3755  (cmp nargs (:$ 0))
     3756  (uuo-interrupt-now (:? ne))
    37793757  :done)
    37803758                                                   
  • branches/arm/compiler/ARM/arm2.lisp

    r14005 r14015  
    16141614          (when safe     
    16151615            (when (typep safe 'fixnum)
    1616               (! trap-unless-simple-array-2
    1617                  src
    1618                  (dpb safe target::arrayH.flags-cell-subtag-byte
    1619                       (ash 1 $arh_simple_bit))
    1620                  (nx-error-for-simple-2d-array-type type-keyword)))
     1616              (with-node-target (src unscaled-i unscaled-j val-reg) expected
     1617                (! lri expected
     1618                   (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1619                             (ash 1 $arh_simple_bit))
     1620                        arm::fixnumshift))
     1621                (! trap-unless-simple-array-2 src expected)))
    16211622            (unless i-known-fixnum
    16221623              (! trap-unless-fixnum unscaled-i))
     
    16861687          (when safe     
    16871688            (when (typep safe 'fixnum)
     1689              (with-node-target (src unscaled-i unscaled-j unscaled-k val-reg) expected
     1690                (! lri expected (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1691                                          (ash 1 $arh_simple_bit))
     1692                                     arm::fixnumshift))
    16881693              (! trap-unless-simple-array-3
    16891694                 src
    1690                  (dpb safe target::arrayH.flags-cell-subtag-byte
    1691                       (ash 1 $arh_simple_bit))
    1692                  (nx-error-for-simple-3d-array-type type-keyword)))
     1695                 expected)))
    16931696            (unless i-known-fixnum
    16941697              (! trap-unless-fixnum unscaled-i))
     
    17321735      (when safe       
    17331736        (when (typep safe 'fixnum)
    1734           (! trap-unless-simple-array-2
    1735              src
    1736              (dpb safe target::arrayH.flags-cell-subtag-byte
    1737                   (ash 1 $arh_simple_bit))
    1738              (nx-error-for-simple-2d-array-type typekeyword)))
     1737          (with-node-target (src unscaled-i unscaled-j) expected
     1738            (! lri expected (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1739                                      (ash 1 $arh_simple_bit))
     1740                                 arm::fixnumshift))
     1741            (! trap-unless-simple-array-2 src expected)))
    17391742        (unless i-known-fixnum
    17401743          (! trap-unless-fixnum unscaled-i))
     
    17841787      (when safe       
    17851788        (when (typep safe 'fixnum)
    1786           (! trap-unless-simple-array-3
    1787              src
    1788              (dpb safe target::arrayH.flags-cell-subtag-byte
    1789                   (ash 1 $arh_simple_bit))
    1790              (nx-error-for-simple-3d-array-type typekeyword)))
     1789          (with-node-target (src unscaled-i unscaled-j unscaled-k) expected
     1790            (! lri expected (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1791                                      (ash 1 $arh_simple_bit))
     1792                                 arm::fixnumshift))
     1793            (! trap-unless-simple-array-3 src expected)))
    17911794        (unless i-known-fixnum
    17921795          (! trap-unless-fixnum unscaled-i))
     
    20422045                 (! misc-set-node val-reg src scaled-idx))))
    20432046            (t
    2044              (with-imm-target (unboxed-val-reg) scaled-idx
    2045                (cond
    2046                  (is-64-bit
     2047             (cond
     2048               (is-64-bit
     2049                (with-imm-target (arm::imm0 arm::imm1) scaled-idx
    20472050                  (if (and index-known-fixnum
    20482051                           (<= index-known-fixnum
    20492052                               (arch::target-max-64-bit-constant-index arch)))
    2050                     (if (eq type-keyword :double-float-vector)
    2051                       (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
    2052                       (if is-signed
    2053                         (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
    2054                         (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
     2053                    (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
    20552054                    (progn
    20562055                      (if index-known-fixnum
    20572056                        (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3)))
    20582057                        (! scale-64bit-misc-index scaled-idx unscaled-idx))
    2059                       (if (eq type-keyword :double-float-vector)
    2060                         (! misc-set-double-float unboxed-val-reg src scaled-idx)
    2061                         (if is-signed
    2062                           (! misc-set-s64 unboxed-val-reg src scaled-idx)
    2063                           (! misc-set-u64 unboxed-val-reg src scaled-idx))))))
    2064                  (is-32-bit
    2065                   (if (and index-known-fixnum
    2066                            (<= index-known-fixnum
    2067                                (arch::target-max-32-bit-constant-index arch)))
    2068                     (if (eq type-keyword :single-float-vector)
    2069                       (if (eq (hard-regspec-class unboxed-val-reg)
    2070                               hard-reg-class-fpr)
    2071                         (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
    2072                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
    2073                       (if is-signed
    2074                         (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
    2075                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
    2076                     (progn
    2077                       (if index-known-fixnum
    2078                         (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    2079                         (! scale-32bit-misc-index scaled-idx unscaled-idx))
    2080                       (if (and (eq type-keyword :single-float-vector)
    2081                                (eql (hard-regspec-class unboxed-val-reg)
    2082                                     hard-reg-class-fpr))
    2083                         (! misc-set-single-float unboxed-val-reg src scaled-idx)
    2084                         (if is-signed
    2085                           (! misc-set-s32 unboxed-val-reg src scaled-idx)
    2086                           (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
    2087                  (is-16-bit
    2088                   (if (and index-known-fixnum
    2089                            (<= index-known-fixnum
    2090                                (arch::target-max-16-bit-constant-index arch)))
    2091                     (if is-signed
    2092                       (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
    2093                       (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
    2094                     (progn
    2095                       (if index-known-fixnum
    2096                         (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
    2097                         (! scale-16bit-misc-index scaled-idx unscaled-idx))
    2098                       (if is-signed
    2099                         (! misc-set-s16 unboxed-val-reg src scaled-idx)
    2100                         (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
    2101                  (is-8-bit
    2102                   (if (and index-known-fixnum
    2103                            (<= index-known-fixnum
    2104                                (arch::target-max-8-bit-constant-index arch)))
    2105                     (if is-signed
    2106                       (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
    2107                       (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
    2108                     (progn
    2109                       (if index-known-fixnum
    2110                         (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
    2111                         (! scale-8bit-misc-index scaled-idx unscaled-idx))
    2112                       (if is-signed
    2113                         (! misc-set-s8 unboxed-val-reg src scaled-idx)
    2114                         (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
     2058                      (! misc-set-double-float unboxed-val-reg src scaled-idx)))))
    21152059                 (t
    2116                   (unless is-1-bit
    2117                     (nx-error "~& unsupported vector type: ~s"
    2118                               type-keyword))
    2119                   (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    2120                     (with-imm-target (unboxed-val-reg) word
    2121                       (let* ((word-index (ash index-known-fixnum -5))
    2122                              (bit-number (logand index-known-fixnum #x1f)))
    2123                         (! misc-ref-c-u32 word src word-index)
    2124                         (if constval
    2125                           (if (zerop constval)
    2126                             (! set-constant-arm-bit-to-0 word word bit-number)
    2127                             (! set-constant-arm-bit-to-1 word word bit-number))
    2128                           (! set-constant-arm-bit-to-variable-value word word unboxed-val-reg bit-number))
    2129                         (! misc-set-c-u32 word src word-index)))
    2130                     (with-crf-target () crf
    2131                     (with-imm-temps () (word-index bit-number temp)
    2132                       (unless constval
    2133                         (! compare-immediate crf unboxed-val-reg 0))
    2134                       (! scale-1bit-misc-index word-index bit-number unscaled-idx)
    2135                       (! lri temp 1)
    2136                       (! shift-left-variable-word bit-number temp bit-number)
    2137                       (! misc-ref-u32 temp src word-index)
    2138                       (if constval
    2139                         (if (zerop constval)
    2140                           (! u32logandc2 temp temp bit-number)
    2141                           (! u32logior temp temp bit-number))
    2142                         (progn
    2143                           (! set-or-clear-bit temp temp bit-number crf)))
    2144                       (! misc-set-u32 temp src word-index)))))))))
     2060                  (with-imm-target (unboxed-val-reg) scaled-idx
     2061                    (cond
     2062                      (is-32-bit
     2063                       (if (and index-known-fixnum
     2064                                (<= index-known-fixnum
     2065                                    (arch::target-max-32-bit-constant-index arch)))
     2066                         (if (eq type-keyword :single-float-vector)
     2067                           (if (eq (hard-regspec-class unboxed-val-reg)
     2068                                   hard-reg-class-fpr)
     2069                             (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
     2070                             (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
     2071                           (if is-signed
     2072                             (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
     2073                             (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
     2074                         (progn
     2075                           (if index-known-fixnum
     2076                             (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     2077                             (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2078                           (if (and (eq type-keyword :single-float-vector)
     2079                                    (eql (hard-regspec-class unboxed-val-reg)
     2080                                         hard-reg-class-fpr))
     2081                             (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2082                             (if is-signed
     2083                               (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2084                               (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
     2085                      (is-16-bit
     2086                       (if (and index-known-fixnum
     2087                                (<= index-known-fixnum
     2088                                    (arch::target-max-16-bit-constant-index arch)))
     2089                         (if is-signed
     2090                           (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
     2091                           (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
     2092                         (progn
     2093                           (if index-known-fixnum
     2094                             (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2095                             (! scale-16bit-misc-index scaled-idx unscaled-idx))
     2096                           (if is-signed
     2097                             (! misc-set-s16 unboxed-val-reg src scaled-idx)
     2098                             (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
     2099                      (is-8-bit
     2100                       (if (and index-known-fixnum
     2101                                (<= index-known-fixnum
     2102                                    (arch::target-max-8-bit-constant-index arch)))
     2103                         (if is-signed
     2104                           (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
     2105                           (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
     2106                         (progn
     2107                           (if index-known-fixnum
     2108                             (arm2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2109                             (! scale-8bit-misc-index scaled-idx unscaled-idx))
     2110                           (if is-signed
     2111                             (! misc-set-s8 unboxed-val-reg src scaled-idx)
     2112                             (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
     2113                      (t
     2114                       (unless is-1-bit
     2115                         (nx-error "~& unsupported vector type: ~s"
     2116                                   type-keyword))
     2117                       (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     2118                         (with-imm-target (unboxed-val-reg) word
     2119                           (let* ((word-index (ash index-known-fixnum -5))
     2120                                  (bit-number (logand index-known-fixnum #x1f)))
     2121                             (! misc-ref-c-u32 word src word-index)
     2122                             (if constval
     2123                               (if (zerop constval)
     2124                                 (! set-constant-arm-bit-to-0 word word bit-number)
     2125                                 (! set-constant-arm-bit-to-1 word word bit-number))
     2126                               (! set-constant-arm-bit-to-variable-value word word unboxed-val-reg bit-number))
     2127                             (! misc-set-c-u32 word src word-index)))
     2128                         (with-crf-target () crf
     2129                           (with-imm-temps () (word-index bit-number temp)
     2130                             (unless constval
     2131                               (! compare-immediate crf unboxed-val-reg 0))
     2132                             (! scale-1bit-misc-index word-index bit-number unscaled-idx)
     2133                             (! lri temp 1)
     2134                             (! shift-left-variable-word bit-number temp bit-number)
     2135                             (! misc-ref-u32 temp src word-index)
     2136                             (if constval
     2137                               (if (zerop constval)
     2138                                 (! u32logandc2 temp temp bit-number)
     2139                                 (! u32logior temp temp bit-number))
     2140                               (progn
     2141                                 (! set-or-clear-bit temp temp bit-number crf)))
     2142                             (! misc-set-u32 temp src word-index)))))))))))
    21452143      (when (and vreg val-reg) (<- val-reg))
    21462144    (^))))
Note: See TracChangeset for help on using the changeset viewer.