Selaa lähdekoodia

Work on interpreter with new reflection (can be compiled and partially works)

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6824 8c9fc860-2736-0410-a75d-ab315db34111
felixf 9 vuotta sitten
vanhempi
commit
7369876d8a
3 muutettua tiedostoa jossa 378 lisäystä ja 229 poistoa
  1. 29 3
      source/FoxInterpreter.Mod
  2. 315 220
      source/FoxInterpreterSymbols.Mod
  3. 34 6
      source/Generic.Reflection.Mod

+ 29 - 3
source/FoxInterpreter.Mod

@@ -86,8 +86,6 @@ TYPE
 		item-: Item;
 		module-: Modules.Module;
 		typeDesc-: Modules.TypeDesc;
-		procedureDesc-: Modules.ProcedureEntry;
-
 		scope-: Scope;
 		exit: BOOLEAN;
 		error-: BOOLEAN;
@@ -1283,13 +1281,41 @@ BEGIN
 	NEW(global, NIL, container);
 END InitGlobalScope;
 
+VAR c: LONGINT;
+VAR d: RECORD e: LONGINT END;
+
+	PROCEDURE Getter(): LONGINT;
+	BEGIN
+		RETURN 123;
+	END Getter;
+
+	PROCEDURE Setter(a: LONGINT): LONGINT;
+	BEGIN
+		TRACE(a);
+		RETURN a+123;
+	END Setter;
+	
+
 BEGIN
 	InitGlobalScope;
+	c := 10; 
+	d.e := 20;
 END FoxInterpreter.
 
-SystemTools.Free FoxInterpreter FoxInterpreterSymbols ~
+SystemTools.Free FoxInterpreter FoxInterpreterSymbols Reflection2 ~
+
+FoxInterpreter.Expression
+	FoxInterpreter.c ~
+
+FoxInterpreter.Expression
+	FoxInterpreter.d.e ~
 
+FoxInterpreter.Expression
+	FoxInterpreter.Getter() ~
 
+FoxInterpreter.Expression
+	FoxInterpreter.Setter(1000) ~
+	
 
 FoxInterpreter.Expression
 	Test.c.b;

+ 315 - 220
source/FoxInterpreterSymbols.Mod

@@ -1,54 +1,91 @@
 MODULE FoxInterpreterSymbols; (** AUTHOR ""; PURPOSE ""; *)
 
-IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, Machine, SyntaxTree := FoxSyntaxTree, SYSTEM;
+IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, Machine, SyntaxTree := FoxSyntaxTree, SYSTEM, Reflection;
 
 CONST
 	TAB = 09X;
 
-CONST
-
-			sfTypeNone = 0X;
-			sfTypeCHAR = 01X;
-			sfTypeCHAR8 = 02X;
-			sfTypeCHAR16 = 03X;
-			sfTypeCHAR32 = 04X;
-			sfTypeRANGE = 05X;
-			sfTypeSHORTINT = 06X;
-			sfTypeINTEGER = 07X;
-			sfTypeLONGINT = 08X;
-			sfTypeHUGEINT = 09X;
-			sfTypeWORD = 0AX;
-			sfTypeLONGWORD = 0BX;
-			sfTypeSIGNED8 = 0CX;
-			sfTypeSIGNED16 = 0DX;
-			sfTypeSIGNED32 = 0EX;
-			sfTypeSIGNED64 = 0FX;
-			sfTypeUNSIGNED8 = 10X;
-			sfTypeUNSIGNED16 = 11X; 
-			sfTypeUNSIGNED32 = 12X;
-			sfTypeUNSIGNED64 = 13X;
-			sfTypeREAL = 14X;
-			sfTypeLONGREAL = 15X;
-			sfTypeCOMPLEX = 16X;
-			sfTypeLONGCOMPLEX = 17X;
-			sfTypeBOOLEAN = 18X;
-			sfTypeSET = 19X;
-			sfTypeANY = 1AX;
-			sfTypeOBJECT = 1BX; 
-			sfTypeBYTE = 1CX; 
-			sfTypeADDRESS = 1DX; 
-			sfTypeSIZE = 1EX; 
-			sfTypePointerToRecord = 20X;
-			sfTypePointerToArray = 21X;
-			sfTypeOpenArray = 22X;
-			sfTypeStaticArray = 23X;
-			sfTypeRecord = 24X;
 
 TYPE
 
 	Item*= PersistentObjects.Object;
 	Object* = PersistentObjects.Object;
 	Content* = PersistentObjects.Content;
