Changeset 15128


Ignore:
Timestamp:
Dec 9, 2011, 7:40:50 AM (8 years ago)
Author:
gb
Message:

Split ARM2-ASET2 into the case that has to deal with the write
barrier and all other cases. (The write-barrier case needs to
ultimately get vector/index/new-value into arg_x/arg_y/arg_z;
the other cases have more flexibility.

Multiple-value aref/aset: don't treat indices as constants unless
reckless, not memoizing.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm2.lisp

    r15121 r15128  
    17341734
    17351735
    1736 
     1736(defun arm2-aset2-via-gvset (seg vreg xfer  array i j new safe type-keyword  constval)
     1737  (with-arm-local-vinsn-macros (seg vreg xfer)
     1738    (let* ((i-known-fixnum (acode-fixnum-form-p i))
     1739           (j-known-fixnum (acode-fixnum-form-p j))
     1740           (src ($ arm::temp0))
     1741           (unscaled-i ($ arm::arg_x))
     1742           (unscaled-j ($ arm::arg_y))
     1743           (val-reg ($ arm::arg_z)))
     1744      (arm2-four-targeted-reg-forms seg
     1745                                    array src
     1746                                    i unscaled-i
     1747                                    j unscaled-j
     1748                                    new val-reg)
     1749      (when safe
     1750        (when (typep safe 'fixnum)
     1751          (with-node-target (src unscaled-i unscaled-j val-reg) expected
     1752            (! lri expected
     1753               (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1754                         (ash 1 $arh_simple_bit))
     1755                    arm::fixnumshift))
     1756            (! trap-unless-simple-array-2 src expected)))
     1757        (unless i-known-fixnum
     1758          (! trap-unless-fixnum unscaled-i))
     1759        (unless j-known-fixnum
     1760          (! trap-unless-fixnum unscaled-j)))
     1761      (with-imm-target () dim1
     1762        (let* ((idx-reg ($ arm::arg_y)))
     1763          (if safe                 
     1764            (! check-2d-bound dim1 unscaled-i unscaled-j src)
     1765            (! 2d-dim1 dim1 src))
     1766          (let* ((v ($ arm::arg_x)))
     1767            (! array-data-vector-ref v src)
     1768            (arm2-vset1 seg vreg xfer type-keyword v idx-reg nil val-reg (arm2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval t)))))))
     1769     
     1770 
    17371771(defun arm2-aset2 (seg vreg xfer  array i j new safe type-keyword dim0 dim1)
    17381772  (with-arm-local-vinsn-macros (seg vreg xfer)
     
    17421776           (is-node (member type-keyword (arch::target-gvector-types arch)))
    17431777           (constval (arm2-constant-value-ok-for-type-keyword type-keyword new))
    1744            (needs-memoization (and is-node (arm2-acode-needs-memoization new)))
    1745            (src)
    1746            (unscaled-i)
    1747            (unscaled-j)
    1748            (val-reg (arm2-target-reg-for-aset vreg type-keyword))
    1749            (constidx
    1750             (and dim0 dim1 i-known-fixnum j-known-fixnum
    1751                  (>= i-known-fixnum 0)
    1752                  (>= j-known-fixnum 0)
    1753                  (< i-known-fixnum dim0)
    1754                  (< j-known-fixnum dim1)
    1755                  (+ (* i-known-fixnum dim1) j-known-fixnum))))
    1756       (progn
    1757         (if constidx
    1758           (multiple-value-setq (src val-reg)
    1759             (arm2-two-targeted-reg-forms seg array ($ arm::temp0) new val-reg))
    1760           (multiple-value-setq (src unscaled-i unscaled-j val-reg)
    1761             (if needs-memoization
    1762               (progn
    1763                 (arm2-four-targeted-reg-forms seg
    1764                                               array ($ arm::temp0)
    1765                                               i ($ arm::arg_x)
    1766                                               j ($ arm::arg_y)
    1767                                               new val-reg)
    1768                 (values ($ arm::temp0) ($ arm::arg_x) ($ arm::arg_y) ($ arm::arg_z)))
    1769               (arm2-four-untargeted-reg-forms seg
    1770                                               array ($ arm::temp0)
    1771                                               i ($ arm::arg_x)
    1772                                               j ($ arm::arg_y)
    1773                                               new val-reg))))
    1774         (let* ((*available-backend-imm-temps* *available-backend-imm-temps*))
    1775           (when (and (= (hard-regspec-class val-reg) hard-reg-class-gpr)
    1776                      (logbitp (hard-regspec-value val-reg)
    1777                               *backend-imm-temps*))
    1778             (use-imm-temp (hard-regspec-value val-reg)))
    1779           (when safe     
    1780             (when (typep safe 'fixnum)
    1781               (let* ((*available-backend-node-temps* *available-backend-node-temps*))
    1782                 (when unscaled-i
    1783                   (use-node-temp (hard-regspec-value unscaled-i)))
    1784                 (when unscaled-j
    1785                   (use-node-temp (hard-regspec-value unscaled-j)))
    1786                 (with-node-target (src val-reg) expected
    1787                   (! lri expected
    1788                      (ash (dpb safe target::arrayH.flags-cell-subtag-byte
    1789                                (ash 1 $arh_simple_bit))
    1790                           arm::fixnumshift))
    1791                   (! trap-unless-simple-array-2 src expected))))
    1792             (unless i-known-fixnum
    1793               (! trap-unless-fixnum unscaled-i))
    1794             (unless j-known-fixnum
    1795               (! trap-unless-fixnum unscaled-j)))
    1796           (with-imm-target () dim1
    1797             (let* ((idx-reg ($ arm::arg_y)))
    1798               (unless constidx
    1799                 (if safe                 
    1800                   (! check-2d-bound dim1 unscaled-i unscaled-j src)
    1801                   (! 2d-dim1 dim1 src))
    1802                 (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
    1803               (let* ((v ($ arm::arg_x)))
    1804                 (! array-data-vector-ref v src)
    1805                 (arm2-vset1 seg vreg xfer type-keyword v idx-reg constidx val-reg (arm2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval needs-memoization)))))))))
     1778           (needs-memoization (and is-node (arm2-acode-needs-memoization new))))
     1779      (if needs-memoization
     1780        (arm2-aset2-via-gvset seg vreg xfer array i j new safe type-keyword constval)
     1781        (let* ((constidx
     1782                (and *arm2-reckless*
     1783                     dim0 dim1 i-known-fixnum j-known-fixnum
     1784                     (>= i-known-fixnum 0)
     1785                     (>= j-known-fixnum 0)
     1786                     (< i-known-fixnum dim0)
     1787                     (< j-known-fixnum dim1)
     1788                     (+ (* i-known-fixnum dim1) j-known-fixnum)))
     1789               (val-reg (arm2-target-reg-for-aset vreg type-keyword))
     1790               (node-val (if (node-reg-p val-reg) val-reg))
     1791               (imm-val (if (imm-reg-p val-reg) val-reg)))
     1792          (with-node-target (node-val) src
     1793            (with-node-target (node-val src) unscaled-i
     1794              (with-node-target (node-val src unscaled-i) unscaled-j
     1795                (if constidx
     1796                  (multiple-value-setq (src val-reg)
     1797                    (arm2-two-untargeted-reg-forms seg array ($ arm::temp0) new val-reg))
     1798                  (multiple-value-setq (src unscaled-i unscaled-j val-reg)
     1799                    (arm2-four-untargeted-reg-forms seg
     1800                                                    array src
     1801                                                    i unscaled-i
     1802                                                    j unscaled-j
     1803                                                    new val-reg)))
     1804                (if (node-reg-p val-reg) (setq node-val val-reg))
     1805                (if (imm-reg-p val-reg) (setq imm-val val-reg))
     1806                (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     1807                       )
     1808                  (when (and (= (hard-regspec-class val-reg) hard-reg-class-gpr)
     1809                             (logbitp (hard-regspec-value val-reg)
     1810                                      *backend-imm-temps*))
     1811                    (use-imm-temp (hard-regspec-value val-reg)))
     1812                  (when safe     
     1813                    (when (typep safe 'fixnum)
     1814                      (with-node-target (src node-val unscaled-i unscaled-j) expected
     1815                        (! lri expected
     1816                           (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     1817                                     (ash 1 $arh_simple_bit))
     1818                                arm::fixnumshift))
     1819                        (! trap-unless-simple-array-2 src expected)))
     1820                    (unless i-known-fixnum
     1821                      (! trap-unless-fixnum unscaled-i))
     1822                    (unless j-known-fixnum
     1823                      (! trap-unless-fixnum unscaled-j)))
     1824                  (with-imm-target (imm-val) dim1
     1825                    (with-node-target (src node-val) idx-reg
     1826                      (unless constidx
     1827                        (if safe                 
     1828                          (! check-2d-bound dim1 unscaled-i unscaled-j src)
     1829                          (! 2d-dim1 dim1 src))
     1830                        (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
     1831                      (with-node-target (idx-reg node-val) v
     1832                        (! array-data-vector-ref v src)
     1833                        (arm2-vset1 seg vreg xfer type-keyword v idx-reg constidx val-reg (arm2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval needs-memoization)))))))))))))
    18061834
    18071835
     
    18211849           (val-reg (arm2-target-reg-for-aset vreg type-keyword))
    18221850           (constidx
    1823             (and dim0 dim1 dim2 i-known-fixnum j-known-fixnum k-known-fixnum
     1851            (and *arm2-reckless*
     1852                 (not needs-memoization) dim0 dim1 dim2 i-known-fixnum j-known-fixnum k-known-fixnum
    18241853                 (>= i-known-fixnum 0)
    18251854                 (>= j-known-fixnum 0)
     
    18941923           (unscaled-j)
    18951924           (constidx
    1896             (and dim0 dim1 i-known-fixnum j-known-fixnum
     1925            (and *arm2-reckless*
     1926                 dim0 dim1 i-known-fixnum j-known-fixnum
    18971927                 (>= i-known-fixnum 0)
    18981928                 (>= j-known-fixnum 0)
     
    19321962              (! 2d-dim1 dim1 src))
    19331963            (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
    1934           (with-node-target (idx-reg) v
     1964          (with-node-target (idx-reg src) v
    19351965            (! array-data-vector-ref v src)
    19361966            (arm2-vref1 seg vreg xfer typekeyword v idx-reg constidx)))))))
     
    19481978           (unscaled-k)
    19491979           (constidx
    1950             (and dim0 dim1 i-known-fixnum j-known-fixnum k-known-fixnum
     1980            (and *arm2-reckless*
     1981                 dim0 dim1 i-known-fixnum j-known-fixnum k-known-fixnum
    19511982                 (>= i-known-fixnum 0)
    19521983                 (>= j-known-fixnum 0)
     
    33563387          (arm2-elide-pushes seg apushed (arm2-pop-register seg (setq adest areg)))))
    33573388      (values adest bdest cdest))))
     3389
    33583390
    33593391(defun arm2-four-untargeted-reg-forms (seg aform areg bform breg cform creg dform dreg)
Note: See TracChangeset for help on using the changeset viewer.