浏览代码

added reflection info for global procedures and variables

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6635 8c9fc860-2736-0410-a75d-ab315db34111
felixf 9 年之前
父节点
当前提交
e02fb52fbf
共有 2 个文件被更改,包括 63 次插入41 次删除
  1. 57 35
      source/FoxIntermediateBackend.Mod
  2. 6 6
      source/Generic.Modules.Mod

+ 57 - 35
source/FoxIntermediateBackend.Mod

@@ -12205,6 +12205,49 @@ TYPE
 			RETURN moduleSection;
 		END ModuleSection;
 		
+			PROCEDURE NewModuleInfo();
+			VAR name: Basic.SegmentedName;source: IntermediateCode.Section;
+				moduleSection: IntermediateCode.Section; i: LONGINT; flags: SET;
+				sectionName: Basic.SectionName;
+			CONST MPO=-40000000H;
+			BEGIN
+					(*
+						TypeDesc* = POINTER TO RECORD
+							descSize: LONGINT;
+							sentinel: LONGINT;	(* = MPO-4 *)
+							tag*: ADDRESS; (* pointer to static type descriptor, only used by linker and loader *)
+							flags*: SET;
+							mod*: Module;	(* hint only, because module may have been freed (at Heaps.ModOfs) *)
+							name*: Name;
+						END;
+					*)
+					Global.GetSymbolSegmentedName(module.module,name);
+					Basic.AppendToSegmentedName(name,"@Info");
+					source := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, name,NIL,declarationVisitor.dump);
+					Info(source, "type info size");	Address(source, 3*ToMemoryUnits(module.system,module.system.addressSize)+32);
+					Address(source,MPO-4);
+					Info(source, "type tag pointer");
+					Address( source,0);
+					Info(source, "type flags");
+					flags := {};
+					Set( source, flags);
+					Info(source, "pointer to module");
+					moduleSection := ModuleSection();
+					Symbol( source, moduleSection, moduleSection.pc,0);
+					Info(source, "type name");
+					i := 0;
+					sectionName := "@Self";
+					(*
+					Global.GetSymbolSegmentedName(td,name);
+					Basic.SegmentedNameToString(name, sectionName);
+					*)
+					Name(source,sectionName);
+					source.SetReferenced(FALSE);
+
+					ReflectVariables(source, module.module);
+					ReflectProcedures(source, module.module);
+			END NewModuleInfo;
+			
 
 			
 		PROCEDURE Module(bodyProc: IntermediateCode.Section);
@@ -12215,7 +12258,7 @@ TYPE
 			exceptionSectionOffset, commandsSectionOffset, typeInfoSectionOffset, procTableSectionOffset, ptrTableSectionOffset, maxPointers, numberProcs,temp,
 			referenceSectionOffset	: LONGINT;
 		BEGIN
-			
+			NewModuleInfo();
 			pointerSection := Block("Heaps","SystemBlockDesc",".@PointerArray",pointerSectionOffset);
 			PointerArray(pointerSection,module.module.moduleScope, numberPointers);
 			importSection := Block("Heaps","SystemBlockDesc",".@ImportsArray",importSectionOffset);
@@ -12357,6 +12400,8 @@ TYPE
 			BEGIN
 				ASSERT(implementationVisitor.newObjectFile);
 				IF ~ReflectionSupport OR simple THEN variable := NIL
+				ELSIF symbol IS SyntaxTree.Module THEN
+					variable := symbol(SyntaxTree.Module).moduleScope.firstVariable;
 				ELSIF symbol IS SyntaxTree.TypeDeclaration THEN
 					type := symbol(SyntaxTree.TypeDeclaration).declaredType.resolved;
 					IF type IS SyntaxTree.PointerType THEN
@@ -12385,6 +12430,8 @@ TYPE
 			BEGIN
 				ASSERT(implementationVisitor.newObjectFile);
 				IF ~ReflectionSupport OR simple THEN procedure := NIL
+				ELSIF symbol IS SyntaxTree.Module THEN
+					procedure := symbol(SyntaxTree.Module).moduleScope.firstProcedure;
 				ELSIF symbol IS SyntaxTree.TypeDeclaration THEN
 					type := symbol(SyntaxTree.TypeDeclaration).declaredType.resolved;
 					IF type IS SyntaxTree.PointerType THEN
@@ -12411,7 +12458,7 @@ TYPE
 			
 			PROCEDURE VariableArray(source: IntermediateCode.Section; variable: SyntaxTree.Variable);
 			VAR pc, offset: LONGINT; tir: Sections.Section; size: LONGINT;
