0.6.12.37;
authorWilliam Harold Newman <william.newman@airmail.net>
Fri, 22 Jun 2001 23:34:21 +0000 (23:34 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Fri, 22 Jun 2001 23:34:21 +0000 (23:34 +0000)
fixed bug 24: COMPILE-FILE handles READER-ERROR now, instead
of dropping you into the debugger.
READ-FOR-COMPILE-FILE now fills the role of the old
CAREFUL-READ code.
deleted now-unused NORMAL-READ-ERROR, IGNORE-ERROR-FORM,
and UNEXPECTED-EOF-ERROR
made slam.sh use a crude make-ish timestamp hack to choose
which files to re-cross-compile

BUGS
slam.sh
src/cold/slam.lisp [new file with mode: 0644]
src/compiler/compiler-error.lisp
src/compiler/early-c.lisp
src/compiler/main.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index 82d0978..1f4e07b 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -189,13 +189,6 @@ WORKAROUND:
        error in function OPEN: error opening #P"/tmp/foo.lisp": NIL
   instead of saying that too many files are open.
 
-24:
-  Right now, when COMPILE-FILE has a read error, it actually pops
-  you into the debugger before giving up on the file. It should
-  instead handle the error, perhaps issuing (and handling)
-  a secondary error "caught ERROR: unrecoverable error during compilation"
-  and then return with FAILURE-P true,
-
 26:
   reported by Sam Steingold on the cmucl-imp mailing list 12 May 2000:
     Also, there is another bug: `array-displacement' should return an
@@ -988,6 +981,12 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
     #*101
     * 
   
+108:
+  (TIME (ROOM T)) reports more than 200 Mbytes consed even for
+  a clean, just-started SBCL system. And it seems to be right:
+  (ROOM T) can bring a small computer to its knees for a *long*
+  time trying to GC afterwards. Surely there's some more economical
+  way to implement (ROOM T).
 
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 
diff --git a/slam.sh b/slam.sh
index bb4c3db..7050511 100644 (file)
--- a/slam.sh
+++ b/slam.sh
@@ -1,19 +1,20 @@
 #!/bin/sh
 
+# ("smooth duct tape: the mark of a true craftsman":-)
+
 # a quick and dirty way of partially rebuilding the system after a
 # change
 #
 # This script is not a reliable way to build the system, but it is
 # fast.:-| It can be useful if you are trying to debug a low-level
-# problem, e.g. a problem in src/runtime/*.c or in src/code/unix.lisp,
-# and you find yourself wanting to make a small change and test it
-# without going through the entire build-the-system-from-scratch
-# cycle.
+# problem, e.g. a problem in src/runtime/*.c or in
+# src/code/cold-init.lisp, and you find yourself wanting to make a
+# small change and test it without going through the entire
+# build-the-system-from-scratch cycle.
 #
 # You probably don't want to be using this script unless you
-# understand the system build process to be able to guess when it
-# won't work.
-
+# understand the system build process well enough to be able to guess
+# when it won't work.
 
 # This software is part of the SBCL system. See the README file for
 # more information.
 # provided with absolutely no warranty. See the COPYING and CREDITS
 # files for more information.
 
+if [ "" != "$*" ]; then
+    echo no command line arguments supported in this version of slam
+    exit 1
+fi
 
 # We don't try to be general about this in this script the way we are
 # in make.sh, since (1) we use our command line args as names of files
@@ -40,17 +45,18 @@ export SBCL_XC_HOST='sbcl --noprogrammer'
 sh make-target-1.sh || exit 1
 
 # Instead of doing the full make-host-2.sh, we (1) use after-xc.core
-# to rebuild only the specifically-requested Lisp files (or skip
-# after-xc.core completely if no Lisp files are specifically
-# requested), then (2) run GENESIS.
+# to rebuild only obviously-out-of-date Lisp files, then (2) run
+# GENESIS.
+sbcl --core output/after-xc.core <<'EOF' || exit 1
+  (load "src/cold/slam.lisp")
+EOF
+# (This ^ used to be
+#   for f in $*; do echo "(target-compile-stem \"$f\")"; done \
+#     | sbcl --core output/after-xc.core || exit 1
+# and perhaps we do something like this again, allowing explicit
+# rebuild-this-stem requests on the command line to supplement
+# the rebuild-obviously-outdated-stems logic above.)
 #
-# Our command line arguments are the stems that we'll use
-# after-xc.core to recompile. If there are no command line arguments,
-# though, make a point of not calling after-xc.core, since it might
-# not exist, and there's no point in causing a fatal failure (by
-# unsuccessfully trying to execute it) unnecessarily.
-for f in $*; do echo "(target-compile-stem \"$f\")"; done \
-  | sbcl --core output/after-xc.core || exit 1
 sh make-genesis-2.sh || exit 1 
 
 sh make-target-2.sh || exit 1
diff --git a/src/cold/slam.lisp b/src/cold/slam.lisp
new file mode 100644 (file)
index 0000000..7101401
--- /dev/null
@@ -0,0 +1,42 @@
+;;;; crude selective re-cross-compilation of the target system, like
+;;;; Unix make(1), but much flakier because we don't keep track of the
+;;;; (many!) dependencies between files
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package :sb-cold)
+
+;;; (This file is intended to be loaded into an after-xc.lisp core, so
+;;; we don't need to LOAD any machinery (e.g. "src/cold/shared.lisp")
+;;; which was already loaded in the course of setting up the system
+;;; state which was frozen into that core.)
+
+;;; basic test for up-to-date-ness of output with respect to input in
+;;; the sense of Unix make(1)
+(defun output-up-to-date-wrt-input-p (output input)
+  (and (probe-file output)
+       ;; (Strict #'> and lax #'>= each have problems here, which
+       ;; could become more noticeable as computation speed
+       ;; accelerates while Common Lisp's 1-second granularity remains
+       ;; the same. We use #'> because it's safer sometimes to
+       ;; recompile unnecessarily than sometimes bogusly to assume
+       ;; up-to-date-ness.)
+       (> (file-write-date output)
+         (file-write-date input))))
+
+(do-stems-and-flags (stem flags)
+  (unless (position :not-target flags)
+    (let ((srcname (concatenate 'string stem ".lisp"))
+         (objname (concatenate 'string
+                               *target-obj-prefix*
+                               stem
+                               *target-obj-suffix*)))
+      (unless (output-up-to-date-wrt-input-p objname srcname)
+       (target-compile-stem stem)))))
index 2e770ec..43f90c7 100644 (file)
@@ -1,5 +1,10 @@
-;;;; the bare essentials of compiler error handling (FIXME: to be
-;;;; moved to early-c.lisp when stable)
+;;;; the bare essentials of compiler error handling
+;;;;
+;;;; (Logically, this might belong in early-c.lisp, since it's stuff
+;;;; which might as well be visible to all compiler code. However,
+;;;; physically its DEFINE-CONDITION forms depend on the condition
+;;;; system being set up before it can be cold loaded, so we keep it
+;;;; in this separate, loaded-later file instead of in early-c.lisp.)
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -12,6 +17,9 @@
 
 (in-package "SB!C")
 
+;;;; error-handling definitions which are easy to define early and
+;;;; which are nice to have visible everywhere
+
 ;;; a function that is called to unwind out of COMPILER-ERROR
 (declaim (type (function () nil) *compiler-error-bailout*))
 (defvar *compiler-error-bailout*
 (defun compiler-style-warning (format-string &rest format-args)
   (apply #'style-warn format-string format-args)
   (values))
+
+;;; the condition of COMPILE-FILE being unable to READ from the
+;;; source file
+;;;
+;;; This is not a COMPILER-ERROR, since we don't try to recover from
+;;; it and keep chugging along, but instead immediately bail out of
+;;; the entire COMPILE-FILE.
+;;;
+;;; (The old CMU CL code did try to recover from this condition, but
+;;; the code for doing that was messy and didn't always work right.
+;;; Since in Common Lisp the simple act of reading and compiling code
+;;; (even without ever loading the compiled result) can have side
+;;; effects, it's a little scary to go on reading code when you're
+;;; deeply confused, so we violate what'd otherwise be good compiler
+;;; practice by not trying to recover from this error and bailing out
+;;; instead.)
+(define-condition input-error-in-compile-file (error)
+  (;; the original error which was trapped to produce this condition
+   (error :reader input-error-in-compile-file-error
+         :initarg :error)
+   ;; the position where the bad READ began, or NIL if unavailable,
+   ;; redundant, or irrelevant
+   (position :reader input-error-in-compile-file-position
+            :initarg :position
+            :initform nil))
+  (:report
+   (lambda (condition stream)
+     (format stream
+            "~@<~S failure in ~S~@[ at character ~D~]: ~2I~_~A~:>"
+            'read
+            'compile-file
+            (input-error-in-compile-file-position condition)
+            (input-error-in-compile-file-error condition)))))
index 913bde5..0222689 100644 (file)
 ;;; *FREE-VARIABLES*, only it deals with function names.
 (defvar *free-variables*)
 (defvar *free-functions*)
-(declaim (hash-table *free-variables* *free-functions*))
+(declaim (type hash-table *free-variables* *free-functions*))
 
-;;; We use the same Constant structure to represent all equal anonymous
-;;; constants. This hashtable translates from constants to the Leafs that
+;;; We use the same CONSTANT structure to represent all equal anonymous
+;;; constants. This hashtable translates from constants to the LEAFs that
 ;;; represent them.
 (defvar *constants*)
-(declaim (hash-table *constants*))
+(declaim (type hash-table *constants*))
 
 ;;; miscellaneous forward declarations
 (defvar *code-segment*)
index 90e02db..d5ce1d9 100644 (file)
                                :forms (vector form)
                                :positions '#(0)))))
 
-;;; Return a SOURCE-INFO which will read from Stream.
+;;; Return a SOURCE-INFO which will read from STREAM.
 (defun make-stream-source-info (stream)
   (let ((files (list (make-file-info :name :stream))))
     (make-source-info
      :current-file files
      :stream stream)))
 
-;;; Print an error message for a non-EOF error on STREAM. OLD-POS is a
-;;; preceding file position that hopefully comes before the beginning
-;;; of the line. Of course, this only works on streams that support
-;;; the file-position operation.
-(defun normal-read-error (stream old-pos condition)
-  (declare (type stream stream) (type unsigned-byte old-pos))
-  (let ((pos (file-position stream)))
-    (file-position stream old-pos)
-    (let ((start old-pos))
-      (loop
-       (let ((line (read-line stream nil))
-             (end (file-position stream)))
-         (when (>= end pos)
-           ;; FIXME: READER-ERROR also prints the file position. Do we really
-           ;; need to try to give position information here?
-           (compiler-abort "read error at ~D:~% \"~A/\\~A\"~%~A"
-                           pos
-                           (string-left-trim "         "
-                                             (subseq line 0 (- pos start)))
-                           (subseq line (- pos start))
-                           condition)
-           (return))
-         (setq start end)))))
-  (values))
-
-;;; Back STREAM up to the position Pos, then read a form with
-;;; *READ-SUPPRESS* on, discarding the result. If an error happens
-;;; during this read, then bail out using COMPILER-ERROR (fatal in
-;;; this context).
-(defun ignore-error-form (stream pos)
-  (declare (type stream stream) (type unsigned-byte pos))
-  (file-position stream pos)
-  (handler-case (let ((*read-suppress* t))
-                 (read stream))
-    (error (condition)
-      (declare (ignore condition))
-      (compiler-error "unable to recover from read error"))))
-
-;;; Print an error message giving some context for an EOF error. We
-;;; print the first line after POS that contains #\" or #\(, or
-;;; lacking that, the first non-empty line.
-(defun unexpected-eof-error (stream pos condition)
-  (declare (type stream stream) (type unsigned-byte pos))
-  (let ((res nil))
-    (file-position stream pos)
-    (loop
-      (let ((line (read-line stream nil nil)))
-       (unless line (return))
-       (when (or (find #\" line) (find #\( line))
-         (setq res line)
-         (return))
-       (unless (or res (zerop (length line)))
-         (setq res line))))
-    (compiler-abort "read error in form starting at ~D:~%~@[ \"~A\"~%~]~A"
-                   pos
-                   res
-                   condition))
-  (file-position stream (file-length stream))
-  (values))
-
-;;; Read a form from STREAM, returning EOF at EOF. If a read error
-;;; happens, then attempt to recover if possible, returning a proxy
-;;; error form.
-;;;
-;;; FIXME: This seems like quite a lot of complexity, and it seems
-;;; impossible to get it quite right. (E.g. the `(CERROR ..) form
-;;; returned here won't do the right thing if it's not in a position
-;;; for an executable form.) I think it might be better to just stop
-;;; trying to recover from read errors, punting all this noise
-;;; (including UNEXPECTED-EOF-ERROR and IGNORE-ERROR-FORM) and doing a
-;;; COMPILER-ABORT instead.
-(defun careful-read (stream eof pos)
-  (handler-case (read stream nil eof)
-    (error (condition)
-      (let ((new-pos (file-position stream)))
-       (cond ((= new-pos (file-length stream))
-              (unexpected-eof-error stream pos condition))
-             (t
-              (normal-read-error stream pos condition)
-              (ignore-error-form stream pos))))
-      '(cerror "Skip this form."
-              "compile-time read error"))))
+;;; Read a form from STREAM; or for EOF, use the trick popularized by
+;;; Kent Pitman of returning STREAM itself. If an error happens, then
+;;; convert it to standard abort-the-compilation error condition
+;;; (possibly recording some extra location information).
+(defun read-for-compile-file (stream position)
+  (handler-case (read stream nil stream)
+    (reader-error (condition)
+     (error 'input-error-in-compile-file
+           :error condition
+           ;; We don't need to supply :POSITION here because
+           ;; READER-ERRORs already know their position in the file.
+           ))
+    ;; ANSI, in its wisdom, says that READ should return END-OF-FILE
+    ;; (and that this is not a READER-ERROR) when it encounters end of
+    ;; file in the middle of something it's trying to read.
+    (end-of-file (condition)
+     (error 'input-error-in-compile-file
+           :error condition
+           ;; We need to supply :POSITION here because the END-OF-FILE
+           ;; condition doesn't carry the position that the user
+           ;; probably cares about, where the failed READ began.
+           :position position))))
 
 ;;; If STREAM is present, return it, otherwise open a stream to the
 ;;; current file. There must be a current file. When we open a new
         (stream (get-source-stream info)))
     (loop
      (let* ((pos (file-position stream))
-           (eof '(*eof*))
-           (form (careful-read stream eof pos)))
-       (if (eq form eof)
-        (return)
-        (let* ((forms (file-info-forms file))
-               (current-idx (+ (fill-pointer forms)
-                               (file-info-source-root file))))
-          (vector-push-extend form forms)
-          (vector-push-extend pos (file-info-positions file))
-          (clrhash *source-paths*)
-          (find-source-paths form current-idx)
-          (process-top-level-form form
-                                  `(original-source-start 0 ,current-idx))))))
+           (form (read-for-compile-file stream pos)))
+       (if (eq form stream) ; i.e., if EOF
+          (return)
+          (let* ((forms (file-info-forms file))
+                 (current-idx (+ (fill-pointer forms)
+                                 (file-info-source-root file))))
+            (vector-push-extend form forms)
+            (vector-push-extend pos (file-info-positions file))
+            (clrhash *source-paths*)
+            (find-source-paths form current-idx)
+            (process-top-level-form form
+                                    `(original-source-start 0
+                                                            ,current-idx))))))
     (when (advance-source-file info)
       (process-sources info))))
 
 ;;; Return the FILE-INFO describing the INDEX'th form.
