0.6.12.16:
[sbcl.git] / src / code / target-load.lisp
index 17a69b7..fe2bd03 100644 (file)
 
 (declaim (type (or pathname null) *load-truename* *load-pathname*))
 \f
-;;;; SLOLOAD
+;;;; LOAD-AS-SOURCE
 
 ;;; Load a text file.
-(defun sloload (stream verbose print)
+(defun load-as-source (stream verbose print)
   (do-load-verbose stream verbose)
   (do ((sexpr (read stream nil *eof-object*)
              (read stream nil *eof-object*)))
        (with-open-file (stream truename
                               :direction :input
                               :if-does-not-exist if-does-not-exist)
-        (sloload stream verbose print)))
+        (load-as-source stream verbose print)))
       (:binary
        (with-open-file (stream truename
                               :direction :input
                               :if-does-not-exist if-does-not-exist
                               :element-type '(unsigned-byte 8))
-        (fasload stream verbose print)))
+        (load-as-fasl stream verbose print)))
       (t
        (let ((first-line (with-open-file (stream truename :direction :input)
                           (read-line stream nil)))
 ;;; take effect. If the compiler is loaded, we make the
 ;;; compiler-policy local to LOAD by binding it to itself.
 ;;;
-;;; FIXME: ANSI specifies an EXTERNAL-FORMAT keyword argument.
-;;;
 ;;; FIXME: Daniel Barlow's ilsb.tar ILISP-for-SBCL patches contain an
 ;;; implementation of "DEFUN SOURCE-FILE" which claims, in a comment, that CMU
 ;;; CL does not correctly record source file information when LOADing a
             &key
             (verbose *load-verbose*)
             (print *load-print*)
-            (if-does-not-exist t))
+            (if-does-not-exist t)
+            (external-format :default))
   #!+sb-doc
-  "Loads the file given by FILESPEC into the Lisp environment, returning
-   T on success. These options are defined:
-
-   :IF-DOES-NOT-EXIST
-       What should we do if the file can't be located? If true (the
-       default), signal an error. If NIL, simply return NIL.
-
-   :VERBOSE
-       If true, print a line describing each file loaded. The default
-       is *LOAD-VERBOSE*.
-
-   :PRINT
-       If true, print information about loaded values. When loading the
-       source, the result of evaluating each top-level form is printed.
-       The default is *LOAD-PRINT*."
+  "Load the file given by FILESPEC into the Lisp environment, returning
+   T on success."
+  (unless (eq external-format :default)
+    (error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported."))
 
-  (let ((sb!c::*policy* sb!c::*policy*)
-       (sb!c::*interface-policy* sb!c::*interface-policy*)
+  (let ((*load-depth* (1+ *load-depth*))
+       ;; KLUDGE: I can't find in the ANSI spec where it says that
+       ;; DECLAIM/PROCLAIM of optimization policy should have file
+       ;; scope. CMU CL did this, and it seems reasonable, but it
+       ;; might not be right; after all, things like (PROCLAIM '(TYPE
+       ;; ..)) don't have file scope, and I can't find anything under
+       ;; PROCLAIM or COMPILE-FILE or LOAD or OPTIMIZE which
+       ;; justifies this behavior. Hmm. -- WHN 2001-04-06
+       (sb!c::*policy* sb!c::*policy*)
+       ;; The ANSI spec for LOAD says "LOAD binds *READTABLE* and
+       ;; *PACKAGE* to the values they held before loading the file."
        (*package* (sane-package))
        (*readtable* *readtable*)
-       (*load-depth* (1+ *load-depth*))
-       ;; The old CMU CL LOAD function used an IF-DOES-NOT-EXIST argument of
-       ;; (MEMBER :ERROR NIL) type. ANSI constrains us to accept a generalized
-       ;; boolean argument value for this externally-visible function, but the
-       ;; internal functions still use the old convention.
+       ;; The old CMU CL LOAD function used an IF-DOES-NOT-EXIST
+       ;; argument of (MEMBER :ERROR NIL) type. ANSI constrains us to
+       ;; accept a generalized boolean argument value for this
+       ;; externally-visible function, but the internal functions
+       ;; still use the old convention.
        (internal-if-does-not-exist (if if-does-not-exist :error nil)))
-    ;; FIXME: This VALUES wrapper is inherited from CMU CL.
-    ;; Once SBCL gets function return type checking right, we can
-    ;; achieve a similar effect better by adding FTYPE declarations.
+    ;; FIXME: This VALUES wrapper is inherited from CMU CL. Once SBCL
+    ;; gets function return type checking right, we can achieve a
+    ;; similar effect better by adding FTYPE declarations.
     (values
      (if (streamp filespec)
         (if (or (equal (stream-element-type filespec)
                        '(unsigned-byte 8)))
-            (fasload filespec verbose print)
-            (sloload filespec verbose print))
+            (load-as-fasl filespec verbose print)
+            (load-as-source filespec verbose print))
         (let ((pn (merge-pathnames (pathname filespec)
                                    *default-pathname-defaults*)))
           (if (wild-pathname-p pn)
   (dolist (symbol *!initial-foreign-symbols*)
     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
 
-(declaim (ftype (function (string) sb!vm:word) foreign-symbol-address-as-integer))
+(declaim (ftype (function (string) sb!vm:word)
+               foreign-symbol-address-as-integer))
 (defun foreign-symbol-address-as-integer (foreign-symbol)
   (or (gethash foreign-symbol *static-foreign-symbols*)
       (gethash (concatenate 'simple-string
       (error "unknown foreign symbol: ~S" foreign-symbol)))
 
 (defun foreign-symbol-address (symbol)
-  (int-sap (foreign-symbol-address-as-integer (sb!vm:extern-alien-name symbol))))
+  (int-sap (foreign-symbol-address-as-integer
+           (sb!vm:extern-alien-name symbol))))