src/builtin.lisp: Bind `me' around slot initializers, and define the order.

Previously, the `init' method kernel (and the `init' class-slot function
before that) initialized one chain at a time, then down the chains,
because this made for a convenient traversal of the class layout.  But
it sucks for users.

Make this better.  Bind `me' around slot initializers -- to the type of
the direct slot.  This means that initializers can compute their values
based on other previously initialized slots, which is useful because
subclasses can override initializers for their superclasses.

The `me' pointer has the type of the class owning the direct slots being
initialized, which means that referring to substructure belonging to
classes other than the superclasses of the slot owner is hard, even if
the initializer can be sure (because it was defined on some subclass)
that those other classes are available.  This is nonetheless the right
thing because (a) it means that the `me' pointer has a reliable type,
and (b) the slots belonging any other classes which might be of interest
won't have been initialized by this point.

Take the opportunity to clarify the documentation regarding slot
initialization generally.

diff --git a/doc/concepts.tex b/doc/concepts.tex
index 39cccb8824c4e807f019c74bd9c6a12569749df3..f5e3a2f832e938e8647a4b717076cc26b01513e6 100644 (file)
--- a/doc/concepts.tex
+++ b/doc/concepts.tex
@@ -259,6 +259,17 @@ expressions if the generated code is expected to be processed by a
 implementation of C89.  Initializers will be evaluated once each time an
 instance is initialized.
 
+Slots are initialized in reverse-precedence order of their defining classes;
+i.e., slots defined by a less specific superclass are initialized earlier
+than slots defined by a more specific superclass.  Slots defined by the same
+class are initialized in the order in which they appear in the class
+definition.
+
+The initializer for a slot may refer to other slots in the same object, via
+the @|me| pointer: in an initializer for a slot defined by a class $C$, @|me|
+has type `pointer to $C$'.  (Note that the type of @|me| depends only on the
+class which defined the slot, not the class which defined the initializer.)
+
 
 \subsection{C language integration} \label{sec:concepts.classes.c}
 
@@ -736,6 +747,14 @@ superclasses.  This default behaviour may be invoked multiple times if some
 method calls on its @|next_method| more than once, unless some other method
 takes steps to prevent this.
 
+Slots are initialized in a well-defined order.
+\begin{itemize}
+\item Slots defined by a more specific superclasses are initialized after
+  slots defined by a less specific superclass.
+\item Slots defined by the same class are initialized in the order in which
+  their definitions appear.
+\end{itemize}
+
 The recommended way to add new initialization behaviour is to define @|after|
 methods on the @|init| message.  These will be run after the slot
 initializers have been applied, in reverse precedence order.

diff --git a/doc/structures.tex b/doc/structures.tex
index 51e71f9a09022742bf53f4277bbe1db4fee38915..c31503e46817abe6bdbbbf2d938db7a3a02d722d 100644 (file)
--- a/doc/structures.tex
+++ b/doc/structures.tex
@@ -151,6 +151,12 @@ recommended.
     specific applicable initializer, if any.  Slots without an initializer
     are left uninitialized.
 
+    Slots are initialized in reverse-precedence order of their defining
+    classes; i.e., slots defined by a less specific superclass are
+    initialized earlier than slots defined by a more specific superclass.
+    Slots defined by the same class are initialized in the order in which
+    they appear in the class definition.
+
     There are no standard keyword arguments; methods on subclasses are free
     to introduce their own in the usual way.
 

diff --git a/src/builtin.lisp b/src/builtin.lisp
index 6374e6ddb88750106cb79bd499eecbfe36bc55ac..ffd84518982bc719ef19d4d2672674eee0027f76 100644 (file)
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -233,6 +233,19 @@ (defmethod simple-method-body
                                                      codegen
                                                      target))))
 
+;; Utilities.
+
+(defun declare-me (codegen class)
+  "Emit, to CODEGEN, a declaration of `me' as a pointer to CLASS.
+
+   The pointer refers to a part of the prevailing `sod__obj' object, which is
+   assumed to be a pointer to an appropriate `ilayout' structure."
+  (emit-decl codegen (make-var-inst "me" (c-type (* (class class)))
+                                   (format nil "&sod__obj->~A.~A"
+                                           (sod-class-nickname
+                                            (sod-class-chain-head class))
+                                           (sod-class-nickname class)))))
+
 ;; Initialization.
 
 (defclass initialization-message (lifecycle-message)
@@ -267,31 +280,48 @@ (defmethod lifecycle-method-kernel
               (deliver-expr codegen var *sod-tmp-val*)
               (codegen-pop-block codegen)))
 
-      ;; Loop over the instance layout emitting initializers as we find them.
-      (dolist (ichain (ilayout-ichains ilayout))
-       (let ((ich (format nil "sod__obj->~A.~A"
-                          (sod-class-nickname (ichain-head ichain))
-                          (sod-class-nickname (ichain-tail ichain)))))
-         (dolist (item (ichain-body ichain))
-           (etypecase item
-             (vtable-pointer
-              nil)
-             (islots
-              (let ((isl (format nil "~A.~A"
-                                 ich
-                                 (sod-class-nickname (islots-class item)))))
-                (dolist (slot (islots-slots item))
-                  (let ((dslot (effective-slot-direct-slot slot))
-                        (init (effective-slot-initializer slot)))
-                    (when init
-                      (let* ((slot-type (sod-slot-type dslot))
-                             (slot-default (sod-initializer-value init))
-                             (target (format nil "~A.~A"
-                                             isl (sod-slot-name dslot)))
-                             (initinst (set-from-initializer target
-                                                             slot-type
-                                                             slot-default)))
-                        (emit-inst codegen initinst))))))))))))
+      ;; Initialize the structure defined by the various superclasses, in
+      ;; reverse precedence order.
+      (dolist (super (reverse (sod-class-precedence-list class)))
+       (let* ((ichain (find (sod-class-chain-head super)
+                            (ilayout-ichains ilayout)
+                            :key #'ichain-head))
+              (islots (find super (ichain-body ichain)
+                            :test (lambda (class item)
+                                    (and (typep item 'islots)
+                                         (eq (islots-class item) class)))))
+              (this-class-focussed-p nil)
+              (isl (format nil "me->~A" (sod-class-nickname super))))
+
+         (flet ((focus-this-class ()
+                  ;; Delayed initial preparation.  Don't bother defining the
+                  ;; `me' pointer if there's actually nothing to do.
+                  (unless this-class-focussed-p
+                    (emit-banner codegen
+                                 "Initialization for class `~A'." super)
+                    (codegen-push codegen)
+                    (declare-me codegen super)
+                    (setf this-class-focussed-p t))))
+
+           ;; Work through each slot in turn.
+           (dolist (slot (and islots (islots-slots islots)))
+             (let ((dslot (effective-slot-direct-slot slot))
+                   (init (effective-slot-initializer slot)))
+               (when init
+                 (focus-this-class)
+                 (let* ((slot-type (sod-slot-type dslot))
+                        (slot-default (sod-initializer-value init))
+                        (target (format nil "~A.~A"
+                                        isl (sod-slot-name dslot)))
+                        (initinst (set-from-initializer target
+                                                        slot-type
+                                                        slot-default)))
+                   (emit-inst codegen initinst)))))
+
+           ;; If we opened a block to initialize this class then close it
+           ;; again.
+           (when this-class-focussed-p
+             (emit-inst codegen (codegen-pop-block codegen)))))))
 
     ;; Done making the initialization function.
     (codegen-pop-function codegen func-name func-type