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.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.