(sod-class-nickname target-head)))))))
;;;--------------------------------------------------------------------------
+;;; Static instance declarations.
+
+(export 'declare-static-instance)
+(defgeneric declare-static-instance (instance stream)
+ (:documentation
+ "Write a declaration for the static INSTANCE to STREAM.
+
+ Note that, according to whether the instance is external or private, this
+ may be written as part of the `:h' or `:c' reasons."))
+(defmethod declare-static-instance (instance stream)
+ (with-slots ((class %class) name externp constp) instance
+ (format stream "~:[static~;extern~] ~:[~;const ~]struct ~
+ ~A ~A__instance;~%~
+ #define ~A (&~A__instance.~A.~A)~%"
+ externp constp (ilayout-struct-tag class) name
+ name name (sod-class-nickname (sod-class-chain-head class))
+ (sod-class-nickname class))))
+
+(defmethod hook-output
+ ((instance static-instance) (reason (eql :h)) sequencer)
+ "Write an `extern' declaration for an external static instance."
+ (with-slots (externp) instance
+ (when externp
+ (one-off-output 'static-instances-banner sequencer
+ '(:static-instances :start)
+ (lambda (stream)
+ (banner "Public static instances" stream)))
+ (one-off-output 'static-instances-end sequencer
+ '(:static-instances :end)
+ #'terpri)
+ (sequence-output (stream sequencer)
+ (:static-instances
+ (declare-static-instance instance stream))))))
+
+;;;--------------------------------------------------------------------------
;;; Implementation output.
(export '*instance-class*)
((instance :object super :slots)
(output-class-initializer slot instance stream))))))
+;;;--------------------------------------------------------------------------
+;;; Static instances.
+
+(export '*static-instance*)
+(defvar-unbound *static-instance*
+ "The static instance currently being output.
+
+ This is bound during the `hook-output' traversal of a static instance for
+ `:c', since the slots traversed need to be able to look up initializers
+ from the static instance definition.")
+
+(defmethod hook-output ((instance static-instance)
+ (reason (eql :c)) sequencer)
+ "Write a static instance definition."
+ (with-slots (externp) instance
+ (one-off-output 'static-instances-banner sequencer
+ '(:static-instances :start)
+ (lambda (stream)
+ (banner "Static instance definitions" stream)))
+ (unless externp
+ (one-off-output 'static-instances-forward sequencer
+ '(:static-instances :start)
+ (lambda (stream)
+ (format stream "/* Forward declarations. */~%")))
+ (one-off-output 'static-instances-forward-gap sequencer
+ '(:static-instances :gap)
+ #'terpri)
+ (sequence-output (stream sequencer)
+ ((:static-instances :decls)
+ (declare-static-instance instance stream))))))
+
+(defmethod hook-output ((class sod-class)
+ (reason (eql 'static-instance)) sequencer)
+ "Output the framing around a static instance initializer."
+ (let ((instance *static-instance*))
+ (with-slots ((class %class) name externp constp) instance
+ (sequence-output (stream sequencer)
+ :constraint ((:static-instances :gap)
+ (*static-instance* :start)
+ (*static-instance* :end)
+ (:static-instances :end))
+ ((*static-instance* :start)
+ (format stream "/* Static instance `~A'. */~%~
+ ~:[static ~;~]~:[~;const ~]~
+ struct ~A ~A__instance = {~%"
+ name
+ externp constp
+ (ilayout-struct-tag class) name))
+ ((*static-instance* :end)
+ (format stream "};~2%"))))))
+
+(defmethod hook-output ((ichain ichain)
+ (reason (eql 'static-instance)) sequencer)
+ "Output the initializer for an ichain."
+ (with-slots ((class %class) chain-head chain-tail) ichain
+ (sequence-output (stream sequencer)
+ :constraint ((*static-instance* :start)
+ (*static-instance* :ichain chain-head :start)
+ (*static-instance* :ichain chain-head :end)
+ (*static-instance* :end))
+ ((*static-instance* :ichain chain-head :start)
+ (format stream " { { /* ~A ichain */~%"
+ (sod-class-nickname chain-head)))
+ ((*static-instance* :ichain chain-head :end)
+ (format stream " } },~%")))))
+
+(defmethod hook-output ((islots islots)
+ (reason (eql 'static-instance)) sequencer)
+ "Initialize a static instance's slots."
+ (with-slots ((class %class)) islots
+ (let ((chain-head (sod-class-chain-head class)))
+ (sequence-output (stream sequencer)
+ :constraint
+ ((*static-instance* :ichain chain-head :start)
+ (*static-instance* :slots class :start)
+ (*static-instance* :slots class)
+ (*static-instance* :slots class :end)
+ (*static-instance* :ichain chain-head :end))
+ ((*static-instance* :slots class :start)
+ (format stream " { /* Class ~A */~%" class))
+ ((*static-instance* :slots class :end)
+ (format stream " },~%"))))))
+
+(defmethod hook-output ((vtptr vtable-pointer)
+ (reason (eql 'static-instance)) sequencer)
+ "Initialize a vtable pointer in a static instance.."
+ (with-slots ((class %class) chain-head chain-tail) vtptr
+ (sequence-output (stream sequencer)
+ :constraint ((*static-instance* :ichain chain-head :start)
+ (*static-instance* :vtable chain-head)
+ (*static-instance* :ichain chain-head :end))
+ ((*static-instance* :vtable chain-head)
+ (format stream " /* ~17@A = */ &~A.~A,~%"
+ "_vt"
+ (vtable-name class chain-head)
+ (sod-class-nickname chain-tail))))))
+
+(export 'output-static-instance-initializer)
+(defgeneric output-static-instance-initializer (instance slot stream)
+ (:documentation
+ "Output an initializer for an effective SLOT in a static INSTANCE."))
+(defmethod output-static-instance-initializer ((instance static-instance)
+ (slot effective-slot)
+ stream)
+ (let* ((direct-slot (effective-slot-direct-slot slot))
+ (init (or (find direct-slot
+ (static-instance-initializers instance)
+ :key #'sod-initializer-slot)
+ (effective-slot-initializer slot))))
+ (format stream " /* ~15@A = */ ~A,~%"
+ (sod-slot-name direct-slot)
+ (sod-initializer-value init))))
+
+(defmethod hook-output ((slot effective-slot)
+ (reason (eql 'static-instance)) sequencer)
+ "Initialize a slot in a static instance."
+ (with-slots ((class %class) initializers) *static-instance*
+ (with-slots ((dslot slot)) slot
+ (let ((super (sod-slot-class dslot))
+ (instance *static-instance*))
+ (sequence-output (stream sequencer)
+ ((instance :slots super)
+ (output-static-instance-initializer instance slot stream)))))))
+
+(defmethod hook-output :after
+ ((instance static-instance) (reason (eql :c)) sequencer)
+ (with-slots ((class %class)) instance
+ (let ((*static-instance* instance))
+ (hook-output class 'static-instance sequencer))))
+
;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff