Changeset 5477
- Timestamp:
- Nov 5, 2006, 6:36:06 AM (18 years ago)
- File:
-
- 1 edited
-
trunk/ccl/compiler/PPC/ppc2.lisp (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/compiler/PPC/ppc2.lisp
r5470 r5477 1304 1304 (ppc2-copy-register seg node-dest arg_z))))) 1305 1305 1306 (defun ppc2-vref1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum) 1307 (with-ppc-local-vinsn-macros (seg vreg xfer) 1308 (when vreg 1309 (let* ((arch (backend-target-arch *target-backend*)) 1310 (is-node (member type-keyword (arch::target-gvector-types arch))) 1311 (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch))) 1312 1313 (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch))) 1314 (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch))) 1315 (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch))) 1316 (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))) 1317 (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector))) 1318 (vreg-class (hard-regspec-class vreg)) 1319 (vreg-mode 1320 (if (or (eql vreg-class hard-reg-class-gpr) 1321 (eql vreg-class hard-reg-class-fpr)) 1322 (get-regspec-mode vreg) 1323 hard-reg-class-gpr-mode-invalid)) 1324 (temp-is-vreg nil)) 1325 (cond 1326 (is-node 1327 (ensuring-node-target (target vreg) 1328 (if (and index-known-fixnum (<= index-known-fixnum 1329 (target-word-size-case 1330 (32 (arch::target-max-32-bit-constant-index arch)) 1331 (64 (arch::target-max-64-bit-constant-index arch))))) 1332 (! misc-ref-c-node target src index-known-fixnum) 1333 (with-imm-target () (idx-reg :u64) 1334 (if index-known-fixnum 1335 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum *ppc2-target-node-shift*))) 1336 (! scale-node-misc-index idx-reg unscaled-idx)) 1337 (! misc-ref-node target src idx-reg))))) 1338 (is-32-bit 1339 (with-imm-target () (temp :u32) 1340 (with-fp-target () (fp-val :single-float) 1341 (if (eql vreg-class hard-reg-class-gpr) 1342 (if 1343 (if is-signed 1344 (or (eql vreg-mode hard-reg-class-gpr-mode-s32) 1345 (eql vreg-mode hard-reg-class-gpr-mode-s64)) 1346 (or (eql vreg-mode hard-reg-class-gpr-mode-u32) 1347 (eql vreg-mode hard-reg-class-gpr-mode-u64))) 1348 (setq temp vreg temp-is-vreg t) 1349 (if is-signed 1350 (set-regspec-mode temp hard-reg-class-gpr-mode-s32))) 1351 (if (and (eql vreg-class hard-reg-class-fpr) 1352 (eql vreg-mode hard-reg-class-fpr-mode-single)) 1353 (setf fp-val vreg temp-is-vreg t))) 1354 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) 1355 (cond ((eq type-keyword :single-float-vector) 1356 (! misc-ref-c-single-float fp-val src index-known-fixnum)) 1357 (t 1358 (if is-signed 1359 (! misc-ref-c-s32 temp src index-known-fixnum) 1360 (! misc-ref-c-u32 temp src index-known-fixnum))))) 1361 (with-imm-target () idx-reg 1362 (if index-known-fixnum 1363 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) 1364 (! scale-32bit-misc-index idx-reg unscaled-idx)) 1365 (cond ((eq type-keyword :single-float-vector) 1366 (! misc-ref-single-float fp-val src idx-reg)) 1367 (t 1368 (if is-signed 1369 (! misc-ref-s32 temp src idx-reg) 1370 (! misc-ref-u32 temp src idx-reg))))) 1371 (case type-keyword 1372 (:single-float-vector 1373 (if (eq vreg-class hard-reg-class-fpr) 1374 (<- fp-val) 1375 (ensuring-node-target (target vreg) 1376 (! single->node target fp-val)))) 1377 (:signed-32-bit-vector 1378 (unless temp-is-vreg 1379 (ensuring-node-target (target vreg) 1380 (ppc2-box-s32 seg target temp)))) 1381 (:fixnum-vector 1382 (unless temp-is-vreg 1383 (ensuring-node-target (target vreg) 1384 (! box-fixnum target temp)))) 1385 (:simple-string 1386 (ensuring-node-target (target vreg) 1387 (! u32->char target temp))) 1388 (t 1389 (unless temp-is-vreg 1390 (ensuring-node-target (target vreg) 1391 (ppc2-box-u32 seg target temp)))))))) 1392 (is-8-bit 1393 (with-imm-target () (temp :u8) 1394 (if (and (eql vreg-class hard-reg-class-gpr) 1395 (or 1396 (and is-signed 1397 (or (eql vreg-mode hard-reg-class-gpr-mode-s8) 1398 (eql vreg-mode hard-reg-class-gpr-mode-s16) 1399 (eql vreg-mode hard-reg-class-gpr-mode-s32) 1400 (eql vreg-mode hard-reg-class-gpr-mode-s64))) 1401 (and (not is-signed) 1402 (or (eql vreg-mode hard-reg-class-gpr-mode-u8) 1403 (eql vreg-mode hard-reg-class-gpr-mode-s16) 1404 (eql vreg-mode hard-reg-class-gpr-mode-u16) 1405 (eql vreg-mode hard-reg-class-gpr-mode-s32) 1406 (eql vreg-mode hard-reg-class-gpr-mode-u32) 1407 (eql vreg-mode hard-reg-class-gpr-mode-s64) 1408 (eql vreg-mode hard-reg-class-gpr-mode-u64))))) 1409 (setq temp vreg temp-is-vreg t) 1410 (if is-signed 1411 (set-regspec-mode temp hard-reg-class-gpr-mode-s8))) 1412 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-8-bit-constant-index arch))) 1413 (if is-signed 1414 (! misc-ref-c-s8 temp src index-known-fixnum) 1415 (! misc-ref-c-u8 temp src index-known-fixnum)) 1416 (with-imm-target () idx-reg 1417 (if index-known-fixnum 1418 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) 1419 (! scale-8bit-misc-index idx-reg unscaled-idx)) 1420 (if is-signed 1421 (! misc-ref-s8 temp src idx-reg) 1422 (! misc-ref-u8 temp src idx-reg)))) 1423 (ecase type-keyword 1424 (:unsigned-8-bit-vector 1425 (unless temp-is-vreg 1426 (ensuring-node-target (target vreg) 1427 (! box-fixnum target temp)))) 1428 (:signed-8-bit-vector 1429 (unless temp-is-vreg 1430 (ensuring-node-target (target vreg) 1431 (! box-fixnum target temp)))) 1432 (:simple-string 1433 (ensuring-node-target (target vreg) 1434 (! u32->char target temp)))))) 1435 (is-16-bit 1436 (ensuring-node-target (target vreg) 1437 (with-imm-target () temp 1438 (if (and index-known-fixnum 1439 (<= index-known-fixnum (arch::target-max-16-bit-constant-index arch))) 1440 (if is-signed 1441 (! misc-ref-c-s16 temp src index-known-fixnum) 1442 (! misc-ref-c-u16 temp src index-known-fixnum)) 1443 (with-imm-target () idx-reg 1444 (if index-known-fixnum 1445 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) 1446 (! scale-16bit-misc-index idx-reg unscaled-idx)) 1447 (if is-signed 1448 (! misc-ref-s16 temp src idx-reg) 1449 (! misc-ref-u16 temp src idx-reg)))) 1450 (! box-fixnum target temp)))) 1451 (is-64-bit 1452 (with-fp-target () (fp-val :double-float) 1453 (with-imm-target () (temp :u64) 1454 (if (and (eql vreg-class hard-reg-class-fpr) 1455 (eql vreg-mode hard-reg-class-fpr-mode-double)) 1456 (setq fp-val vreg) 1457 (if (eql vreg-class hard-reg-class-gpr) 1458 (if (or (and is-signed 1459 (eql vreg-mode hard-reg-class-gpr-mode-s64)) 1460 (and (not is-signed) 1461 (eql vreg-mode hard-reg-class-gpr-mode-u64))) 1462 (setf temp vreg temp-is-vreg t) 1463 (if is-signed 1464 (set-regspec-mode temp hard-reg-class-gpr-mode-s64))))) 1465 (case type-keyword 1466 (:double-float-vector 1467 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) 1468 (! misc-ref-c-double-float fp-val src index-known-fixnum) 1469 (with-imm-target () idx-reg 1470 (if index-known-fixnum 1471 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))) 1472 (! scale-64bit-misc-index idx-reg unscaled-idx)) 1473 (! misc-ref-double-float fp-val src idx-reg))) 1474 (if (eq vreg-class hard-reg-class-fpr) 1475 (<- fp-val) 1476 (ensuring-node-target (target vreg) 1477 (! double->heap seg target fp-val)))) 1478 ((:signed-64-bit-vector :fixnum-vector) 1479 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) 1480 (! misc-ref-c-s64 temp src index-known-fixnum) 1481 (with-imm-target () idx-reg 1482 (if index-known-fixnum 1483 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))) 1484 (! scale-64bit-misc-index idx-reg unscaled-idx)) 1485 (! misc-ref-s64 temp src idx-reg))) 1486 (if (eq type-keyword :fixnum-vector) 1487 (ensuring-node-target (target vreg) 1488 (! box-fixnum target temp)) 1489 (unless temp-is-vreg 1490 (ensuring-node-target (target vreg) 1491 (! s64->integer target temp))))) 1492 (t 1493 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) 1494 (! misc-ref-c-u64 temp src index-known-fixnum) 1495 (with-imm-target () idx-reg 1496 (if index-known-fixnum 1497 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))) 1498 (! scale-64bit-misc-index idx-reg unscaled-idx)) 1499 (! misc-ref-u64 src idx-reg))) 1500 (unless temp-is-vreg 1501 (ensuring-node-target (target vreg) 1502 (! u64->integer target temp)))))))) 1503 (t 1504 (unless is-1-bit 1505 (nx-error "~& unsupported vector type: ~s" 1506 type-keyword)) 1507 (ensuring-node-target (target vreg) 1508 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch))) 1509 (! misc-ref-c-bit-fixnum target src index-known-fixnum) 1510 (with-imm-temps 1511 () (word-index bitnum dest) 1512 (if index-known-fixnum 1513 (progn 1514 (ppc2-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -5))) 1515 (ppc2-lri seg bitnum (logand index-known-fixnum #x1f))) 1516 (! scale-1bit-misc-index word-index bitnum unscaled-idx)) 1517 (! misc-ref-u32 dest src word-index) 1518 (! extract-variable-bit-fixnum target dest bitnum)))))))) 1519 (^))) 1520 1521 1306 1522 1307 1523 ;;; safe = T means assume "vector" is miscobj, do bounds check. … … 1311 1527 ;;; This mostly knows how to reference the elements of an immediate miscobj. 1312 1528 (defun ppc2-vref (seg vreg xfer type-keyword vector index safe) 1313 (let* ((arch (backend-target-arch *target-backend*))1314 (is-node (member type-keyword (arch::target-gvector-types arch)))1315 (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch)))1316 1317 (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch)))1318 (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch)))1319 (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch)))1320 (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))))1321 1322 (if is-node1323 (ppc2-misc-node-ref seg vreg xfer vector index safe)1324 (with-ppc-local-vinsn-macros (seg vreg xfer)1325 (if (null vreg)1326 (progn1327 (ppc2-form seg nil nil vector)1328 (ppc2-form seg nil xfer index))1329 (let* ((vreg-class (hard-regspec-class vreg))1330 (vreg-mode1331 (if (= vreg-class hard-reg-class-gpr)1332 (get-regspec-mode vreg)1333 hard-reg-class-gpr-mode-invalid)))1334 (declare (fixnum vreg-class vreg-mode))1335 (if (and (= vreg-class hard-reg-class-fpr)1336 (eq type-keyword :double-float-vector))1337 (ppc2-df-vref seg vreg xfer vector index safe)1338 (if (and (= vreg-class hard-reg-class-fpr)1339 (eq type-keyword :single-float-vector))1340 (ppc2-sf-vref seg vreg xfer vector index safe)1341 (if (target-arch-case1342 (:ppc321343 (and (= vreg-mode hard-reg-class-gpr-mode-u32)1344 is-32-bit1345 (not (or (eq type-keyword :signed-32-bit-vector)1346 (eq type-keyword :fixnum-vector)1347 (eq type-keyword :simple-string)1348 (eq type-keyword :single-float-vector)))))1349 (:ppc641350 (and (= vreg-mode hard-reg-class-gpr-mode-u64)1351 is-64-bit1352 (not (or (eq type-keyword :signed-64-bit-vector)1353 (eq type-keyword :fixnum-vector)1354 (eq type-keyword :double-float-vector))))))1355 1356 (ppc2-natural-vref seg vreg xfer vector index safe)1357 (let* ((index-known-fixnum (acode-fixnum-form-p index))1358 (unscaled-idx nil)1359 (src nil))1360 (if (or safe (not index-known-fixnum))1361 (multiple-value-setq (src unscaled-idx)1362 (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z))1363 (setq src (ppc2-one-untargeted-reg-form seg vector ppc::arg_z)))1364 (when safe1365 (if (typep safe 'fixnum)1366 (! trap-unless-typecode= src safe))1367 (unless index-known-fixnum1368 (! trap-unless-fixnum unscaled-idx))1369 (! check-misc-bound unscaled-idx src))1370 (if is-32-bit1371 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))1372 (cond ((eq type-keyword :single-float-vector)1373 (! misc-ref-c-single-float 0 src index-known-fixnum)1374 (ensuring-node-target1375 (target vreg)1376 (! single->node target 0)))1377 (t1378 (ensuring-node-target1379 (target vreg)1380 1381 (with-imm-temps () (temp)1382 (! misc-ref-c-u32 temp src index-known-fixnum)1383 (case type-keyword1384 (:signed-32-bit-vector1385 (ppc2-box-s32 seg target temp))1386 (:fixnum-vector1387 (! box-fixnum target temp))1388 (:simple-string1389 (! u32->char target temp))1390 (t1391 (ppc2-box-u32 seg target temp)))))))1392 (with-imm-temps1393 () (idx-reg)1394 (if index-known-fixnum1395 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))1396 (! scale-32bit-misc-index idx-reg unscaled-idx))1397 (cond ((eq type-keyword :single-float-vector)1398 (! misc-ref-single-float 0 src idx-reg)1399 (ensuring-node-target1400 (target vreg)1401 (! single->node target 0)))1402 (t1403 (ensuring-node-target1404 (target vreg)1405 (with-imm-temps1406 (idx-reg) (temp)1407 (! misc-ref-u32 temp src idx-reg)1408 (case type-keyword1409 (:signed-32-bit-vector1410 (ppc2-box-s32 seg target temp))1411 (:fixnum-vector1412 (! box-fixnum target temp))1413 (:simple-string1414 (! u32->char target temp))1415 (t1416 (ppc2-box-u32 seg target temp)))))))))1417 (if is-8-bit1418 (with-imm-temps1419 () (temp)1420 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-8-bit-constant-index arch)))1421 (! misc-ref-c-u8 temp src index-known-fixnum)1422 (with-imm-temps1423 () (idx-reg)1424 (if index-known-fixnum1425 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))1426 (! scale-8bit-misc-index idx-reg unscaled-idx))1427 (! misc-ref-u8 temp src idx-reg)))1428 (if (eq type-keyword :unsigned-8-bit-vector)1429 (if (= vreg-mode hard-reg-class-gpr-mode-u8)1430 (ppc2-copy-register seg vreg temp)1431 (ensuring-node-target (target vreg)1432 (! u8->fixnum target temp)))1433 (ensuring-node-target (target vreg)1434 (if (eq type-keyword :signed-8-bit-vector)1435 (! s8->fixnum target temp)1436 (! u32->char target temp)))))1437 (if is-16-bit1438 (ensuring-node-target (target vreg)1439 1440 (with-imm-temps1441 () (temp)1442 (if (and index-known-fixnum1443 (<= index-known-fixnum (arch::target-max-16-bit-constant-index arch)))1444 (! misc-ref-c-u16 temp src index-known-fixnum)1445 (with-imm-temps1446 () (idx-reg)1447 (if index-known-fixnum1448 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))1449 (! scale-16bit-misc-index idx-reg unscaled-idx))1450 (! misc-ref-u16 temp src idx-reg)))1451 (if (eq type-keyword :unsigned-16-bit-vector)1452 (! u16->fixnum target temp)1453 (! s16->fixnum target temp))))1454 ;; Down to the dregs.1455 (if is-64-bit1456 (ensuring-node-target (target vreg)1457 (ecase type-keyword1458 (:double-float-vector1459 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))1460 (! misc-ref-c-double-float 0 src index-known-fixnum)1461 (with-imm-temps1462 () (idx-reg)1463 (if index-known-fixnum1464 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3)))1465 (! scale-64bit-misc-index idx-reg unscaled-idx))1466 (! misc-ref-double-float 0 src idx-reg)))1467 (! double->heap target 0))1468 (:unsigned-64-bit-vector1469 (with-imm-target () (u64-reg :u64)1470 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))1471 (! misc-ref-c-u64 u64-reg src index-known-fixnum)1472 (with-imm-temps1473 (u64-reg) (idx-reg)1474 (if index-known-fixnum1475 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3)))1476 (! scale-64bit-misc-index idx-reg unscaled-idx))1477 (! misc-ref-u64 u64-reg src idx-reg)))1478 (! u64->integer target u64-reg)))1479 ((:signed-64-bit-vector :fixnum-vector)1480 (with-imm-target () (s64-reg :s64)1481 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))1482 (! misc-ref-c-s64 s64-reg src index-known-fixnum)1483 (with-imm-temps1484 () (idx-reg)1485 (if index-known-fixnum1486 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3)))1487 (! scale-64bit-misc-index idx-reg unscaled-idx))1488 (! misc-ref-s64 s64-reg src idx-reg)))1489 (if (eq type-keyword :fixnum-vector)1490 (! box-fixnum target s64-reg)1491 (! s64->integer target s64-reg))))))1492 (progn1493 (unless is-1-bit1494 (nx-error "~& unsupported vector type: ~s"1495 type-keyword))1496 (ensuring-node-target (target vreg)1497 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))1498 (! misc-ref-c-bit-fixnum target src index-known-fixnum)1499 (with-imm-temps1500 () (word-index bitnum dest)1501 (if index-known-fixnum1502 (progn1503 (ppc2-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -5)))1504 (ppc2-lri seg bitnum (logand index-known-fixnum #x1f)))1505 (! scale-1bit-misc-index word-index bitnum unscaled-idx))1506 (! misc-ref-u32 dest src word-index)1507 (! extract-variable-bit-fixnum target dest bitnum)))))))))1508 (^)))))))))))1509 1510 ;;; In this case, the target register is an fp reg and the vector is declared1511 ;;; do be a double-float vector. Avoid boxing the result!1512 (defun ppc2-df-vref (seg vreg xfer vector index safe)1513 1529 (with-ppc-local-vinsn-macros (seg vreg xfer) 1514 1530 (let* ((index-known-fixnum (acode-fixnum-form-p index)) 1515 (arch (backend-target-arch *target-backend*)) 1516 (src) 1517 (unscaled-idx)) 1531 (unscaled-idx nil) 1532 (src nil)) 1518 1533 (if (or safe (not index-known-fixnum)) 1519 1534 (multiple-value-setq (src unscaled-idx) … … 1526 1541 (! trap-unless-fixnum unscaled-idx)) 1527 1542 (! check-misc-bound unscaled-idx src)) 1528 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) 1529 (! misc-ref-c-double-float vreg src index-known-fixnum) 1530 (with-imm-temps () (idx-reg) 1531 (if index-known-fixnum 1532 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) 1533 (! scale-64bit-misc-index idx-reg unscaled-idx)) 1534 (! misc-ref-double-float vreg src idx-reg))) 1535 (^)))) 1543 (ppc2-vref1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum)))) 1544 1545 1536 1546 1537 1547 (defun ppc2-aset2 (seg target array i j new safe typename &optional dim0 dim1) … … 1611 1621 (let* ((i-known-fixnum (acode-fixnum-form-p i)) 1612 1622 (j-known-fixnum (acode-fixnum-form-p j)) 1613 (arch (backend-target-arch *target-backend*))1614 1623 (src) 1615 (need-scale t)1616 1624 (unscaled-i) 1617 1625 (unscaled-j) … … 1632 1640 (when safe 1633 1641 (when (typep safe 'fixnum) 1634 (! trap-unless-array-header src) 1635 (! check-arrayH-rank src 2) 1636 (! check-arrayH-flags src 1642 (! trap-unless-simple-array-2 1643 src 1637 1644 (dpb safe target::arrayH.flags-cell-subtag-byte 1638 (ash 1 $arh_simple_bit)))) 1645 (ash 1 $arh_simple_bit)) 1646 (nx-error-for-simple-2d-array-type typekeyword))) 1639 1647 (unless i-known-fixnum 1640 1648 (! trap-unless-fixnum unscaled-i)) 1641 1649 (unless j-known-fixnum 1642 1650 (! trap-unless-fixnum unscaled-j))) 1643 (with-imm-temps () (dim1 idx-reg) 1644 (unless constidx 1645 (if safe 1646 (! check-2d-bound dim1 unscaled-i unscaled-j src) 1647 (! 2d-dim1 dim1 src)) 1648 (! 2d-unscaled-index idx-reg src unscaled-i unscaled-j dim1)) 1649 (with-node-temps () (v) 1650 (! array-data-vector-ref v src) 1651 (let* ((bias (arch::target-misc-data-offset arch))) 1652 (multiple-value-bind (shift limit) 1653 (case typekeyword 1654 (:double-float-vector 1655 (setq bias (arch::target-misc-dfloat-offset arch)) 1656 (values 3 (arch::target-max-64-bit-constant-index arch))) 1657 ((:single-float-vector 1658 :s32-vector 1659 :u32-vector) 1660 (values 2 (arch::target-max-32-bit-constant-index arch)))) 1661 (when (and constidx (>= constidx limit)) 1662 (ppc2-absolute-natural seg idx-reg nil (+ bias 1663 (ash constidx shift))) 1664 (setq constidx nil need-scale nil)))) 1665 (case typekeyword 1666 (:double-float-vector 1667 (if constidx 1668 (! misc-ref-c-double-float vreg v constidx) 1669 (progn 1670 (when need-scale (! scale-64bit-misc-index idx-reg idx-reg)) 1671 (! misc-ref-double-float vreg v idx-reg)))) 1672 (:single-float-vector 1673 (if constidx 1674 (! misc-ref-c-single-float vreg v constidx) 1675 (progn 1676 (when need-scale (! scale-32bit-misc-index idx-reg idx-reg)) 1677 (! misc-ref-single-float vreg v idx-reg))))))) 1678 (^)))) 1679 1680 (defun ppc2-sf-vref (seg vreg xfer vector index safe) 1681 (with-ppc-local-vinsn-macros (seg vreg xfer) 1682 (let* ((index-known-fixnum (acode-fixnum-form-p index)) 1683 (arch (backend-target-arch *target-backend*)) 1684 (src) 1685 (unscaled-idx)) 1686 (if (or safe (not index-known-fixnum)) 1687 (multiple-value-setq (src unscaled-idx) 1688 (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z)) 1689 (setq src (ppc2-one-untargeted-reg-form seg vector ppc::arg_z))) 1690 (when safe 1691 (if (typep safe 'fixnum) 1692 (! trap-unless-typecode= src safe)) 1693 (unless index-known-fixnum 1694 (! trap-unless-fixnum unscaled-idx)) 1695 (! check-misc-bound unscaled-idx src)) 1696 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) 1697 (! misc-ref-c-single-float vreg src index-known-fixnum) 1698 (with-imm-temps () (idx-reg) 1699 (if index-known-fixnum 1700 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) 1701 (! scale-32bit-misc-index idx-reg unscaled-idx)) 1702 (! misc-ref-single-float vreg src idx-reg))) 1703 (^)))) 1704 1705 ;;; Vreg is of mode u32/u64; so's the vector element. Don't box result. 1706 (defun ppc2-natural-vref (seg vreg xfer vector index safe) 1707 (with-ppc-local-vinsn-macros (seg vreg xfer) 1708 (let* ((index-known-fixnum (acode-fixnum-form-p index)) 1709 (arch (backend-target-arch *target-backend*)) 1710 (src) 1711 (unscaled-idx)) 1712 (if (or safe (not index-known-fixnum)) 1713 (multiple-value-setq (src unscaled-idx) 1714 (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z)) 1715 (setq src (ppc2-one-untargeted-reg-form seg vector ppc::arg_z))) 1716 (when safe 1717 (if (typep safe 'fixnum) 1718 (! trap-unless-typecode= src safe)) 1719 (unless index-known-fixnum 1720 (! trap-unless-fixnum unscaled-idx)) 1721 (! check-misc-bound unscaled-idx src)) 1722 (target-arch-case 1723 (:ppc32 1724 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) 1725 (! misc-ref-c-u32 vreg src index-known-fixnum) 1726 (with-imm-temps () (idx-reg) 1727 (if index-known-fixnum 1728 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) 1729 (! scale-32bit-misc-index idx-reg unscaled-idx)) 1730 (! misc-ref-u32 vreg src idx-reg)))) 1731 (:ppc64 1732 (if (and index-known-fixnum (<= index-known-fixnum ppc64::max-64-bit-constant-index)) 1733 (! misc-ref-c-u64 vreg src index-known-fixnum) 1734 (with-imm-temps () (idx-reg) 1735 (if index-known-fixnum 1736 (ppc2-absolute-natural seg idx-reg nil (+ ppc64::misc-data-offset (ash index-known-fixnum 3))) 1737 (! scale-64bit-misc-index idx-reg unscaled-idx)) 1738 (! misc-ref-u64 vreg src idx-reg))))) 1739 (^)))) 1651 (with-node-target (src) idx-reg 1652 (with-imm-target () dim1 1653 (unless constidx 1654 (if safe 1655 (! check-2d-bound dim1 unscaled-i unscaled-j src) 1656 (! 2d-dim1 dim1 src)) 1657 (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j)) 1658 (with-node-target (idx-reg) v 1659 (! array-data-vector-ref v src) 1660 (ppc2-vref1 seg vreg xfer typekeyword v idx-reg constidx))))))) 1661 1740 1662 1741 1663 (defun ppc2-natural-vset (seg vreg xfer vector index value safe) … … 4225 4147 (^)))) 4226 4148 4227 ;;; If safe, ensure that index is a fixnum (if non-constant) 4228 ;;; and check vector bound. 4229 ;;; If we're going to have to evaluate the index into a register (to do 4230 ;;; the bounds check), but know that the index could be a constant 16-bit 4231 ;;; displacement, this'll look pretty silly .. 4232 (defun ppc2-misc-node-ref (seg vreg xfer miscobj index safe) 4233 (with-ppc-local-vinsn-macros (seg vreg xfer) 4234 (let* ((index-known-fixnum (acode-fixnum-form-p index)) 4235 (arch (backend-target-arch *target-backend*)) 4236 (unscaled-idx nil) 4237 (src nil)) 4238 (if (or safe (not index-known-fixnum)) 4239 (multiple-value-setq (src unscaled-idx) 4240 (ppc2-two-untargeted-reg-forms seg miscobj ppc::arg_y index ppc::arg_z)) 4241 (setq src (ppc2-one-untargeted-reg-form seg miscobj ppc::arg_z))) 4242 (when safe 4243 (if (typep safe 'fixnum) 4244 (! trap-unless-typecode= src safe)) 4245 (unless index-known-fixnum 4246 (! trap-unless-fixnum unscaled-idx)) 4247 (! check-misc-bound unscaled-idx src)) 4248 (when vreg 4249 (ensuring-node-target (target vreg) 4250 (if (and index-known-fixnum (<= index-known-fixnum 4251 (target-word-size-case 4252 (32 (arch::target-max-32-bit-constant-index arch)) 4253 (64 (arch::target-max-64-bit-constant-index arch))))) 4254 (! misc-ref-c-node target src index-known-fixnum) 4255 (let* ((idx-reg ppc::imm0)) 4256 (if index-known-fixnum 4257 (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum *ppc2-target-node-shift*))) 4258 (! scale-node-misc-index idx-reg unscaled-idx)) 4259 (! misc-ref-node target src idx-reg))))) 4260 (^)))) 4149 4261 4150 4262 4151 (defun ppc2-misc-node-set (seg vreg xfer miscobj index value safe) … … 5415 5304 5416 5305 (defppc2 ppc2-%svref %svref (seg vreg xfer vector index) 5417 (ppc2- misc-node-ref seg vreg xfer vector index nil))5306 (ppc2-vref seg vreg xfer :simple-vector vector index nil)) 5418 5307 5419 5308 (defppc2 ppc2-svref svref (seg vreg xfer vector index) 5420 (ppc2- misc-node-ref seg vreg xfervector index (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :simple-vector))))5309 (ppc2-vref seg vreg xfer :simple-vector vector index (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :simple-vector)))) 5421 5310 5422 5311 ;;; It'd be nice if this didn't box the result. Worse things happen ... … … 5621 5510 5622 5511 (defppc2 ppc2-struct-ref struct-ref (seg vreg xfer struct offset) 5623 (ppc2- misc-node-ref seg vreg xferstruct offset (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :struct))))5512 (ppc2-vref seg vreg xfer :struct struct offset (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :struct)))) 5624 5513 5625 5514 (defppc2 ppc2-struct-set struct-set (seg vreg xfer struct offset value) … … 7462 7351 (ppc2-use-operator op seg vreg xfer n0 n1 *nx-t*))) 7463 7352 7464 (eval-when (:compile-toplevel) 7465 (warn "fix ppc2-%aref2")) 7353 7466 7354 7467 7355 (defppc2 ppc2-%aref2 simple-typed-aref2 (seg vreg xfer typename arr i j &optional dim0 dim1) 7468 (declare (ignore typename dim0 dim1)) 7469 (ppc2-three-targeted-reg-forms seg arr ($ ppc::arg_x) i ($ ppc::arg_y) j ($ ppc::arg_z)) 7470 (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2))) 7356 (if (null vreg) 7357 (progn 7358 (ppc2-form seg nil nil arr) 7359 (ppc2-form seg nil nil i) 7360 (ppc2-form seg nil xfer j)) 7361 (let* ((type-keyword (ppc2-immediate-operand typename)) 7362 (fixtype (nx-lookup-target-uvector-subtag type-keyword )) 7363 (safe (unless *ppc2-reckless* fixtype)) 7364 (dim0 (acode-fixnum-form-p dim0)) 7365 (dim1 (acode-fixnum-form-p dim1))) 7366 (ppc2-aref2 seg vreg xfer arr i j safe type-keyword dim0 dim1)))) 7471 7367 7472 7368 (defppc2 ppc2-general-aref2 general-aref2 (seg vreg xfer arr i j) 7473 (ppc2-three-targeted-reg-forms seg arr ($ ppc::arg_x) i ($ ppc::arg_y) j ($ ppc::arg_z)) 7474 (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2))) 7369 (let* ((atype0 (acode-form-type arr t)) 7370 (ctype (if atype0 (specifier-type atype0))) 7371 (atype (if (array-ctype-p ctype) ctype)) 7372 (keyword (and atype 7373 (= 2 (length (array-ctype-dimensions atype))) 7374 (not (array-ctype-complexp atype)) 7375 (funcall 7376 (arch::target-array-type-name-from-ctype-function 7377 (backend-target-arch *target-backend*)) 7378 atype)))) 7379 (cond (keyword 7380 (let* ((dims (array-ctype-dimensions atype)) 7381 (dim0 (car dims)) 7382 (dim1 (cadr dims))) 7383 (ppc2-aref2 seg 7384 vreg 7385 xfer 7386 arr 7387 i 7388 j 7389 (if *ppc2-reckless* 7390 *nx-nil* 7391 (nx-lookup-target-uvector-subtag keyword )) 7392 keyword ;(make-acode (%nx1-operator immediate) ) 7393 (if (typep dim0 'fixnum) dim0) (if (typep dim1 'fixnum) dim1)))) 7394 (t 7395 (ppc2-three-targeted-reg-forms seg 7396 arr ($ ppc::arg_x) 7397 i ($ ppc::arg_y) 7398 j ($ ppc::arg_z)) 7399 (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2))))) ) 7475 7400 7476 7401 (defppc2 ppc2-%aset2 aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1)
Note:
See TracChangeset
for help on using the changeset viewer.
