Simplified data structures for precise garbage collection again.

Precise GC works

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

source/FoxBinaryCode.Mod

@@ -197,7 +197,6 @@ TYPE
 		finally-: Unit; (* position of finally section in bitstream -1 if none *)
 		comments-: Sections.CommentWriter; (* writer to write comment text between instructions *)
 		bigEndian-: BOOLEAN; (* endianess of bits (not bytes) *)
-		validPAFEnter-,validPAFExit-: Unit; (* begin and end of code section where current PAF (procedure activation frame) is considered valid *)
 		pc-: Unit; (* current position, in units *)
 
 		PROCEDURE GetPC(): LONGINT;
@@ -229,7 +228,6 @@ TYPE
 			SELF.bigEndian := bigEndian;
 			NEW(fixupList);
 			NEW(aliasList);
-			validPAFEnter := 0; validPAFExit := 0;
 			pc := 0;
 			os.fixed := FALSE;
 			SELF.os.priority := priority;
@@ -240,19 +238,9 @@ TYPE
 			NEW(os.bits,0);
 			NEW(fixupList);
 			IF comments # NIL THEN comments.Reset END;
-			validPAFEnter := 0; validPAFExit := 0;
 			pc := 0;
 		END Reset;
 
-		PROCEDURE EnterValidPAF*;
-		BEGIN
-			validPAFEnter := pc;
-		END EnterValidPAF;
-
-		PROCEDURE ExitValidPAF*;
-		BEGIN
-			validPAFExit := pc;
-		END ExitValidPAF;
 
 		PROCEDURE AddLabel*(position: Unit);
 		VAR new: LabelList;

source/FoxBinaryObjectFile.Mod

@@ -1728,8 +1728,9 @@ TYPE
 				*)
 
 				w.RawNum((destination.offset ));
-				w.RawNum(destination.offset+destination.resolved.validPAFEnter);
-				w.RawNum(destination.offset+destination.resolved.validPAFExit);
+				(* the metadata GC is screwed -- validPAF does not work -- removed from compiler *)
+				w.RawNum(0);
+				w.RawNum(0); 
 				(*!
 				w.RawNum(destination.beginOffset);
 				w.RawNum(destination.endOffset);

source/FoxCodeGenerators.Mod

@@ -456,8 +456,6 @@ TYPE
 				inPC := pc; outPC := out.pc;
 				in.SetPC(pc, outPC);
 				IF pc = in.finally THEN out.SetFinally(out.pc) END;
-				IF pc = in.validPAFEnter THEN out.EnterValidPAF END;
-				IF pc = in.validPAFExit THEN out.ExitValidPAF END;
 				instruction := in.instructions[pc];
 				SetLiveness(instruction);
 				IF dump # NIL THEN DumpInstruction(instruction); dump.Ln END;

source/FoxIntermediateBackend.Mod

@@ -768,7 +768,6 @@ TYPE
 							END;
 						END;
 					END;
-					ir.EnterValidPAF;
 				END;
 
 				implementationVisitor.tagsAvailable := procedureType.callingConvention = SyntaxTree.OberonCallingConvention;
@@ -815,8 +814,6 @@ TYPE
 						*)
 					END;
 
-					ir.ExitValidPAF;
-
 					IF procedureType.callingConvention = SyntaxTree.WinAPICallingConvention THEN
 						parametersSize := ProcedureParametersSize(backend.system,x);
 					ELSE
@@ -894,10 +891,8 @@ TYPE
 				END;
 			ELSE (* force body for procedures *)
 				implementationVisitor.EmitEnter(ir, x.position,x,cc,0,0);
-				ir.EnterValidPAF;
 				implementationVisitor.Body(scope.body,currentScope,ir,x = module.module.moduleScope.bodyProcedure);
 				IF implementationVisitor.usedRegisters # NIL THEN D.TraceBack END;
-				ir.ExitValidPAF;
 				implementationVisitor.EmitLeave(ir,x.position,x,cc);
 				ir.Emit(Exit(x.position,procedureType.pcOffset,cc, parametersSize));
 			END;
@@ -10925,10 +10920,7 @@ TYPE
 					IntermediateCode.InitMemory(left,addressType,fp,0);
 					Emit(Mov(position, left, right));
 				END;
-				
-				ir.EnterValidPAF;
-				(* procedure activation frame is valid from here on *)
-				
+								
 				IF x.code = NIL THEN
 					VisitStatementBlock(x);
 				ELSE