+	
+
+	Meta* = RECORD
+		module*: Modules.Module;
+		refs*: Modules.Bytes;
+		offset*: LONGINT;
+	END;
+
+	PROCEDURE FindSymbol*(CONST name: ARRAY OF CHAR; meta: Meta): Meta;
+	BEGIN
+		meta.offset := Reflection.FindByName(meta.refs, meta.offset, name,TRUE);
+		RETURN meta;
+	END FindSymbol;
+
+	PROCEDURE SymbolKind*(meta: Meta): CHAR;
+	BEGIN
+		RETURN Reflection.GetChar(meta.refs, meta.offset);
+	END SymbolKind;
+
+	PROCEDURE SymbolParent*(meta: Meta): Meta;
+	BEGIN
+		Reflection.SkipChar(meta.offset);
+		meta.offset := Reflection.GetSize(meta.refs, meta.offset);
+	RETURN meta;
+	END SymbolParent;
+
+	PROCEDURE SymbolName*(meta: Meta; VAR name: ARRAY OF CHAR);
+	BEGIN
+		Reflection.SkipChar(meta.offset);
+		Reflection.SkipSize(meta.offset);
+		Reflection.GetString(meta.refs, meta.offset, name);
+	END SymbolName;
+
+	PROCEDURE VariableMode*(meta: Meta): Meta;
+	BEGIN
+		Reflection.SkipChar(meta.offset);
+		Reflection.SkipSize(meta.offset);
+		Reflection.SkipString(meta.refs, meta.offset);
+		RETURN meta;
+	END VariableMode;
+
+	PROCEDURE VariableType*(meta: Meta): Meta;
+	BEGIN
+		Reflection.SkipChar(meta.offset);
+		Reflection.SkipSize(meta.offset);
+		Reflection.SkipString(meta.refs, meta.offset);
+		Reflection.SkipChar(meta.offset);
+		Reflection.SkipSize(meta.offset);
+		RETURN meta;
+	END VariableType;
+	
+	PROCEDURE SymbolAddress*(meta: Meta; base: ADDRESS): ADDRESS;
+	VAR kind, mode: CHAR;
+	BEGIN
+		kind := Reflection.GetChar(meta.refs, meta.offset);
+		Reflection.SkipSize(meta.offset);
+		Reflection.SkipString(meta.refs, meta.offset);
+		CASE kind OF 
+		Reflection.sfProcedure:
+			RETURN Reflection.GetAddress(meta.refs, meta.offset);
+		|Reflection.sfVariable:
+			mode := Reflection.GetChar(meta.refs, meta.offset); 
+			IF mode = Reflection.sfRelative THEN
+				RETURN base + Reflection.GetSize(meta.refs, meta.offset);
+			ELSIF mode = Reflection.sfIndirect THEN
+				RETURN base + Reflection.GetSize(meta.refs, meta.offset);
+			ELSIF mode = Reflection.sfAbsolute THEN
+				RETURN Reflection.GetAddress(meta.refs, meta.offset);
+			END;
+		|Reflection.sfTypeDeclaration:
+			RETURN Reflection.GetAddress(meta.refs, meta.offset);
+		END;
+		RETURN 0; 
+	END SymbolAddress;
+
 
 	TYPE
 
@@ -94,25 +131,24 @@ TYPE
 
 	TypeResult*= OBJECT(SymbolResult)
 	VAR 
-		type-: Modules.TypeDesc;
+		type-: Meta;
 		address: ADDRESS;
 		
-		PROCEDURE & InitType(CONST name: ARRAY OF CHAR; CONST t: Modules.TypeDesc);
+		PROCEDURE & InitType(CONST name: ARRAY OF CHAR; t: Meta);
+		VAR typeDesc: Modules.TypeDesc; adr: ADDRESS;
 		BEGIN
 			InitSymbol(name); 
 			type := t;
+			adr := SymbolAddress(type, 0);
+			typeDesc := SYSTEM.VAL(Modules.TypeDesc, adr);
+			address := typeDesc.tag;
 		END InitType;
 
 		PROCEDURE Address(): ADDRESS;
 		BEGIN
-			RETURN type.tag;
+			RETURN address;
 		END Address;
-			
-		PROCEDURE Evaluate(): Value;
-		BEGIN
-			RETURN NIL;
-		END Evaluate;
-		
+					
 		PROCEDURE Constructor*(): ProcedureResult;
 		BEGIN
 			RETURN FindConstructor(SELF, type);
@@ -122,25 +158,37 @@ TYPE
 
 	ModuleResult*= OBJECT(SymbolResult)
 	VAR 
-		self: Modules.TypeDesc;
-		mod: Modules.Module;
+		self: Meta;
 		
-		PROCEDURE & InitModule(CONST name: ARRAY OF CHAR; m: Modules.Module);
+		PROCEDURE & InitModule(CONST name: ARRAY OF CHAR; m: Meta);
 		BEGIN
-			mod := m;
 			InitSymbol(name);
