Changeset 5448


Ignore:
Timestamp:
Nov 3, 2006, 11:41:05 AM (18 years ago)
Author:
Gary Byers
Message:

Change handling of 2d-aref; lots of related changes.

Split the code which handles bounds/type-checking in vref out from the code which
actually does the reference, so that the latter can be used in multidimensional
cases.

Need to do this on PPC as well; need to do more (%aset2, 3d cases, general case.)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ccl/compiler/X86/x862.lisp

    r5373 r5448  
    14281428
    14291429
     1430(defun x862-vref1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum) 
     1431  (with-x86-local-vinsn-macros (seg vreg xfer)
     1432    (when vreg
     1433      (let* ((arch (backend-target-arch *target-backend*))
     1434             (is-node (member type-keyword (arch::target-gvector-types arch)))
     1435             (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch)))
     1436
     1437             (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch)))
     1438             (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch)))
     1439             (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch)))
     1440             (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch)))
     1441             (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector)))
     1442             (vreg-class (and (not (eq vreg :push)) (hard-regspec-class vreg)))
     1443             (vreg-mode
     1444              (if (eql vreg-class hard-reg-class-gpr)
     1445                (get-regspec-mode vreg)
     1446                hard-reg-class-gpr-mode-invalid)))
     1447        (cond
     1448          (is-node
     1449           (if (eq vreg :push)
     1450             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
     1451               (! push-misc-ref-c-node  src index-known-fixnum)
     1452               (! push-misc-ref-node src unscaled-idx))
     1453             (ensuring-node-target (target vreg)
     1454               (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
     1455                 (! misc-ref-c-node target src index-known-fixnum)
     1456                 (! misc-ref-node target src unscaled-idx)))))
     1457          (is-32-bit
     1458           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))
     1459             (cond ((eq type-keyword :single-float-vector)
     1460                    (with-fp-target () (fp-val :single-float)
     1461                      (if (and (eql vreg-class hard-reg-class-fpr)
     1462                               (eql vreg-mode hard-reg-class-fpr-mode-single))
     1463                        (setq fp-val vreg))
     1464                      (! misc-ref-c-single-float fp-val src index-known-fixnum)
     1465                      (if (eql vreg-class hard-reg-class-fpr)
     1466                        (<- fp-val)
     1467                        (ensuring-node-target (target vreg)
     1468                          (! single->node target fp-val)))))
     1469                   (t
     1470                    (with-imm-target () temp
     1471                      (if is-signed
     1472                        (! misc-ref-c-s32 temp src index-known-fixnum)
     1473                        (! misc-ref-c-u32 temp src index-known-fixnum))
     1474                      (ensuring-node-target (target vreg)
     1475                        (if (eq type-keyword :simple-string)
     1476                          (! u32->char target temp)
     1477                          (! box-fixnum target temp))))))
     1478             (with-imm-target () idx-reg
     1479               (if index-known-fixnum
     1480                 (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     1481                 (! scale-32bit-misc-index idx-reg unscaled-idx))
     1482               (cond ((eq type-keyword :single-float-vector)
     1483                      (with-fp-target () (fp-val :single-float)
     1484                        (if (and (eql vreg-class hard-reg-class-fpr)
     1485                                 (eql vreg-mode hard-reg-class-fpr-mode-single))
     1486                          (setq fp-val vreg))
     1487                        (! misc-ref-single-float fp-val src idx-reg)
     1488                        (if (eq vreg-class hard-reg-class-fpr)
     1489                          (<- fp-val)
     1490                          (ensuring-node-target (target vreg)
     1491                            (! single->node target fp-val)))))
     1492                     (t (with-imm-target () temp
     1493                          (if is-signed
     1494                            (! misc-ref-s32 temp src idx-reg)
     1495                            (! misc-ref-u32 temp src idx-reg))
     1496                          (ensuring-node-target (target vreg)
     1497                            (if (eq type-keyword :simple-string)
     1498                              (! u32->char target temp)
     1499                              (! box-fixnum target temp)))))))))
     1500          (is-8-bit
     1501           (with-imm-target () temp
     1502             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-8-bit-constant-index arch)))
     1503               (if is-signed
     1504                 (! misc-ref-c-s8 temp src index-known-fixnum)
     1505                 (! misc-ref-c-u8 temp src index-known-fixnum))
     1506               (with-imm-target () idx-reg
     1507                 (if index-known-fixnum
     1508                   (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     1509                   (! scale-8bit-misc-index idx-reg unscaled-idx))
     1510                 (if is-signed
     1511                   (! misc-ref-s8 temp src idx-reg)
     1512                   (! misc-ref-u8 temp src idx-reg))))
     1513             (if (eq type-keyword :simple-string)
     1514               (ensuring-node-target (target vreg)
     1515                 (! u32->char target temp))
     1516               (if (and (= vreg-mode hard-reg-class-gpr-mode-u8)
     1517                        (eq type-keyword :unsigned-8-bit-vector))
     1518                 (x862-copy-register seg vreg temp)
     1519                 (ensuring-node-target (target vreg)
     1520                   (! box-fixnum target temp))))))
     1521          (is-16-bit
     1522           (with-imm-target () temp
     1523             (ensuring-node-target (target vreg)
     1524               (if (and index-known-fixnum
     1525                        (<= index-known-fixnum (arch::target-max-16-bit-constant-index arch)))
     1526                 (if is-signed
     1527                   (! misc-ref-c-s16 temp src index-known-fixnum)
     1528                   (! misc-ref-c-u16 temp src index-known-fixnum))
     1529                 (with-imm-target () idx-reg
     1530                   (if index-known-fixnum
     1531                     (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     1532                     (! scale-16bit-misc-index idx-reg unscaled-idx))
     1533                   (if is-signed
     1534                     (! misc-ref-s16 temp src idx-reg)
     1535                     (! misc-ref-u16 temp src idx-reg))))
     1536               (! box-fixnum target temp))))
     1537          ;; Down to the dregs.
     1538          (is-64-bit
     1539           (case type-keyword
     1540             (:double-float-vector
     1541              (with-fp-target () (fp-val :double-float)
     1542                (if (and (eql vreg-class hard-reg-class-fpr)
     1543                         (eql vreg-mode hard-reg-class-fpr-mode-double))
     1544                  (setq fp-val vreg))
     1545                (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
     1546                  (! misc-ref-c-double-float fp-val src index-known-fixnum)
     1547                  (progn
     1548                    (if index-known-fixnum
     1549                      (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
     1550                    (! misc-ref-double-float fp-val src unscaled-idx)))
     1551                (if (eq vreg-class hard-reg-class-fpr)
     1552                  (<- fp-val)
     1553                  (ensuring-node-target (target vreg)
     1554                    (x862-double->heap seg target fp-val)))))
     1555             ((:signed-64-bit-vector :fixnum-vector)
     1556              (ensuring-node-target (target vreg)
     1557
     1558                (with-imm-target () (s64-reg :s64)
     1559                  (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
     1560                    (! misc-ref-c-s64 s64-reg src index-known-fixnum)
     1561                    (progn
     1562                      (if index-known-fixnum
     1563                        (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
     1564                      (! misc-ref-s64 s64-reg src unscaled-idx)))
     1565                  (if (eq type-keyword :fixnum-vector)
     1566                    (! box-fixnum target s64-reg)
     1567                    (x862-box-s64 seg target s64-reg)))))
     1568             (t
     1569                (with-imm-target () (u64-reg :u64)
     1570                  (if (eql vreg-mode hard-reg-class-gpr-mode-u64)
     1571                    (setq u64-reg vreg))
     1572                  (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
     1573                    (! misc-ref-c-u64 u64-reg src index-known-fixnum)
     1574                    (progn
     1575                      (if index-known-fixnum
     1576                        (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
     1577                      (! misc-ref-u64 u64-reg src unscaled-idx)))
     1578                  (unless (eq u64-reg vreg)
     1579                    (ensuring-node-target (target vreg)
     1580                      (x862-box-u64 seg target u64-reg)))))))
     1581          (t
     1582           (unless is-1-bit
     1583             (nx-error "~& unsupported vector type: ~s"
     1584                       type-keyword))
     1585           (ensuring-node-target (target vreg)
     1586             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     1587               (! misc-ref-c-bit-fixnum target src index-known-fixnum)
     1588               (with-imm-temps
     1589                   () (word-index bitnum)
     1590                 (if index-known-fixnum
     1591                   (progn
     1592                     (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
     1593                     (x862-lri seg bitnum (logand index-known-fixnum #x63)))
     1594                   (! word-index-and-bitnum-from-index word-index bitnum unscaled-idx))
     1595                 (! ref-bit-vector-fixnum target bitnum src word-index))))))))
     1596    (^)))
     1597
    14301598;;; safe = T means assume "vector" is miscobj, do bounds check.
    14311599;;; safe = fixnum means check that subtag of vector = "safe" and do
    … …  
    14341602;;; This mostly knows how to reference the elements of an immediate miscobj.
    14351603(defun x862-vref (seg vreg xfer type-keyword vector index safe)
    1436   (let* ((arch (backend-target-arch *target-backend*))
    1437          (is-node (member type-keyword (arch::target-gvector-types arch)))
    1438          (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch)))
    1439 
    1440          (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch)))
    1441          (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch)))
    1442          (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch)))
    1443          (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch)))
    1444          (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector))))
    1445     (if is-node
    1446       (x862-misc-node-ref seg vreg xfer vector index safe)
    1447       (with-x86-local-vinsn-macros (seg vreg xfer)
    1448         (if (null vreg)
    1449           (progn
    1450             (x862-form seg nil nil vector)
    1451             (x862-form seg nil xfer index))
    1452           (let* ((vreg-class (hard-regspec-class vreg))
    1453                  (vreg-mode
    1454                   (if (= vreg-class hard-reg-class-gpr)
    1455                     (get-regspec-mode vreg)
    1456                     hard-reg-class-gpr-mode-invalid)))
    1457             (declare (fixnum vreg-class vreg-mode))
    1458             (if (and (= vreg-class hard-reg-class-fpr)
    1459                      (eq type-keyword :double-float-vector))
    1460               (x862-df-vref seg vreg xfer vector index safe)
    1461               (if (and (= vreg-class hard-reg-class-fpr)
    1462                        (eq type-keyword :single-float-vector))
    1463                 (x862-sf-vref seg vreg xfer vector index safe)
    1464                 (if (target-arch-case
    1465                      
    1466                      (:x8664
    1467                       (and (= vreg-mode hard-reg-class-gpr-mode-u64)
    1468                            is-64-bit
    1469                            (not (or (eq type-keyword :signed-64-bit-vector)
    1470                                     (eq type-keyword :fixnum-vector)
    1471                                     (eq type-keyword :double-float-vector))))))
    1472                      
    1473                   (x862-natural-vref seg vreg xfer vector index safe)
    1474                   (let* ((index-known-fixnum (acode-fixnum-form-p index))
    1475                          (unscaled-idx nil)
    1476                          (src nil))
    1477                     (if (or safe (not index-known-fixnum))
    1478                       (multiple-value-setq (src unscaled-idx)
    1479                         (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
    1480                       (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
    1481                     (when safe
    1482                       (if (typep safe 'fixnum)
    1483                         (! trap-unless-typecode= src safe))
    1484                       (unless index-known-fixnum
    1485                         (! trap-unless-fixnum unscaled-idx))
    1486                       (! check-misc-bound unscaled-idx src))
    1487                     (if is-32-bit
    1488                       (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))
    1489                         (cond ((eq type-keyword :single-float-vector)
    1490                                (! misc-ref-c-single-float x8664::fp1 src index-known-fixnum)
    1491                                (ensuring-node-target (target vreg)
    1492                                  (! single->node target x8664::fp1)))
    1493                               (t
    1494                                (with-imm-temps () (temp)
    1495                                  (if is-signed
    1496                                    (! misc-ref-c-s32 temp src index-known-fixnum)
    1497                                    (! misc-ref-c-u32 temp src index-known-fixnum))
    1498                                  (ensuring-node-target (target vreg)
    1499                                    (if (eq type-keyword :simple-string)
    1500                                      (! u32->char target temp)
    1501                                      (! box-fixnum target temp))))))
    1502                         (with-imm-temps
    1503                             () (idx-reg)
    1504                           (if index-known-fixnum
    1505                             (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    1506                             (! scale-32bit-misc-index idx-reg unscaled-idx))
    1507                           (cond ((eq type-keyword :single-float-vector)
    1508                                  (! misc-ref-single-float x8664::fp1 src idx-reg)
    1509                                  (ensuring-node-target (target vreg)
    1510                                    
    1511                                    (! single->node target x8664::fp1)))
    1512                                 (t (with-imm-temps
    1513                                        (idx-reg) (temp)
    1514                                      (if is-signed
    1515                                        (! misc-ref-s32 temp src idx-reg)
    1516                                        (! misc-ref-u32 temp src idx-reg))
    1517                                      (ensuring-node-target (target vreg)
    1518                                        (if (eq type-keyword :simple-string)
    1519                                          (! u32->char target temp)
    1520                                          (! box-fixnum target temp))))))))
    1521                       (if is-8-bit
    1522                         (with-imm-temps
    1523                             () (temp)
    1524                           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-8-bit-constant-index arch)))
    1525                             (if is-signed
    1526                               (! misc-ref-c-s8 temp src index-known-fixnum)
    1527                               (! misc-ref-c-u8 temp src index-known-fixnum))
    1528                             (with-imm-temps
    1529                                 () (idx-reg)
    1530                               (if index-known-fixnum
    1531                                 (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
    1532                                 (! scale-8bit-misc-index idx-reg unscaled-idx))
    1533                               (if is-signed
    1534                                 (! misc-ref-s8 temp src idx-reg)
    1535                                 (! misc-ref-u8 temp src idx-reg))))
    1536                           (if (eq type-keyword :simple-string)
    1537                             (ensuring-node-target (target vreg)
    1538                               (! u32->char target temp))
    1539                             (if (and (= vreg-mode hard-reg-class-gpr-mode-u8)
    1540                                      (eq type-keyword :unsigned-8-bit-vector))
    1541                               (x862-copy-register seg vreg temp)
    1542                               (ensuring-node-target (target vreg)
    1543                                 (! box-fixnum target temp)))))
    1544                         (if is-16-bit
    1545                           (with-imm-temps
    1546                               () (temp)
    1547                             (ensuring-node-target (target vreg)
    1548                               (if (and index-known-fixnum
    1549                                        (<= index-known-fixnum (arch::target-max-16-bit-constant-index arch)))
    1550                                 (if is-signed
    1551                                   (! misc-ref-c-s16 temp src index-known-fixnum)
    1552                                   (! misc-ref-c-u16 temp src index-known-fixnum))
    1553                                 (with-imm-temps
    1554                                     () (idx-reg)
    1555                                   (if index-known-fixnum
    1556                                     (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
    1557                                     (! scale-16bit-misc-index idx-reg unscaled-idx))
    1558                                   (if is-signed
    1559                                     (! misc-ref-s16 temp src idx-reg)
    1560                                     (! misc-ref-u16 temp src idx-reg))))
    1561                               (! box-fixnum target temp)))
    1562                           ;; Down to the dregs.
    1563                           (if is-64-bit
    1564                             (ensuring-node-target (target vreg)
    1565                               (ecase type-keyword
    1566                                 (:double-float-vector
    1567                                  (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    1568                                    (! misc-ref-c-double-float 0 src index-known-fixnum)
    1569                                    (progn
    1570                                      (if index-known-fixnum
    1571                                        (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
    1572                                      (! misc-ref-double-float x8664::fp1 src unscaled-idx)))
    1573                                  (x862-double->heap seg target x8664::fp1))
    1574                                 (:unsigned-64-bit-vector
    1575                                  (with-imm-target () (u64-reg :u64)
    1576                                    (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    1577                                      (! misc-ref-c-u64 u64-reg src index-known-fixnum)
    1578                                      (progn
    1579                                        (if index-known-fixnum
    1580                                          (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
    1581                                        (! misc-ref-u64 u64-reg src unscaled-idx)))
    1582                                    (x862-box-u64 seg target u64-reg)))
    1583                                 ((:signed-64-bit-vector :fixnum-vector)
    1584                                  (with-imm-target () (s64-reg :s64)
    1585                                    (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    1586                                      (! misc-ref-c-s64 s64-reg src index-known-fixnum)
    1587                                      (progn
    1588                                        (if index-known-fixnum
    1589                                          (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))))
    1590                                        (! misc-ref-s64 s64-reg src unscaled-idx)))
    1591                                    (if (eq type-keyword :fixnum-vector)
    1592                                      (! box-fixnum target s64-reg)
    1593                                      (x862-box-s64 seg target s64-reg))))))
    1594                             (progn
    1595                               (unless is-1-bit
    1596                                 (nx-error "~& unsupported vector type: ~s"
    1597                                           type-keyword))
    1598                               (ensuring-node-target (target vreg)
    1599                                 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    1600                                   (! misc-ref-c-bit-fixnum target src index-known-fixnum)
    1601                                   (with-imm-temps
    1602                                       () (word-index bitnum)
    1603                                     (if index-known-fixnum
    1604                                       (progn
    1605                                         (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    1606                                         (x862-lri seg bitnum (logand index-known-fixnum #x63)))
    1607                                       (! word-index-and-bitnum-from-index word-index bitnum unscaled-idx))
    1608                                     (! ref-bit-vector-fixnum target bitnum src word-index)))))))))
    1609                     (^)))))))))))
    1610 
    1611 ;;; In this case, the target register is an fp reg and the vector is declared
    1612 ;;; do be a double-float vector.  Avoid boxing the result!
    1613 (defun x862-df-vref (seg vreg xfer vector index safe)
    16141604  (with-x86-local-vinsn-macros (seg vreg xfer)
    1615     (let* ((index-known-fixnum (acode-fixnum-form-p index))
    1616            (arch (backend-target-arch *target-backend*))
    1617            (src)
    1618            (unscaled-idx))
    1619       (if (or safe (not index-known-fixnum))
    1620         (multiple-value-setq (src unscaled-idx)
    1621           (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
    1622         (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
    1623       (when safe
    1624         (if (typep safe 'fixnum)
    1625           (! trap-unless-typecode= src safe))
    1626         (unless index-known-fixnum
    1627           (! trap-unless-fixnum unscaled-idx))
    1628         (! check-misc-bound unscaled-idx src))
    1629       (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    1630         (! misc-ref-c-double-float vreg src index-known-fixnum)
    1631         (progn
    1632           (if index-known-fixnum
    1633             (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
    1634           (! misc-ref-double-float vreg src unscaled-idx)))
    1635       (^))))
     1605    (if (null vreg)
     1606      (progn
     1607        (x862-form seg nil nil vector)
     1608        (x862-form seg nil xfer index))
     1609      (let* ((index-known-fixnum (acode-fixnum-form-p index))
     1610             (unscaled-idx nil)
     1611             (src nil))
     1612        (if (or safe (not index-known-fixnum))
     1613          (multiple-value-setq (src unscaled-idx)
     1614            (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
     1615          (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
     1616        (when safe
     1617          (if (typep safe 'fixnum)
     1618            (! trap-unless-typecode= src safe))
     1619          (unless index-known-fixnum
     1620            (! trap-unless-fixnum unscaled-idx))
     1621          (! check-misc-bound unscaled-idx src))
     1622        (x862-vref1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum)))))
     1623
     1624
    16361625
    16371626(defun x862-aset2 (seg target  array i j new safe typename &optional dim0 dim1)
    … …  
    17061695  target)
    17071696
     1697(defun x862-error-for-simple-2d-array-type (type-keyword)
     1698  (ecase type-keyword
     1699    (:simple-vector arch::error-object-not-simple-array-t-2d)
     1700    (:simple-string arch::error-object-not-simple-array-char-2d)
     1701    (:bit-vector arch::error-object-not-simple-array-bit-2d)
     1702    (:unsigned-8-bit-vector arch::error-object-not-simple-array-u8-2d)
     1703    (:signed-8-bit-vector arch::error-object-not-simple-array-s8-2d)
     1704    (:unsigned-16-bit-vector arch::error-object-not-simple-array-u16-2d)
     1705    (:signed-16-bit-vector arch::error-object-not-simple-array-s16-2d)
     1706    (:unsigned-32-bit-vector arch::error-object-not-simple-array-u32-2d)
     1707    (:signed-32-bit-vector arch::error-object-not-simple-array-s32-2d)
     1708    (:unsigned-64-bit-vector arch::error-object-not-simple-array-u64-2d)
     1709    (:signed-64-bit-vector arch::error-object-not-simple-array-s64-2d)
     1710    (:double-float-vector arch::error-object-not-simple-array-double-float-2d)
     1711    (:single-float-vector arch::error-object-not-simple-array-double-float-2d)))
     1712 
    17081713(defun x862-aref2 (seg vreg xfer array i j safe typekeyword &optional dim0 dim1)
    17091714  (with-x86-local-vinsn-macros (seg vreg xfer)
    17101715    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    17111716           (j-known-fixnum (acode-fixnum-form-p j))
    1712            (arch (backend-target-arch *target-backend*))
    17131717           (src)
    1714            (need-scale t)
    17151718           (unscaled-i)
    17161719           (unscaled-j)
    … …  
    17311734      (when safe       
    17321735        (when (typep safe 'fixnum)
    1733           (! trap-unless-array-header src)
    1734           (! check-arrayH-rank src 2)
    1735           (! check-arrayH-flags src
     1736          (! trap-unless-simple-array-2
     1737             src
    17361738             (dpb safe target::arrayH.flags-cell-subtag-byte
    17371739                  (ash 1 $arh_simple_bit))
    1738              (ecase typekeyword
    1739                (:double-float-vector arch::error-object-not-simple-array-double-float-2d)
    1740                (:singe-float-vector arch::error-object-not-simple-array-double-float-2d))
    1741              ))
     1740             (x862-error-for-simple-2d-array-type typekeyword)))
    17421741        (unless i-known-fixnum
    17431742          (! trap-unless-fixnum unscaled-i))
    17441743        (unless j-known-fixnum
    17451744          (! trap-unless-fixnum unscaled-j)))
    1746       (with-imm-temps () (dim1 idx-reg)
     1745      (with-node-target (src unscaled-i unscaled-j) idx-reg
     1746        (with-imm-target () dim1
    17471747        (unless constidx
    17481748          (if safe                   
    17491749            (! check-2d-bound dim1 unscaled-i unscaled-j src)
    17501750            (! 2d-dim1 dim1 src))
    1751           (! 2d-unscaled-index idx-reg src unscaled-i unscaled-j dim1))
    1752         (with-node-temps () (v)
     1751          (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
     1752        (with-node-target (idx-reg) v
    17531753          (! array-data-vector-ref v src)
    1754           (let* ((bias (arch::target-misc-data-offset arch)))
    1755             (multiple-value-bind (shift limit)
    1756                 (case typekeyword
    1757                   (:double-float-vector
    1758                    (setq bias (arch::target-misc-dfloat-offset arch))
    1759                    (values 3 (arch::target-max-64-bit-constant-index arch)))
    1760                   ((:single-float-vector
    1761                     :s32-vector
    1762                     :u32-vector)
    1763                    (values 2 (arch::target-max-32-bit-constant-index arch))))
    1764               (when (and constidx (>= constidx limit))
    1765                 (x862-absolute-natural seg idx-reg nil (+ bias
    1766                                                        (ash constidx shift)))
    1767                 (setq constidx nil need-scale nil))))
    1768           (case typekeyword
    1769             (:double-float-vector
    1770              (if constidx
    1771                (! misc-ref-c-double-float vreg v constidx)
    1772                (progn
    1773                  (! misc-ref-double-float vreg v idx-reg))))
    1774             (:single-float-vector
    1775              (if constidx
    1776                (! misc-ref-c-single-float vreg v constidx)
    1777                (progn
    1778                  (when need-scale (! scale-32bit-misc-index idx-reg idx-reg))
    1779                  (! misc-ref-single-float vreg v idx-reg)))))))
    1780       (^))))
    1781 
    1782 (defun x862-sf-vref (seg vreg xfer vector index safe)
    1783   (with-x86-local-vinsn-macros (seg vreg xfer)
    1784     (let* ((index-known-fixnum (acode-fixnum-form-p index))
    1785            (arch (backend-target-arch *target-backend*))
    1786            (src)
    1787            (unscaled-idx))
    1788       (if (or safe (not index-known-fixnum))
    1789         (multiple-value-setq (src unscaled-idx)
    1790           (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
    1791         (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
    1792       (when safe
    1793         (if (typep safe 'fixnum)
    1794           (! trap-unless-typecode= src safe))
    1795         (unless index-known-fixnum
    1796           (! trap-unless-fixnum unscaled-idx))
    1797         (! check-misc-bound unscaled-idx src))
    1798       (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))
    1799         (! misc-ref-c-single-float vreg src index-known-fixnum)
    1800         (with-imm-temps () (idx-reg)
    1801           (if index-known-fixnum
    1802             (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3)))
    1803             (! scale-32bit-misc-index idx-reg unscaled-idx))
    1804           (! misc-ref-single-float vreg src idx-reg)))
    1805       (^))))
    1806 
    1807 ;;; Vreg is of mode u32/u64; so's the vector element.  Don't box result.
    1808 (defun x862-natural-vref (seg vreg xfer vector index safe)
    1809   (with-x86-local-vinsn-macros (seg vreg xfer)
    1810     (let* ((index-known-fixnum (acode-fixnum-form-p index))
    1811            (src)
    1812            (unscaled-idx))
    1813       (if (or safe (not index-known-fixnum))
    1814         (multiple-value-setq (src unscaled-idx)
    1815           (x862-two-untargeted-reg-forms seg vector x8664::arg_y index x8664::arg_z))
    1816         (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
    1817       (when safe
    1818         (if (typep safe 'fixnum)
    1819           (! trap-unless-typecode= src safe))
    1820         (unless index-known-fixnum
    1821           (! trap-unless-fixnum unscaled-idx))
    1822         (! check-misc-bound unscaled-idx src))
    1823       (target-arch-case
    1824        
    1825        (:x8664
    1826         (if (and index-known-fixnum (<= index-known-fixnum x8664::max-64-bit-constant-index))
    1827           (! misc-ref-c-u64 vreg src index-known-fixnum)
    1828           (progn
    1829             (if index-known-fixnum
    1830               (x862-absolute-natural seg unscaled-idx nil (+ x8664::misc-data-offset (ash index-known-fixnum 3))))
    1831             (! misc-ref-u64 vreg src unscaled-idx)))))
    1832       (^))))
     1754          (x862-vref1 seg vreg xfer typekeyword v idx-reg constidx)))))))
     1755
     1756
    18331757
    18341758(defun x862-natural-vset (seg vreg xfer vector index value safe)
    … …  
    18891813                         (typep val 'bit)))))
    18901814      (if typep val))))
     1815
     1816#||
     1817;;; Caller has to have handled node case specially, may also have wanted to have
     1818;;; targeted the value to a specific register.
     1819(defun x862-vset1 (seg vreg xfer type-keyword vector index-reg index-known-fixnum val-reg constval)
     1820  (let* ((arch (backend-target-arch *target-backend*))
     1821         (is-node (member type-keyword (arch::target-gvector-types arch)))
     1822         (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch)))
     1823         (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch)))
     1824         (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch)))
     1825         (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch)))
     1826         (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))))
     1827    (cond (is-node
     1828           (! misc-set-node val-reg vector index-reg)
     1829           ))))
     1830||#
    18911831
    18921832(defun x862-vset (seg vreg xfer type-keyword vector index value safe)
    … …  
    41484088      (^))))
    41494089
    4150 ;;; If safe, ensure that index is a fixnum (if non-constant)
    4151 ;;; and check vector bound.
    4152 ;;; If we're going to have to evaluate the index into a register (to do
    4153 ;;; the bounds check), but know that the index could be a constant 16-bit
    4154 ;;; displacement, this'll look pretty silly ..
    4155 (defun x862-misc-node-ref (seg vreg xfer miscobj index safe)
    4156   (with-x86-local-vinsn-macros (seg vreg xfer)
    4157     (let* ((index-known-fixnum (acode-fixnum-form-p index))
    4158            (arch (backend-target-arch *target-backend*))
    4159            (unscaled-idx nil)
    4160            (src nil))
    4161       (if (or safe (not (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))))
    4162         (multiple-value-setq (src unscaled-idx)
    4163           (x862-two-untargeted-reg-forms seg miscobj x8664::arg_y index x8664::arg_z))
    4164         (setq src (x862-one-untargeted-reg-form seg miscobj x8664::arg_z)))
    4165       (when safe
    4166         (if (typep safe 'fixnum)
    4167           (! trap-unless-typecode= src safe))
    4168         (unless index-known-fixnum
    4169           (! trap-unless-fixnum unscaled-idx))
    4170         (! check-misc-bound unscaled-idx src))
    4171       (when vreg
    4172         (if (eq vreg :push)
    4173           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    4174             (! push-misc-ref-c-node  src index-known-fixnum)
    4175             (! push-misc-ref-node src unscaled-idx))
    4176         (ensuring-node-target (target vreg)
    4177           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    4178               (! misc-ref-c-node target src index-known-fixnum)
    4179             (! misc-ref-node target src unscaled-idx)))))
    4180       (^))))
    41814090
    41824091(defun x862-misc-node-set (seg vreg xfer miscobj index value safe)
    … …  
    52095118  (with-x86-local-vinsn-macros (seg vreg xfer)
    52105119    (let* ((index (arch::builtin-function-name-offset name))
    5211            (idx-subprim (x862-builtin-index-subprim index))
     5120           (idx-subprim (if index (x862-builtin-index-subprim index)))
    52125121           (tail-p (x862-tailcallok xfer)))
    52135122      (when tail-p
    … …  
    52165125      (if idx-subprim
    52175126        (setq subprim idx-subprim)
    5218         (! lri ($ x8664::imm0) (ash index *x862-target-fixnum-shift*)))
     5127        (if index (! lri ($ x8664::imm0) (ash index *x862-target-fixnum-shift*))))
    52195128      (if tail-p
    52205129        (! jump-subprim subprim)
    … …  
    55325441(pushnew (%nx1-operator %svref) *x862-operator-supports-push*)
    55335442(defx862 x862-%svref %svref (seg vreg xfer vector index)
    5534   (x862-misc-node-ref seg vreg xfer vector index nil))
     5443  (x862-vref seg vreg xfer :simple-vector vector index nil))
    55355444
    55365445(pushnew (%nx1-operator svref) *x862-operator-supports-push*)
    55375446(defx862 x862-svref svref (seg vreg xfer vector index)
    5538   (x862-misc-node-ref seg vreg xfer vector index (unless *x862-reckless* (nx-lookup-target-uvector-subtag :simple-vector))))
     5447  (x862-vref seg vreg xfer :simple-vector vector index (unless *x862-reckless* (nx-lookup-target-uvector-subtag :simple-vector))))
    55395448
    55405449;;; It'd be nice if this didn't box the result.  Worse things happen ...
    … …  
    57345643(pushnew (%nx1-operator struct-ref) *x862-operator-supports-push*)
    57355644(defx862 x862-struct-ref struct-ref (seg vreg xfer struct offset)
    5736   (x862-misc-node-ref seg vreg xfer struct offset (unless *x862-reckless* (nx-lookup-target-uvector-subtag :struct))))
     5645  (x862-vref seg vreg xfer :struct struct offset (unless *x862-reckless* (nx-lookup-target-uvector-subtag :struct))))
    57375646
    57385647(defx862 x862-struct-set struct-set (seg vreg xfer struct offset value)
    … …  
    66106519(defx862 x862-%aref1 %aref1 (seg vreg xfer v i)
    66116520  (let* ((vtype (acode-form-type v t))
    6612          (atype (if vtype (specifier-type vtype)))
     6521         (ctype (if vtype (specifier-type vtype)))
     6522         (atype (if (array-ctype-p ctype) ctype))
    66136523         (keyword (if (and atype
     6524                           (= 1 (length (array-ctype-dimensions atype)))
    66146525                           (not (array-ctype-complexp atype)))
    66156526                    (funcall
    … …  
    66186529                        atype))))
    66196530    (if keyword
    6620       (x862-vref  seg vreg xfer keyword v i (not *x862-reckless*))
     6531      (x862-vref  seg vreg xfer keyword v i (unless *x862-reckless*
     6532                                              (nx-lookup-target-uvector-subtag keyword)))
    66216533      (x862-binary-builtin seg vreg xfer '%aref1 v i))))
    66226534
    … …  
    75917503    (x862-use-operator op seg vreg xfer n0 n1 *nx-t*)))
    75927504
    7593 (defx862 x862-%aref2 aref2 (seg vreg xfer typename arr i j &optional dim0 dim1)
     7505(defx862 x862-%aref2 simple-typed-aref2 (seg vreg xfer typename arr i j &optional dim0 dim1)
    75947506  (if (null vreg)
    75957507    (progn
    … …  
    76027514         (dim0 (acode-fixnum-form-p dim0))
    76037515         (dim1 (acode-fixnum-form-p dim1)))
    7604     (case type-keyword
    7605       (:double-float-vector
    7606        (if (= (hard-regspec-class vreg) hard-reg-class-fpr)
    7607          (x862-aref2 seg vreg xfer arr i j safe type-keyword dim0 dim1)
    7608          (with-fp-target () (target :double-float)
    7609            (x862-aref2 seg target nil arr i j safe type-keyword dim0 dim1)
    7610            (<- target)
    7611            (^))))
    7612       (:single-float-vector
    7613        (if (= (hard-regspec-class vreg) hard-reg-class-fpr)
    7614          (x862-aref2 seg vreg xfer arr i j safe fixtype dim0 dim1)
    7615          (with-fp-target () (target :single-float)
    7616            (x862-aref2 seg target nil arr i j safe type-keyword dim0 dim1)
    7617            (<- target)
    7618            (^))))
    7619       (t (error "Bug: shouldn't have tried to open-code %AREF2 call.")))))
     7516    (x862-aref2 seg vreg xfer arr i j safe type-keyword dim0 dim1)))
     7517
     7518(defx862 x862-generic-aref2 general-aref2 (seg vreg xfer arr i j)
     7519  (let* ((atype0 (acode-form-type arr t))
     7520         (ctype (if atype0 (specifier-type atype0)))
     7521         (atype (if (array-ctype-p ctype) ctype))
     7522         (keyword (and atype
     7523                           (= 2 (length (array-ctype-dimensions atype)))
     7524                           (not (array-ctype-complexp atype))
     7525                           (funcall
     7526                            (arch::target-array-type-name-from-ctype-function
     7527                             (backend-target-arch *target-backend*))
     7528                            atype))))
     7529    (cond (keyword
     7530           (let* ((dims (array-ctype-dimensions atype))
     7531                  (dim0 (car dims))
     7532                  (dim1 (cadr dims)))
     7533             (x862-aref2 seg
     7534                         vreg
     7535                         xfer
     7536                         arr
     7537                         i
     7538                         j
     7539                         (if *x862-reckless*
     7540                           *nx-nil*
     7541                           (nx-lookup-target-uvector-subtag keyword ))
     7542                         keyword ;(make-acode (%nx1-operator immediate) )
     7543                         (if (typep dim0 'fixnum) dim0) (if (typep dim1 'fixnum) dim1))))
     7544          (t
     7545           (x862-three-targeted-reg-forms seg
     7546                                          arr ($ x8664::arg_x)
     7547                                          i ($ x8664::arg_y)
     7548                                          j ($ x8664::arg_z))
     7549           (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2))))))
     7550                                         
    76207551
    76217552(defx862 x862-%aset2 aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1)
Note: See TracChangeset for help on using the changeset viewer.