0.pre7.86.flaky7.8:

	found that suppressing the pretty printer lets the system limp
		into warm init (then die around assem-rtns.lisp)

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index d36f8c9..31cb86c 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -787,9 +787,13 @@
         (namestring (unix-namestring defaulted-pathname t)))
     (when (and namestring (sb!unix:unix-file-kind namestring t))
       (let ((trueishname (sb!unix:unix-resolve-links namestring)))
+       (/show0 "back from UNIX-RESOLVE-LINKS in PROBE-FILE")
        (when trueishname
          (let ((*ignore-wildcards* t))
-           (pathname (sb!unix:unix-simplify-pathname trueishname))))))))
+           (/show0 "calling UNIX-SIMPLIFY-PATHNAME in PROBE-FILE")
+           (prog1
+               (pathname (sb!unix:unix-simplify-pathname trueishname))
+             (/show0 "back from UNIX-SIMPLIFY-PATHNAME in PROBE-FILE"))))))))
 \f
 ;;;; miscellaneous other operations
 

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 77521d3..b5e3b7c 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -457,9 +457,26 @@
        (/hexstr error-number)
        (/show0 "cold/low ARGUMENTS=..")
        (/hexstr arguments)
-       (/show (mapcar #'type-of arguments))
+
+       ;; REMOVEME
+       (/show0 "cold/low (LENGTH ARGUMENTS)=..")
+       (/hexstr (length arguments))
        (dolist (argument arguments)
-        (/show argument))
+        (/show0 "cold/low ARGUMENT=..")
+        (/hexstr argument)
+        (if (symbolp argument)
+            (progn
+              (/show0 "Argument is a SYMBOL..")
+              (/primitive-print (symbol-name argument)))
+            (let ((argument-type (type-of argument)))
+              (cond ((symbolp argument-type)
+                     (/show0 "Argument type is a SYMBOL..")
+                     (/primitive-print (symbol-name argument-type)))
+                    ((listp argument-type)
+                     (/primitive-print "Argument type is a LIST."))
+                    (t
+                     (/primitive-print "Argument type is not a SYMBOL or LIST."))))))
+
        (multiple-value-bind (name sb!debug:*stack-top-hint*)
           (find-interrupted-name)
         (/show0 "back from FIND-INTERRUPTED-NAME")

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 2067b07..a6ccaa7 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -905,6 +905,7 @@
 
 (defun pprint-dispatch (object &optional (table *print-pprint-dispatch*))
   (declare (type (or pprint-dispatch-table null) table))
+  (/show0 "entering PPRINT-DISPATCH")
   (let* ((table (or table *initial-pprint-dispatch*))
         (cons-entry
          (and (consp object)
@@ -1251,6 +1252,7 @@
 ;;; OUTPUT-PRETTY-OBJECT is called by OUTPUT-OBJECT when *PRINT-PRETTY* is
 ;;; bound to T.
 (defun output-pretty-object (object stream)
+  (/show0 "entering OUTPUT-PRETTY-OBJECT")
   (with-pretty-stream (stream)
     (funcall (pprint-dispatch object) stream object)))
 

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 205afbe..9b1f551 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -388,7 +388,9 @@
 
 ;;; Output OBJECT to STREAM observing all printer control variables.
 (defun output-object (object stream)
+  (/show0 "entering OUTPUT-OBJECT")
   (labels ((print-it (stream)
+            (/show0 "entering PRINT-IT")
             (if *print-pretty*
                 (if *pretty-printer*
                     (funcall *pretty-printer* object stream)
@@ -396,6 +398,7 @@
                       (output-ugly-object object stream)))
                 (output-ugly-object object stream)))
           (check-it (stream)
+            (/show0 "entering CHECK-IT")
             (let ((marker (check-for-circularity object t)))
               (case marker
                 (:initiate
@@ -412,6 +415,7 @@
     (cond (;; Maybe we don't need to bother with circularity detection.
           (or (not *print-circle*)
               (uniquely-identified-by-print-p object))
+          (/show0 "in obviously-don't-bother case")
           (print-it stream))
          (;; If we have already started circularity detection, this
           ;; object might be a shared reference. If we have not, then
@@ -419,8 +423,10 @@
           ;; reference to itself or multiple shared references.
           (or *circularity-hash-table*
               (compound-object-p object))
+          (/show0 "in CHECK-IT case")
           (check-it stream))
          (t
+          (/show0 "in don't-bother-after-all case")
           (print-it stream)))))
 
 ;;; Output OBJECT to STREAM observing all printer control variables
@@ -428,6 +434,7 @@
 ;;; then the pretty printer will be used for any components of OBJECT,
 ;;; just not for OBJECT itself.
 (defun output-ugly-object (object stream)
+  (/show0 "entering OUTPUT-UGLY-OBJECT")
   (typecase object
     ;; KLUDGE: The TYPECASE approach here is non-ANSI; the ANSI definition of
     ;; PRINT-OBJECT says it provides printing and we're supposed to provide
@@ -492,6 +499,7 @@
     (fdefn
      (output-fdefn object stream))
     (t
+     (/show0 "in OUTPUT-RANDOM case")
      (output-random object stream))))
 \f
 ;;;; symbols

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 5897b71..e8097e3 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -386,6 +386,10 @@
           ;; return its truename.
           (probe-init-files (&rest possible-init-file-names)
             (/show0 "entering PROBE-INIT-FILES")
+
+            ;; REMOVEME: commented out while compiler has problems
+            #+nil
+
             (prog1
                 (find-if (lambda (x)
                            (and (stringp x) (probe-file x)))
@@ -459,8 +463,7 @@
   (let ((* nil) (** nil) (*** nil)
        (- nil)
        (+ nil) (++ nil) (+++ nil)
-       (/// nil) (// nil) (/ nil)
-       (eof-marker (cons :eof nil)))
+       (/// nil) (// nil) (/ nil))
     (/show0 "about to set up restarts in TOPLEVEL-REPL")
     ;; There should only be one TOPLEVEL restart, and it's here, so
     ;; restarting at TOPLEVEL always bounces you all the way out here.
@@ -478,27 +481,39 @@
 
 (defun repl (noprint)
   (/show0 "entering REPL")
-  (loop
-   ;; FIXME: It seems bad to have GC behavior depend on scrubbing the
-   ;; control stack before each interactive command. Isn't there some
-   ;; way we can convince the GC to just ignore dead areas of the
-   ;; control stack, so that we don't need to rely on this
-   ;; half-measure?
-   (scrub-control-stack)
-   (unless noprint
-     (fresh-line)
-     (princ (if (functionp *prompt*)
-               (funcall *prompt*)
-               *prompt*))
-     (flush-standard-output-streams))
-   (let ((form (read *standard-input* nil eof-marker)))
-     (if (eq form eof-marker)
-        (quit)
-        (let ((results (multiple-value-list (interactive-eval form))))
-          (unless noprint
-            (dolist (result results)
-              (fresh-line)
-              (prin1 result))))))))
+
+
+  ;; REMOVEME after debugging
+  (setf *print-pretty* nil)
+
+  (let ((eof-marker (cons :eof nil)))
+    (loop
+     ;; FIXME: It seems bad to have GC behavior depend on scrubbing the
+     ;; control stack before each interactive command. Isn't there some
+     ;; way we can convince the GC to just ignore dead areas of the
+     ;; control stack, so that we don't need to rely on this
+     ;; half-measure?
+     (/show0 "at head of LOOP")
+     (scrub-control-stack)
+     (/show0 "back from SCRUB-CONTROL-STACK")
+     (unless noprint
+       (fresh-line)
+       (/show0 "back from FRESH-LINE")
+       (princ (if (functionp *prompt*)
+                 (funcall *prompt*)
+                 *prompt*))
+       (/show0 "back from PRINC")
+       (flush-standard-output-streams)
+       (/show0 "back from FLUSH-STANDARD-OUTPUT-STREAMS"))
+     (let ((form (read *standard-input* nil eof-marker)))
+       (/show0 "back from READ")
+       (if (eq form eof-marker)
+          (quit)
+          (let ((results (multiple-value-list (interactive-eval form))))
+            (unless noprint
+              (dolist (result results)
+                (fresh-line)
+                (prin1 result)))))))))
 
 (defun noprogrammer-debugger-hook-fun (condition old-debugger-hook)
   (declare (ignore old-debugger-hook))

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 7149082..626a24a 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -699,9 +699,9 @@
   (aver (not (relative-unix-pathname? pathname)))
   (/show "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
-       (/show pathname previous-pathnames)
+       (/noshow pathname previous-pathnames)
        (let ((link (unix-readlink pathname)))
-         (/show link)
+         (/noshow link)
          ;; Unlike the old CMU CL code, we handle a broken symlink by
          ;; returning the link itself. That way, CL:TRUENAME on a
          ;; broken link returns the link itself, so that CL:DIRECTORY
@@ -720,7 +720,7 @@
                                                        pathname
                                                        :from-end t)))
                                 (dir (subseq pathname 0 dir-len)))
-                           (/show dir)
+                           (/noshow dir)
                            (concatenate 'string dir link))
                          link))))
                (if (unix-file-kind new-pathname)

diff --git a/version.lisp-expr b/version.lisp-expr
index bab9913..88e5200 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.86.flaky7.7"
+"0.pre7.86.flaky7.8"