;;; information for DEF!STRUCT-defined types
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
- ;; FIXME: All this could be byte compiled. (Perhaps most of the rest
- ;; of the file could be, too.)
-
;; (DEF!STRUCT-SUPERTYPE TYPE) is the DEF!STRUCT-defined type that
;; TYPE inherits from, or NIL if none.
(defvar *def!struct-supertype* (make-hash-table))
(defun (setf def!struct-type-make-load-form-fun) (new-value type)
(when #+sb-xc-host t #-sb-xc-host *type-system-initialized*
(aver (subtypep type 'structure!object))
- (check-type new-value def!struct-type-make-load-form-fun))
+ (aver (typep new-value 'def!struct-type-make-load-form-fun)))
(setf (gethash type *def!struct-type-make-load-form-fun*) new-value)))
;;; the simplest, most vanilla MAKE-LOAD-FORM function for DEF!STRUCT
;;; objects
(defun just-dump-it-normally (object &optional (env nil env-p))
(declare (type structure!object object))
+ (declare (ignorable env env-p))
+ ;; KLUDGE: we require essentially three different behaviours of
+ ;; JUST-DUMP-IT-NORMALLY, two of which (host compiler's
+ ;; MAKE-LOAD-FORM, cross-compiler's MAKE-LOAD-FORM) are handled by
+ ;; the #+SB-XC-HOST clause. The #-SB-XC-HOST clause is the
+ ;; behaviour required by the target, before the CLOS-based
+ ;; MAKE-LOAD-FORM-SAVING-SLOTS is implemented.
+ #+sb-xc-host
(if env-p
- (make-load-form-saving-slots object :environment env)
- (make-load-form-saving-slots object)))
+ (sb!xc:make-load-form-saving-slots object :environment env)
+ (sb!xc:make-load-form-saving-slots object))
+ #-sb-xc-host
+ :sb-just-dump-it-normally)
;;; a MAKE-LOAD-FORM function for objects which don't use the load
;;; form system. This is used for LAYOUT objects because the special
;; a description of a DEF!STRUCT call to be stored until we get
;; enough of the system running to finish processing it
(defstruct delayed-def!struct
- (args (required-argument) :type cons)
+ (args (missing-arg) :type cons)
(package (sane-package) :type package))
;; a list of DELAYED-DEF!STRUCTs stored until we get DEF!STRUCT
;; working fully so that we can apply it to them then. After
;; DEF!STRUCT is made to work fully, this list is processed, then
;; made unbound, and should no longer be used.
(defvar *delayed-def!structs* nil))
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
;; Parse the arguments for a DEF!STRUCT call, and return
;; (VALUES NAME DEFSTRUCT-ARGS MAKE-LOAD-FORM-FUN DEF!STRUCT-SUPERTYPE),
;; where NAME is the name of the new type, DEFSTRUCT-ARGS is the
(if (consp nameoid)
(values (first nameoid) (rest nameoid))
(values nameoid nil))
+ (declare (type list options))
(let* ((include-clause (find :include options :key #'first))
(def!struct-supertype nil) ; may change below
(mlff-clause (find :make-load-form-fun options :key #'first))
#+sb-xc-host
(progn
(defun %instance-length (instance)
- (check-type instance structure!object)
- (layout-length (class-layout (sb!xc:find-class (type-of instance)))))
+ (aver (typep instance 'structure!object))
+ (layout-length (classoid-layout (find-classoid (type-of instance)))))
(defun %instance-ref (instance index)
- (check-type instance structure!object)
- (let* ((class (sb!xc:find-class (type-of instance)))
- (layout (class-layout class)))
+ (aver (typep instance 'structure!object))
+ (let* ((class (find-classoid (type-of instance)))
+ (layout (classoid-layout class)))
(if (zerop index)
layout
(let* ((dd (layout-info layout))
(dsd (elt (dd-slots dd) (1- index)))
- (accessor (dsd-accessor dsd)))
- (declare (type symbol accessor))
- (funcall accessor instance)))))
+ (accessor-name (dsd-accessor-name dsd)))
+ (declare (type symbol accessor-name))
+ (funcall accessor-name instance)))))
(defun %instance-set (instance index new-value)
- (check-type instance structure!object)
- (let* ((class (sb!xc:find-class (type-of instance)))
- (layout (class-layout class)))
+ (aver (typep instance 'structure!object))
+ (let* ((class (find-classoid (type-of instance)))
+ (layout (classoid-layout class)))
(if (zerop index)
(error "can't set %INSTANCE-REF FOO 0 in cross-compilation host")
(let* ((dd (layout-info layout))
(dsd (elt (dd-slots dd) (1- index)))
- (accessor (dsd-accessor dsd)))
- (declare (type symbol accessor))
- (funcall (fdefinition `(setf ,accessor)) new-value instance))))))
+ (accessor-name (dsd-accessor-name dsd)))
+ (declare (type symbol accessor-name))
+ (funcall (fdefinition `(setf ,accessor-name))
+ new-value
+ instance))))))
;;; a helper function for DEF!STRUCT in the #+SB-XC-HOST case: Return
;;; DEFSTRUCT-style arguments with any class names in the SB!XC