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

[Frode Vatvedt Fjeld]

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

Modified Files:
	read.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:59 2004
Author: ffjeld

Index: ia-x86/read.lisp
diff -u ia-x86/read.lisp:1.6 ia-x86/read.lisp:1.7
--- ia-x86/read.lisp:1.6	Tue Aug 10 12:12:57 2004
+++ ia-x86/read.lisp	Thu Sep  2 11:02:58 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Mon Jul 31 13:54:27 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: read.lisp,v 1.6 2004/08/10 10:12:57 ffjeld Exp $
+;;;; $Id: read.lisp,v 1.7 2004/09/02 09:02:58 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -44,6 +44,8 @@
 ;;;       absexpr ::= <label> | <number> | append-prg
 ;;;    append-prg ::= program
 ;;;
+;;;        prefix ::= <segment-override> | (:size <size>)
+;;;
 ;;;
 ;;; Instructions are recognized by symbol-name, so there should be no
 ;;; need to worry about packages etc.
@@ -206,25 +208,34 @@
    (t (error "Can't read operand ~S" spec))))
 
 (defun read-prefixes (prefix-spec)
-  (loop for p in prefix-spec
-      with user-size = nil
+  (loop with user-size = nil with user-finalizer = nil
+      for p in prefix-spec
       if (symbolp p)
       collect (let ((ps (find-symbol (symbol-name p) '#:ia-x86)))
 		(if (decode-set +prefix-opcode-map+ ps :errorp nil)
 		    ps
 		  (error "No such prefix: ~A" p)))
       into prefixes
-      else if (integerp p)
-      do (setf user-size p)
-      finally (return (values prefixes user-size))))
+      else do
+	   (check-type p list)
+	   (ecase (car p)
+	     (:size
+	      (let ((size (second p)))
+		(check-type size integer)
+		(setf user-size size)))
+	     (:finalize			; XXX
+	      (let ((finalizer (second p)))
+		(check-type finalizer symbol "a function name")
+		(setf user-finalizer finalizer))))
+      finally (return (values prefixes user-size user-finalizer))))
 	      
 (defvar *find-instruction-cache* (make-hash-table :test #'eq))
 
 (defun read-instruction (sexpr)
   "Parse a list into an assembly instruction."
-  (let (prefix-list user-size instr-name operand-list)
+  (let (prefix-list user-size user-finalizer instr-name operand-list)
     (if (listp (first sexpr))
-	(setf (values prefix-list user-size) (read-prefixes (first sexpr))
+	(setf (values prefix-list user-size user-finalizer) (read-prefixes (first sexpr))
 	      instr-name (second sexpr)
 	      operand-list (nthcdr 2 sexpr))
       (setf prefix-list nil
@@ -244,9 +255,10 @@
 				(unless instr-symbol-status
 				  (error "No instruction named ~A." (string instr-name)))
 				instr-symbol)))
-	   'prefixes prefix-list
-	   'user-size user-size
-	   'operands (mapcar #'read-operand operand-list))))))
+	   :prefixes prefix-list
+	   :user-size user-size
+	   :user-finalizer user-finalizer
+	   :operands (mapcar #'read-operand operand-list))))))
       
 
 (defun inline-data-p (expr)
@@ -303,4 +315,4 @@
 
 
 (defmacro asm (&rest spec)
-  `(instruction-encode (read-instruction ',spec)))
+  `(instruction-encode (read-instruction ',spec) nil))