X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=2e687c5c25858e0a226cc6595ef0669b64efcef1;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=d5720530f7d97cab94f2d5e382ed26a8230596b9;hpb=27295fde2701d198fa80b9f5ac94e3cc5888512c;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index d572053..2e687c5 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -42,6 +42,16 @@ ;;;; LOAD itself +(define-condition fasl-header-missing (invalid-fasl) + ((fhsss :reader invalid-fasl-fhsss :initarg :fhsss)) + (:report + (lambda (condition stream) + (format stream "~@" + (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 @@ -82,8 +92,10 @@ :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)))))))) @@ -153,8 +165,6 @@ #!+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 @@ -282,15 +292,18 @@ (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)