Preparations for precise GC --> procedureDescriptors will be tagged pointers at EBP.

WinAOS release works with such tagged pointers, including trap writes. No procedure descriptors replaced (yet).

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

source/FoxGlobal.Mod

@@ -383,7 +383,7 @@ TYPE
 		
 
 		PROCEDURE GenerateVariableOffsets*(scope: SyntaxTree.Scope): BOOLEAN;
-		VAR variable: SyntaxTree.Variable; offset,size: LONGINT; alignment: LONGINT; parameterOffset :LONGINT;
+		VAR variable: SyntaxTree.Variable; offset,size: LONGINT; alignment: LONGINT; 
 		BEGIN
 			IF scope IS SyntaxTree.RecordScope THEN (* increasing indices *)
 				RETURN GenerateRecordOffsets(scope(SyntaxTree.RecordScope).ownerRecord)
@@ -392,11 +392,6 @@ TYPE
 			ELSE (* module scope or procedure scope: decreasing indices *)
 				ASSERT((scope IS SyntaxTree.ModuleScope) OR (scope IS SyntaxTree.ProcedureScope));
 				offset := 0;
-				IF scope IS SyntaxTree.ProcedureScope THEN
-					parameterOffset := scope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).parameterOffset
-				ELSE
-					parameterOffset := 0
-				END;
 
 				variable := scope.firstVariable;
 				WHILE (variable # NIL) DO
@@ -427,7 +422,7 @@ TYPE
 			IF (procedure.isInline) THEN
 				offset := 0
 			ELSE
-				offset := SELF.offsetFirstParameter;
+				offset := SELF.offsetFirstParameter + procedureType.parametersOffset * addressSize;
 			END;
 			IF nestedProcedure THEN
 				INC(offset,addressSize); (* parameter offset of static link *) (*! check alternative: add hidden parameter *)
@@ -465,7 +460,6 @@ TYPE
 			IF (procedureType.isDelegate) THEN
 				INC(offset,addressSize); (* parameter offset of delegate *)
 			END;
-			procedureType.SetParameterOffset(offset);
 			RETURN TRUE
 		END GenerateParameterOffsets;
 

source/FoxIntermediateBackend.Mod

@@ -100,6 +100,11 @@ CONST
 		Size8Flag = 10; (* size = 8 *)
 		
 		ReflectionSupport = TRUE;
+		PreciseGCSupport = FALSE;
+		(* Solution for identifying procedure descriptors on the stack and for being able to differentiate "old school" stack frames from the underlying operating system stack frames:
+			push a procedure desriptor plus one to where the BP pointer would be located. The misalignment of the procedure descriptor makes it possible to identify that it is not
+			a base pointer but a procedure descriptor. The base pointer itself is in such cases located at BP + address size.
+		*)
 		
 TYPE
 	SupportedInstructionProcedure* = PROCEDURE {DELEGATE} (CONST instr: IntermediateCode.Instruction; VAR moduleName,procedureName: ARRAY OF CHAR): BOOLEAN;
@@ -833,7 +838,7 @@ TYPE
 								implementationVisitor.ProfilerEnterExit(implementationVisitor.numberProcedures-1, FALSE) 
 							END;
 						END;
-						implementationVisitor.EmitLeave(ir, x.position,cc);
+						implementationVisitor.EmitLeave(ir, x.position,x,cc);
 						IF finalizer THEN
 							IF backend.hasLinkRegister THEN
 								ir.Emit(Pop(-1, implementationVisitor.lr));
@@ -876,12 +881,12 @@ TYPE
 								END;
 							END;
 							
-							implementationVisitor.EmitLeave(ir,x.position,cc);
+							implementationVisitor.EmitLeave(ir,x.position,x,cc);
 							ir.Emit(Exit(x.position,procedureType.pcOffset,cc, parametersSize));
 						ELSE
 							ir.Emit(Nop(x.position));
 							IF scope.body.isUnchecked OR backend.noRuntimeChecks THEN (* return from procedure in any case *)
-								implementationVisitor.EmitLeave(ir,x.position,cc);
+								implementationVisitor.EmitLeave(ir,x.position,x,cc);
 								ir.Emit(Exit(x.position,procedureType.pcOffset,cc, parametersSize));
 							END;
 						END;
@@ -893,7 +898,7 @@ TYPE
 				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,cc);
