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)