Added support for checking finalised objects

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@8638 8c9fc860-2736-0410-a75d-ab315db34111

source/Coop.Heaps.Mod

@@ -10,7 +10,7 @@ MODULE Heaps;	(** AUTHOR "pjm/Luc Bläser/U. Glavitsch (ug)"; PURPOSE "Heap mana
 		Knuth, The Art of Computer Programming, Volume 1, Section 2.3.5, Algorithm C
 *)
 
-IMPORT SYSTEM, Trace, Machine, GarbageCollector;
+IMPORT SYSTEM, Trace, Machine, GarbageCollector, BaseTypes;
 
 CONST
 	Stats* = TRUE;					(* maintain statistical counters *)
@@ -53,10 +53,10 @@ TYPE
 	Finalizer* = PROCEDURE {DELEGATE} (obj: ANY);
 
 	FinalizerNode* = POINTER TO RECORD
-		objWeak* (*{UNTRACED}*): ANY;	(* weak reference to checked object *)
+		objWeak* {UNTRACED}: ANY;	(* weak reference to checked object *)
 		nextFin: FinalizerNode;			(* in finalization list *)
 		objStrong*: ANY;				(* strong reference to object to be finalized *)
-		finalizer* (*{UNTRACED}*) : Finalizer;(* finalizer, if any. Untraced for the case that a finalizer points to objWeak *)
+		finalizer* {UNTRACED}: Finalizer;(* finalizer, if any. Untraced for the case that a finalizer points to objWeak *)
 		finalizerStrong: Finalizer; 		(* strong reference to the object that is referenced by the finalizer, if any *)
 	END;
 
@@ -156,6 +156,46 @@ END CheckCandidates;
 PROCEDURE CheckAssignment*(dest, src: ADDRESS);
 END CheckAssignment;
 
+(* Check reachability of finalized objects. *)
+PROCEDURE CheckFinalizedObjects (cycle: LONGWORD);
+VAR n, p, t: FinalizerNode; pointer {UNTRACED}: BaseTypes.Pointer;
+
+	PROCEDURE MarkDelegate(p: Finalizer);
+	VAR pointer {UNTRACED}: ANY;
+	BEGIN
+		SYSTEM.GET(ADDRESSOF(p)+SIZEOF(ADDRESS),pointer);
+		IF pointer # NIL THEN Mark(pointer) END;
+	END MarkDelegate;
+
+BEGIN
+	n := checkRoot;
+	WHILE n # NIL DO	(* move unmarked checked objects to finalize list *)
+		pointer := SYSTEM.VAL(BaseTypes.Pointer, n.objWeak);
+		IF pointer.cycle - cycle <= 0 THEN
+			IF n = checkRoot THEN checkRoot := n.nextFin ELSE p.nextFin := n.nextFin END;
+			n.objStrong := n.objWeak;	(* anchor the object for finalization *)
+			n.finalizerStrong := n.finalizer; (* anchor the finalizer for finalization *)
+			t := n.nextFin; n.nextFin := finalizeRoot; finalizeRoot := n; n := t;
+			IF Stats THEN DEC(NfinalizeAlive); INC(NfinalizeDead) END
+		ELSE
+			p := n; n := n.nextFin
+		END
+	END;
+
+	(* now trace the weak references to keep finalized objects alive during this collection *)
+	n := finalizeRoot;
+	WHILE n # NIL DO
+		MarkDelegate(n.finalizerStrong);
+		Mark(n.objStrong); n := n.nextFin
+	END;
+
+	n := checkRoot;
+	WHILE n # NIL DO (* list of objects that had been marked before entering CheckFinalizedObjects *)
+		(* we still have to mark the weak finalizers, as they might have not been marked before  *)
+		MarkDelegate(n.finalizer); n := n.nextFin
+	END;
+END CheckFinalizedObjects;
+
 (** Return the next scheduled finalizer or NIL if none available. Called by finalizer object in Kernel. *)
 PROCEDURE GetFinalizer* (): FinalizerNode;
 VAR n: FinalizerNode;
@@ -497,6 +537,7 @@ END FullSweep;
 (* Init - Initialize the heap. *)
 PROCEDURE Init;
 BEGIN
+	GarbageCollector.finalize := CheckFinalizedObjects;
 	checkRoot := NIL; finalizeRoot := NIL; realtimeList := NIL;
 
 	(* the Type desciptor is generated by the compiler, therefore the linker does not have ot patch anything any more *)

source/GarbageCollector.Mod

@@ -7,6 +7,9 @@ MODULE GarbageCollector;
 
 IMPORT Activities, BaseTypes, Counters, CPU;
 
+(** Notifies interested parties before collecting. *)
+VAR finalize*: PROCEDURE (cycle: LONGWORD);
+
 VAR tracings: Counters.AlignedCounter;
 VAR currentCycle, oldestCycle: LONGWORD;
 VAR firstMarked {UNTRACED}, firstWatched {UNTRACED}: BaseTypes.Pointer;
@@ -169,6 +172,9 @@ BEGIN {UNCHECKED}
 	WHILE Counters.Read (tracings) # 0 DO TraceMarkedPointers END; TraceMarkedPointers;
 	ASSERT (CAS (oldestCycle, cycle, cycle + 1) = cycle);
 
+	(* notify interested parties *)
+	IF finalize # NIL THEN finalize (cycle) END;
+
 	(* collect garbage *)
 	Sweep (first, cycle);
 END Collect;