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 @@ ...@@ -9,7 +9,7 @@
;;;; Created at: Fri Dec 17 18:01:26 1999 ;;;; Created at: Fri Dec 17 18:01:26 1999
;;;; Distribution: See the accompanying file COPYING. ;;;; 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 @@ ...@@ -44,7 +44,7 @@
(defmethod print-object ((obj instruction) stream) (defmethod print-object ((obj instruction) stream)
(cond (cond
(*print-readably* (*print-readably*
(format stream "(~@[~A ~]~A~{ ~A~})" (format stream "(~@[~W ~]~W~{ ~W~})"
(instruction-prefixes obj) (instruction-prefixes obj)
(type-of obj) (type-of obj)
(instruction-operands obj)) (instruction-operands obj))
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
;;;; Created at: Thu Jan 27 14:43:05 2000 ;;;; Created at: Thu Jan 27 14:43:05 2000
;;;; Distribution: See the accompanying file COPYING. ;;;; 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 @@ ...@@ -248,7 +248,8 @@
;;; ---------------------------------------------------------------- ;;; ----------------------------------------------------------------
(cl:defmethod cl:print-object ((obj mov) stream) (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:= 2 (cl:length (instruction-operands obj))))
(cl:progn (cl:progn
(cl:format stream (cl:format stream
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
;;;; Created at: Wed Feb 16 14:02:57 2000 ;;;; Created at: Wed Feb 16 14:02:57 2000
;;;; Distribution: See the accompanying file COPYING. ;;;; 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.")) ...@@ -176,6 +176,11 @@ operands at encoding-time."))
:reader operand-user-size :reader operand-user-size
:initform nil))) :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) (defmethod operand-resolve-to-number ((operand calculated-operand) env)
(assert (not (null env)) () (assert (not (null env)) ()
"Resolving ~A requires an assemble-environment." operand) "Resolving ~A requires an assemble-environment." operand)
...@@ -319,8 +324,16 @@ operands at encoding-time.")) ...@@ -319,8 +324,16 @@ operands at encoding-time."))
(defmethod operand-listform ((obj operand-indirect-register)) (defmethod operand-listform ((obj operand-indirect-register))
(with-slots (offset register scale register2) (with-slots (offset register scale register2)
obj obj
(append (unless (and (integerp offset) (zerop offset)) (append (cond
(list offset)) ((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) (if (= 1 scale)
(list register) (list register)
(list (list register scale))) (list (list register scale)))
...@@ -328,7 +341,8 @@ operands at encoding-time.")) ...@@ -328,7 +341,8 @@ operands at encoding-time."))
(list register2))))) (list register2)))))
(defmethod print-object ((obj operand-indirect-register) stream) (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 (with-slots (offset register2 register scale) obj
(format stream "[~@[~A+~]~@[%~A+~]%~A~@[*~D~]]" (format stream "[~@[~A+~]~@[%~A+~]%~A~@[*~D~]]"
(unless (and (integerp offset) (zerop offset)) (unless (and (integerp offset) (zerop offset))
...@@ -337,8 +351,7 @@ operands at encoding-time.")) ...@@ -337,8 +351,7 @@ operands at encoding-time."))
register register
(when (> scale 1) (when (> scale 1)
scale)) scale))
obj) obj)))
(call-next-method obj stream)))
(defun resolve-indirect-register (operand env) (defun resolve-indirect-register (operand env)
(with-slots (register register2 offset scale) operand (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