X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fshow.lisp;h=d5a38f4ad725fad316e5638a2ec34ec931b26577;hb=aa61c7571b33b86981301f34d3acdb66666f53a3;hp=9359e5429577004f93b9ab11ac08851a1870d56f;hpb=cbaa1997bb097a55d108df592ac3b7eb4a703fff;p=sbcl.git

diff --git a/src/code/show.lisp b/src/code/show.lisp
index 9359e54..d5a38f4 100644
--- a/src/code/show.lisp
+++ b/src/code/show.lisp
@@ -13,13 +13,71 @@
 (in-package "SB!INT")
 
 ;;;; various SB-SHOW-dependent forms
+;;;;
+;;;; In general, macros named /FOO
+;;;;   * are for debugging/tracing
+;;;;   * expand into nothing unless :SB-SHOW is in the target
+;;;;     features list
+;;;; Often, they also do nothing at runtime if */SHOW* is NIL, but
+;;;; this is not always true for some very-low-level ones.
+;;;;
+;;;; (I follow the "/FOO for debugging/tracing expressions" naming
+;;;; rule and several other naming conventions in all my Lisp
+;;;; programming when possible, and then set Emacs to display comments
+;;;; in one shade of blue, tracing expressions in another shade of
+;;;; blue, and declarations and assertions in a yellowish shade, so
+;;;; that it's easy to separate them from the "real code" which
+;;;; actually does the work of the program. -- WHN 2001-05-07)
 
 ;;; Set this to NIL to suppress output from /SHOW-related forms.
 #!+sb-show (defvar */show* t)
 
-;;; shorthand for a common idiom in output statements used in debugging:
-;;; (/SHOW "Case 2:" X Y) becomes a pretty-printed version of
-;;; (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y).
+(defun cannot-/show (string)
+  #+sb-xc-host (error "can't /SHOW: ~A" string)
+  ;; We end up in this situation when we execute /SHOW too early in
+  ;; cold init. That happens to me often enough that it's really
+  ;; annoying for it to cause a hard failure -- which at that point is
+  ;; hard to recover from -- instead of just diagnostic output.
+  #-sb-xc-host (sb!sys:%primitive
+		print
+		(concatenate 'string "/can't /SHOW: " string))
+  (values))
+
+;;; Should /SHOW output be suppressed at this point?
+;;;
+;;; Note that despite the connoting-no-side-effects-pure-predicate
+;;; name, we emit some error output if we're called at a point where
+;;; /SHOW is inherently invalid.
+(defun suppress-/show-p ()
+  (cond (;; protection against /SHOW too early in cold init for
+	 ;; (FORMAT *TRACE-OUTPUT* ..) to work, part I: Obviously
+	 ;; we need *TRACE-OUTPUT* bound.
+	 (not (boundp '*trace-output*))
+	 (cannot-/show "*TRACE-OUTPUT* isn't bound. (Try /SHOW0.)")
+	 t)
+	(;; protection against /SHOW too early in cold init for
+	 ;; (FORMAT *TRACE-OUTPUT* ..) to work, part II: In a virtuoso
+	 ;; display of name mnemonicity, *READTABLE* is used by the
+	 ;; printer to decide which case convention to use when
+	 ;; writing symbols, so we need it bound.
+	 (not (boundp '*readtable*))
+	 (cannot-/show "*READTABLE* isn't bound. (Try /SHOW0.)")
+	 t)
+	(;; more protection against /SHOW too early in cold init, part III
+	 (not (boundp '*/show*))
+	 (cannot-/show "*/SHOW* isn't bound. (Try initializing it earlier.)")
+	 t)
+	(;; ordinary, healthy reason to suppress /SHOW, no error
+	 ;; output needed
+	 (not */show*)
+	 t)
+	(t
+	 ;; Let the /SHOW go on.
+	 nil)))
+
+;;; shorthand for a common idiom in output statements used in
+;;; debugging: (/SHOW "Case 2:" X Y) becomes a pretty-printed version
+;;; of (FORMAT .. "~&/Case 2: X=~S Y=~S~%" X Y), conditional on */SHOW*.
 (defmacro /show (&rest xlist)
   #!-sb-show (declare (ignore xlist))
   #!+sb-show
@@ -47,30 +105,18 @@
 	    (format-rest (reverse format-reverse-rest)))
 	`(locally
 	   (declare (optimize (speed 1) (space 2) (safety 3)))
-	   ;; For /SHOW to work, we need *TRACE-OUTPUT* of course, but
-	   ;; also *READTABLE* (used by the printer to decide what
-	   ;; case convention to use when outputting symbols).
-	   (if (every #'boundp '(*trace-output* *readtable*))
-	       (when */show*
-		 (format *trace-output*
-			 ,format-string
-			 #+ansi-cl (list ,@format-rest)
-			 #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
-	       #+sb-xc-host (error "can't /SHOW, unbound vars")
-	       ;; We end up in this situation when we execute /SHOW
-	       ;; too early in cold init. That happens often enough
-	       ;; that it's really annoying for it to cause a hard
-	       ;; failure -- which at that point is hard to recover
-	       ;; from -- instead of just diagnostic output.
-	       #-sb-xc-host (sb!sys:%primitive
-			     print
-			     "/(can't /SHOW, unbound vars)"))
+	   (unless (suppress-/show-p)
+	     (format *trace-output*
+		     ,format-string
+		     #+ansi-cl (list ,@format-rest)
+		     #-ansi-cl ,@format-rest)) ; for CLISP (CLTL1-ish)
 	   (values))))))
 
 ;;; a disabled-at-compile-time /SHOW, implemented as a macro instead
 ;;; of a function so that leaving occasionally-useful /SHOWs in place
 ;;; but disabled incurs no run-time overhead and works even when the
-;;; arguments can't be evaluated due to code flux
+;;; arguments can't be evaluated (e.g. because they're only meaningful
+;;; in a debugging version of the system, or just due to bit rot..)
 (defmacro /noshow (&rest rest)
   (declare (ignore rest)))
 
@@ -112,9 +158,6 @@
     #+sb-xc-host `(/show "(/primitive-print)" ,thing)
     #-sb-xc-host `(sb!sys:%primitive print (the simple-string ,thing))))
 
-(defmacro /nohexstr (thing)
-  (declare (ignore thing)))
-
 ;;; low-level display of a system word, works even early in cold init
 (defmacro /hexstr (thing)
   (declare (ignorable thing)) ; (for when #!-SB-SHOW)