\f
;;;; 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))
\f
;;;; LOAD itself
(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
- "~@<Couldn't load ~S: file does not exist.~@:>"
- :format-arguments (list pathspec))))))))
+ :element-type '(unsigned-byte 8))))))
+ (if if-does-not-exist
+ (error 'simple-file-error
+ :pathname pathspec
+ :format-control
+ "~@<Couldn't load ~S: file does not exist.~@:>"
+ :format-arguments (list pathspec)))))
(unless stream
(return-from load nil))
(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))
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*