Added procedure flags (such as Constructor)

Interpreter works again.

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

source/FoxIntermediateBackend.Mod

@@ -11734,6 +11734,9 @@ TYPE
 				sfIN = 0X;
 				sfOUT = 1X;
 				
+				flagDelegate = 0;
+				flagConstructor = 1;
+				
 				(* variable / parameter addressing modes *)
 				sfAbsolute = 0X; (* global vars *)
 				sfRelative = 1X; (* variables, value parameters *)
@@ -12050,7 +12053,7 @@ TYPE
 				*)
 				PROCEDURE NProcedure(procedure: SyntaxTree.Procedure; scopeOffset: LONGINT);
 				VAR s: Sections.Section; procedureType: SyntaxTree.ProcedureType; parameter: SyntaxTree.Parameter; pos: LONGINT;
-					name: Basic.SegmentedName;
+					name: Basic.SegmentedName; flags: SET;
 				BEGIN
 					IF RefInfo THEN Info(section, "Procedure") END;
 					pos := CurrentIndex(); 
@@ -12062,6 +12065,15 @@ TYPE
 					Symbol(section,s,0,0); (* start *)
 					Symbol(section,s,s(IntermediateCode.Section).pc,0); (* end *)
 					
+					flags := {};
+					IF procedureType.isDelegate THEN
+						INCL(flags, flagDelegate);
+					END;
+					IF procedure.isConstructor THEN
+						INCL(flags, flagConstructor);
+					END;
+					Set(section, flags);
+					
 					Global.GetSymbolSegmentedName(procedure,name);
 					Basic.SuffixSegmentedName (name, Basic.MakeString ("@Descriptor"));
 

source/FoxInterpreter.Mod

@@ -45,22 +45,29 @@ TYPE
 
 	END CommandStatement;
 
