#!-sb-fluid (declaim (inline store-word))
(defun store-word (word base &optional (offset 0) (lowtag 0))
(declare (type (unsigned-byte #.sb!vm:n-word-bits) word base offset)
- (type (unsigned-byte #.n-lowtag-bits) lowtag))
+ (type (unsigned-byte #.n-lowtag-bits) lowtag))
(setf (sap-ref-word (int-sap base) (- (ash offset word-shift) lowtag)) word))
(defun allocate-static-vector (widetag length words)
(declare (type (unsigned-byte #.n-widetag-bits) widetag)
- (type (unsigned-byte #.n-word-bits) words)
- (type index length))
+ (type (unsigned-byte #.n-word-bits) words)
+ (type index length))
(handler-case
- ;; FIXME: Is WITHOUT-GCING enough to do lisp-side allocation
- ;; to static space, or should we have WITHOUT-INTERRUPTS here
- ;; as well?
+ ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS
(without-gcing
- (let* ((pointer *static-space-free-pointer*) ; in words
- (free (* pointer n-word-bytes))
- (vector (logior free other-pointer-lowtag)) ; in bytes, yay
- ;; rounded to dual word boundary
- (nwords (logandc2 (+ lowtag-mask (+ words vector-data-offset 1))
- lowtag-mask))
- (new-pointer (+ *static-space-free-pointer* nwords))
- (new-free (* new-pointer n-word-bytes)))
- (unless (> static-space-end new-free)
- (error 'simple-storage-condition
- :format-control "Not enough memory left in static space to ~
- allocate vector."))
- (store-word widetag
- vector 0 other-pointer-lowtag)
- (store-word (ash length word-shift)
- vector vector-length-slot other-pointer-lowtag)
- (store-word 0 new-free)
- (prog1
- (make-lisp-obj vector)
- (setf *static-space-free-pointer* new-pointer))))
+ (let* ((pointer *static-space-free-pointer*) ; in words
+ (free (* pointer n-word-bytes))
+ (vector (logior free other-pointer-lowtag)) ; in bytes, yay
+ ;; rounded to dual word boundary
+ (nwords (logandc2 (+ lowtag-mask (+ words vector-data-offset 1))
+ lowtag-mask))
+ (new-pointer (+ *static-space-free-pointer* nwords))
+ (new-free (* new-pointer n-word-bytes)))
+ (unless (> static-space-end new-free)
+ (error 'simple-storage-condition
+ :format-control "Not enough memory left in static space to ~
+ allocate vector."))
+ (store-word widetag
+ vector 0 other-pointer-lowtag)
+ (store-word (ash length word-shift)
+ vector vector-length-slot other-pointer-lowtag)
+ (store-word 0 new-free)
+ (setf *static-space-free-pointer* new-pointer)
+ (%make-lisp-obj vector)))
(serious-condition (c)
;; unwind from WITHOUT-GCING
(error c))))
-
\ No newline at end of file