\f
;;;; LOAD itself
-;;; a helper function for LOAD: Load the stuff in a file when we have the name.
+(define-condition fasl-header-missing (invalid-fasl)
+ ((fhsss :reader invalid-fasl-fhsss :initarg :fhsss))
+ (:report
+ (lambda (condition stream)
+ (format stream "~@<File ~S has a fasl file type, but no fasl header:~%~
+ Expected ~S, but got ~S.~:@>"
+ (invalid-fasl-stream condition)
+ (invalid-fasl-expected condition)
+ (invalid-fasl-fhsss condition)))))
+
+;;; 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))
:binary))
(t
(when (string= (pathname-type truename) *fasl-file-type*)
- (error "File has a fasl file type, but no fasl file header:~% ~S"
- (namestring truename)))
+ (error 'fasl-header-missing
+ :stream (namestring truename)
+ :fhsss first-line
+ :expected fhsss))
(internal-load pathname truename if-does-not-exist verbose print
:source))))))))
#!+sb-doc
"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 ((*load-depth* (1+ *load-depth*))
;; KLUDGE: I can't find in the ANSI spec where it says that
(load-as-fasl filespec verbose print)
(load-as-source filespec verbose print))
(let* ((pathname (pathname filespec))
- (physical-pathname (translate-logical-pathname pathname)))
- (if (or (probe-file physical-pathname) (pathname-type physical-pathname))
+ (physical-pathname (translate-logical-pathname pathname))
+ (probed-file (probe-file physical-pathname)))
+ (if (or probed-file
+ (pathname-type physical-pathname))
(internal-load physical-pathname
- (truename physical-pathname)
+ probed-file
internal-if-does-not-exist
verbose
print)
-
(internal-load-default-type pathname
internal-if-does-not-exist
verbose
(declare (fixnum i))
(push (pop-stack) stuff))
(let* ((dbi (car (last stuff))) ; debug-info
- (tto (first stuff)) ; trace-table-offset
- ;; Old CMU CL code had maybe-we-shouldn't-load-to-dyn-space
- ;; pussyfooting around here, apparently dating back to the
- ;; stone age of the X86 port, but in SBCL we always load
- ;; to dynamic space. FIXME: So now this "variable" could go
- ;; away entirely.
- (load-to-dynamic-space t))
+ (tto (first stuff))) ; trace-table-offset
(setq stuff (nreverse stuff))
(sb!c::debug-info-p dbi)
(sb!c::compiled-debug-info-name dbi)
tto)
- (if load-to-dynamic-space
- (format t " loading to the dynamic space~%")
- (format t " loading to the static space~%")))
+ (format t " loading to the dynamic space~%"))
- (let ((code
- (if load-to-dynamic-space
- (%primitive sb!c:allocate-dynamic-code-object
- box-num
- code-length)
- (%primitive sb!c:allocate-code-object
- box-num
- code-length)))
+ (let ((code (%primitive sb!c:allocate-dynamic-code-object
+ box-num
+ code-length))
(index (+ sb!vm:code-trace-table-offset-slot box-num)))
(declare (type index index))
(when *load-code-verbose*
(dolist (symbol *!initial-foreign-symbols*)
(setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
-(declaim (ftype (function (string) sb!vm:word)
+(declaim (ftype (function (string) (unsigned-byte #.sb!vm:n-machine-word-bits))
foreign-symbol-address-as-integer))
;;; SB!SYS:GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS is in foreign.lisp, on
;;; platforms that have dynamic loading
+(defun foreign-symbol-address-as-integer-or-nil (foreign-symbol)
+ (or (find-foreign-symbol-in-table foreign-symbol *static-foreign-symbols*)
+ (sb!sys:get-dynamic-foreign-symbol-address foreign-symbol)))
+
(defun foreign-symbol-address-as-integer (foreign-symbol)
- (or (find-foreign-symbol-in-table foreign-symbol *static-foreign-symbols*)
- (sb!sys:get-dynamic-foreign-symbol-address foreign-symbol)
+ (or (foreign-symbol-address-as-integer-or-nil foreign-symbol)
(error "unknown foreign symbol: ~S" foreign-symbol)))
(defun foreign-symbol-address (symbol)