-;;; This is our real LOAD. The LOAD below is just a wrapper that does
-;;; some defaulting in case the user asks us to load a file that
-;;; doesn't exist at the time we start.
-(defun %load (pathspec &key (verbose *load-verbose*) (print *load-print*)
- (if-does-not-exist t) (external-format :default))
- (when (streamp pathspec)
- (let* ( ;; Bindings required by ANSI.
- (*readtable* *readtable*)
- (*package* (sane-package))
- ;; FIXME: we should probably document the circumstances
- ;; where *LOAD-PATHNAME* and *LOAD-TRUENAME* aren't
- ;; pathnames during LOAD. ANSI makes no exceptions here.
- (*load-pathname* (handler-case (pathname pathspec)
- ;; FIXME: it should probably be a type
- ;; error to try to get a pathname for a
- ;; stream that doesn't have one, but I
- ;; don't know if we guarantee that.
- (error () nil)))
- (*load-truename* (when *load-pathname*
- (handler-case (truename *load-pathname*)
- (file-error () nil))))
- ;; Bindings used internally.
- (*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*))
- (return-from %load
- (if (equal (stream-element-type pathspec) '(unsigned-byte 8))
- (load-as-fasl pathspec verbose print)
- (load-as-source pathspec verbose print)))))
- ;; If we're here, PATHSPEC isn't a stream, so must be some other
- ;; kind of pathname designator.
- (with-open-file (stream pathspec
- :element-type '(unsigned-byte 8)
- :if-does-not-exist
- (if if-does-not-exist :error nil))
- (unless stream
- (return-from %load nil))
- (let* ((header-line (make-array
- (length *fasl-header-string-start-string*)
- :element-type '(unsigned-byte 8))))
- (read-sequence header-line stream)
- (if (mismatch header-line *fasl-header-string-start-string*
- :test #'(lambda (code char) (= code (char-code char))))
- (let ((truename (resignal-race-condition (probe-file stream))))
- (when (and truename
- (string= (pathname-type truename) *fasl-file-type*))
- (error 'fasl-header-missing
- :stream (namestring truename)
- :fhsss header-line
- :expected *fasl-header-string-start-string*)))
- (progn
- (file-position stream :start)
- (return-from %load
- (%load stream :verbose verbose :print print))))))
- ;; Because we're just opening for input, we don't need
- ;; WITH-OPEN-FILE's abort handling semantics, and we want to say
- ;; it's an error for PATHSPEC to have existed before but not now, so
- ;; WITH-OPEN-STREAM it is.
- (with-open-stream (stream (resignal-race-condition
- (open pathspec
- :external-format external-format)))
- (%load stream :verbose verbose :print print)))
-
-;; Given a simple %LOAD like the above, one can implement any
-;; particular defaulting strategy with a wrapper like this one: