Bläddra i källkod

Work on the interpreter using reflection support. (Unlimited and yet dangerous) access to global variables and fields available.
Next: procedure support.
/!\ work in progress /!\

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

felixf 9 år sedan
förälder
incheckning
a7d53a4eac
4 ändrade filer med 922 tillägg och 147 borttagningar
  1. 201 11
      source/FoxIntermediateBackend.Mod
  2. 305 63
      source/FoxInterpreter.Mod
  3. 374 46
      source/FoxInterpreterSymbols.Mod
  4. 42 27
      source/Generic.Modules.Mod

+ 201 - 11
source/FoxIntermediateBackend.Mod

@@ -11096,6 +11096,13 @@ TYPE
 			section.Emit(Data(-1,op));
 		END Char;
 
+		PROCEDURE Integer(section: IntermediateCode.Section; int: LONGINT);
+		VAR op: IntermediateCode.Operand;
+		BEGIN
+			IntermediateCode.InitImmediate(op,IntermediateCode.GetType(module.system, module.system.integerType),int);
+			section.Emit(Data(-1,op));
+		END Integer;
+
 		PROCEDURE String(section: IntermediateCode.Section; CONST str: ARRAY OF CHAR);
 		VAR i: LONGINT;
 		BEGIN
@@ -12541,40 +12548,222 @@ TYPE
 			VAR pc, offset: LONGINT; tir: Sections.Section; size: LONGINT;
 				segmentedName, name: Basic.SegmentedName;
 				td: SyntaxTree.TypeDeclaration;
+			CONST
+			
+				sfTypeNoType = 0X;
+				sfTypeBoolean= 01X;
+				sfTypeChar = 02X;
+				sfTypeSignedInteger = 03X;
+				sfTypeUnsignedInteger = 04X;
+				sfTypeFloat = 05X;
+				sfTypeComplex = 06X;
+				sfTypeSet = 07X;
+				sfTypeByte =  08X;
+				sfTypeAny =  09X;
+				sfTypeObject =  0AX;
+				sfTypeAddress= 0BX;
+				sfTypeSize = 0CX;
+				sfTypeRange  = 0DX;
+				sfTypePointerToRecord = 0EX;
+				sfTypePointerToArray = 0FX;
+				sfTypeOpenArray = 10X;
+				sfTypeStaticArray = 11X;
+				sfTypeRecord = 12X;
+				
+				
+
 			BEGIN
 				IF type # NIL THEN 
 					type := type.resolved;
 					Info(source,"type class");
-					IF type IS SyntaxTree.PointerType THEN
-						Size(source, 1);
-					ELSIF type IS SyntaxTree.RecordType THEN
-						Size(source, 2);
-					ELSIF type IS SyntaxTree.NumberType THEN
-						Size(source, 3);
+					
+					size := type.sizeInBits;
+					IF type IS SyntaxTree.BasicType THEN (* BasicType  *)
+						IF type IS SyntaxTree.BooleanType THEN 
+							Char(source, sfTypeBoolean);
+						ELSIF type IS SyntaxTree.CharacterType THEN
+							Char(source, sfTypeChar);
+						ELSIF type IS SyntaxTree.IntegerType THEN
+							IF type(SyntaxTree.IntegerType).signed THEN
+								Char(source, sfTypeSignedInteger)
+							ELSE
+								Char(source, sfTypeUnsignedInteger)
+							END;
+						ELSIF type IS SyntaxTree.FloatType THEN
+							Char(source, sfTypeFloat);
+						ELSIF type IS SyntaxTree.ComplexType THEN
+							Char(source, sfTypeComplex)
+						ELSIF type IS SyntaxTree.SetType THEN
+							Char(source, sfTypeSet);
+						ELSIF type IS SyntaxTree.AnyType THEN 
+							Char(source, sfTypeAny);
+						ELSIF type IS SyntaxTree.ObjectType THEN
+							Char(source, sfTypeObject);
+						ELSIF type IS SyntaxTree.ByteType THEN
+							Char(source, sfTypeByte);
+						ELSIF type IS SyntaxTree.RangeType THEN
+							Char(source, sfTypeRange)
+						ELSIF type IS SyntaxTree.AddressType THEN 
+							Char(source, sfTypeAddress)
+						ELSIF type IS SyntaxTree.SizeType THEN 
+							Char(source, sfTypeSize)
+						ELSE 
+							Char(source, 0FFX); (* invalid type *)
+						END;
+					ELSIF (type IS SyntaxTree.PointerType) THEN
+						IF IsStrictlyPointerToRecord(type) THEN
+							Char(source, sfTypePointerToRecord)
+						ELSE
+							Char(source, sfTypePointerToArray)
+						END; 
+					ELSIF (type IS SyntaxTree.ArrayType) THEN
+						IF IsStaticArray(type) THEN
+							Char(source, sfTypeStaticArray)
+						ELSE
+							Char(source, sfTypeOpenArray)
+						END;
+					ELSIF (type IS SyntaxTree.RecordType) THEN
+						IF type(SyntaxTree.RecordType).pointerType # NIL (* OBJECT *) THEN
+							Char(source, sfTypePointerToRecord)
+						ELSE
+							Char(source, sfTypeRecord);
+						END;
 					ELSE
