src/class-output.lisp: Generate more general class-object macros.

[sod] / src / class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 8d1d93e3974e8e3c4a1cc5290675bf3238747f2a..dec1e4eed13c7484a6b9211268c4aa4a86503e66 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -94,10 +94,17 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
           (metaroot (find-root-metaclass class)))
        (format stream "/* The class object. */~@
                       extern const struct ~A ~A__classobj;~@
-                      #define ~:*~A__class (&~:*~A__classobj.~A.~A)~2%"
+                      #define ~:*~A__class (&~:*~A__classobj.~A.~A)~%"
               (ilayout-struct-tag metaclass) class
               (sod-class-nickname (sod-class-chain-head metaroot))
-              (sod-class-nickname metaroot)))))
+              (sod-class-nickname metaroot))
+       (dolist (chain (sod-class-chains metaclass))
+        (let ((tail (car chain)))
+          (unless (eq tail metaroot)
+            (format stream "#define ~A__cls_~A (&~2:*~A__classobj.~A.~A)~%"
+                    class (sod-class-nickname (sod-class-chain-head tail))
+                    (sod-class-nickname tail)))))
+       (terpri stream))))
 
   ;; Maybe generate an islots structure.
   (when (sod-class-slots class)