[movitz-cvs] CVS movitz

[ffjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Remove remnants of ia-x86.


--- /project/movitz/cvsroot/movitz/compiler.lisp	2008/02/17 00:10:11	1.192
+++ /project/movitz/cvsroot/movitz/compiler.lisp	2008/02/23 22:36:21	1.193
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.192 2008/02/17 00:10:11 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.193 2008/02/23 22:36:21 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -991,32 +991,6 @@
 	(assemble-funobj funobj combined-code))))
   funobj)
 
-
-(defun diss (code)
-  (format nil "~&;; Diss:
-~:{~4D: ~16<~{ ~2,'0X~}~;~> ~A~@[ ;~{ ~A~}~]~%~}"
-	  (loop with code-position = 0 and instruction-octets = nil
-	     for pc = 0 then code-position
-	     for instruction = (progn
-				 (setf instruction-octets nil)
-				 (ia-x86:decode-read-octet (lambda ()
-							     (incf code-position)
-							     (loop while (and code (not (typep (car code) '(unsigned-byte 8))))
-								  do (warn "diss bad byte at ~D: ~S" code-position (pop code))
-								  (incf code-position))
-							     (let ((x (pop code)))
-							       (when x (push x instruction-octets))
-							       x))))
-	     collect (if (not instruction)
-			 (list pc (nreverse instruction-octets) nil '("???"))
-			 (list pc
-			       (nreverse instruction-octets)
-			       ;;(ia-x86::cbyte-to-octet-list (ia-x86::instruction-original-datum instruction))
-			       instruction
-			       (comment-instruction instruction nil pc)))
-	     while code)))
-
-
 (defun assemble-funobj (funobj combined-code)
   (multiple-value-bind (code-vector code-symtab)
       (let ((asm:*instruction-compute-extra-prefix-map*
@@ -1056,20 +1030,13 @@
 	  (break "entry%2: ~D" b))
 	(unless (<= 0 c 4095)
 	  (break "entry%3: ~D" c)))
-      (loop for ((entry-label slot-name)) on '((entry%1op code-vector%1op)
-					       (entry%2op code-vector%2op)
-					       (entry%3op code-vector%3op))
-	 do (cond
-	      ((assoc entry-label code-symtab)
-	       (let ((offset (cdr (assoc entry-label code-symtab))))
-		 (setf (slot-value funobj slot-name)
-		       (cons offset funobj))
-		 #+ignore (when (< offset #x100)
-			    (vector-push offset code-vector))))
-	      #+ignore
-	      ((some (lambda (label) (assoc label code-symtab))
-		     (mapcar #'car rest))
-	       (vector-push 0 code-vector))))
+      (loop for (entry-label slot-name) in '((entry%1op code-vector%1op)
+					     (entry%2op code-vector%2op)
+					     (entry%3op code-vector%3op))
+	 do (when (assoc entry-label code-symtab)
+	      (let ((offset (cdr (assoc entry-label code-symtab))))
+		(setf (slot-value funobj slot-name)
+		      (cons offset funobj)))))
       (check-locate-concistency code-vector)
       (setf (movitz-funobj-code-vector funobj)
 	    (make-movitz-vector (length code-vector)