Changeset 13981


Ignore:
Timestamp:
Jul 19, 2010, 2:38:15 PM (9 years ago)
Author:
gb
Message:

Use ARM::EMIT-LAP-INSTRUCTION-ELEMENTS (rather than
CCL::APPEND-DLL-NODE) to add lap instructions/labels to the
doubly-linked list. (ARM::EMIT-LAP-INSTRUCTION-ELEMENT incrementally
updates the label/instruction's tentative address, which is hopefully
faster than calculating it on every call to DRAIN-CONSTANT-POOL.)

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

Legend:

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

    r13968 r13981  
    12961296      (%make-lap-instruction form))))
    12971297
     1298(defun emit-lap-instruction-element (insn seg)
     1299  (ccl::append-dll-node insn seg)
     1300  (let* ((addr (let* ((prev (ccl::dll-node-pred insn)))
     1301                 (if (eq prev seg)
     1302                   0
     1303                   (the fixnum (+ (the fixnum (instruction-element-address prev))
     1304                                  (the fixnum (instruction-element-size prev))))))))
     1305    (setf (instruction-element-address insn) addr))
     1306  insn)
     1307 
    12981308;;; FORM is a list and its car isn't a pseudo-op or lapmacro; try to
    12991309;;; generate an instruction.
     
    13321342            (setf (lap-instruction-opcode insn)
    13331343                  (dpb cond (byte 4 28) (lap-instruction-opcode insn))))
    1334           (ccl::append-dll-node insn seg))))))
     1344          (emit-lap-instruction-element insn seg))))))
    13351345
    13361346;;; A label can only be emitted once.  Once it's been emitted, its pred/succ
     
    13791389        (error "Label ~s: multiply defined." name))
    13801390      (setq lab (make-lap-label name)))
    1381     (ccl::append-dll-node lab seg)))
     1391    (emit-lap-instruction-element lab seg)))
    13821392
    13831393(defmacro do-lap-labels ((lab &optional result) &body body)
     
    13951405      ,result)))
    13961406
     1407(defun section-size (seg)
     1408  (let* ((last (ccl::dll-node-pred seg)))
     1409    (if (eq last seg)                   ;empty
     1410      0
     1411      (the fixnum
     1412        (+ (the fixnum (instruction-element-address last))
     1413           (the fixnum (instruction-element-size last)))))))
     1414                 
    13971415(defun set-element-addresses (start seg)
    13981416  (ccl::do-dll-nodes (element seg start)
     
    14001418    (incf start (instruction-element-size element))))
    14011419
    1402 (defun count-element-sizes (seg)
    1403   (let* ((start 0))
    1404     (ccl::do-dll-nodes (element seg start)
    1405       (incf start (instruction-element-size element)))))
    1406 
    1407 (defun element-sizes-since (seg first)
    1408   (let* ((n 0))
    1409     (do* ((curr (or first (ccl::dll-node-succ seg)) (ccl::dll-node-succ curr)))
    1410          ((eq curr seg) n)
    1411       (incf n (instruction-element-size curr)))))
    1412 
    14131420
    14141421;;; It's better to do this naively than to not do it at all
    14151422(defun drain-constant-pool (primary constant-pool)
    1416   (let* ((n-constant-bytes (count-element-sizes constant-pool)))
     1423  (let* ((n-constant-bytes (section-size constant-pool)))
    14171424    (declare (fixnum n-constant-bytes))
    14181425    (when (> n-constant-bytes 0)
    1419       (when (> (+ n-constant-bytes (element-sizes-since primary *last-constant-pool-origin*)) 4000) ; some slack here
     1426      (when (> (+ n-constant-bytes (section-size primary)) 4000) ; some slack here
    14201427        ;; Jump around an embedded constant pool.  We might be following
    14211428        ;; some flavor of a jump with an unreachable one, or sticking
     
    14251432        ;; generates jump tables or other span-dependent things, it'll
    14261433        ;; have to be careful about how it does so.       
    1427         (multiple-value-bind (first last) (ccl::detach-dll-nodes constant-pool)
    1428           (let* ((target-name (gensym))
    1429                  (origin (make-lap-instruction nil))
    1430                  (offset (make-lap-instruction nil))
    1431                  (pool-count (make-lap-instruction nil))
    1432                  (offset-label (make-lap-label (gensym))))
    1433             (assemble-instruction primary `(b ,target-name))
    1434             (setf (lap-instruction-opcode origin) 0)
    1435             (ccl::append-dll-node origin primary)
    1436             (setq *last-constant-pool-origin* origin)
    1437             (setf (lap-instruction-opcode offset) 0)
    1438             (ccl::append-dll-node offset primary)
    1439             (setf (lap-instruction-opcode pool-count)
    1440                   (ash n-constant-bytes (- arm::word-shift)))
    1441             (ccl::append-dll-node pool-count primary)
    1442             (ccl::insert-dll-node-after first pool-count last)
    1443             (push (cons offset :offset) (lap-label-refs offset-label))
    1444             (emit-lap-label primary (lap-label-name offset-label))
    1445             (emit-lap-label primary target-name)))))))
     1434        (let* ((target-name (gensym))
     1435               (origin (make-lap-instruction nil))
     1436               (offset (make-lap-instruction nil))
     1437               (pool-count (make-lap-instruction nil))
     1438               (offset-label (make-lap-label (gensym))))
     1439          (assemble-instruction primary `(b ,target-name))
     1440          (setf (lap-instruction-opcode origin) 0)
     1441          (emit-lap-instruction-element origin primary)
     1442          (setq *last-constant-pool-origin* origin)
     1443          (setf (lap-instruction-opcode offset) 0)
     1444          (emit-lap-instruction-element offset primary)
     1445          (setf (lap-instruction-opcode pool-count)
     1446                (ash n-constant-bytes (- arm::word-shift)))
     1447          (emit-lap-instruction-element pool-count primary)
     1448          (ccl::do-dll-nodes (datum constant-pool)
     1449            (ccl::remove-dll-node datum)
     1450            (emit-lap-instruction-element datum primary))
     1451          (push (cons offset :offset) (lap-label-refs offset-label))
     1452          (emit-lap-label primary (lap-label-name offset-label))
     1453          (emit-lap-label primary target-name))))))
    14461454           
    14471455   
     
    14601468  (dolist (lab *called-subprim-jmp-labels*)
    14611469    (unless (lap-label-emitted-p lab)
    1462       (ccl::append-dll-node lab primary)
     1470      (emit-lap-instruction-element lab primary)
    14631471      (assemble-instruction primary `(ba ,(lap-label-name lab)))))
    1464   (let* ((constants-size (count-element-sizes constant-pool)))
     1472  (let* ((constants-size (section-size constant-pool)))
    14651473    (unless (eql constants-size 0)
    14661474      (let* ((c0 (make-lap-instruction nil)))
  • branches/arm/compiler/ARM/arm-lap.lisp

    r13897 r13981  
    140140      (:word
    141141       (check-usage :word)
    142        (append-dll-node
     142       (arm::emit-lap-instruction-element
    143143        (let* ((insn (arm::make-lap-instruction nil)))
    144144          (setf (arm::lap-instruction-opcode insn) (logand #xffffffff (eval arg)))
  • branches/arm/compiler/ARM/arm2.lisp

    r13968 r13981  
    48974897                    (setf (arm::lap-instruction-opcode insn)
    48984898                          (parse-operand-form (cadr f)))
    4899                     (append-dll-node insn current)))
     4899                    (arm::emit-lap-instruction-element insn current)))
    49004900                 (t
    49014901                  (let* ((insn (arm::make-lap-instruction nil))
     
    49074907                               insn
    49084908                               predicate))
    4909                     (dolist (op operands (append-dll-node insn current))
     4909                    (dolist (op operands (arm::emit-lap-instruction-element insn current))
    49104910                      (let* ((insert-function (svref operand-insert-functions (car op))))
    49114911                        (funcall insert-function insn (parse-operand-form (cdr op)))))))))
Note: See TracChangeset for help on using the changeset viewer.