[movitz-cvs] CVS movitz

[ffjeld]

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

Modified Files:
	asm.lisp 
Log Message:
Add support for *instruction-compute-extra-prefix-map* etc.


--- /project/movitz/cvsroot/movitz/asm.lisp	2008/02/02 00:33:04	1.5
+++ /project/movitz/cvsroot/movitz/asm.lisp	2008/02/03 10:23:05	1.6
@@ -6,7 +6,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: asm.lisp,v 1.5 2008/02/02 00:33:04 ffjeld Exp $
+;;;; $Id: asm.lisp,v 1.6 2008/02/03 10:23:05 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -26,13 +26,15 @@
 	   #:proglist-encode
 	   #:*pc*
 	   #:*symtab*
-	   #:*instruction-compute-extra-prefix-map*))
+	   #:*instruction-compute-extra-prefix-map*
+	   #:*position-independent-p*))
 
 (in-package asm)
 
 (defvar *pc* nil "Current program counter.")
 (defvar *symtab* nil "Current symbol table.")
 (defvar *instruction-compute-extra-prefix-map* nil)
+(defvar *position-independent-p* t)
 
 (deftype symbol-reference ()
   '(cons (eql quote) (cons symbol null)))
@@ -106,13 +108,26 @@
 		      ((member previous-definition corrections)
 		       (cond
 			 ((> *pc* (cdr previous-definition))
+;; 			  (warn "correcting ~S from ~D to ~D" instruction (cdr previous-definition) *pc*)
 			  (setf (cdr previous-definition) *pc*)
 			  (push previous-definition new-corrections))
 			 ((< *pc* (cdr previous-definition))
-			  (error "Definition for ~S shrunk from ~S to ~S."
-				 instruction
-				 (cdr previous-definition)
-				 *pc*))))
+;; 			  (warn "Definition for ~S shrunk from ~S to ~S (corrections: ~{~D~}."
+;; 				instruction
+;; 				(cdr previous-definition)
+;; 				*pc*
+;; 				corrections)
+;; 			  (warn "prg: ~{~%~A~}" proglist)
+;; 			  (warn "Definition for ~S shrunk from ~S to ~S."
+;; 				instruction
+;; 				(cdr previous-definition)
+;; 				*pc*)
+;; 			  (break "Definition for ~S shrunk from ~S to ~S."
+;; 				 instruction
+;; 				 (cdr previous-definition)
+;; 				 *pc*)
+			  (setf (cdr previous-definition) *pc*)
+			  (push previous-definition new-corrections))))
 		      (t (error "Label ~S doubly defined. Old value: ~S, new value: ~S"
 				instruction
 				(cdr previous-definition)
@@ -121,7 +136,8 @@
 		 (cons
 		  (let ((code (handler-bind
 				  ((unresolved-symbol (lambda (c)
-							(let ((a (cons (unresolved-symbol c) 0)))
+							(let ((a (cons (unresolved-symbol c) *pc*)))
+;; 							  (warn "assuming ~S for ~S" (unresolved-symbol c) *pc*)
 							  (push a assumptions)
 							  (push a *symtab*)
 							  (invoke-restart 'retry-symbol-resolve)))))
@@ -138,5 +154,5 @@
 		  (return (proglist-encode proglist
 					   :start-pc start-pc
 					   :cpu-package cpu-package
-					   :corrections new-corrections)))))
+					   :corrections (nconc new-corrections corrections))))))
 	    *symtab*)))