Changeset 15849


Ignore:
Timestamp:
Jun 26, 2013, 8:40:03 PM (6 years ago)
Author:
gb
Message:

Change handling of inline constants ("the constant pool") in ARM
backend.

Recognize that offsets in floating-point loads are limited to 10 bits.

Don't support :DRAIN-CONSTANT-POOL vinsn directive; replace with
:LOCK-CONSTANT-POOL/:UNLOCK-CONSTANT-POOL, which control the automatic
draining of the constant pool when an unconditional control-transfer
instruction is generated. (This is intended to "protect" things like
jump tables that generate such instructions but don't want to have
floating-point constants embedded in the instruction stream.)

Don't support a "force" argument to ARM-DRAIN-CONSTANT-POOL.

If a constant would be too far away from its referencing instruction
if it was appended to the (current) code segment, embed it at the point
of reference, e.g.

  (fldd d1,:= @x)
  (b 1f)
...
@x (:word ...) (:word)
1:

Fixes ticket:1087 in the trunk.

Location:
trunk/source/compiler
Files:
6 edited

Legend:

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

    r15607 r15849  
    17061706                     (set-field-value insn (byte 1 23) 1)
    17071707                     (setq diff-in-bytes (- diff-in-bytes)))
    1708                    (when (> (integer-length diff-in-bytes) 12)
     1708                   (when (> (integer-length diff-in-bytes) (if (eq reftype :fpmem) 10 12))
    17091709                     (error "PC-relative displacement can't be encoded."))
    17101710                   (if (eq reftype :fpmem)
  • trunk/source/compiler/ARM/arm-backend.lisp

    r15431 r15849  
    168168                               (if (keywordp opname)
    169169                                 (ecase opname
    170                                    ((:code :data :drain-constant-pool)  form)
     170                                   ((:code :data :lock-constant-pool :unlock-constant-pool)  form)
    171171                                   (:word (destructuring-bind (val) opvals
    172172                                            (list opname
  • trunk/source/compiler/ARM/arm-lap.lisp

    r15425 r15849  
    141141      constants-vector)))
    142142
    143 ;;; This can be called as a result of a :DRAIN-CONSTANT-POOL directive
    144 ;;; or at the end of a function. In either case, it shouldn't be possible
    145 ;;; for code to reach the point where the constants are appended to
    146 ;;; the primary section.
    147 (defun arm-drain-constant-pool (primary constants &optional force)
    148   (let* ((constants-size (arm::section-size constants)))
    149     (unless (= constants-size 0)
    150       (let* ((force-label-name (when force (gensym))))
    151         (when force
    152           (arm::assemble-instruction primary `(b ,force-label-name)))
    153         (when (logtest 7 (arm::section-size primary))
    154           (arm::assemble-instruction primary '(nop)))
    155         (let* ((marker (arm::make-lap-instruction nil))
    156                (code-count (arm::make-lap-instruction nil))
    157                (constant-count (arm::make-lap-instruction nil)))
    158           (arm::emit-lap-instruction-element marker primary)
    159           (arm::emit-lap-instruction-element code-count primary)
    160           (arm::set-field-value code-count (byte 32 0) (ash (arm::section-size primary) -2))
    161           (arm::emit-lap-instruction-element constant-count primary)
    162           (arm::set-field-value constant-count (byte 32 0) (ash (arm::section-size constants) -2))
    163           (do-dll-nodes (element constants)
    164             (remove-dll-node element)
    165             (arm::emit-lap-instruction-element element primary))
    166           (when force (arm::emit-lap-label primary force-label-name))
    167           t)))))
     143;;; Iterate until the constants pool is empty or until all constant references
     144;;; would be "near enough" to the constants that they reference if the
     145;;; constants that they reference were appended to the primary section.
     146;;; If a referenced constant is too far away from the point of reference,
     147;;; embed the constant in the code right after the reference and jump
     148;;; around it, then adjust element addresses and try again.
     149;;; This assumes that each constant is referenced exactly once.
     150(defun arm-drain-constant-pool (primary constants)
     151  (loop
     152    (when (eq (dll-header-first constants) constants)
     153      (return))
     154    (let* ((primary-size (arm::section-size primary))
     155           (label-offset (+ primary-size 12 (if (logtest 7 primary-size) 4 0))))
     156      (collect ((data-label-offsets))
     157        (do-dll-nodes (node constants)
     158          (if (typep node 'arm::lap-label)
     159            (data-label-offsets (cons node label-offset))
     160            (incf label-offset (arm::instruction-element-size node))))
     161        (let* ((tentative-data-labels (data-label-offsets))
     162               (first-outlier nil))
     163          (dolist (pair tentative-data-labels)
     164            (destructuring-bind (label . tentative-addr) pair
     165              (unless (dolist (ref (arm::lap-label-refs label) t)
     166                        (destructuring-bind (insn . type) ref
     167                          (let* ((insn-addr (arm::instruction-element-address insn)))
     168                            (when (> (- tentative-addr insn-addr)
     169                                     (ecase type
     170                                       (:mem12 4095)
     171                                       (:fpmem 1023)))
     172                              (setq first-outlier label)
     173                              (return nil)))))
     174                        (return nil))))
     175            (cond ((not first-outlier)
     176                   (when (logtest 7 primary-size)
     177                     (arm::assemble-instruction primary '(nop)))
     178                   (let* ((marker (arm::make-lap-instruction nil))
     179                          (code-count (arm::make-lap-instruction nil))
     180                          (constant-count (arm::make-lap-instruction nil)))
     181                     (arm::emit-lap-instruction-element marker primary)
     182                     (arm::emit-lap-instruction-element code-count primary)
     183                     (arm::set-field-value code-count (byte 32 0) (ash (arm::section-size primary) -2))
     184                     (arm::emit-lap-instruction-element constant-count primary)
     185                     (arm::set-field-value constant-count (byte 32 0) (ash (arm::section-size constants) -2))
     186                     (do-dll-nodes (element constants)
     187                       (remove-dll-node element)
     188                       (arm::emit-lap-instruction-element element primary))
     189                     (return t)))
     190                  (t (let* ((ref (caar (arm::lap-label-refs first-outlier)))
     191                            (trailing-instructions (make-dll-header))
     192                            (next (arm::lap-instruction-succ ref))
     193                            (last (dll-header-last primary))
     194                            (after-data-label-name (gensym)))
     195                       (remove-dll-node-list next last)
     196                       (insert-dll-node-after next trailing-instructions last)
     197                       (arm::assemble-instruction primary `(b ,after-data-label-name))
     198                       (when (logtest 7 (arm::section-size primary))
     199                         (arm::assemble-instruction primary '(nop)))
     200                       (let* ((marker (arm::make-lap-instruction nil))
     201                              (code-count (arm::make-lap-instruction nil))
     202                              (constant-count (arm::make-lap-instruction nil))
     203                              (constant-bytes 0)
     204                              (node first-outlier)
     205                              (succ (dll-node-succ node)))
     206                         (arm::emit-lap-instruction-element marker primary)
     207                         (arm::emit-lap-instruction-element code-count primary)
     208                         (arm::set-field-value code-count (byte 32 0) (ash (arm::section-size primary) -2))
     209                         (arm::emit-lap-instruction-element constant-count primary)
     210                         (loop
     211                           (remove-dll-node node)
     212                           (arm::emit-lap-instruction-element node primary)
     213                           (incf constant-bytes (arm::instruction-element-size node))
     214                           (if (or (eq succ constants)
     215                                   (typep succ 'arm::lap-label))
     216                             (return)
     217                             (setq node succ
     218                                   succ (dll-node-succ node))))
     219                         (arm::set-field-value constant-count (byte 32 0) (ash constant-bytes -2))
     220                         (arm::emit-lap-label primary after-data-label-name)
     221                         (arm::set-element-addresses 0 constants)
     222                         (arm::set-element-addresses (arm::section-size primary) trailing-instructions)
     223                         (remove-dll-node-list next last)
     224                         (insert-dll-node-after next (dll-header-last primary) last))))))))))
    168225
    169226 
  • trunk/source/compiler/ARM/arm-vinsns.lisp

    r15495 r15849  
    4444  (:code))
    4545
    46 (define-arm-vinsn (pop-nvfprs :push :multiple :doubleword :csp :predicatable)
     46(define-arm-vinsn (pop-nvfprs :pop :multiple :doubleword :csp :predicatable)
    4747    (()
    4848     ((n :u16const))
     
    20562056  (b label))
    20572057
     2058(define-arm-vinsn lock-constant-pool (()
     2059                                      ())
     2060  (:lock-constant-pool))
     2061
     2062(define-arm-vinsn unlock-constant-pool (()
     2063                                      ())
     2064  (:unlock-constant-pool))
    20582065
    20592066(define-arm-vinsn (skip-unless-fixnum-in-range :branch)
     
    20622069      (minval :s32const)
    20632070      (maxval :u32const)
     2071
     2072
    20642073      (default :label))
    20652074     ((temp :s32)))
    2066   (:drain-constant-pool)
    20672075  (tst reg (:$ arm::fixnummask))
    20682076  (mov idx (:asr reg (:$  arm::fixnumshift)))
  • trunk/source/compiler/ARM/arm2.lisp

    r15607 r15849  
    3636(defparameter *arm2-target-half-fixnum-type* nil)
    3737(defparameter *arm2-operator-supports-u8-target* ())
    38 
     38(defparameter *arm2-autodrain-constant-pool* ())
    3939
    4040
     
    439439           (*arm2-fcells* (afunc-fcells afunc))
    440440           *arm2-recorded-symbols*
     441           (*arm2-autodrain-constant-pool* t)
    441442           (*arm2-emitted-source-notes* '())
    442443           (*arm2-gpr-locations-valid-mask* 0)
     
    53835384                          (expand-insn-form (list (cons (ldb (byte 16 16) val)
    53845385                                                        (ldb (byte 16 0) val))))))
    5385                  (:drain-constant-pool
    5386                   (arm-drain-constant-pool code data t))
     5386                 (:lock-constant-pool (setq *arm2-autodrain-constant-pool* nil))
     5387                 (:unlock-constant-pool (setq *arm2-autodrain-constant-pool* t))
    53875388                 (t
    53885389                 
     
    54035404                    ;; and we have data in the constant pool, drain the pool.
    54045405                    (when (and (eql current code)
    5405                                (not (eq (dll-header-succ data) data)))
     5406                               (not (eq (dll-header-succ data) data))
     5407                               *arm2-autodrain-constant-pool*)
    54065408                      (let* ((high (arm::lap-instruction-opcode-high insn)))
    54075409                        (declare (type (unsigned-byte 16) high))
     
    66016603                                           (eql (length labeled-trueforms) 1))))
    66026604                  (let* ((reg (arm2-one-untargeted-reg-form seg (make-acode (%nx1-operator lexical-reference) var) arm::arg_z)))
     6605                    (! lock-constant-pool)
    66036606                    (with-imm-target () (idx :u32)
    66046607                      (! skip-unless-fixnum-in-range idx reg min span  (aref *backend-labels* defaultlabel))
     
    66116614                          (let* ((info (assoc val all)))
    66126615                            (! non-barrier-jump (aref *backend-labels* (if info (cadr info) defaultlabel))))))
     6616                      (! unlock-constant-pool)
    66136617                      (let* ((target (if (arm2-mvpass-p xfer)
    66146618                                       (logior $backend-mvpass-mask endlabel)
     
    79737977         (mv-pass (arm2-mv-p xfer)))
    79747978    (arm2-one-targeted-reg-form seg tag ($ arm::arg_z))
     7979    (! lock-constant-pool)
    79757980    (if mv-pass
    79767981      (! mkcatchmv)
    79777982      (! mkcatch1v))
    79787983    (! non-barrier-jump (aref *backend-labels* tag-label))
     7984    (! unlock-constant-pool)
    79797985    (arm2-open-undo)
    79807986    (if mv-pass
     
    85188524         (old-stack (arm2-encode-stack))
    85198525         (ilevel '*interrupt-level*))
     8526    (! lock-constant-pool)
    85208527    (! nmkunwind)
    85218528    (arm2-open-undo $undointerruptlevel)
     
    85268533    (! non-barrier-jump (aref *backend-labels* cleanup-label))
    85278534    (-> protform-label)
     8535    (! unlock-constant-pool)
    85288536    (@ cleanup-label)
    85298537    (let* ((*arm2-vstack* *arm2-vstack*)
     
    85548562         (old-stack (arm2-encode-stack)))
    85558563    (arm2-two-targeted-reg-forms seg symbols ($ arm::arg_y) values ($ arm::arg_z))
     8564    (! lock-constant-pool)
    85568565    (! progvsave)                       ;creates an unwind-protect
    85578566    (arm2-open-undo $undostkblk)
    85588567    (! non-barrier-jump (aref *backend-labels* cleanup-label))
    85598568    (-> protform-label)
     8569    (! unlock-constant-pool)
    85608570    (@ cleanup-label)
    85618571    (! progvrestore)
  • trunk/source/compiler/dll-node.lisp

    r13067 r15849  
    6161          (dll-node-succ node) header
    6262          (dll-node-succ last) node)))
     63
     64(defun remove-dll-node-list (head tail)
     65  (let* ((prev (dll-node-pred head))
     66         (after (dll-node-succ tail)))
     67    (setf (dll-node-pred after) prev
     68          (dll-node-succ prev) after
     69          (dll-node-pred head) nil
     70          (dll-node-succ tail) nil)))
     71
    6372
    6473;;; Splice one or more nodes out of the containing doubly-linked list.
Note: See TracChangeset for help on using the changeset viewer.