(declaim (inline ref-fop-table))
(defun ref-fop-table (index)
- (declare (index index))
+ (declare (type index index))
(svref *fop-table* (the index (+ index 1))))
(defun get-fop-table-index ()
;;; These three routines are used for both the stack and the table.
(defun make-fop-vector (size)
- (declare (index size))
+ (declare (type index size))
(let ((vector (make-array size)))
(setf (aref vector 0) 0)
vector))
(defun grow-fop-vector (old-vector old-size)
(declare (simple-vector old-vector)
- (index old-size))
+ (type index old-size))
(let* ((new-size (* old-size 2))
(new-vector (make-array new-size)))
(declare (fixnum new-size)
(defun nuke-fop-vector (vector)
(declare (simple-vector vector)
+ #!-gencgc (ignore vector)
(optimize speed))
;; Make sure we don't keep any garbage.
#!+gencgc
(defun pop-fop-stack ()
(let* ((stack *fop-stack*)
(top (svref stack 0)))
- (declare (index top))
+ (declare (type index top))
(when (eql 0 top)
(error "FOP stack empty"))
(setf (svref stack 0) (1- top))
(defun push-fop-stack (value)
(let* ((stack *fop-stack*)
(next (1+ (the index (svref stack 0)))))
- (declare (index next))
+ (declare (type index next))
(when (eql (length stack) next)
(setf stack (grow-fop-vector stack next)
*fop-stack* stack))
;;; Returns T if the stream is a binary input stream with a FASL header.
(defun fasl-header-p (stream &key errorp)
- (unless (member (stream-element-type stream) '(character base-char))
+ (unless (and (member (stream-element-type stream) '(character base-char))
+ ;; give up if it's not a file stream, or it's an
+ ;; fd-stream but it's either not bivalent or not
+ ;; seekable (doesn't really have a file)
+ (or (not (typep stream 'file-stream))
+ (and (typep stream 'fd-stream)
+ (or (not (sb!impl::fd-stream-bivalent-p stream))
+ (not (sb!impl::fd-stream-file stream))))))
(let ((p (file-position stream)))
(unwind-protect
(let* ((header *fasl-header-string-start-string*)
(when (zerop (file-length stream))
(error "attempt to load an empty FASL file:~% ~S" (namestring stream)))
(maybe-announce-load stream verbose)
- (with-world-lock ()
- (let* ((*fasl-input-stream* stream)
- (*fop-table* (make-fop-vector 1000))
- (*fop-stack* (make-fop-vector 100)))
- (unwind-protect
- (loop while (load-fasl-group stream))
- ;; Nuke the table and stack to avoid keeping garbage on
- ;; conservatively collected platforms.
- (nuke-fop-vector *fop-table*)
- (nuke-fop-vector *fop-stack*))))
+ (let* ((*fasl-input-stream* stream)
+ (*fop-table* (make-fop-vector 1000))
+ (*fop-stack* (make-fop-vector 100)))
+ (unwind-protect
+ (loop while (load-fasl-group stream))
+ ;; Nuke the table and stack to avoid keeping garbage on
+ ;; conservatively collected platforms.
+ (nuke-fop-vector *fop-table*)
+ (nuke-fop-vector *fop-stack*)))
t)
(declaim (notinline read-byte)) ; Why is it even *declaimed* inline above?