+	PrintStatement = OBJECT (SyntaxTree.Statement)
+	VAR expression: SyntaxTree.Expression;
+
+		PROCEDURE & InitPrintStatement(e: SyntaxTree.Expression);
+		BEGIN
+			expression := e;
+		END InitPrintStatement;
+
+	END PrintStatement;
+
 	Parser*= OBJECT(FoxParser.Parser)
 
 		PROCEDURE Statement(statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
 		VAR statement: SyntaxTree.Statement;
 		BEGIN
-			IF (symbol.token = Scanner.Identifier) & (symbol.identifier = StringPool.GetIndex1("CMD")) THEN
+			IF (Token() = Scanner.ExclamationMark) THEN
 				statement := Cmd();
 				statements.AddStatement(statement);
 				RETURN TRUE
-			(*
-			ELSIF (symbol.token = Scanner.Identifier) & (symbol.identifier = StringPool.GetIndex1("CMDS")) THEN
-				REPEAT
-					statement := Cmd();
-					statements.AddStatement(statement);
-				UNTIL (symbol.token = Scanner.Identifier) & (symbol.identifier = StringPool.GetIndex1("ENDCMDS"))
-			*)
+			ELSIF (Token() = Scanner.Questionmark) THEN
+				statement := Print();
+				statements.AddStatement(statement);
+				RETURN TRUE
 			ELSE
 				RETURN Statement^(statements, outer);
 			END;
@@ -77,6 +84,14 @@ TYPE
 			RETURN cmd;
 		END Cmd;
 
+		PROCEDURE Print(): SyntaxTree.Statement;
+		VAR print: PrintStatement;
+		BEGIN
+			NextSymbol;
+			NEW(print, Expression());
+			RETURN print;
+		END Print;
+
 
 	END Parser;
 
@@ -120,6 +135,7 @@ TYPE
 			IF diagnostics # NIL THEN
 				diagnostics.Error("",Diagnostics.Invalid, Diagnostics.Invalid, msg);
 			END;
+			D.TraceBack;
 		END Error;
 
 		PROCEDURE ErrorSS(CONST msg: ARRAY OF CHAR; id: StringPool.Index);
@@ -211,7 +227,10 @@ TYPE
 		VAR value: Value; i: HUGEINT; r: LONGREAL; b: BOOLEAN; operator: LONGINT;
 		BEGIN
 			operator := x.operator;
-			IF ~GetValue(x, value) THEN RETURN END;
+			IF ~GetValue(x.left, value) THEN 
+				Error("no operand");
+				RETURN 
+			END;
 			IF value IS Integer THEN
 				i := value(Integer).value;
 				CASE operator OF
@@ -915,11 +934,35 @@ TYPE
 			IF res # 0 THEN Error(msg) END;
 		END VisitCommandStatement;
 
+		PROCEDURE VisitPrintStatement(x: PrintStatement);
+		VAR out: Streams.Writer; printout: Printout.Printer; expression: SyntaxTree.Expression; value: Value;
+		BEGIN
+		
+			out := context.out;
+			printout := Printout.NewPrinter(out,Printout.SourceCode,FALSE);
+				expression := x.expression;
+				IF ~(expression IS SyntaxTree.StringValue) THEN
+					printout.Expression(expression);
+					out.String("= ");
+				END;
+				value := Evaluate(expression);
+				IF value # NIL THEN
+					value.WriteValue(out);
+				ELSE
+					out.String("UNKNOWN")
+				END;
+				out.String("; ");
+			out.Ln;
+			out.Update;
+		END VisitPrintStatement;
+
 		(** statements *)
 		PROCEDURE VisitStatement*(x: SyntaxTree.Statement);
 		BEGIN
 			IF x IS CommandStatement THEN
 				VisitCommandStatement(x(CommandStatement));
+			ELSIF x IS PrintStatement THEN
+				VisitPrintStatement(x(PrintStatement));
 			ELSE HALT(100)
 			END;
 		END VisitStatement;
@@ -1295,6 +1338,15 @@ VAR d: RECORD e: LONGINT END;
 		RETURN a+123;
 	END Setter;
 	
+	TYPE TestO= OBJECT
+	VAR i: LONGINT;
+	PROCEDURE &P(s: SHORTINT);
+	BEGIN
+		i := 999+s;
+	END P;
+	
+	END TestO;
+	
 
 BEGIN
 	InitGlobalScope;
@@ -1302,11 +1354,14 @@ BEGIN
 	d.e := 20;
 END FoxInterpreter.
 
-SystemTools.Free FoxInterpreter FoxInterpreterSymbols Reflection2 ~
+SystemTools.FreeDownTo FoxInterpreterSymbols ~ FoxInterpreter FoxInterpreterSymbols Reflection2 ~
 
 FoxInterpreter.Expression
 	FoxInterpreter.c ~
 
+FoxInterpreter.Expression
+	-8 ~
+
 FoxInterpreter.Expression
 	FoxInterpreter.d.e ~
 
@@ -1315,7 +1370,14 @@ FoxInterpreter.Expression
 
 FoxInterpreter.Expression
 	FoxInterpreter.Setter(1000) ~
-	
+
+FoxInterpreter.Statements
+	a := NEW FoxInterpreter.TestO(-8);
+	trace(a.i);
+	a.i := 10;
+	KernelLog.Int(a.i,1);
+	KernelLog.Ln;
+	~
 
 FoxInterpreter.Expression
 	Test.c.b;
@@ -1348,8 +1410,8 @@ FoxInterpreter.Statements
 		ELSE suffix := "th"
 		END;
 		IF i MOD 9 = 0 THEN
-			CMD SystemTools.Show This is the ?{i}?{suffix} run. ;
-			CMD SystemTools.Ln;
+			! "SystemTools.Show This is the ?{i}??{suffix}? run." ;
+			! "SystemTools.Ln";
 		END;
 	END;
 ~
@@ -1360,6 +1422,7 @@ FoxInterpreter.Statements
 	o := Test.TestO();
 	~
 	
+	
 
 FoxInterpreter.Statements
 	s := {0..10, 15};
@@ -1401,166 +1464,14 @@ FoxInterpreter.Statements
 	a := [[1,2,3],[4,5,6],[7,8,9]];
 	FOR i := 0 TO 2 DO
 	FOR j := 0 TO 2 DO
-		CMD \+"SystemTools.Show ?{a[i,j]}? ;"+\
+		! \+"SystemTools.Show ?{a[i,j]}? ;"+\
 	END;
-		CMD \+"SystemTools.Ln;"+\
+		! \+"SystemTools.Ln;"+\ 
 	END;
-	CMD \+"SystemTools.Show ?{a}? "+\
+	! "SystemTools.Show ?{a}? ";
+	? a;
+	? 1+1;
+	? 1+2;
 	~
 
 SystemTools.FreeDownTo FoxInterpreter FoxInterpreterSymbols ~
-
-FoxInterpreter.Statements
-	version := 02000302H;
-	a := [
-	(* development , version base, TL300, CN, SingleSensor, Version *)
-	[FALSE, "TLxDev", FALSE, FALSE, FALSE, version],
-	[FALSE, "TL400", FALSE, FALSE, FALSE, version],
-	[FALSE, "TL300", TRUE, FALSE, TRUE, version],
-	[FALSE, "TL300CN", TRUE, TRUE, FALSE, version],
-	[FALSE, "TL300USsu", TRUE, FALSE, TRUE, version],
-	[FALSE, "TL300USrt", TRUE, FALSE, FALSE, version]
-	];
-	FOR i := 0 TO 5 DO
-		major := a[i,5] DIV 1000000H MOD 100H;
-		minor := a[i,5] DIV 10000H MOD 100H;
-		release := a[i,5] DIV 100H MOD 100H;
-		internal := a[i,5] MOD 100H;
-		CMD \+"
-		SystemTools.Show Building ?{a[i,1]}? Version ?{major}?.?{minor}?.?{release}?.?{internal}? ~
-		SystemTools.Ln ~
-		FSTools.CreateFile -c -r TLHostConst.Mod
-			MODULE TLHostConst;
-			(**
-				purpose: GUI Configuration Controller. Sets basics for differentiation of different product lines.
-				author: Felix Friedrich
-			*)
-
-			CONST
-				Development*=?{a[i,0]}?;
-				VersionBase*="?{a[i,1]}? ";
-				TL300*=?{a[i,2]}?;
-				CN*=?{a[i,3]}?;
-				SingleSensor*=?{a[i,4]}?;
-				Version* = ?{a[i,5]}?;
-			END TLHostConst.
-		~
-		Compiler.Compile  --objectFile=Generic Runtime.Mod Trace.Mod  A2/Win32.MiniKernel.Mod A2/Win32.WatchdogServer.Mod ~
-
-		StaticLinker.Link
-			--fileFormat=PE32
-			--fileName=A2Watchdog.exe
-			--extension=Gof
-			--displacement=401000H
-
-			Runtime Trace MiniKernel WatchdogServer ~
-
-		SystemTools.Show Create ramdisk and format with FAT file system... ~ SystemTools.Ln ~
-		VirtualDisks.InstallRamdisk RAMDISK 240000 ~
-		Partitions.WriteMBR RAMDISK#0 OBEMBR.Bin ~
-		Partitions.Create RAMDISK#1 12 1000 ~
-		Partitions.Format RAMDISK#1 FatFS  ~
-		FSTools.Mount WINAOS FatFS RAMDISK#1 ~
-
-		SystemTools.Ln ~ SystemTools.Show Create WinAOS directory structure... ~
-		FSTools.CreateDirectory WINAOS:/TL ~
-		FSTools.CreateDirectory WINAOS:/TL/obj ~
-		FSTools.CreateDirectory WINAOS:/TL/source ~
-		FSTools.CreateDirectory WINAOS:/TL/data ~
-		FSTools.CreateDirectory WINAOS:/TL/skins ~
-		FSTools.CreateDirectory WINAOS:/TL/fonts ~
-		FSTools.CreateDirectory WINAOS:/TL/work ~
-		SystemTools.Show Done. ~ SystemTools.Ln ~
-
-		SystemTools.Ln ~ SystemTools.Show Create build directory and build WinAos... ~ SystemTools.Ln ~
-		Release.Build
-			-f=TL/TLHost.Tool --path="WINAOS:/TL/obj/" --build --zip WinAosMini ~
-
-		SystemTools.Ln ~ SystemTools.Show Extracting data ... ~ SystemTools.Ln ~
-		ZipTool.ExtractAll --prefix=WINAOS:/TL/data/ --sourcePath=WINAOS:/TL/obj/ --overwrite -d --silent
-			Kernel.zip System.zip Drivers.zip
-			ApplicationsMini.zip Compiler.zip GuiApplicationsMini.zip TL.zip
-		~
-
-		SystemTools.Ln ~ SystemTools.Show Removing object files from data folder... ~ SystemTools.Ln ~
-		FSTools.DeleteFiles --silent WINAOS:/TL/data/*.Obw ~
-
-		SystemTools.Ln ~ SystemTools.Show Extracting  fonts ... ~ SystemTools.Ln ~
-		ZipTool.ExtractAll --prefix=WINAOS:/TL/fonts/ --sourcePath=WINAOS:/TL/obj/ --overwrite -d --silent
-			ScreenFonts.zip TrueTypeFonts.zip
-		~
-
-		SystemTools.Ln ~ SystemTools.Show Delete ZIP archives from obj folder... ~ SystemTools.Ln ~
-		FSTools.DeleteFiles --silent WINAOS:/TL/obj/*.zip ~
-
-		SystemTools.Ln ~ SystemTools.Show Copy skins ... ~ SystemTools.Ln ~
-		FSTools.CopyFiles  -o ../../source/*.skin => WINAOS:/TL/skins/*.skin ~
-
-
-		SystemTools.Ln ~ SystemTools.Show Delete some large files that are not stricly required... ~ SystemTools.Ln ~
-		FSTools.DeleteFiles
-			WINAOS:/TL/data/UnicodeData.txt
-			WINAOS:/TL/data/Setup.Text
-			WINAOS:/TL/data/BootManager.Text
-		~
-
-		SystemTools.Ln ~ SystemTools.Show Delete some files from data folder... ~ SystemTools.Ln ~
-		FSTools.DeleteFiles WINAOS:/TL/data/*.Bin ~
-		FSTools.DeleteFiles
-			WINAOS:/TL/data/TestContext.xml
-			WINAOS:/TL/data/Release.Auto.dsk
-			WINAOS:/TL/data/AosDefault.Pal
-			WINAOS:/TL/data/OBL.Text
-			WINAOS:/TL/data/License.Text
-			WINAOS:/TL/data/bluebottle.xsl
-			WINAOS:/TL/data/WMPerfMonAlerts.XML
-			WINAOS:/TL/data/config.txt
-			WINAOS:/TL/data/WMPerfMon.Text
-			WINAOS:/TL/obj/CompileCommand.Tool
-		~
-		FSTools.CopyFiles WINAOS:/TL/data/ZeroSkin.zip => WINAOS:/TL/skins/ZeroSkin.zip ~
-		FSTools.CopyFiles A2Watchdog.exe => WINAOS:/TL/A2Watchdog.exe ~
-		FSTools.DeleteFiles WINAOS:/TL/data/ZeroSkin.zip ~
-
-
-		SystemTools.Show Linking aos.exe ... ~ SystemTools.Ln ~
-		PELinker.Link --path=WINAOS:/TL/obj/ --destination=WINAOS:/TL/tl.exe Win32.Aos.Link ~
-
-		FSTools.CreateFile -c -r WINAOS:/TL/aos.ini
-			[Configuration]
-			Paths.Search = work;obj;source;data;skins;fonts;c:/windows/fonts/
-			Paths.Work = work
-			Oberon = OberonExternal.Text
-			Boot  = Traps.Install
-			Boot1 = FileTrapWriter.Install
-			Boot2  = Display.Install --fullscreen --bits16 --noMouseCursor
-			Boot3 = WindowManager.Install --noMouseCursor --bgColor=0F2EFFH
-			Boot4 = Clipboard.Install
-			Boot6 = HotKeys.Open
-			Boot7 = TLC.EnableTrace
-			Boot8 = TLC.SetClientTraceLog tltrace
-			Boot9 = TLHost.Boot
-			Trace = File
-		~
-
-		FSTools.CreateFile -c -r WINAOS:/TL/TL.bat
-			A2Watchdog tl.exe
-		~
-
-		FSTools.DeleteFiles TL.zip ~
-		SystemTools.Ln ~ SystemTools.Show Creating archive TL.zip... ~
-		FSTools.Enumerate -s WINAOS:/TL/*.*
-			ZipTool.Add --silent -r   TL.zip <#filename#>
-		~
-		FSTools.CloseFiles TL.zip ~
-		SystemTools.Show Done ~ SystemTools.Ln ~
-
-		FSTools.Unmount WINAOS ~
-		VirtualDisks.Uninstall RAMDISK ~
-		FSTools.CopyFiles -o TL.zip => ?{a[i,1]}?_?{major}?_?{minor}?_?{release}?_?{internal}?.zip ~
-		"+\;
-	END;
-	~
-
-
-

source/FoxInterpreterSymbols.Mod

@@ -12,6 +12,7 @@ TYPE
 	Object* = PersistentObjects.Object;
 	Content* = PersistentObjects.Content;
 	
+	Name*= ARRAY 128 OF CHAR;
 
 	Meta* = RECORD
 		module*: Modules.Module;
@@ -135,13 +136,10 @@ TYPE
 		address: ADDRESS;
 		
 		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;
+			address := SymbolAddress(type, 0);
 		END InitType;
 
 		PROCEDURE Address(): ADDRESS;
@@ -151,7 +149,7 @@ TYPE
 					
 		PROCEDURE Constructor*(): ProcedureResult;
 		BEGIN
-			RETURN FindConstructor(SELF, type);
+			RETURN FindConstructor(SELF, address);
 		END Constructor;
 
 	END TypeResult;
@@ -177,34 +175,14 @@ TYPE
 				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;
-					RETURN proc
-				ELSIF FindField(self.fields, name, num) THEN
-					NEW(field, name, self.fields[num]);
-					field.address := self.fields[num].offset;
-					RETURN field;
-				ELSE 
-					type := FindType(mod.typeInfo, name);
-					IF type # NIL THEN
-						NEW(typeResult, name, type);
-					END;
-					RETURN typeResult;
-				END;
-				*)
 				RETURN NIL;
 		END Find;
 
@@ -384,6 +362,7 @@ TYPE
 		index: LONGINT;
 		caller-: Result;
 		parameters: Meta;
+		flags: SET; 
 		
 		PROCEDURE Parameters(): Meta;
 		VAR m: Meta;
@@ -394,6 +373,7 @@ TYPE
 			Reflection.SkipString(m.refs, m.offset);
 			address := Reflection.GetAddress(m.refs, m.offset);
 			Reflection.SkipAddress(m.offset);
+			flags := Reflection.GetSet(m.refs, m.offset);
 			RETURN m;
 		END Parameters;
 		
@@ -452,11 +432,11 @@ TYPE
 			a: ADDRESS;
 			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);
+			Reflection.SkipSize(parameters.offset);
 			type := Reflection.GetChar(parameters.refs, parameters.offset);
 			
 			(*type := proc.parameters[index].type;
@@ -486,10 +466,8 @@ TYPE
 				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
@@ -668,9 +646,11 @@ TYPE
 			b: BOOLEAN;
 			set: SET;
 			type: Meta;
+			c: CHAR;
 		BEGIN
 			type := VariableType(meta);
-			CASE Reflection.GetChar(meta.refs, meta.offset) OF
+			c := Reflection.GetChar(type.refs, type.offset);
+			CASE c OF
 				Reflection.sfTypeSHORTINT, Reflection.sfTypeSIGNED8:
 				IF v.GetInt(h) THEN
 					s:= SHORTINT(h); SYSTEM.PUT(address, s);
@@ -722,7 +702,6 @@ TYPE
 		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);
@@ -752,12 +731,10 @@ TYPE
 				meta.module := typeInfo.mod;
 				meta.offset := typeInfo.refsOffset;
 				meta.refs := meta.module.refs;
-				Reflection.Report(Commands.GetContext().out, meta.refs, meta.offset); 
+				(*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;
@@ -766,42 +743,54 @@ TYPE
 					ELSE (* none *)
 					END;
 				END;
-				(*
-				IF FindProc(typeInfo.procedures, name,num) THEN
-					NEW(proc, scope, 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;
-				END;
-				*)
 			END;
 		END;
 		RETURN NIL; 
 	END FindInType;
 	
 		
-	PROCEDURE FindConstructor(scope: Result; type: Meta): ProcedureResult;
+	PROCEDURE FindConstructor(scope: Result; type: ADDRESS): ProcedureResult;
 	VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT; 
 			proc: ProcedureResult; f: FieldResult;	
+				meta: Meta; c: CHAR; pos: SIZE; flags: SET; 
+				name: Name;
 	BEGIN
-		(*
+		(* find constructor in a (base) type *)
 		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); 
-				FOR num := 0 TO LEN(typeInfo.procedures)-1 DO
-					IF SyntaxTree.FlagProcedureConstructor IN typeInfo.procedures[num].flags THEN
-						NEW(proc, scope, typeInfo.procedures[num].name^, typeInfo.procedures[num]);
-						proc.address := typeInfo.procedures[num].address;
-						RETURN proc
+				meta.module := typeInfo.mod;
+				meta.offset := typeInfo.refsOffset;
+				meta.refs := meta.module.refs;
+				
+				c := Reflection.GetChar(meta.refs, meta.offset);
+				ASSERT(c = Reflection.sfTypeDeclaration); 
+				Reflection.SkipSize(meta.offset); 
+				Reflection.SkipString(meta.refs, meta.offset);
+				Reflection.SkipAddress(meta.offset); 
+				c := Reflection.GetChar(meta.refs, meta.offset); 
+				ASSERT(c= Reflection.sfScopeBegin);
+				WHILE meta.refs[meta.offset] = Reflection.sfVariable DO
+					Reflection.SkipVariable(meta.refs, meta.offset); 
+				END;
+				WHILE meta.refs[meta.offset] = Reflection.sfProcedure DO
+					pos := meta.offset; 
+					Reflection.SkipChar(meta.offset);
+					Reflection.SkipSize(meta.offset); 
+					Reflection.GetString(meta.refs, meta.offset, name);
+					Reflection.SkipAddress(meta.offset);
+					Reflection.SkipAddress(meta.offset);
+					flags := Reflection.GetSet(meta.refs, meta.offset); 
+					meta.offset := pos;
+					IF Reflection.flagConstructor IN flags THEN 
+						NEW(proc, scope, name, meta); 
+						RETURN proc;
 					END;
+					Reflection.SkipProcedure(meta.refs, meta.offset); 
 				END;
 			END;
 		END;
-		*)
 		RETURN NIL; 
 	END FindConstructor;
 	

source/Generic.Reflection.Mod

@@ -64,6 +64,9 @@ CONST
 	sfIN* = 0X;
 	sfOUT* = 1X;
 	
+	flagDelegate*=0;
+	flagConstructor*=1;
+	
 	(* variable / parameter addressing modes *)
 	sfAbsolute* = 0X; (* global vars *)
 	sfRelative* = 1X; (* variables, value parameters *)
@@ -81,7 +84,7 @@ CONST
 		
 		Scope = sfScopeBegin {variable:Variable} {procedure:Procedure} {typeDecl:TypeDeclaration} sfScopeEnd.
 		Module = sfModule prevSymbolOffset:SIZE name:String Scope.
-		Procedure = sfProcedure prevSymbolOffset:SIZE name:String start:ADR end:ADR returnType:Type {parameter:Variable} Scope.
+		Procedure = sfProcedure prevSymbolOffset:SIZE name:String start:ADR end:ADR flags:SET {parameter:Variable} returnType:Type 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 = 
@@ -193,6 +196,24 @@ CONST
 		INC(offset, SIZEOF(SIZE)); 
 	END SkipSize;
 
+	(* consume a set in the byte stream *)
+	PROCEDURE GetSet*(refs: Modules.Bytes; VAR offset: LONGINT): SET;
+	VAR set: SET; i: LONGINT;
+	BEGIN
+		IF ~Expect(offset < LEN(refs)) THEN RETURN {} END; 
+		FOR i := 0 TO SIZEOF(SET)-1 DO
+			SYSTEM.PUT8(ADDRESSOF(set)+i, refs[offset]);
+			INC(offset);
+		END;
+		RETURN set;
+	END GetSet;
+
+	(* skip a set in the byte stream *)
+	PROCEDURE SkipSet*(VAR offset: LONGINT);
+	BEGIN
+		INC(offset, SIZEOF(SET)); 
+	END SkipSet;
+
 	(* consume a string in the byte stream *)
 	PROCEDURE GetString*(refs: Modules.Bytes; VAR offset: LONGINT; VAR string: ARRAY OF CHAR);
 	VAR ch: CHAR; i: LONGINT; 
@@ -300,10 +321,11 @@ CONST
 				offset := refpos;
 				IF GetChar(refs, offset) = sfProcedure THEN
 					SkipSize(offset);
-					SkipString(refs, offset); 
+					SkipString(refs, offset);
 					GetFullName(refs, refpos, name); 
 					startpc := GetAddress(refs, offset);
 					end := GetAddress(refs, offset); 
+					SkipSet(offset);
 					w.String(name); 
 					w.Char(":"); w.Int(LONGINT(pc-startpc),1);
 					base := fp; (*! only for local !! *)
@@ -614,6 +636,7 @@ CONST
 		SkipString(refs, offset);
 		SkipAddress(offset);
 		SkipAddress(offset);
+		SkipSet(offset);
 		WHILE (refs[offset] = sfVariable)  DO	SkipVariable(refs, offset) END;
 		SkipType(refs, offset); 
 		SkipScope(refs, offset);
@@ -704,6 +727,7 @@ CONST
 		FindString(refs, offset, level, find);
 		start := GetAddress(refs, offset);
 		end := GetAddress(refs, offset);
+		SkipSet(offset);
 		find.found := find.found OR (start <= find.pc) & (find.pc < end);
 		IF find.found THEN
 			find.pos := pos; 
@@ -1046,7 +1070,7 @@ TYPE
 	END ReportType;
 
 	PROCEDURE ReportProcedure*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
-	VAR name: Name;  start, end: LONGINT; 
+	VAR name: Name;  start, end: LONGINT;  flags: SET; 
 	BEGIN
 		w.Int(offset,1); w.String(":");
 		w.String("PROCEDURE "); 
@@ -1056,6 +1080,10 @@ TYPE
 		w.String(name); 
 		start := GetAddress(refs, offset);
 		end := GetAddress(refs, offset);
+		flags := GetSet(refs, offset); 
+		IF flags # {} THEN
+			w.Set(flags);
+		END;
 		w.String("[@"); w.Address(start); w.String(" - "); w.Address(end); w.String("]");
 		w.String("("); w.Ln;
 		WHILE refs[offset] = sfVariable DO