X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=48b3fc394a18f5dd8e1cc4646f3fd159c67d2cf2;hb=ba12c5c0420f28250ef4931b47af92c6d7963195;hp=219aba025781ae9a37641955e117716eefa319e3;hpb=f22ad70037030c07074327cf239bd84dc17b44b6;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 219aba0..48b3fc3 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -28,31 +28,37 @@ ;;;; LOAD-AS-SOURCE ;;; Load a text stream. (Note that load-as-fasl is in another file.) -(defun load-as-source (stream verbose print) +(defun load-as-source (stream &key verbose print (context "loading")) (maybe-announce-load stream verbose) - (macrolet ((do-sexprs ((sexpr stream) &body body) - (aver (symbolp sexpr)) - (with-unique-names (source-info) - (once-only ((stream stream)) - `(if (handler-case (pathname stream) - (error () nil)) - (let ((,source-info (sb!c::make-file-source-info - (pathname ,stream) - (stream-external-format ,stream)))) - (setf (sb!c::source-info-stream ,source-info) ,stream) - (sb!c::do-forms-from-info ((,sexpr) ,source-info) - ,@body)) - (do ((,sexpr (read ,stream nil *eof-object*) - (read ,stream nil *eof-object*))) - ((eq ,sexpr *eof-object*)) - ,@body)))))) - (do-sexprs (sexpr stream) - (if print - (let ((results (multiple-value-list (eval sexpr)))) - (load-fresh-line) - (format t "~{~S~^, ~}~%" results)) - (eval sexpr))) - t)) + (let* ((pathname (ignore-errors (translate-logical-pathname stream))) + (native (when pathname (native-namestring pathname)))) + (with-simple-restart (abort "Abort ~A file ~S." context native) + (flet ((eval-form (form index) + (with-simple-restart (continue "Ignore error and continue ~A file ~S." + context native) + (loop + (with-simple-restart (retry "Retry EVAL of current toplevel form.") + (if print + (let ((results (multiple-value-list (eval-tlf form index)))) + (load-fresh-line) + (format t "~{~S~^, ~}~%" results)) + (eval-tlf form index))) + (return))))) + (if pathname + (let* ((info (sb!c::make-file-source-info + pathname (stream-external-format stream))) + (sb!c::*source-info* info) + (sb!c::*source-paths* (make-hash-table :test 'eq))) + (setf (sb!c::source-info-stream info) stream) + (sb!c::do-forms-from-info ((form current-index) info) + (sb!c::find-source-paths form current-index) + (eval-form form current-index))) + (let ((sb!c::*source-info* nil)) + (do ((form (read stream nil *eof-object*) + (read stream nil *eof-object*))) + ((eq form *eof-object*)) + (eval-form form nil))))))) + t) ;;;; LOAD itself @@ -81,7 +87,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 +115,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)))))) + (load-as-source stream :verbose verbose :print 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 +143,17 @@ :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-equal (pathname-type real) *fasl-file-type*)))) + ;; Don't allow empty .fasls, and assume other empty files + ;; are source files. + (when (and (or should-be-fasl-p (not (eql 0 (file-length stream)))) + (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 @@ -200,7 +199,7 @@ (defun load-code (box-num code-length) (declare (fixnum box-num code-length)) (with-fop-stack t - (let ((code (%primitive sb!c:allocate-code-object box-num code-length)) + (let ((code (sb!c:allocate-code-object box-num code-length)) (index (+ sb!vm:code-trace-table-offset-slot box-num))) (declare (type index index)) (setf (%code-debug-info code) (pop-stack)) @@ -246,9 +245,7 @@ tto) (format t " loading to the dynamic space~%")) - (let ((code (%primitive sb!c:allocate-code-object - box-num - code-length)) + (let ((code (sb!c:allocate-code-object box-num code-length)) (index (+ sb!vm:code-trace-table-offset-slot box-num))) (declare (type index index)) (when *load-code-verbose*