X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=560ba0e0bb451465e8baa3394b5ba818f558dc80;hb=add57c72c932fbf70c8ba8297154936c908b410e;hp=56a139eda2f9317d71788abc6a5d4abcbf32bc8e;hpb=b7a8f5313a83dea33ce60551a4fb987b415c2cc6;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 56a139e..560ba0e 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,7 +165,7 @@ #!+sb-doc "Load the file given by FILESPEC into the Lisp environment, returning T on success." - + (declare (ignore external-format)) (let ((*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 @@ -249,7 +261,7 @@ tto) (format t " loading to the dynamic space~%")) - (let ((code (%primitive sb!c:allocate-dynamic-code-object + (let ((code (%primitive sb!c:allocate-code-object box-num code-length)) (index (+ sb!vm:code-trace-table-offset-slot box-num))) @@ -286,9 +298,12 @@ ;;; 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)