0.6.7.22: removed CVS dollar-Header-dollar tags from sources
[sbcl.git] / src / compiler / x86 / target-insts.lisp
1 ;;;; target-only stuff from CMU CL's src/compiler/x86/insts.lisp
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11
12 (in-package "SB!VM")
13
14 (defun print-mem-access (value stream print-size-p dstate)
15   (declare (type list value)
16            (type stream stream)
17            (type (member t nil) print-size-p)
18            (type sb!disassem:disassem-state dstate))
19   (when print-size-p
20     (princ (sb!disassem:dstate-get-prop dstate 'width) stream)
21     (princ '| PTR | stream))
22   (write-char #\[ stream)
23   (let ((firstp t))
24     (macrolet ((pel ((var val) &body body)
25                  ;; Print an element of the address, maybe with
26                  ;; a leading separator.
27                  `(let ((,var ,val))
28                     (when ,var
29                       (unless firstp
30                         (write-char #\+ stream))
31                       ,@body
32                       (setq firstp nil)))))
33       (pel (base-reg (first value))
34         (print-addr-reg base-reg stream dstate))
35       (pel (index-reg (third value))
36         (print-addr-reg index-reg stream dstate)
37         (let ((index-scale (fourth value)))
38           (when (and index-scale (not (= index-scale 1)))
39             (write-char #\* stream)
40             (princ index-scale stream))))
41       (let ((offset (second value)))
42         (when (and offset (or firstp (not (zerop offset))))
43           (unless (or firstp (minusp offset))
44             (write-char #\+ stream))
45           (if firstp
46               (sb!disassem:princ16 offset stream)
47               (princ offset stream))))))
48   (write-char #\] stream))