X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3a774b55edfea441c1715994924c2999e9202143..211bf0df3e49bda800a748474ada19dff6f15b5f:/src/class-output.lisp diff --git a/src/class-output.lisp b/src/class-output.lisp index ee77a2c..dec1e4e 100644 --- a/src/class-output.lisp +++ b/src/class-output.lisp @@ -94,10 +94,17 @@ (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) @@ -654,15 +661,6 @@ const struct ~A ~A__classobj = {~%" (vtable-name class chain-head) (sod-class-nickname chain-tail)))))) -(defgeneric find-class-initializer (slot class) - (:method ((slot effective-slot) (class sod-class)) - (let ((dslot (effective-slot-direct-slot slot))) - (or (some (lambda (super) - (find dslot (sod-class-class-initializers super) - :key #'sod-initializer-slot)) - (sod-class-precedence-list class)) - (effective-slot-initializer slot))))) - (defgeneric output-class-initializer (slot instance stream) (:method ((slot sod-class-effective-slot) (instance sod-class) stream) (let ((func (effective-slot-initializer-function slot))