@@ -10981,7 +10973,7 @@ TYPE
 		TypeTags: LONGINT; (* type extension level support *)
 		TypeRecordBaseOffset: LONGINT; (* offset of type zero offset (without method entries) *)
 		
-		patchInfoPC, patchProcedurePC: LONGINT;
+		patchInfoPC: LONGINT;
 		
 
 		PROCEDURE &InitMetaDataGenerator(implementationVisitor: ImplementationVisitor; declarationVisitor: DeclarationVisitor; simple: BOOLEAN);
@@ -12066,10 +12058,6 @@ TYPE
 					
 					Global.GetSymbolSegmentedName(procedure,name);
 					Basic.SuffixSegmentedName (name, Basic.MakeString ("@Descriptor"));
-					s := module.allSections.FindByName(name); 
-					IF s # NIL THEN (*! should always work, check this *)
-						PatchSize(s(IntermediateCode.Section), patchProcedurePC, pos);
-					END;
 
 					IF RefInfo THEN Info(section, "Parameters") END;
 					parameter := procedureType.firstParameter;
@@ -12385,12 +12373,6 @@ TYPE
 				Symbol(section,procedureSection,0,0);
 				Info(section,"pcTo");
 				Symbol(section, procedureSection, procedureSection.pc, 0);
-				Info(section,"pcStatementBegin");
-				Symbol(section,procedureSection, procedureSection.validPAFEnter,0);
-				Info(section,"pcStatementEnd");
-				Symbol(section, procedureSection, procedureSection.validPAFExit,0);
-				patchProcedurePC := section.pc;
-				Size(section, 0);
 				Info(section,"pointer to offsets array");
 				Symbol(section, section,section.pc+1,0);
 				Info(section,"offsets array");

source/FoxIntermediateCode.Mod

@@ -147,7 +147,6 @@ TYPE
 		aliasOffset-: LONGINT; (* for aliases *)
 
 		comments-: Sections.CommentWriter;
-		validPAFEnter-,validPAFExit-: LONGINT; (* begin and end of code section where current PAF (procedure activation frame) is considered valid *)
 		sizeInUnits: LONGINT;
 		exported-: BOOLEAN;
 
@@ -160,7 +159,6 @@ TYPE
 			InitSection(type,priority,n,symbol); (*InitArray;*) pc := 0; resolved := NIL;
 			IF comment THEN NEW(comments,GetPC) ELSE comments := NIL END;
 			finally := -1;
-			validPAFEnter := 0; validPAFExit := 0;
 			sizeInUnits := NotYetCalculatedSize;
 			exported := FALSE;
 		END InitIntermediateSection;
@@ -178,14 +176,6 @@ TYPE
 			END;
 		END EnableComments;
 
-		PROCEDURE EnterValidPAF*;
-		BEGIN validPAFEnter := pc
-		END EnterValidPAF;
-
-		PROCEDURE ExitValidPAF*;
-		BEGIN validPAFExit := pc
-		END ExitValidPAF;
-
 		PROCEDURE DeleteComments*;
 		BEGIN comments := NIL
 		END DeleteComments;

source/Generic.Modules.Mod

@@ -81,8 +81,7 @@ TYPE
 	
 	ProcedureDescPointer* = POINTER TO ProcedureDesc;
 	ProcedureDesc*= RECORD
-		pcFrom-, pcLimit-, pcValid-, pcEnd-: ADDRESS; 
-		refsOffset-: SIZE;
+		pcFrom-, pcLimit-: ADDRESS; 
 		offsets- {UNTRACED}: POINTER TO ARRAY OF ADDRESS; 
 	END;
 	
@@ -100,7 +99,7 @@ TYPE
 			ptrAdr*: POINTER TO ARRAY OF ADDRESS; (* traced explicitly in FindRoots *)
 			typeInfo*: POINTER TO ARRAY OF TypeDesc;	
 			module*: POINTER TO ARRAY OF Module; (* imported modules: for reference counting *)
-			procTable*: ProcedureDescs; (* information inserted by loader, removed after use in Publish *)
+			procTable*: ProcedureDescs; (* information inserted by loader, sorted by pc after loading *)
 			data*, code*, staticTypeDescs* (* ug *), refs*: Bytes;
 			export*: ExportDesc;
 			term*: TerminationHandler;
@@ -145,7 +144,6 @@ VAR
 	
 	(* global sorted table of all procedures , basically for GC *)
 	procedureDescriptors-: ProcedureDescs;
