From b33fd6859bbe71667bf9d8a6dbcaf62464bfbee5 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 22 Jun 2001 23:34:21 +0000 Subject: [PATCH] 0.6.12.37; 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 | 13 ++- slam.sh | 40 +++++---- src/cold/slam.lisp | 42 +++++++++ src/compiler/compiler-error.lisp | 45 +++++++++- src/compiler/early-c.lisp | 8 +- src/compiler/main.lisp | 182 ++++++++++++++------------------------ version.lisp-expr | 9 +- 7 files changed, 190 insertions(+), 149 deletions(-) create mode 100644 src/cold/slam.lisp diff --git a/BUGS b/BUGS index 82d0978..1f4e07b 100644 --- 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 --- 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. @@ -24,6 +25,10 @@ # 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 index 0000000..7101401 --- /dev/null +++ b/src/cold/slam.lisp @@ -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))))) diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp index 2e770ec..43f90c7 100644 --- a/src/compiler/compiler-error.lisp +++ b/src/compiler/compiler-error.lisp @@ -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* @@ -48,3 +56,36 @@ (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))))) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 913bde5..0222689 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -56,13 +56,13 @@ ;;; *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*) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 90e02db..d5ce1d9 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -745,7 +745,7 @@ :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 @@ -753,88 +753,28 @@ :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 @@ -884,23 +824,26 @@ (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)) @@ -911,6 +854,9 @@ ;;; 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)) @@ -980,8 +926,6 @@ (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. @@ -1290,20 +1234,29 @@ (*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* + "~@" + condition) + (values nil t t))))) ;;; Return a list of pathnames for the named files. All the files must ;;; exist. @@ -1346,7 +1299,6 @@ :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~&" @@ -1441,8 +1393,8 @@ (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 diff --git a/version.lisp-expr b/version.lisp-expr index 5b7096c..3545520 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4