Skip to content
Snippets Groups Projects
Commit 661411a6 authored by toy's avatar toy
Browse files

o Added new defvar *load-lp-object-types* to hold possible logical

  pathname types for object files.
o Modified load to search for possible fasl file types for logical
  pathnames just as it does for physical pathnames.  (But source files
  are still only searched using LISP type.)
parent a3ac2365
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.78 2001/04/11 17:37:38 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.79 2001/05/02 22:05:03 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -43,7 +43,13 @@ ...@@ -43,7 +43,13 @@
"fasl") "fasl")
"A list of the object file types recognized by LOAD.") "A list of the object file types recognized by LOAD.")
(declaim (list *load-source-types* *load-object-types*)) (defvar *load-lp-object-types*
'(#.(string-upcase (c:backend-fasl-file-type c:*backend*))
#.(string-upcase (c:backend-byte-fasl-file-type c:*backend*))
"FASL")
"A list of the object file types recognized by LOAD for logical pathnames.")
(declaim (list *load-source-types* *load-object-types* *load-lp-object-types*))
(defvar *load-verbose* t (defvar *load-verbose* t
"The default for the :VERBOSE argument to Load.") "The default for the :VERBOSE argument to Load.")
...@@ -496,9 +502,9 @@ ...@@ -496,9 +502,9 @@
The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER* The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER*
determine the defaults for the corresponding keyword arguments. These determine the defaults for the corresponding keyword arguments. These
variables are also bound to the specified argument values, so specifying a variables are also bound to the specified argument values, so specifying a
keyword affects nested loads. The variables EXT:*LOAD-SOURCE-TYPES* and keyword affects nested loads. The variables EXT:*LOAD-SOURCE-TYPES*,
EXT:*LOAD-OBJECT-TYPES* determine the file types that we use for defaulting EXT:*LOAD-OBJECT-TYPES*, and EXT:*LOAD-LP-OBJECT-TYPES* determine the file
when none is specified." types that we use for defaulting when none is specified."
(declare (type (member :default :source :binary) external-format)) (declare (type (member :default :source :binary) external-format))
(collect ((vars) (collect ((vars)
(vals)) (vals))
...@@ -598,18 +604,18 @@ ...@@ -598,18 +604,18 @@
;;; TRY-DEFAULT-TYPES -- Internal ;;; TRY-DEFAULT-TYPES -- Internal
;;; ;;;
(defun try-default-types (pathname types lp-type) (defun try-default-types (pathname types lp-types)
;; Modified 18-Jan-97/pw for logical-pathname support.
(flet ((frob (pathname type) (flet ((frob (pathname type)
(let* ((pn (make-pathname :type type :defaults pathname)) (let* ((pn (make-pathname :type type :defaults pathname))
(tn (probe-file pn))) (tn (probe-file pn)))
(values pn tn)))) (values pn tn))))
(if (logical-pathname-p pathname) (dolist (type (if (logical-pathname-p pathname)
(frob pathname lp-type) lp-types types)
(dolist (type types (values nil nil)) (values nil nil))
(multiple-value-bind (pn tn)(frob pathname type) (multiple-value-bind (pn tn)
(when tn (frob pathname type)
(return (values pn tn)))))))) (when tn
(return (values pn tn)))))))
;;; INTERNAL-LOAD-DEFAULT-TYPE -- Internal ;;; INTERNAL-LOAD-DEFAULT-TYPE -- Internal
;;; ;;;
...@@ -618,10 +624,10 @@ ...@@ -618,10 +624,10 @@
(defun internal-load-default-type (pathname if-does-not-exist) (defun internal-load-default-type (pathname if-does-not-exist)
(multiple-value-bind (multiple-value-bind
(src-pn src-tn) (src-pn src-tn)
(try-default-types pathname *load-source-types* "LISP") (try-default-types pathname *load-source-types* '("LISP"))
(multiple-value-bind (multiple-value-bind
(obj-pn obj-tn) (obj-pn obj-tn)
(try-default-types pathname *load-object-types* "FASL") (try-default-types pathname *load-object-types* *load-lp-object-types*)
(cond (cond
((and obj-tn src-tn ((and obj-tn src-tn
(> (file-write-date src-tn) (file-write-date obj-tn))) (> (file-write-date src-tn) (file-write-date obj-tn)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment