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