X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/27ec3825bd945bcdae0dca8ab2b4475c4722b313..43ce48fd4112471e4c7ef083297688fc45add4a8:/src/builtin.lisp

diff --git a/src/builtin.lisp b/src/builtin.lisp
index ffd8451..d7d0fcb 100644
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -290,6 +290,7 @@ static const SodClass *const ~A__cpl[] = {
 			     :test (lambda (class item)
 				     (and (typep item 'islots)
 					  (eq (islots-class item) class)))))
+	       (frags (sod-class-initfrags super))
 	       (this-class-focussed-p nil)
 	       (isl (format nil "me->~A" (sod-class-nickname super))))
 
@@ -318,6 +319,17 @@ static const SodClass *const ~A__cpl[] = {
 							 slot-default)))
 		    (emit-inst codegen initinst)))))
 
+	    ;; Emit the class's initialization fragments.
+	    (when frags
+	      (let ((used-me-p this-class-focussed-p))
+		(focus-this-class)
+		(unless used-me-p
+		  (deliver-call codegen :void "SOD__IGNORE" "me")))
+	      (dolist (frag frags)
+		(codegen-push codegen)
+		(emit-inst codegen frag)
+		(emit-inst codegen (codegen-pop-block codegen))))
+
 	    ;; If we opened a block to initialize this class then close it
 	    ;; again.
 	    (when this-class-focussed-p
@@ -331,6 +343,44 @@ static const SodClass *const ~A__cpl[] = {
 
     (deliver-call codegen :void func-name "sod__obj")))
 
+;; Teardown.
+
+(defclass teardown-message (lifecycle-message)
+  ())
+
+(defclass teardown-effective-method (lifecycle-effective-method)
+  ())
+
+(defmethod sod-message-effective-method-class ((message teardown-message))
+  'teardown-effective-method)
+
+(defmethod lifecycle-method-kernel
+    ((method teardown-effective-method) codegen target)
+  (let* ((class (effective-method-class method))
+	 (obj-tag (ilayout-struct-tag class))
+	 (func-type (c-type (fun void ("sod__obj" (* (struct obj-tag))))))
+	 (func-name (format nil "~A__teardown" class)))
+    (codegen-push codegen)
+    (dolist (super (sod-class-precedence-list class))
+      (let ((frags (sod-class-tearfrags super)))
+	(when frags
+	  (emit-banner codegen "Teardown for class `~A'." super)
+	  (codegen-push codegen)
+	  (declare-me codegen super)
+	  (deliver-call codegen :void "SOD__IGNORE" "me")
+	  (dolist (frag frags)
+	    (codegen-push codegen)
+	    (emit-inst codegen frag)
+	    (emit-inst codegen (codegen-pop-block codegen)))
+	  (emit-inst codegen (codegen-pop-block codegen)))))
+    (codegen-pop-function codegen func-name func-type
+			  "Instance teardown function ~:_~
+			   for class `~A'."
+			  class)
+    (deliver-call codegen :void
+		  (format nil "~A__teardown" class) "sod__obj")
+    (deliver-expr codegen target 0)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Bootstrapping the class graph.
 
@@ -351,6 +401,8 @@ static const SodClass *const ~A__cpl[] = {
 		      (c-type (fun void :keys))
 		      (make-property-set
 		       :message-class 'initialization-message))
+    (make-sod-message sod-object "teardown" (c-type (fun int))
+		      (make-property-set :message-class 'teardown-message))
 
     ;; Sort out the recursion.
     (setf (slot-value sod-class 'chain-link) sod-object)