Changeset 13751


Ignore:
Timestamp:
May 30, 2010, 2:36:13 PM (10 years ago)
Author:
gb
Message:

Some stuff compiles; still a lot of work to do.
Try to reduce stack traffic in some simple cases by tracking which
registers contain copies of which stack locations. Should try to
exploit this further (and port to other platforms when it's working
reliably.)
Todo: well, a very long list of things, but one that seems obvious
is to try to use predication (at the vinsn level) to reduce the number
of conditional branches.

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

Legend:

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

    r13741 r13751  
    277277     ())
    278278   (define-arm-instruction ands (:rd :rn :shifter)
    279      #x00100000
     279     #x01000000
    280280     ((#x03000000 . #x0ff00000)
    281281      (#x01000000 . #x0ff00010)
     
    511511   (define-arm-instruction stm (:rnw :reglist)
    512512     #x08800000
    513      #x0ff00000
     513     #x0fd00000
    514514     ())
    515515   (define-arm-instruction stmia (:rnw :reglist)
    516516     #x08800000
    517      #x0ff00000
     517     #x0fd00000
    518518     ())
    519519   (define-arm-instruction stmea (:rnw :reglist)
    520520     #x08800000
    521      #x0ff00000
     521     #x0fd00000
    522522     ())
    523523   (define-arm-instruction ldmia (:rnw :reglist)
    524524     #x08900000
    525      #x0ff00000
     525     #x0fd00000
    526526     ())
    527527   (define-arm-instruction ldm (:rnw :reglist)
    528528     #x08900000
    529      #x0ff00000
     529     #x0fd00000
    530530     ())
    531531   (define-arm-instruction ldmfd (:rnw :reglist)
    532532     #x08900000
    533      #x0ff00000
     533     #x0fd00000
    534534     ())
    535535   (define-arm-instruction stmdb (:rnw :reglist)
    536536     #x09000000
    537      #x0ff00000
     537     #x0fd00000
    538538     ())
    539539   (define-arm-instruction stmfb (:rnw :reglist)
    540540     #x09000000
    541      #x0ff00000
     541     #x0fd00000
    542542     ())
    543543   (define-arm-instruction stmfd (:rnw :reglist)
     
    547547   (define-arm-instruction ldmdb (:rnw :reglist)
    548548     #x09100000
    549      #x0ff00000
     549     #x0fd00000
    550550     ())
    551551   (define-arm-instruction ldmea (:rnw :reglist)
    552552     #x09100000
    553      #x0ff00000
     553     #x0fd00000
    554554     ())
    555555
    556556   (define-arm-instruction b (:b)
    557557     #x0a000000
    558      #x0e000000
     558     #x0f000000
    559559     ())
    560560   (define-arm-instruction bl (:b)
    561561     #x0b000000
    562      #x0e000000
     562     #x0f000000
    563563     ())
    564564   (define-arm-instruction bx (:rm)
     
    916916  (ecase mode           
    917917    ((:@ :+@ :+@! :@!)
    918      ;; Preindexed, no writeback unless :+@! , add register operands.
     918     ;; Preindexed, no writeback unless :[+]@! , add register operands.
    919919     (unless constant-index
    920920       (setq opcode (logior opcode (ash 1 23))))
    921      (when (eq mode :+@!)
     921     (when (or (eq mode :+@!)
     922               (eq mode :@!))
    922923       (setq opcode (logior opcode (ash 1 21))))
    923924     (setq opcode (logior opcode (ash 1 24))))
     
    10381039
    10391040(defun parse-subprim-operand (form instruction)
    1040   (let* ((address (arm-subprimitive-address form)))
     1041  (let* ((address (or (arm-subprimitive-address form)
     1042                      (when (arm-subprimitive-name form) form))))
    10411043    (unless address
    10421044      (error "Unknown ARM subprimitive : ~s" form))
     
    12451247
    12461248(defun arm-finalize (primary constant-pool)
     1249  (do-lap-labels (lab)
     1250    (loop
     1251      (when (dolist (ref (lap-label-refs lab) t)
     1252              (when (eq lab (lap-instruction-succ (car ref)))
     1253                (ccl::remove-dll-node (car ref))
     1254                (setf (lap-label-refs lab)
     1255                      (delete ref (lap-label-refs lab)))
     1256                (return)))
     1257        (return))))
    12471258  (dolist (lab *called-subprim-jmp-labels*)
    12481259    (unless (lap-label-emitted-p lab)
     
    13631374    :label
    13641375    :subprim
    1365     :application
    1366     :local-label
     1376    :data-label
    13671377    :dd
    13681378    :dm
     
    14041414  (let* ((p (position form vinsn-params)))
    14051415    (cond (p
    1406            (add-avi-operand avi encoded-type p)
     1416           (add-avi-operand avi encoded-type (list p))
    14071417           nil)
    14081418          (t           
     
    14121422  (let* ((p (position form vinsn-params)))
    14131423    (cond (p
    1414            (add-avi-operand avi encoded-type p)
     1424           (add-avi-operand avi encoded-type (list p))
    14151425           nil)
    14161426          (t           
     
    14201430  (let* ((p (position form vinsn-params)))
    14211431    (cond (p
    1422            (add-avi-operand avi encoded-type p)
     1432           (add-avi-operand avi encoded-type (list p))
    14231433           nil)
    14241434          (t
     
    14451455  (let* ((p (position form vinsn-params)))
    14461456    (cond (p
    1447            (add-avi-operand avi encoded-type p)
     1457           (add-avi-operand avi encoded-type (list p))
    14481458           nil)
    1449           ((typep form 'keyword)
    1450            (add-avi-operand avi encoded-type form)
     1459          ((and (typep form 'keyword)
     1460                (eql encoded-type (encode-vinsn-field-type :mem12-offset)))
     1461           (add-avi-operand avi (encode-vinsn-field-type :data-label) form)
    14511462           nil)
    14521463          ((and (consp form) (eq (car form) :apply))
     
    14771488             (let* ((constant (encode-arm-immediate val)))
    14781489               (if constant
    1479                  (set-avi-opcode-field avi (byte 1 25) 1)
     1490                 (progn
     1491                   (set-avi-opcode-field avi (byte 1 25) 1)
     1492                   (set-avi-opcode-field avi (byte 12 0) constant))
    14801493                 (let* ((op (ldb (byte 4 21) (avi-opcode avi)))
    14811494                        (newop nil))
     
    15041517           (t
    15051518            (unless (eq (car count) :$)
    1506               (error "Invalid shift count: ~s" count)
    1507               (destructuring-bind (countval) (cdr count)
    1508                 (vinsn-arg-or-constant avi countval vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7)))))))))))
     1519              (error "Invalid shift count: ~s" count))
     1520            (destructuring-bind (countval) (cdr count)
     1521              (vinsn-arg-or-constant avi countval vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7))))))))))
    15091522
    15101523(defun vinsn-parse-m12-operand (avi value vinsn-params)
     1524
    15111525  (when (typep value 'keyword)
    15121526    (setq value `(:@ arm::pc (:$ ,value))))
     
    15511565    (let* ((p (position r vinsn-params)))
    15521566      (if p
    1553         (add-avi-operand avi (encode-vinsn-field-type :reglist-bit) p)
     1567        (add-avi-operand avi (encode-vinsn-field-type :reglist-bit) (list p))
    15541568        (let* ((bit (need-arm-gpr r)))
    15551569          (setf (avi-opcode avi)
     
    15841598(defun vinsn-parse-b-operand (avi value vinsn-params)
    15851599  ;; Pretty much has to be a param or a local label what else would we b to ?
    1586   (let* ((p (position value vinsn-params)))
     1600  (let* ((p (position value vinsn-params))
     1601         (addr nil))
    15871602    (cond (p
    1588            (add-avi-operand avi (encode-vinsn-field-type :label) p))
     1603           (add-avi-operand avi (encode-vinsn-field-type :label) (list p)))
    15891604          ((typep value 'keyword)
    1590            (add-avi-operand avi (encode-vinsn-field-type :local-label) value))
    1591           ((arm-subprimitive-address value)
    1592            (add-avi-operand avi (encode-vinsn-field-type :subprim) value))
     1605           (add-avi-operand avi (encode-vinsn-field-type :label) value))
     1606          ((setq addr (arm-subprimitive-address value))
     1607           (add-avi-operand avi (encode-vinsn-field-type :label) addr))
     1608          ((arm-subprimitive-name value)
     1609           (add-avi-operand avi (encode-vinsn-field-type :label) addr))
    15931610          (t
    15941611           (error "Unknown branch target: ~s." value)))))
     
    15991616  (let* ((p (position value vinsn-params)))
    16001617    (if p
    1601       (add-avi-operand avi (encode-vinsn-field-type :subprim) p)
     1618      (add-avi-operand avi (encode-vinsn-field-type :subprim) (list p))
    16021619      (let* ((addr (or (arm-subprimitive-address value)
    16031620                   (and (typep value 'integer)
     
    16061623                        (not (logtest #x7f value))))))
    16071624        (unless addr
    1608           (error "Unknown ARM subprimitive address: ~s." addr))
     1625          (error "Unknown ARM subprimitive address: ~s." value))
    16091626        (set-avi-opcode-field avi (byte 12 0) (encode-arm-immediate addr))))))
    16101627
     
    17001717                                                (encode-vinsn-field-type :cond)
    17011718                                                (encode-vinsn-field-type :negated-cond))
    1702                                           p)
     1719                                          (list p))
    17031720                         (setq cond nil)))
    17041721                     (let* ((c (need-arm-condition-name cond-name)))
     
    17251742
    17261743(defparameter *arm-vinsn-insert-functions*
    1727     #(vinsn-insert-rd-operand
    1728       vinsn-insert-rn-operand
    1729       vinsn-insert-shifter-operand
    1730       vinsn-insert-m12-operand
    1731       vinsn-insert-reglist-operand
    1732       vinsn-insert-rnw-operand
    1733       vinsn-insert-uuoa-operand
    1734       vinsn-insert-uuo-unary-operand
    1735       vinsn-insert-uuob-operand
    1736       vinsn-insert-rm-operand
    1737       vinsn-insert-b-operand
    1738       vinsn-insert-subprim-operand
    1739       vinsn-insert-m8-operand
    1740       vinsn-insert-dd-operand
    1741       vinsn-insert-dm-operand
    1742       vinsn-insert-sd-operand
    1743       vinsn-insert-sm-operand
    1744       vinsn-insert-dn-operand
    1745       vinsn-insert-sn-operand
    1746       vinsn-insert-rde-operand
    1747       vinsn-insert-rs-operand
    1748       ))
     1744  #(vinsn-insert-cond-operand
     1745    vinsn-insert-negated-cond-operand
     1746    vinsn-insert-rn-operand
     1747    vinsn-insert-rd-operand
     1748    vinsn-insert-rm-operand
     1749    vinsn-insert-rs-operand
     1750    vinsn-insert-alu-constant-operand
     1751    vinsn-insert-shift-count-operand                        ;shift type is always explicit
     1752    vinsn-insert-mem12-offset-operand
     1753    vinsn-insert-mem8-offset-operand
     1754    vinsn-insert-reglist-bit-operand
     1755    vinsn-insert-uuoA-operand
     1756    vinsn-insert-uuo-unary-operand
     1757    vinsn-insert-uuoB-operand
     1758    vinsn-insert-label-operand
     1759    vinsn-insert-subprim-operand
     1760    vinsn-insert-data-label-operand
     1761    vinsn-insert-dd-operand
     1762    vinsn-insert-dm-operand
     1763    vinsn-insert-sd-operand
     1764    vinsn-insert-sm-operand
     1765    vinsn-insert-dn-operand
     1766    vinsn-insert-sn-operand
     1767    ))
     1768
     1769(defun vinsn-insert-cond-operand (instruction value)
     1770  (set-field-value instruction (byte 4 28) value))
     1771
     1772(defun vinsn-insert-negated-cond-operand (instruction value)
     1773  (set-field-value instruction (byte 4 28) (logxor value 1)))
     1774
     1775(defun vinsn-insert-rn-operand (instruction value)
     1776  (set-field-value instruction (byte 4 16) value))
     1777
     1778(defun vinsn-insert-rd-operand (instruction value)
     1779  (set-field-value instruction (byte 4 12) value))
     1780
     1781(defun vinsn-insert-rm-operand (instruction value)
     1782  (set-field-value instruction (byte 4 0) value))
     1783
     1784(defun vinsn-insert-rs-operand (instruction value)
     1785  (set-field-value instruction (byte 4 8) value))
     1786
     1787(defun vinsn-insert-alu-constant-operand (instruction value)
     1788  (insert-shifter-constant value instruction))
     1789
     1790(defun vinsn-insert-shift-count-operand (instruction value)
     1791  (set-field-value instruction (byte 5 7) value))
     1792
     1793(defun vinsn-insert-mem12-offset-operand (instruction value)
     1794  (if (typep value 'lap-label)
     1795    (lap-note-label-reference value instruction :mem12)
     1796    (progn
     1797      (if (< value 0)
     1798        (setq value (- value))
     1799        (set-field-value instruction (byte 1 23) 1))
     1800      (set-field-value instruction (byte 12 0) value))))
     1801
     1802(defun vinsn-insert-mem8-offset-operand (instruction value)
     1803  (if (< value 0)
     1804    (setq value (- value))
     1805    (set-field-value instruction (byte 1 23) 1))
     1806  (set-field-value instruction (byte 4 8) (ldb (byte 4 4) value))
     1807  (set-field-value instruction (byte 4 0) (ldb (byte 4 0) value)))
     1808
     1809(defun vinsn-insert-reglist-bit-operand (instruction value)
     1810  (set-field-value instruction (byte 1 value) 1))
     1811
     1812(defun vinsn-insert-uuoA-operand (instruction value)
     1813  (set-field-value instruction (byte 4 8) value))
     1814
     1815(defun vinsn-insert-uuo-unary-operand (instruction value)
     1816  (set-field-value instruction (byte 8 12) value))
     1817
     1818(defun vinsn-insert-uuoB-operand (instruction value)
     1819  (set-field-value instruction (byte 4 12) value))
     1820
     1821(defun vinsn-insert-label-operand (instruction value)
     1822  (let* ((label (etypecase value
     1823                  (lap-label value)
     1824                  (ccl::vinsn-label
     1825                   (or (find-lap-label value)
     1826                       (make-lap-label value)))
     1827                  (fixnum (let* ((lab (or (find-lap-label value)
     1828                                          (make-lap-label value))))
     1829                            (pushnew lab *called-subprim-jmp-labels*)
     1830                            lab)))))
     1831    (push (cons instruction :b) (lap-label-refs label))))
     1832
     1833(defun vinsn-insert-subprim-operand (instruction value)
     1834  )
     1835
     1836(defun vinsn-insert-data-label-operand (instruction value)
     1837  )
     1838
     1839(defun vinsn-insert-dd-operand (instruction value)
     1840  (set-field-value instruction (byte 4 12) value) )
     1841
     1842(defun vinsn-insert-dm-operand (instruction value)
     1843  (set-field-value instruction (byte 4 0) value))
     1844
     1845(defun vinsn-insert-sd-operand (instruction value)
     1846  )
     1847
     1848(defun vinsn-insert-sm-operand (instruction value)
     1849  )
     1850
     1851(defun vinsn-insert-dn-operand (instruction value)
     1852  (set-field-value instruction (byte 4 16) value))
     1853
     1854(defun vinsn-insert-sn-operand (instruction value)
     1855  )
     1856   
     1857
     1858
    17491859
    17501860(provide "ARM-ASM")
  • branches/arm/compiler/ARM/arm-disassemble.lisp

    r13741 r13751  
    264264    extract-arm-dn-operand
    265265    extract-arm-sn-operand
     266    extract-arm-rd-operand                  ;rde
     267    extract-arm-rs-operand
    266268    ))
    267269
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r13741 r13751  
    12121212                                    ((object :lisp))
    12131213                                    ((tag :u8)))
    1214   (ands tag object (:$ arm::tagmask))
     1214  (and tag object (:$ arm::tagmask))
    12151215  (cmp tag (:$ arm::tag-list))
    12161216  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-list)))
     
    13281328
    13291329
    1330 ;; Sometimes we try to extract a single bit from some source register
    1331 ;; into a destination bit (typically 31, sometimes fixnum bit 0 = 29).
    1332 ;; If we copy bit 0 (whoops, I mean "bit 31") to bit 4 (aka 27) in a
    1333 ;; given register, we get a value that's either 17 (the arithmetic difference
    1334 ;; between T and NIL) or 0.
    1335 
    1336 #+later
    1337 (define-arm-vinsn lowbit->truth (((dest :lisp)
    1338                                   (bits :u32))
    1339                                  ((bits :u32))
    1340                                  ())
    1341   (rlwimi bits bits (- arm::least-significant-bit 27) 27 27) ; bits = 0000...X000X
    1342   (addi dest bits (:apply target-nil-value)))
    1343 
    1344 #+later
    1345 (define-arm-vinsn invert-lowbit (((bits :u32))
    1346                                  ((bits :u32))
    1347                                  ())
    1348   (xori bits bits 1))
    13491330
    13501331                           
    13511332
    1352 (define-arm-vinsn eq0->boolean (((dest t))
    1353                                 ((src t)))
    1354   (cmp src (:$ 0))
    1355   (mov dest (:$ arm::nil-value))
    1356   (addeq dest dest (:$ arm::t-offset)))               
    1357 
    1358 
    1359 (define-arm-vinsn ne0->boolean (((dest t))
    1360                                 ((src t)))
    1361   (cmp src (:$ 0))
    1362   (mov dest (:$ arm::nil-value))
    1363   (addne dest dest (:$ arm::t-offset)))
    1364 
    1365 (define-arm-vinsn lt0->boolean (((dest t))
    1366                                 ((src t)))
    1367   (cmp src (:$ 0))
    1368   (mov dest (:$ arm::nil-value))
    1369   (addmi dest dest (:$ arm::t-offset)))               
    1370 
    1371 
    1372 #+later
    1373 (define-arm-vinsn ge0->bit31 (((bits :u32))
    1374                               ((src (t (:ne bits)))))
    1375   (srwi bits src 31)       
    1376   (xori bits bits 1))                   ; bits = 0000...000X
    1377 
    1378 #+later
    1379 (define-arm-vinsn le0->bit31 (((bits :u32))
    1380                               ((src (t (:ne bits)))))
    1381   (neg bits src)
    1382   (orc bits bits src)
    1383   (srwi bits bits 31))                  ; bits = 0000...000X
    1384 
    1385 #+later
    1386 (define-arm-vinsn gt0->bit31 (((bits :u32))
    1387                               ((src (t (:ne bits)))))
    1388   (subi bits src 1)       
    1389   (nor bits bits src)
    1390   (srwi bits bits 31))                  ; bits = 0000...000X
    1391 
    1392 #+later
    1393 (define-arm-vinsn ne->bit31 (((bits :u32))
    1394                              ((x t)
    1395                               (y t))
    1396                              ((temp :u32)))
    1397   (subf temp x y)
    1398   (cntlzw bits temp)
    1399   (slw bits temp bits)
    1400   (srwi bits bits 31))                  ; bits = 0000...000X
    1401 
    1402 #+later
    1403 (define-arm-vinsn fulltag->bit31 (((bits :u32))
    1404                                   ((lispobj :lisp)
    1405                                    (tagval :u8const))
    1406                                   ())
    1407   (clrlwi bits lispobj (- arm::nbits-in-word arm::ntagbits))
    1408   (subi bits bits tagval)
    1409   (cntlzw bits bits)
    1410   (srwi bits bits 5))
    1411 
    1412 #+later
    1413 (define-arm-vinsn eq->bit31 (((bits :u32))
    1414                              ((x t)
    1415                               (y t)))
    1416   (subf bits x y)
    1417   (cntlzw bits bits)
    1418   (srwi bits bits 5))                   ; bits = 0000...000X
    1419 
    1420 #+later
    1421 (define-arm-vinsn eqnil->bit31 (((bits :u32))
    1422                                 ((x t)))
    1423   (subi bits x (:apply target-nil-value))
    1424   (cntlzw bits bits)
    1425   (srwi bits bits 5))
    1426 
    1427 #+later
    1428 (define-arm-vinsn ne->bit31 (((bits :u32))
    1429                              ((x t)
    1430                               (y t)))
    1431   (subf bits x y)
    1432   (cntlzw bits bits)
    1433   (srwi bits bits 5)
    1434   (xori bits bits 1))
    1435 
    1436 #+later
    1437 (define-arm-vinsn nenil->bit31 (((bits :u32))
    1438                                 ((x t)))
    1439   (subi bits x (:apply target-nil-value))
    1440   (cntlzw bits bits)
    1441   (srwi bits bits 5)
    1442   (xori bits bits 1))
    1443 
    1444 #+later
    1445 (define-arm-vinsn lt->bit31 (((bits :u32))
    1446                              ((x (t (:ne bits)))
    1447                               (y (t (:ne bits)))))
    1448 
    1449   (xor bits x y)
    1450   (srawi bits bits 31)
    1451   (or bits bits x)
    1452   (subf bits y bits)
    1453   (srwi bits bits 31))                  ; bits = 0000...000X
    1454 
    1455 #+later
    1456 (define-arm-vinsn ltu->bit31 (((bits :u32))
    1457                               ((x :u32)
    1458                                (y :u32)))
    1459   (subfc bits y x)
    1460   (subfe bits bits bits)
    1461   (neg bits bits))
    1462 
    1463 #+later
    1464 (define-arm-vinsn le->bit31 (((bits :u32))
    1465                              ((x (t (:ne bits)))
    1466                               (y (t (:ne bits)))))
    1467 
    1468   (xor bits x y)
    1469   (srawi bits bits 31)
    1470   (nor bits bits y)
    1471   (add bits bits x)
    1472   (srwi bits bits 31))                  ; bits = 0000...000X
    1473 
    1474 #+later
    1475 (define-arm-vinsn leu->bit31  (((bits :u32))
    1476                                ((x :u32)
    1477                                 (y :u32)))
    1478   (subfc bits x y)
    1479   (addze bits arm::rzero))
    1480 
    1481 #+later
    1482 (define-arm-vinsn gt->bit31 (((bits :u32))
    1483                              ((x (t (:ne bits)))
    1484                               (y (t (:ne bits)))))
    1485 
    1486   (eqv bits x y)
    1487   (srawi bits bits 31)
    1488   (and bits bits x)
    1489   (subf bits bits y)
    1490   (srwi bits bits 31))                  ; bits = 0000...000X
    1491 
    1492 #+later
    1493 (define-arm-vinsn gtu->bit31 (((bits :u32))
    1494                               ((x :u32)
    1495                                (y :u32)))
    1496   (subfc bits x y)
    1497   (subfe bits bits bits)
    1498   (neg bits bits))
    1499 
    1500 #+later
    1501 (define-arm-vinsn ge->bit31 (((bits :u32))
    1502                              ((x (t (:ne bits)))
    1503                               (y (t (:ne bits)))))
    1504   (eqv bits x y)
    1505   (srawi bits bits 31)
    1506   (andc bits bits x)
    1507   (add bits bits y)
    1508   (srwi bits bits 31))                  ; bits = 0000...000X
    1509 
    1510 #+later
    1511 (define-arm-vinsn geu->bit31 (((bits :u32))
    1512                               ((x :u32)
    1513                                (y :u32)))
    1514   (subfc bits y x)
    1515   (addze bits arm::rzero))
    1516 
    1517 
    1518 ;;; there are big-time latencies associated with MFCR on more heavily
    1519 ;;; pipelined processors; that implies that we should avoid this like
    1520 ;;; the plague.
    1521 ;;; GSO can't find anything much quicker for LT or GT, even though
    1522 ;;; MFCR takes three cycles and waits for previous instructions to complete.
    1523 ;;; Of course, using a CR field costs us something as well.
    1524 #+later
    1525 (define-arm-vinsn crbit->bit31 (((bits :u32))
    1526                                 ((crf :crf)
    1527                                  (bitnum :crbit))
    1528                                 ())
    1529   (mfcr bits)                           ; Suffer.
    1530   (rlwinm bits bits (:apply + 1  bitnum (:apply ash crf 2)) 31 31)) ; bits = 0000...000X
    1531 
    1532 
    1533 (define-arm-vinsn compare (()
     1333
     1334
     1335(define-arm-vinsn compare (((crf :crf))
    15341336                           ((arg0 t)
    15351337                            (arg1 t))
     
    15371339  (cmp arg0 arg1))
    15381340
    1539 (define-arm-vinsn compare-to-nil (()
     1341(define-arm-vinsn compare-to-nil (((crf :crf))
    15401342                                  ((arg0 t)))
    15411343  (cmp arg0 (:$ arm::nil-value)))
     
    17221524  (str reg (:@! vsp (:$ (- arm::node-size)))))
    17231525
     1526(define-arm-vinsn (vpush-xyz :push :node :vsp) (() ())
     1527  (stmdb (:! vsp) (arg_z arg_y arg_x)))
     1528
     1529(define-arm-vinsn (vpush-yz :push :node :vsp) (() ())
     1530  (stmdb (:! vsp) (arg_z arg_y)))
     1531
     1532   
     1533
    17241534(define-arm-vinsn (vpop-register :pop :node :vsp)
    17251535    (((dest :lisp))
    17261536     ())
    17271537  (ldr dest (:@+ vsp (:$ arm::node-size))))
     1538
     1539(define-arm-vinsn (pop-argument-registers :pop :node :vsp) (()
     1540                                                            ())
     1541  (cmp nargs (:$ 0))
     1542  (beq :done)
     1543  (cmp nargs (:$ (* 2 arm::fixnumshift)))
     1544  (ldrlt arg_z (:@+ vsp (:$ arm::node-size)))
     1545  (ldmiaeq (:! vsp) (arg_z arg_y))
     1546  (ldmiagt (:! vsp) (arg_z arg_y arg_x))
     1547  :done)
     1548
    17281549
    17291550
     
    18651686(define-arm-vinsn (cbranch-true :branch) (()
    18661687                                          ((label :label)
     1688                                           (crf :crf)
    18671689                                           (crbit :u8const)))
    18681690  (b (:? crbit) label))
     
    18701692(define-arm-vinsn (cbranch-false :branch) (()
    18711693                                           ((label :label)
     1694                                            (crf :crf)
    18721695                                            (crbit :u8const)))
    18731696  (b (:~ crbit) label))
    18741697
     1698(define-arm-vinsn cond->boolean (((dest :imm))
     1699                                 ((cond :u8const)))
     1700  (mov dest (:$ arm::nil-value))
     1701  (add (:? cond) dest dest (:$ arm::t-offset)))
    18751702
    18761703
     
    27342561  (subs dest x y)
    27352562  (bvc target)
    2736   (mov unboxed (:asr dest (:$ arm::fixnumshift0)))
     2563  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
    27372564  (mov header (:$ arm::subtag-bignum))
    27382565  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     
    29632790(define-arm-vinsn save-lisp-context-offset (()
    29642791                                            ((nbytes-vpushed :u16const))
    2965                                             ((imm :imm)))
     2792                                            ((imm (:u32 #.arm::imm1))))
    29662793  (add imm vsp (:$ nbytes-vpushed))
    29672794  (mov imm0 (:$ arm::lisp-frame-marker))
    29682795  (stmdb (:! sp) (imm0 imm fn lr))
    29692796  (mov fn nfn))
     2797
     2798(define-arm-vinsn save-lisp-context-variable (()
     2799                                              ()
     2800                                              ((imm (:u32 #.arm::imm1))))
     2801  (subs imm nargs (:$ (ash $numarmargregs arm::word-shift)))
     2802  (movmi imm (:$ 0))
     2803  (add imm imm vsp)
     2804  (mov imm0 (:$ arm::lisp-frame-marker))
     2805  (stmdb (:! sp) (imm0 imm fn lr))
     2806  (mov fn nfn)) 
    29702807
    29712808
     
    33643201    (ba ,spno)))
    33653202
    3366 (define-arm-subprim-jump-vinsn (restore-interrupt-level) .SPrestoreintlevel)
    33673203
    33683204(define-arm-subprim-call-vinsn (save-values) .SPsave-values)
     
    33723208(define-arm-subprim-call-vinsn (add-values) .SPadd-values)
    33733209
    3374 (define-arm-subprim-jump-vinsn (jump-known-symbol-ool) .SPjmpsym)
    3375 
    3376 (define-arm-subprim-call-vinsn (call-known-symbol-ool)  .SPjmpsym)
    33773210
    33783211(define-arm-subprim-call-vinsn (pass-multiple-values)  .SPmvpass)
     
    33883221(define-arm-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
    33893222
    3390 (define-arm-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
    3391 
    3392 (define-arm-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
    33933223
    33943224(define-arm-subprim-call-vinsn (funcall)  .SPfuncall)
     
    34003230(define-arm-subprim-jump-vinsn (tail-funcall-vsp) .SPtfuncallvsp)
    34013231
    3402 (define-arm-subprim-call-vinsn (spread-lexpr)  .SPspread-lexpr-z)
     3232(define-arm-subprim-call-vinsn (spread-lexpr)  .SPspread-lexprz)
    34033233
    34043234(define-arm-subprim-call-vinsn (spread-list)  .SPspreadargz)
    34053235
    3406 (define-arm-subprim-call-vinsn (pop-argument-registers)  .SPvpopargregs)
    34073236
    34083237(define-arm-subprim-call-vinsn (getu32) .SPgetu32)
     
    34103239(define-arm-subprim-call-vinsn (gets32) .SPgets32)
    34113240
    3412 (define-arm-subprim-call-vinsn (getxlong)  .SPgetXlong)
    34133241
    34143242(define-arm-subprim-call-vinsn (stack-cons-list)  .SPstkconslist)
     
    35113339
    35123340(define-arm-subprim-call-vinsn (mkunwind) .SPmkunwind)
    3513 (define-arm-subprim-call-vinsn (nmkunwind) .SPnmkunwind)
     3341(define-arm-subprim-call-vinsn (nmkunwind) .SPmkunwind)
    35143342
    35153343
     
    35183346(define-arm-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
    35193347
    3520 (define-arm-subprim-call-vinsn (eabi-syscall) .SPeabi-syscall)
    35213348
    35223349(define-arm-subprim-call-vinsn (misc-ref) .SPmisc-ref)
     
    35363363
    35373364
    3538 (define-arm-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
    3539 
    3540 (define-arm-subprim-call-vinsn (poweropen-ff-call) .SPpoweropen-ffcall)
    3541 
    3542 (define-arm-subprim-call-vinsn (poweropen-ff-callX) .SPpoweropen-ffcallX)
     3365
    35433366
    35443367(define-arm-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
  • branches/arm/compiler/ARM/arm2.lisp

    r13741 r13751  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;-*-Mode: LISP; Package: CCL -*-
    22;;;
    3 ;;;   Copyright (C) 2009 Clozure Associates
    4 ;;;   Copyright (C) 1994-2001 Digitool, Inc
     3;;;   Copyright (C) 2010 Clozure Associates
    54;;;   This file is part of Clozure CL. 
    65;;;
     
    6362                    (unless ,template-temp
    6463                      (warn "VINSN \"~A\" not defined" ,template-name-var))
    65                     `(%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var))))
     64                    `(arm2-update-regmap (%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))))
    6665       (macrolet ((<- (,retvreg-var)
    6766                    `(arm2-copy-register ,',segvar ,',vreg-var ,,retvreg-var))
    6867                  (@  (,labelnum-var)
    69                     `(backend-gen-label ,',segvar ,,labelnum-var))
     68                    `(progn
     69                      (arm2-invalidate-regmap)
     70                      (backend-gen-label ,',segvar ,,labelnum-var)))
    7071                  (-> (,label-var)
    7172                    `(! jump (aref *backend-labels* ,,label-var)))
     
    116117(defvar *arm2-register-restore-ea* nil)
    117118(defvar *arm2-compiler-register-save-label* nil)
    118 (defvar *arm2-valid-register-annotations* 0)
    119 (defvar *arm2-register-annotation-types* nil)
    120 (defvar *arm2-register-ea-annotations* nil)
    121119
    122120(defparameter *arm2-tail-call-aliases*
     
    163161
    164162(defvar *arm2-result-reg* arm::arg_z)
     163(defvar *arm2-gpr-locations* nil)
     164(defvar *arm2-gpr-locations-valid-mask* 0)
    165165
    166166
     
    374374           (*arm2-register-restore-count* nil)
    375375           (*arm2-compiler-register-save-label* nil)
    376            (*arm2-valid-register-annotations* 0)
    377            (*arm2-register-ea-annotations* (arm2-make-stack 16))
    378376           (*arm2-register-restore-ea* nil)
    379377           (*arm2-vstack* 0)
     
    397395           (*backend-fp-temps* arm-temp-fp-regs)
    398396           (*available-backend-fp-temps* arm-temp-fp-regs)
     397           (*backend-crf-temps* arm-cr-fields)
     398           (*available-backend-crf-temps* arm-cr-fields)
    399399           (bits 0)
    400400           (*logical-register-counter* -1)
     
    426426           (*arm2-fcells* (afunc-fcells afunc))
    427427           *arm2-recorded-symbols*
    428            (*arm2-emitted-source-notes* '()))
     428           (*arm2-emitted-source-notes* '())
     429           (*arm2-gpr-locations-valid-mask* 0)
     430           (*arm2-gpr-locations* (make-array 16 :initial-element nil)))
     431      (declare (dynamic-extent *arm2-gpr-locations*))
    429432      (set-fill-pointer
    430433       *backend-labels*
     
    490493    afunc))
    491494
    492 (defun arm2-xmake-function (code data labels imms bits)
    493   (let* ((arm::*lap-labels* labels)
    494          (cross-compiling (target-arch-case
    495                            (:arm (not (eq *host-backend* target-backend)))
    496                            (t t)))
    497          (numimms (length imms))
    498          (function (%alloc-misc (+ numimms 3)
    499                                 (if cross-compiling
    500                                   target::subtag-xfunction
    501                                   target::subtag-function))))
    502     (dotimes (i numimms)
    503       (setf (uvref function (1+ 2)) (aref imms i)))
    504     (setf (uvref function (+ numimms 1)) bits)
    505     (let* ((code-vector-size (arm::arm-finalize code data))
    506            (code-vector (%alloc-misc code-vector-size
    507                                      (if cross-compiling
    508                                        target::subtag-xcode-vector
    509                                        target::subtag-code-vector)))
    510            (j 0))
    511       (dotimes (i prefix-size)
    512         (setf (uvref code-vector i) (pop prefix)))
    513       (arm-lap-resolve-labels)
    514       (do-dll-nodes (insn *lap-instructions*)
    515         (arm-lap-generate-instruction code-vector i insn)
    516         (incf i))
    517       (setf (uvref function 1) code-vector)
    518       (%make-code-executable code-vector)
    519       function)))
     495(defun arm2-xmake-function (code data imms bits)
     496  (collect ((lap-imms))
     497    (dotimes (i (length imms))
     498      (lap-imms (cons (aref imms i) i)))
     499    (let* ((arm::*arm-constants* (lap-imms)))
     500      (arm-lap-generate-code code
     501                             (arm::arm-finalize code data)
     502                             bits))))
     503
     504
    520505     
    521506   
     
    538523              (if (eq (%svref v i) ref)
    539524                (setf (%svref v i) ref-fun)))))))))
     525
     526(eval-when (:compile-toplevel)
     527  (declaim (inline arm2-invalidate-regmap)))
     528
     529(defun arm2-invalidate-regmap ()
     530  (setq *arm2-gpr-locations-valid-mask* 0))
     531
     532(defun arm2-update-regmap (vinsn)
     533  (if (vinsn-attribute-p vinsn :call :jump)
     534    (arm2-invalidate-regmap)
     535    (setq *arm2-gpr-locations-valid-mask* (logandc2 *arm2-gpr-locations-valid-mask* (vinsn-gprs-set vinsn))))
     536  vinsn)
     537
     538(defun arm2-regmap-note-store (gpr loc)
     539  (let* ((gpr (%hard-regspec-value gpr)))
     540    ;; Any other GPRs that had contained loc no longer do so.
     541    (dotimes (i 16)
     542      (unless (eql i gpr)
     543        (when (and (logbitp i *arm2-gpr-locations-valid-mask*)
     544                   (eql loc (svref *arm2-gpr-locations* i)))
     545          (setq *arm2-gpr-locations-valid-mask* (logandc2 *arm2-gpr-locations-valid-mask* (ash 1 i))))))
     546    (setf (svref *arm2-gpr-locations* gpr) loc)
     547    (setq *arm2-gpr-locations-valid-mask* (logior *arm2-gpr-locations-valid-mask* (ash 1 gpr)))))
     548 
     549;;; For vpush: nothing else should claim to contain loc.
     550(defun arm2-regmap-note-reg-location (gpr loc)
     551  (let* ((gpr (%hard-regspec-value gpr)))
     552    (setf (svref *arm2-gpr-locations* gpr) loc)
     553    (setq *arm2-gpr-locations-valid-mask* (logior *arm2-gpr-locations-valid-mask* (ash 1 gpr))))) 
     554 
     555(defun arm2-regmap-note-vstack-delta (new old)
     556  (when (< new old)
     557    (let* ((mask *arm2-gpr-locations-valid-mask*)
     558           (info *arm2-gpr-locations*))
     559    (unless (eql 0 mask)
     560      (dotimes (i 16 (setq *arm2-gpr-locations-valid-mask* mask))
     561        (when (logbitp i mask)
     562          (let* ((loc (svref info i)))
     563            (when (>= loc new)
     564              (setq mask (logandc2 mask (ash 1 i)))))))))))
     565
    540566
    541567(defun arm2-generate-pc-source-map (debug-info)
     
    819845          (! save-lisp-context-offset offset)))
    820846      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
     847        (declare (ignore xvar yvar))
    821848        (let* ((nstackargs (length stack-args)))
    822849          (arm2-set-vstack (* nstackargs *arm2-target-node-size*))
     
    824851            (arm2-new-vstack-lcell :reserved *arm2-target-lcell-size* 0 nil))
    825852          (if (>= nargs 3)
    826             (push (arm2-vpush-arg-register seg ($ arm::arg_x) xvar) reg-vars))
    827           (if (>= nargs 2)
    828             (push (arm2-vpush-arg-register seg ($ arm::arg_y) yvar) reg-vars))
    829           (if (>= nargs 1)
    830             (push (arm2-vpush-arg-register seg ($ arm::arg_z) zvar) reg-vars))))
     853            (progn
     854              (! vpush-xyz)
     855              (arm2-regmap-note-store arm::arg_x *arm2-vstack*)
     856              (arm2-regmap-note-store arm::arg_y (+ *arm2-target-node-size* *arm2-vstack*))
     857              (arm2-regmap-note-store arm::arg_z (+ (* 2 *arm2-target-node-size*) *arm2-vstack*))
     858              (dotimes (i 3)
     859                (arm2-new-vstack-lcell :reserved *arm2-target-lcell-size* 0 nil))
     860              (arm2-adjust-vstack (* 3 *arm2-target-node-size*)))
     861            (if (= nargs 2)
     862              (progn
     863                (! vpush-yz)
     864                (arm2-regmap-note-store arm::arg_y *arm2-vstack*)
     865                (arm2-regmap-note-store arm::arg_z (+ *arm2-target-node-size* *arm2-vstack*))
     866                (dotimes (i 2)
     867                  (arm2-new-vstack-lcell :reserved *arm2-target-lcell-size* 0 nil))
     868                (arm2-adjust-vstack (* 2 *arm2-target-node-size*)))
     869              (if (= nargs 1)
     870                (push (arm2-vpush-arg-register seg ($ arm::arg_z) zvar) reg-vars))))))
    831871      reg-vars)))
    832872
     
    10671107
    10681108(defun arm2-set-vstack (new)
     1109  (arm2-regmap-note-vstack-delta new *arm2-vstack*)
    10691110  (setq *arm2-vstack* new))
    10701111
     
    10961137(defun arm2-stack-to-register (seg memspec reg)
    10971138  (with-arm-local-vinsn-macros (seg)
    1098     (! vframe-load reg (memspec-frame-address-offset memspec) *arm2-vstack*)))
     1139    (let* ((offset (memspec-frame-address-offset memspec))
     1140           (mask *arm2-gpr-locations-valid-mask*)
     1141           (info *arm2-gpr-locations*)
     1142           (regno (%hard-regspec-value reg)))
     1143      (unless (and (logbitp regno mask)
     1144                   (eql offset (svref info regno)))
     1145        (let* ((other (dotimes (i 16)
     1146                        (when (and (logbitp i mask)
     1147                                   (eql offset (svref info i)))
     1148                          (return i)))))
     1149          (cond (other
     1150                 (let* ((vinsn (! copy-node-gpr reg other)))
     1151                   (setq *arm2-gpr-locations-valid-mask*
     1152                         (logior mask (ash 1 regno)))
     1153                   (setf (svref info regno)
     1154                         (svref info other))
     1155                   vinsn))
     1156                (t
     1157                 (let* ((vinsn (! vframe-load reg offset *arm2-vstack*)))
     1158                   (setq *arm2-gpr-locations-valid-mask*
     1159                         (logior mask (ash 1 regno)))
     1160                   (setf (svref info regno) offset)
     1161                   vinsn))))))))
    10991162
    11001163(defun arm2-lcell-to-register (seg lcell reg)
     
    11081171(defun arm2-register-to-stack (seg reg memspec)
    11091172  (with-arm-local-vinsn-macros (seg)
    1110     (! vframe-store reg (memspec-frame-address-offset memspec) *arm2-vstack*)))
     1173    (let* ((offset (memspec-frame-address-offset memspec))
     1174           (vinsn (! vframe-store reg offset *arm2-vstack*)))
     1175      (arm2-regmap-note-store (%hard-regspec-value reg) offset)
     1176      vinsn)))
    11111177
    11121178
     
    22272293(defun arm2-restore-full-lisp-context (seg)
    22282294  (with-arm-local-vinsn-macros (seg)
    2229     (if *arm2-open-code-inline*
    2230       (! restore-full-lisp-context)
    2231       (! restore-full-lisp-context-ool))))
     2295    (! restore-full-lisp-context)))
    22322296
    22332297(defun arm2-call-symbol (seg jump-p)
     
    22422306  ; tradeoff.
    22432307  (with-arm-local-vinsn-macros (seg)
    2244     (if *arm2-open-code-inline*
    22452308      (if jump-p
    22462309        (! jump-known-symbol)
    2247         (! call-known-symbol arm::arg_z))
    2248       (if jump-p
    2249         (! jump-known-symbol-ool)
    2250         (! call-known-symbol-ool)))))
     2310        (! call-known-symbol arm::arg_z))))
    22512311
    22522312;;; Nargs = nil -> multiple-value case.
     
    23612421                           (! tail-call-fn-slide)))
    23622422                        (t
     2423                         (! restore-full-lisp-context)
    23632424                         (if symp
    2364                            (! tail-call-sym-vsp)
    2365                            (! tail-call-fn-vsp)))))))))
     2425                           (! jump-known-symbol)
     2426                           (! jump-known-function)))))))))
    23662427        ;; The general (funcall) case: we don't know (at compile-time)
    23672428        ;; for sure whether we've got a symbol or a (local, constant)
     
    26782739           (same-reg (eq (hard-regspec-value pushed-reg)
    26792740                         (hard-regspec-value popped-reg)))
    2680            (tsp-p (vinsn-attribute-p push-vinsn :tsp)))
    2681       (when (and tsp-p t)               ; vsp case is harder.
     2741           (sp-p (vinsn-attribute-p push-vinsn :sp)))
     2742      (when (and sp-p t)               ; vsp case is harder.
    26822743        (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :tsp :discard)
    26832744          (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
     
    31083169         (! compare dest ireg jreg)
    31093170         (^ cr-bit true-p))
    3110        (with-imm-temps () ((b31-reg :natural))
    3111          (ecase cr-bit
    3112            (#. arm::arm-cond-eq
    3113             (if true-p
    3114               (! eq->bit31 b31-reg ireg jreg)
    3115               (! ne->bit31 b31-reg ireg jreg)))
    3116            (#. arm::arm-cond-lt
    3117             (if true-p
    3118               (! lt->bit31 b31-reg ireg jreg)
    3119               (! ge->bit31 b31-reg ireg jreg)))
    3120            (#. arm::arm-cond-gt
    3121             (if true-p
    3122               (! gt->bit31 b31-reg ireg jreg)
    3123               (! le->bit31 b31-reg ireg jreg))))
     3171       (with-crf-target () crf
     3172         (! compare crf ireg jreg)
    31243173         (ensuring-node-target (target dest)
    3125            (! lowbit->truth target b31-reg))
     3174           (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1))))
    31263175         (^)))
    31273176      (^))))
     
    31353184         (! compare-to-nil dest ireg)
    31363185         (^ cr-bit true-p))
    3137        (with-imm-temps () ((b31-reg :natural))
    3138          (ecase cr-bit
    3139            (#. arm::arm-cond-eq
    3140             (if true-p
    3141               (! eqnil->bit31 b31-reg ireg)
    3142               (! nenil->bit31 b31-reg ireg))))
     3186       (with-crf-target () crf
     3187         (! compare-to-nil crf ireg)
    31433188         (ensuring-node-target (target dest)
    3144            (! lowbit->truth target b31-reg))
     3189           (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1))))
    31453190         (^)))
    31463191      (^))))
     
    32193264    (prog1
    32203265      (! vpush-register src)
     3266      (arm2-regmap-note-store src *arm2-vstack*)
    32213267      (arm2-new-vstack-lcell (or why :node) *arm2-target-lcell-size* (or attr 0) info)
    32223268      (arm2-adjust-vstack *arm2-target-node-size*))))
     
    48094855         (vp (vinsn-variable-parts vinsn))
    48104856         (nvp (vinsn-template-nvp template))
    4811          (unique-labels ()))
     4857         (unique-labels ())
     4858         (operand-insert-functions arm::*arm-vinsn-insert-functions*))
    48124859    (declare (fixnum nvp))
    48134860    (dotimes (i nvp)
     
    48204867        (arm::make-lap-label unique)))
    48214868    (labels ((parse-operand-form (valform)
     4869               ;(break "valform = ~s" valform)
    48224870               (cond ((typep valform 'keyword)
    48234871                      (or (assq valform unique-labels)
     
    48354883                            (setq tail (cdr (rplaca tail (parse-operand-form op)))))))))
    48364884             (expand-insn-form (f)
    4837                (let* ((operands (cdr f))
    4838                       (head (make-list (length operands)))
    4839                       (tail head))
    4840                  (declare (dynamic-extent head)
    4841                           (cons head tail))
    4842                  (dolist (op operands)
    4843                    (rplaca tail (parse-operand-form op))
    4844                    (setq tail (cdr tail)))
    4845                  (arm-emit-lap-instruction (svref arm::*arm-opcodes* (car f))
    4846                                            head)))
     4885               (case (car f)
     4886                 (:code (setq current (svref sections 0)))
     4887                 (:data (setq current (svref sections 1)))
     4888                 (:word
     4889                  (let* ((insn (arm::make-lap-instruction nil)))
     4890                    (setf (arm::lap-instruction-opcode insn)
     4891                          (parse-operand-form (cadr f)))
     4892                    (append-dll-node insn current)))
     4893                 (t
     4894                  (let* ((insn (arm::make-lap-instruction nil))
     4895                         (operands (cdr f)))
     4896                    (setf (arm::lap-instruction-opcode insn) (car f))
     4897                    (dolist (op operands (append-dll-node insn current))
     4898                      (let* ((insert-function (svref operand-insert-functions (car op))))
     4899                        (funcall insert-function insn (parse-operand-form (cdr op)))))))))
    48474900             (eval-predicate (f)
    48484901               (case (car f)
     
    48784931      (setf (vinsn-variable-parts vinsn) nil)
    48794932      (when vp
    4880         (free-varparts-vector vp)))))
     4933        (free-varparts-vector vp))
     4934      current)))
    48814935
    48824936
     
    49645018           (num-req (length req))
    49655019           (num-opt (length (%car opt)))
    4966            (no-regs nil)
    49675020           (arg-regs nil)
    49685021           optsupvloc
     
    49715024      (declare (type (unsigned-byte 16) num-req num-opt num-inh))
    49725025      (with-arm-p2-declarations p2decls
    4973         (setq *arm2-inhibit-register-allocation*
    4974               (setq no-regs (%ilogbitp $fbitnoregs fbits)))
    4975 
     5026        ;; Need to do this for effect here.
     5027        (nx2-allocate-global-registers *arm2-fcells* *arm2-vcells* nil nil nil)
    49765028        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    49775029        (when keys ;; Ensure keyvect is the first immediate
     
    50015053                (unless (or rest keys)
    50025054                  (! check-max-nargs (+ num-fixed num-opt)))
    5003                 ;; Going to have to call one or more subprims.  First save
    5004                 ;; the LR in LOC-PC.
    5005                 (! save-lr)
     5055                (! save-lisp-context-variable)
    50065056                ;; If there were &optional args, initialize their values
    50075057                ;; to NIL.  All of the argregs get vpushed as a result of this.
     
    50745124                       (nbytes-vpushed (* nwords-vpushed *arm2-target-node-size*)))
    50755125                  (declare (fixnum nwords-vpushed nbytes-vpushed))
    5076                   (unless (or lexprp keys)
    5077                     (if *arm2-open-code-inline*
    5078                       (! save-lisp-context-offset nbytes-vpushed)
    5079                       (! save-lisp-context-offset-ool nbytes-vpushed)))
     5126
    50805127                  (arm2-set-vstack nbytes-vpushed)
    50815128                  (setq optsupvloc (- *arm2-vstack* (* num-opt *arm2-target-node-size*)))))))
Note: See TracChangeset for help on using the changeset viewer.