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 \f
  15 ;;;; various SB-SHOW-dependent forms
  16
  17 ;;; Set this to NIL to suppress output from /SHOW-related forms.
  18 #!+sb-show (defvar */show* t)
  19
  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))
  25   #!+sb-show
  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)
  34       (dolist (x xlist)
  35         (if first-p
  36             (setq first-p nil)
  37             (write-string #+ansi-cl " ~_"
  38                           #-ansi-cl " " ; for CLISP (CLTL1-ish)
  39                           format-stream))
  40         (if (literal-p x)
  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)))
  48         `(locally
  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*))
  54                (when */show*
  55                  (format *trace-output*
  56                          ,format-string
  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
  66                              print
  67                              "/(can't /SHOW, unbound vars)"))
  68            (values))))))
  69
  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)))
  76
  77 ;;; like /SHOW, except displaying values in hexadecimal
  78 (defmacro /xhow (&rest rest)
  79   `(let ((*print-base* 16))
  80      (/show ,@rest)))
  81 (defmacro /noxhow (&rest rest)
  82   (declare (ignore rest)))
  83
  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
  86 ;;; in cold load
  87 ;;;
  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.
  91 (defmacro /show0 (s)
  92   (declare (type simple-string s))
  93   (declare (ignorable s)) ; (for when #!-SB-SHOW)
  94   #+sb-xc-host `(/show ,s)
  95   #-sb-xc-host `(progn
  96                   #!+sb-show
  97                   (sb!sys:%primitive print
  98                                      ,(concatenate 'simple-string "/" s))))
  99 (defmacro /noshow0 (s)
 100   (declare (ignore s)))
 101 \f
 102 (/show0 "done with show.lisp")