From: Martin C. <cra...@co...> - 2009-06-22 21:13:58
|
I think this broke this: when I now load a zero-length Lisp file (*.lsp extension) it gives me an error "attempt to load an empty FASL file: <filename>". Martin Nikodemus Siivola wrote on Sun, Jun 21, 2009 at 04:30:35PM +0000: > Update of /cvsroot/sbcl/sbcl/src/code > In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv4761/src/code > > Modified Files: > common-os.lisp early-extensions.lisp load.lisp > target-load.lisp toplevel.lisp > Log Message: > 1.0.29.27: add shebang line to fasls > > * Don't advertise yet, and don't make fasls executable out of the box > -- since the SBCL version used to run the fasl has to be the same as > compiled it this is clearly not good for distributing stuff in > general, just for local convenience. > > > Index: common-os.lisp > =================================================================== > RCS file: /cvsroot/sbcl/sbcl/src/code/common-os.lisp,v > retrieving revision 1.2 > retrieving revision 1.3 > diff -u -d -r1.2 -r1.3 > --- common-os.lisp 30 Nov 2006 15:18:58 -0000 1.2 > +++ common-os.lisp 21 Jun 2009 16:30:33 -0000 1.3 > @@ -13,12 +13,9 @@ > > (defvar *software-version* nil) > > -(defvar *core-pathname* nil > - #!+sb-doc > - "The absolute pathname of the running SBCL core.") > - > (sb!alien:define-alien-variable ("posix_argv" *native-posix-argv*) (* (* char))) > (sb!alien:define-alien-variable ("core_string" *native-core-string*) (* char)) > +(sb!alien:define-alien-routine os-get-runtime-executable-path sb!alien:c-string) > > ;;; if something ever needs to be done differently for one OS, then > ;;; split out the different part into per-os functions. > @@ -45,4 +42,6 @@ > (/show0 "setting *CORE-PATHNAME*") > (setf *core-pathname* > (merge-pathnames (native-pathname *core-string*))) > + (/show0 "setting *RUNTIME-PATHNAME*") > + (setf *runtime-pathname* (native-pathname (os-get-runtime-executable-path))) > (/show0 "leaving OS-COLD-INIT-OR-REINIT")) > > Index: early-extensions.lisp > =================================================================== > RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v > retrieving revision 1.105 > retrieving revision 1.106 > diff -u -d -r1.105 -r1.106 > --- early-extensions.lisp 23 May 2009 08:27:21 -0000 1.105 > +++ early-extensions.lisp 21 Jun 2009 16:30:33 -0000 1.106 > @@ -13,6 +13,14 @@ > > (in-package "SB!IMPL") > > +(defvar *core-pathname* nil > + #!+sb-doc > + "The absolute pathname of the running SBCL core.") > + > +(defvar *runtime-pathname* nil > + #!+sb-doc > + "The absolute pathname of the running SBCL runtime.") > + > ;;; something not EQ to anything we might legitimately READ > (defparameter *eof-object* (make-symbol "EOF-OBJECT")) > > > Index: load.lisp > =================================================================== > RCS file: /cvsroot/sbcl/sbcl/src/code/load.lisp,v > retrieving revision 1.44 > retrieving revision 1.45 > diff -u -d -r1.44 -r1.45 > --- load.lisp 12 Dec 2008 12:27:01 -0000 1.44 > +++ load.lisp 21 Jun 2009 16:30:33 -0000 1.45 > @@ -269,6 +269,48 @@ > (invalid-fasl-features condition) > (invalid-fasl-expected condition))))) > > +;;; Skips past the shebang line on stream, if any. > +(defun maybe-skip-shebang-line (stream) > + (let ((p (file-position stream))) > + (flet ((next () (read-byte stream nil))) > + (unwind-protect > + (when (and (eq (next) (char-code #\#)) > + (eq (next) (char-code #\!))) > + (setf p nil) > + (loop for x = (next) > + until (or (not x) (eq x (char-code #\newline))))) > + (when p > + (file-position stream p)))) > + t)) > + > +;;; Returns T if the stream is a binary input stream with a FASL header. > +(defun fasl-header-p (stream &key errorp) > + (let ((p (file-position stream))) > + (unwind-protect > + (let* ((header *fasl-header-string-start-string*) > + (buffer (make-array (length header) :element-type '(unsigned-byte 8))) > + (n 0)) > + (flet ((scan () > + (maybe-skip-shebang-line stream) > + (setf n (read-sequence buffer stream)))) > + (if errorp > + (scan) > + (or (ignore-errors (scan)) > + ;; no a binary input stream > + (return-from fasl-header-p nil)))) > + (if (mismatch buffer header > + :test #'(lambda (code char) (= code (char-code char)))) > + ;; Immediate EOF is valid -- we want to match what > + ;; CHECK-FASL-HEADER does... > + (or (zerop n) > + (when errorp > + (error 'fasl-header-missing > + :stream stream > + :fhsss buffer > + :expected header))) > + t)) > + (file-position stream p)))) > + > ;;;; LOAD-AS-FASL > ;;;; > ;;;; Note: LOAD-AS-FASL is used not only by LOAD, but also (with > @@ -278,10 +320,11 @@ > > ;;; a helper function for LOAD-FASL-GROUP > ;;; > -;;; Return true if we successfully read a FASL header from the stream, > -;;; or NIL if EOF was hit before anything was read. Signal an error if > -;;; we encounter garbage. > +;;; Return true if we successfully read a FASL header from the stream, or NIL > +;;; if EOF was hit before anything except the optional shebang line was read. > +;;; Signal an error if we encounter garbage. > (defun check-fasl-header (stream) > + (maybe-skip-shebang-line stream) > (let ((byte (read-byte stream nil))) > (when byte > ;; Read and validate constant string prefix in fasl header. > > Index: target-load.lisp > =================================================================== > RCS file: /cvsroot/sbcl/sbcl/src/code/target-load.lisp,v > retrieving revision 1.46 > retrieving revision 1.47 > diff -u -d -r1.46 -r1.47 > --- target-load.lisp 1 Dec 2008 19:32:33 -0000 1.46 > +++ target-load.lisp 21 Jun 2009 16:30:33 -0000 1.47 > @@ -81,7 +81,7 @@ > #!+sb-doc > "Load the file given by FILESPEC into the Lisp environment, returning > T on success." > - (flet ((load-stream (stream) > + (flet ((load-stream (stream faslp) > (let* (;; Bindings required by ANSI. > (*readtable* *readtable*) > (*package* (sane-package)) > @@ -109,12 +109,14 @@ > ;; behavior. Hmm. -- WHN 2001-04-06 > (sb!c::*policy* sb!c::*policy*)) > (return-from load > - (if (equal (stream-element-type stream) '(unsigned-byte 8)) > + (if faslp > (load-as-fasl stream verbose print) > (load-as-source stream verbose print)))))) > + ;; Case 1: stream. > (when (streamp pathspec) > - (return-from load (load-stream pathspec))) > + (return-from load (load-stream pathspec (fasl-header-p pathspec)))) > (let ((pathname (pathname pathspec))) > + ;; Case 2: Open as binary, try to process as a fasl. > (with-open-stream > (stream (or (open pathspec :element-type '(unsigned-byte 8) > :if-does-not-exist nil) > @@ -135,26 +137,14 @@ > :format-arguments (list pathspec))))) > (unless stream > (return-from load nil)) > - > - (let* ((header-line (make-array > - (length *fasl-header-string-start-string*) > - :element-type '(unsigned-byte 8)))) > - (read-sequence header-line stream) > - (if (mismatch header-line *fasl-header-string-start-string* > - :test #'(lambda (code char) (= code (char-code char)))) > - (let ((truename (probe-file stream))) > - (when (and truename > - (string= (pathname-type truename) *fasl-file-type*)) > - (error 'fasl-header-missing > - :stream (namestring truename) > - :fhsss header-line > - :expected *fasl-header-string-start-string*))) > - (progn > - (file-position stream :start) > - (return-from load > - (load-stream stream)))))) > + (let* ((real (probe-file stream)) > + (should-be-fasl-p > + (and real (string= (pathname-type real) *fasl-file-type*)))) > + (when (fasl-header-p stream :errorp should-be-fasl-p) > + (return-from load (load-stream stream t))))) > + ;; Case 3: Open using the gived external format, process as source. > (with-open-file (stream pathname :external-format external-format) > - (load-stream stream))))) > + (load-stream stream nil))))) > > ;; This implements the defaulting SBCL seems to have inherited from > ;; CMU. This routine does not try to perform any loading; all it does > > Index: toplevel.lisp > =================================================================== > RCS file: /cvsroot/sbcl/sbcl/src/code/toplevel.lisp,v > retrieving revision 1.104 > retrieving revision 1.105 > diff -u -d -r1.104 -r1.105 > --- toplevel.lisp 12 May 2009 11:00:14 -0000 1.104 > +++ toplevel.lisp 21 Jun 2009 16:30:33 -0000 1.105 > @@ -383,25 +383,11 @@ > (dolist (option options) > (process-1 option))))) > > -;;; Skips past the shebang line on stream, if any. > -(defun maybe-skip-shebang-line (stream) > - (let ((p (file-position stream))) > - (flet ((next () (read-byte stream nil))) > - (unwind-protect > - (when (and (eq (next) (char-code #\#)) > - (eq (next) (char-code #\!))) > - (setf p nil) > - (loop for x = (next) > - until (or (not x) (eq x (char-code #\newline))))) > - (when p > - (file-position stream p)))) > - t)) > - > (defun process-script (script) > (let ((pathname (native-pathname script))) > (handling-end-of-the-world > (with-open-file (f pathname :element-type :default) > - (maybe-skip-shebang-line f) > + (sb!fasl::maybe-skip-shebang-line f) > (load f :verbose nil :print nil) > (quit))))) > > > > ------------------------------------------------------------------------------ > Are you an open source citizen? Join us for the Open Source Bridge conference! > Portland, OR, June 17-19. Two days of sessions, one day of unconference: $250. > Need another reason to go? 24-hour hacker lounge. Register today! > http://ad.doubleclick.net/clk;215844324;13503038;v?http://opensourcebridge.org > _______________________________________________ > Sbcl-commits mailing list > Sbc...@li... > https://lists.sourceforge.net/lists/listinfo/sbcl-commits -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Martin Cracauer <cra...@co...> http://www.cons.org/cracauer/ FreeBSD - where you want to go, today. http://www.freebsd.org/ |