[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv21898

Modified Files:
	asm.lisp 
Log Message:
More assembler hackery.


--- /project/movitz/cvsroot/movitz/asm.lisp	2008/01/03 10:34:20	1.2
+++ /project/movitz/cvsroot/movitz/asm.lisp	2008/01/29 22:04:31	1.3
@@ -6,7 +6,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: asm.lisp,v 1.2 2008/01/03 10:34:20 ffjeld Exp $
+;;;; $Id: asm.lisp,v 1.3 2008/01/29 22:04:31 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -20,10 +20,17 @@
 	   #:indirect-operand-p
 	   #:indirect-operand
 	   #:register-operand
-	   #:unresolved-symbol))
+	   #:unresolved-symbol
+	   #:pc-relative-operand
+	   #:proglist-encode
+	   #:*pc*
+	   #:*symtab*))
 
 (in-package asm)
 
+(defvar *pc* nil "Current program counter.")
+(defvar *symtab* nil "Current symbol table.")
+
 (deftype symbol-reference ()
   '(cons (eql quote) (cons symbol null)))
 
@@ -52,9 +59,36 @@
 (defun indirect-operand-p (operand)
   (typep operand 'indirect-operand))
 
+(deftype pc-relative-operand ()
+  '(cons (eql :pc+)))
+
+(defun pc-relative-operand-p (operand)
+  (typep operand 'pc-relative-operand))
+
 (define-condition unresolved-symbol ()
   ((symbol
     :initarg :symbol
     :reader unresolved-symbol))
   (:report (lambda (c s)
 	     (format s "Unresolved symbol ~S." (unresolved-symbol c)))))
+
+
+;;;;;;;;;;;;
+
+
+(defun proglist-encode (proglist &key symtab (pc 0) (encoder (find-symbol (string '#:encode-instruction) '#:asm-x86)))
+  (let ((*pc* pc)
+	(*symtab* symtab))
+    (loop for instruction in proglist
+       appending
+	 (etypecase instruction
+	   (symbol
+	    (when (assoc instruction *symtab*)
+	      (error "Label ~S doubly defined." instruction))
+	    (push (cons instruction *pc*)
+		  *symtab*)
+	    nil)
+	   (cons
+	    (let ((code (funcall encoder instruction)))
+	      (incf *pc* (length code))
+	      code))))))