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