-				segmentedName: Basic.SegmentedName;
+				segmentedName, name: Basic.SegmentedName;
 				td: SyntaxTree.TypeDeclaration;
 				type: SyntaxTree.Type;
 			BEGIN
@@ -12423,7 +12470,12 @@ TYPE
 					Symbol(source, moduleNamePoolSection, DynamicName(moduleNamePoolSection, variable.name, moduleNamePool), 0); (* reference to dynamic name *)
 					type := variable.type.resolved;
 					Info(source,"offset");
-					Size(source, ToMemoryUnits(module.system,variable.offsetInBits));
+					IF variable.scope IS SyntaxTree.ModuleScope THEN
+						implementationVisitor.GetCodeSectionNameForSymbol(variable, name);
+						NamedSymbol(source, name,variable, 0,0);
+					ELSE
+						Size(source, ToMemoryUnits(module.system,variable.offsetInBits));
+					END;
 					Info(source,"type class");
 					IF type IS SyntaxTree.PointerType THEN
 						Size(source, 1);
@@ -12537,43 +12589,13 @@ TYPE
 					Name(source,sectionName);
 					source.SetReferenced(FALSE);
 
-					Global.GetSymbolSegmentedName(td,name);
-					Basic.AppendToSegmentedName(name,"@Fields");
-					
 					ReflectVariables(source, td);
 					ReflectProcedures(source, td);
-					(*
-					fieldSection := VariableArray(
-
-					fieldSection := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, name, NIL,TRUE);
-					HeapBlock("Heaps","SystemBlockDesc", fieldSection, 2);
-					Info(fieldSection, "HeapBlock");
-					Address(fieldSection,0); (* empty such that GC does not go on traversing *)
-					Info(fieldSection, "TypeDescriptor");
-					Address(fieldSection,0);
 
-					Info(source, "FieldArray ref");
-					Symbol(source, fieldSection, fieldSection.pc, 0);
-
-					FieldArray(fieldSection);
-
-					Global.GetSymbolSegmentedName(td,name);
-					Basic.AppendToSegmentedName(name,"@Procedures");
-
-					fieldSection := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, name, NIL,TRUE);
-					HeapBlock("Heaps","SystemBlockDesc", fieldSection, 2);
-					Info(fieldSection, "HeapBlock");
-					Address(fieldSection,0); (* empty such that GC does not go on traversing *)
-					Info(fieldSection, "TypeDescriptor");
-					Address(fieldSection,0);
-
-					Info(source, "Procedure Array ref");
-					Symbol(source, fieldSection, fieldSection.pc, 0);
-
-					ProcedureArray(fieldSection);
-					*)
 					RETURN source;
 			END NewTypeDescriptorInfo;
+			
+
 
 
 			PROCEDURE NewTypeDescriptor;

+ 6 - 6
source/Generic.Modules.Mod

@@ -91,7 +91,7 @@ TYPE
 	END;
 
 	FieldEntry*= RECORD
-		name*: DynamicName; (*! change to dynamic name ? *)
+		name*: DynamicName;
 		offset*: SIZE; (* offset of this type *)
 		type*: EntryType;
 		flags*: SET;
@@ -109,15 +109,15 @@ TYPE
 		returnType*: EntryType;
 	END;
 
-	TypeDesc* = POINTER TO RECORD   (* ug: adapt constant TypeDescRecSize if this type is changed !!! *)
+	TypeDesc* = POINTER TO RECORD 
 		descSize: LONGINT;
 		sentinel: LONGINT;	(* = MPO-4 *)
 		tag*: ADDRESS; (* pointer to static type descriptor, only used by linker and loader *)
 		flags*: SET;
 		mod*: Module;	(* hint only, because module may have been freed (at Heaps.ModOfs) *)
 		name*: Name;
-		fields*: POINTER TO ARRAY OF FieldEntry;
-		procedures*: POINTER TO ARRAY OF ProcedureEntry;
+		fields*: FieldEntries;
+		procedures*: ProcedureEntries;
 	END;
 
 	ExceptionTableEntry* = RECORD
@@ -153,8 +153,8 @@ TYPE
 			sb*: ADDRESS; (* reference address between constants and local variables *)
 			entry*: POINTER TO ARRAY OF ADDRESS;
 			command*: POINTER TO ARRAY OF Command;
-			ptrAdr*: POINTER TO ARRAY OF ADDRESS;
-			typeInfo*: POINTER TO ARRAY OF TypeDesc;	(* traced explicitly in FindRoots *)
+			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*: ProcTable; (* information inserted by loader, removed after use in Publish *)
 			ptrTable*: PtrTable;  (* information inserted by loader, removed after use in Publish *)