0.7.7.13:

[sbcl.git] / src / code / target-load.lisp

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index c2df8ae..11de3e3 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -29,7 +29,7 @@
 
 ;;; Load a text file.
 (defun load-as-source (stream verbose print)
-  (do-load-verbose stream verbose)
+  (maybe-announce-load stream verbose)
   (do ((sexpr (read stream nil *eof-object*)
              (read stream nil *eof-object*)))
       ((eq sexpr *eof-object*)
@@ -42,7 +42,8 @@
 \f
 ;;;; LOAD itself
 
-;;; a helper function for LOAD: Load the stuff in a file when we have the name.
+;;; a helper function for LOAD: Load the stuff in a file when we have
+;;; the name.
 (defun internal-load (pathname truename if-does-not-exist verbose print
                      &optional contents)
   (declare (type (member nil :error) if-does-not-exist))
@@ -96,7 +97,7 @@
 ;;; possible types are ".lisp" and ".cl", and both "foo.lisp" and
 ;;; "foo.cl" exist?)
 (defun try-default-type (pathname type)
-  (let ((pn (make-pathname :type type :defaults pathname)))
+  (let ((pn (translate-logical-pathname (make-pathname :type type :defaults pathname))))
     (values pn (probe-file pn))))
 
 ;;; a helper function for LOAD: Handle the case of INTERNAL-LOAD where
@@ -183,40 +184,20 @@
                        '(unsigned-byte 8)))
             (load-as-fasl filespec verbose print)
             (load-as-source filespec verbose print))
-        (let (;; FIXME: MERGE-PATHNAMES doesn't work here for
-              ;; FILESPEC="TEST:Load-Test" and
-              ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST")
-              ;;   = (("**;*.*.*" "/foo/bar/**/*.*")).
-              ;; Physicalizing the pathname before merging 
-              ;; is a workaround, but the ANSI spec talks about
-              ;; MERGE-PATHNAMES accepting (and returning)
-              ;; logical pathnames, so a true fix would probably
-              ;; include fixing MERGE-PATHNAMES, then probably
-              ;; revisiting this code.
-              (ppn (physicalize-pathname (pathname filespec))))
-          (if (wild-pathname-p ppn)
-              (let ((files (directory ppn)))
-                #!+high-security
-                (when (null files)
-                  (error 'file-error :pathname filespec))
-                (dolist (file files t)
-                  (internal-load ppn
-                                 file
-                                 internal-if-does-not-exist
-                                 verbose
-                                 print)))
-              (let ((tn (probe-file ppn)))
-                (if (or tn (pathname-type ppn))
-                    (internal-load ppn
-                                   tn
-                                   internal-if-does-not-exist
-                                   verbose
-                                   print)
-                    (internal-load-default-type
-                     ppn
-                     internal-if-does-not-exist
-                     verbose
-                     print)))))))))
+        (let* ((pathname (pathname filespec))
+               (physical-pathname (translate-logical-pathname pathname))
+               (probed-file (probe-file physical-pathname)))
+          (if (or probed-file
+                  (pathname-type physical-pathname))
+              (internal-load physical-pathname
+                             probed-file
+                             internal-if-does-not-exist
+                             verbose
+                             print)
+              (internal-load-default-type pathname
+                                          internal-if-does-not-exist
+                                          verbose
+                                          print)))))))
 \f
 ;;; Load a code object. BOX-NUM objects are popped off the stack for
 ;;; the boxed storage section, then SIZE bytes of code are read in.
@@ -246,9 +227,6 @@
 ;;; all these code objects. After a purify these fixups can be
 ;;; dropped. In CMU CL, this policy was enabled with
 ;;; *ENABLE-DYNAMIC-SPACE-CODE*; in SBCL it's always used.
-;;;
-;;; A little analysis of the header information is used to determine
-;;; if a code object is byte compiled, or native code.
 #!+x86
 (defun load-code (box-num code-length)
   (declare (fixnum box-num code-length))
@@ -268,15 +246,6 @@
 
        (setq stuff (nreverse stuff))
 
-       ;; Check that tto is always a list for byte-compiled
-       ;; code. Could be used an alternate check.
-       (when (and (typep tto 'list)
-                  (not (and (sb!c::debug-info-p dbi)
-                            (not (sb!c::compiled-debug-info-p dbi)))))
-         ;; FIXME: What is this for?
-         (format t "* tto list on non-bc code: ~S~% ~S ~S~%"
-                 stuff dbi tto))
-       
        ;; FIXME: *LOAD-CODE-VERBOSE* should probably be #!+SB-SHOW.
        (when *load-code-verbose*
              (format t "stuff: ~S~%" stuff)
@@ -330,7 +299,7 @@
                foreign-symbol-address-as-integer))
 
 
-;;; sb!sys:get-dynamic-foreign-symbol-address is in foreign.lisp, on
+;;; SB!SYS:GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS is in foreign.lisp, on
 ;;; platforms that have dynamic loading
 (defun foreign-symbol-address-as-integer (foreign-symbol)
   (or (find-foreign-symbol-in-table  foreign-symbol *static-foreign-symbols*)