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