[movitz-cvs] CVS ia-x86

[ffjeld]

Update of /project/movitz/cvsroot/ia-x86
In directory clnet:/tmp/cvs-serv19341

Modified Files:
	operands.lisp 
Log Message:
Minor tweaks to printing instruction objects etc. Mostly related to testing the new assembler.


--- /project/movitz/cvsroot/ia-x86/operands.lisp	2005/08/13 20:31:51	1.6
+++ /project/movitz/cvsroot/ia-x86/operands.lisp	2007/12/20 22:42:43	1.7
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Feb 16 14:02:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: operands.lisp,v 1.6 2005/08/13 20:31:51 ffjeld Exp $
+;;;; $Id: operands.lisp,v 1.7 2007/12/20 22:42:43 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -176,6 +176,11 @@
     :reader operand-user-size
     :initform nil)))
 
+(defmethod operand-listform ((operand calculated-operand))
+  `(quote (:funcall ,(operand-calculation operand)
+		    ,@(sub-operands operand))))
+
+
 (defmethod operand-resolve-to-number ((operand calculated-operand) env)
   (assert (not (null env)) ()
     "Resolving ~A requires an assemble-environment." operand)
@@ -319,8 +324,16 @@
 (defmethod operand-listform ((obj operand-indirect-register))
   (with-slots (offset register scale register2)
       obj
-    (append (unless (and (integerp offset) (zerop offset))
-	      (list offset))
+    (append (cond
+	      ((eql 0 offset)
+	       nil)
+	      ((typep offset '(cons (eql +)))
+	       (mapcar (lambda (x)
+			 (if (symbolp x)
+			     `(quote ,x)
+			     x))
+		       (cdr offset)))
+	      (t (list offset)))
 	    (if (= 1 scale)
 		(list register)
 	      (list (list register scale)))
@@ -328,7 +341,8 @@
 	      (list register2)))))
 
 (defmethod print-object ((obj operand-indirect-register) stream)
-  (if (not *print-readably*)
+  (if *print-readably*
+      (call-next-method obj stream)
       (with-slots (offset register2 register scale) obj
 	(format stream "[~@[~A+~]~@[%~A+~]%~A~@[*~D~]]"
 		(unless (and (integerp offset) (zerop offset))
@@ -337,8 +351,7 @@
 		register
 		(when (> scale 1)
 		  scale))
-	obj)
-    (call-next-method obj stream)))
+	obj)))
 
 (defun resolve-indirect-register (operand env)
   (with-slots (register register2 offset scale) operand