-						Size(source, 0);
+						Char(source, 0FFX); (* invalid type *)
+					END; 
+					Char(source, 0X); (* subtype *)
+
+						(*
+						IF TraceExport IN Trace THEN
+
+							IF  type IS SyntaxTree.RecordType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / RecordType "); D.Str(name); D.Ln END;
+								WITH type: SyntaxTree.RecordType DO
+									w.RawNum(sfTypeRecord);
+									baseType := type.baseType;
+									Type(baseType);
+									w.RawString(name);
+									IF type.isRealtime THEN INCL(flags,sfRealtime) END;
+									w.RawNum(SYSTEM.VAL(LONGINT,flags));
+									Record(type)
+								END
+							ELSIF type IS SyntaxTree.PointerType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / PointerType "); D.Str(name); D.Ln END;
+								w.RawNum(sfTypePointer);
+								Type(type(SyntaxTree.PointerType).pointerBase);
+								w.RawString(name);
+								WITH type: SyntaxTree.PointerType DO
+									IF type.isUnsafe THEN INCL(flags,sfUnsafe) END;
+									IF type.isRealtime THEN INCL(flags,sfRealtime) END;
+									IF type.isDisposable THEN INCL(flags,sfDisposable) END;
+								END;
+								w.RawNum(SYSTEM.VAL(LONGINT,flags));
+							ELSIF type IS SyntaxTree.ArrayType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / ArrayType "); D.Str(name); D.Ln END;
+								WITH type: SyntaxTree.ArrayType DO
+									IF type.form = SyntaxTree.Open THEN
+										w.RawNum(sfTypeOpenArray)
+									ELSIF type.form = SyntaxTree.Static THEN
+										w.RawNum(sfTypeStaticArray)
+									ELSE HALT(100)
+									END;
+									Type(type.arrayBase);
+									w.RawString(name);
+									IF type.isRealtime THEN INCL(flags,sfRealtime) END;
+									w.RawNum(SYSTEM.VAL(LONGINT,flags));
+									IF type.form = SyntaxTree.Static THEN
+										w.RawNum(type.staticLength);
+									END;
+								END;
+							ELSIF type IS SyntaxTree.MathArrayType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / MathArrayType "); D.Str(name); D.Ln END;
+								WITH type: SyntaxTree.MathArrayType DO
+									IF type.form = SyntaxTree.Open THEN
+										w.RawNum(sfTypeOpenMathArray)
+									ELSIF type.form = SyntaxTree.Static THEN
+										w.RawNum(sfTypeStaticMathArray)
+									ELSIF type.form = SyntaxTree.Tensor THEN
+										w.RawNum(sfTypeTensor)
+									ELSE HALT(100)
+									END;
+									Type(type.arrayBase);
+									w.RawString(name);
+									IF type.isRealtime THEN INCL(flags,sfRealtime) END;
+									w.RawNum(SYSTEM.VAL(LONGINT,flags));
+									IF type.form = SyntaxTree.Static THEN
+										w.RawNum(type.staticLength);
+									END;
+								END;
+							ELSIF type IS SyntaxTree.ProcedureType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / ProcedureType"); D.Str(name); D.Ln END;
+								WITH type: SyntaxTree.ProcedureType DO
+									IF type.isDelegate THEN
+										w.RawNum(sfSysFlag); w.RawNum(sfDelegate);
+									END;
+									w.RawNum(sfTypeProcedure);
+									Type(type.returnType);
+									w.RawString(name);
+
+									IF type.callingConvention =  SyntaxTree.WinAPICallingConvention THEN
+										INCL(flags,sfWinAPIParam);
+									ELSIF  type.callingConvention =  SyntaxTree.CCallingConvention  THEN
+										INCL(flags,sfCParam);
+									ELSIF  type.callingConvention =  SyntaxTree.DarwinCCallingConvention  THEN
+										INCL(flags,sfDarwinCParam);
+									END;
+									IF type.isRealtime THEN
+										INCL(flags,sfRealtime)
+									END;
+									w.RawNum(SYSTEM.VAL(LONGINT,flags));
+
+									ParameterList(type);
+								END;
+							ELSIF type IS SyntaxTree.EnumerationType THEN
+								IF TraceExport IN Trace THEN D.Str("Type / UserType / EnumerationType"); D.Str(name); D.Ln END;
+								WITH type: SyntaxTree.EnumerationType DO
+									w.RawNum(sfTypeEnumeration);
+									Type(type.enumerationBase);
+									w.RawString(name);
+									EnumerationList(type.enumerationScope);
+								END;
+							ELSE HALT(200)
+							END;
+						END;
 					END;
+					*)
+					Info(source, "size");
+					Integer(source, size);
 					Info(source, "type desc");
-					IF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).typeDeclaration # NIL) THEN
+					td := NIL;
+					IF type IS SyntaxTree.PointerType THEN
+						td := type(SyntaxTree.PointerType).typeDeclaration;
+						type := type(SyntaxTree.PointerType).pointerBase.resolved;
+					END;
+					IF (td = NIL) & (type IS SyntaxTree.RecordType) THEN 
 						td := type(SyntaxTree.RecordType).typeDeclaration;
+					END;
+					IF (td # NIL) & (type IS SyntaxTree.RecordType) 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(type(SyntaxTree.RecordType).recordScope.numberMethods)*module.system.addressSize);
+						IF type IS SyntaxTree.RecordType THEN
+							offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(type(SyntaxTree.RecordType).recordScope.numberMethods)*module.system.addressSize);
+						END;
 						Symbol(source, tir,  0, offset);
 					ELSE
 						Address(source, 0);
 					END;
 				ELSE
-					Size(source, 0);
+					Char(source, 0X); (* NIL type *)
+					Char(source, 0X);
+					Integer(source, 0);
 					Address(source, 0);
 				END;
 			END TypeEntry;
 			
-			
 			PROCEDURE VariableArray(source: IntermediateCode.Section; variable: SyntaxTree.Variable);
 			VAR pc, offset: LONGINT; tir: Sections.Section; size: LONGINT;
 				name: Basic.SegmentedName;
@@ -12624,6 +12813,7 @@ TYPE
 						ReflectParameters(source, procedure);
 						(* variables *)
 						ReflectVariables(source, procedure);
+						(* proedures *)
 						ReflectProcedures(source, procedure);
 
 						(* return type entry *)

+ 305 - 63
source/FoxInterpreter.Mod

@@ -1,14 +1,16 @@
 MODULE FoxInterpreter; (** AUTHOR ""; PURPOSE ""; *)
 
 IMPORT Scanner := FoxScanner, FoxParser, SyntaxTree := FoxSyntaxTree, Printout := FoxPrintout, Commands, Diagnostics, StringPool, InterpreterSymbols := FoxInterpreterSymbols, D:= Debugging,
-	Strings, Streams, Modules, PersistentObjects, Basic := FoxBasic;
-	
+	Strings, Streams, Modules, PersistentObjects, Basic := FoxBasic, SYSTEM, Machine;
+
 CONST
 	EnableTrace = FALSE;
+	MaxIndex = 8;
 
-TYPE
 
-	Value*=InterpreterSymbols.Item;
+TYPE
+	Result*= InterpreterSymbols.Result;
+	Value*=InterpreterSymbols.Value;
 	Integer*=InterpreterSymbols.IntegerValue;
 	Real*=InterpreterSymbols.RealValue;
 	String*=InterpreterSymbols.StringValue;
@@ -16,9 +18,17 @@ TYPE
 	Set*=InterpreterSymbols.SetValue;
 	Range*=InterpreterSymbols.RangeValue;
 	Char*=InterpreterSymbols.CharValue;
+	MathArrayValue*= InterpreterSymbols.MathArrayValue;
+	
 	Scope*=InterpreterSymbols.Scope;
 	Container*= InterpreterSymbols.Container;
-	Address*=InterpreterSymbols.Address;
+	
+	Item*= RECORD
+		object*: InterpreterSymbols.Item;
+		in*: InterpreterSymbols.Item;
+		name*: StringPool.Index;
+		i*: ARRAY MaxIndex OF LONGINT; (* indices if applicable *)
+	END;
 
 	CommandStatement = OBJECT (SyntaxTree.Statement)
 	VAR command: Strings.String;
