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 ;;; FIXME: Look for any other calls to %PRIMITIVE PRINT and check whether
16 ;;; any of them need removing too.
18 ;;;; FIXME: Remove this after all in-the-flow-of-control EXPORTs
19 ;;;; have been cleaned up.
21 (defvar *rogue-export*)
25 ;;;; FILE-COMMENT arguably doesn't belong in this file, even though
26 ;;;; it's sort of for displaying information about the system.
27 ;;;; However, it's convenient to put it in this file, since we'd like
28 ;;;; this file to be the first file in the system, and we'd like to be
29 ;;;; able to use FILE-COMMENT in this file.
31 ;;; The real implementation of SB!INT:FILE-COMMENT is a special form,
32 ;;; but this macro expansion for it is still useful for
33 ;;; (1) documentation,
34 ;;; (2) code walkers, and
35 ;;; (3) compiling the cross-compiler itself under the cross-compilation
36 ;;; host ANSI Common Lisp.
37 (defmacro file-comment (string)
40 When COMPILE-FILE sees this form at top-level, it places the constant string
41 in the run-time source location information. DESCRIBE will print the file
42 comment for the file that a function was defined in. The string is also
43 textually present in the FASL, so the RCS \"ident\" command can find it,
45 (declare (ignore string))
48 ;;; Now that we've got it, we can use it.
52 ;;;; various SB-SHOW-dependent forms
54 ;;; Set this to NIL to suppress output from /SHOW-related forms.
55 #!+sb-show (defvar */show* t)
57 ;;; shorthand for a common idiom in output statements used in debugging:
58 ;;; (/SHOW "Case 2:" X Y) becomes a pretty-printed version of
59 ;;; (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y).
60 (defmacro /show (&rest xlist)
61 #!-sb-show (declare (ignore xlist))
63 (flet (;; Is X something we want to just show literally by itself?
64 ;; (instead of showing it as NAME=VALUE)
65 (literal-p (x) (or (stringp x) (numberp x))))
66 ;; We build a FORMAT statement out of what we find in XLIST.
67 (let ((format-stream (make-string-output-stream)) ; string arg to FORMAT
68 (format-reverse-rest) ; reversed &REST argument to FORMAT
69 (first-p t)) ; first pass through loop?
70 (write-string "~&~<~;/" format-stream)
74 (write-string #+ansi-cl " ~_"
75 #-ansi-cl " " ; for CLISP (CLTL1-ish)
78 (princ x format-stream)
79 (progn (let ((*print-pretty* nil))
80 (format format-stream "~S=~~S" x))
81 (push x format-reverse-rest))))
82 (write-string "~;~:>~%" format-stream)
83 (let ((format-string (get-output-stream-string format-stream))
84 (format-rest (reverse format-reverse-rest)))
86 (declare (optimize (speed 1) (space 2) (safety 3)))
87 ;; For /SHOW to work, we need *TRACE-OUTPUT* of course, but
88 ;; also *READTABLE* (used by the printer to decide what
89 ;; case convention to use when outputting symbols).
90 (if (every #'boundp '(*trace-output* *readtable*))
92 (format *trace-output*
94 #+ansi-cl (list ,@format-rest)
95 #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
96 #+sb-xc-host (error "can't /SHOW, unbound vars")
97 ;; We end up in this situation when we execute /SHOW
98 ;; too early in cold init. That happens often enough
99 ;; that it's really annoying for it to cause a hard
100 ;; failure -- which at that point is hard to recover
101 ;; from -- instead of just diagnostic output.
102 #-sb-xc-host (sb!sys:%primitive
104 "/(can't /SHOW, unbound vars)"))
107 ;;; a disabled-at-compile-time /SHOW, implemented as a macro instead
108 ;;; of a function so that leaving occasionally-useful /SHOWs in place
109 ;;; but disabled incurs no run-time overhead and works even when the
110 ;;; arguments can't be evaluated due to code flux
111 (defmacro /noshow (&rest rest)
112 (declare (ignore rest)))
114 ;;; like /SHOW, except displaying values in hexadecimal
115 (defmacro /xhow (&rest rest)
116 `(let ((*print-base* 16))
118 (defmacro /noxhow (&rest rest)
119 (declare (ignore rest)))
121 ;;; a trivial version of /SHOW which only prints a constant string,
122 ;;; implemented at a sufficiently low level that it can be used early
125 ;;; Unlike the other /SHOW-related functions, this one doesn't test
126 ;;; */SHOW* at runtime, because messing with special variables early
127 ;;; in cold load is too much trouble to be worth it.
129 (declare (type simple-string s))
130 (declare (ignorable s)) ; (for when #!-SB-SHOW)
131 #+sb-xc-host `(/show ,s)
134 (sb!sys:%primitive print
135 ,(concatenate 'simple-string "/" s))))
136 (defmacro /noshow0 (s)
137 (declare (ignore s)))
139 (/show0 "done with show.lisp")