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))