-			ASSERT(m # NIL);
-			self := FindType(m.typeInfo, "@Self");
-			ASSERT(self # NIL);
+			self := m; 
 		END InitModule;
 		
 		PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
 		VAR num: LONGINT;
 				proc: ProcedureResult;
 				field: FieldResult;
+				
 				type: Modules.TypeDesc;
 				typeResult: TypeResult;
-		BEGIN
+				kind: CHAR; 
+				f: Meta;
+		BEGIN
+				f := FindSymbol(name, self);
+				TRACE(f.offset);
+				IF f.offset >= 0 THEN
+					kind := SymbolKind(f); 
+					TRACE(ORD(kind));
+					CASE kind OF
+					Reflection.sfVariable: NEW(field, name, f, Address()); RETURN field;
+					| Reflection.sfProcedure: NEW(proc, SELF, name, f); RETURN proc; 
+					| Reflection.sfTypeDeclaration: NEW(typeResult, name, f); RETURN typeResult;
+					END;
+				END;
+				(*
+				
 				IF FindProc(self.procedures, name,num) THEN
 					NEW(proc, SELF, name, self.procedures[num]);
 					proc.address := self.procedures[num].address;
@@ -156,21 +204,20 @@ TYPE
 					END;
 					RETURN typeResult;
 				END;
+				*)
 				RETURN NIL;
 		END Find;
 
 
 	END ModuleResult;
 	
-		Callstack = OBJECT
+	Callstack = OBJECT
 	VAR 
 		data: ARRAY 1024 OF CHAR;
 		pos: LONGINT;
 		size: LONGINT;
 		H: HUGEINT; (* result in register *)
 		
-		retType: Modules.FieldEntry;
-		parameters: POINTER TO ARRAY OF Modules.FieldEntry;
 		pPos: LONGINT;
 		
 		PROCEDURE & Init;
@@ -330,16 +377,42 @@ TYPE
 
 	ProcedureResult*= OBJECT(SymbolResult)
 	VAR 
-		proc: Modules.ProcedureEntry;
+		meta: Meta;
+		
 		address: ADDRESS;
 		stack: Callstack;
 		index: LONGINT;
 		caller-: Result;
+		parameters: Meta;
+		
+		PROCEDURE Parameters(): Meta;
+		VAR m: Meta;
+		BEGIN
+			m := meta;
+			ASSERT(Reflection.GetChar(m.refs, m.offset) = Reflection.sfProcedure);
+			Reflection.SkipSize(m.offset);
+			Reflection.SkipString(m.refs, m.offset);
+			address := Reflection.GetAddress(m.refs, m.offset);
+			Reflection.SkipAddress(m.offset);
+			RETURN m;
+		END Parameters;
+		
+		PROCEDURE ReturnType(): Meta;
+		VAR m: Meta;
+		BEGIN
+			m := Parameters();
+			WHILE m.refs[m.offset] = Reflection.sfVariable DO
+				Reflection.SkipVariable(m.refs, m.offset);
+			END; 
+			RETURN m;
+		END ReturnType;
 		
 		PROCEDURE ReturnsPointer*(): BOOLEAN;
+		VAR type: Meta; c: CHAR;
 		BEGIN
-			CASE proc.returnType.class
-			OF sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord: RETURN TRUE
+			type := ReturnType();
+			c := Reflection.GetChar(type.refs, type.offset);
+			CASE c OF Reflection.sfTypeANY, Reflection.sfTypeOBJECT, Reflection.sfTypePointerToRecord: RETURN TRUE
 			ELSE RETURN FALSE
 			END;
 		END ReturnsPointer;
@@ -349,16 +422,18 @@ TYPE
 			RETURN address;
 		END Address;
 		
-	
-		PROCEDURE & InitProcedure(c: Result; CONST name: ARRAY OF CHAR; CONST p: Modules.ProcedureEntry);
+		PROCEDURE & InitProcedure(c: Result; CONST name: ARRAY OF CHAR; m: Meta);
+		VAR offset: LONGINT;
 		BEGIN
-			InitSymbol(name); proc := p;
+			meta := m;
+			InitSymbol(name); (*proc := p;*)
 			caller := c; 
 		END InitProcedure;
 		
 		PROCEDURE Pars*();
 		BEGIN
 			index := 0;
+			parameters := Parameters();
 			NEW(stack); (* can optimize this *)
 		END Pars;
 		
@@ -368,148 +443,156 @@ TYPE
 		END PushAddress;
 		
 		PROCEDURE Push*(o: Result): BOOLEAN;
-		VAR type: Modules.EntryType;
+		VAR 
 			s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT; 
 			r: REAL; x: LONGREAL;
 			b: BOOLEAN;
 			set: SET;
-			var: BOOLEAN;
 			v:Value;
 			a: ADDRESS;
-		BEGIN
-			IF (proc.parameters = NIL) OR (index >= LEN(proc.parameters)) THEN RETURN FALSE END; 
-			type := proc.parameters[index].type;
+			type,mode: CHAR;
+		BEGIN
+			TRACE(ORD(parameters.refs[parameters.offset])); 
+			IF Reflection.GetChar(parameters.refs, parameters.offset) # Reflection.sfVariable THEN RETURN FALSE END;			
+			Reflection.SkipSize(parameters.offset);
+			Reflection.SkipString(parameters.refs, parameters.offset);
+			mode := Reflection.GetChar(parameters.refs, parameters.offset);
+			type := Reflection.GetChar(parameters.refs, parameters.offset);
+			
+			(*type := proc.parameters[index].type;
 			var := 1 IN proc.parameters[index].flags;
+			*)
 			INC(index);
-			IF var THEN
-				IF type.subclass = 0X THEN
-					CASE type.class OF
-						sfTypeCHAR .. sfTypePointerToArray:
+			IF mode  = Reflection.sfIndirect THEN (* by reference *)
+				IF type = Reflection.sfTypeOpenArray THEN 
+					type := Reflection.GetChar(parameters.refs, parameters.offset);
+					CASE type OF
+					Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
+						IF o IS StringValue THEN
+							stack.PushSz(LEN(o(StringValue).value));
+							stack.PushA(ADDRESSOF(o(StringValue).value[0])); 
+							RETURN TRUE;
+						END;
+					END;
+				ELSE
+					CASE type OF
+						Reflection.sfTypeCHAR .. Reflection.sfTypeSIZE, Reflection.sfTypePointerToRecord, Reflection.sfTypePointerToArray:
 						(*! check type ! *)
 						 stack.PushA(o.Address());
 						 RETURN TRUE;
 					ELSE
 						RETURN FALSE
 					END;
-				ELSIF type.subclass = sfTypeOpenArray THEN
-					CASE type.class OF
-					sfTypeCHAR, sfTypeCHAR8:
-						IF o IS StringValue THEN
-							stack.PushSz(LEN(o(StringValue).value));
-							stack.PushA(ADDRESSOF(o(StringValue).value[0])); 
+				END;
+			ELSE (* by value *)
+				v := o.Evaluate();
+				TRACE(v);
+				IF v = NIL THEN RETURN FALSE END;
+				WITH v: Value DO 
+					TRACE(type);
+					CASE type OF
+					Reflection.sfTypeSHORTINT,Reflection.sfTypeSIGNED8 : 
+						IF v.GetInt(h) THEN
+							s:= SHORTINT(h); stack.PushS(s);
 							RETURN TRUE;
 						END;
-					END;
-				END;
-			ELSE
-			v := o.Evaluate();
-			IF v = NIL THEN RETURN FALSE END;
-			WITH v: Value DO 
-			IF type.subclass = 0X THEN
-				CASE type.class OF
-				sfTypeSHORTINT,sfTypeSIGNED8 : 
-					IF v.GetInt(h) THEN
-						s:= SHORTINT(h); stack.PushS(s);
-						RETURN TRUE;
-					END;
-				| sfTypeINTEGER,sfTypeSIGNED16 : 
-					IF v.GetInt(h) THEN
-						i:= INTEGER(h); stack.PushI(i);
-						RETURN TRUE;
-					END;
-				| sfTypeLONGINT,sfTypeSIGNED32: 
-					IF v.GetInt(h) THEN
-						l:= LONGINT(h); stack.PushL(l);
-						RETURN TRUE;
-					END;
-				| sfTypeHUGEINT,sfTypeSIGNED64: 
-					IF v.GetInt(h) THEN
-						stack.PushH(h);
-						RETURN TRUE;
-					END;
-				|sfTypeREAL:
-					IF v.GetReal(x) THEN
-						r := REAL(x);stack.PushR(r);
-						RETURN TRUE;
-					END;
-				|sfTypeLONGREAL:
-					IF v.GetReal(x) THEN
-						stack.PushX(x);
-						RETURN TRUE;
-					END;
-				|sfTypeBOOLEAN:
-					IF v.GetBoolean(b) THEN
-						stack.PushB(b);
-					RETURN TRUE
-					END;
-				|sfTypeSET:
-					IF v.GetSet(set) THEN
-						stack.PushSet(set);
-						RETURN TRUE
-					END;
-				|sfTypePointerToRecord:
-					IF v.GetAddress(a) THEN
-						stack.PushA(a);
+					| Reflection.sfTypeINTEGER,Reflection.sfTypeSIGNED16 : 
+						IF v.GetInt(h) THEN
+							i:= INTEGER(h); stack.PushI(i);
+							RETURN TRUE;
+						END;
+					| Reflection.sfTypeLONGINT,Reflection.sfTypeSIGNED32: 
+						IF v.GetInt(h) THEN
+							l:= LONGINT(h); stack.PushL(l);
+							RETURN TRUE;
+						END;
+					| Reflection.sfTypeHUGEINT,Reflection.sfTypeSIGNED64: 
+						IF v.GetInt(h) THEN
+							stack.PushH(h);
+							RETURN TRUE;
+						END;
+					|Reflection.sfTypeREAL:
+						IF v.GetReal(x) THEN
+							r := REAL(x);stack.PushR(r);
+							RETURN TRUE;
+						END;
+					|Reflection.sfTypeLONGREAL:
+						IF v.GetReal(x) THEN
+							stack.PushX(x);
+							RETURN TRUE;
+						END;
+					|Reflection.sfTypeBOOLEAN:
+						IF v.GetBoolean(b) THEN
+							stack.PushB(b);
 						RETURN TRUE
-					END;
-				ELSE TRACE(ORD(type.class)); HALT(100);
-				END;
-			ELSIF type.subclass = sfTypeOpenArray THEN
-				CASE type.class OF
-				sfTypeCHAR, sfTypeCHAR8:
-					IF v IS StringValue THEN
-						stack.PushSz(LEN(v(StringValue).value));
-						stack.PushA(ADDRESSOF(v(StringValue).value[0])); 
-						RETURN TRUE;
+						END;
+					|Reflection.sfTypeSET:
+						IF v.GetSet(set) THEN
+							stack.PushSet(set);
+							RETURN TRUE
+						END;
+					|Reflection.sfTypePointerToRecord:
+						IF v.GetAddress(a) THEN
+							stack.PushA(a);
+							RETURN TRUE
+						END;
+					|Reflection.sfTypeOpenArray:
+						type := Reflection.GetChar(parameters.refs, parameters.offset);
+						CASE type OF
+						Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
+							IF v IS StringValue THEN
+								stack.PushSz(LEN(v(StringValue).value));
+								stack.PushA(ADDRESSOF(v(StringValue).value[0])); 
+								RETURN TRUE;
+							END;
+						END;
 					END;
 				END;
 			END;
-			END;
-			END;
 			RETURN FALSE;
 		END Push;
 		
 		PROCEDURE Check*(): BOOLEAN;
 		BEGIN
-			RETURN (proc.parameters = NIL) & (index = 0) OR  (index = LEN(proc.parameters));
+			RETURN Reflection.GetChar(parameters.refs, parameters.offset) # Reflection.sfVariable;
 		END Check;
 
 		PROCEDURE Evaluate(): Value;
 		VAR 
-			type: Modules.EntryType;
 			int: IntegerValue;
 			real: RealValue;
 			bool: BooleanValue;
 			set: SetValue;
 			any: AnyValue;
+			type: Meta;
 		BEGIN
-			type := proc.returnType;
-			CASE type.class OF
-				sfTypeSHORTINT,sfTypeSIGNED8 : 
+			type := ReturnType();
+			CASE Reflection.GetChar(type.refs, type.offset) OF
+				Reflection.sfTypeSHORTINT,Reflection.sfTypeSIGNED8 : 
 					NEW(int, SHORTINT(stack.CallH(address))); 
 					RETURN int;
-			| sfTypeINTEGER,sfTypeSIGNED16 : 
+			| Reflection.sfTypeINTEGER,Reflection.sfTypeSIGNED16 : 
 					NEW(int,  INTEGER(stack.CallH(address))); 
 					RETURN int;
-			| sfTypeLONGINT,sfTypeSIGNED32: 
+			| Reflection.sfTypeLONGINT,Reflection.sfTypeSIGNED32: 
 					NEW(int,  LONGINT(stack.CallH(address))); 
 					RETURN int;
-			| sfTypeHUGEINT,sfTypeSIGNED64: 
+			| Reflection.sfTypeHUGEINT,Reflection.sfTypeSIGNED64: 
 					NEW(int, stack.CallH(address)); 
 					RETURN int;
-			|sfTypeREAL:
+			|Reflection.sfTypeREAL:
 				 NEW(real, stack.CallR(address)); 
 				 RETURN real
-			|sfTypeLONGREAL:
+			|Reflection.sfTypeLONGREAL:
 				NEW(real, stack.CallX(address));
 				RETURN real; 
-			|sfTypeBOOLEAN:
+			|Reflection.sfTypeBOOLEAN:
 				NEW(bool, SYSTEM.VAL(BOOLEAN, stack.CallH(address))); 
 				RETURN bool; 
-			|sfTypeSET:
+			|Reflection.sfTypeSET:
 				NEW(set,  SYSTEM.VAL(SET, stack.CallH(address))); 
 				RETURN set;
-			| sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord:  (* pointers are passed as varpars *)
+			| Reflection.sfTypeANY, Reflection.sfTypeOBJECT, Reflection.sfTypePointerToRecord:  (* pointers are passed as varpars *)
 				stack.Call(address);
 				RETURN NIL;
 			| 0X: 
@@ -522,12 +605,15 @@ TYPE
 	END ProcedureResult;
 
 	FieldResult* = OBJECT (SymbolResult)
-	VAR field: Modules.FieldEntry;
+	VAR
 		address: ADDRESS;
-	
-		PROCEDURE & InitField(CONST name: ARRAY OF CHAR; CONST f: Modules.FieldEntry);
+		meta: Meta;
+			
+		PROCEDURE & InitField(CONST name: ARRAY OF CHAR; meta: Meta; base: ADDRESS);
 		BEGIN
-			InitSymbol(name); field := f;
+			InitSymbol(name); 
+			SELF.meta := meta;
+			SELF.address := SymbolAddress(meta, base);
 		END InitField;
 		
 		PROCEDURE Address(): ADDRESS;
@@ -545,25 +631,28 @@ TYPE
 			int: IntegerValue;
 			a: ANY; 
 			any: AnyValue; 
+			
+			type: Meta;
 		BEGIN
-			CASE field.type.class OF
-				sfTypeSHORTINT,sfTypeSIGNED8 : 
+			type := VariableType(meta);
+			CASE Reflection.GetChar(type.refs, type.offset) OF
+				Reflection.sfTypeSHORTINT,Reflection.sfTypeSIGNED8 : 
 					SYSTEM.GET(address, s);
 					NEW(int, s); 
 					RETURN int;
-			| sfTypeINTEGER,sfTypeSIGNED16 : 
+			| Reflection.sfTypeINTEGER,Reflection.sfTypeSIGNED16 : 
 					SYSTEM.GET(address, i);
 					NEW(int, i); 
 					RETURN int;
-			| sfTypeLONGINT,sfTypeSIGNED32: 
+			| Reflection.sfTypeLONGINT,Reflection.sfTypeSIGNED32: 
 					SYSTEM.GET(address, l);
 					NEW(int, l); 
 					RETURN int;
-			| sfTypeHUGEINT,sfTypeSIGNED64: 
+			| Reflection.sfTypeHUGEINT,Reflection.sfTypeSIGNED64: 
 					SYSTEM.GET(address, h);
 					NEW(int,LONGINT(h)); 
 					RETURN int;
-			| sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
+			| Reflection.sfTypePointerToRecord, Reflection.sfTypeANY, Reflection.sfTypeOBJECT, Reflection.sfTypePointerToArray:
 				SYSTEM.GET(address, a); 
 					NEW(any, a);
 					RETURN any;
@@ -578,44 +667,46 @@ TYPE
 			r: REAL; x: LONGREAL;
 			b: BOOLEAN;
 			set: SET;
+			type: Meta;
 		BEGIN
-			CASE field.type.class OF
-				sfTypeSHORTINT, sfTypeSIGNED8:
+			type := VariableType(meta);
+			CASE Reflection.GetChar(meta.refs, meta.offset) OF
+				Reflection.sfTypeSHORTINT, Reflection.sfTypeSIGNED8:
 				IF v.GetInt(h) THEN
 					s:= SHORTINT(h); SYSTEM.PUT(address, s);
 					RETURN TRUE;
 				END;
-			|sfTypeINTEGER, sfTypeSIGNED16:
+			|Reflection.sfTypeINTEGER, Reflection.sfTypeSIGNED16:
 				IF v.GetInt(h) THEN
 					i:= INTEGER(h); SYSTEM.PUT(address, i);
 					RETURN TRUE;
 				END;
-			|sfTypeLONGINT, sfTypeSIGNED32:
+			|Reflection.sfTypeLONGINT, Reflection.sfTypeSIGNED32:
 				IF v.GetInt(h) THEN
 					l:= LONGINT(h); SYSTEM.PUT(address, l);
 					RETURN TRUE;
 				END;
-			|sfTypeHUGEINT, sfTypeSIGNED64:
+			|Reflection.sfTypeHUGEINT, Reflection.sfTypeSIGNED64:
 				IF v.GetInt(h) THEN
 					SYSTEM.PUT(address, h); 
 					RETURN TRUE
 				END;
-			|sfTypeREAL:
+			|Reflection.sfTypeREAL:
 				IF v.GetReal(x) THEN
 					r := REAL(x); SYSTEM.PUT(address, r);
 					RETURN TRUE
 				END;
-			|sfTypeLONGREAL:
+			|Reflection.sfTypeLONGREAL:
 				IF v.GetReal(x) THEN
 					SYSTEM.PUT(address,x); 
 					RETURN TRUE
 				END;
-			|sfTypeBOOLEAN:
+			|Reflection.sfTypeBOOLEAN:
 				IF v.GetBoolean(b) THEN
 					SYSTEM.PUT(address,b); 
 					RETURN TRUE
 				END;
-			|sfTypeSET:
+			|Reflection.sfTypeSET:
 				IF v.GetSet(set) THEN
 					SYSTEM.PUT(address,set); 
 					RETURN TRUE
@@ -624,61 +715,58 @@ TYPE
 		END SetV;
 
 		PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
-		VAR type, value: ADDRESS;
+		VAR value, typeDesc: ADDRESS;
 		VAR typeInfo: Modules.TypeDesc; num: LONGINT;
 		proc: ProcedureResult; f: FieldResult;
-		BEGIN
-			IF (field.type.class = sfTypePointerToRecord)
-				OR (field.type.class = sfTypeANY) 
-				OR (field.type.class = sfTypeOBJECT)
-			 THEN
-				SYSTEM.GET(address, value);
-				SYSTEM.GET(value-SIZEOF(ADDRESS), type); (*  type desc *)
-				RETURN FindInType(SELF, value, type, name);
-				(*
-				SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
-				IF FindProc(typeInfo.procedures, name,num) THEN
-					NEW(proc, SELF, name, typeInfo.procedures[num]);
-					proc.address := typeInfo.procedures[num].address;
-					RETURN proc
-				ELSIF FindField(typeInfo.fields, name, num) THEN
-					NEW(f, name, typeInfo.fields[num]);
-					f.address := value + typeInfo.fields[num].offset;
-					RETURN f;
-				ELSE HALT(101);
-				END;
-				*)
-			ELSIF field.type.class = sfTypeRecord THEN
-				type := field.type.type;
-				RETURN FindInType(SELF, address, type, name);
-				(*
-				SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
-				IF FindProc(typeInfo.procedures, name,num) THEN
-					NEW(proc, SELF, name, typeInfo.procedures[num]);
-					proc.address := typeInfo.procedures[num].address;
-					RETURN proc
-				ELSIF FindField(typeInfo.fields, name, num) THEN
-					NEW(f, name, typeInfo.fields[num]);
-					f.address := address + typeInfo.fields[num].offset;
-					RETURN f;
-				ELSE HALT(101);
-				END;
-				*)
-			ELSE HALT(100); 
+		type: Meta; base: CHAR;
+		BEGIN
+			type := VariableType(meta);
+			base := Reflection.GetChar(type.refs, type.offset); 
+			TRACE(ORD(base));
+			CASE base OF
+				Reflection.sfTypePointerToRecord, Reflection.sfTypeANY, Reflection.sfTypeOBJECT:
+					SYSTEM.GET(address, value);
+					SYSTEM.GET(value-SIZEOF(ADDRESS), typeDesc); (*  type desc *)
+					RETURN FindInType(SELF, value, typeDesc, name);
+				|Reflection.sfTypeRecord:
+					typeDesc := Reflection.GetAddress(type.refs, type.offset); (* type desc *) 
+					RETURN FindInType(SELF, address, typeDesc, name);
+			ELSE
+				RETURN NIL;
 			END;
 		END Find;
 		
 	END FieldResult;
 
+	
 	(* traverse types and supertypes for first occurence of symbol name *) 	
 	PROCEDURE FindInType(scope: Result; address: ADDRESS; type: ADDRESS; CONST name: ARRAY OF CHAR): Result;
 	VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT; 
 			proc: ProcedureResult; f: FieldResult;	
+			meta: Meta; kind: CHAR;
 	BEGIN
 		FOR i := 15 TO 0 BY -1 DO
 			SYSTEM.GET(type-(2+i)*SIZEOF(ADDRESS), tag); 
 			IF tag # NIL THEN
 				SYSTEM.GET(tag-SIZEOF(ADDRESS), typeInfo); 
+				meta.module := typeInfo.mod;
+				meta.offset := typeInfo.refsOffset;
+				meta.refs := meta.module.refs;
+				Reflection.Report(Commands.GetContext().out, meta.refs, meta.offset); 
+				meta := FindSymbol(name, meta);
+				TRACE(meta.offset);
+				IF meta.offset >= 0 THEN 
+					kind := SymbolKind(meta);
+					TRACE(ORD(kind));
+					CASE kind OF
+					Reflection.sfProcedure:
+						NEW(proc, scope, name, meta); RETURN proc;
+					|Reflection.sfVariable:
+						NEW(f, name, meta, address); RETURN f;
+					ELSE (* none *)
+					END;
+				END;
+				(*
 				IF FindProc(typeInfo.procedures, name,num) THEN
 					NEW(proc, scope, name, typeInfo.procedures[num]);
 					proc.address := typeInfo.procedures[num].address;
@@ -688,15 +776,18 @@ TYPE
 					f.address := address + typeInfo.fields[num].offset;
 					RETURN f;
 				END;
+				*)
 			END;
 		END;
 		RETURN NIL; 
 	END FindInType;
 	
-	PROCEDURE FindConstructor(scope: Result; type: ADDRESS): ProcedureResult;
+		
+	PROCEDURE FindConstructor(scope: Result; type: Meta): ProcedureResult;
 	VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT; 
 			proc: ProcedureResult; f: FieldResult;	
 	BEGIN
+		(*
 		FOR i := 15 TO 0 BY -1 DO
 			SYSTEM.GET(type-(2+i)*SIZEOF(ADDRESS), tag); 
 			IF tag # NIL THEN
@@ -710,6 +801,7 @@ TYPE
 				END;
 			END;
 		END;
+		*)
 		RETURN NIL; 
 	END FindConstructor;
 	
@@ -1573,9 +1665,8 @@ TYPE
 		END Filter;
 
 	END ObjectFilter;
-
-
-			
+	
+	(*
 	PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
 	VAR i: LONGINT;
 	BEGIN
@@ -1609,13 +1700,17 @@ TYPE
 		END;
 		RETURN FALSE;
 	END FindProc;
+	*)
 	
 	PROCEDURE GetModule*(CONST name: ARRAY OF CHAR): ModuleResult;
-	VAR msg: ARRAY 128 OF CHAR; res: LONGINT; mod:ModuleResult; m: Modules.Module;
+	VAR msg: ARRAY 128 OF CHAR; res: LONGINT; mod:ModuleResult; m: Modules.Module; meta: Meta;
 	BEGIN
 		m := Modules.ThisModule(name, res, msg);
 		IF m # NIL THEN 
-			NEW(mod, name, m);
+			meta.module := m;
+			meta.refs := m.refs;
+			meta.offset := 0;
+			NEW(mod, name, meta);
 		ELSE
 			mod := NIL;
 		END;

+ 34 - 6
source/Generic.Reflection.Mod

@@ -84,6 +84,28 @@ CONST
 		Procedure = sfProcedure prevSymbolOffset:SIZE name:String start:ADR end:ADR returnType:Type {parameter:Variable} Scope.
 		Variable = sfVariable prevSymbolOffset:SIZE name:String (sfRelative offset: SIZE | sfIndirec offset: SIZE | sfAbsolute address:ADDRESS) type:Type.
 		TypeDeclaration = sfTypeDeclaration prevSymbolOffset:SIZE name:String typeInfo:ADR Scope.
+		Type = 
+			sfTypePointerToRecord 
+			| sfTypePointerToArray Type
+			| sfTypeOpenArray Type
+			| sfTypeDynamicArray Type
+			| sfTypeStaticArray length:SIZE Type
+			| sfTypeMathOpenArray Type 
+			| sfTypeMathStaticArray length:SIZE Type
+			| sfTypeMathTensor Type
+			| sfTypeRecord tdAdr:ADDRESS 
+			| sfTypeDelegate {Parameter} return:Type
+			| sfTypePort (sfIN | sfOUT)
+			| sfTypeBOOLEAN
+			| sfTypeCHAR | sfTypeCHAR8 | sfTypeCHAR16 | sfTypeCHAR32
+			| sfTypeSHORTINT | sfTypeINTEGER | sfTypeLONGINT | sfTypeHUGEINT
+			| sfTypeSIGNED8 | sfTypeSIGNED16 | sfTypeSIGNED32 | sfTypeSIGNED64
+			| sfTypeUNSIGNED8 | sfTypeUNSIGNED16 | sfTypeUNSIGNED32 | sfTypeUNSIGNED64
+			| sfTypeWORD | sfTypeLONGWORD
+			| sfTypeREAL | sfTypeLONGREAL
+			| sfTypeCOMPLEX | sfTypeLONGCOMPLEX
+			| sfTypeSET | sfTypeANY | sfTypeOBJECT | sfTypeBYTE | sfTypeADDRESS | sfTypeSIZE.
+
 	*)
 
 
@@ -93,6 +115,12 @@ CONST
 	TYPE 
 		Name = ARRAY 128 OF CHAR;
 
+		Meta* = RECORD
+			module-: Modules.Module;
+			refs-: Modules.Bytes;
+			offset*: LONGINT;
+		END;
+    
 	PROCEDURE CheckHeapAddress(address: ADDRESS): BOOLEAN;
 	BEGIN
 		RETURN Machine.ValidHeapAddress(address);
@@ -963,7 +991,7 @@ TYPE
 
 
 	
-	PROCEDURE ReportType(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
+	PROCEDURE ReportType*(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
 	VAR size: SIZE;  adr: LONGINT; c: CHAR;
 	BEGIN
 		c := GetChar(refs, offset);
@@ -1017,7 +1045,7 @@ TYPE
 		END;
 	END ReportType;
 
-	PROCEDURE ReportProcedure(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
+	PROCEDURE ReportProcedure*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
 	VAR name: Name;  start, end: LONGINT; 
 	BEGIN
 		w.Int(offset,1); w.String(":");
@@ -1041,7 +1069,7 @@ TYPE
 	END ReportProcedure;
 
 
-	PROCEDURE ReportVariable(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
+	PROCEDURE ReportVariable*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
 	VAR name: ARRAY 128 OF CHAR;  adr: ADDRESS;  size: SIZE;
 	BEGIN
 		w.Int(offset,1); w.String(":");
@@ -1062,7 +1090,7 @@ TYPE
 		w.Ln;
 	END ReportVariable; 
 
-	PROCEDURE ReportTypeDeclaration(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
+	PROCEDURE ReportTypeDeclaration*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
 	VAR name: ARRAY 128 OF CHAR;  adr: LONGINT; 
 	BEGIN
 		w.Int(offset,1); w.String(":");
@@ -1078,7 +1106,7 @@ TYPE
 		IF refs[offset] = sfScopeBegin THEN ReportScope(w, refs, offset) END;
 	END ReportTypeDeclaration; 
 
-	PROCEDURE ReportScope(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
+	PROCEDURE ReportScope*(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
 	BEGIN
 		IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END; 
 		w.Int(offset,1); w.String(": Scope"); w.Ln;
@@ -1095,7 +1123,7 @@ TYPE
 		w.String("END"); w.Ln; 
 	END ReportScope;
 	
-	PROCEDURE ReportModule(w: Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
+	PROCEDURE ReportModule*(w: Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
 	VAR name: Name;
 	BEGIN
 		w.String("MODULE ");