Commit c3ec47a6 authored by Frode Vatvedt Fjeld's avatar Frode Vatvedt Fjeld

Minor tweaks to printing instruction objects etc. Mostly related to testing the new assembler.

parent 79099f49
......@@ -9,7 +9,7 @@
;;;; Created at: Fri Dec 17 18:01:26 1999
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: ia-x86.lisp,v 1.3 2004/02/10 00:03:23 ffjeld Exp $
;;;; $Id: ia-x86.lisp,v 1.4 2004/09/02 09:01:29 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -44,7 +44,7 @@
(defmethod print-object ((obj instruction) stream)
(cond
(*print-readably*
(format stream "(~@[~A ~]~A~{ ~A~})"
(format stream "(~@[~W ~]~W~{ ~W~})"
(instruction-prefixes obj)
(type-of obj)
(instruction-operands obj))
......
......@@ -9,7 +9,7 @@
;;;; Created at: Thu Jan 27 14:43:05 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: instr-mov.lisp,v 1.1.1.1 2004/01/12 14:19:00 ffjeld Exp $
;;;; $Id: instr-mov.lisp,v 1.2 2004/01/16 11:54:14 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -248,7 +248,8 @@
;;; ----------------------------------------------------------------
(cl:defmethod cl:print-object ((obj mov) stream)
(cl:if (cl:and cl:*print-pretty*
(cl:if (cl:and (cl:not cl:*print-readably*)
cl:*print-pretty*
(cl:= 2 (cl:length (instruction-operands obj))))
(cl:progn
(cl:format stream
......
......@@ -9,7 +9,7 @@
;;;; Created at: Wed Feb 16 14:02:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: operands.lisp,v 1.5 2004/09/02 09:01:44 ffjeld Exp $
;;;; $Id: operands.lisp,v 1.6 2005/08/13 20:31:51 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -176,6 +176,11 @@ operands at encoding-time."))
: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 @@ operands at encoding-time."))
(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 @@ operands at encoding-time."))
(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 @@ operands at encoding-time."))
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment