X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=31d6102ab1e81e5ffdd2c18fefc485d298cd7bb7;hb=3cbc1e7cfb59875d7ebec4af3c7c744cab0b76ae;hp=d1dcd872b1a132100b9dbb8041d42a5323a4e73b;hpb=305d6ddb826451ee5ab8e2d6ffa15f7dfc1de873;p=sbcl.git

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index d1dcd87..31d6102 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
-                                         "~@<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))
 
@@ -186,7 +200,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))
@@ -232,9 +246,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*