1 ;;;; some stuff for displaying information for debugging/experimenting
2 ;;;; with the system, mostly conditionalized with #!+SB-SHOW
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 ;;;; various SB-SHOW-dependent forms
17 ;;;; In general, macros named /FOO
18 ;;;; * are for debugging/tracing
19 ;;;; * expand into nothing unless :SB-SHOW is in the target
21 ;;;; Often, they also do nothing at runtime if */SHOW* is NIL, but
22 ;;;; this is not always true for some very-low-level ones.
24 ;;;; (I follow the "/FOO for debugging/tracing expressions" naming
25 ;;;; rule and several other naming conventions in all my Lisp
26 ;;;; programming when possible, and then set Emacs to display comments
27 ;;;; in one shade of blue, tracing expressions in another shade of
28 ;;;; blue, and declarations and assertions in a yellowish shade, so
29 ;;;; that it's easy to separate them from the "real code" which
30 ;;;; actually does the work of the program. -- WHN 2001-05-07)
32 ;;; Set this to NIL to suppress output from /SHOW-related forms.
33 #!+sb-show (defvar */show* t)
35 ;;; shorthand for a common idiom in output statements used in debugging:
36 ;;; (/SHOW "Case 2:" X Y) becomes a pretty-printed version of
37 ;;; (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y).
38 (defmacro /show (&rest xlist)
39 #!-sb-show (declare (ignore xlist))
41 (flet (;; Is X something we want to just show literally by itself?
42 ;; (instead of showing it as NAME=VALUE)
43 (literal-p (x) (or (stringp x) (numberp x))))
44 ;; We build a FORMAT statement out of what we find in XLIST.
45 (let ((format-stream (make-string-output-stream)) ; string arg to FORMAT
46 (format-reverse-rest) ; reversed &REST argument to FORMAT
47 (first-p t)) ; first pass through loop?
48 (write-string "~&~<~;/" format-stream)
52 (write-string #+ansi-cl " ~_"
53 #-ansi-cl " " ; for CLISP (CLTL1-ish)
56 (princ x format-stream)
57 (progn (let ((*print-pretty* nil))
58 (format format-stream "~S=~~S" x))
59 (push x format-reverse-rest))))
60 (write-string "~;~:>~%" format-stream)
61 (let ((format-string (get-output-stream-string format-stream))
62 (format-rest (reverse format-reverse-rest)))
64 (declare (optimize (speed 1) (space 2) (safety 3)))
65 ;; For /SHOW to work, we need *TRACE-OUTPUT* of course, but
66 ;; also *READTABLE* (used by the printer to decide what
67 ;; case convention to use when outputting symbols).
68 (if (every #'boundp '(*trace-output* *readtable*))
70 (format *trace-output*
72 #+ansi-cl (list ,@format-rest)
73 #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
74 #+sb-xc-host (error "can't /SHOW, unbound vars")
75 ;; We end up in this situation when we execute /SHOW
76 ;; too early in cold init. That happens often enough
77 ;; that it's really annoying for it to cause a hard
78 ;; failure -- which at that point is hard to recover
79 ;; from -- instead of just diagnostic output.
80 #-sb-xc-host (sb!sys:%primitive
82 "/(can't /SHOW, unbound vars)"))
85 ;;; a disabled-at-compile-time /SHOW, implemented as a macro instead
86 ;;; of a function so that leaving occasionally-useful /SHOWs in place
87 ;;; but disabled incurs no run-time overhead and works even when the
88 ;;; arguments can't be evaluated due to code flux
89 (defmacro /noshow (&rest rest)
90 (declare (ignore rest)))
92 ;;; like /SHOW, except displaying values in hexadecimal
93 (defmacro /xhow (&rest rest)
94 `(let ((*print-base* 16))
96 (defmacro /noxhow (&rest rest)
97 (declare (ignore rest)))
99 ;;; a trivial version of /SHOW which only prints a constant string,
100 ;;; implemented at a sufficiently low level that it can be used early
103 ;;; Unlike the other /SHOW-related functions, this one doesn't test
104 ;;; */SHOW* at runtime, because messing with special variables early
105 ;;; in cold load is too much trouble to be worth it.
106 (defmacro /show0 (&rest string-designators)
107 ;; We can't use inline MAPCAR here because, at least in 0.6.11.x,
108 ;; this code gets compiled before DO-ANONYMOUS is defined.
109 (declare (notinline mapcar))
110 (let ((s (apply #'concatenate
112 (mapcar #'string string-designators))))
113 (declare (ignorable s)) ; (for when #!-SB-SHOW)
114 #+sb-xc-host `(/show ,s)
117 (sb!sys:%primitive print
118 ,(concatenate 'simple-string "/" s)))))
119 (defmacro /noshow0 (&rest rest)
120 (declare (ignore rest)))
122 ;;; low-level display of a string, works even early in cold init
123 (defmacro /primitive-print (thing)
124 (declare (ignorable thing)) ; (for when #!-SB-SHOW)
127 #+sb-xc-host `(/show "(/primitive-print)" ,thing)
128 #-sb-xc-host `(sb!sys:%primitive print (the simple-string ,thing))))
130 (defmacro /nohexstr (thing)
131 (declare (ignore thing)))
133 ;;; low-level display of a system word, works even early in cold init
134 (defmacro /hexstr (thing)
135 (declare (ignorable thing)) ; (for when #!-SB-SHOW)
138 #+sb-xc-host `(/show "(/hexstr)" ,thing)
139 #-sb-xc-host `(sb!sys:%primitive print (hexstr ,thing))))
141 (defmacro /nohexstr (thing)
142 (declare (ignore thing)))
144 (/show0 "done with show.lisp")