Improced reflection (parameters part 1)

ActiveCells runner / runtime works fine again.
- todo: VAR par / CONST par / val par, unification of par/val 

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

source/ActiveCellsRuntime.mod

@@ -4,7 +4,7 @@
 module ActiveCellsRuntime;
 
 import
-	system, Heaps, Modules, Diagnostics, Strings, Objects;
+	system, Heaps, Modules, Diagnostics, Strings, Objects, Reflection, Commands;
 
 const
 	EnableTrace* = true;
@@ -350,7 +350,7 @@ type
 		end Starter
 				
 	var
-		moduleName, typeName: array 256 of char;
+		moduleName, typeName, name: array 256 of char;
 		m: Modules.Module;
 		typeInfo: Modules.TypeDesc;
 		i, res: longint;
@@ -359,6 +359,8 @@ type
 		unloaded: longint;
 		starter: Starter;
 		launcher: Launcher;
+		offset: size;
+		pc: address;
 	begin
 		assert(context # nil);
 		context.topNet := nil;
@@ -394,18 +396,41 @@ type
 			return;
 		end;
 
-		assert(len(typeInfo.procedures) = 1);
-		assert(typeInfo.procedures[0].name^ = "@Body");
+		copy(typeName, name);
+		Strings.Append(name, ".@Body");
+		if Reflection.FindByName(m.refs, offset, name) then
+			if Reflection.GetChar(m.refs,offset) = Reflection.sfProcedure then
+				Reflection.SkipSize(offset);
+				Reflection.SkipString(m.refs,offset);
+				pc := Reflection.GetAddress(m.refs, offset);
+				trace(pc);
+				
+				(*assert(len(typeInfo.procedures) = 1);
+				assert(typeInfo.procedures[0].name^ = "@Body");
+				*)
 
-		(* allocate the top level cellnet *)
-		AllocateOnContext(context, nil,scope,typeInfo.tag,typeName,true,false);
-		assert(scope # nil);
-		assert(scope.c # nil);
+				(* allocate the top level cellnet *)
+				AllocateOnContext(context, nil,scope,typeInfo.tag,typeName,true,false);
+				assert(scope # nil);
+				assert(scope.c # nil);
 
-		new(starter, typeInfo.procedures[0].address, scope);
-		new(launcher, context); 
-		launcher.Start(starter.P, true);
+				new(starter, pc, scope);
+			end;
+			new(launcher, context); 
+			launcher.Start(starter.P, true);
+		else 
+			Reflection.Report(Commands.GetContext().out, m.refs);
+		end;
 	end Execute;
-
+	
+(*	type LA = array of longint;
+	operator "<<"* (p: port out; const a: LA);
+	var i: longint;
+	begin
+		for i := 0 to len(a)-1 do
+			p << a[i];
+		end;
+	end "<<";
+*)
 end ActiveCellsRuntime.
 

source/FoxIntermediateBackend.Mod

@@ -1,4 +1,3 @@
-
 MODULE FoxIntermediateBackend; (** AUTHOR ""; PURPOSE ""; *)
 
 IMPORT Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, SemanticChecker := FoxSemanticChecker, Backend := FoxBackend, Global := FoxGlobal,
@@ -11685,7 +11684,11 @@ TYPE
 				sfTypeMathTensor = 28X;
 				sfTypeDelegate = 29X;
 				sfTypeENUM = 2AX; 
+				sfTypeCellType = 2BX;
+				sfTypePortType = 2CX;
 				
+				sfInPort = 0X;
+				sfOutPort = 1X;
 				sfValPar = 0X;
 				sfVarPar = 1X;
 				sfConstPar = 2X; 
@@ -11812,6 +11815,30 @@ TYPE
 									Address(section, 0);
 								END;
 							END;
+						| type: SyntaxTree.CellType DO
+								IF RefInfo THEN Info(section,"Record") END;
+								Char(section, sfTypeRecord);
+								td := type.typeDeclaration;		
+								IF RefInfo THEN Info(section,"TD") END;
+								IF (td # NIL) THEN
+									Global.GetSymbolSegmentedName(td,segmentedName);
+									IF (td.scope = NIL) OR (td.scope.ownerModule = module.module) THEN
+										tir := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+									ELSE
+										tir := IntermediateCode.NewSection(module.importedSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+									END;
+									offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(0)*module.system.addressSize);
+									Symbol(section, tir,  0, offset);
+								ELSE
+									Address(section, 0);
+								END;
+						| type: SyntaxTree.PortType DO
+							Char(section, sfTypePortType);
+							IF type.direction = SyntaxTree.OutPort THEN
+								Char(section, sfOutPort)
+							ELSE
+								Char(section, sfInPort)
+							END;
 						| type: SyntaxTree.ProcedureType DO
 								Char(section, sfTypeDelegate);
 								parameter := type.firstParameter;
@@ -12051,6 +12078,14 @@ TYPE
 						PatchSize(s(IntermediateCode.Section), patchInfoPC, pos);
 
 						NScope(declared.recordScope, pos);
+					|declared: SyntaxTree.CellType DO
+						offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(0)*module.system.addressSize);
+						Symbol(section, s,  0, offset);
+						Global.GetSymbolSegmentedName(typeDeclaration,name);
+						Basic.AppendToSegmentedName(name,".@Info");
+						s := module.allSections.FindByName(name); 
+						PatchSize(s(IntermediateCode.Section), patchInfoPC, pos);
+						NScope(declared.cellScope, pos);
 					ELSE
 						Address(section, 0);
 					END;					

source/Generic.Reflection.Mod

@@ -58,6 +58,11 @@ CONST
 	sfTypeMathTensor* = 28X;
 	sfTypeDelegate* = 29X; 
 	sfTypeENUM* = 2AX;
+	sfTypeCell = 2BX;
+	sfTypePort = 2CX;
+	
+	sfInPort = 0X;
+	sfOutPort = 1X;
 
 	sfValPar* = 0X;
 	sfVarPar* = 1X;
@@ -274,7 +279,6 @@ CONST
 					end := GetAddress(refs, offset); 
 					w.String(name); 
 					w.Char(":"); w.Int(LONGINT(pc-startpc),1);
-					SkipType(refs, offset);
 					base := fp; (*! only for local !! *)
 					refpos := offset; 
 				END;
@@ -398,6 +402,8 @@ CONST
 			SYSTEM.GET(adr, sz); Signed(sz); w.String("["); Unsigned(sz, SIZEOF(SIZE)); w.String("]");
 		| sfTypeENUM:
 			SYSTEM.GET(adr, word); Signed(word);
+		| sfTypePort:
+			SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
 		ELSE
 			w.String("UNKOWN TYPE "); Unsigned(ORD(type),1);
 		END;
@@ -476,6 +482,9 @@ CONST
 		| sfTypeDelegate: 
 			WHILE refs[offset] = sfParameter DO SkipParameter(refs, offset) END;
 			SkipType(refs, offset); 
+		| sfTypePort:
+			WriteBasicValue(w, type, adr, size);
+			SkipChar(offset);
 		ELSE
 			WriteBasicValue(w, type, adr, size);
 		END;
@@ -496,18 +505,44 @@ CONST
 		WriteValue(w, refs, offset, adr+base); 
 	END WriteVariable; 
 	
+	PROCEDURE WriteParameter*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT;  base: ADDRESS);
+	VAR name: ARRAY 128 OF CHAR;  adr: LONGINT;  prevScope: SIZE; c: CHAR;
+	BEGIN
+		IF ~Expect(GetChar(refs, offset) = sfParameter) THEN RETURN END;
+		prevScope := GetSize(refs, offset);
+		GetString(refs, offset, name); 
+		w.String(Sep); w.String(name); w.Char("=");
+		adr := GetSize(refs, offset);
+		c := GetChar(refs, offset); (*! check for varpar *)
+		WriteValue(w, refs, offset, adr+base); 
+	END WriteParameter; 
+	
+
 	(* write variables taking meta information from stream in stream at offset, potentially stored at base address
 	 *)
 	PROCEDURE WriteVariables*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS);
 	VAR count: LONGINT; 
 	BEGIN
 		WHILE refs[offset] = sfVariable DO
-			WriteVariable(w, refs, offset, base); 
-			INC(count); 
+			WriteVariable(w, refs, offset, base); w.Ln;
+			(*INC(count); *)
 		END; 
 		IF count > 0 THEN w.Ln; Wait(w); END;
 	END WriteVariables;
 
+	(* write variables taking meta information from stream in stream at offset, potentially stored at base address
+	 *)
+	PROCEDURE WriteParameters*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS);
+	VAR count: LONGINT; 
+	BEGIN
+		WHILE refs[offset] = sfParameter DO
+			WriteParameter(w, refs, offset, base); w.Ln;
+			(*INC(count); *)
+		END; 
+		IF count > 0 THEN w.Ln; Wait(w); END;
+	END WriteParameters;
+
+
 	(* skip type metadata in stream *)
 	PROCEDURE SkipType*(refs: Modules.Bytes; VAR offset: LONGINT);
 	VAR size: SIZE;  adr: LONGINT; c: CHAR;
@@ -528,6 +563,7 @@ CONST
 			WHILE refs[offset] = sfParameter DO SkipParameter(refs, offset) END;
 			SkipType(refs, offset);
 		| sfTypeENUM:
+		| sfTypePort: SkipChar(offset);
 		ELSE (* ?? *)
 		END;
 	END SkipType;
@@ -786,6 +822,8 @@ CONST
 					WriteProc0(w, m, pc, bp, refs, offset, base); w.Ln;Wait(w); w.Update;
 					IF long & (~overflow OR (count > 0)) THEN	(* show variables *)
 						IF offset >= 0 THEN 
+							WriteParameters(w,refs,offset, base); 
+							SkipType(refs, offset);
 							IF Expect(GetChar(refs, offset) = sfScopeBegin) THEN
 								WriteVariables(w,refs,offset, base); 
 							END;
@@ -927,6 +965,7 @@ TYPE
 		| sfTypeRANGE: w.String("RANGE"); 
 		| sfTypeADDRESS: w.String("ADDRESS"); 
 		| sfTypeSIZE: w.String("SIZE"); 
+		| sfTypePort: w.String("PORT"); IF GetChar(refs,offset) = sfInPort THEN w.String("IN") ELSE w.String("OUT") END;
 		ELSE w.String("????? TYPE ?????");
 		END;
 	END ReportType;
@@ -1047,3 +1086,7 @@ TestReflection.Test
 TestReflection.Trace 09454F69H ~
 
 SystemTools.FreeDownTo FoxIntermediateBackend ~
+
+
+#	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 ~
+