Changeset 6468


Ignore:
Timestamp:
May 9, 2007, 7:34:58 AM (15 years ago)
Author:
gb
Message:

Support :talign, (@ (: label) (% rip)).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/X86/x86-lap.lisp

    r5874 r6468  
    344344    (new-frag frag-list)))
    345345
     346;;; Make the current frag be of type :talign; set that frag-type's
     347;;; argument to NIL initially.  Start a new frag of type :pending-talign;
     348;;; that frag will contain at most one instruction.  When an
     349;;; instuction is ouput in the pending-talign frag, adjust the preceding
     350;;; :talign frag's argument and set the type of the :pending-talign
     351;;; frag to NIL.  (The :talign frag will have 0-7 NOPs of some form
     352;;; appended to it, so the first instruction in the successor will end
     353;;; on an address that matches the argument below.)
     354;;; That instruction can not be a relaxable branch.
     355(defun finish-frag-for-talign (frag-list arg)
     356  (let* ((current (frag-list-current frag-list))
     357         (new (new-frag frag-list)))
     358    (setf (frag-type current) (list :talign nil))
     359    (setf (frag-type new) (list :pending-talign arg))))
     360
     361;;; Having generated an instruction in a :pending-talign frag, set the
     362;;; frag-type argument of the preceding :talign frag to the :pendint-talign
     363;;; frag's argument - the length of the pending-talign's first instruction
     364;;; mod 8, and clear the type of the "pending" frag.
     365;;; cadr of the frag-type
     366(defun finish-pending-talign-frag (frag-list)
     367  (let* ((frag (frag-list-current frag-list))
     368         (pred (frag-pred frag))
     369         (arg (cadr (frag-type frag)))
     370         (pred-arg (frag-type pred)))
     371    (setf (cadr pred-arg) (logand 7 (- arg (frag-length frag)))
     372          (frag-type frag) nil)
     373    (new-frag frag-list)))
     374
    346375(defun finish-frag-for-org (frag-list org)
    347376  (let* ((frag (frag-list-current frag-list)))
    348377    (setf (frag-type frag) (list :org org))
    349378    (new-frag frag-list)))
     379
    350380
    351381(defun lookup-x86-register (regname designator)
     
    913943             (when sib
    914944               (frag-list-push-byte frag-list sib)))))
    915        (let* ((disp (x86::x86-instruction-disp insn)))
    916          (when disp
    917            (let* ((optype (x86::x86-instruction-extra insn))
    918                   (val (early-x86-lap-expression-value disp)))
     945       (let* ((operands (x86::x86-opcode-template-operand-types template)))
     946         (if (and (= (length operands) 1)
     947                  (= (x86::encode-operand-type :label) (aref operands 0)))
     948           (let* ((label (x86::x86-instruction-extra insn))
     949                  (frag (frag-list-current frag-list))
     950                  (pos (frag-list-position frag-list)))
     951             (push (make-reloc :type :branch32
     952                               :arg label
     953                               :frag frag
     954                               :pos pos)
     955                   (frag-relocs frag))
     956             (frag-list-push-32 frag-list 0))
     957           (let* ((disp (x86::x86-instruction-disp insn)))
     958             (when disp
     959               (let* ((optype (x86::x86-instruction-extra insn))
     960                      (pcrel (and (logtest (x86::encode-operand-type :label) optype)
     961                              (typep disp 'label-x86-lap-expression)))
     962                  (val (unless pcrel (early-x86-lap-expression-value disp))))
    919963             (if (null val)
    920964               ;; We can do better job here, but (for now)
     
    922966               (let* ((frag (frag-list-current frag-list))
    923967                      (pos (frag-list-position frag-list)))
    924                  (push (make-reloc :type :expr32
    925                                    :arg disp
     968                 (push (make-reloc :type (if pcrel :branch32 :expr32)
     969                                   :arg (if pcrel (label-x86-lap-expression-label disp) disp)
    926970                                   :frag frag
    927971                                   :pos pos)
     
    932976                 (if (logtest optype (x86::encode-operand-type :disp32 :disp32s))
    933977                   (frag-list-push-32 frag-list val)
    934                    (frag-list-push-64 frag-list val)))))))
     978                   (frag-list-push-64 frag-list val)))))))))
    935979       ;; Emit immediate operand(s).
    936980       (let* ((op (x86::x86-instruction-imm insn)))
     
    9661010                   (if (logtest optype (x86::encode-operand-type :imm64))
    9671011                     (frag-list-push-64 frag-list val)
    968                      (frag-list-push-32 frag-list val))))))))))))
     1012                     (frag-list-push-32 frag-list val))))))))))
     1013    (let* ((frag (frag-list-current frag-list)))
     1014      (if (eq (car (frag-type frag)) :pending-talign)
     1015        (finish-pending-talign-frag frag-list)))))
    9691016
    9701017(defun x86-lap-directive (frag-list directive arg)
     
    9951042                (:quad (frag-list-push-64 frag-list val))
    9961043                (:align (finish-frag-for-align frag-list val))
     1044                (:talign (finish-frag-for-talign frag-list val))
    9971045                (:org (finish-frag-for-org frag-list val))))
    9981046            (let* ((pos (frag-list-position frag-list))
     
    10081056                (:quad (frag-list-push-64 frag-list 0)
    10091057                       (setq reloctype :expr64))
    1010                 (:align (error ":align expression ~s not constant" arg)))
     1058                (:align (error ":align expression ~s not constant" arg))
     1059                (:talign (error ":talign expression ~s not constant" arg)))
    10111060              (when reloctype
    10121061                (push
     
    10601109    (- (logandc2 (+ address mask) mask) address)))
    10611110
     1111(defun relax-talign (address mask)
     1112  (do* ((i 0 (1+ i)))
     1113       ((= (logand address 7) mask) i)
     1114    (incf address)))
     1115
     1116
    10621117(defun relax-frag-list (frag-list)
    10631118  ;; First, assign tentative addresses to all frags, assuming that
     
    10801135                (:align
    10811136                 (incf address (relax-align address (cadr (frag-type frag)))))
     1137                (:talign
     1138                 (let* ((arg (cadr (frag-type frag))))
     1139                   (if (null arg)
     1140                     ;;; Never generated code in :pending-talign frag
     1141                     (setf (frag-type frag) nil)
     1142                     (incf address (relax-talign address arg)))))
    10821143                ((:assumed-short-branch :assumed-short-conditional-branch)
    10831144                 (destructuring-bind (label pos reloc) (cdr (frag-type frag))
     
    11301191                    (oldoff (relax-align (+ was-address len) bits))
    11311192                    (newoff (relax-align (+ address len) bits)))
     1193               (setq growth (- newoff oldoff))))
     1194            (:talign
     1195             (let* ((arg (cadr fragtype))
     1196                    (len (frag-length frag))
     1197                    (oldoff (relax-talign (+ was-address len) arg))
     1198                    (newoff (relax-talign (+ address len) arg)))
    11321199               (setq growth (- newoff oldoff))))
    11331200            ;; If we discover - on any iteration - that a short
     
    12051272                             
    12061273
     1274(defun frag-emit-nops (frag count)
     1275  (let* ((nnops (ash (+ count 3) -2))
     1276         (len (floor count nnops))
     1277         (remains (- count (* nnops len))))
     1278    (dotimes (i remains)
     1279      (dotimes (k len) (frag-push-byte frag #x66))
     1280      (frag-push-byte frag #x90))
     1281    (do* ((i remains (1+ i)))
     1282         ((= i nnops))
     1283      (dotimes (k (1- len)) (frag-push-byte frag #x66))
     1284      (frag-push-byte frag #x90))))
     1285 
    12071286(defun fill-for-alignment (frag-list)
    12081287  (ccl::do-dll-nodes (frag frag-list)
     
    12131292               (pad (- nextaddr (+ addr (frag-length frag)))))
    12141293          (unless (eql 0 pad)
    1215             (dotimes (i pad) (frag-push-byte frag #xcc))))))))
     1294            (if (eq (car (frag-type frag)) :talign)
     1295              (frag-emit-nops frag pad)
     1296              (dotimes (i pad) (frag-push-byte frag #xcc)))))))))
    12161297
    12171298(defun show-frag-bytes (frag-list)
     
    13041385         (*x86-lap-lfun-bits* bits)
    13051386         (end-code-tag (gensym))
     1387         (entry-code-tag (gensym))
    13061388         (instruction (x86::make-x86-instruction))
    13071389         (frag-list (make-frag-list)))
    13081390    (make-x86-lap-label end-code-tag)
     1391    (make-x86-lap-label entry-code-tag)
    13091392    (x86-lap-directive frag-list :long `(ash (+ (- (:^ ,end-code-tag ) 8)
    13101393                                              *x86-lap-entry-offset*) -3))
     
    13121395    (x86-lap-directive frag-list :byte 0) ;regsave ea
    13131396    (x86-lap-directive frag-list :byte 0) ;regsave mask
     1397    (emit-x86-lap-label frag-list entry-code-tag)
     1398    (x86-lap-form `(lea (@ (:^ ,entry-code-tag) (% rip)) (% fn)) frag-list instruction)
    13141399    (dolist (f forms)
    13151400      (x86-lap-form f frag-list instruction))
Note: See TracChangeset for help on using the changeset viewer.