Changeset 6313

Timestamp:

Apr 20, 2007, 1:55:52 AM (18 years ago)

Author:

Gary Byers

Message:

Support for :talign pseudo-op: aligns the -end- of the next instruction
on a specified boundary. (This is intended to allow use of CALL instructions
in some cases, forcing the return address to be tagged properly.)

File:

• branches/x8664-call/ccl/compiler/X86/x86-lap.lisp (modified) (9 diffs)

branches/x8664-call/ccl/compiler/X86/x86-lap.lisp

@@ -344 +344 @@
     (new-frag frag-list)))
 
+;;; Make the current frag be of type :talign; set that frag-type's
+;;; argument to NIL initially.  Start a new frag of type :pending-talign;
+;;; that frag will contain at most one instruction.  When an
+;;; instuction is ouput in the pending-talign frag, adjust the preceding
+;;; :talign frag's argument and set the type of the :pending-talign
+;;; frag to NIL.  (The :talign frag will have 0-7 NOPs of some form
+;;; appended to it, so the first instruction in the successor will end
+;;; on an address that matches the argument below.)
+;;; That instruction can not be a relaxable branch.
+(defun finish-frag-for-talign (frag-list arg)
+  (let* ((current (frag-list-current frag-list))
+         (new (new-frag frag-list)))
+    (setf (frag-type current) (list :talign nil))
+    (setf (frag-type new) (list :pending-talign arg))))
+
+;;; Having generated an instruction in a :pending-talign frag, set the
+;;; frag-type argument of the preceding :talign frag to the :pendint-talign
+;;; frag's argument - the length of the pending-talign's first instruction
+;;; mod 8, and clear the type of the "pending" frag.
+;;; cadr of the frag-type 
+(defun finish-pending-talign-frag (frag-list)
+  (let* ((frag (frag-list-current frag-list))
+         (pred (frag-pred frag))
+         (arg (cadr (frag-type frag)))
+         (pred-arg (frag-type pred)))
+    (setf (cadr pred-arg) (logand 7 (- arg (frag-length frag)))
+          (frag-type frag) nil)
+    (new-frag frag-list)))
+
 (defun finish-frag-for-org (frag-list org)
   (let* ((frag (frag-list-current frag-list)))
     (setf (frag-type frag) (list :org org))
     (new-frag frag-list)))
+
 
 (defun lookup-x86-register (regname designator)
@@ -968 +998 @@
                    (if (logtest optype (x86::encode-operand-type :imm64))
                      (frag-list-push-64 frag-list val)
-                     (frag-list-push-32 frag-list val))))))))))))
+                     (frag-list-push-32 frag-list val))))))))))
+    (let* ((frag (frag-list-current frag-list)))
+      (if (eq (car (frag-type frag)) :pending-talign)
+        (finish-pending-talign-frag frag-list)))))
 
 (defun x86-lap-directive (frag-list directive arg)
@@ -997 +1030 @@
                 (:quad (frag-list-push-64 frag-list val))
                 (:align (finish-frag-for-align frag-list val))
+                (:talign (finish-frag-for-talign frag-list val))
                 (:org (finish-frag-for-org frag-list val))))
             (let* ((pos (frag-list-position frag-list))
@@ -1010 +1044 @@
                 (:quad (frag-list-push-64 frag-list 0)
                        (setq reloctype :expr64))
-                (:align (error ":align expression ~s not constant" arg)))
+                (:align (error ":align expression ~s not constant" arg))
+                (:talign (error ":talign expression ~s not constant" arg)))
               (when reloctype
                 (push
@@ -1062 +1097 @@
     (- (logandc2 (+ address mask) mask) address)))
 
+(defun relax-talign (address mask)
+  (do* ((i 0 (1+ i)))
+       ((= (logand address 7) mask) i)
+    (incf address)))
+
+
 (defun relax-frag-list (frag-list)
   ;; First, assign tentative addresses to all frags, assuming that
@@ -1082 +1123 @@
                 (:align
                  (incf address (relax-align address (cadr (frag-type frag)))))
+                (:talign
+                 (let* ((arg (cadr (frag-type frag))))
+                   (if (null arg)
+                     ;;; Never generated code in :pending-talign frag
+                     (setf (frag-type frag) nil)
+                     (incf address (relax-talign address arg)))))
                 ((:assumed-short-branch :assumed-short-conditional-branch)
                  (destructuring-bind (label pos reloc) (cdr (frag-type frag))
@@ -1132 +1179 @@
                     (oldoff (relax-align (+ was-address len) bits))
                     (newoff (relax-align (+ address len) bits)))
+               (setq growth (- newoff oldoff))))
+            (:talign
+             (let* ((arg (cadr fragtype))
+                    (len (frag-length frag))
+                    (oldoff (relax-talign (+ was-address len) arg))
+                    (newoff (relax-talign (+ address len) arg)))
                (setq growth (- newoff oldoff))))
             ;; If we discover - on any iteration - that a short
@@ -1207 +1260 @@
                              
 
+(defun frag-emit-nops (frag count)
+  (let* ((nnops (ash (+ count 3) -2))
+         (len (floor count nnops))
+         (remains (- count (* nnops len))))
+    (dotimes (i remains)
+      (dotimes (k len) (frag-push-byte frag #x66))
+      (frag-push-byte frag #x90))
+    (do* ((i remains (1+ i)))
+         ((= i nnops))
+      (dotimes (k (1- len)) (frag-push-byte frag #x66))
+      (frag-push-byte frag #x90))))
+  
 (defun fill-for-alignment (frag-list)
   (ccl::do-dll-nodes (frag frag-list)
@@ -1215 +1280 @@
                (pad (- nextaddr (+ addr (frag-length frag)))))
           (unless (eql 0 pad)
-            (dotimes (i pad) (frag-push-byte frag #xcc))))))))
+            (if (eq (car (frag-type frag)) :talign)
+              (frag-emit-nops frag pad)
+              (dotimes (i pad) (frag-push-byte frag #xcc)))))))))
 
 (defun show-frag-bytes (frag-list)