@@ -65,25 +75,177 @@ TYPE
 
 	END Parser;
 
+
+	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;
+		BEGIN
+			pos := 1024; size := 0;
+		END Init;
+		
+		PROCEDURE Next(s: SIZE): ADDRESS;
+		BEGIN
+			DEC(pos, s); INC(size, s);
+			RETURN ADDRESSOF(data[pos]);
+		END Next;
+		
+		PROCEDURE PushH(h: HUGEINT);
+		VAR p: POINTER {UNSAFE} TO RECORD h: HUGEINT END;
+		BEGIN
+			p := Next(SIZEOF(HUGEINT));
+			p.h := h;
+		END PushH;
+
+		PROCEDURE PushL(i: LONGINT);
+		VAR p: POINTER {UNSAFE} TO RECORD i: LONGINT END;
+		BEGIN
+			p := Next(SIZEOF(LONGINT));
+			p.i := i;
+		END PushL;
+
+		PROCEDURE PushI(i: INTEGER);
+		BEGIN
+			PushL(i);
+		END PushI;		
+
+		PROCEDURE PushS(i: SHORTINT);
+		BEGIN
+			PushL(i);
+		END PushS;		
+		
+		PROCEDURE PushC(c: CHAR);
+		BEGIN
+			PushL(ORD(c));
+		END PushC;
+		
+		PROCEDURE PushR(r: REAL);
+		VAR p: POINTER {UNSAFE} TO RECORD r: REAL END;
+		BEGIN
+			p := Next(SIZEOF(REAL));
+			p.r := r;
+		END PushR;
+		
+		PROCEDURE PushX(x: LONGREAL);
+		VAR p: POINTER {UNSAFE} TO RECORD x: LONGREAL END;
+		BEGIN
+			p := Next(SIZEOF(LONGREAL));
+			p.x := x;
+		END PushX;
+		
+		PROCEDURE PushA(a: ADDRESS);
+		VAR p: POINTER {UNSAFE} TO RECORD a: ADDRESS END;
+		BEGIN
+			p := Next(SIZEOF(ADDRESS));
+			p.a := a;
+		END PushA;
+
+
+		PROCEDURE PushSz(s: SIZE);
+		VAR p: POINTER {UNSAFE} TO RECORD s: SIZE END;
+		BEGIN
+			p := Next(SIZEOF(SIZE));
+			p.s := s;
+		END PushSz;
+		
+		PROCEDURE Call(adr: ADDRESS);
+		VAR esp: ADDRESS; P: Procedure; h: HUGEINT
+		TYPE 
+			Procedure = PROCEDURE(): HUGEINT;
+		BEGIN
+			P := SYSTEM.VAL(Procedure, adr); 
+			esp := Machine.CurrentSP();
+			Machine.SetSP(esp-size);
+			SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
+			H := P();
+			Machine.SetSP(esp);
+		END Call;
+		
+		PROCEDURE ResH(): HUGEINT;
+		BEGIN
+			RETURN H;
+		END ResH;
+
+		PROCEDURE ResL(): LONGINT;
+		BEGIN
+			RETURN LONGINT(H);
+		END ResL;
+
+		PROCEDURE ResI(): INTEGER;
+		BEGIN
+			RETURN INTEGER(H);
+		END ResI;
+
+		PROCEDURE ResS(): SHORTINT;
+		BEGIN
+			RETURN SHORTINT(H);
+		END ResS;
+
+		PROCEDURE ResC(): CHAR;
+		BEGIN
+			RETURN CHR(H);
+		END ResC;
+
+		PROCEDURE ResSet(): SET;
+		BEGIN
+			RETURN SYSTEM.VAL(SET,H);
+		END ResSet;
+
+		PROCEDURE ResSz(): SIZE;
+		BEGIN
+			RETURN SYSTEM.VAL(SIZE, H);
+		END ResSz;
+
+		PROCEDURE ResA(): ADDRESS;
+		BEGIN
+			RETURN SYSTEM.VAL(ADDRESS, H)
+		END ResA;
+
+		PROCEDURE ResR(): REAL;
+		BEGIN
+			RETURN SYSTEM.VAL(REAL, ResL())
+		END ResR;
+
+		PROCEDURE ResX(): LONGREAL;
+		BEGIN
+			RETURN SYSTEM.VAL(LONGREAL, ResH())
+		END ResX;
+		
+		
+	END Callstack;
+
 	Interpreter* = OBJECT (SyntaxTree.Visitor)
 	VAR
 		value: BOOLEAN;
-		address-: Address;
+		item-: Item;
 		module-: Modules.Module;
+		typeDesc-: Modules.TypeDesc;
+		procedureDesc-: Modules.ProcedureEntry;
 
 		scope-: Scope;
 		exit: BOOLEAN;
 		error-: BOOLEAN;
 		diagnostics: Diagnostics.Diagnostics;
 		context-: Commands.Context;
-
+		callStack: Callstack;
+		
+		
 		PROCEDURE & Init*(scope: Scope; diagnostics: Diagnostics.Diagnostics; context: Commands.Context);
 		BEGIN
 			IF scope = NIL THEN scope := global END;
 			SELF.scope := scope;
 			error := FALSE;
 			SELF.diagnostics := diagnostics;
-			SELF.context := context
+			SELF.context := context;
+			NEW(callStack);
 		END Init;
 
 		PROCEDURE SetScope*(s: Scope);
@@ -96,7 +258,6 @@ TYPE
 			error := FALSE;
 		END Reset;
 
-
 		PROCEDURE Error(CONST msg: ARRAY OF CHAR);
 		BEGIN
 			IF error THEN RETURN END;
@@ -139,57 +300,57 @@ TYPE
 		END VisitSet;
 
 		PROCEDURE VisitMathArrayExpression*(x: SyntaxTree.MathArrayExpression);
-		VAR numberElements, i: LONGINT; a: InterpreterSymbols.MathArrayValue;
+		VAR numberElements, i: LONGINT; a: MathArrayValue;
 		BEGIN
 			numberElements := x.elements.Length();
 			NEW(a, numberElements);
 			FOR i := 0 TO numberElements-1 DO
 				Expression(x.elements.GetExpression(i));
-				a.SetValue(i,address.object(InterpreterSymbols.Value));
+				a.SetValue(i,item.object(Value));
 			END;
-			address.object := a; value := TRUE;
+			item.object := a; value := TRUE;
 		END VisitMathArrayExpression;
 
 		PROCEDURE NewInt(i: LONGINT);
 		VAR v: Integer;
 		BEGIN
-			NEW(v, i); address.object := v; value := TRUE
+			NEW(v, i); item.object := v; value := TRUE
 		END NewInt;
 
 		PROCEDURE NewReal(i: LONGREAL);
 		VAR v: Real;
 		BEGIN
-			NEW(v, i); address.object := v; value := TRUE
+			NEW(v, i); item.object := v; value := TRUE
 		END NewReal;
 
 		PROCEDURE NewBool(b: BOOLEAN);
 		VAR v: Boolean;
 		BEGIN
-			NEW(v, b); address.object := v; value := TRUE;
+			NEW(v, b); item.object := v; value := TRUE;
 		END NewBool;
 
 		PROCEDURE NewSet(s: SET);
 		VAR v: Set;
 		BEGIN
-			NEW(v, s); address.object := v; value := TRUE;
+			NEW(v, s); item.object := v; value := TRUE;
 		END NewSet;
 
 		PROCEDURE NewString(CONST s: ARRAY OF CHAR);
 		VAR v: String;
 		BEGIN
-			NEW(v, s); address.object := v; value := TRUE;
+			NEW(v, s); item.object := v; value := TRUE;
 		END NewString;
 
 		PROCEDURE NewRange(r: RANGE);
 		VAR v: Range;
 		BEGIN
-			NEW(v, r ); address.object := v; value := TRUE;
+			NEW(v, r ); item.object := v; value := TRUE;
 		END NewRange;
 
 		PROCEDURE NewChar(c: CHAR);
 		VAR v: Char;
 		BEGIN
-			NEW(v, c); address.object := v; value := TRUE;
+			NEW(v, c); item.object := v; value := TRUE;
 		END NewChar;
 
 		PROCEDURE VisitUnaryExpression*(x: SyntaxTree.UnaryExpression);
@@ -357,44 +518,97 @@ TYPE
 		END FindInScope;
 		*)
 
