-(defun do-load-time-code-fixup (code offset fixup kind)
- (flet ((add-load-time-code-fixup (code offset)
- (let ((fixups (code-header-ref code sb!vm:code-constants-offset)))
- (cond ((typep fixups '(simple-array (unsigned-byte 32) (*)))
- (let ((new-fixups
- (adjust-array fixups (1+ (length fixups))
- :element-type '(unsigned-byte 32))))
- (setf (aref new-fixups (length fixups)) offset)
- (setf (code-header-ref code sb!vm:code-constants-offset)
- new-fixups)))
- (t
- ;; FIXME: This doesn't look like production code, and
- ;; should be a fatal error, not just a print.
- (unless (or (eq (get-type fixups)
- sb!vm:unbound-marker-type)
- (zerop fixups))
- (%primitive print "** Init. code FU"))
- (setf (code-header-ref code sb!vm:code-constants-offset)
- (make-specializable-array
- 1
- :element-type '(unsigned-byte 32)
- :initial-element offset)))))))
+(defun !envector-load-time-code-fixup (code offset fixup kind)
+ (flet ((frob (code offset)
+ (let ((fixups (code-header-ref code code-constants-offset)))
+ (cond ((typep fixups '(simple-array (unsigned-byte 32) (*)))
+ (let ((new-fixups
+ (adjust-fixup-array fixups (1+ (length fixups)))))
+ (setf (aref new-fixups (length fixups)) offset)
+ (setf (code-header-ref code code-constants-offset)
+ new-fixups)))
+ (t
+ (unless (or (eq (widetag-of fixups)
+ unbound-marker-widetag)
+ (zerop fixups))
+ (sb!impl::!cold-lose "Argh! can't process fixup"))
+ (setf (code-header-ref code code-constants-offset)
+ (make-array
+ 1
+ :element-type '(unsigned-byte 32)
+ :initial-element offset)))))))