X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/93348ae9e276dec213b5d543338b1e2c53a7b687..refs/heads/mdw/progfmt:/src/class-layout-proto.lisp diff --git a/src/class-layout-proto.lisp b/src/class-layout-proto.lisp index a4ca263..5c755a3 100644 --- a/src/class-layout-proto.lisp +++ b/src/class-layout-proto.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; This file is part of the Sensible Object Design, an object system for C. ;;; ;;; SOD is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -31,10 +31,12 @@ (export '(effective-slot effective-slot-class effective-slot-direct-slot effective-slot-initializer)) (defclass effective-slot () - ((class :initarg :class :type sod-slot :reader effective-slot-class) + ((%class :initarg :class :type sod-class :reader effective-slot-class) (slot :initarg :slot :type sod-slot :reader effective-slot-direct-slot) (initializer :initarg :initializer :type (or sod-initializer null) - :reader effective-slot-initializer)) + :reader effective-slot-initializer) + (initargs :initarg :initargs :initform nil + :type list :reader effective-slot-initargs)) (:documentation "Describes a slot and how it's meant to be initialized. @@ -50,6 +52,14 @@ (:documentation "Return the most specific initializer for SLOT, starting from CLASS.")) +(export 'find-slot-initargs) +(defgeneric find-slot-initargs (class slot) + (:documentation + "Return as a list all of the initargs defined on CLASS to initialize SLOT. + + The list is returned with initargs defined on more specific classes + first.")) + (export 'compute-effective-slot) (defgeneric compute-effective-slot (class slot) (:documentation @@ -58,6 +68,19 @@ SLOT is a direct slot defined on CLASS or one of its superclasses. (Metaclass initializers are handled using a different mechanism.)")) +(export 'find-class-initializer) +(defgeneric find-class-initializer (slot class) + (:documentation + "Return an initializer value (any printable value) for a class slot SLOT. + + The initializer might come either from the SLOT's defining class (which it + already knows), or from the instance CLASS, of which the defining class is + be (a superclass of) the metaclass. + + This is used as part of `has-class-initializer-p' and the default output + hook for `effective-slot': if you override both of those then you don't + need to override this too.")) + ;;;-------------------------------------------------------------------------- ;;; Instance layout. @@ -65,7 +88,7 @@ (export '(islots islots-class islots-subclass islots-slots)) (defclass islots () - ((class :initarg :class :type sod-class :reader islots-class) + ((%class :initarg :class :type sod-class :reader islots-class) (subclass :initarg :subclass :type sod-class :reader islots-subclass) (slots :initarg :slots :type list :reader islots-slots)) (:documentation @@ -88,7 +111,7 @@ (export '(vtable-pointer vtable-pointer-class vtable-pointer-chain-head vtable-pointer-chain-tail)) (defclass vtable-pointer () - ((class :initarg :class :type sod-class :reader vtable-pointer-class) + ((%class :initarg :class :type sod-class :reader vtable-pointer-class) (chain-head :initarg :chain-head :type sod-class :reader vtable-pointer-chain-head) (chain-tail :initarg :chain-tail :type sod-class @@ -106,7 +129,7 @@ (export '(ichain ichain-class ichain-head ichain-tail ichain-body)) (defclass ichain () - ((class :initarg :class :type sod-class :reader ichain-class) + ((%class :initarg :class :type sod-class :reader ichain-class) (chain-head :initarg :chain-head :type sod-class :reader ichain-head) (chain-tail :initarg :chain-tail :type sod-class :reader ichain-tail) (body :initarg :body :type list :reader ichain-body)) @@ -133,7 +156,7 @@ (export '(ilayout ilayout-class ilayout-ichains)) (defclass ilayout () - ((class :initarg :class :type sod-class :reader ilayout-class) + ((%class :initarg :class :type sod-class :reader ilayout-class) (ichains :initarg :ichains :type list :reader ilayout-ichains)) (:documentation "All of the instance layout for a class. @@ -151,8 +174,10 @@ ;;; vtmsgs +(export '(vtmsgs vtmsgs-class vtmsgs-subclass + vtmsgs-chain-head vtmsgs-chain-tail vtmsgs-entries)) (defclass vtmsgs () - ((class :initarg :class :type sod-class :reader vtmsgs-class) + ((%class :initarg :class :type sod-class :reader vtmsgs-class) (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass) (chain-head :initarg :chain-head :type sod-class :reader vtmsgs-chain-head) @@ -186,7 +211,7 @@ (export '(class-pointer class-pointer-class class-pointer-chain-head class-pointer-metaclass class-pointer-meta-chain-head)) (defclass class-pointer () - ((class :initarg :class :type sod-class :reader class-pointer-class) + ((%class :initarg :class :type sod-class :reader class-pointer-class) (chain-head :initarg :chain-head :type sod-class :reader class-pointer-chain-head) (metaclass :initarg :metaclass :type sod-class @@ -216,7 +241,7 @@ (export '(base-offset base-offset-class base-offset-chain-head)) (defclass base-offset () - ((class :initarg :class :type sod-class :reader base-offset-class) + ((%class :initarg :class :type sod-class :reader base-offset-class) (chain-head :initarg :chain-head :type sod-class :reader base-offset-chain-head)) (:documentation @@ -237,7 +262,7 @@ (export '(chain-offset chain-offset-class chain-offset-chain-head chain-offset-target-head)) (defclass chain-offset () - ((class :initarg :class :type sod-class :reader chain-offset-class) + ((%class :initarg :class :type sod-class :reader chain-offset-class) (chain-head :initarg :chain-head :type sod-class :reader chain-offset-chain-head) (target-head :initarg :target-head :type sod-class @@ -254,6 +279,7 @@ object's metadata; but that would either require a search or we'd have to be able work out the target chain's index in the table.")) +(export 'make-chain-offset) (defgeneric make-chain-offset (class chain-head target-head) (:documentation "Return the offset from CHAIN-HEAD to TARGET-HEAD.")) @@ -263,7 +289,7 @@ (export '(vtable vtable-class vtable-body vtable-chain-head vtable-chain-tail)) (defclass vtable () - ((class :initarg :class :type sod-class :reader vtable-class) + ((%class :initarg :class :type sod-class :reader vtable-class) (chain-head :initarg :chain-head :type sod-class :reader vtable-chain-head) (chain-tail :initarg :chain-tail :type sod-class