+;;;
+;;; FIXME: This is unnecessarily general cruft now that we only read
+;;; a single file in COMPILE-FILE.
 (defun find-file-info (index info)
   (declare (type index index) (type source-info info))
   (dolist (file (source-info-files info))
 
 ;;; Return the INDEX'th source form read from INFO and the position
 ;;; where it was read.
+;;;
+;;; FIXME: This is unnecessarily general cruft now that we only read
+;;; a single file in COMPILE-FILE.
 (defun find-source-root (index info)
   (declare (type source-info info) (type index index))
   (let* ((file (find-file-info index info))
     (when eval
       (eval form))))
 
-(declaim (special *compiler-error-bailout*))
-
 ;;; Process a top-level FORM with the specified source PATH.
 ;;;  * If this is a magic top-level form, then do stuff.
 ;;;  * If this is a macro, then expand it.
         (*info-environment* (or *backend-info-environment*
                                 *info-environment*))
         (*gensym-counter* 0))
-    (with-compilation-values
-      (sb!xc:with-compilation-unit ()
-        (clear-stuff)
-
-       (process-sources info)
-
-       (finish-block-compilation)
-       (compile-top-level-lambdas () t)
-       (let ((object *compile-object*))
-         (etypecase object
-           (fasl-output (fasl-dump-source-info info object))
-           (core-object (fix-core-source-info info object d-s-info))
-           (null)))
-       nil))))
+    (handler-case
+       (with-compilation-values
+        (sb!xc:with-compilation-unit ()
+          (clear-stuff)
+
+          (process-sources info)
+
+          (finish-block-compilation)
+          (compile-top-level-lambdas () t)
+          (let ((object *compile-object*))
+            (etypecase object
+              (fasl-output (fasl-dump-source-info info object))
+              (core-object (fix-core-source-info info object d-s-info))
+              (null)))
+          nil))
+      ;; Some errors are sufficiently bewildering that we just fail
+      ;; immediately, without trying to recover and compile more of
+      ;; the input file.
+      (input-error-in-compile-file (condition)
+       (format *error-output*
+              "~@<compilation aborted because of input error: ~2I~_~A~:>"
+              condition)
+       (values nil t t)))))
 
 ;;; Return a list of pathnames for the named files. All the files must
 ;;; exist.
                                                   :print-weekday nil
                                                   :print-timezone nil)))
   (values))
-
 (defun finish-error-output (source-info won)
   (declare (type source-info source-info))
   (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
                   (trace-file-pathname
                    (if (eql trace-file t)
                        default-trace-file-pathname
-                       (make-pathname trace-file
-                                      default-trace-file-pathname))))
+                       (merge-pathnames trace-file
+                                        default-trace-file-pathname))))
              (setf *compiler-trace-output*
                    (open trace-file-pathname
                          :if-exists :supersede
index 5b7096c..3545520 100644 (file)
@@ -11,8 +11,9 @@
 ;;; we control the build, we can always assign an appropriate and
 ;;; relevant result, so this must be a string, not NIL.
 ;;;
-;;; Conventionally a string like "0.6.6" is used for released
-;;; versions, and a string like "0.6.5.12" is used for versions which
-;;; aren't released but correspond only to CVS tags or snapshots.
+;;; Conventionally a string like "0.6.6", with three numeric fields,
+;;; is used for released versions, and a string like "0.6.5.12", with
+;;; four numeric fields, is used for versions which aren't released
+;;; but correspond only to CVS tags or snapshots.
 
-"0.6.12.36"
+"0.6.12.37"