[movitz-cvs] CVS update: ia-x86/proglist.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/ia-x86
In directory common-lisp.net:/tmp/cvs-serv12439

Modified Files:
	proglist.lisp 
Log Message:
Added a protocol for adding "extra" prefixes (such as NOPs) to
instructions as they are inserted in a code-stream. This is needed for
Movitz to be able to align call instructions such that
return-addresses are distinguisable from immediate values, which is
required by stack discipline.

Date: Thu Sep  2 11:02:41 2004
Author: ffjeld

Index: ia-x86/proglist.lisp
diff -u ia-x86/proglist.lisp:1.4 ia-x86/proglist.lisp:1.5
--- ia-x86/proglist.lisp:1.4	Tue Aug 10 12:12:52 2004
+++ ia-x86/proglist.lisp	Thu Sep  2 11:02:40 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Mon May 15 13:43:55 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: proglist.lisp,v 1.4 2004/08/10 10:12:52 ffjeld Exp $
+;;;; $Id: proglist.lisp,v 1.5 2004/09/02 09:02:40 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -100,19 +100,21 @@
 				      (make-assemble-env :symtab (assemble-env-symtab env)
 							 :current-pc referring-pc)
 				      optimize-teo)))
-      #+ignore
       (when (< (imagpart cdatum) assumed-length)
+	(warn "Assumption ~D bigger than actual ~D" assumed-length (imagpart cdatum))
 	(setf cdatum
 	  (instruction-encode instruction
 			      (make-assemble-env :symtab (assemble-env-symtab env)
 						 :current-pc referring-pc)
-			      #'(lambda (teo-list instr)
-				  (find-if #'(lambda (teo)
+			      #'(lambda (teo-list instr env)
+				  (or (find-if #'(lambda (teo)
 					       (= assumed-length
 						  (template-instr-and-prefix-length
 						   (teo-template teo)
-						   instr)))
-					   teo-list)))))
+						   instr env)))
+					       teo-list)
+				      (error "Unable to find encoding matching size ~D for ~S"
+					     assumed-length instr))))))
       (unless (= (imagpart cdatum) assumed-length)
 	(error 'assumption-failed
 	       'forward-reference fwd-to-resolve
@@ -144,7 +146,7 @@
 	    (cdr placeholder-cons) (cdr cdatums)))))
 
 
-(defun guess-next-instruction-length (expr missing-labels program-rest)
+(defun guess-next-instruction-length (expr missing-labels program-rest env)
   (declare (special *proglist-minimum-expr-size*))
   ;; (let ((minimum-size (max previous-length (gethash expr *proglist-minimum-expr-size*))))
   (or (instruction-user-size expr)
@@ -169,7 +171,7 @@
 		   (t (loop with guesses = nil
 			  for template in (templates-lookup-by-class-name (type-of expr))
 			  when (template-match-by-operand-classes template (instruction-operands expr))
-			  do (let ((l (template-instr-and-prefix-length template expr)))
+			  do (let ((l (template-instr-and-prefix-length template expr env)))
 			       (unless (member l guesses)
 				 (setf guesses
 				   (merge 'list guesses (list l) #'<))))
@@ -190,9 +192,8 @@
 	      (loop for fwd in forward-references
 		  when (try-resolve-forward-reference fwd env optimize-teo)
 		  collect fwd into resolved-forwards
-		  finally (unless (null resolved-forwards)
-			    (setf forward-references
-			      (set-difference forward-references resolved-forwards)))))
+		  finally (setf forward-references
+			    (set-difference forward-references resolved-forwards))))
 	     (ALIGNMENT
 	      (loop for cbyte in (create-alignment expr (assemble-env-current-pc env))
 		  do (push cbyte encoded-proglist-reverse)
@@ -252,7 +253,8 @@
 		  (loop for assumed-instr-length =
 			(guess-next-instruction-length expr
 						       (unresolved-labels-labels ul-condition)
-						       (rest expr-rest))
+						       (rest expr-rest)
+						       env)
 		      do
 			#+ignore (warn "Trying for ~A at ~D with ~A octets.."
 				       expr (assemble-env-current-pc env) assumed-instr-length)
@@ -277,7 +279,7 @@
 			    (assumption-failed (af-condition)
 			      (unless (eq fwd (assumption-failed-forward-reference af-condition))
 				(error af-condition)) ; decline
-			      #+ignore (warn "~A" af-condition)
+			      ;; (warn "~A" af-condition)
 			      ;; pop this length off the list of instr-length guesses
 			      (assert (gethash expr *proglist-minimum-expr-size*) (expr)
 				"Unable to encode ~A. Is the label too far away?" expr)