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

[sod] / src / builtin.lisp

diff --git a/src/builtin.lisp b/src/builtin.lisp
index 6374e6d..ffd8451 100644 (file)
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -233,6 +233,19 @@ static const SodClass *const ~A__cpl[] = {
                                                      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 @@ static const SodClass *const ~A__cpl[] = {
               (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