X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/944bf9362ff51217b1617f85126d26e821b8aa91..00d59354c311fb28730b7c9b117b0d91aac092cc:/src/class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 45a4909..0dfd30a 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -539,6 +539,41 @@
 		 (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*)
@@ -869,4 +904,134 @@ const struct ~A ~A__classobj = {~%"
 	((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 --------------------------------------------------