X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-load.lisp;h=2e687c5c25858e0a226cc6595ef0669b64efcef1;hb=f9aaac53a4a43ebae198f53079857acb2d628eb0;hp=28109303b804f29204f61fae2fa67fb1b81acc6d;hpb=f1407e424f1063203af07d2e61ceef58515a4797;p=sbcl.git diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 2810930..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)))))))) @@ -280,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)