Changeset 14111


Ignore:
Timestamp:
Aug 3, 2010, 4:05:10 AM (9 years ago)
Author:
gb
Message:

Yet another scheme for subprim calls. Go ahead and laugh.
Details:

  • ba/bla are new pseudo instructions, identical to b/bl except that their operands are subprim names (or addresses).
  • for each subprim name/address referenced in a ba/bla instruction, the assembler generates an:

(ldr pc (:= data-word-containing-subprim-address))

instruction and makes the ba/bla branch to that instruction.

  • this is the only use of the "constant pool" and there are no longer user-visible directives for referencing pc-relative data. (We can load 32-bit integer constants via movw/movt instructions and initialize FPRs to constants via GPRs.)
  • by default, the disassembler hides this and shows ba/bla instructions.

Compared to the scheme of a few days ago, it's about the same speed
(b/bl to LDR vs mov reg/bx reg). If a subprim's called once per function
it's a little bigger; if there's more than one call site, it can be smaller.
(And we don't have to find a temp register.) If we can map the subprims
to addresses within 32MB of the pure area, then purify can turn the PC-relative
branches/bls to the LDR instructions into direct branches/bls to the code.

Compared to the original scheme (branch/bl to mov pc, #n) we don't flush
the pipeline on every call and don't have any constraints on subprimitive
addresses (they don't have to be expressible as ARM constants.)

Location:
branches/arm
Files:
18 edited

Legend:

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

    r14107 r14111  
    4444(defvar *arm-constants* ())
    4545(defvar *lap-labels* ())
    46 (defvar *last-constant-pool-origin* ())
     46(defvar *called-subprim-jmp-labels* ())
     47
    4748
    4849
     
    603604     #x0f000000
    604605     ())
     606   ;; BA and BLA are indistinguishable from B/BL in their
     607   ;; generated code; they branch to/call subprim glue.
     608   (define-arm-instruction ba (:subprim)
     609     #x0a000000
     610     #x0f000000
     611     ())     
     612      (define-arm-instruction bla (:subprim)
     613     #x0b000000
     614     #x0f000000
     615     ())   
    605616   (define-arm-instruction bx (:rm)
    606617     #x012fff10
     
    12741285  (lap-note-label-reference form instruction :b))
    12751286
     1287(defun parse-subprim-operand (form instruction)
     1288  (multiple-value-bind (addr name)
     1289      (if (typep form 'fixnum)
     1290        (values form
     1291                (arm-subprimitive-name form))
     1292        (values (arm-subprimitive-address form)
     1293                form))
     1294    (unless (and name addr)
     1295      (error "~s is not the name or address of an ARM subprimitive." form))
     1296    (let* ((lab (or (find-lap-label name)
     1297                    (make-lap-label name))))
     1298      (pushnew lab *called-subprim-jmp-labels*)
     1299      (push (cons instruction :b) (lap-label-refs lab)))))
     1300
    12761301
    12771302   
     
    13681393      parse-rm-operand
    13691394      parse-b-operand
    1370       obsolete
     1395      parse-subprim-operand
    13711396      parse-m8-operand
    13721397      parse-dd-operand
     
    15191544
    15201545
    1521 ;;; It's better to do this naively than to not do it at all
    1522 (defun drain-constant-pool (primary constant-pool)
    1523   (let* ((n-constant-bytes (section-size constant-pool)))
    1524     (declare (fixnum n-constant-bytes))
    1525     (when (> n-constant-bytes 0)
    1526       (when (> (+ n-constant-bytes (section-size primary)) 4000) ; some slack here
    1527         ;; Jump around an embedded constant pool.  We might be following
    1528         ;; some flavor of a jump with an unreachable one, or sticking
    1529         ;; some stuff in the middle of a jump table, or something.
    1530         ;; LAP functions that have jump tables aren't likely to be
    1531         ;; big enough to need to worry about this; if the compiler
    1532         ;; generates jump tables or other span-dependent things, it'll
    1533         ;; have to be careful about how it does so.       
    1534         (let* ((target-name (gensym))
    1535                (origin (make-lap-instruction nil))
    1536                (offset (make-lap-instruction nil))
    1537                (pool-count (make-lap-instruction nil))
    1538                (offset-label (make-lap-label (gensym))))
    1539           (assemble-instruction primary `(b ,target-name))
    1540           (set-field-value origin (byte 32 0) 0)
    1541           (emit-lap-instruction-element origin primary)
    1542           (setq *last-constant-pool-origin* origin)
    1543           (set-field-value offset (byte 32 0) 0)
    1544           (emit-lap-instruction-element offset primary)
    1545           (set-field-value pool-count (byte 32 0) (ash n-constant-bytes (- arm::word-shift)))
    1546           (emit-lap-instruction-element pool-count primary)
    1547           (ccl::do-dll-nodes (datum constant-pool)
    1548             (ccl::remove-dll-node datum)
    1549             (emit-lap-instruction-element datum primary))
    1550           (push (cons offset :offset) (lap-label-refs offset-label))
    1551           (emit-lap-label primary (lap-label-name offset-label))
    1552           (emit-lap-label primary target-name))))))
    15531546           
    15541547   
    15551548 
    1556 (defun arm-finalize (primary constant-pool)
    1557   (do-lap-labels (lab)
    1558     (loop
    1559       (when (dolist (ref (lap-label-refs lab) t)             
    1560               (when (and (eq :b (cdr ref))
    1561                          (eq lab (lap-instruction-succ (car ref))))
    1562                 (ccl::remove-dll-node (car ref))
    1563                 (setf (lap-label-refs lab)
    1564                       (delete ref (lap-label-refs lab)))
    1565                 (return)))
    1566         (return))))
    1567 
    1568   (let* ((constants-size (section-size constant-pool)))
    1569     (unless (eql constants-size 0)
    1570       (let* ((c0 (make-lap-instruction nil)))
    1571         (set-field-value c0 (byte 32 0) (ash constants-size -2))
    1572         (ccl::insert-dll-node-before c0 (ccl::dll-header-first constant-pool)))))
    1573   (let* ((w0 (make-lap-instruction nil))
    1574          (w1 (make-lap-instruction nil)))
    1575     (set-field-value w0 (byte 32 0) 0)
    1576     (ccl::append-dll-node w0 primary)
    1577     (ccl::append-dll-node w1 primary )
    1578     (let* ((n (set-element-addresses 0 primary)))
    1579       (set-field-value w1 (byte 32 0) (ash n (- arm::word-shift)))
    1580       (set-element-addresses n constant-pool)))
    1581   ;; Now fix up label references.  Recall that the PC value at some
    1582   ;; point in program execution is 8 bytes beyond that point.
    1583   (do-lap-labels (lab)
    1584     (if (lap-label-emitted-p lab)
    1585       (let* ((labaddr (lap-label-address lab)))
    1586         (dolist (ref (lap-label-refs lab))
    1587           (destructuring-bind (insn . reftype) ref
    1588             (let* ((diff-in-bytes (- labaddr (+ 8 (lap-instruction-address insn)))))
    1589               (case reftype
    1590                 (:b (set-field-value insn (byte 24 0) (ash diff-in-bytes -2)))
    1591                 (:mem12
    1592                  (if (>= diff-in-bytes 0)
    1593                    (set-field-value insn (byte 1 23) 1)
    1594                    (setq diff-in-bytes (- diff-in-bytes)))
    1595                  (when (> (integer-length diff-in-bytes) 12)
    1596                    (error "PC-relative displacement can't be encoded."))
    1597                  (set-field-value insn (byte 12 0) diff-in-bytes))
    1598                 (:offset
    1599                  (set-field-value insn (byte 32 0)(1+ (ash (lap-instruction-address insn) (- arm::word-shift)))))
    1600                 (t
    1601                  (error "Label type ~s invalid or not yet supported."
    1602                         reftype)))))))
    1603       (if (lap-label-refs lab)
    1604         (error "LAP label ~s was referenced but not defined." (lap-label-name lab)))))
    1605   (ccl::merge-dll-nodes primary constant-pool)
    1606   (let* ((last (ccl::dll-header-last primary)))
    1607     (ash (+ (instruction-element-address last)
    1608             (instruction-element-size last)) -2)))
     1549(defun arm-finalize (seg)
     1550  (let* ((data-labels ())
     1551         (removed nil))
     1552    (do-lap-labels (lab)
     1553      (loop
     1554        (when (dolist (ref (lap-label-refs lab) t)             
     1555                (when (and (eq :b (cdr ref))
     1556                           (eq lab (lap-instruction-succ (car ref))))
     1557                  (ccl::remove-dll-node (car ref))
     1558                  (setq removed t)
     1559                  (setf (lap-label-refs lab)
     1560                        (delete ref (lap-label-refs lab)))
     1561                  (return)))
     1562          (return))))
     1563    (when removed
     1564      (set-element-addresses 0 seg))
     1565    (dolist (jmp-label *called-subprim-jmp-labels*)
     1566      (let* ((spname (lap-label-name jmp-label))
     1567             (data-label-name (cons spname (arm-subprimitive-address spname)))
     1568             (data-label (make-lap-label data-label-name)))
     1569        (push data-label data-labels)
     1570        (emit-lap-label seg spname)
     1571        (assemble-instruction seg `(ldr pc (:= ,data-label-name)))))
     1572   
     1573    (let* ((marker (make-lap-instruction nil))
     1574           (code-count (make-lap-instruction nil)))
     1575      (emit-lap-instruction-element marker seg)
     1576      (emit-lap-instruction-element code-count seg)
     1577      (set-field-value code-count (byte 32 0) (ash (section-size seg) -2)))
     1578   
     1579    (dolist (data-label (nreverse data-labels))
     1580      (let* ((name (lap-label-name data-label))
     1581             (addr (cdr name)))
     1582        (emit-lap-label seg name)
     1583        (let* ((insn (make-lap-instruction nil)))
     1584          (set-field-value insn (byte 32 0) addr)
     1585          (emit-lap-instruction-element insn seg))))
     1586         
     1587   
     1588    ;; Now fix up label references.  Recall that the PC value at some
     1589    ;; point in program execution is 8 bytes beyond that point.
     1590    (do-lap-labels (lab)
     1591      (if (lap-label-emitted-p lab)
     1592        (let* ((labaddr (lap-label-address lab)))
     1593          (dolist (ref (lap-label-refs lab))
     1594            (destructuring-bind (insn . reftype) ref
     1595              (let* ((diff-in-bytes (- labaddr (+ 8 (lap-instruction-address insn)))))
     1596                (case reftype
     1597                  (:b (set-field-value insn (byte 24 0) (ash diff-in-bytes -2)))
     1598                  (:mem12
     1599                   (if (>= diff-in-bytes 0)
     1600                     (set-field-value insn (byte 1 23) 1)
     1601                     (setq diff-in-bytes (- diff-in-bytes)))
     1602                   (when (> (integer-length diff-in-bytes) 12)
     1603                     (error "PC-relative displacement can't be encoded."))
     1604                   (set-field-value insn (byte 12 0) diff-in-bytes))
     1605                  (:offset
     1606                   (set-field-value insn (byte 32 0)(1+ (ash (lap-instruction-address insn) (- arm::word-shift)))))
     1607                  (t
     1608                   (error "Label type ~s invalid or not yet supported."
     1609                          reftype)))))))
     1610        (if (lap-label-refs lab)
     1611          (error "LAP label ~s was referenced but not defined." (lap-label-name lab)))))
     1612    (ash (section-size seg) -2)))
    16091613
    16101614;;; We want to be able to write vinsn templates using a (mostly) LAP-like
     
    17161720      vinsn-parse-rm-operand
    17171721      vinsn-parse-b-operand
    1718       obsolete
     1722      vinsn-parse-subprim-operand
    17191723      vinsn-parse-m8-operand
    17201724      vinsn-parse-dd-operand
     
    19371941(defun vinsn-parse-b-operand (avi value vinsn-params)
    19381942  ;; Pretty much has to be a param or a local label what else would we b to ?
    1939   (let* ((p (position value vinsn-params))
    1940          (addr nil))
     1943  (let* ((p (position value vinsn-params)))
    19411944    (cond (p
    19421945           (add-avi-operand avi (encode-vinsn-field-type :label) (list p)))
    19431946          ((typep value 'keyword)
    19441947           (add-avi-operand avi (encode-vinsn-field-type :label) value))
    1945           ((setq addr (arm-subprimitive-address value))
    1946            (add-avi-operand avi (encode-vinsn-field-type :label) addr))
    1947           ((arm-subprimitive-name value)
    1948            (add-avi-operand avi (encode-vinsn-field-type :label) value))
    19491948          (t
    19501949           (error "Unknown branch target: ~s." value)))))
    19511950
    1952 
     1951(defun vinsn-parse-subprim-operand (avi value vinsn-params)
     1952  (let* ((p (position value vinsn-params))
     1953         (addr nil))
     1954    (cond (p
     1955           (add-avi-operand avi (encode-vinsn-field-type :subprim) (list p)))
     1956          ((setq addr (arm-subprimitive-address value))
     1957           (add-avi-operand avi (encode-vinsn-field-type :subprim) addr))
     1958          ((arm-subprimitive-name value)
     1959           (add-avi-operand avi (encode-vinsn-field-type :subprim) value)) 
     1960          (t
     1961           (error "Unknown subprimitive name or address: ~s." value)))))
    19531962
    19541963(defun vinsn-parse-m8-operand (avi value vinsn-params)
     
    21132122    vinsn-insert-uuoB-operand
    21142123    vinsn-insert-label-operand
    2115     obsolete
     2124    vinsn-insert-subprim-operand
    21162125    vinsn-insert-data-label-operand
    21172126    vinsn-insert-dd-operand
     
    21912200    (push (cons instruction :b) (lap-label-refs label))))
    21922201
     2202(defun vinsn-insert-subprim-operand (instruction value)
     2203  (let* ((name (arm-subprimitive-name value))
     2204         (label (or (find-lap-label name)
     2205                    (make-lap-label name))))
     2206    (pushnew label *called-subprim-jmp-labels*)
     2207    (push (cons instruction :b) (lap-label-refs label))))
     2208
    21932209
    21942210
  • branches/arm/compiler/ARM/arm-disassemble.lisp

    r14107 r14111  
    1919)
    2020
     21(defparameter *hide-spjump-internals* t)
     22
    2123(defstruct (arm-disassembled-instruction (:conc-name adi-))
    2224  (opcode 0 :type (unsigned-byte 32))
     
    8688    (if (logbitp 25 opcode)
    8789      (let* ((count (ash (ldb (byte 4 8) opcode) 1))
    88              (mov-p (eql (ldb (byte 4 21) opcode) arm::opcode-mov))
    89              (value (arm::arm-rotate-left (ldb (byte 8 0) opcode) (logand 31 (- 32 count))))
    90              (spname (and mov-p (arm::arm-subprimitive-name value))))
    91         (if spname
    92           (progn
    93             (setf (adi-mnemonic (svref opcodes i)) "load-subprim")
    94             `(:spname ,spname))
    95           `(:$ ,value)))
     90             (value (arm::arm-rotate-left (ldb (byte 8 0) opcode) (logand 31 (- 32 count)))))
     91        `(:$ ,value))
    9692      (let* ((rn (arm-gpr-name (ldb (byte 4 0) opcode)))
    9793             (register-shifted (logbitp 4 opcode)))
     
    214210
    215211(defun extract-arm-b-operand (opcodes i)
    216   (let* ((opcode (adi-opcode (svref opcodes i)))
     212  (let* ((adi (svref opcodes i))
     213         (opcode (adi-opcode adi))
    217214         (b-field (ldb (byte 24 0) opcode)))
    218215    (when (logbitp 23 b-field)
     
    221218      (when (and (>= target 0)
    222219                 (< target (length opcodes)))
    223         (setf (adi-labeled (svref opcodes target)) t))
    224       `(:label ,target))))
     220        (let* ((target-op (svref opcodes target))
     221               (target-op-label (adi-labeled target-op)))
     222          (cond  ((and target-op-label
     223                       (not (eq t target-op-label)))
     224                  (when *hide-spjump-internals*
     225                    (setf (adi-mnemonic adi)
     226                          (if (logbitp 24 opcode)
     227                            "bla"
     228                            "ba")))
     229                  `(:spname ,target-op-label))
     230                 (t
     231                  (setf (adi-labeled (svref opcodes target)) t)
     232                  `(:label ,target))))))))
    225233
    226234
     
    319327(defun process-adi-vector (adi-vector)
    320328  (let* ((n (length adi-vector))
    321          (skip 0)
    322          (data 0))
    323     (dotimes (i n adi-vector)
     329         (data nil))
     330    (declare (fixnum n))
     331    (do* ((i (1- n) (1- i)))
     332         ((< i 0))
     333      (declare (fixnum i))
    324334      (let* ((adi (svref adi-vector i))
    325335             (opcode (adi-opcode adi)))
    326         (cond ((> skip 0)
    327                (decf skip)
    328                (if (= skip 0)
    329                  (setq data opcode)))
    330               ((> data 0)
    331                (decf data)
     336        (when (= opcode 0)
     337          (do* ((w (1- n) (1- w))
     338                (j (1- i) (1- j))
     339                (ndata (- n (1+ i)) (1- ndata)))
     340               ((zerop ndata))
     341            (let* ((addr (adi-opcode (svref adi-vector w)))
     342                   (jmp (svref adi-vector j)))
     343              (setf (adi-labeled jmp)
     344                    (arm::arm-subprimitive-name addr))))
     345          (return))))
     346    (do* ((i 0 (1+ i)))
     347         ((= i n) adi-vector)
     348      (declare (fixnum i))
     349      (let* ((adi (svref adi-vector i))
     350             (opcode (adi-opcode adi)))
     351        (cond ((= opcode 0)
     352               (setq data t)
     353               (incf i))
     354              (data
    332355               (setf (adi-mnemonic adi) ":word"
    333                      (adi-operands adi) (list opcode)))
    334               ((= opcode 0)
    335                (setq skip 2))
     356                     (adi-operands adi) (list (adi-opcode adi))))
    336357              (t
    337358               (let* ((template (find-arm-instruction-template opcode)))
     
    358379    "temp1" "temp2" "vsp" "fn" "allocptr" "sp" "lr" "pc"))
    359380
    360 (defun disassemble-arm-xfunction (xfunction &optional (stream *debug-io*))
     381
     382
     383(defun disassemble-arm-xfunction (xfunction &optional (stream *debug-io*) (*hide-spjump-internals* *hide-spjump-internals*))
    361384  (let* ((adi-vector (process-adi-vector (make-adi-vector (uvref xfunction 1))))
    362385         (functionp (typep xfunction 'function)) ;not cross-compiling
     
    402425            (if (eq t labeled)
    403426              (format stream "~&L~d~&" (ash i 2))
    404               (format stream "~&~a~&" labeled)))
     427              (if *hide-spjump-internals*
     428                (return)
     429                (format-spname labeled stream))))
    405430          (let* ((name (adi-mnemonic info)))
    406431            (when name
  • branches/arm/compiler/ARM/arm-lap.lisp

    r14096 r14111  
    6464(defun %define-arm-lap-function (name body &optional (bits 0))
    6565  (with-dll-node-freelist (primary arm::*lap-instruction-freelist*)
    66     (with-dll-node-freelist (constant-pool arm::*lap-instruction-freelist*)
    6766      (let* ((arm::*lap-labels* ())
    68              (arm::*last-constant-pool-origin* ())
     67             (arm::*called-subprim-jmp-labels* ())
    6968             (name-cell (list name))
    7069             (arm::*arm-constants* ())
    7170             (*arm-lap-lfun-bits* bits)
    72              (arm::*arm-register-names* arm::*standard-arm-register-names*)
    73              (current primary)
    74              (sections (vector primary constant-pool)))
    75         (declare (dynamic-extent sections))
     71             (arm::*arm-register-names* arm::*standard-arm-register-names*))
    7672        (dolist (form body)
    77           (setq current (arm-lap-form form current sections)))
     73          (arm-lap-form form primary))
    7874        (rplacd name-cell (length arm::*arm-constants*))
    7975        (push name-cell arm::*arm-constants*)
    8076        (arm-lap-generate-code primary
    81                                (arm::arm-finalize primary  constant-pool)
    82                                *arm-lap-lfun-bits*)))))
     77                               (arm::arm-finalize primary)
     78                               *arm-lap-lfun-bits*))))
    8379
    8480
     
    139135      constants-vector)))
    140136
    141 (defun arm-lap-pseudo-op (directive arg current sections)
    142   (flet ((check-usage (directive)
    143            (unless (eq current (svref sections 1))
    144              (error "~s directive should only be used inside :data section" directive))))
    145     (ecase directive
    146       (:arglist (setq *arm-lap-lfun-bits* (encode-lambda-list arg)))
    147       (:data
    148        (setq current (svref sections 1)))
    149       (:code
    150        (setq current (svref sections 0)))
    151       (:section
    152        (setq current (svref sections
    153                             (ecase arg
    154                               (:code 0)
    155                               (:data 1)))))
    156       (:word
    157        (check-usage :word)
    158        (arm::emit-lap-instruction-element
    159         (let* ((insn (arm::make-lap-instruction nil)))
    160           (arm::set-field-value insn (byte 32 0)  (logand #xffffffff (eval arg)))
    161           insn)
    162         current))
    163      
    164       (:single
    165        (check-usage :single)
    166        (arm::emit-lap-instruction-element
    167         (let* ((insn (arm::make-lap-instruction nil)))
    168           (arm::set-field-value insn (byte 32 0) (single-float-bits (float (eval arg) 0.0f0)))
    169           insn)
    170         current))
    171       (:double
    172        (check-usage :double)
    173        (multiple-value-bind (high low) (double-float-bits (float (eval arg) 0.0d0))
    174          (let* ((insnlow (arm::make-lap-instruction nil))
    175                 (insnhigh (arm::make-lap-instruction nil)))
    176            (arm::set-field-value insnlow (byte 32 0) low)
    177            (arm::set-field-value insnhigh (byte 32 0) high)
    178            (arm::emit-lap-instruction-element insnlow current)
    179            (arm::emit-lap-instruction-element insnhigh current)))))
    180     current))
     137(defun arm-lap-pseudo-op (directive arg)
     138  (ecase directive
     139    (:arglist (setq *arm-lap-lfun-bits* (encode-lambda-list arg)))))
    181140       
    182141
    183142       
    184 (defun arm-lap-form (form current sections)
     143(defun arm-lap-form (form seg)
    185144  (if (and form (symbolp form))
    186     (arm::emit-lap-label current form)
     145    (arm::emit-lap-label seg form)
    187146    (if (or (atom form) (not (symbolp (car form))))
    188147      (error "~& unknown ARM-LAP form: ~S ." form)
     
    190149                           (arm-lap-macroexpand-1 form)
    191150        (if expanded
    192           (setq current (arm-lap-form expansion current sections))
     151          (arm-lap-form expansion seg)
    193152          (let* ((name (car form)))
    194153            (if (keywordp name)
    195               (setq current (arm-lap-pseudo-op name (cadr form) current sections))
     154              (arm-lap-pseudo-op name (cadr form))
    196155              (case name
    197                 ((progn) (dolist (f (cdr form)) (setq current (arm-lap-form f current sections))))
    198                 ((let) (setq current (arm-lap-equate-form (cadr form) (cddr form) current sections)))
     156                ((progn) (dolist (f (cdr form)) (arm-lap-form f seg)))
     157                ((let) (arm-lap-equate-form (cadr form) (cddr form) seg))
    199158                (t
    200                  (arm::assemble-instruction current form)))))))))
    201   current)
     159                 (arm::assemble-instruction seg form))))))))))
    202160
    203161;;; (let ((name val) ...) &body body)
    204162;;; each "val" gets a chance to be treated as a ARM register name
    205163;;; before being evaluated.
    206 (defun arm-lap-equate-form (eqlist body current sections)
     164(defun arm-lap-equate-form (eqlist body seg)
    207165  (collect ((symbols)
    208166            (values))
     
    226184
    227185    (progv (symbols) (values)
    228       (dolist (form body current)
    229         (setq current (arm-lap-form form current sections)))))))
     186      (dolist (form body)
     187        (arm-lap-form form seg))))))
    230188
    231189
  • branches/arm/compiler/ARM/arm-lapmacros.lisp

    r14108 r14111  
    353353       `((movt ,reg (:$ ,high)))))))
    354354
    355 (defarmlapmacro load-subprim (reg spname)
    356   `(mov ,reg (:$ ,(subprim-name->offset spname))))
     355
    357356
    358357
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r14098 r14111  
    12561256  (fmsr dest imm)
    12571257  (fsitos dest dest)
    1258   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1259   (blx lr))
     1258  (bla .SPcheck-fpu-exception))
    12601259
    12611260(define-arm-vinsn (shift-left-variable-word :predicatable)
     
    14691468  (fmxr fpscr imm)
    14701469  (faddd result x y)
    1471   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1472   (blx lr))
     1470  (bla .SPcheck-fpu-exception))
    14731471
    14741472(define-arm-vinsn (double-float--2 :predicatable)
     
    14871485  (fmxr fpscr imm)
    14881486  (fsubd result x y)
    1489   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1490   (blx lr))
     1487  (bla .SPcheck-fpu-exception))
    14911488
    14921489(define-arm-vinsn (double-float*-2 :predicatable)
     
    15051502  (fmxr fpscr imm)
    15061503  (fmuld result x y)
    1507   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1508   (blx lr))
     1504  (bla .SPcheck-fpu-exception))
    15091505
    15101506(define-arm-vinsn (double-float/-2 :predicatable)
     
    15231519  (fmxr fpscr imm)
    15241520  (fdivd result x y)
    1525   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1526   (blx lr))
     1521  (bla .SPcheck-fpu-exception))
    15271522
    15281523
     
    15501545  (fmxr fpscr imm)
    15511546  (fadds result x y)
    1552   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1553   (blx lr))
     1547  (bla .SPcheck-fpu-exception))
    15541548
    15551549(define-arm-vinsn (single-float--2 :predicatable)
     
    15681562  (fmxr fpscr imm)
    15691563  (fsubs result x y)
    1570   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1571   (blx lr))
     1564  (bla .SPcheck-fpu-exception))
    15721565
    15731566(define-arm-vinsn (single-float*-2 :predicatable)
     
    15861579  (fmxr fpscr imm)
    15871580  (fmuls result x y)
    1588   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1589   (blx lr))
     1581  (bla .SPcheck-fpu-exception))
    15901582
    15911583(define-arm-vinsn (single-float/-2 :predicatable)
     
    16041596  (fmxr fpscr imm)
    16051597  (fdivs result x y)
    1606   (mov lr (:$ (subprim-name->offset '.SPcheck-fpu-exception)))
    1607   (blx lr))
     1598  (bla .SPcheck-fpu-exception))
    16081599
    16091600
     
    18571848(define-arm-vinsn (call-subprim :call :subprim-call) (()
    18581849                                                      ((spno :s32const)))
    1859   (mov lr (:$ spno))
    1860   (blx lr))
     1850  (bla spno))
    18611851
    18621852(define-arm-vinsn (jump-subprim :jumpLR) (()
    1863                                           ((spno :s32const)
    1864                                            (reg :imm)))
    1865   (mov reg (:$ spno))
    1866   (bx reg))
     1853                                          ((spno :s32const)))
     1854  (ba spno))
    18671855
    18681856;;; Same as "call-subprim", but gives us a place to
     
    18701858(define-arm-vinsn (call-subprim-0 :call :subprim-call) (((dest t))
    18711859                                                        ((spno :s32const)))
    1872   (mov lr (:$ spno))
    1873   (blx lr))
     1860  (bla spno))
    18741861
    18751862(define-arm-vinsn (call-subprim-1 :call :subprim-call) (((dest t))
    18761863                                                        ((spno :s32const)
    18771864                                                         (z t)))
    1878   (mov lr (:$ spno))
    1879   (blx lr))
     1865  (bla spno))
    18801866 
    18811867(define-arm-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
     
    18831869                                                         (y t)
    18841870                                                         (z t)))
    1885   (mov lr (:$ spno))
    1886   (blx lr))
     1871  (bla spno))
    18871872
    18881873(define-arm-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
     
    18911876                                                         (y t)
    18921877                                                         (z t)))
    1893   (mov lr (:$ spno))
    1894   (blx lr))
     1878  (bla spno))
    18951879
    18961880
     
    25642548  :done)
    25652549
    2566 (define-arm-vinsn negate-fixnum-overflow-ool (((result (:lisp #.arm::arg_z)))
    2567                                               ((src :imm))
    2568                                               )
     2550(define-arm-vinsn (negate-fixnum-overflow-ool :call :subprim-call)
     2551    (((result (:lisp #.arm::arg_z)))
     2552     ((src :imm))
     2553     )
    25692554  (rsbs arm::arg_z src (:$ 0))
    2570   (movvs lr (:$ (subprim-name->offset '.SPfix-overflow)))
    2571   (blxvs lr))
     2555  (blavs .SPfix-overflow))
    25722556 
    25732557                                                 
     
    25762560    (((dest :lisp))
    25772561     ((src :imm)))
    2578  
    25792562  (rsb dest src (:$ 0)))
    25802563 
     
    27752758                                           ())
    27762759  (adds arm::arg_z x y)
    2777   (movvs lr (:$ (subprim-name->offset '.SPfix-overflow)))
    2778   (blxvs lr))
     2760  (blavs .SPfix-overflow))
    27792761
    27802762(define-arm-vinsn fixnum-add-overflow-inline (((dest :lisp))
     
    28432825      (y :imm)))
    28442826  (subs arm::arg_z x y)
    2845   (movvs lr (:$ (subprim-name->offset '.SPfix-overflow)))
    2846   (blxvs lr))
     2827  (blavs .SPfix-overflow))
    28472828
    28482829(define-arm-vinsn fixnum-sub-overflow-inline (((dest :lisp))
     
    29282909    (((val :lisp))
    29292910     ((sym (:lisp (:ne val)))))
    2930   (mov lr (:$ (subprim-name->offset '.SPspecrefcheck)))
    2931   (blx lr))
     2911  (bla .SPspecrefcheck))
    29322912
    29332913(define-arm-vinsn ref-symbol-value-inline (((dest :lisp))
     
    29492929    (((val :lisp))
    29502930     ((sym (:lisp (:ne val)))))
    2951   (mov lr (:$ (subprim-name->offset '.SPspecref)))
    2952   (blx lr))
     2931  (bla .SPspecref))
    29532932
    29542933(define-arm-vinsn %ref-symbol-value-inline (((dest :lisp))
     
    29692948     ((sym :lisp)
    29702949      (val :lisp)))
    2971   (mov  lr (:$ (subprim-name->offset '.SPspecset)))
    2972   (blx lr))
     2950  (bla .SPspecset))
    29732951
    29742952
     
    30513029  ((:pred > n 1)
    30523030   (mov temp (:$ n))
    3053    (mov lr (:$ (subprim-name->offset '.SPunbind-n))))
     3031   (bla .SPunbind-n))
    30543032  ((:pred = n 1)
    3055    (mov lr (:$ (subprim-name->offset '.SPunbind))))
    3056   (blx lr))
     3033   (bla .SPunbind)))
    30573034
    30583035(define-arm-vinsn (zero-double-float-register :predicatable)
     
    33333310(define-arm-vinsn (default-optionals :call :subprim-call) (()
    33343311                                                           ((n :u16const)))
    3335   (mov lr (:$ (subprim-name->offset '.SPdefault-optional-args)))
    33363312  (mov imm0 (:$ (:apply ash n 2)))
    3337   (blx lr))
     3313  (bla .SPdefault-optional-args))
    33383314
    33393315;;; fname contains a known symbol
     
    35663542(defmacro define-arm-subprim-call-vinsn ((name &rest other-attrs) spno)
    35673543  `(define-arm-vinsn (,name :call :subprim-call ,@other-attrs) (() ())
    3568     (mov lr (:$ (subprim-name->offset ',spno)))
    3569     (blx lr)))
    3570 
    3571 (defmacro define-arm-subprim-jump-vinsn ((name &rest other-attrs) spno &optional (reg 'imm0))
     3544    (bla ,spno)))
     3545
     3546(defmacro define-arm-subprim-jump-vinsn ((name &rest other-attrs) spno &optional)
    35723547  `(define-arm-vinsn (,name  :jumpLR ,@other-attrs) (() ())
    3573     (mov ,reg (:$ (subprim-name->offset ',spno)))
    3574     (bx ,reg)))
     3548    (ba ,spno)))
    35753549
    35763550
     
    36083582(define-arm-vinsn (tail-funcall-vsp :jumpLR :predicatable) (() ())
    36093583  (ldmia (:! sp) (imm0 vsp fn lr))
    3610   (mov imm0 (:$ (subprim-name->offset '.SPfuncall)))
    3611   (bx imm0))
     3584  (ba .SPfuncall))
    36123585
    36133586(define-arm-subprim-call-vinsn (spread-lexpr)  .SPspread-lexprz)
     
    36853658(define-arm-vinsn (nth-value :call :subprim-call) (((result :lisp))
    36863659                                                   ())
    3687   (mov lr (:$ (subprim-name->offset '.SPnthvalue)))
    3688   (blx lr))
     3660  (bla .SPnthvalue))
    36893661
    36903662(define-arm-subprim-call-vinsn (fitvals) .SPfitvals)
     
    37023674(define-arm-vinsn (throw :jump-unknown) (()
    37033675                                         ())
    3704   (mov lr (:$ (subprim-name->offset '.SPthrow)))
    3705   (blx lr))
     3676  (bla .SPthrow))
    37063677
    37073678(define-arm-subprim-call-vinsn (mkcatchmv) .SPmkcatchmv)
  • branches/arm/compiler/ARM/arm2.lisp

    r14099 r14111  
    444444           
    445445               (with-dll-node-freelist (code arm::*lap-instruction-freelist*)
    446                  (with-dll-node-freelist (data arm::*lap-instruction-freelist*)
    447                    (let* ((sections (vector code data))
    448                           (arm::*lap-labels* nil)
    449                           (arm::*last-constant-pool-origin* nil)
     446                   (let* ((arm::*lap-labels* nil)
     447                          (arm::*called-subprim-jmp-labels* nil)
    450448                          debug-info)
    451                      (declare (dynamic-extent sections))
    452                      (arm2-expand-vinsns vinsns code sections)
     449                     (arm2-expand-vinsns vinsns code)
    453450                     (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))
    454451                       (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
     
    474471                           (arm2-xmake-function
    475472                            code
    476                             data
    477473                            *backend-immediates*
    478474                            bits))
     
    480476                       (setf (getf debug-info 'pc-source-map) (arm2-generate-pc-source-map debug-info)))
    481477                     (when (getf debug-info 'function-symbol-map)
    482                        (setf (getf debug-info 'function-symbol-map) (arm2-digest-symbols)))))))
     478                       (setf (getf debug-info 'function-symbol-map) (arm2-digest-symbols))))))
    483479          (backend-remove-labels))))
    484480    afunc))
    485481
    486 (defun arm2-xmake-function (code data imms bits)
     482(defun arm2-xmake-function (code imms bits)
    487483  (collect ((lap-imms))
    488484    (dotimes (i (length imms))
     
    490486    (let* ((arm::*arm-constants* (lap-imms)))
    491487      (arm-lap-generate-code code
    492                              (arm::arm-finalize code data)
     488                             (arm::arm-finalize code)
    493489                             bits))))
    494490
     
    48514847
    48524848
    4853 (defun arm2-expand-vinsns (header current sections)
     4849(defun arm2-expand-vinsns (header seg)
    48544850  (do-dll-nodes (v header)
    48554851    (if (%vinsn-label-p v)
     
    48574853        (if (or (typep id 'fixnum) (null id))
    48584854          (when (or t (vinsn-label-refs v) (null id))
    4859             (setf (vinsn-label-info v) (arm::emit-lap-label current v)))
    4860           (arm2-expand-note current id)))
    4861       (progn
    4862         (setq current (arm2-expand-vinsn v current sections))
    4863         (arm::drain-constant-pool (svref sections 0) (svref sections 1)))))
     4855            (setf (vinsn-label-info v) (arm::emit-lap-label seg v)))
     4856          (arm2-expand-note seg id)))
     4857      (arm2-expand-vinsn v seg)))
    48644858  ;;; This doesn't have too much to do with anything else that's
    48654859  ;;; going on here, but it needs to happen before the lregs
     
    48824876;;; on entry, but it might be reasonable to make PARSE-OPERAND-FORM
    48834877;;; deal with lregs ...
    4884 (defun arm2-expand-vinsn (vinsn current sections)
     4878(defun arm2-expand-vinsn (vinsn seg)
    48854879  (let* ((template (vinsn-template vinsn))
    48864880         (vp (vinsn-variable-parts vinsn))
     
    49154909                            (setq tail (cdr (rplaca tail (parse-operand-form op)))))))))
    49164910             (expand-insn-form (f)
    4917                (case (car f)
    4918                  (:code (setq current (svref sections 0)))
    4919                  (:data (setq current (svref sections 1)))
    4920                  (:word
    4921                   (let* ((insn (arm::make-lap-instruction nil))
    4922                          (val (parse-operand-form (cadr f))))
    4923                     (arm::set-field-value insn (byte 32 0) val)
    4924                     (arm::emit-lap-instruction-element insn current)))
    4925                  (t
    4926                   (let* ((insn (arm::make-lap-instruction nil))
    4927                          (opcode (car f))
    4928                          (operands (cdr f)))
    4929                     (setf (arm::lap-instruction-opcode-high insn) (car opcode)
    4930                           (arm::lap-instruction-opcode-low insn) (cdr opcode))
    4931                     (when predicate
    4932                       (funcall (svref operand-insert-functions
    4933                                       (arm::encode-vinsn-field-type :cond))
    4934                                insn
    4935                                predicate))
    4936                     (dolist (op operands (arm::emit-lap-instruction-element insn current))
    4937                       (let* ((insert-function (svref operand-insert-functions (car op))))
    4938                         (funcall insert-function insn (parse-operand-form (cdr op)))))))))
     4911               (let* ((insn (arm::make-lap-instruction nil))
     4912                      (opcode (car f))
     4913                      (operands (cdr f)))
     4914                 (setf (arm::lap-instruction-opcode-high insn) (car opcode)
     4915                       (arm::lap-instruction-opcode-low insn) (cdr opcode))
     4916                 (when predicate
     4917                   (funcall (svref operand-insert-functions
     4918                                   (arm::encode-vinsn-field-type :cond))
     4919                            insn
     4920                            predicate))
     4921                 (dolist (op operands (arm::emit-lap-instruction-element insn seg))
     4922                   (let* ((insert-function (svref operand-insert-functions (car op))))
     4923                     (funcall insert-function insn (parse-operand-form (cdr op)))))))
    49394924             (eval-predicate (f)
    49404925               (case (car f)
     
    49564941             (expand-form (f)
    49574942               (if (keywordp f)
    4958                  (arm::emit-lap-label current (assq f unique-labels))
     4943                 (arm::emit-lap-label seg (assq f unique-labels))
    49594944                 (if (atom f)
    49604945                   (compiler-bug "Invalid form in vinsn body: ~s" f)
     
    49714956      (setf (vinsn-variable-parts vinsn) nil)
    49724957      (when vp
    4973         (free-varparts-vector vp))
    4974       current)))
     4958        (free-varparts-vector vp)))))
    49754959
    49764960
     
    49994983        (arm2-restore-full-lisp-context seg))
    50004984      (if tail-p
    5001         (! jump-subprim subprim ($ arm::imm0))
     4985        (! jump-subprim subprim)
    50024986        (progn
    50034987          (! call-subprim subprim)
     
    59285912        (arm2-set-nargs seg nargs)))
    59295913    (if tail-p
    5930       (! jump-subprim subprim ($ arm::imm0))
     5914      (! jump-subprim subprim)
    59315915      (progn
    59325916        (! call-subprim subprim)
  • branches/arm/level-0/ARM/arm-array.lisp

    r14104 r14111  
    142142  (beq @word-set-loop)
    143143  @bad
    144   (load-subprim temp0 .SPksignalerr)
    145144  (mov arg_x  '#.$xnotelt)
    146145  (set-nargs 3)
    147   (blx temp0)
     146  (bla .SPksignalerr)
    148147  @fixnum
    149148  (tst val (:$ arm::fixnum-mask))
     
    259258    (add offset offset disp)
    260259    (ble  @loop)
    261     (load-subprim imm0 .SPvalues)
    262260    (mov temp0 vsp)
    263261    (vpush1 a)
    264262    (vpush1 offset)
    265263    (set-nargs 2)
    266     (bx imm0)))
     264    (ba .SPvalues)))
    267265
    268266(defarmlapfunction %boole-clr ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
     
    531529
    532530(defarmlapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
    533   (load-subprim imm0 .SParef2)
    534531  (check-nargs 3)
    535   (bx imm0))
     532  (ba .SParef2))
    536533
    537534(defarmlapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z))
    538   (load-subprim imm0 .SParef3)
    539535  (check-nargs 4)
    540536  (vpop1 temp0)
    541   (bx imm0))
     537  (ba .SParef3))
    542538
    543539
    544540(defarmlapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z))
    545   (load-subprim imm0 .SPaset2)
    546541  (check-nargs 4)
    547542  (vpop1 temp0)
    548   (bx imm0))
     543  (ba .SPaset2))
    549544
    550545(defarmlapfunction %aset3 ((array #.target::node-size) (i 0) (j arg_x) (k arg_y)  (newval arg_z))
    551   (load-subprim imm0 .SPaset3)
    552546  (check-nargs 5)
    553547  (vpop1 temp0)
    554548  (vpop1 temp1)
    555   (bx imm0))
     549  (ba .SPaset3))
    556550 
    557551
  • branches/arm/level-0/ARM/arm-bignum.lisp

    r14104 r14111  
    3232  (digit-h temp0 imm0)
    3333  (digit-l temp1 imm0)
    34   (load-subprim imm0 .SPvalues)
    3534  (vpush1 temp0)
    3635  (vpush1 temp1)
    3736  (add temp0 vsp (:$ 8))                 
    3837  (set-nargs 2)                         
    39   (bx imm0))
     38  (ba .SPvalues))
    4039
    4140
     
    158157    (digit-h temp0 b)
    159158    (digit-l temp1 b)
    160     (load-subprim imm0 .SPvalues)
    161159    (vpush1 temp0)
    162160    (vpush1 temp1)
    163161    (add temp0 vsp '2)
    164162    (set-nargs 2)
    165     (bx imm0)))
     163    (ba .SPvalues)))
    166164
    167165
     
    294292    (digit-h temp0 b)
    295293    (digit-l temp1 b)
    296     (load-subprim imm0 .SPvalues)
    297294    (vpush temp0)
    298295    (vpush temp1)
    299296    (add temp0 vsp (:$ 8))
    300297    (set-nargs 2)
    301     (bx imm0)))
     298    (ba .SPvalues)))
    302299
    303300
     
    334331    (vpush1 temp1)
    335332    (vpush1 c)
    336     (load-subprim imm0 .SPvalues)
    337333    (add temp0 vsp (:$ 20))
    338334    (set-nargs 3)
    339     (bx imm0)))
     335    (ba .SPvalues)))
    340336
    341337
     
    347343    (vpush1 temp0)
    348344    (digit-l temp0 a)
    349     (load-subprim imm0 .SPvalues)
    350345    (vpush1 temp0)
    351346    (add temp0 vsp (:$ 8))
    352347    (set-nargs 2)
    353     (bx imm0)))
     348    (ba .SPvalues)))
    354349
    355350
     
    395390    (digit-h temp2 lo)
    396391    (digit-l arg_z lo)
    397     (load-subprim imm0 .SPvalues)
    398392    (vpush1 temp0)
    399393    (vpush1 temp1)
     
    402396    (set-nargs 4)
    403397    (add temp0 vsp (:$ 16))
    404     (bx imm0)))
     398    (ba .SPvalues)))
    405399
    406400
     
    938932    (vpush1 temp0)
    939933    (digit-l temp0 guess)
    940     (load-subprim imm0 .SPvalues)
    941934    (vpush1 temp0)
    942935    (add temp0 vsp (:$ 20))
    943936    (add sp sp (:$ 32))
    944937    (set-nargs 2)
    945     (bx imm0)))
     938    (ba .SPvalues)))
    946939
    947940(defarmlapfunction normalize-bignum-loop ((sign arg_x)(res arg_y)(len arg_z))
     
    11241117    (vector-length len bignum imm0)
    11251118    (mov imm2 (:$ 0))
    1126     (load-subprim temp1 .SPudiv64by32)
    11271119    (b @next)
    11281120    @loop
     
    11311123    (mov imm1 imm2)
    11321124    (compose-digit imm2 yhi ylo)
    1133     (blx temp1)
     1125    (bla .SPudiv64by32)
    11341126    (add imm1 len (:$ arm::misc-data-offset))
    11351127    (str imm0 (:@ res imm1))
     
    11391131    (digit-h yhi imm2)
    11401132    (digit-l ylo imm2)
    1141     (load-subprim imm0 .SPnvalret)
    11421133    (vpush1 yhi)
    11431134    (vpush1 ylo)
    11441135    (set-nargs 2)
    1145     (bx imm0)))
     1136    (ba .SPnvalret)))
    11461137
    11471138;;; For TRUNCATE-BY-FIXNUM et al.
     
    11521143    (vector-length len x imm0)
    11531144    (mov imm2 (:$ 0))
    1154     (load-subprim temp0 .SPudiv64by32)
    11551145    (b @next)
    11561146    @loop
     
    11591149    (mov imm1 imm2)
    11601150    (compose-digit imm2 yhi ylo)
    1161     (blx temp0)
     1151    (bla .SPudiv64by32)
    11621152    @next
    11631153    (subs len len '1)
     
    11651155    (digit-h yhi imm2)
    11661156    (digit-l ylo imm2)
    1167     (load-subprim imm0 .SPnvalret)
    11681157    (vpush1 yhi)
    11691158    (vpush1 ylo)
    11701159    (set-nargs 2)
    1171     (bx imm0)))
     1160    (ba .SPnvalret)))
    11721161   
    11731162   
     
    12801269  (build-lisp-frame imm0 imm1)
    12811270  (mov fn nfn)
    1282   (load-subprim temp1 .SPnvalret)
    1283   (load-subprim temp2 .SPudiv64by32)
    12841271  (ldr temp0 (:@ vsp (:$ x-stk)))
    12851272  (add imm0 xidx (:$ arm::misc-data-offset))
     
    13001287  (add imm1 imm1 (:$ arm::node-size))
    13011288  (ldr imm1 (:@ temp0 imm1))
    1302   (blx temp2)
     1289  (bla .SPudiv64by32)
    13031290  (mov arg_y '-1)
    13041291  (and arg_y arg_y (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
     
    13081295  (stmdb (:! vsp) (arg_z arg_y))
    13091296  (set-nargs 2)
    1310   (bx temp1))
     1297  (ba .SPnvalret))
    13111298
    13121299;;; Karatsuba multiplication stuff. NYI.
  • branches/arm/level-0/ARM/arm-clos.lisp

    r14104 r14111  
    199199(defarmlapfunction unset-fin-trampoline ()
    200200  (build-lisp-frame)
    201   (load-subprim imm0 .SPheap-rest-arg)
    202   (blx imm0)                ; cons up an &rest arg, vpush it
     201  (bla .SPheap-rest-arg)                 ; cons up an &rest arg, vpush it
    203202  (vpop1 arg_z)                          ; whoops, didn't really want to
    204   (load-subprim imm0 .SPksignalerr)
    205203  (mov arg_x '#.$XNOFINFUNCTION)
    206204  (mov arg_y nfn)
    207205  (set-nargs 3)
    208   (blx imm0)
     206  (bla .SPksignalerr)
    209207  (mov arg_z 'nil)
    210208  (return-lisp-frame))
  • branches/arm/level-0/ARM/arm-def.lisp

    r14104 r14111  
    6969(defarmlapfunction %fixnum-ref-natural ((fixnum arg_y) #| &optional |# (offset arg_z))
    7070  (:arglist (fixnum &optional offset))
    71   (load-subprim imm1 .SPmakeu32)
    7271  (check-nargs 1 2)
    7372  (cmp nargs '1)
     
    7675  (unbox-fixnum imm0 offset)
    7776  (ldr imm0 (:@ imm0 fixnum))
    78   (bx imm1))
     77  (ba .SPmakeu32))
    7978
    8079
     
    206205  (cmp imm0 (:$ arm::subtag-function))
    207206  (ldr lr (:@ p (:$ arm::lisp-frame.savelr)))
    208   (load-subprim temp0 .SPnvalret)
    209207  (bne @no)
    210208  (ldr arg_x (:@ arg_y (:$ (+ arm::node-size arm::misc-data-offset))))
     
    220218  @go
    221219  (set-nargs 2)
    222   (bx temp0)
     220  (ba .SPnvalret)
    223221  @no
    224222  (mov imm0 'nil)
     
    958956      (bx lr)
    959957      @unsigned-doubleword
    960       (load-subprim temp0 .SPmakeu64)
    961       (bx temp0)
     958      (ba .SPmakeu64)
    962959      @signed-doubleword
    963       (load-subprim temp0 .SPmakes64)
    964       (bx temp0))
     960      (ba .SPmakes64))
    965961
    966962  ;;; This is just here so that we can jump to a subprim from lisp.
     
    11171113  (mov arm::next-method-context magic)
    11181114  (mov arm::nfn function)
    1119   (load-subprim temp0 .SPspread-lexprz)
    11201115  (set-nargs 0)
    11211116  (build-lisp-frame)
    1122   (blx temp0)
     1117  (bla .SPspread-lexprz)
    11231118  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
    11241119  ;; Nothing's changed FN.
     
    11391134  (mov arm::next-method-context magic)
    11401135  (mov arm::nfn function)
    1141   (load-subprim temp0 .SPspreadargZ)
    11421136  (set-nargs 0)
    11431137  (build-lisp-frame)
    1144   (blx temp0)
     1138  (bla .SPspreadargZ)
    11451139  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
    11461140  ;; Nothing's changed FN.
     
    12221216  (sub nargs nargs '2)                  ; remove count for butlast & last
    12231217  (build-lisp-frame)
    1224   (load-subprim imm0 .SPspreadargz)
    1225   (blx imm0)
     1218  (bla .SPspreadargz)
    12261219  (cmp nargs '3)
    12271220  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
    12281221  (discard-lisp-frame)
    1229   (load-subprim imm0 .SPfuncall)
    12301222  (add nargs nargs '1)                  ; count for last
    12311223  (strhs arg_x (:@! vsp (:$ -4)))
     
    12341226  (mov arg_z temp0)
    12351227  (ldr nfn (:@ nfn 'funcall))
    1236   (bx imm0))
     1228  (ba .SPfuncall))
    12371229
    12381230
  • branches/arm/level-0/ARM/arm-float.lisp

    r14104 r14111  
    110110  (vpush1 imm0)   ; hi 25 bits of mantissa (includes implied 1)
    111111  (vpush1 imm1)   ; lo 28 bits of mantissa
    112   (load-subprim imm0 .SPvalues)
    113112  (vpush1 temp1)  ; exp
    114113  (vpush1 temp0)  ; sign
    115114  (set-nargs 4)
    116115  (add temp0 vsp '4)
    117   (bx imm0))
     116  (ba .SPvalues))
    118117
    119118
     
    532531(defarmlapfunction %single-float-sqrt! ((src arg_y) (dest arg_z))
    533532  (build-lisp-frame)
    534   (load-subprim temp0 .SPcheck-fpu-exception)
    535533  (get-single-float s0 src imm0)
    536534  (fmrx imm0 fpscr)
     
    538536  (fmxr fpscr imm0)
    539537  (fsqrts s1 s0)
    540   (blx temp0)
     538  (bla .SPcheck-fpu-exception)
    541539  (put-single-float s1 dest imm0)
    542540  (return-lisp-frame))
     
    546544(defarmlapfunction %double-float-sqrt! ((src arg_y) (dest arg_z))
    547545  (build-lisp-frame)
    548   (load-subprim temp0 .SPcheck-fpu-exception)
    549546  (get-double-float d0 src)
    550547  (fmrx imm0 fpscr)
     
    552549  (fmxr fpscr imm0)
    553550  (fsqrtd d1 d0)
    554   (blx temp0)
     551  (bla .SPcheck-fpu-exception)
    555552  (put-double-float d1 dest)
    556553  (return-lisp-frame))
  • branches/arm/level-0/ARM/arm-hash.lisp

    r14104 r14111  
    3030(defarmlapfunction fast-mod ((number arg_y) (divisor arg_z))
    3131  (build-lisp-frame imm0)
    32   (load-subprim temp0 .SPudiv32)
    3332  (mov imm0 (:lsr number (:$ arm::fixnumshift)))
    3433  (mov imm1 (:lsr divisor (:$ arm::fixnumshift)))
    35   (blx temp0)
     34  (bla .SPudiv32)
    3635  (box-fixnum arg_z imm1)
    3736  (return-lisp-frame imm0))
     
    106105;;; ensure that the vector header gets memoized as well
    107106(defarmlapfunction %set-hash-table-vector-key ((vector arg_x) (index arg_y) (value arg_z))
    108   (load-subprim imm0 .SPset-hash-key)
    109   (bx imm0))
     107  (ba .SPset-hash-key))
    110108
    111109(defarmlapfunction %set-hash-table-vector-key-conditional ((offset 0) (vector arg_x) (old arg_y) (new arg_z))
    112   (load-subprim imm0 .SPset-hash-key-conditional)
    113   (bx imm0))
     110  (ba .SPset-hash-key-conditional))
    114111
    115112;;; Strip the tag bits to turn x into a fixnum
  • branches/arm/level-0/ARM/arm-misc.lisp

    r14104 r14111  
    200200
    201201(defarmlapfunction %heap-bytes-allocated ()
    202   (load-subprim temp0 .SPmakeu64)
    203202  (ldr imm2 (:@ rcontext (:$ arm::tcr.last-allocptr)))
    204203  (ldr imm1 (:@ rcontext (:$ arm::tcr.total-bytes-allocated-high)))
     
    212211  (adc imm1 imm1 (:$ 0))
    213212  @go
    214   (bx temp0))
     213  (ba .SPmakeu64))
    215214
    216215
     
    219218(defarmlapfunction values ()
    220219  (:arglist (&rest values))
    221   (load-subprim imm0 .SPvalues)
    222220  (vpush-argregs)
    223221  (add temp0 nargs vsp)
    224   (bx imm0))
     222  (ba .SPvalues))
    225223
    226224;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
     
    241239
    242240(defarmlapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
    243   (load-subprim temp0 .SPmakeu64)
    244241  (trap-unless-xtype= ptr arm::subtag-macptr)
    245242  (macptr-ptr imm1 ptr)
     
    248245  (ldr imm0 (:@ imm2 (:$ 0)))
    249246  (ldr imm1 (:@ imm2 (:$ 4)))
    250   (bx temp0))
     247  (ba .SPmakeu64))
    251248
    252249
    253250
    254251(defarmlapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
    255   (load-subprim temp0 .SPmakes64)
    256252  (trap-unless-xtype= ptr arm::subtag-macptr)
    257253  (macptr-ptr imm1 ptr)
     
    260256  (ldr imm0 (:@ imm2 (:$ 0)))           ;low
    261257  (ldr imm1 (:@ imm2 (:$ 1)))           ;high
    262   (bx temp0))
     258  (ba .SPmakes64))
    263259
    264260
     
    267263                                            (offset arg_y)
    268264                                            (val arg_z))
    269   (load-subprim temp0 .SPgetu64)
    270265  (build-lisp-frame imm0)
    271266  (mov fn nfn)
    272267  (trap-unless-xtype= ptr arm::subtag-macptr)
    273   (blx temp0)
     268  (bla .SPgetu64)
    274269  (macptr-ptr imm2 ptr)
    275270  (add imm2 imm2 (:asr offset (:$ arm::fixnumshift)))
     
    283278                                          (offset arg_y)
    284279                                          (val arg_z))
    285   (load-subprim temp0 .SPgets64)
    286280  (build-lisp-frame imm0)
    287281  (mov fn nfn)
    288282  (trap-unless-xtype= ptr arm::subtag-macptr)
    289   (blx temp0)
     283  (bla .SPgets64)
    290284  (macptr-ptr imm2 ptr)
    291285  (add imm2 imm2 (:asr offset (:$ arm::fixnumshift)))
     
    345339;;; This needs to be done out-of-line, to handle EGC memoization.
    346340(defarmlapfunction %store-node-conditional ((offset 0) (object arg_x) (old arg_y) (new arg_z))
    347   (load-subprim temp0 .SPstore-node-conditional)
    348   (bx temp0))
     341  (ba .SPstore-node-conditional))
    349342
    350343#+notyet                                ; needs a subprim on ARM
     
    420413
    421414(defarmlapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
    422   (load-subprim imm0 .SPatomic-incf-node)
    423   (bx imm0))
     415  (ba .SPatomic-incf-node))
    424416
    425417(defarmlapfunction %atomic-incf-ptr ((ptr arg_z))
  • branches/arm/level-0/ARM/arm-numbers.lisp

    r14108 r14111  
    6262  (digit-h temp0 imm0)
    6363  (digit-l temp1 imm0)
    64   (load-subprim imm0 .SPvalues)
    6564  (vpush1 temp0)
    6665  (vpush1 temp1)
    6766  (add temp0 vsp '2)
    6867  (set-nargs 2)
    69   (bx imm0))
     68  (ba .SPvalues))
    7069
    7170
     
    140139        (remainder arg_z))
    141140    (build-lisp-frame)
    142     (load-subprim temp0 .SPsdiv32)
    143     (load-subprim temp1 .SPnvalret)
    144141    (mov fn nfn)
    145142    (cmp divisor '-1)   
     
    147144    (unbox-fixnum unboxed-divisor divisor)
    148145    (beq @neg)
    149     (blx temp0)
     146    (bla .SPsdiv32)
    150147    (box-fixnum quotient unboxed-quotient)
    151148    (box-fixnum remainder unboxed-remainder)
    152149    (stmdb (:! vsp) (quotient remainder))
    153150    (set-nargs 2)
    154     (bx temp1)
     151    (ba .SPnvalret)
    155152    @neg
    156153    (ldr arg_z (:@ fn '*least-positive-bignum*))
     
    162159    (vpush1 temp0)
    163160    (set-nargs 2)
    164     (bx temp1)))
     161    (ba .SPnvalret)))
    165162
    166163
  • branches/arm/level-0/ARM/arm-symbol.lisp

    r14104 r14111  
    6868
    6969(defarmlapfunction %symptr-value ((symptr arg_z))
    70   (load-subprim imm0 .SPspecref)
    71   (bx imm0))
     70  (ba .SPspecref))
    7271
    7372(defarmlapfunction %set-symptr-value ((symptr arg_y) (val arg_z))
    74   (load-subprim imm0 .SPspecset)
    75   (bx imm0))
     73  (ba .SPspecset))
    7674
    7775(defarmlapfunction %symptr-binding-address ((symptr arg_z))
     
    8482  (cmp temp0 (:$ arm::subtag-no-thread-local-binding))
    8583  (unbox-fixnum imm0 imm0)
    86   (load-subprim temp1 .SPvalues)
    8784  (beq @sym)
    8885  (vpush1 imm1)
     
    9087  (set-nargs 2)
    9188  (add temp0 vsp '2)
    92   (bx temp1)
     89  (ba .SPvalues)
    9390  @sym
    9491  (mov arg_y '#.arm::symbol.vcell)
     
    9794  (set-nargs 2)
    9895  (add temp0 vsp '2)
    99   (bx temp1))
     96  (ba .SPvalues))
    10097
    10198(defarmlapfunction %tcr-binding-location ((tcr arg_y) (sym arg_z))
  • branches/arm/level-0/ARM/arm-utils.lisp

    r14104 r14111  
    2222  ;; %address-of anything else is the address of that thing as an integer.
    2323  (test-fixnum arg)
    24   (load-subprim imm1 .SPmakeu32)
    2524  (mov imm0 arg_z)
    2625  (bxeq lr)
     
    2827  (box-fixnum arg_z imm0)               ; assume it did
    2928  (bxeq lr)                             ; else arg_z tagged ok, but missing bits
    30   (bx imm1)         ; put all bits in bignum.
     29  (ba .SPmakeu32)         ; put all bits in bignum.
    3130)
    3231
     
    112111    (set-nargs 1)
    113112    (stmdb (:! vsp) (fun obj limit))
    114     (load-subprim imm1 .SPfuncall)
    115113    (mov nfn fun)
    116     (blx imm1)
     114    (bla .SPfuncall)
    117115    (ldmia (:! vsp) (fun obj limit))
    118116    (add obj obj (:$ arm::cons.size))
     
    121119    (add arg_z obj (:$ arm::fulltag-misc))
    122120    (stmdb (:! vsp) (fun obj limit))
    123     (load-subprim imm1 .SPfuncall)
    124121    (set-nargs 1)
    125122    (mov nfn fun)
    126     (blx imm1)
     123    (bla .SPfuncall)
    127124    (ldmia (:! vsp) (fun obj limit))
    128125    (ldr header (:@ obj (:$ 0)))
     
    209206    (bhs @done)
    210207    (set-nargs 1)
    211     (load-subprim imm1 .SPfuncall)
    212208    (stmdb (:! vsp) (arg_z fun sentinel))
    213209    (mov nfn fun)
    214     (blx imm1)
     210    (bla .SPfuncall)
    215211    (ldmia (:! vsp) (obj fun sentinel))
    216212    (add obj obj (:$ (- arm::cons.size arm::fulltag-cons)))
     
    219215    (add arg_z obj (:$ arm::fulltag-misc))
    220216    (stmdb (:! vsp) (arg_z fun sentinel))
    221     (load-subprim imm1 .SPfuncall)
    222217    (set-nargs 1)
    223218    (mov nfn fun)
    224     (blx imm1)
     219    (bla .SPfuncall)
    225220    (ldmia (:! vsp) (obj fun sentinel))
    226221    (sub obj obj (:$ arm::fulltag-misc))
     
    332327  (mov fn nfn)
    333328  (uuo-kernel-service (:? al) (:$ arch::error-allocate-list))
    334   (load-subprim imm0 .SPnvalret)
    335329  (vpush1 arg_z)
    336330  (vpush1 arg_y)
    337331  (set-nargs 2)
    338   (bx imm0))
     332  (ba .SPnvalret))
    339333
    340334
     
    380374  (mov imm0 (:$ arch::gc-trap-function-get-lisp-heap-threshold))
    381375  (uuo-gc-trap (:? al))
    382   (load-subprim imm1 .SPmakeu32)
    383   (bx imm1))
     376  (ba .SPmakeu32))
    384377
    385378(defarmlapfunction set-lisp-heap-gc-threshold ((new arg_z))
     
    390383  (check-nargs 1)
    391384  (build-lisp-frame)
    392   (load-subprim imm0 .SPgetu32)
    393   (blx imm0)
     385  (bla .SPgetu32)
    394386  (mov imm1 imm0)
    395387  (mov imm0 (:$ arch::gc-trap-function-set-lisp-heap-threshold))
    396   (load-subprim temp0 .SPmakeu32)
    397388  (uuo-gc-trap (:? al))
    398389  (restore-lisp-frame imm1)
    399   (bx temp0))
     390  (ba .SPmakeu32))
    400391
    401392
     
    412403  "Do a full GC, then consider all heap-allocated objects which survive to be non-relocatable."
    413404  (check-nargs 0)
    414   (load-subprim temp0 .SPmakeu32)
    415405  (mov imm0 (:$ arch::gc-trap-function-freeze))
    416406  (uuo-gc-trap (:? al))
    417   (bx temp0))
     407  (ba .SPmakeu32))
    418408
    419409(defarmlapfunction flash-freeze ()
    420410  "Like FREEZE, but don't GC first."
    421411  (check-nargs 0)
    422   (load-subprim temp0 .SPmakeu32)
    423412  (mov imm0 (:$ arch::gc-trap-function-flash-freeze))
    424413  (uuo-gc-trap (:? al))
    425   (bx temp0))
     414  (ba .SPmakeu32))
    426415
    427416(defun %watch (uvector)
  • branches/arm/level-1/arm-callback-support.lisp

    r14103 r14111  
    2323                 (uvref (uvref (compile nil `(lambda (&lap 0) (arm-lap-function () ((?? 0)) ,instruction-form))) 1) 0)))
    2424      (setf (%get-unsigned-long p 0)
    25             (arm-lap-word (mov r12 (:$ #.(subprim-name->offset '.SPeabi-callback))))
    26             (%get-unsigned-long p 4)
    27             (arm-lap-word (push1 r12 sp))
    28             (%get-unsigned-long p 8)
    2925            (dpb (ldb (byte 12 0) index)
    3026                 (byte 12 0)
    3127                 (dpb (ldb (byte 4 12) index)
    3228                      (byte 4 16)
    33                       (arm-lap-word (movw r12 (:$ 0)))))
    34 
    35             (%get-unsigned-long p 12)
    36             (arm-lap-word (pop1 pc sp)))
     29                      (arm-lap-word (movw r12 (:$ ??)))))
     30            (%get-unsigned-long p 4)
     31            (arm-lap-word (ldr pc (:@ pc (:$ -4))))
     32            (%get-unsigned-long p 8)
     33             #.(subprim-name->offset '.SPeabi-callback))
    3734      (ff-call (%kernel-import #.arm::kernel-import-makedataexecutable)
    3835               :address p
    39                :unsigned-fullword 16
     36               :unsigned-fullword 12
    4037               :void)
    4138      p)))
  • branches/arm/xdump/xarmfasload.lisp

    r14102 r14111  
    2626
    2727(defun xload-arm-lap-word (instruction-form)
    28   (uvref (uvref (compile nil
    29                          `(lambda (&lap 0)
    30                            (arm-lap-function () ((?? 0))
    31                             ,instruction-form)))
     28  (if (listp instruction-form)
     29    (uvref (uvref (compile nil
     30                           `(lambda (&lap 0)
     31                             (arm-lap-function () ((?? 0))
     32                              ,instruction-form)))
    3233                  1)
    33          0))
     34           0)
     35    instruction-form))
    3436
    3537(defparameter *arm-macro-apply-code*
    36   (let* ((code '((load-subprim temp0 .SPheap-rest-arg)
    37                  (build-lisp-frame imm0)
    38                  (blx temp0)
    39                  (vpop1 arg_z)
    40                  (load-subprim temp0 .SPksignalerr)
    41                  (mov arg_y fname)
    42                  (mov arg_x '#.$xnotfun)
    43                  (set-nargs 3)
    44                  (bx temp0))))
    45     (make-array (length code)
    46                 :element-type '(unsigned-byte 32)
    47                 :initial-contents
    48                 (mapcar #'xload-arm-lap-word code))))
     38  (let* ((code-vector (uvref (compile nil
     39          '(lambda (&lap 0)
     40            (arm-lap-function () ()
     41             (build-lisp-frame imm0)
     42             (bla .SPheap-rest-arg)
     43             (vpop1 arg_z)
     44             (mov arg_y fname)
     45             (mov arg_x '#.$xnotfun)
     46             (set-nargs 3)
     47             (ba .SPksignalerr))))
     48                             1))
     49         (n (uvsize code-vector))
     50         (u32-vector (make-array n
     51                                 :element-type '(unsigned-byte 32))))
     52    (declare (fixnum n))
     53    (dotimes (i n u32-vector)
     54      (setf (uvref u32-vector i)
     55            (uvref code-vector i)))))
    4956
    5057
     
    5461
    5562(defparameter *arm-closure-trampoline-code*
    56   (let* ((code '((load-subprim imm0 .SPcall-closure)
    57                  (bx imm0))))
    58     (make-array (length code)
     63  (let* ((code0 (xload-arm-lap-word '(ldr pc (:@ pc (:$ 4))))))
     64    (make-array 4
    5965                :element-type '(unsigned-byte 32)
    6066                :initial-contents
    61                 (mapcar #'xload-arm-lap-word code))))
     67                (list code0 0 3 (arm::arm-subprimitive-address '.SPcall-closure)))))
    6268
    6369
Note: See TracChangeset for help on using the changeset viewer.