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 ;;;; In general, macros named /FOO
  18 ;;;;   * are for debugging/tracing
  19 ;;;;   * expand into nothing unless :SB-SHOW is in the target
  20 ;;;;     features list
  21 ;;;; Often, they also do nothing at runtime if */SHOW* is NIL, but
  22 ;;;; this is not always true for some very-low-level ones.
  23 ;;;;
  24 ;;;; (I follow the "/FOO for debugging/tracing expressions" naming
  25 ;;;; rule and several other naming conventions in all my Lisp
  26 ;;;; programming when possible, and then set Emacs to display comments
  27 ;;;; in one shade of blue, tracing expressions in another shade of
  28 ;;;; blue, and declarations and assertions in a yellowish shade, so
  29 ;;;; that it's easy to separate them from the "real code" which
  30 ;;;; actually does the work of the program. -- WHN 2001-05-07)
  31
  32 ;;; Set this to NIL to suppress output from /SHOW-related forms.
  33 #!+sb-show (defvar */show* t)
  34
  35 ;;; shorthand for a common idiom in output statements used in debugging:
  36 ;;; (/SHOW "Case 2:" X Y) becomes a pretty-printed version of
  37 ;;; (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y).
  38 (defmacro /show (&rest xlist)
  39   #!-sb-show (declare (ignore xlist))
  40   #!+sb-show
  41   (flet (;; Is X something we want to just show literally by itself?
  42          ;; (instead of showing it as NAME=VALUE)
  43          (literal-p (x) (or (stringp x) (numberp x))))
  44     ;; We build a FORMAT statement out of what we find in XLIST.
  45     (let ((format-stream (make-string-output-stream)) ; string arg to FORMAT
  46           (format-reverse-rest)  ; reversed &REST argument to FORMAT
  47           (first-p t))            ; first pass through loop?
  48       (write-string "~&~<~;/" format-stream)
  49       (dolist (x xlist)
  50         (if first-p
  51             (setq first-p nil)
  52             (write-string #+ansi-cl " ~_"
  53                           #-ansi-cl " " ; for CLISP (CLTL1-ish)
  54                           format-stream))
  55         (if (literal-p x)
  56             (princ x format-stream)
  57             (progn (let ((*print-pretty* nil))
  58                      (format format-stream "~S=~~S" x))
  59                    (push x format-reverse-rest))))
  60       (write-string "~;~:>~%" format-stream)
  61       (let ((format-string (get-output-stream-string format-stream))
  62             (format-rest (reverse format-reverse-rest)))
  63         `(locally
  64            (declare (optimize (speed 1) (space 2) (safety 3)))
  65            ;; For /SHOW to work, we need *TRACE-OUTPUT* of course, but
  66            ;; also *READTABLE* (used by the printer to decide what
  67            ;; case convention to use when outputting symbols).
  68            (if (every #'boundp '(*trace-output* *readtable*))
  69                (when */show*
  70                  (format *trace-output*
  71                          ,format-string
  72                          #+ansi-cl (list ,@format-rest)
  73                          #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
  74                #+sb-xc-host (error "can't /SHOW, unbound vars")
  75                ;; We end up in this situation when we execute /SHOW
  76                ;; too early in cold init. That happens often enough
  77                ;; that it's really annoying for it to cause a hard
  78                ;; failure -- which at that point is hard to recover
  79                ;; from -- instead of just diagnostic output.
  80                #-sb-xc-host (sb!sys:%primitive
  81                              print
  82                              "/(can't /SHOW, unbound vars)"))
  83            (values))))))
  84
  85 ;;; a disabled-at-compile-time /SHOW, implemented as a macro instead
  86 ;;; of a function so that leaving occasionally-useful /SHOWs in place
  87 ;;; but disabled incurs no run-time overhead and works even when the
  88 ;;; arguments can't be evaluated due to code flux
  89 (defmacro /noshow (&rest rest)
  90   (declare (ignore rest)))
  91
  92 ;;; like /SHOW, except displaying values in hexadecimal
  93 (defmacro /xhow (&rest rest)
  94   `(let ((*print-base* 16))
  95      (/show ,@rest)))
  96 (defmacro /noxhow (&rest rest)
  97   (declare (ignore rest)))
  98
  99 ;;; a trivial version of /SHOW which only prints a constant string,
 100 ;;; implemented at a sufficiently low level that it can be used early
 101 ;;; in cold init
 102 ;;;
 103 ;;; Unlike the other /SHOW-related functions, this one doesn't test
 104 ;;; */SHOW* at runtime, because messing with special variables early
 105 ;;; in cold load is too much trouble to be worth it.
 106 (defmacro /show0 (&rest string-designators)
 107   ;; We can't use inline MAPCAR here because, at least in 0.6.11.x,
 108   ;; this code gets compiled before DO-ANONYMOUS is defined.
 109   (declare (notinline mapcar))
 110   (let ((s (apply #'concatenate
 111                   'simple-string
 112                   (mapcar #'string string-designators))))
 113     (declare (ignorable s)) ; (for when #!-SB-SHOW)
 114     #+sb-xc-host `(/show ,s)
 115     #-sb-xc-host `(progn
 116                     #!+sb-show
 117                     (sb!sys:%primitive print
 118                                        ,(concatenate 'simple-string "/" s)))))
 119 (defmacro /noshow0 (&rest rest)
 120   (declare (ignore rest)))
 121
 122 ;;; low-level display of a string, works even early in cold init
 123 (defmacro /primitive-print (thing)
 124   (declare (ignorable thing)) ; (for when #!-SB-SHOW)
 125   #!+sb-show
 126   (progn
 127     #+sb-xc-host `(/show "(/primitive-print)" ,thing)
 128     #-sb-xc-host `(sb!sys:%primitive print (the simple-string ,thing))))
 129
 130 (defmacro /nohexstr (thing)
 131   (declare (ignore thing)))
 132
 133 ;;; low-level display of a system word, works even early in cold init
 134 (defmacro /hexstr (thing)
 135   (declare (ignorable thing)) ; (for when #!-SB-SHOW)
 136   #!+sb-show
 137   (progn
 138     #+sb-xc-host `(/show "(/hexstr)" ,thing)
 139     #-sb-xc-host `(sb!sys:%primitive print (hexstr ,thing))))
 140
 141 (defmacro /nohexstr (thing)
 142   (declare (ignore thing)))
 143 \f
 144 (/show0 "done with show.lisp")