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 \f
  48 ;;;; various SB-SHOW-dependent forms
  49
  50 ;;; Set this to NIL to suppress output from /SHOW-related forms.
  51 #!+sb-show (defvar */show* t)
  52
  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))
  58   #!+sb-show
  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)
  67       (dolist (x xlist)
  68         (if first-p
  69             (setq first-p nil)
  70             (write-string #+ansi-cl " ~_"
  71                           #-ansi-cl " " ; for CLISP (CLTL1-ish)
  72                           format-stream))
  73         (if (literal-p x)
  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)))
  81         `(locally
  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*))
  87                (when */show*
  88                  (format *trace-output*
  89                          ,format-string
  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
  99                              print
 100                              "/(can't /SHOW, unbound vars)"))
 101            (values))))))
 102
 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)))
 109
 110 ;;; like /SHOW, except displaying values in hexadecimal
 111 (defmacro /xhow (&rest rest)
 112   `(let ((*print-base* 16))
 113      (/show ,@rest)))
 114 (defmacro /noxhow (&rest rest)
 115   (declare (ignore rest)))
 116
 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
 119 ;;; in cold load
 120 ;;;
 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.
 124 (defmacro /show0 (s)
 125   (declare (type simple-string s))
 126   (declare (ignorable s)) ; (for when #!-SB-SHOW)
 127   #+sb-xc-host `(/show ,s)
 128   #-sb-xc-host `(progn
 129                   #!+sb-show
 130                   (sb!sys:%primitive print
 131                                      ,(concatenate 'simple-string "/" s))))
 132 (defmacro /noshow0 (s)
 133   (declare (ignore s)))
 134 \f
 135 (/show0 "done with show.lisp")