-	mayAllocate: BOOLEAN;
 
 (** Register a module loader. *)
 
@@ -207,7 +205,6 @@ BEGIN
 		m.refcnt := 0;
 		SortExceptionTable(m.exTable);
 		SortProcedureDescs(m.procTable);
-		MergeProcedureDescs(m.procTable);
 
 		IF m.module # NIL THEN
 			FOR i := 0 TO LEN(m.module)-1 DO INC(m.module[i].refcnt) END;
@@ -386,46 +383,6 @@ END Initialize;
 		Quick(0, LEN(p)-1);
 	END SortExceptionTable;
 	
-		
-	(* sort and merge procedure descriptors with the global procedure desc array, replacing the global procedure array *)
-	PROCEDURE MergeProcedureDescs*(p: ProcedureDescs);
-	VAR n: ProcedureDescs;
-		i,j,k: LONGINT;
-	BEGIN
-		IF ~mayAllocate THEN RETURN END; 
-		IF (p = NIL) OR (LEN(p) = 0) THEN RETURN END; 
-		IF procedureDescriptors = NIL THEN 
-			procedureDescriptors := p;
-		ELSE
-			NEW(n, LEN(procedureDescriptors) + LEN(p));
-			k := 0; i := 0; j := 0;
-			FOR k := 0 TO LEN(n)-1 DO
-				IF (i<LEN(p)) & ((j=LEN(procedureDescriptors)) OR (p[i].pcFrom < procedureDescriptors[j].pcFrom)) THEN
-					n[k] := p[i]; INC(i);
-				ELSE
-					n[k] := procedureDescriptors[j]; INC(j);
-				END;
-			END;
-			procedureDescriptors := n;
-		END;
-	END MergeProcedureDescs;
-
-	(* remove sorted procedure descriptors from sorted global array *)
-	PROCEDURE RemoveProcedureDescs*(p: ProcedureDescs);
-	VAR i,j,k: LONGINT; n: ProcedureDescs;
-	BEGIN
-		IF ~mayAllocate THEN RETURN END; 
-		NEW(n, LEN(procedureDescriptors) - LEN(p));
-		i := 0; j := 0; k := 0; 
-		WHILE i < LEN(procedureDescriptors) DO 
-			IF (j < LEN(p)) & (procedureDescriptors[i] = p[j]) THEN INC(j);
-			ELSE n[k] := procedureDescriptors[i]; INC(k);
-			END;
-			INC(i); 
-		END;
-		procedureDescriptors := n;
-	END RemoveProcedureDescs;
-
 (** Load the module if it is not already loaded. *)	(* Algorithm J. Templ, ETHZ, 1994 *)
 PROCEDURE ThisModule*(CONST name: ARRAY OF CHAR; VAR res: LONGINT; VAR msg: ARRAY OF CHAR): Module;
 VAR m, p: Module; fileName: ARRAY 64 OF CHAR; i: LONGINT;
@@ -650,7 +607,6 @@ BEGIN
 			(* do not clear m.data or m.code, as they are used in ThisModuleByAdr (for debugging). *)
 			(* do not clear m.refs, as they are used in Traps (for debugging). *)
 			m.export.dsc := NIL; m.exTable := NIL;
-			RemoveProcedureDescs(m.procTable);
 		ELSE
 			res := 1901;	(* can not free module in use *)
 			COPY(name, msg); Append(" reference count not zero", msg)
@@ -813,7 +769,6 @@ END Main;
 PROCEDURE Init;
 VAR
 	s: ARRAY 4 OF CHAR;
-	module: Module;
 BEGIN
 	(* root is initialized by the linker *)
 	shutdown := None;
@@ -821,30 +776,6 @@ BEGIN
 	freeRoot := NIL;
 	Machine.GetConfig("TraceModules", s);
 	trace := (s[0] = "1");
