Ignore:
Timestamp:
May 30, 2010, 2:36:13 PM (9 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.

File:
1 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")
Note: See TracChangeset for help on using the changeset viewer.