src/class-output.lisp: Make `__CONV_' macros more robust.

[sod] / src / class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 2ab636392fd50fe66384c80d4c48e21c147534fc..d914864baa13410af4fe3943dc42e30638b78a3b 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -98,8 +98,8 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
         (format stream "/* Conversion macros. */~%")
         (dolist (super (cdr (sod-class-precedence-list class)))
           (let ((super-head (sod-class-chain-head super)))
-            (format stream "#define ~:@(~A__CONV_~A~)(p) ((~A *)~
-                                    ~:[SOD_XCHAIN(~A, (p))~;(p)~])~%"
+            (format stream "#define ~:@(~A__CONV_~A~)(_obj) ((~A *)~
+                                    ~:[SOD_XCHAIN(~A, (_obj))~;(_obj)~])~%"
                     class (sod-class-nickname super) super
                     (eq chain-head super-head)
                     (sod-class-nickname super-head))))
@@ -296,11 +296,23 @@ (defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer)
                         struct ~A {~%"
                 (vtable-struct-tag chain-tail chain-head)))
        ((class :vtable chain-head :end)
-        (format stream "};~2%"))))
+        (format stream "};~2%")
+        (format stream "/* Union of equivalent superclass vtables. */~@
+                        union ~A {~@
+                        ~:{  struct ~A ~A;~%~}~
+                        };~2%"
+                (vtable-union-tag chain-tail chain-head)
+
+                ;; As for the ichain union, make sure the most specific
+                ;; class is first.
+                (mapcar (lambda (super)
+                          (list (vtable-struct-tag super chain-head)
+                                (sod-class-nickname super)))
+                        (sod-class-chain chain-tail))))))
     (sequence-output (stream sequencer)
       ((class :vtable-externs)
-       (format stream "~@<extern const struct ~A ~2I~_~A__vtable_~A;~:>~%"
-              (vtable-struct-tag chain-tail chain-head)
+       (format stream "~@<extern const union ~A ~2I~_~A__vtable_~A;~:>~%"
+              (vtable-union-tag chain-tail chain-head)
               class (sod-class-nickname chain-head))))))
 
 (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
@@ -470,12 +482,12 @@ (defmethod hook-output progn ((vtable vtable) (reason (eql :c)) sequencer)
                   (class :vtables :end))
       ((class :vtable chain-head :start)
        (format stream "/* Vtable for ~A chain. */~@
-                      const struct ~A ~A = {~%"
+                      const union ~A ~A = { {~%"
               chain-head
-              (vtable-struct-tag chain-tail chain-head)
+              (vtable-union-tag chain-tail chain-head)
               (vtable-name class chain-head)))
       ((class :vtable chain-head :end)
-       (format stream "};~2%")))))
+       (format stream "} };~2%")))))
 
 (defmethod hook-output progn ((cptr class-pointer)
                              (reason (eql :c))
@@ -592,8 +604,10 @@ (defmethod hook-output progn ((vtptr vtable-pointer)
                   (*instance-class* :object chain-head :vtable)
                   (*instance-class* :object chain-head :ichain :end))
       ((*instance-class* :object chain-head :vtable)
-       (format stream "      &~A__vtable_~A,~%"
-              class (sod-class-nickname chain-head))))))
+       (format stream "      /* ~17@A = */ &~A.~A,~%"
+              "_vt"
+              (vtable-name class chain-head)
+              (sod-class-nickname chain-tail))))))
 
 (defgeneric find-class-initializer (slot class)
   (:method ((slot effective-slot) (class sod-class))