+
+		PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
+		VAR i: LONGINT;
+		BEGIN
+		IF types = NIL THEN RETURN NIL END;
+		FOR i := 0 TO LEN(types)-1 DO
+			IF types[i].name = name THEN 
+				RETURN types[i];
+			END;
+		END;
+		RETURN NIL;
+		END FindType;
+
+		PROCEDURE FindProc(CONST types: POINTER TO ARRAY OF Modules.ProcedureEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
+		BEGIN
+		IF types = NIL THEN RETURN FALSE END;
+		FOR num := 0 TO LEN(types)-1 DO
+			IF types[num].name^ = name THEN 
+				RETURN TRUE;
+			END;
+		END;
+			RETURN FALSE;
+		END FindProc;
+
+		PROCEDURE FindField(CONST types: POINTER TO ARRAY OF Modules.FieldEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
+		BEGIN
+		IF types = NIL THEN RETURN FALSE END;
+		FOR num := 0 TO LEN(types)-1 DO
+			IF types[num].name^ = name THEN 
+				RETURN TRUE;
+			END;
+		END;
+			RETURN FALSE;
+		END FindField;
+
+
+
 		PROCEDURE VisitIdentifierDesignator*(x: SyntaxTree.IdentifierDesignator);
 		VAR moduleName: Modules.Name; msg: ARRAY 128 OF CHAR; res: LONGINT;
 		BEGIN
 			ASSERT(x.left = NIL);
-			address.name := x.identifier;
+			item.name := x.identifier;
 			(*
-			address.object := FindInScope(address.scope, address.name);
+			item.object := FindInScope(item.scope, item.name);
 			*)
-			address.object := scope.FindObject1(address.name, -1, address.in);
-			IF address.object = NIL THEN
-				StringPool.GetString(address.name, moduleName);
-				module := Modules.ThisModule(moduleName, res, msg)
-			ELSE
-				module := NIL
+			item.object := scope.FindObject1(item.name, -1, item.in);
+			IF item.object = NIL THEN
+				StringPool.GetString(item.name, moduleName);
+				item.object :=InterpreterSymbols.GetModule(moduleName); 
 			END;
 		END VisitIdentifierDesignator;
 
 		PROCEDURE VisitSelectorDesignator*(x: SyntaxTree.SelectorDesignator);
-		VAR traverse: BOOLEAN; name: ARRAY 128 OF CHAR;
+		VAR traverse: BOOLEAN; name: ARRAY 128 OF CHAR; num: LONGINT;
 		BEGIN
 			Expression(x.left); traverse := FALSE;
 			IF error THEN RETURN END;
-			address.name := x.identifier;
-			IF (address.object # NIL) THEN
-				address.in := address.object;
-				address.object := InterpreterSymbols.FindInObject1(address.object, x.identifier,-1);
-			ELSIF module # NIL THEN
-				StringPool.GetString(address.name, name);
+			item.name := x.identifier;
+			IF (item.object # NIL) THEN
+				IF item.object IS Result THEN
+					StringPool.GetString(item.name, name);
+					item.object := item.object(Result).Find(name);
+				ELSE
+					item.in := item.object;
+					item.object := InterpreterSymbols.FindInObject1(item.object, x.identifier,-1);
+				END;
 			ELSE
-				ErrorSS("invalid selector",address.name);
-				address.in := NIL;
+				ErrorSS("invalid selector",item.name);
+				item.in := NIL;
 			END;
 		END VisitSelectorDesignator;
 
+		PROCEDURE PushParameters(e: SyntaxTree.ExpressionList);
+		VAR i: LONGINT; value: Value;
+		BEGIN
+			FOR i := 0 TO e.Length()-1 DO
+				IF GetValue(e.GetExpression(i), value) THEN
+					callStack.PushL(value(Integer).value);
+				END;
+			END;
+		END PushParameters;
+		
+	
 		PROCEDURE VisitParameterDesignator*(x: SyntaxTree.ParameterDesignator);
 		VAR e: SyntaxTree.Expression;
-		BEGIN HALT(100);
+		BEGIN
 			e := x.left;
+			PushParameters(x.parameters);
+			Expression(e);
+			callStack.Call(procedureDesc.address);
+			TRACE(procedureDesc.name^, procedureDesc.address);
 			(*IF e IS IdentifierDesignator THEN
 			END;
 			*)
@@ -404,22 +618,22 @@ TYPE
 		BEGIN HALT(100) (* abstract *) END VisitArrowDesignator;
 
 		PROCEDURE VisitBracketDesignator*(x: SyntaxTree.BracketDesignator);
-		VAR array: InterpreterSymbols.MathArrayValue; i: LONGINT; element: InterpreterSymbols.Value; index: Integer; obj: PersistentObjects.Object;
+		VAR array: MathArrayValue; i: LONGINT; element: Value; index: Integer; obj: PersistentObjects.Object;
 			leftValue, rightValue: Value; filter: InterpreterSymbols.ObjectFilter; expression: SyntaxTree.Expression;
 			attribute, value: ARRAY 128 OF CHAR;
 		BEGIN
 			Expression(x.left);
-			IF (address.object # NIL) & (address.object IS InterpreterSymbols.MathArrayValue) THEN
-				element := address.object(InterpreterSymbols.MathArrayValue);
+			IF (item.object # NIL) & (item.object IS MathArrayValue) THEN
+				element := item.object(MathArrayValue);
 				FOR i := 0 TO x.parameters.Length()-1 DO
-					array := element(InterpreterSymbols.MathArrayValue);
+					array := element(MathArrayValue);
 					IF GetInteger(x.parameters.GetExpression(i), index) THEN
 						element := array.GetValue(index.value);
 					END;
 				END;
-				address.object := element;
-			ELSIF (address.object # NIL) THEN
-				NEW(filter); obj := address.object;
+				item.object := element;
+			ELSIF (item.object # NIL) THEN
+				NEW(filter); obj := item.object;
 				FOR i := 0 TO x.parameters.Length()-1 DO
 					expression := x.parameters.GetExpression(i);
 					IF (expression IS SyntaxTree.BinaryExpression) & (expression(SyntaxTree.BinaryExpression).operator = Scanner.Equal) THEN
@@ -427,28 +641,28 @@ TYPE
 						GetValue(expression(SyntaxTree.BinaryExpression).right, rightValue) THEN
 							StringPool.GetString(
 							expression(SyntaxTree.BinaryExpression).left(SyntaxTree.IdentifierDesignator).identifier, attribute);
-							rightValue(InterpreterSymbols.Value).GetString(value);
+							rightValue(Value).GetString(value);
 							obj := filter.Filter(obj, attribute, value)
 						ELSE HALT(200)
 						END;
 					ELSE
 						IF GetValue(expression, leftValue) THEN
 							IF leftValue IS String THEN
-								leftValue(InterpreterSymbols.Value).GetString(value);
+								leftValue(Value).GetString(value);
 								obj := filter.Filter(obj, "name", value);
 							ELSIF leftValue IS Integer THEN
 								IF obj IS PersistentObjects.ObjectList THEN
-									address.object := obj(PersistentObjects.ObjectList).GetElement(leftValue(Integer).value)
-								ELSIF obj IS InterpreterSymbols.Container THEN
-									address.object := obj(InterpreterSymbols.Container).GetItem(leftValue(Integer).value)
+									item.object := obj(PersistentObjects.ObjectList).GetElement(leftValue(Integer).value)
+								ELSIF obj IS Container THEN
+									item.object := obj(Container).GetItem(leftValue(Integer).value)
 								ELSE Error("cannot be indexed")
 								END;
 							END;
 						END;
 					END;
 				END;
-				IF obj(InterpreterSymbols.Container).symbols.Length() > 0 THEN
-					address.object := obj(InterpreterSymbols.Container).GetItem(0);
+				IF obj(Container).symbols.Length() > 0 THEN
+					item.object := obj(Container).GetItem(0);
 				ELSE
 					Error("no such symbol")
 				END;
@@ -585,7 +799,7 @@ TYPE
 					done := GetValue(expression, value);
 				UNTIL done OR ~parser.Optional(Scanner.Colon);
 
-				IF done THEN value(InterpreterSymbols.Value).WriteValue(destinationWriter);
+				IF done THEN value(Value).WriteValue(destinationWriter);
 				ELSE
 					destinationWriter.String("#COULD NOT INTERPRETE#");
 					error := TRUE;
@@ -710,8 +924,10 @@ TYPE
 
 		PROCEDURE LoadValue;
 		BEGIN
-			IF address.object = NIL THEN
-				ErrorSS("could not load value", address.name);
+			IF (item.object # NIL) & (item.object IS Result) THEN
+				item.object := item.object(Result).Evaluate();
+			ELSE
+				ErrorSS("could not load value", item.name);
 			END;
 		END LoadValue;
 
@@ -720,7 +936,9 @@ TYPE
 			IF error THEN RETURN FALSE END;
 			Expression(x);
 			LoadValue();
-			w := address.object;
+			IF item.object # NIL THEN
+				w := item.object(Value);
+			END;
 			RETURN ~error
 		END GetValue;
 
@@ -747,8 +965,9 @@ TYPE
 		PROCEDURE PutValue(x: SyntaxTree.Designator; v: Value);
 		BEGIN
 			x.Accept(SELF);
-			IF (address.in # NIL) & (address.name # 0) & (address.in IS InterpreterSymbols.Container) THEN
-				address.in(InterpreterSymbols.Container).Enter1(v, address.name);
+			IF (item.object # NIL) & item.object(Result).SetV(v) THEN
+			ELSIF (item.in # NIL) & (item.name # 0) & (item.in IS Container) THEN
+				item.in(Container).Enter1(v, item.name);
 			END;
 		END PutValue;
 
@@ -881,12 +1100,13 @@ TYPE
 		PROCEDURE Expression(x: SyntaxTree.Expression);
 		BEGIN
 			value := FALSE;
-			x.Accept(SELF);
+			x.Accept(SELF);			
 		END Expression;
-
+		
+		
 		PROCEDURE Statement(x: SyntaxTree.Statement);
 		BEGIN
-			address.object := NIL;
+			item.object := NIL;
 			x.Accept(SELF);
 		END Statement;
 
@@ -964,7 +1184,7 @@ TYPE
 			END;
 		END DoResolve;
 
-		PROCEDURE Resolve*(scope: InterpreterSymbols.Scope);
+		PROCEDURE Resolve*(scope: Scope);
 		BEGIN
 			REPEAT
 				changed := FALSE;
@@ -998,7 +1218,7 @@ BEGIN
 	expression := parser.Expression();
 	NEW(interpreter, global, diagnostics,NIL);
 	IF interpreter.GetValue(expression, value) THEN
-		value(InterpreterSymbols.Value).WriteValue(context.out); context.out.Ln
+		value(Value).WriteValue(context.out); context.out.Ln
 	ELSE
 		context.error.String("could not evaluate expression"); context.error.Ln
 	END;
@@ -1035,6 +1255,25 @@ END FoxInterpreter.
 
 SystemTools.Free FoxInterpreter FoxInterpreterSymbols ~
 
+
+FoxInterpreter.Expression
+	Test.c.b;
+	~ 
+FoxInterpreter.Statements
+	a := Test.c.b;
+	Test.c.b := Test.c.b + 1;
+	~	
+FoxInterpreter.Expression
+	a;
+	~	
+FoxInterpreter.Expression
+	Test.c.b;
+	~	
+
+FoxInterpreter.Statements
+	Test.Test(123)
+	~
+
 FoxInterpreter.Statements
 	FOR i := 1 TO 100 DO
 		CASE i MOD 10 OF
@@ -1052,7 +1291,10 @@ FoxInterpreter.Statements
 FoxInterpreter.Expression
 	i MOD 10  ~
 
-
+FoxInterpreter.Statements
+	o := Test.TestO();
+	~
+	
 
 FoxInterpreter.Statements
 	s := {0..10, 15};

+ 374 - 46
source/FoxInterpreterSymbols.Mod

@@ -1,27 +1,224 @@
 MODULE FoxInterpreterSymbols; (** AUTHOR ""; PURPOSE ""; *)
 
-IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects;
+IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, SYSTEM;
 
 CONST
-	MaxIndex = 8;
 	TAB = 09X;
+
+CONST
+
+	sfTypeNoType = 0X;
+	sfTypeBoolean= 01X;
+	sfTypeChar = 02X;
+	sfTypeSignedInteger = 03X;
+	sfTypeUnsignedInteger = 04X;
+	sfTypeFloat = 05X;
+	sfTypeComplex = 06X;
+	sfTypeSet = 07X;
+	sfTypeByte =  08X;
+	sfTypeAny =  09X;
+	sfTypeObject =  0AX;
+	sfTypeAddress= 0BX;
+	sfTypeSize = 0CX;
+	sfTypeRange  = 0DX;
+	sfTypePointerToRecord = 0EX;
+	sfTypePointerToArray = 0FX;
+	sfTypeOpenArray = 10X;
+	sfTypeStaticArray = 11X;
+	sfTypeRecord = 12X;
+
 TYPE
 
 	Item*= PersistentObjects.Object;
+	Object* = PersistentObjects.Object;
+	Content* = PersistentObjects.Content;
+
+	TYPE
 
-	Address*= RECORD
-		object*: Item;
-		in*: Item;
-		name*: StringPool.Index;
-		i*: ARRAY MaxIndex OF LONGINT; (* indices if applicable *)
-	END;
+	Result*= OBJECT (Item)
+
+		PROCEDURE Evaluate*(): Value;
+		BEGIN
+			RETURN NIL;
+		END Evaluate;
+
+		PROCEDURE SetV*(v: Value): BOOLEAN;
+		BEGIN
+			RETURN FALSE;
+		END SetV;
+		
+		PROCEDURE Find*(CONST name: ARRAY OF CHAR): Result;
+		BEGIN
+			RETURN NIL;
+		END Find;
+
+		PROCEDURE Address*(): ADDRESS;
+		BEGIN
+			RETURN NIL;
+		END Address;
+		
+		PROCEDURE Trace*;
+		BEGIN
+			
+		END Trace;
+		
+	END Result;
+	
+		
+	SymbolResult*=OBJECT(Result)
+	VAR name: ARRAY 32 OF CHAR;
+	
+		PROCEDURE InitSymbol(CONST n: ARRAY OF CHAR);
+		BEGIN
+			COPY(n, name);
+		END InitSymbol;
+		
+	END SymbolResult;
+	
+	ModuleResult*= OBJECT(SymbolResult)
+	VAR 
+		self: Modules.TypeDesc;
+		
+		PROCEDURE & InitModule(CONST name: ARRAY OF CHAR; m: Modules.Module);
+		BEGIN
+			InitSymbol(name);
+			ASSERT(m # NIL);
+			self := FindType(m.typeInfo, "@Self");
+		END InitModule;
+		
+		PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
+		VAR num: LONGINT;
+				proc: ProcedureResult;
+				field: FieldResult;
+		BEGIN
+				IF FindProc(self.procedures, name,num) THEN
+					NEW(proc, name, self.procedures[num]);
+					proc.address := self.procedures[num].address;
+					RETURN proc
+				ELSIF FindField(self.fields, name, num) THEN
+					NEW(field, name, self.fields[num]);
+					field.address := self.fields[num].offset;
+					RETURN field;
+				END;
+		END Find;
+
+
+	END ModuleResult;
+	
+	ProcedureResult*= OBJECT(SymbolResult)
+	VAR 
+		proc: Modules.ProcedureEntry;
+		address: ADDRESS;
+	
+		PROCEDURE & InitProcedure(CONST name: ARRAY OF CHAR; CONST p: Modules.ProcedureEntry);
+		BEGIN
+			InitSymbol(name); proc := p;
+		END InitProcedure;
+
+	END ProcedureResult;
+
+	FieldResult = OBJECT (SymbolResult)
+	VAR field: Modules.FieldEntry;
+		address: ADDRESS;
+	
+		PROCEDURE & InitField(CONST name: ARRAY OF CHAR; CONST f: Modules.FieldEntry);
+		BEGIN
+			InitSymbol(name); field := f;
+		END InitField;
+		
+		PROCEDURE Evaluate(): Value;
+		VAR l: LONGINT;
+			int: IntegerValue;
+		BEGIN
+			CASE field.type.class OF
+				sfTypeSignedInteger: 
+					SYSTEM.GET(address, l);
+					NEW(int, l); 
+					RETURN int
+			ELSE
+				HALT(100);
+			END;
+		END Evaluate;
+		
+		PROCEDURE SetV(v: Value): BOOLEAN;
+		VAR h: HUGEINT; s: SHORTINT; i: INTEGER; l: LONGINT; 
+		BEGIN
+			CASE field.type.class OF
+				sfTypeSignedInteger:
+				IF v.GetInt(h) THEN
+					CASE field.type.size OF
+					8: s:= SHORTINT(h); SYSTEM.PUT(address, s);
+					|16: i:= INTEGER(h); SYSTEM.PUT(address, i);
+					|32:l := LONGINT(h); SYSTEM.PUT(address, l);
+					|64: SYSTEM.PUT(address, h); 
+					END;
+				RETURN TRUE
+				END;
+			END;
+		END SetV;
+
+		PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
+		VAR type, value: 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 *)
+				SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
+				IF FindProc(typeInfo.procedures, name,num) THEN
+					NEW(proc, 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;
+				SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
+				IF FindProc(typeInfo.procedures, name,num) THEN
+					NEW(proc, 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); 
+			END;
+		END Find;
+		
+	END FieldResult;
 
-	Value* = OBJECT (Item)
+	Value*= OBJECT(Result)
 
 		PROCEDURE & InitValue;
 		BEGIN InitObject
 		END InitValue;
 
+		PROCEDURE Evaluate(): Value;
+		BEGIN
+			RETURN SELF;
+		END Evaluate;
+		
+		PROCEDURE GetInt(VAR h: HUGEINT): BOOLEAN;
+		BEGIN
+			RETURN FALSE;
+		END GetInt;
+		
+		PROCEDURE GetReal(VAR x: LONGREAL): BOOLEAN;
+		BEGIN
+			RETURN FALSE;
+		END GetReal;
+
 		PROCEDURE WriteValue*(w: Streams.Writer);
 		BEGIN
 		END WriteValue;
@@ -34,12 +231,50 @@ TYPE
 			stringWriter.Get(w);
 		END GetString;
 
-
 	END Value;
 
+
 	CONST StrValue="value";
 	TYPE
 
+	AnyValue*=OBJECT(Value)
+	VAR value*:ADDRESS;
+
+		PROCEDURE & InitAny*(value: ADDRESS);
+		BEGIN InitValue; SELF.value := value; type := "AnyValue";
+		END InitAny;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		VAR int: LONGINT;
+		BEGIN
+			IF name = StrValue THEN c.GetInteger(int); value := int;
+			ELSE Set^(name, index, c);
+			END;
+		END Set;
+
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		BEGIN
+			IF name = StrValue THEN c.SetInteger(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN w.Int(value,0);
+		END WriteValue;
+		
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+		
+
+	END AnyValue;
+
 	IntegerValue*=OBJECT(Value)
 	VAR value*: LONGINT;
 
@@ -51,24 +286,35 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetInteger(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetInteger(value);
 			ELSE Get^(name, index, c);
 			END;
 		END Get;
+		
+		PROCEDURE GetInt(VAR v: HUGEINT): BOOLEAN;
+		BEGIN
+			v := value; RETURN TRUE;
+		END GetInt;
+		
 
 		PROCEDURE WriteValue(w: Streams.Writer);
 		BEGIN w.Int(value,0);
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+
 	END IntegerValue;
 
 	RealValue*=OBJECT(Value)
@@ -82,14 +328,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetFloat(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetFloat(value);
 			ELSE Get^(name, index, c);
@@ -100,6 +346,10 @@ TYPE
 		BEGIN w.Float(value,40);
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
 
 	END RealValue;
 
@@ -114,14 +364,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetBoolean(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetBoolean(value);
 			ELSE Get^(name, index, c);
@@ -132,6 +382,11 @@ TYPE
 		BEGIN IF value THEN w.String("TRUE") ELSE w.String("FALSE") END
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+
 	END BooleanValue;
 
 	StringValue*=OBJECT(Value)
@@ -145,14 +400,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetString(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetString(value);
 			ELSE Get^(name, index, c);
@@ -163,6 +418,11 @@ TYPE
 		BEGIN (*w.String('"');*) w.String(value^); (*w.String('"');*)
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN value;
+		END Address;
+
 	END StringValue;
 
 
@@ -177,14 +437,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetSet(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetSet(value);
 			ELSE Get^(name, index, c);
@@ -195,6 +455,11 @@ TYPE
 		BEGIN
 			w.Set(value)
 		END WriteValue;
+		
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
 
 	END SetValue;
 
@@ -209,14 +474,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetRange(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetRange(value);
 			ELSE Get^(name, index, c);
@@ -228,6 +493,11 @@ TYPE
 			w.Int(FIRST(value),0); w.String(" .. "); w.Int(LAST(value),0); IF STEP(value) # 1 THEN w.String(" BY "); w.Int(STEP(value),0) END;
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+
 	END RangeValue;
 
 	CharValue*=OBJECT(Value)
@@ -241,14 +511,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetChar(value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetChar(value);
 			ELSE Get^(name, index, c);
@@ -260,6 +530,11 @@ TYPE
 			w.Hex(ORD(value),2); w.String("X");
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+
 	END CharValue;
 
 	EnumValue*=OBJECT(Value)
@@ -273,14 +548,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.GetEnum(translation, value);
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetEnum(translation, value);
 			ELSE Get^(name, index, c);
@@ -293,6 +568,11 @@ TYPE
 			IF translation.Name(value, str) THEN w.String(str) ELSE w.String("unknown") END;
 		END WriteValue;
 
+		PROCEDURE Address(): ADDRESS;
+		BEGIN
+			RETURN ADDRESSOF(value)
+		END Address;
+
 	END EnumValue;
 
 	MathArrayValue*=OBJECT(Value)
@@ -309,14 +589,14 @@ TYPE
 		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN values[index] := ContentGetValue(c)
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF name = StrValue THEN c.SetObject(values[index],"Value");
 			ELSE Get^(name, index, c);
@@ -392,14 +672,14 @@ TYPE
 			END;
 		END Enumerate;
 
-		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
 			IF FALSE THEN
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
-		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.Content);
+		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		VAR item: Item;
 		BEGIN
 			item := Find(name);
@@ -453,10 +733,10 @@ TYPE
 	Scope* = OBJECT
 	VAR
 		outer-: Scope;
-		object-: PersistentObjects.Object;
+		object-: Object;
 		level: LONGINT;
 
-		PROCEDURE & InitScope*(outer: Scope; object: PersistentObjects.Object);
+		PROCEDURE & InitScope*(outer: Scope; object: Object);
 		BEGIN
 			SELF.outer := outer;
 			IF outer = NIL THEN level := 0 ELSE level := outer.level + 1 END;
@@ -464,15 +744,15 @@ TYPE
 			SELF.object := object
 		END InitScope;
 
-		PROCEDURE Enter*(object: PersistentObjects.Object): Scope;
+		PROCEDURE Enter*(object: Object): Scope;
 		VAR scope: Scope;
 		BEGIN
 			NEW(scope, SELF, object);
 			RETURN scope
 		END Enter;
 
-		PROCEDURE FindObject*(CONST name: ARRAY OF CHAR; index: LONGINT; VAR in: PersistentObjects.Object): PersistentObjects.Object;
-		VAR object: PersistentObjects.Object;
+		PROCEDURE FindObject*(CONST name: ARRAY OF CHAR; index: LONGINT; VAR in: Object): Object;
+		VAR object: Object;
 		BEGIN
 			in := SELF.object;
 			object := FindInObject(in, name, index);
@@ -482,7 +762,7 @@ TYPE
 			RETURN object
 		END FindObject;
 
-		PROCEDURE FindObject1*(name: StringPool.Index; index: LONGINT; VAR in: PersistentObjects.Object): PersistentObjects.Object;
+		PROCEDURE FindObject1*(name: StringPool.Index; index: LONGINT; VAR in: Object): Object;
 		VAR str: ARRAY 256 OF CHAR;
 		BEGIN
 			StringPool.GetString(name, str);
@@ -524,8 +804,8 @@ TYPE
 		(*scope.Write(context.out);*)
 	END Test;
 
-	PROCEDURE ContentGetValue(c: PersistentObjects.Content): Value;
-	VAR o: PersistentObjects.Object;
+	PROCEDURE ContentGetValue(c: Content): Value;
+	VAR o: Object;
 	BEGIN
 		c.GetObject(o); IF o = NIL THEN RETURN NIL ELSE RETURN o(Value) END;
 	END ContentGetValue;
@@ -585,8 +865,8 @@ TYPE
 		NEW(obj, translation, value);
 	END NewEnumValue;
 
-	PROCEDURE FindInObject*(in: PersistentObjects.Object; CONST name: ARRAY OF CHAR; index: LONGINT): PersistentObjects.Object;
-	VAR content: PersistentObjects.Content;
+	PROCEDURE FindInObject*(in: Object; CONST name: ARRAY OF CHAR; index: LONGINT): Object;
+	VAR content: Content;
 	TYPE Class=PersistentObjects.Class;
 	BEGIN
 		NEW(content);
@@ -611,8 +891,8 @@ TYPE
 	TYPE
 	ObjectFilter* = OBJECT
 	VAR
-		content: PersistentObjects.Content;
-		object: PersistentObjects.Object;
+		content: Content;
+		object: Object;
 		found: Container;
 		attribute, value: ARRAY 256 OF CHAR;
 
@@ -621,7 +901,7 @@ TYPE
 			NEW(content); NEW(found);
 		END InitObjectFilter;
 
-		PROCEDURE AddFiltered(obj: PersistentObjects.Object);
+		PROCEDURE AddFiltered(obj: Object);
 		BEGIN
 			IF obj # NIL THEN
 				obj.Get(attribute, -1, content);
@@ -632,7 +912,7 @@ TYPE
 		END AddFiltered;
 
 		PROCEDURE Enumerate(CONST name: ARRAY OF CHAR; array: BOOLEAN);
-		VAR obj: PersistentObjects.Object; index: LONGINT;
+		VAR obj: Object; index: LONGINT;
 		BEGIN
 			object.Get(name,-1, content);
 			IF content.success & (content.class = PersistentObjects.Class.Object) THEN
@@ -650,7 +930,7 @@ TYPE
 			END;
 		END Enumerate;
 
-		PROCEDURE Filter*(obj: PersistentObjects.Object; attribute, value: ARRAY OF CHAR): Container;
+		PROCEDURE Filter*(obj: Object; attribute, value: ARRAY OF CHAR): Container;
 		BEGIN
 			NEW(found);
 			object := obj;
@@ -662,7 +942,55 @@ TYPE
 
 	END ObjectFilter;
 
-	PROCEDURE FindInObject1*(in: PersistentObjects.Object; name: StringPool.Index; index: LONGINT): PersistentObjects.Object;
+
+			
+	PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
+	VAR i: LONGINT;
+	BEGIN
+		IF types = NIL THEN RETURN NIL END;
+		FOR i := 0 TO LEN(types)-1 DO
+			IF types[i].name = name THEN 
+				RETURN types[i];
+			END;
+		END;
+		RETURN NIL;
+	END FindType;
+	
+	PROCEDURE FindField(CONST types: POINTER TO ARRAY OF Modules.FieldEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
+	BEGIN
+		IF types = NIL THEN RETURN FALSE END;
+		FOR num := 0 TO LEN(types)-1 DO
+			IF types[num].name^ = name THEN 
+				RETURN TRUE;
+			END;
+		END;
+		RETURN FALSE;
+	END FindField;
+
+	PROCEDURE FindProc(CONST types: POINTER TO ARRAY OF Modules.ProcedureEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
+	BEGIN
+		IF types = NIL THEN RETURN FALSE END;
+		FOR num := 0 TO LEN(types)-1 DO
+			IF types[num].name^ = name THEN 
+				RETURN TRUE;
+			END;
+		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;
+	BEGIN
+		m := Modules.ThisModule(name, res, msg);
+		IF m # NIL THEN 
+			NEW(mod, name, m);
+		ELSE
+			mod := NIL;
+		END;
+		RETURN mod;
+	END GetModule;
+
+	PROCEDURE FindInObject1*(in: Object; name: StringPool.Index; index: LONGINT): Object;
 	VAR str: ARRAY 256 OF CHAR;
 	BEGIN
 		StringPool.GetString(name, str);

+ 42 - 27
source/Generic.Modules.Mod

@@ -58,37 +58,51 @@ TYPE
 
 	
 	EntryType*=RECORD
-		(* classes:
-			0: no Type
-			1:  ObjectType
-			2:	NilType
-			3:	AnyType
-			4:	ByteType
-			5:	AddressType
-			6:	SizeType
-			7:	BooleanType
-			8:	SetType
-			9:	CharacterType
-			10:	RangeType
-			11:	SignedInteger
-			12:	UnsignedIntegerType
-			13:	FloatType
-			14:	ComplexType
-			15: StringType
-			16: EnumerationType
-			17: ArrayType
-			18: MathArrayType
-			19: PointerType
-			20: PortType
-			21: RecordType
-			22: CellType
-			23: ProcedureType		 
-		*)
-		class*: SHORTINT; 
+		class*: CHAR; 
+		subclass*: CHAR;
 		(* size in bits *)
 		size*: INTEGER;
 		type*: ADDRESS; (* type descriptor or additional information *)
 	END;
+	
+	VAR
+	(*
+		EntryType = POINTER TO EntryTypeDesc;
+		shortint: EntryType;
+		integer: EntryType;
+		longint: EntryType;
+		hugeint: EntryType;
+		size: EntryType;
+		address: EntryType;
+		real: EntryType;
+		longreal: EntryType;
+		set: EntryType;
+		...
+	*)
+
+	(*
+	Type = POINTER {UNSAFE} TO RECORD
+		class: CHAR
+	END;
+	
+	BaseType = POINTER {UNSAFE} TO RECORD(Type)
+		size: INTEGER;
+		type: ADDRESS;
+	END;
+	
+	StaticArrayType = POINTER {UNSAFE} TO RECORD(Type)
+		size: SIZE;
+		base: POINTER {UNSAFE} TO Base;
+	END;
+	
+	DynamicArrayType = POINTER {UNSAFE} TO RECORD(Type)
+		base: POINTER {UNSAFE} TO Type;
+	END;
+	
+	RecordType = POINTER {UNSAFE} TO RECORD(Type)
+		type: ADDRESS;
+	END;
+	*)
 
 	FieldEntry*= RECORD
 		name*: DynamicName;
@@ -96,6 +110,7 @@ TYPE
 		type*: EntryType;
 		flags*: SET;
 	END;
+	
 	FieldEntries*= POINTER TO ARRAY OF FieldEntry;
 	ProcedureEntries*=POINTER TO ARRAY OF ProcedureEntry;