;;;; retained in such a way that we can get to it even on vanilla
;;;; ANSI Common Lisp at cross-compiler build time.
;;;; 2. MAKE-LOAD-FORM information is stored in such a way that we can
;;;; retained in such a way that we can get to it even on vanilla
;;;; ANSI Common Lisp at cross-compiler build time.
;;;; 2. MAKE-LOAD-FORM information is stored in such a way that we can
-;;;; get to it at bootstrap time before CLOS is built.
+;;;; get to it at bootstrap time before CLOS is built. This is
+;;;; important because at least as of sbcl-0.6.11.26, CLOS is built
+;;;; (compiled) after cold init, so we need to have the compiler
+;;;; even before CLOS runs.
;; (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))
;; (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))
;; 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
;; 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
(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
(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
(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))
(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))
- (assert (not include-clause))
- (unless include-clause
- (setf def!struct-supertype 'structure!object)
- (push `(:include ,def!struct-supertype) options)))
+ (aver (not include-clause))
+ (unless include-clause
+ (setf def!struct-supertype 'structure!object)
+ (push `(:include ,def!struct-supertype) options)))
(values name `((,name ,@options) ,@rest) mlff def!struct-supertype)))))
;;; Part of the raison d'etre for DEF!STRUCT is to be able to emulate
(values name `((,name ,@options) ,@rest) mlff def!struct-supertype)))))
;;; Part of the raison d'etre for DEF!STRUCT is to be able to emulate
- layout
- (let* ((dd (layout-info layout))
- (dsd (elt (dd-slots dd) (1- index)))
- (accessor (dsd-accessor dsd)))
- (declare (type symbol accessor))
- (funcall accessor instance)))))
+ layout
+ (let* ((dd (layout-info layout))
+ (dsd (elt (dd-slots dd) (1- index)))
+ (accessor-name (dsd-accessor-name dsd)))
+ (declare (type symbol accessor-name))
+ (funcall accessor-name instance)))))
- (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))))))
+ (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-name (dsd-accessor-name dsd)))
+ (declare (type symbol accessor-name))
+ (funcall (fdefinition `(setf ,accessor-name))
+ new-value
+ instance))))))
(destructuring-bind (name-and-options &rest slots-and-doc) defstruct-args
(multiple-value-bind (name options)
(if (symbolp name-and-options)
(destructuring-bind (name-and-options &rest slots-and-doc) defstruct-args
(multiple-value-bind (name options)
(if (symbolp name-and-options)
- ;; (Putting the DEFSTRUCT here, outside the EVAL-WHEN, seems to
- ;; be necessary in order to cross-compile the hash table
- ;; implementation. -- WHN 19990809)
+ ;; Make sure that we really do include STRUCTURE!OBJECT. (If an
+ ;; :INCLUDE clause was used, and the included class didn't
+ ;; itself include STRUCTURE!OBJECT, then we wouldn't; and it's
+ ;; better to find out ASAP then to let the bug lurk until
+ ;; someone tries to do MAKE-LOAD-FORM on the object.)
+ (aver (subtypep ',def!struct-supertype 'structure!object))
- (progn
- (mapcar (lambda (x)
- (let ((*package* (delayed-def!struct-package x)))
- ;; KLUDGE(?): EVAL is almost always the wrong thing.
- ;; However, since we have to map DEFSTRUCT over the
- ;; list, and since ANSI declined to specify any
- ;; functional primitives corresponding to the
- ;; DEFSTRUCT macro, it seems to me that EVAL is
- ;; required in there somewhere..
- (eval `(sb!xc:defstruct ,@(delayed-def!struct-args x)))))
- (reverse *delayed-def!structs*))
- ;; We shouldn't need this list any more. Making it unbound
- ;; serves as a signal to DEF!STRUCT that it needn't delay
- ;; DEF!STRUCTs any more. It is also generally a good thing for
- ;; other reasons: it frees garbage, and it discourages anyone
- ;; else from pushing anything else onto the list later.
- (makunbound '*delayed-def!structs*))
- ;; This condition is probably harmless if it comes up when
- ;; interactively experimenting with the system by loading a source
- ;; file into it more than once. But it's worth warning about it
- ;; because it definitely shouldn't come up in an ordinary build
- ;; process.
- (warn "*DELAYED-DEF!STRUCTS* is already unbound.")))
+ (progn
+ (mapcar (lambda (x)
+ (let ((*package* (delayed-def!struct-package x)))
+ ;; KLUDGE(?): EVAL is almost always the wrong thing.
+ ;; However, since we have to map DEFSTRUCT over the
+ ;; list, and since ANSI declined to specify any
+ ;; functional primitives corresponding to the
+ ;; DEFSTRUCT macro, it seems to me that EVAL is
+ ;; required in there somewhere..
+ (eval `(sb!xc:defstruct ,@(delayed-def!struct-args x)))))
+ (reverse *delayed-def!structs*))
+ ;; We shouldn't need this list any more. Making it unbound
+ ;; serves as a signal to DEF!STRUCT that it needn't delay
+ ;; DEF!STRUCTs any more. It is also generally a good thing for
+ ;; other reasons: it frees garbage, and it discourages anyone
+ ;; else from pushing anything else onto the list later.
+ (makunbound '*delayed-def!structs*))
+ ;; This condition is probably harmless if it comes up when
+ ;; interactively experimenting with the system by loading a source
+ ;; file into it more than once. But it's worth warning about it
+ ;; because it definitely shouldn't come up in an ordinary build
+ ;; process.
+ (warn "*DELAYED-DEF!STRUCTS* is already unbound.")))
-;;; hierarchy for objects which use DEF!STRUCT functionality.
+;;; hierarchy for objects which have/use DEF!STRUCT functionality.
+;;; (The extra hackery in DEF!STRUCT-defined things isn't needed for
+;;; STRUCTURE-OBJECTs defined by ordinary, post-warm-init programs, so
+;;; it's only put into STRUCTURE-OBJECTs which inherit from
+;;; STRUCTURE!OBJECT.)