X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/b426ab51d0598242a4c2b57d563341db66d71f7b..a9cffac12f45d917ae632f4037991d7ba66091fb:/src/class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 2ab6363..8880df5 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -98,8 +98,8 @@
 	 (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))))
@@ -138,7 +138,7 @@
 				raw-name)))
 		 (cond ((and (cdr args) (eq (cadr args) :ellipsis))
 			(setf varargsp t)
-			(unless in-names (setf me "SOD__CAR(__VA_ARGS__)"))
+			(unless in-names (setf me "SOD_CAR(__VA_ARGS__)"))
 			(push (format nil "/*~A*/ ..." name) in-names)
 			(push "__VA_ARGS__" out-names)
 			(return))
@@ -296,11 +296,23 @@
 			 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 @@ const struct ~A ~A__classobj = {~%"
 		   (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 @@ const struct ~A ~A__classobj = {~%"
 		   (*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))