Basic functionality of objects on the heap tracing working again

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

source/FoxArrayBase.Mod

@@ -9657,6 +9657,7 @@ TYPE
 			descr := GetArrayDesc( LEN( a,0 ) );  
 			dest := descr;
 			NewData;
+			Heaps.SetPC(data);
 		ELSE
 			i := 0;
 			WHILE (i < dim) & same DO
@@ -9665,7 +9666,8 @@ TYPE
 			END;
 			IF ~same THEN
 				IF (RangeFlag IN GetFlags( dest )) THEN Err( "Array's shape must not be modified (is RANGE !) " );  END;
-				NewData
+				NewData;
+				Heaps.SetPC(data);
 			ELSE ClearData
 			END;
 		END;		
@@ -9674,6 +9676,7 @@ TYPE
 	PROCEDURE AllocateArrayA*( CONST a: ARRAY OF SIZE;  elementSize: SIZE; tag: ADDRESS; dest: UnsafeArray );
 	BEGIN
 		AllocateTensorA(a,elementSize,tag,dest);
+		IF dest.ptr # NIL THEN Heaps.SetPC(dest.ptr) END;
 	END AllocateArrayA;
 
 	PROCEDURE AllocateTensorX*( VAR destA: ARRAY [?]; CONST a: ARRAY [ * ] OF LONGINT;  Size: SIZE; tag: ADDRESS );

source/Generic.Reflection.Mod

@@ -1063,8 +1063,27 @@ TYPE
 		type-, size-, n-, tdadr-: LONGINT
 	END;
 	
+	(* half-stub for module Info to work *)
 	PROCEDURE FindVar*(mod: Modules.Module; CONST name: ARRAY OF CHAR; VAR v: Variable): BOOLEAN;
+	VAR offset: SIZE; size: SIZE;adr: ADDRESS;
 	BEGIN
+		offset := FindByName(mod.refs, 0,name, TRUE);
+		IF offset < 0 THEN RETURN FALSE END;
+		IF ~Expect(GetChar(mod.refs, offset) = sfVariable) THEN RETURN FALSE END;
+		SkipSize(offset);
+		SkipString(mod.refs, offset); 
+		IF GetChar(mod.refs, offset) = sfRelative THEN
+			size := GetSize(mod.refs, offset);
+		ELSE (* absolute *)
+			adr := GetAddress(mod.refs, offset);
+		END;
+		
+		v.adr := adr;
+		v.type := 0;
+		v.size := 0;
+		v.n := 0;
+		v.tdadr :=  0;
+		RETURN TRUE;
 	END FindVar;
 	
 	PROCEDURE WriteVar*(w: Streams.Writer; v: Variable; VAR col: LONGINT);

source/Heaps.Mod

@@ -1145,7 +1145,7 @@ BEGIN
 	RETURN bp;
 END CheckBP;
 
-PROCEDURE SetPC(p: DataBlockU);
+PROCEDURE SetPC*(p: DataBlockU);
 VAR bp: ADDRESS;
 BEGIN
 	IF p # NIL THEN
@@ -1422,6 +1422,7 @@ VAR p: ANY; dim: SIZE;
 			NewArr(p, tag, GetSize(), dim, FALSE);
 		END;
 		SetSizes(p);
+		SetPC(p);
 		dest := p;
 END NewArray;
 

source/Info.Mod

@@ -463,11 +463,14 @@ BEGIN
 	NEW(options);
 	options.Add("s", "sort", Options.Integer);
 	options.Add(0X, "pc", Options.Flag);
+	options.Add(0X, "gc", Options.Flag);
 	IF options.Parse(context.arg, context.error) THEN
 		IF ~options.GetInteger("sort", sortMode) THEN sortMode := SortNone; END;
 		context.arg.SkipWhitespace; context.arg.String(mask);
 		NEW(analyzer, MaxNofTypes);
+		IF options.GetFlag("gc") THEN Heaps.LazySweepGC END; (* slight inaccuracy here: other processes can kick in now *)
 		Machine.Acquire(Machine.Heaps);
+		Heaps.FullSweep(); (* the heap might contain wrong pointers in the freed part *)
 		memBlock := Machine.memBlockHead;
 		WHILE memBlock # NIL DO
 			p := memBlock.beginBlockAdr;
@@ -813,8 +816,10 @@ BEGIN
 	ASSERT(module # NIL); 
 	IF (module # NIL) THEN
 		IF Reflection.FindVar(module, "currentMarkValue", variable) THEN
+			(*
 			ASSERT(variable.n = 1); (* currentMarkValue is not an array *)
 			ASSERT(variable.type = 6); (*? type is LONGINT, currently no support for 64-bit addresses *)
+			*)
 			address := variable.adr;
 		ELSE HALT(100);
 		END;
@@ -841,10 +846,22 @@ Compiler.Compile -p=Win32G FoxIntermediateBackend.Mod ~
 Info.AllObjects ~
 Info.AllObjects * ~
 
-Info.AllObjects --sort=0 * ~
-Info.AllObjects --sort=1 * ~
-Info.AllObjects --sort=2 * ~
-Info.AllObjects --sort=3 * ~
+(* view by type *)
+Info.AllObjects --sort=0 * ~ sort by none
+Info.AllObjects --sort=1 * ~ sort by count
+Info.AllObjects --sort=2 * ~ sort by size
+Info.AllObjects --sort=3 * ~ sort by total size
+Info.AllObjects --sort=4 * ~ sort by name
+
+(* view by allocation pc *)
+Info.AllObjects --pc --sort=0 * ~ sort by none
+Info.AllObjects --pc --sort=1 * ~ sort by count
+Info.AllObjects --pc --sort=2 * ~ sort by size
+Info.AllObjects --pc --sort=3 * ~ sort by total size
+Info.AllObjects --pc --sort=4 * ~ sort by name
+
+
+
 
 Info.TraceModule PET ~