- ;; Unless VALUE is an object which which obviously
- ;; can't contain other objects
- (unless (typep value
- '(or #-sb-xc-host unboxed-array
- symbol
- number
- character
- string))
- (etypecase things-processed
- (list
- (when (member value things-processed :test #'eq)
- (return-from grovel nil))
- (push value things-processed)
- (incf count)
- (when (> count list-to-hash-table-threshold)
- (let ((things things-processed))
- (setf things-processed
- (make-hash-table :test 'eq))
- (dolist (thing things)
- (setf (gethash thing things-processed) t)))))
- (hash-table
- (when (gethash value things-processed)
- (return-from grovel nil))
- (setf (gethash value things-processed) t)))
- (typecase value
- (cons
- (grovel (car value))
- (grovel (cdr value)))
- (simple-vector
- (dotimes (i (length value))
- (grovel (svref value i))))
- ((vector t)
- (dotimes (i (length value))
- (grovel (aref value i))))
- ((simple-array t)
- ;; Even though the (ARRAY T) branch does the exact
- ;; same thing as this branch we do this separately
- ;; so that the compiler can use faster versions of
- ;; array-total-size and row-major-aref.
- (dotimes (i (array-total-size value))
- (grovel (row-major-aref value i))))
- ((array t)
- (dotimes (i (array-total-size value))
- (grovel (row-major-aref value i))))
- (;; In the target SBCL, we can dump any instance,
- ;; but in the cross-compilation host,
- ;; %INSTANCE-FOO functions don't work on general
- ;; instances, only on STRUCTURE!OBJECTs.
- #+sb-xc-host structure!object
- #-sb-xc-host instance
- (when (emit-make-load-form value)
- (dotimes (i (%instance-length value))
- (grovel (%instance-ref value i)))))
- (t
- (compiler-error
- "Objects of type ~S can't be dumped into fasl files."
- (type-of value)))))))
+ ;; Unless VALUE is an object which which obviously
+ ;; can't contain other objects
+ (unless (typep value
+ '(or #-sb-xc-host unboxed-array
+ #+sb-xc-host (simple-array (unsigned-byte 8) (*))
+ symbol
+ number
+ character
+ string))
+ (etypecase things-processed
+ (list
+ (when (member value things-processed :test #'eq)
+ (return-from grovel nil))
+ (push value things-processed)
+ (incf count)
+ (when (> count list-to-hash-table-threshold)
+ (let ((things things-processed))
+ (setf things-processed
+ (make-hash-table :test 'eq))
+ (dolist (thing things)
+ (setf (gethash thing things-processed) t)))))
+ (hash-table
+ (when (gethash value things-processed)
+ (return-from grovel nil))
+ (setf (gethash value things-processed) t)))
+ (typecase value
+ (cons
+ (grovel (car value))
+ (grovel (cdr value)))
+ (simple-vector
+ (dotimes (i (length value))
+ (grovel (svref value i))))
+ ((vector t)
+ (dotimes (i (length value))
+ (grovel (aref value i))))
+ ((simple-array t)
+ ;; Even though the (ARRAY T) branch does the exact
+ ;; same thing as this branch we do this separately
+ ;; so that the compiler can use faster versions of
+ ;; array-total-size and row-major-aref.
+ (dotimes (i (array-total-size value))
+ (grovel (row-major-aref value i))))
+ ((array t)
+ (dotimes (i (array-total-size value))
+ (grovel (row-major-aref value i))))
+ (;; In the target SBCL, we can dump any instance,
+ ;; but in the cross-compilation host,
+ ;; %INSTANCE-FOO functions don't work on general
+ ;; instances, only on STRUCTURE!OBJECTs.
+ #+sb-xc-host structure!object
+ #-sb-xc-host instance
+ (when (emit-make-load-form value)
+ (dotimes (i (- (%instance-length value)
+ #+sb-xc-host 0
+ #-sb-xc-host (layout-n-untagged-slots
+ (%instance-ref value 0))))
+ (grovel (%instance-ref value i)))))
+ (t
+ (compiler-error
+ "Objects of type ~S can't be dumped into fasl files."
+ (type-of value)))))))