X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=dc855043b02055770fbf5045c2913ec47fb7d5dc;hb=ba12c5c0420f28250ef4931b47af92c6d7963195;hp=3b2a82fbac5d6a20c7825619e58bca146f707069;hpb=18cc020d7e2477249c280c61750599213fb58ba9;p=sbcl.git diff --git a/src/code/load.lisp b/src/code/load.lisp index 3b2a82f..dc85504 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -285,31 +285,33 @@ ;;; Returns T if the stream is a binary input stream with a FASL header. (defun fasl-header-p (stream &key errorp) - (let ((p (file-position stream))) - (unwind-protect - (let* ((header *fasl-header-string-start-string*) - (buffer (make-array (length header) :element-type '(unsigned-byte 8))) - (n 0)) - (flet ((scan () - (maybe-skip-shebang-line stream) - (setf n (read-sequence buffer stream)))) - (if errorp - (scan) - (or (ignore-errors (scan)) - ;; no a binary input stream - (return-from fasl-header-p nil)))) - (if (mismatch buffer header - :test #'(lambda (code char) (= code (char-code char)))) - ;; Immediate EOF is valid -- we want to match what - ;; CHECK-FASL-HEADER does... - (or (zerop n) - (when errorp - (error 'fasl-header-missing - :stream stream - :fhsss buffer - :expected header))) - t)) - (file-position stream p)))) + (unless (member (stream-element-type stream) '(character base-char)) + (let ((p (file-position stream))) + (unwind-protect + (let* ((header *fasl-header-string-start-string*) + (buffer (make-array (length header) :element-type '(unsigned-byte 8))) + (n 0)) + (flet ((scan () + (maybe-skip-shebang-line stream) + (setf n (read-sequence buffer stream)))) + (if errorp + (scan) + (or (ignore-errors (scan)) + ;; no a binary input stream + (return-from fasl-header-p nil)))) + (if (mismatch buffer header + :test #'(lambda (code char) (= code (char-code char)))) + ;; Immediate EOF is valid -- we want to match what + ;; CHECK-FASL-HEADER does... + (or (zerop n) + (when errorp + (error 'fasl-header-missing + :stream stream + :fhsss buffer + :expected header))) + t)) + (file-position stream p))))) + ;;;; LOAD-AS-FASL ;;;;