-	
-	
-	module := root;
-	WHILE (module # NIL) DO 
-		MergeProcedureDescs(module.procTable);
-		module := module.next;
-	END;
-	mayAllocate := TRUE;
-	
-	(*
-	FOR i := 0 TO Runtime.modules-1 DO
-		module := SYSTEM.VAL(Module,Runtime.kernelModule[i]);
-		IF TraceBoot THEN
-			Trace.String("publishing module ");
-			Trace.String(module.name); Trace.Ln;
-		END;
-		Publish(module,new);
-		ASSERT(new,112233);
-	END;
-	*)
-	(*
-	module := SYSTEM.VAL(Module,SELF);
-	Publish(module,new);
-	*)
 END Init;
 
 BEGIN

source/Generic.Reflection.Mod

@@ -1089,25 +1089,8 @@ TYPE
 		END;
 	END Report;
 
-VAR w: Streams.Writer; 
-
-	PROCEDURE WP(pc: ADDRESS);
-	BEGIN
-		WriteProc(w,pc);w.Update;
-	END WP;
-
-	PROCEDURE WPr(p: Objects.Process);
-	BEGIN
-		WriteProcess(w,p);w.Update;
-	END WPr;
-	
-
-
 BEGIN
 	modes := " rdy run awl awc awe rip";   (* 4 characters per mode from Objects.Ready to Objects.Terminated *)
-	Streams.OpenWriter(w, Trace.Send);
-	Objects.WriteProc := WP; 
-	Objects.WriteProcess := WPr;
 END Reflection.
 
 

source/Heaps.Mod

@@ -750,65 +750,6 @@ BEGIN
 	numCandidates := 0
 END CheckCandidates;
 
-(* Check validity of single pointer candidate and enter it into the list of candidates *)
-PROCEDURE ReportCandidate*(p: ADDRESS): BOOLEAN;
-VAR memBlock, memBlockX {UNTRACED}: Machine.MemoryBlock; 
-	tdAdr, heapBlockAdr: ADDRESS;
-	tdPtr: POINTER {UNSAFE} TO RECORD typeAdr: ADDRESS END;
-	hbPtr: POINTER {UNSAFE} TO RECORD heapBlock: HeapBlock END;
-	heapBlock {UNTRACED}: HeapBlock;
-BEGIN
-	IF p MOD SIZEOF(ADDRESS) # 0 THEN RETURN FALSE END; 
-	IF (p >= Machine.memBlockHead.beginBlockAdr) & (p < Machine.memBlockTail.endBlockAdr) THEN
-		memBlock := Machine.memBlockHead;
-		WHILE memBlock # NIL DO
-			IF (p + HeapBlockOffset >= memBlock.beginBlockAdr) & (p + HeapBlockOffset < memBlock.endBlockAdr) THEN
-				hbPtr := p + HeapBlockOffset; 
-				heapBlock := hbPtr.heapBlock;
-				heapBlockAdr := heapBlock ;
-				IF heapBlockAdr MOD SIZEOF(ADDRESS) # 0 THEN RETURN FALSE END; 
-				tdAdr :=heapBlockAdr + TypeDescOffset;
-				(* check if tdAdr is a valid pointer in the heap *)
-				memBlockX := Machine.memBlockHead;
-				WHILE memBlockX # NIL DO 
-					IF (tdAdr >= memBlockX.beginBlockAdr) & (tdAdr < memBlockX.endBlockAdr) THEN
-						(* IF (heapBlock.mark >= currentMarkValue) THEN RETURN END;*)
-						tdPtr := tdAdr;
-						tdAdr := tdPtr.typeAdr;
-						(* check whether tdAdr is a valid type descriptor address *)
-						IF (tdAdr = systemBlockTag) OR (tdAdr = recordBlockTag) OR (tdAdr = protRecBlockTag) OR (tdAdr = arrayBlockTag) THEN
-							RETURN TRUE;
-							candidates[numCandidates] := p;
-							INC(numCandidates);
-							IF numCandidates = LEN(candidates) THEN CheckCandidates END
-						END;
-						RETURN FALSE; (* found *)
-					END;
-					memBlockX := memBlockX.next
-				END;
-				RETURN FALSE; (* not found *)
-			END;
-			memBlock := memBlock.next
-		END
-	END;
-	RETURN FALSE;
-END ReportCandidate;
-
-(** RegisterCandidates - Register a block of pointer candidates *)
-PROCEDURE ReportCandidates*(adr: ADDRESS; size: SIZE);
-VAR end, p: ADDRESS;
-BEGIN
-	(* current processor must hold Heaps lock *)
-	end := adr + size;
-	WHILE adr # end DO
-		SYSTEM.GET(adr, p);
-		IF ReportCandidate(p) THEN
-			Trace.Address(adr); Trace.String(":"); Trace.Address(p); Trace.Ln; 
-		END;
-		INC(adr, AddressSize)
-	END
-END ReportCandidates;
-
 (* Check validity of single pointer candidate and enter it into the list of candidates *)
 PROCEDURE Candidate*(p: ADDRESS);
 VAR memBlock, memBlockX {UNTRACED}: Machine.MemoryBlock; 

source/Win32.Objects.Mod

@@ -173,12 +173,6 @@ TYPE
 			state.ContextFlags := Kernel32.ContextControl + Kernel32.ContextInteger;
 			res := Kernel32.GetThreadContext( handle, state );
 			IF SYSTEM.VAL( Process, Kernel32.TlsGetValue( tlsIndex ) ) = SELF THEN
-				Trace.String("bp = "); Trace.Address(state.BP);
-				Trace.String(" =?= "); Trace.Address(Machine.CurrentBP()); Trace.Ln;
-				Trace.String("sp = "); Trace.Address(state.SP);
-				Trace.String(" =?= "); Trace.Address(Machine.CurrentSP()); Trace.Ln;
-				Trace.String("pc = "); Trace.Address(state.PC);
-				Trace.String(" =?= "); Trace.Address(Machine.CurrentPC()); Trace.Ln;
 				sp := Machine.CurrentSP();  bp :=Machine.CurrentBP(); pc := Machine.CurrentPC(); 
 			ELSE
 				sp := state.SP;  bp := state.BP; pc := state.PC;
@@ -196,57 +190,30 @@ TYPE
 					Heaps.RegisterCandidates( sp, stackBottom - sp );
 				END;
 			ELSIF Heaps.GCType = Heaps.MetaDataForStackGC THEN
-				IF WriteProcess # NIL THEN 
-					WriteProcess(SELF);Trace.Ln;
-				END;
-				Trace.String("Heuristic:"); Trace.Ln; 
-				Heaps.ReportCandidates(sp, stackBottom-sp); 
-				Trace.String("Metadata:"); Trace.Ln; 
-				Trace.String("sp = "); Trace.Address(sp); Trace.String(" bp= "); Trace.Address(bp);
-				Trace.String("bot = "); Trace.Address(stackBottom); Trace.Ln; 
 				WHILE (bp # Heaps.NilVal) & (sp <= bp) & (bp <= stackBottom)  DO
-					Trace.String("proc ");
-					IF WriteProc # NIL THEN
-						WriteProc(pc); Trace.String("@ ");Trace.Address(bp); Trace.String(":"); Trace.Address(pc);
-					END;
-
 					SYSTEM.GET(bp, n);
 					IF ODD(n) THEN (* procedure descriptor at bp *)
-						Trace.String(" has descriptor"); Trace.Ln;
 						DEC(n);
 						desc := SYSTEM.VAL(Modules.ProcedureDescPointer, n);
 						IF desc # NIL THEN
-							IF WriteProc # NIL THEN
-								Trace.String("proc from desc: "); WriteProc((desc.pcFrom+desc.pcLimit) DIV 2); Trace.Ln;
-							END;
 							FOR i := 0 TO LEN(desc.offsets)-1 DO
 								adr := bp + desc.offsets[i]; (* pointer at offset *)
 								SYSTEM.GET(adr, p); (* load pointer *)
 								IF p # NIL THEN 
- 									Trace.Int(desc.offsets[i],1); Trace.String(":"); Trace.Address(adr); Trace.String(":"); Trace.Address(p); Trace.Ln; 
 									Heaps.Mark(p);
 								END;
 							END;
-						ELSE
-								Trace.String("has nil desc: "); Trace.Ln;
 						END;
-						SYSTEM.GET(bp + 2*SIZEOF(ADDRESS), pc); (* next pc for tracing *)
 						SYSTEM.GET(bp + SIZEOF(ADDRESS), bp);
 					ELSE (* classical stack frame *)
-						Trace.String(" has no descriptor"); Trace.Ln;
-						SYSTEM.GET(bp + SIZEOF(ADDRESS), pc); (* next pc for tracing *)
 						bp := n; 
 					END;
-					Trace.String("next bp "); Trace.Address(bp); Trace.Ln;
 				END;
 			END;
 		END FindRoots;
 		
 	END Process;
 
-VAR 
-	WriteProc* : PROCEDURE (pc: ADDRESS);
-	WriteProcess*: PROCEDURE(p: Process);
 TYPE
 	ExceptionHandler* = PROCEDURE(	VAR context: Kernel32.Context;
 										VAR excpRec: Kernel32.ExceptionRecord;