+				implementationVisitor.EmitLeave(ir,x.position,x,cc);
 				ir.Emit(Exit(x.position,procedureType.pcOffset,cc, parametersSize));
 			END;
 			Scope(scope);
@@ -1062,7 +1067,7 @@ TYPE
 			Scope(x.moduleScope);
 
 			IF hasDynamicOperatorDeclarations THEN
-				implementationVisitor.EmitLeave(implementationVisitor.operatorInitializationCodeSection,-1,0);
+				implementationVisitor.EmitLeave(implementationVisitor.operatorInitializationCodeSection,-1,NIL,0);
 				implementationVisitor.operatorInitializationCodeSection.Emit(Exit(-1,0,0,0));
 			END;
 
@@ -1283,7 +1288,7 @@ TYPE
 		
 
 		(* useful operands and types *)
-		nil,fp,sp,ap,lr,true,false: IntermediateCode.Operand;
+		nil,one,fp,sp,ap,lr,true,false: IntermediateCode.Operand;
 		bool,addressType,setType, sizeType, byteType: IntermediateCode.Type;
 
 		commentPrintout: Printout.Printer;
@@ -1349,6 +1354,7 @@ TYPE
 			ap := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.AP);
 			lr := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.LR);
 			nil := IntermediateCode.Immediate(addressType,0);
+			one := IntermediateCode.Immediate(addressType,1);
 
 			IntermediateCode.InitOperand(destination);
 			tagsAvailable := TRUE;
@@ -1518,8 +1524,10 @@ TYPE
 		VAR prevSection: IntermediateCode.Section;
 		VAR prevDump: Streams.Writer;
 		VAR body: SyntaxTree.Body;
+		VAR procedureType: SyntaxTree.ProcedureType;
 		BEGIN
-			ASSERT((procedure = NIL) OR ~procedure.type(SyntaxTree.ProcedureType).noPAF);
+			procedureType := procedure.type(SyntaxTree.ProcedureType);
+			ASSERT((procedure = NIL) OR ~procedureType.noPAF);
 			prevSection := SELF.section;
 			SELF.section := section;
 			prevDump := dump;
@@ -1560,6 +1568,16 @@ TYPE
 					nocall.Resolve(section.pc);
 				END;
 			ELSE
