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 ;;; Set this to NIL to suppress output from /SHOW-related forms.
18 #!+sb-show (defvar */show* t)
20 ;;; shorthand for a common idiom in output statements used in debugging:
21 ;;; (/SHOW "Case 2:" X Y) becomes a pretty-printed version of
22 ;;; (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y).
23 (defmacro /show (&rest xlist)
24 #!-sb-show (declare (ignore xlist))
26 (flet (;; Is X something we want to just show literally by itself?
27 ;; (instead of showing it as NAME=VALUE)
28 (literal-p (x) (or (stringp x) (numberp x))))
29 ;; We build a FORMAT statement out of what we find in XLIST.
30 (let ((format-stream (make-string-output-stream)) ; string arg to FORMAT
31 (format-reverse-rest) ; reversed &REST argument to FORMAT
32 (first-p t)) ; first pass through loop?
33 (write-string "~&~<~;/" format-stream)
37 (write-string #+ansi-cl " ~_"
38 #-ansi-cl " " ; for CLISP (CLTL1-ish)
41 (princ x format-stream)
42 (progn (let ((*print-pretty* nil))
43 (format format-stream "~S=~~S" x))
44 (push x format-reverse-rest))))
45 (write-string "~;~:>~%" format-stream)
46 (let ((format-string (get-output-stream-string format-stream))
47 (format-rest (reverse format-reverse-rest)))
49 (declare (optimize (speed 1) (space 2) (safety 3)))
50 ;; For /SHOW to work, we need *TRACE-OUTPUT* of course, but
51 ;; also *READTABLE* (used by the printer to decide what
52 ;; case convention to use when outputting symbols).
53 (if (every #'boundp '(*trace-output* *readtable*))
55 (format *trace-output*
57 #+ansi-cl (list ,@format-rest)
58 #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
59 #+sb-xc-host (error "can't /SHOW, unbound vars")
60 ;; We end up in this situation when we execute /SHOW
61 ;; too early in cold init. That happens often enough
62 ;; that it's really annoying for it to cause a hard
63 ;; failure -- which at that point is hard to recover
64 ;; from -- instead of just diagnostic output.
65 #-sb-xc-host (sb!sys:%primitive
67 "/(can't /SHOW, unbound vars)"))
70 ;;; a disabled-at-compile-time /SHOW, implemented as a macro instead
71 ;;; of a function so that leaving occasionally-useful /SHOWs in place
72 ;;; but disabled incurs no run-time overhead and works even when the
73 ;;; arguments can't be evaluated due to code flux
74 (defmacro /noshow (&rest rest)
75 (declare (ignore rest)))
77 ;;; like /SHOW, except displaying values in hexadecimal
78 (defmacro /xhow (&rest rest)
79 `(let ((*print-base* 16))
81 (defmacro /noxhow (&rest rest)
82 (declare (ignore rest)))
84 ;;; a trivial version of /SHOW which only prints a constant string,
85 ;;; implemented at a sufficiently low level that it can be used early
88 ;;; Unlike the other /SHOW-related functions, this one doesn't test
89 ;;; */SHOW* at runtime, because messing with special variables early
90 ;;; in cold load is too much trouble to be worth it.
92 (declare (type simple-string s))
93 (declare (ignorable s)) ; (for when #!-SB-SHOW)
94 #+sb-xc-host `(/show ,s)
97 (sb!sys:%primitive print
98 ,(concatenate 'simple-string "/" s))))
99 (defmacro /noshow0 (s)
100 (declare (ignore s)))
102 (/show0 "done with show.lisp")