src/code/show.lisp

   1 ;;;; some stuff for displaying information for debugging/experimenting
   2 ;;;; with the system, mostly conditionalized with #!+SB-SHOW
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   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.
  12
  13 (in-package "SB!INT")
  14
  15 ;;; FIXME: Look for any other calls to %PRIMITIVE PRINT and check whether
  16 ;;; any of them need removing too.
  17 \f
  18 ;;;; FIXME: Remove this after all in-the-flow-of-control EXPORTs
  19 ;;;; have been cleaned up.
  20
  21 (defvar *rogue-export*)
  22 \f
  23 ;;;; FILE-COMMENT
  24
  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.
  30
  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)
  38   #!+sb-doc
  39   "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,
  44   etc."
  45   (declare (ignore string))
  46   '(values))
  47
  48 ;;; Now that we've got it, we can use it.
  49 (file-comment
  50   "$Header$")
  51 \f
  52 ;;;; various SB-SHOW-dependent forms
  53
  54 ;;; Set this to NIL to suppress output from /SHOW-related forms.
  55 #!+sb-show (defvar */show* t)
  56
  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))
  62   #!+sb-show
  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)
  71       (dolist (x xlist)
  72         (if first-p
  73             (setq first-p nil)
  74             (write-string #+ansi-cl " ~_"
  75                           #-ansi-cl " " ; for CLISP (CLTL1-ish)
  76                           format-stream))
  77         (if (literal-p x)
  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)))
  85         `(locally
  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*))
  91                (when */show*
  92                  (format *trace-output*
  93                          ,format-string
  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
 103                              print
 104                              "/(can't /SHOW, unbound vars)"))
 105            (values))))))
 106
 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)))
 113
 114 ;;; like /SHOW, except displaying values in hexadecimal
 115 (defmacro /xhow (&rest rest)
 116   `(let ((*print-base* 16))
 117      (/show ,@rest)))
 118 (defmacro /noxhow (&rest rest)
 119   (declare (ignore rest)))
 120
 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
 123 ;;; in cold load
 124 ;;;
 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.
 128 (defmacro /show0 (s)
 129   (declare (type simple-string s))
 130   (declare (ignorable s)) ; (for when #!-SB-SHOW)
 131   #+sb-xc-host `(/show ,s)
 132   #-sb-xc-host `(progn
 133                   #!+sb-show
 134                   (sb!sys:%primitive print
 135                                      ,(concatenate 'simple-string "/" s))))
 136 (defmacro /noshow0 (s)
 137   (declare (ignore s)))
 138 \f
 139 (/show0 "done with show.lisp")