+				IF procedure # NIL THEN
+					body := procedure.procedureScope.body;
+				ELSE
+					body := NIL;
+				END;
+				IF PreciseGCSupport & (body # NIL) & (body.code = NIL) THEN
+					Emit(Push(-1, one)) ;
+					procedureType.SetParametersOffset(1); 
+					ASSERT(system.GenerateParameterOffsets(procedure, procedure.level > 0));
+				END;
 				Emit(Mov(-1, fp, sp));
 			END;
 			Emit(Enter(-1, callconv, varSize));
@@ -1586,14 +1604,21 @@ TYPE
 			RETURN instruction
 		END Leave;
 		
-		PROCEDURE EmitLeave(section: IntermediateCode.Section; position: LONGINT; callconv: LONGINT);
+		PROCEDURE EmitLeave(section: IntermediateCode.Section; position: LONGINT; procedure: SyntaxTree.Procedure; callconv: LONGINT);
 		VAR prevSection: IntermediateCode.Section;
-		VAR op2: IntermediateCode.Operand;
+		VAR op2, size: IntermediateCode.Operand;
+		VAR body: SyntaxTree.Body;
 		BEGIN
 			prevSection := SELF.section;
 			SELF.section := section;
 			Emit(Leave(position, callconv)); 
-			IF backend.cooperative THEN
+			IF procedure # NIL THEN
+				body := procedure.procedureScope.body;
+			ELSE 
+				body := NIL;
+			END;
+
+			IF backend.cooperative OR PreciseGCSupport & (body # NIL) & (body.code = NIL) THEN
 				IntermediateCode.InitImmediate(op2,addressType, ToMemoryUnits(system, system.addressSize));
 				Emit(Add(position, sp, fp, op2));
 			ELSE
@@ -6062,7 +6087,7 @@ TYPE
 		BEGIN
 			IntermediateCode.InitImmediate(reg, IntermediateCode.GetType(system,system.longintType), numberProcedures);
 			profileInit.EmitAt(profileInitPatchPosition,Push(position,reg));
-			EmitLeave(profileInit,position,0);
+			EmitLeave(profileInit,position,NIL,0);
 			profileInit.Emit(Exit(position,0,0,0));
 		END ProfilerPatchInit;
 
@@ -6907,7 +6932,7 @@ TYPE
 		
 		PROCEDURE CloseInitializer(prev: IntermediateCode.Section);
 		BEGIN
-			EmitLeave(section, 0, 0 );
+			EmitLeave(section, 0, NIL, 0 );
 			Emit(Exit(-1,ToMemoryUnits(system,addressType.sizeInBits),0, 0));
 			section := prev;
 		END CloseInitializer;
@@ -9283,13 +9308,13 @@ TYPE
 			IF scope # baseScope THEN
 				(* left := [fp+8] *)
 				IntermediateCode.InitMemory(right,addressType,fp,ToMemoryUnits(system,2*addressType.sizeInBits));
-				IF backend.cooperative THEN IntermediateCode.AddOffset (right, ToMemoryUnits(system,addressType.sizeInBits)) END;
+				IF backend.cooperative OR PreciseGCSupport THEN IntermediateCode.AddOffset (right, ToMemoryUnits(system,addressType.sizeInBits)) END;
 				ReuseCopy(left,right);
 				ReleaseIntermediateOperand(right);
 				scope := scope.outerScope; DEC(level);
 				(* { left := [left+8] } *)
 				IntermediateCode.InitMemory(right,addressType,left,ToMemoryUnits(system,2*addressType.sizeInBits));
-				IF backend.cooperative THEN IntermediateCode.AddOffset (right, ToMemoryUnits(system,addressType.sizeInBits)) END;
+				IF backend.cooperative  OR PreciseGCSupport THEN IntermediateCode.AddOffset (right, ToMemoryUnits(system,addressType.sizeInBits)) END;
 				WHILE (scope # baseScope) & (scope IS SyntaxTree.ProcedureScope) DO
 					Emit(Mov(position,left,right));
 					scope := scope.outerScope; DEC(level);
@@ -10428,7 +10453,7 @@ TYPE
 					parametersSize := 0;
 				END;
 
-				EmitLeave(section, position,procedure.type(SyntaxTree.ProcedureType).callingConvention);
+				EmitLeave(section, position,procedure, procedure.type(SyntaxTree.ProcedureType).callingConvention);
 				Emit(Exit(position,procedure.type(SyntaxTree.ProcedureType).pcOffset,procedure.type(SyntaxTree.ProcedureType).callingConvention, parametersSize));
 			END;
 			IF Trace THEN TraceExit("VisitReturnStatement") END;
@@ -10706,7 +10731,7 @@ TYPE
 				ELSE
 					parametersSize := 0;
 				END;
-				EmitLeave(section, position,cc);
+				EmitLeave(section, position,NIL, cc);
 				Emit(Exit(position,procedureType(SyntaxTree.ProcedureType).pcOffset,cc, parametersSize));
 				ReleaseIntermediateOperand(return);
 			END;
@@ -10887,6 +10912,11 @@ TYPE
 
 				ParameterCopies(procedureType);
 				InitVariables(scope);
+				
+				
+				ir.EnterValidPAF;
+				(* procedure activation frame is valid from here on *)
+				
 				IF x.code = NIL THEN
 					VisitStatementBlock(x);
 				ELSE
@@ -13072,7 +13102,6 @@ TYPE
 		preregisterStatic-: BOOLEAN;
 		dump-: Basic.Writer;
 		cellsAreObjects: BOOLEAN;
-
 		PROCEDURE &InitIntermediateBackend*;
 		BEGIN
 			simpleMetaData := FALSE;
@@ -14091,12 +14120,12 @@ END FoxIntermediateBackend.
 Compiler.Compile FoxIntermediateBackend.Mod ~
 
 #	Release.Build --path="/temp/obg/" WinAosNewObjectFile ~
-#	StaticLinker.Link --fileFormat=PE32 --fileName=A2H.exe --extension=GofW --displacement=401000H --path="/temp/obg/" Runtime Trace Kernel32 Machine Heaps Modules Objects Kernel KernelLog Streams Commands FIles WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection  GenericLoader  BootConsole ~
+#	StaticLinker.Link --fileFormat=PE32 --fileName=A2H.exe --extension=GofW --displacement=401000H  Runtime Trace Kernel32 Machine Heaps Modules Objects Kernel KernelLog Streams Commands FIles WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection  GenericLoader  BootConsole ~
 FSTools.CloseFiles A2H.exe ~
 
 SystemTools.FreeDownTo FoxIntermediateBackend ~
 
-Compiler.Compile -p=Win32G  --destPath=/temp/obg/
+Compiler.Compile -p=Win32G 
 Runtime.Mod Trace.Mod Generic.Win32.Kernel32.Mod Win32.Machine.Mod Heaps.Mod 
 Generic.Modules.Mod Win32.Objects.Mod Win32.Kernel.Mod KernelLog.Mod Plugins.Mod Streams.Mod Pipes.Mod 
 Commands.Mod I386.Reals.Mod Generic.Reflection.Mod TrapWriters.Mod CRC.Mod SystemVersion.Mod 

source/FoxSyntaxTree.Mod

@@ -1711,7 +1711,7 @@ TYPE
 			pcOffset-: LONGINT; (* PC offset: used for ARM interrupt procedures *)
 			callingConvention-: CallingConvention;
 			stackAlignment-: LONGINT;
-			parameterOffset-: LONGINT; (* stack parameter offset caused by parameters on stack *)
+			parametersOffset-: LONGINT; (* stack parameter offset -- in units of addresses: one pointer = 1 *)
 
 		PROCEDURE & InitProcedureType( position: LONGINT; scope: Scope);
 		BEGIN
@@ -1723,7 +1723,7 @@ TYPE
 			stackAlignment := 1;
 			isDelegate := FALSE; isInterrupt := FALSE; noPAF := FALSE;
 			callingConvention := OberonCallingConvention;
-			parameterOffset := 0;
+			parametersOffset := 0;
 			pcOffset := 0;
 			hasUntracedReturn := FALSE;
 			returnTypeModifiers := NIL;
@@ -1767,9 +1767,9 @@ TYPE
 			stackAlignment := alignment;
 		END SetStackAlignment;
 
-		PROCEDURE SetParameterOffset*(ofs: LONGINT);
-		BEGIN parameterOffset := ofs
-		END SetParameterOffset;
+		PROCEDURE SetParametersOffset*(ofs: LONGINT);
+		BEGIN parametersOffset := ofs
+		END SetParametersOffset;
 
 		PROCEDURE SetReturnParameter*(parameter: Parameter);
 		BEGIN returnParameter := parameter

source/Generic.Reflection.Mod

@@ -803,6 +803,17 @@ CONST
 		END;
 	END ModuleState;
 
+	PROCEDURE CheckBP(bp: ADDRESS): ADDRESS;
+	VAR n: ADDRESS;
+	BEGIN
+		IF bp # NIL THEN
+			SYSTEM.GET(bp, n);
+			IF ODD(n) THEN INC(bp, SIZEOF(ADDRESS)) END;
+		END;
+		RETURN bp;
+	END CheckBP;
+	
+
 	(* Display call trackback. *)
 	PROCEDURE StackTraceBack*(w: Streams.Writer; pc, bp: ADDRESS; stackhigh: ADDRESS; long, overflow: BOOLEAN);
 	VAR count,offset: LONGINT; stacklow: ADDRESS; base: ADDRESS; m: Modules.Module; refs: Modules.Bytes;
@@ -827,6 +838,7 @@ CONST
 				ELSE
 					w.String( "Unknown external procedure, pc = " );  w.Address( pc );  w.Ln; Wait(w);
 				END;
+				bp := CheckBP(bp);
 				SYSTEM.GET(bp + SIZEOF(ADDRESS), pc);	(* return addr from stack *)
 				SYSTEM.GET(bp, bp);	(* follow dynamic link *)
 				INC(count)

source/Win32.Traps.Mod

@@ -230,16 +230,27 @@ VAR
 	*)
 	END SetLastExceptionState;
 
+	PROCEDURE CheckBP(fp: ADDRESS): ADDRESS;
+	VAR n: ADDRESS;
+	BEGIN
+		IF (fp # NIL) THEN
+			SYSTEM.GET(fp, n);
+			IF ODD(n) THEN RETURN fp + SIZEOF(ADDRESS) END;
+		END;
+		RETURN fp;
+	END CheckBP;
+	
 
 	(**  Handles an exception. Interrupts are on during this procedure. *)
 	PROCEDURE HandleException( VAR int: Kernel32.Context;  VAR exc: Kernel32.ExceptionRecord;  VAR handled: BOOLEAN );
-	VAR fp, sp, pc, handler: LONGINT;
+	VAR fp, newFP, sp, pc, handler: ADDRESS;
 	BEGIN
 		fp := int.BP;  sp := int.SP;  pc := int.PC;  handler := Modules.GetExceptionHandler( pc );
 		IF handler # -1 THEN  (* Handler in the current PAF *)
 			int.PC := handler;  handled := TRUE;  SetTrapVariable( pc, fp );  SetLastExceptionState( int )
-		ELSE
+		ELSE			
 			WHILE (fp # 0) & (handler = -1) DO
+				fp := CheckBP(fp);
 				SYSTEM.GET( fp + 4, pc );
 				pc := pc - 1;   (*  CALL instruction, machine dependant!!! *)
 				handler := Modules.GetExceptionHandler( pc );
@@ -264,7 +275,7 @@ VAR
 	(* Unbreakable stack trace back with regard to every FINALLY on the way *)
 	PROCEDURE Unbreakable( p: Objects.Process;  VAR int: Kernel32.Context;  VAR exc: Kernel32.ExceptionRecord;
 											 VAR handled: BOOLEAN );
-	VAR ebp, ebpSave, pc, handler, ebpBottom: LONGINT;  hasFinally: BOOLEAN;
+	VAR ebp, ebpSave, pc, handler, ebpBottom: ADDRESS; checkedBP: ADDRESS;  hasFinally: BOOLEAN;
 	BEGIN
 		ebp := int.BP;  pc := int.PC;  hasFinally := FALSE;
 
@@ -274,24 +285,25 @@ VAR
 		IF handler # -1 THEN int.PC := handler;  hasFinally := TRUE;  SetTrapVariable( pc, ebp );  END;
 
 		(* The first waypoint is the ebp of the top PAF *)
-		ebpSave := ebp;
+		ebpSave := CheckBP(ebp);
 
 		WHILE (ebp # 0) DO
 			(* Did we reach the last PAF? *)
-			SYSTEM.GET( ebp, pc );
+			checkedBP := CheckBP(ebp);
+			SYSTEM.GET( checkedBP, pc );
 			IF (pc = 0) THEN
 				ebpBottom := ebp;   (* Save the FP of the last PAF *)
 			END;
 
 			(* Get the return pc *)
-			SYSTEM.GET( ebp + 4, pc );
+			SYSTEM.GET( checkedBP + 4, pc );
 
 			handler := Modules.GetExceptionHandler( pc );
 
 			(* Save the last framepointer as stackpointer *)
 			IF ~hasFinally THEN int.SP := ebp;  END;
 
-			SYSTEM.GET( ebp, ebp );
+			SYSTEM.GET( checkedBP, ebp );
 
 			(* Here ebp may be 0. *)
 
@@ -300,8 +312,9 @@ VAR
 					(* Connect Finally to Finally *)
 					SYSTEM.PUT( ebpSave + 4, handler );   (* Adapt the return pc *)
 					SYSTEM.PUT( ebpSave, ebp );   (* Adapt the dynamic link *)
-					ebpSave := ebp;
-				ELSE int.PC := handler;  int.BP := ebp;  ebpSave := ebp;  hasFinally := TRUE;
+					ebpSave := checkedBP;
+				ELSE 
+					int.PC := handler;  int.BP := ebp;  ebpSave := checkedBP;  hasFinally := TRUE;
 				END;
 				SetTrapVariable( pc, ebp )
 			END