X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=219aba025781ae9a37641955e117716eefa319e3;hb=2c06e3056fe6aa820817a927fa0e840eb7b8edb7;hp=d1dcd872b1a132100b9dbb8041d42a5323a4e73b;hpb=305d6ddb826451ee5ab8e2d6ffa15f7dfc1de873;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index d1dcd87..219aba0 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -27,18 +27,32 @@ ;;;; LOAD-AS-SOURCE -;;; Load a text file. (Note that load-as-fasl is in another file.) +;;; Load a text stream. (Note that load-as-fasl is in another file.) (defun load-as-source (stream verbose print) (maybe-announce-load stream verbose) - (do ((sexpr (read stream nil *eof-object*) - (read stream nil *eof-object*))) - ((eq sexpr *eof-object*) - t) - (if print - (let ((results (multiple-value-list (eval sexpr)))) - (load-fresh-line) - (format t "~{~S~^, ~}~%" results)) - (eval sexpr)))) + (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)) ;;;; LOAD itself @@ -112,13 +126,13 @@ (open pathname :if-does-not-exist (if if-does-not-exist :error nil) - :element-type '(unsigned-byte 8))) - (if if-does-not-exist - (error 'simple-file-error - :pathname pathspec - :format-control - "~@" - :format-arguments (list pathspec)))))))) + :element-type '(unsigned-byte 8)))))) + (if if-does-not-exist + (error 'simple-file-error + :pathname pathspec + :format-control + "~@" + :format-arguments (list pathspec))))) (unless stream (return-from load nil))