moved the interpreter from OC to A2 trunk

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

source/FoxInterpreter.Mod

@@ -0,0 +1,1259 @@
+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;
+	
+CONST
+	EnableTrace = FALSE;
+
+TYPE
+
+	Value*=InterpreterSymbols.Item;
+	Integer*=InterpreterSymbols.IntegerValue;
+	Real*=InterpreterSymbols.RealValue;
+	String*=InterpreterSymbols.StringValue;
+	Boolean*=InterpreterSymbols.BooleanValue;
+	Set*=InterpreterSymbols.SetValue;
+	Range*=InterpreterSymbols.RangeValue;
+	Char*=InterpreterSymbols.CharValue;
+	Scope*=InterpreterSymbols.Scope;
+	Container*= InterpreterSymbols.Container;
+	Address*=InterpreterSymbols.Address;
+
+	CommandStatement = OBJECT (SyntaxTree.Statement)
+	VAR command: Strings.String;
+
+		PROCEDURE & InitCommandStatement(s: Strings.String);
+		BEGIN
+			command := s
+		END InitCommandStatement;
+
+	END CommandStatement;
+
+	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
+				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"))
+			*)
+			ELSE
+				RETURN Statement^(statements, outer);
+			END;
+		END Statement;
+
+		PROCEDURE Cmd(): SyntaxTree.Statement;
+		VAR cmd: CommandStatement; string: Strings.String;
+		BEGIN
+			NextSymbol;
+			IF MandatoryString(string) THEN
+			NEW(cmd, string);
+			(* TRACE(string^) *)
+			END;
+			RETURN cmd;
+		END Cmd;
+
+
+	END Parser;
+
+	Interpreter* = OBJECT (SyntaxTree.Visitor)
+	VAR
+		value: BOOLEAN;
+		address-: Address;
+		module-: Modules.Module;
+
+		scope-: Scope;
+		exit: BOOLEAN;
+		error-: BOOLEAN;
+		diagnostics: Diagnostics.Diagnostics;
+		context-: Commands.Context;
+
+		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
+		END Init;
+
+		PROCEDURE SetScope*(s: Scope);
+		BEGIN
+			scope := s
+		END SetScope;
+
+		PROCEDURE Reset*;
+		BEGIN
+			error := FALSE;
+		END Reset;
+
+
+		PROCEDURE Error(CONST msg: ARRAY OF CHAR);
+		BEGIN
+			IF error THEN RETURN END;
+			(*! use diagnostics *)
+			error := TRUE;
+			IF diagnostics # NIL THEN
+				diagnostics.Error("",Diagnostics.Invalid, Diagnostics.Invalid, msg);
+			END;
+		END Error;
+
+		PROCEDURE ErrorSS(CONST msg: ARRAY OF CHAR; id: StringPool.Index);
+		VAR name: ARRAY 128 OF CHAR; message: ARRAY 256 OF CHAR;
+		BEGIN
+			IF error THEN RETURN END;
+			(*! use diagnostics *)
+			error := TRUE;
+			COPY(msg, message);
+			IF id # 0 THEN Strings.Append(message," "); StringPool.GetString(id, name); Strings.Append(message, name); END;
+			IF diagnostics # NIL THEN
+				diagnostics.Error("",Diagnostics.Invalid, Diagnostics.Invalid, message);
+			END;
+		END ErrorSS;
+
+		(** syntax tree types omitted -- unused *)
+
+		(** expressions *)
+
+		PROCEDURE VisitSet*(x: SyntaxTree.Set);
+		VAR s: SET; i: LONGINT; value: Value;
+		BEGIN
+			FOR i := 0 TO x.elements.Length()-1 DO
+				IF GetValue(x.elements.GetExpression(i), value) THEN
+					IF value IS Integer THEN INCL(s, value(Integer).value)
+					ELSIF value IS Range THEN s := s + {FIRST(value(Range).value)..LAST(value(Range).value)}
+					ELSE Error("wrong value type")
+					END;
+				END;
+			END;
+			NewSet(s)
+		END VisitSet;
+
+		PROCEDURE VisitMathArrayExpression*(x: SyntaxTree.MathArrayExpression);
+		VAR numberElements, i: LONGINT; a: InterpreterSymbols.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));
+			END;
+			address.object := a; value := TRUE;
+		END VisitMathArrayExpression;
+
+		PROCEDURE NewInt(i: LONGINT);
+		VAR v: Integer;
+		BEGIN
+			NEW(v, i); address.object := v; value := TRUE
+		END NewInt;
+
+		PROCEDURE NewReal(i: LONGREAL);
+		VAR v: Real;
+		BEGIN
+			NEW(v, i); address.object := v; value := TRUE
+		END NewReal;
+
+		PROCEDURE NewBool(b: BOOLEAN);
+		VAR v: Boolean;
+		BEGIN
+			NEW(v, b); address.object := v; value := TRUE;
+		END NewBool;
+
+		PROCEDURE NewSet(s: SET);
+		VAR v: Set;
+		BEGIN
+			NEW(v, s); address.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;
+		END NewString;
+
+		PROCEDURE NewRange(r: RANGE);
+		VAR v: Range;
+		BEGIN
+			NEW(v, r ); address.object := v; value := TRUE;
+		END NewRange;
+
+		PROCEDURE NewChar(c: CHAR);
+		VAR v: Char;
+		BEGIN
+			NEW(v, c); address.object := v; value := TRUE;
+		END NewChar;
+
+		PROCEDURE VisitUnaryExpression*(x: SyntaxTree.UnaryExpression);
+		VAR value: Value; i: LONGINT; r: LONGREAL; b: BOOLEAN; operator: LONGINT;
+		BEGIN
+			operator := x.operator;
+			IF ~GetValue(x, value) THEN RETURN END;
+			IF value IS Integer THEN
+				i := value(Integer).value;
+				CASE operator OF
+				Scanner.Minus: NewInt(-i)
+				|Scanner.Plus: NewInt(i)
+				ELSE Error("unary operator not supported")
+				END;
+			ELSIF value IS Real THEN
+				r := value(Real).value;
+				CASE operator OF
+				Scanner.Minus: NewReal(-r)
+				|Scanner.Plus: NewReal(r)
+				ELSE Error("unary operator not supported")
+				END;
+			ELSIF value IS Boolean THEN
+				b := value(Boolean).value;
+				CASE operator OF
+				Scanner.Not: NewBool(~b)
+				ELSE Error("unary operator not supported")
+				END;
+			ELSIF value IS Set THEN
+				CASE operator OF
+				Scanner.Minus: NewSet(-value(Set).value)
+				ELSE Error("unary operator not supported")
+				END;
+			ELSE
+				Error("unary operation not supported");
+			END;
+		END VisitUnaryExpression;
+
+		PROCEDURE VisitBinaryExpression*(x: SyntaxTree.BinaryExpression);
+		VAR left, right: Value; operator: LONGINT; li, ri: LONGINT; lr, rr: LONGREAL; lb, rb:  BOOLEAN; sl, sr: SET;
+		BEGIN
+			operator := x.operator;
+			IF ~GetValue(x.left, left) OR ~GetValue(x.right, right) THEN RETURN END;
+
+			IF (left IS Integer) & (right IS Integer) THEN
+				li := left(Integer).value; ri := right(Integer).value;
+				CASE operator OF
+				|Scanner.Plus: NewInt(li+ri)
+				|Scanner.Minus: NewInt(li-ri);
+				|Scanner.Times: NewInt(li * ri);
+				|Scanner.Div: NewInt(li DIV ri);
+				|Scanner.Mod: NewInt(li MOD ri);
+				|Scanner.Equal: NewBool(li = ri);
+				|Scanner.Unequal: NewBool(li # ri)
+				|Scanner.Less: NewBool(li < ri)
+				|Scanner.LessEqual: NewBool(li <= ri)
+				|Scanner.Greater: NewBool(li > ri)
+				|Scanner.GreaterEqual: NewBool(li >= ri)
+				|Scanner.Slash: NewReal(li/ri)
+				ELSE Error("binary operator not supported")
+				END;
+			ELSIF ((left IS Integer) OR (left IS Real)) & ((right IS Integer) OR (right IS Real)) THEN
+				IF left IS Integer THEN lr := left(Integer).value
+				ELSE lr := left(Real).value
+				END;
+				IF right IS Integer THEN rr := right(Integer).value;
+				ELSE rr := right(Real).value
+				END;
+				CASE operator OF
+				|Scanner.Plus: NewReal(lr+rr)
+				|Scanner.Minus: NewReal(lr-rr);
+				|Scanner.Times: NewReal(lr * rr);
+				|Scanner.Slash: NewReal(lr / rr);
+				|Scanner.Equal: NewBool(lr = rr);
+				|Scanner.Unequal: NewBool(lr # rr)
+				|Scanner.Less: NewBool(lr < rr)
+				|Scanner.LessEqual: NewBool(lr <= rr)
+				|Scanner.Greater: NewBool(lr > rr)
+				|Scanner.GreaterEqual: NewBool(lr >= rr)
+				ELSE Error("binary operator not supported")
+				END;
+			ELSIF (left IS Boolean) & (right IS Boolean) THEN
+				lb := left(Boolean).value; rb := right(Boolean).value;
+				CASE operator OF
+				|Scanner.Or: NewBool(lb OR rb);
+				|Scanner.And: NewBool(lb & rb);
+				|Scanner.Equal: NewBool(lb = rb)
+				|Scanner.Unequal: NewBool(lb # rb)
+				ELSE Error("operator not supported")
+				END;
+			ELSIF (left IS String) & (right IS String) THEN
+				CASE operator OF
+				|Scanner.Equal: NewBool(left(String).value^ = right(String).value^);
+				|Scanner.Unequal: NewBool(left(String).value^ = right(String).value^);
+				|Scanner.Less: NewBool(left(String).value^ < right(String).value^);
+				|Scanner.LessEqual: NewBool(left(String).value^ <= right(String).value^);
+				|Scanner.Greater: NewBool(left(String).value^ > right(String).value^);
+				|Scanner.GreaterEqual: NewBool(left(String).value^ >= right(String).value^);
+				ELSE Error("binary operator not supported")
+				END
+			ELSIF (left IS Set) & (right IS Set) THEN
+				sl := left(Set).value; sr := right(Set).value;
+				CASE operator OF
+				|Scanner.Plus: NewSet(sl+sr)
+				|Scanner.Minus: NewSet(sl-sr);
+				|Scanner.Times: NewSet(sl * sr);
+				|Scanner.Slash: NewSet(sl / sr);
+				|Scanner.Equal: NewBool(sl = sr);
+				|Scanner.Unequal: NewBool(sl # sr)
+				|Scanner.Less: NewBool(sl < sr)
+				|Scanner.LessEqual: NewBool(sl <= sr)
+				|Scanner.Greater: NewBool(sl > sr)
+				|Scanner.GreaterEqual: NewBool(sl >= sr)
+				ELSE Error("binary operator not supported")
+				END;
+			ELSIF (left IS Integer) & (right IS Set) THEN
+				CASE operator OF
+				Scanner.In: NewBool(left(Integer).value IN right(Set).value)
+				ELSE Error("binary operator not supported")
+				END;
+			ELSE
+				Error("binary operation not supported");
+				Printout.Info("binary operation", x);
+			END;
+		END VisitBinaryExpression;
+
+		PROCEDURE VisitRangeExpression*(x: SyntaxTree.RangeExpression);
+		VAR first,last,step: LONGINT; value: Integer;
+		BEGIN
+			IF ~ExpectInteger(x.first, value) THEN RETURN END;
+			first := value.value;
+			IF ~ExpectInteger(x.last, value) THEN RETURN END;
+			last := value.value;
+			IF (x.step # NIL) & ExpectInteger(x.step, value) THEN
+				step := value.value;
+			ELSE
+				step := 1
+			END;
+			NewRange(first ..last BY step);
+		END VisitRangeExpression;
+
+		PROCEDURE VisitTensorRangeExpression*(x: SyntaxTree.TensorRangeExpression);
+		BEGIN HALT(100) (* abstract *) END VisitTensorRangeExpression;
+
+		PROCEDURE VisitConversion*(x: SyntaxTree.Conversion);
+		BEGIN HALT(100) (* abstract *) END VisitConversion;
+
+		(** designators (expressions) *)
+		PROCEDURE VisitDesignator*(x: SyntaxTree.Designator);
+		BEGIN HALT(100) (* abstract *) END VisitDesignator;
+
+		(*
+		PROCEDURE FindInScope(scope: Scope; symbol: StringPool.Index): Value;
+		VAR item: Value;
+		BEGIN
+			REPEAT
+				item := scope.Find1(symbol);
+
+				IF (item = NIL) THEN
+					scope := scope.outer
+				ELSE
+					scope := NIL
+				END;
+			UNTIL (scope = NIL);
+			RETURN item
+		END FindInScope;
+		*)
+
+		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;
+			(*
+			address.object := FindInScope(address.scope, address.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
+			END;
+		END VisitIdentifierDesignator;
+
+		PROCEDURE VisitSelectorDesignator*(x: SyntaxTree.SelectorDesignator);
+		VAR traverse: BOOLEAN; name: ARRAY 128 OF CHAR;
+		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);
+			ELSE
+				ErrorSS("invalid selector",address.name);
+				address.in := NIL;
+			END;
+		END VisitSelectorDesignator;
+
+		PROCEDURE VisitParameterDesignator*(x: SyntaxTree.ParameterDesignator);
+		VAR e: SyntaxTree.Expression;
+		BEGIN HALT(100);
+			e := x.left;
+			(*IF e IS IdentifierDesignator THEN
+			END;
+			*)
+		END VisitParameterDesignator;
+
+		PROCEDURE VisitArrowDesignator*(x: SyntaxTree.ArrowDesignator);
+		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;
+			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);
+				FOR i := 0 TO x.parameters.Length()-1 DO
+					array := element(InterpreterSymbols.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;
+				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
+						IF (expression(SyntaxTree.BinaryExpression).left IS SyntaxTree.IdentifierDesignator) &
+						GetValue(expression(SyntaxTree.BinaryExpression).right, rightValue) THEN
+							StringPool.GetString(
+							expression(SyntaxTree.BinaryExpression).left(SyntaxTree.IdentifierDesignator).identifier, attribute);
+							rightValue(InterpreterSymbols.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);
+								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)
+								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);
+				ELSE
+					Error("no such symbol")
+				END;
+			END;
+		END VisitBracketDesignator;
+
+		PROCEDURE VisitSymbolDesignator*(x: SyntaxTree.SymbolDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitSymbolDesignator;
+
+		PROCEDURE VisitIndexDesignator*(x: SyntaxTree.IndexDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitIndexDesignator;
+
+		PROCEDURE VisitProcedureCallDesignator*(x: SyntaxTree.ProcedureCallDesignator);
+		BEGIN HALT(100)
+		END VisitProcedureCallDesignator;
+
+		PROCEDURE VisitBuiltinCallDesignator*(x: SyntaxTree.BuiltinCallDesignator);
+		BEGIN HALT(100)
+		END VisitBuiltinCallDesignator;
+
+		PROCEDURE VisitTypeGuardDesignator*(x: SyntaxTree.TypeGuardDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitTypeGuardDesignator;
+
+		PROCEDURE VisitDereferenceDesignator*(x: SyntaxTree.DereferenceDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitDereferenceDesignator;
+
+		PROCEDURE VisitSupercallDesignator*(x: SyntaxTree.SupercallDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitSupercallDesignator;
+
+		PROCEDURE VisitSelfDesignator*(x: SyntaxTree.SelfDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitSelfDesignator;
+
+		PROCEDURE VisitResultDesignator*(x: SyntaxTree.ResultDesignator);
+		BEGIN HALT(100) (* abstract *) END VisitResultDesignator;
+
+		(** values *)
+		PROCEDURE VisitValue*(x: SyntaxTree.Value);
+		BEGIN HALT(100) (* abstract *) END VisitValue;
+
+		PROCEDURE VisitBooleanValue*(x: SyntaxTree.BooleanValue);
+		BEGIN
+			NewBool(x.value)
+		END VisitBooleanValue;
+
+		PROCEDURE VisitIntegerValue*(x: SyntaxTree.IntegerValue);
+		BEGIN
+			NewInt(x.value)
+		END VisitIntegerValue;
+
+		PROCEDURE VisitCharacterValue*(x: SyntaxTree.CharacterValue);
+		BEGIN
+			NewChar(x.value);
+		END VisitCharacterValue;
+
+		PROCEDURE VisitSetValue*(x: SyntaxTree.SetValue);
+		BEGIN
+			NewSet(x.value)
+		END VisitSetValue;
+
+		PROCEDURE VisitMathArrayValue*(x: SyntaxTree.MathArrayValue);
+		BEGIN HALT(100) (* abstract *) END VisitMathArrayValue;
+
+		PROCEDURE VisitRealValue*(x: SyntaxTree.RealValue);
+		BEGIN
+			NewReal(x.value)
+		END VisitRealValue;
+
+		PROCEDURE VisitComplexValue*(x: SyntaxTree.ComplexValue);
+		BEGIN HALT(100) (* abstract *) END VisitComplexValue;
+
+		PROCEDURE VisitStringValue*(x: SyntaxTree.StringValue);
+		BEGIN
+			NewString(x.value^);
+		END VisitStringValue;
+
+		PROCEDURE VisitNilValue*(x: SyntaxTree.NilValue);
+		BEGIN HALT(100) (* abstract *) END VisitNilValue;
+
+		PROCEDURE VisitEnumerationValue*(x: SyntaxTree.EnumerationValue);
+		BEGIN HALT(100) (* abstract *) END VisitEnumerationValue;
+
+		(** symbols *)
+		PROCEDURE VisitSymbol*(x: SyntaxTree.Symbol);
+		BEGIN HALT(100) (* abstract *) END VisitSymbol;
+
+		PROCEDURE VisitTypeDeclaration*(x: SyntaxTree.TypeDeclaration);
+		BEGIN HALT(100) (* abstract *) END VisitTypeDeclaration;
+
+		PROCEDURE VisitConstant*(x: SyntaxTree.Constant);
+		BEGIN HALT(100) (* abstract *) END VisitConstant;
+
+		PROCEDURE VisitVariable*(x: SyntaxTree.Variable);
+		BEGIN HALT(100) (* abstract *) END VisitVariable;
+
+		PROCEDURE VisitParameter*(x: SyntaxTree.Parameter);
+		BEGIN HALT(100) (* abstract *) END VisitParameter;
+
+		PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
+		BEGIN HALT(100) (* abstract *) END VisitProcedure;
+
+		PROCEDURE VisitBuiltin*(x: SyntaxTree.Builtin);
+		BEGIN HALT(100) (* abstract *) END VisitBuiltin;
+
+		PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
+		BEGIN HALT(100) (* abstract *) END VisitOperator;
+
+		PROCEDURE VisitImport*(x: SyntaxTree.Import);
+		BEGIN HALT(100) (* abstract *) END VisitImport;
+
+		(* copy src to value string replacing substrings that are embraced between refSymbols by expression value *)
+		PROCEDURE TranslateString*(cmd: CHAR; CONST str: ARRAY OF CHAR; VAR dest: Strings.String): BOOLEAN;
+		CONST
+			LeftDelimiter = '{'; RightDelimiter = '}';
+		VAR
+			position : LONGINT; ch: CHAR;
+			destination, expMaker: Scanner.StringMaker; destinationWriter, expressionWriter: Streams.Writer; scanner: Scanner.Scanner; parser: Parser;
+			expression: SyntaxTree.Expression; value: Value; len: LONGINT;
+			comment: LONGINT;
+
+			PROCEDURE Next(VAR ch: CHAR);
+			BEGIN
+				IF position = LEN(str) THEN ch := 0X ELSE ch := str[position]; INC(position) END;
+			END Next;
+
+			PROCEDURE EvaluateExpression();
+			VAR str: Strings.String; reader: Streams.Reader; done: BOOLEAN;
+			BEGIN
+				reader := expMaker.GetReader();
+				NEW(scanner, "", reader, 0, NIL);
+				NEW(parser, scanner, NIL);
+				REPEAT
+					error := FALSE;
+					expression := parser.Expression();
+					done := GetValue(expression, value);
+				UNTIL done OR ~parser.Optional(Scanner.Colon);
+
+				IF done THEN value(InterpreterSymbols.Value).WriteValue(destinationWriter);
+				ELSE
+					destinationWriter.String("#COULD NOT INTERPRETE#");
+					error := TRUE;
+				END;
+			END EvaluateExpression;
+
+		BEGIN
+			error := FALSE;
+			position := 0;
+			Next(ch);
+			NEW(destination,256); destinationWriter := destination.GetWriter();
+			NEW(expMaker, 256); expressionWriter := expMaker.GetWriter();
+			comment := 0;
+
+			WHILE (ch # 0X) DO
+				(* copy string literally *)
+				IF (comment = 0) & (ch = cmd) THEN
+					Next(ch);
+					IF ch = LeftDelimiter THEN
+						Next(ch);
+						REPEAT
+							WHILE (ch # 0X) & (ch # RightDelimiter) DO expressionWriter.Char(ch); Next(ch) END;
+							IF ch = RightDelimiter THEN
+								Next(ch); IF (ch # cmd) THEN expressionWriter.Char(RightDelimiter) END;
+							END;
+						UNTIL (ch=0X) OR (ch = cmd);
+						IF ch # 0X THEN Next(ch) END;
+						expressionWriter.Update;
+						EvaluateExpression();
+						expMaker.Clear;
+					ELSE
+						destinationWriter.Char(cmd);
+					END;
+				(* remove comments *)
+				ELSIF ch = "(" THEN
+					Next(ch);
+					IF ch = "*" THEN 
+						INC(comment); Next(ch);
+					ELSIF comment = 0 THEN 
+						destinationWriter.Char("(");
+					END;
+				ELSIF ch="*" THEN
+					Next(ch);
+					IF ch = ")" THEN 
+						DEC(comment); 
+						IF comment < 0 THEN comment := 0 END; Next(ch);
+					ELSIF comment = 0 THEN 
+						destinationWriter.Char("*")
+					END;
+				ELSE
+					IF comment = 0 THEN destinationWriter.Char(ch) END;
+					Next(ch);
+				END;
+			END;
+			destinationWriter.Update;
+			dest := destination.GetString(len);
+			RETURN ~error
+		END TranslateString;
+		
+		PROCEDURE VisitCommandStatement(x: CommandStatement);
+		VAR t: Strings.String; res: LONGINT; msg: ARRAY 128 OF CHAR; i: LONGINT; array: Strings.StringArray; pos: LONGINT;
+			command: ARRAY 256 OF CHAR; context: Commands.Context;
+
+			PROCEDURE CreateContext(paramString : Strings.String; pos: LONGINT) : Commands.Context;
+			VAR c : Commands.Context; arg : Streams.StringReader; dummy : ARRAY 1 OF CHAR; len: LONGINT;
+			BEGIN
+				IF (paramString = NIL) THEN
+					NEW(arg, 1); dummy := ""; arg.SetRaw(dummy, 0, 1);
+				ELSE
+					len := Strings.Length(paramString^)+1 (*+1 to include 0X *);
+					NEW(arg, len-pos); arg.SetRaw(paramString^, pos, len-pos);
+				END;
+				NEW(c, context.in, arg, context.out, context.error, context.caller);
+				RETURN c;
+			END CreateContext;
+
+			PROCEDURE IsDelimiter(ch : CHAR) : BOOLEAN;
+			CONST 	CR = 0DX;  LF = 0AX;  TAB = 9X;
+			BEGIN
+				RETURN (ch = " ") OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (ch = ";") OR (ch = 0X);
+			END IsDelimiter;
+
+		BEGIN
+			IF SELF.context = NIL THEN
+				context := Commands.GetContext();
+			ELSE
+				context := SELF.context
+			END;
+			IF TranslateString("?", x.command^, t) THEN END;
+			array := Strings.Split(t^, "~");
+			FOR i := 0 TO LEN(array)-1 DO
+				Strings.TrimWS(array[i]^);
+				IF (array[i]^ # "") THEN
+						(* extract command *)
+						pos := 0;
+						WHILE ~IsDelimiter(array[i][pos])  DO command[pos] := array[i][pos]; INC(pos); END;
+						command[pos] := 0X;
+						IF pos # 0 THEN
+							context := CreateContext(array[i], pos);
+							Commands.Activate(command, context, {Commands.Wait, Commands.InheritContext}, res, msg);
+							IF res # 0 THEN
+								context.out.String("Interpreter: "); context.error.String(command); context.error.String(" failed"); context.error.Ln
+							END;
+						END;
+				END;
+
+			END;
+			IF res # 0 THEN Error(msg) END;
+		END VisitCommandStatement;
+
+		(** statements *)
+		PROCEDURE VisitStatement*(x: SyntaxTree.Statement);
+		BEGIN
+			IF x IS CommandStatement THEN
+				VisitCommandStatement(x(CommandStatement));
+			ELSE HALT(100)
+			END;
+		END VisitStatement;
+
+		PROCEDURE VisitProcedureCallStatement*(x: SyntaxTree.ProcedureCallStatement);
+		BEGIN x.call.Accept(SELF) END VisitProcedureCallStatement;
+
+		PROCEDURE LoadValue;
+		BEGIN
+			IF address.object = NIL THEN
+				ErrorSS("could not load value", address.name);
+			END;
+		END LoadValue;
+
+		PROCEDURE GetValue*(x: SyntaxTree.Expression; VAR w: Value): BOOLEAN;
+		BEGIN
+			IF error THEN RETURN FALSE END;
+			Expression(x);
+			LoadValue();
+			w := address.object;
+			RETURN ~error
+		END GetValue;
+
+		PROCEDURE GetInteger(x: SyntaxTree.Expression; VAR i: Integer): BOOLEAN;
+		VAR v: Value;
+		BEGIN
+			IF GetValue(x, v) & (v IS Integer) THEN i := v(Integer); RETURN TRUE ELSE RETURN FALSE END;
+		END GetInteger;
+
+		PROCEDURE ExpectInteger(x: SyntaxTree.Expression; VAR i: Integer): BOOLEAN;
+		BEGIN IF ~GetInteger(x, i) THEN Error("invalid value - must be integer"); RETURN FALSE ELSE RETURN TRUE END;
+		END ExpectInteger;
+
+		PROCEDURE GetBoolean(x: SyntaxTree.Expression; VAR i: Boolean): BOOLEAN;
+		VAR v: Value;
+		BEGIN
+			IF GetValue(x, v) & (v IS Boolean) THEN i := v(Boolean); RETURN TRUE ELSE RETURN FALSE END;
+		END GetBoolean;
+
+		PROCEDURE ExpectBoolean(x: SyntaxTree.Expression; VAR b: Boolean): BOOLEAN;
+		BEGIN IF ~GetBoolean(x, b) THEN Error("invalid value - must be boolean"); RETURN FALSE ELSE RETURN TRUE END;
+		END ExpectBoolean;
+
+		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);
+			END;
+		END PutValue;
+
+		PROCEDURE VisitAssignment*(x: SyntaxTree.Assignment);
+		VAR value: Value;
+		BEGIN
+			IF GetValue(x.right, value) THEN
+				PutValue(x.left, value);
+			END;
+		END VisitAssignment;
+
+		PROCEDURE IfPart(ifPart: SyntaxTree.IfPart): BOOLEAN;
+		VAR value: Boolean;
+		BEGIN
+			IF ExpectBoolean(ifPart.condition,value) THEN
+				IF value(Boolean).value THEN
+					StatementSequence(ifPart.statements);
+					RETURN TRUE
+				END;
+			END;
+			RETURN FALSE
+		END IfPart;
+
+		PROCEDURE VisitIfStatement*(x: SyntaxTree.IfStatement);
+		VAR i: LONGINT; elsif: SyntaxTree.IfPart;
+		BEGIN
+			IF IfPart(x.ifPart) THEN RETURN END;
+			FOR i := 0 TO x.ElsifParts()-1 DO
+				elsif := x.GetElsifPart(i);
+				IF IfPart(elsif) THEN RETURN END;
+			END;
+			IF x.elsePart # NIL THEN
+				StatementSequence(x.elsePart)
+			END;
+		END VisitIfStatement;
+
+		PROCEDURE VisitWithStatement*(x: SyntaxTree.WithStatement);
+		BEGIN HALT(100) (* abstract *) END VisitWithStatement;
+
+		PROCEDURE CasePart(x: SyntaxTree.CasePart; b: SyntaxTree.BinaryExpression): BOOLEAN;
+		VAR i: LONGINT; value: Value;
+		BEGIN
+			FOR i := 0 TO x.elements.Length()-1 DO
+				b.SetRight(x.elements.GetExpression(i));
+				IF GetValue(b, value) & (value IS Boolean) THEN
+					IF value(Boolean).value THEN StatementSequence(x.statements); RETURN TRUE END;
+				ELSE Error("invalid non-boolean value")
+				END
+			END;
+			RETURN FALSE
+		END CasePart;
+
+		PROCEDURE VisitCaseStatement*(x: SyntaxTree.CaseStatement);
+		VAR binary: SyntaxTree.BinaryExpression; i: LONGINT;
+		BEGIN
+			binary := SyntaxTree.NewBinaryExpression(0, x.variable, x.variable, Scanner.Equal);
+			FOR i := 0 TO x.CaseParts()-1 DO
+				IF CasePart(x.GetCasePart(i), binary) THEN RETURN END;
+			END;
+			IF x.elsePart # NIL THEN
+				StatementSequence(x.elsePart)
+			END;
+		END VisitCaseStatement;
+
+		PROCEDURE VisitWhileStatement*(x: SyntaxTree.WhileStatement);
+		VAR value: Boolean;
+		BEGIN
+			WHILE ExpectBoolean(x.condition, value) & value.value DO
+				StatementSequence(x.statements);
+			END;
+		END VisitWhileStatement;
+
+		PROCEDURE VisitRepeatStatement*(x: SyntaxTree.RepeatStatement);
+		VAR value: Boolean;
+		BEGIN
+			REPEAT
+				StatementSequence(x.statements);
+			UNTIL ~ExpectBoolean(x.condition, value) OR value.value
+		END VisitRepeatStatement;
+
+		PROCEDURE VisitForStatement*(x: SyntaxTree.ForStatement);
+		VAR fromV, toV, byV: Integer; from, to, by,i: LONGINT; int: Integer;
+		BEGIN
+			IF ExpectInteger(x.from, fromV) & ExpectInteger(x.to, toV) THEN
+				from := fromV.value;
+				to := toV.value;
+				Expression(x.variable);
+				NEW(int, from);
+				PutValue(x.variable, int);
+				i := from;
+				WHILE i <= to DO
+					int.value := i;
+					StatementSequence(x.statements);
+					INC(i);
+				END;
+			END;
+		END VisitForStatement;
+
+		PROCEDURE VisitLoopStatement*(x: SyntaxTree.LoopStatement);
+		VAR prevExit: BOOLEAN;
+		BEGIN
+			prevExit := exit;
+			exit := FALSE;
+			LOOP
+				StatementSequence(x.statements);
+				IF exit THEN EXIT END;
+			END;
+			exit := prevExit
+		END VisitLoopStatement;
+
+		PROCEDURE VisitExitStatement*(x: SyntaxTree.ExitStatement);
+		BEGIN
+			exit := TRUE
+		END VisitExitStatement;
+
+		PROCEDURE VisitReturnStatement*(x: SyntaxTree.ReturnStatement);
+		BEGIN HALT(100) (* abstract *) END VisitReturnStatement;
+
+		PROCEDURE VisitAwaitStatement*(x: SyntaxTree.AwaitStatement);
+		BEGIN HALT(100) (* abstract *) END VisitAwaitStatement;
+
+		PROCEDURE VisitStatementBlock*(x: SyntaxTree.StatementBlock);
+		BEGIN
+			StatementSequence(x.statements)
+		END VisitStatementBlock;
+
+		PROCEDURE VisitCode*(x: SyntaxTree.Code);
+		BEGIN HALT(100) (* abstract *) END VisitCode;
+
+		PROCEDURE Expression(x: SyntaxTree.Expression);
+		BEGIN
+			value := FALSE;
+			x.Accept(SELF);
+		END Expression;
+
+		PROCEDURE Statement(x: SyntaxTree.Statement);
+		BEGIN
+			address.object := NIL;
+			x.Accept(SELF);
+		END Statement;
+
+		PROCEDURE StatementSequence*(x: SyntaxTree.StatementSequence);
+		VAR i: LONGINT;
+		BEGIN
+			FOR i := 0 TO x.Length()-1 DO
+				Statement(x.GetStatement(i));
+			END;
+		END StatementSequence;
+
+	END Interpreter;
+
+	Resolver*= OBJECT
+	VAR
+		interpreter: Interpreter;
+		content: PersistentObjects.Content;
+		resolved: Basic.HashTable;
+		current: Scope;
+		changed: BOOLEAN;
+
+		PROCEDURE & InitResolver*;
+		BEGIN
+			NEW(content); NEW(resolved,64); NEW(interpreter, NIL, NIL, NIL);
+		END InitResolver;
+
+		PROCEDURE Traverse(CONST name: ARRAY OF CHAR; array: BOOLEAN);
+		VAR index: LONGINT; success: BOOLEAN;
+		BEGIN
+			IF array THEN index := 0 ELSE index := -1 END;
+			REPEAT
+				success := FALSE;
+				content.success := FALSE;
+				current.object.Get(name, index, content);
+				IF content.success & (content.class = PersistentObjects.Class.Object) THEN
+					success := content.object # NIL;
+					IF content.object # NIL THEN
+						DoResolve(current.Enter(content.object)); (* content object can be overwritten as sideeffect! *)
+					END;
+				END;
+				INC(index);
+			UNTIL ~array OR ~success
+		END Traverse;
+
+		PROCEDURE DoResolve*(scope: Scope);
+		VAR translation: PersistentObjects.Interpretation; prev: Scope; str: Strings.String;
+		BEGIN
+			IF (scope.object # NIL) & ~resolved.Has(scope.object) THEN
+				prev := current;
+				current := scope;
+				resolved.Put(scope.object, SELF);
+				interpreter.Init(scope, NIL, NIL);
+
+				translation := scope.object.firstTranslation;
+				WHILE translation # NIL DO
+					IF EnableTrace THEN D.String("resolve "); D.String(translation.name^); D.String(":"); D.String(translation.str^); END;
+					IF interpreter.TranslateString("?", translation.str^,  str) THEN
+						IF EnableTrace THEN D.String(":"); D.Str(str^); END;
+						scope.object.Get(translation.name^, -1, content);
+						IF ~content.Equals(str^) THEN
+							changed := TRUE;
+							content.SetAsString(str^);
+						END;
+						scope.object.Set(translation.name^, -1, content);
+					ELSE
+						IF EnableTrace THEN D.String(":could not resolve"); END;
+					END;
+					IF EnableTrace THEN D.Ln; END;
+					translation := translation.next
+				END;
+
+				scope.object.Enumerate(Traverse);
+
+				current := prev;
+			END;
+		END DoResolve;
+
+		PROCEDURE Resolve*(scope: InterpreterSymbols.Scope);
+		BEGIN
+			REPEAT
+				changed := FALSE;
+				resolved.Clear();
+				DoResolve(scope);
+			UNTIL ~changed;
+		END Resolve;
+
+	END Resolver;
+
+VAR global-: Scope;
+
+PROCEDURE Statements*(context: Commands.Context);
+VAR scanner: Scanner.Scanner; parser: Parser; diagnostics: Diagnostics.StreamDiagnostics;
+	seq: SyntaxTree.StatementSequence; interpreter: Interpreter;
+BEGIN
+	NEW(diagnostics, context.error);
+	scanner := Scanner.NewScanner("",context.arg,0,diagnostics);
+	NEW(parser, scanner, diagnostics);
+	seq := parser.StatementSequence(NIL);
+	NEW(interpreter, global, diagnostics,context); interpreter.StatementSequence(seq);
+END Statements;
+
+PROCEDURE Expression*(context: Commands.Context);
+VAR scanner: Scanner.Scanner; parser: Parser; diagnostics: Diagnostics.StreamDiagnostics;
+	interpreter: Interpreter; value: Value; expression: SyntaxTree.Expression;
+BEGIN
+	NEW(diagnostics, context.error);
+	scanner := Scanner.NewScanner("",context.arg,0,diagnostics);
+	NEW(parser, scanner, diagnostics);
+	expression := parser.Expression();
+	NEW(interpreter, global, diagnostics,NIL);
+	IF interpreter.GetValue(expression, value) THEN
+		value(InterpreterSymbols.Value).WriteValue(context.out); context.out.Ln
+	ELSE
+		context.error.String("could not evaluate expression"); context.error.Ln
+	END;
+END Expression;
+
+PROCEDURE TranslateString*(context: Commands.Context);
+VAR dest: Strings.String; testString: ARRAY 256 OF CHAR; interpreter: Interpreter; streamDiagnostics: Diagnostics.StreamDiagnostics;
+BEGIN
+	NEW(streamDiagnostics, context.error);
+	NEW(interpreter, global, streamDiagnostics,NIL);
+	WHILE context.arg.GetString(testString) DO
+		IF interpreter.TranslateString("?", testString, dest) THEN
+			context.out.String("RESULT: ");
+			context.out.String(dest^);
+			context.out.Ln;
+		ELSE
+			context.error.String("could not translate: ");
+			context.error.String(dest^);
+			context.error.Ln;
+		END;
+	END;
+END TranslateString;
+
+PROCEDURE InitGlobalScope;
+VAR container: Container;
+BEGIN
+	NEW(container);
+	NEW(global, NIL, container);
+END InitGlobalScope;
+
+BEGIN
+	InitGlobalScope;
+END FoxInterpreter.
+
+SystemTools.Free FoxInterpreter FoxInterpreterSymbols ~
+
+FoxInterpreter.Statements
+	FOR i := 1 TO 100 DO
+		CASE i MOD 10 OF
+		1: suffix := "st"
+		|2: suffix := "nd"
+		|3: suffix := "rd"
+		ELSE suffix := "th"
+		END;
+		IF i MOD 9 = 0 THEN
+			CMD SystemTools.Show This is the ?{i}?{suffix} run. ;
+			CMD SystemTools.Ln;
+		END;
+	END;
+~
+FoxInterpreter.Expression
+	i MOD 10  ~
+
+
+
+FoxInterpreter.Statements
+	s := {0..10, 15};
+	a := 10;
+	b := 10..20;
+	c := {a,b};
+	x := 10;
+	y := 20;
+	z := x;
+	z := x + y;
+	b := x = y;
+	nb := x # y;
+	FOR i := 0 TO 3 DO
+		a := i;
+		IF i<2 THEN
+			a := 200+i;
+		END;
+		CASE i OF
+		0: a := 2000;
+		|2: HALT(100)
+		END;
+	END;
+	~
+	TRACE(x);
+
+	FOR i := 0 TO 100 DO
+		x[i] := i
+	END;
+	~
+
+FoxInterpreter.TranslateString
+	"This is a string ?{15+2*20*a:32}? oha."
+	"The rest of this string will be evaluated ?{3+5 = 20}?"
+	"?{ 100*15"
+	"a set in a evaluated expression ?{{1,2,4}}?"
+	~
+
+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]}? ;"+\
+	END;
+		CMD \+"SystemTools.Ln;"+\
+	END;
+	CMD \+"SystemTools.Show ?{a}? "+\
+	~
+
+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

@@ -0,0 +1,675 @@
+MODULE FoxInterpreterSymbols; (** AUTHOR ""; PURPOSE ""; *)
+
+IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects;
+
+CONST
+	MaxIndex = 8;
+	TAB = 09X;
+TYPE
+
+	Item*= PersistentObjects.Object;
+
+	Address*= RECORD
+		object*: Item;
+		in*: Item;
+		name*: StringPool.Index;
+		i*: ARRAY MaxIndex OF LONGINT; (* indices if applicable *)
+	END;
+
+	Value* = OBJECT (Item)
+
+		PROCEDURE & InitValue;
+		BEGIN InitObject
+		END InitValue;
+
+		PROCEDURE WriteValue*(w: Streams.Writer);
+		BEGIN
+		END WriteValue;
+
+		PROCEDURE GetString*(VAR w: ARRAY OF CHAR);
+		VAR stringWriter: Streams.StringWriter;
+		BEGIN
+			NEW(stringWriter, 128);
+			WriteValue(stringWriter); stringWriter.Update;
+			stringWriter.Get(w);
+		END GetString;
+
+
+	END Value;
+
+	CONST StrValue="value";
+	TYPE
+
+	IntegerValue*=OBJECT(Value)
+	VAR value*: LONGINT;
+
+		PROCEDURE & InitInteger*(value: LONGINT);
+		BEGIN InitValue; SELF.value := value; type := "IntegerValue";
+		END InitInteger;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		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;
+
+	END IntegerValue;
+
+	RealValue*=OBJECT(Value)
+	VAR value*: LONGREAL;
+
+		PROCEDURE & InitReal*(value: LONGREAL);
+		BEGIN InitValue; SELF.value := value; type := "RealValue";
+		END InitReal;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetFloat(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN w.Float(value,40);
+		END WriteValue;
+
+
+	END RealValue;
+
+	BooleanValue*=OBJECT(Value)
+	VAR value*: BOOLEAN;
+
+		PROCEDURE & InitBoolean*(value: BOOLEAN);
+		BEGIN InitValue; SELF.value := value; type := "BooleanValue";
+		END InitBoolean;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetBoolean(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN IF value THEN w.String("TRUE") ELSE w.String("FALSE") END
+		END WriteValue;
+
+	END BooleanValue;
+
+	StringValue*=OBJECT(Value)
+	VAR value*: Strings.String;
+
+		PROCEDURE & InitString*(CONST value: ARRAY OF CHAR);
+		BEGIN InitValue; SELF.value := Strings.NewString(value); type := "StringValue";
+		END InitString;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetString(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN (*w.String('"');*) w.String(value^); (*w.String('"');*)
+		END WriteValue;
+
+	END StringValue;
+
+
+	SetValue*=OBJECT(Value)
+	VAR value*: SET;
+
+		PROCEDURE & InitSet*(value: SET);
+		BEGIN InitValue; SELF.value := value; type := "SetValue"
+		END InitSet;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetSet(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN
+			w.Set(value)
+		END WriteValue;
+
+	END SetValue;
+
+	RangeValue*=OBJECT(Value)
+	VAR value*: RANGE;
+
+		PROCEDURE & InitRange*(r: RANGE);
+		BEGIN InitValue; value := r; type := "RangeValue"
+		END InitRange;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetRange(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN
+			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;
+
+	END RangeValue;
+
+	CharValue*=OBJECT(Value)
+	VAR value: CHAR;
+
+		PROCEDURE & InitChar*(c: CHAR);
+		BEGIN InitValue; value := c; type := "CharValue";
+		END InitChar;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetChar(value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		BEGIN
+			w.Hex(ORD(value),2); w.String("X");
+		END WriteValue;
+
+	END CharValue;
+
+	EnumValue*=OBJECT(Value)
+	VAR value: LONGINT; translation: PersistentObjects.Translation;
+
+		PROCEDURE & InitEnumValue*(trans: PersistentObjects.Translation; v: LONGINT);
+		BEGIN InitValue; value := v;  translation := trans; type := "EnumValue";
+		END InitEnumValue;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetEnum(translation, value);
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE WriteValue(w: Streams.Writer);
+		VAR str: ARRAY 32 OF CHAR;
+		BEGIN
+			IF translation.Name(value, str) THEN w.String(str) ELSE w.String("unknown") END;
+		END WriteValue;
+
+	END EnumValue;
+
+	MathArrayValue*=OBJECT(Value)
+	VAR values: ARRAY [*] OF Value;
+
+		PROCEDURE &InitMathArrayValue*(len: LONGINT);
+		BEGIN
+			InitValue;
+			NEW(values, len);
+			type := "MathArrayValue";
+		END InitMathArrayValue;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		BEGIN Enumerate^(enum); enum(StrValue,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		BEGIN
+			IF name = StrValue THEN c.SetObject(values[index],"Value");
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE SetValue*(at: LONGINT; value: Value);
+		BEGIN
+			values[at] := value;
+		END SetValue;
+
+		PROCEDURE GetValue*(at: LONGINT): Value;
+		BEGIN
+			RETURN values[at]
+		END GetValue;
+
+		PROCEDURE WriteValue*(w: Streams.Writer);
+		VAR i: LONGINT; max: LONGINT;
+		BEGIN
+			w.String("[ ");
+			max := LEN(values,0)-1;
+			FOR i := 0 TO max  DO
+				values[i].WriteValue(w);
+				IF i < max THEN
+					w.String(", ");
+				END;
+			END;
+			w.String("] ");
+		END WriteValue;
+
+
+	END MathArrayValue;
+
+	(* object value represented as ANY wrapped in Value ? *)
+	Symbol*= OBJECT
+	VAR
+		name: StringPool.Index;
+		item-: Item;
+
+		PROCEDURE & InitSymbol(name: StringPool.Index; index: LONGINT);
+		BEGIN
+			SELF.name := name; SELF.item := item;
+		END InitSymbol;
+
+		PROCEDURE GetName(VAR name: ARRAY OF CHAR);
+		BEGIN
+			StringPool.GetString(SELF.name, name);
+		END GetName;
+
+	END Symbol;
+
+	Container* = OBJECT (Item)
+	VAR
+		symbols-: Basic.List;
+		lookup-: Basic.HashTableInt;
+
+		(* New scope. Note that it is possible that a scope is registered with an alias *)
+		PROCEDURE & InitContainer*;
+		BEGIN
+			InitObject();
+			NEW(lookup, 16); NEW(symbols, 16);
+			type := "Container";
+		END InitContainer;
+
+		PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
+		VAR i: LONGINT; symbol: Symbol; o: ANY; name: ARRAY 256 OF CHAR;
+		BEGIN Enumerate^(enum);
+			FOR i := 0 TO symbols.Length()-1 DO
+				o := symbols.Get(i);
+				symbol := o(Symbol);
+				symbol.GetName(name);
+				enum(name, FALSE);
+			END;
+		END Enumerate;
+
+		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: PersistentObjects.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);
+		VAR item: Item;
+		BEGIN
+			item := Find(name);
+			IF item # NIL THEN c.SetObject(item,"Item")
+			ELSE Get^(name, index, c);
+			END;
+		END Get;
+
+		PROCEDURE GetItem*(index: LONGINT): Item;
+		BEGIN
+			RETURN symbols.Get(index)(Symbol).item
+		END GetItem;
+
+
+		(* Enter a symbol with its name *)
+		PROCEDURE Enter1*(item: Item; name: StringPool.Index);
+		VAR any: ANY; symbol: Symbol;
+		BEGIN
+			any := lookup.Get(name);
+			IF any # NIL THEN
+				symbol := any(Symbol)
+			ELSE
+				NEW(symbol, name, symbols.Length());
+				symbols.Add(symbol);
+				lookup.Put(symbol.name, symbol);
+			END;
+			symbol.item := item
+		END Enter1;
+
+		(* Enter a symbol with its name *)
+		PROCEDURE Enter*(item: Item; CONST name: ARRAY OF CHAR);
+		BEGIN
+			Enter1(item, StringPool.GetIndex1(name))
+		END Enter;
+
+		PROCEDURE Find1*(id: LONGINT): Item;
+		VAR any: ANY;
+		BEGIN
+			any := lookup.Get(id);
+			IF any # NIL THEN RETURN any(Symbol).item ELSE RETURN NIL END
+		END Find1;
+
+		(* Find a symbol with name *)
+		PROCEDURE Find*(CONST name: ARRAY OF CHAR): Item;
+		BEGIN
+			RETURN Find1(StringPool.GetIndex1(name))
+		END Find;
+
+	END Container;
+
+	Scope* = OBJECT
+	VAR
+		outer-: Scope;
+		object-: PersistentObjects.Object;
+		level: LONGINT;
+
+		PROCEDURE & InitScope*(outer: Scope; object: PersistentObjects.Object);
+		BEGIN
+			SELF.outer := outer;
+			IF outer = NIL THEN level := 0 ELSE level := outer.level + 1 END;
+			ASSERT(object # NIL);
+			SELF.object := object
+		END InitScope;
+
+		PROCEDURE Enter*(object: PersistentObjects.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;
+		BEGIN
+			in := SELF.object;
+			object := FindInObject(in, name, index);
+			IF (object = NIL) & (outer # NIL) THEN
+				object := outer.FindObject(name, index, in)
+			END;
+			RETURN object
+		END FindObject;
+
+		PROCEDURE FindObject1*(name: StringPool.Index; index: LONGINT; VAR in: PersistentObjects.Object): PersistentObjects.Object;
+		VAR str: ARRAY 256 OF CHAR;
+		BEGIN
+			StringPool.GetString(name, str);
+			RETURN FindObject(str,index, in);
+		END FindObject1;
+
+		PROCEDURE Leave*(): Scope;
+		BEGIN
+			RETURN outer
+		END Leave;
+
+		PROCEDURE Dump*(log: Streams.Writer);
+		BEGIN
+			IF object # NIL THEN object.Dump(log,"scope object") END;
+			log.Ln;
+			IF outer # NIL THEN outer.Dump(log) END;
+		END Dump;
+
+	END Scope;
+
+
+	PROCEDURE Indent(w: Streams.Writer; level: LONGINT);
+	BEGIN
+		WHILE level> 0 DO w.Char(TAB); DEC(level) END;
+	END Indent;
+
+	PROCEDURE Test*(context: Commands.Context);
+	VAR scope, inner: Scope; container: Container; integer: IntegerValue; float: RealValue; string: StringValue;
+	BEGIN
+		NEW(container);
+		container.Enter(integer, "integer");
+		container.Enter(float,"float");
+		container.Enter(string,"string");
+		NEW(scope, NIL, container);
+		NEW(container);
+		inner := scope.Enter(container);
+		scope.Dump(context.out);
+
+		(*scope.Write(context.out);*)
+	END Test;
+
+	PROCEDURE ContentGetValue(c: PersistentObjects.Content): Value;
+	VAR o: PersistentObjects.Object;
+	BEGIN
+		c.GetObject(o); IF o = NIL THEN RETURN NIL ELSE RETURN o(Value) END;
+	END ContentGetValue;
+
+
+	PROCEDURE NewIntegerValue(value: LONGINT): IntegerValue;
+	VAR obj: IntegerValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewIntegerValue;
+
+	PROCEDURE NewFloatValue(value: LONGREAL): RealValue;
+	VAR obj: RealValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewFloatValue;
+
+	PROCEDURE NewBooleanValue(value: BOOLEAN): BooleanValue;
+	VAR obj: BooleanValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewBooleanValue;
+
+	PROCEDURE NewStringValue(CONST value: ARRAY OF CHAR): StringValue;
+	VAR obj: StringValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewStringValue;
+
+	PROCEDURE NewNameValue(CONST value: ARRAY OF CHAR): StringValue;
+	VAR obj: StringValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewNameValue;
+
+	PROCEDURE NewRangeValue(value: RANGE): RangeValue;
+	VAR obj: RangeValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewRangeValue;
+
+	PROCEDURE NewCharValue(value: CHAR): CharValue;
+	VAR obj: CharValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewCharValue;
+
+	PROCEDURE NewSetValue(value: SET): SetValue;
+	VAR obj: SetValue;
+	BEGIN
+		NEW(obj, value); RETURN obj
+	END NewSetValue;
+
+	PROCEDURE NewEnumValue(translation: PersistentObjects.Translation; value: LONGINT): EnumValue;
+	VAR obj: EnumValue;
+	BEGIN
+		NEW(obj, translation, value);
+	END NewEnumValue;
+
+	PROCEDURE FindInObject*(in: PersistentObjects.Object; CONST name: ARRAY OF CHAR; index: LONGINT): PersistentObjects.Object;
+	VAR content: PersistentObjects.Content;
+	TYPE Class=PersistentObjects.Class;
+	BEGIN
+		NEW(content);
+		in.Get(name, index, content);
+		IF content.success THEN
+			CASE content.class OF
+				|Class.String: RETURN NewStringValue(content.string^);
+				|Class.Object: RETURN content.object
+				|Class.Name: RETURN NewNameValue(content.name);
+				|Class.Boolean: RETURN NewBooleanValue(content.boolean);
+				|Class.Integer: RETURN NewIntegerValue(content.integer);
+				|Class.Float: RETURN NewFloatValue(content.float);
+				|Class.Enum: RETURN NewEnumValue(content.translation,content.integer)
+				|Class.Range: RETURN NewRangeValue(content.range)
+				|Class.Set: RETURN NewSetValue(content.set)
+				|Class.Char: RETURN NewCharValue(content.char)
+			END
+		END;
+		RETURN NIL
+	END FindInObject;
+
+	TYPE
+	ObjectFilter* = OBJECT
+	VAR
+		content: PersistentObjects.Content;
+		object: PersistentObjects.Object;
+		found: Container;
+		attribute, value: ARRAY 256 OF CHAR;
+
+		PROCEDURE & InitObjectFilter*;
+		BEGIN
+			NEW(content); NEW(found);
+		END InitObjectFilter;
+
+		PROCEDURE AddFiltered(obj: PersistentObjects.Object);
+		BEGIN
+			IF obj # NIL THEN
+				obj.Get(attribute, -1, content);
+				IF content.success & content.Equals(value) THEN
+					found.Enter(obj,"any");
+				END;
+			END;
+		END AddFiltered;
+
+		PROCEDURE Enumerate(CONST name: ARRAY OF CHAR; array: BOOLEAN);
+		VAR obj: PersistentObjects.Object; index: LONGINT;
+		BEGIN
+			object.Get(name,-1, content);
+			IF content.success & (content.class = PersistentObjects.Class.Object) THEN
+				IF array THEN
+					index := 0;
+					REPEAT
+						object.Get(name, index, content);
+						obj := content.object;
+						AddFiltered(obj);
+						INC(index);
+					UNTIL obj = NIL;
+				ELSE
+					AddFiltered(content.object)
+				END;
+			END;
+		END Enumerate;
+
+		PROCEDURE Filter*(obj: PersistentObjects.Object; attribute, value: ARRAY OF CHAR): Container;
+		BEGIN
+			NEW(found);
+			object := obj;
+			COPY(attribute, SELF.attribute);
+			COPY(value, SELF.value);
+			obj.Enumerate(Enumerate);
+			RETURN found
+		END Filter;
+
+	END ObjectFilter;
+
+	PROCEDURE FindInObject1*(in: PersistentObjects.Object; name: StringPool.Index; index: LONGINT): PersistentObjects.Object;
+	VAR str: ARRAY 256 OF CHAR;
+	BEGIN
+		StringPool.GetString(name, str);
+		RETURN FindInObject(in,str,index);
+	END FindInObject1;
+
+END FoxInterpreterSymbols.
+
+SystemTools.FreeDownTo FoxInterpreterSymbols ~
+FoxInterpreterSymbols.Test ~

source/InterpreterShell.Mod

@@ -0,0 +1,739 @@
+MODULE InterpreterShell; (** AUTHOR "be"; PURPOSE "Simple command shell" **)
+(**
+ * Simple echo-based command shell.
+ *
+ * History:
+ *
+ *	16.05.2006	Added command history, backspace key handling, factored out serial port related code into ShellSerials.Mod (staubesv)
+ *
+ *)
+
+IMPORT Modules, Commands, Streams, Pipes, Strings, Files, Interpreter := FoxInterpreter, Diagnostics, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Printout := FoxPrintout, InterpreterSymbols := FoxInterpreterSymbols;
+
+CONST
+	(* Notify procedure command codes *)
+	ExitShell* = 1;
+	Clear* = 2;
+
+	Version = "InterpreterShell v1.0";
+
+	DefaultAliasFile = "Shell.Alias";
+
+	NestingLevelIndicator = ">";
+
+	MaxLen = 512;
+	CmdLen = 64;
+	ParamLen = MaxLen;
+	CR = 0DX; LF = 0AX; TAB = 9X;
+	Backspace = 08X;
+	Space = 20X;
+	Delete = 7FX;
+	Escape = 1BX;
+
+	EscapeChar1 = Escape;
+	EscapeChar2 = '[';
+
+	(* Non-ASCII characters *)
+	CursorUp = 0C1X;
+	CursorDown = 0C2X;
+
+	(* symbols *)
+	start = {};
+	inputFile = {0};	 			(* 01H *)
+	pipe = {1};					(* 02H *)
+	outputFile = {2};				(* 04H *)
+	outputFileAppend = {3};		(* 08H *)
+	ampersand = {4};			(* 10H *)
+	whitespace = {5};			(* 20H *)
+	eoln = {6};					(* 40H *)
+	char = {7};					(* 80H *)
+	EndOfParam = pipe + inputFile + outputFile + outputFileAppend + ampersand + eoln;
+
+	(* errors *)
+	ErrFileNotFound = 1;
+	ErrInvalidFilename = 2;
+	ErrAlreadyPiped = 3;
+	ErrPipeAtBeginning = 4;
+	ErrInvalidCommand = 5;
+	ErrEolnExpected = 6;
+
+TYPE
+	CommandsString = POINTER TO RECORD
+		prev, next: CommandsString;
+		string: ARRAY MaxLen OF CHAR;
+	END;
+
+	CommandHistory = OBJECT
+	VAR
+		first, current: CommandsString;
+
+		PROCEDURE GetNextCommand(VAR cmd : ARRAY OF CHAR);
+		BEGIN
+			IF first = NIL THEN RETURN END;
+			IF current = NIL THEN current := first ELSE current := current.next END;
+			COPY(current.string, cmd);
+		END GetNextCommand;
+
+		PROCEDURE GetPreviousCommand(VAR cmd : ARRAY OF CHAR);
+		BEGIN
+			IF first = NIL THEN RETURN END;
+			IF current = NIL THEN current := first.prev ELSE current := current.prev END;
+			COPY(current.string, cmd);
+		END GetPreviousCommand;
+
+		PROCEDURE AddCommand(CONST cmd : ARRAY OF CHAR);
+		VAR command: CommandsString;
+		BEGIN
+			IF (cmd = "") THEN (* Don't add to history *) RETURN; END;
+			command := first;
+			IF command # NIL THEN
+				WHILE (command.string # cmd) & (command.next # first) DO command := command.next END;
+				IF command.string # cmd THEN command := NIL END
+			END;
+			IF command # NIL THEN
+				IF first = command THEN first := command.next END;
+				command.prev.next := command.next;
+				command.next.prev := command.prev;
+			ELSE
+				NEW (command);
+				COPY (cmd, command.string);
+			END;
+			IF first = NIL THEN
+				first := command; first.next := first; first.prev := first
+			ELSE
+				command.prev := first.prev; command.next := first;
+				first.prev.next := command; first.prev := command;
+			END;
+			current := NIL;
+		END AddCommand;
+
+		PROCEDURE &Init*;
+		BEGIN first := NIL; current := NIL;
+		END Init;
+
+	END CommandHistory;
+
+TYPE
+
+	Command = POINTER TO RECORD
+		command: ARRAY CmdLen OF CHAR;			(* command (e.g. <module>"."<command> *)
+		parameters: ARRAY ParamLen OF CHAR;	(* parameters *)
+		context: Commands.Context;	(* context (in, out & err streams *)
+		pipe : Pipes.Pipe;
+		next: Command;
+	END;
+
+	Alias = POINTER TO RECORD
+		alias,
+		command: ARRAY CmdLen OF CHAR;
+		parameters: ARRAY ParamLen OF CHAR;
+		next: Alias;
+	END;
+
+	NotifyProcedure* = PROCEDURE {DELEGATE} (command : LONGINT);
+
+TYPE
+
+	(*
+	Blocker* = OBJECT (Streams.Writer)
+	VAR
+		interpreter: Interpreter.Interpreter; i: LONGINT;
+		parser: Interpreter.Parser;
+		reader-: Streams.Reader;
+		writer-: Streams.Writer;
+		scanner: Scanner.Scanner;
+		diagnostics: Diagnostics.StreamDiagnostics;
+
+
+		PROCEDURE & InitBlocker(context: Commands.Context);
+		VAR pipe: Pipes.Pipe;
+		BEGIN
+			TRACE(1);
+			NEW(diagnostics, context.error);
+			TRACE(2);
+			NEW(pipe, 256);
+			TRACE(3);
+			NEW(reader, pipe.Receive, 256);
+			TRACE(4);
+			NEW(writer, pipe.Send, 256);
+		END InitBlocker;
+
+		PROCEDURE Statements;
+		VAR statement: SyntaxTree.Statement; statements: SyntaxTree.StatementSequence;
+		BEGIN
+			NEW(scanner, "", reader, 0, diagnostics);
+			TRACE(6);
+			NEW(parser, scanner, diagnostics);
+			TRACE(7);
+			statements := SyntaxTree.NewStatementSequence();
+			LOOP
+			WHILE  parser.Statement(statements, NIL) DO TRACE("parser statement");
+				IF parser.Optional(Scanner.Semicolon) THEN END;
+			END;
+			TRACE("failure");
+			END;
+		END Statements;
+
+
+	BEGIN{ACTIVE}
+		Statements
+	END Blocker;
+	*)
+
+	Shell* = OBJECT
+	VAR
+		echo, dead, close: BOOLEAN;
+		context: Commands.Context;
+		command: ARRAY MaxLen OF CHAR;
+		res: LONGINT;
+		nestingLevel : LONGINT; (* how many shells run in this shell? *)
+		aliases: Alias;
+		prompt: ARRAY 32 OF CHAR;
+
+		(* Connection to the entiry hosting this shell instance *)
+		upcall : NotifyProcedure;
+
+		commandHistory : CommandHistory;
+
+		PROCEDURE &Init*(in: Streams.Reader; out, err: Streams.Writer; echo: BOOLEAN; CONST prompt: ARRAY OF CHAR);
+		BEGIN
+			ASSERT((in # NIL) & (out # NIL) & (err # NIL));
+			NEW(context, in, NIL, out, err, SELF);
+			close := FALSE; dead := FALSE; command[0] := 0X; res := 0; SELF.echo := echo; COPY(prompt, SELF.prompt);
+			NEW(commandHistory);
+		END Init;
+
+		PROCEDURE Exit*;
+		BEGIN
+			close := TRUE;
+		END Exit;
+
+		PROCEDURE DeleteStringFromDisplay(CONST x : ARRAY OF CHAR);
+		VAR i, len : LONGINT;
+		BEGIN
+			len := Strings.Length(x);
+			FOR i :=	 0 TO len-1 DO context.out.Char(Backspace); END;
+			FOR i :=	 0 TO len-1 DO context.out.Char(Space); END;
+			FOR i :=	 0 TO len-1 DO context.out.Char(Backspace); END;
+		END DeleteStringFromDisplay;
+
+		PROCEDURE ReadCommand(w: Streams.Writer);
+		VAR
+			ch: CHAR;
+			currentIndex : LONGINT;
+
+			PROCEDURE IsAsciiCharacter(ch : CHAR) : BOOLEAN;
+			BEGIN
+				RETURN ORD(ch) <= 127;
+			END IsAsciiCharacter;
+
+			PROCEDURE IsControlCharacter(ch : CHAR) : BOOLEAN;
+			BEGIN
+				RETURN ORD(ch) < 32;
+			END IsControlCharacter;
+
+			PROCEDURE HandleEscapeSequence;
+			BEGIN
+				ch := context.in.Get();
+				ch := CHR(ORD(ch)+128);
+
+				IF (ch = CursorDown) OR (ch = CursorUp) THEN (* Command History Keys *)
+
+					command[currentIndex+1] := 0X;
+					DeleteStringFromDisplay(command);
+
+					IF ch = CursorUp THEN
+						commandHistory.GetPreviousCommand(command);
+					ELSE
+						commandHistory.GetNextCommand(command);
+					END;
+					currentIndex := Strings.Length(command)-1;
+					IF echo & (command # "") THEN context.out.String(command); context.out.Update; END;
+				ELSE
+					(* ignore escaped character *)
+				END;
+			END HandleEscapeSequence;
+
+		BEGIN
+			command := ""; currentIndex := -1;
+
+			LOOP
+				ch := context.in.Get();
+				TRACE(ORD(ch), ch);
+				IF IsAsciiCharacter(ch) THEN
+
+					IF IsControlCharacter(ch) OR (ch = Delete) THEN
+
+						IF (ch = Streams.EOT) OR (context.in.res # Streams.Ok) THEN
+							EXIT
+						ELSIF (ch = Backspace) OR (ch = Delete)THEN
+							IF currentIndex >= 0 THEN (* There is a character at the left of the cursor *)
+								IF command[currentIndex] = CR THEN
+									context.out.Char(Backspace); context.out.Char(Space); context.out.Char(Backspace); context.out.Update;
+								END;
+								command[currentIndex] := 0X;
+								DEC(currentIndex);
+								IF echo THEN
+									context.out.Char(Backspace); context.out.Char(Space); context.out.Char(Backspace); context.out.Update;
+								END;
+							END;
+						ELSIF (ORD(ch) = 03H) THEN
+						(*	IF runner # NIL THEN AosActive.TerminateThis(runner); END; *)
+						ELSIF (ch = EscapeChar1) THEN (* Escape sequence *)
+							IF context.in.Peek() = EscapeChar2 THEN ch := context.in.Get(); HandleEscapeSequence;
+							ELSIF context.in.Peek() = 0DX THEN (* command *)
+								ch := context.in.Get();
+								EXIT;
+							ELSIF context.in.Peek () = Escape THEN
+								command[currentIndex+1] := 0X;
+								DeleteStringFromDisplay (command); context.out.Update;
+								ch := context.in.Get (); command := ""; currentIndex := -1;
+							END;
+						ELSIF (ch =CR) OR (ch = LF) THEN
+							INC(currentIndex); command[currentIndex] := ch;
+							IF (ch = CR) & (context.in.Available() > 0) & (context.in.Peek() = LF) THEN
+								ch := context.in.Get();
+								INC(currentIndex); command[currentIndex] := ch;
+							 END;
+							IF echo THEN context.out.Ln; context.out.Update END;
+						ELSE
+							INC(currentIndex);
+							command[currentIndex] := ch;
+							IF echo THEN context.out.Char(ch); context.out.Update; END;
+						END;
+					ELSE
+						IF currentIndex <= LEN(command) - 2 (* Always need space for 0X *) THEN
+							INC(currentIndex);
+							command[currentIndex] := ch;
+							IF echo THEN context.out.Char(ch); context.out.Update; END;
+						END;
+					END;
+
+				ELSE
+					(* ignore non-ascii characters *)
+				END;
+			END;
+
+			command[currentIndex+1] := 0X;
+
+			IF ch = CR THEN
+				commandHistory.AddCommand(command);
+				IF (context.in.Available() > 0) & (context.in.Peek() = LF) THEN ch := context.in.Get() END;
+				(* IF echo THEN context.out.Ln; context.out.Update END; *)
+				w.String(command);
+			END;
+		END ReadCommand;
+		(*
+		PROCEDURE Parse(VAR cmd: Command; VAR wait: BOOLEAN): LONGINT;
+		VAR sym: SET; pos: LONGINT; c, next: CHAR;
+
+			PROCEDURE Init;
+			BEGIN
+				pos := 0; c := 0X; next := command[pos]; sym := start; Scan
+			END Init;
+
+			PROCEDURE Scan;
+			BEGIN
+				IF (sym # eoln) THEN
+					c := next; INC(pos); next := command[pos];
+					CASE c OF
+					| "<": sym := inputFile
+					| "|": sym := pipe
+					| ">": IF (next = ">") THEN sym := outputFileAppend; INC(pos); next := command[pos]; ELSE sym := outputFile END
+					| "&": sym := ampersand
+					| " ", 09X: sym := whitespace
+					| 0X: sym := eoln
+					ELSE sym := char
+					END
+				END
+			END Scan;
+
+			PROCEDURE Match(symbol: SET): BOOLEAN;
+			BEGIN IF (symbol = sym) THEN Scan; RETURN TRUE ELSE RETURN FALSE END
+			END Match;
+
+			PROCEDURE Skip;
+			BEGIN
+				WHILE (sym = whitespace) & (sym # eoln) DO Scan END
+			END Skip;
+
+			PROCEDURE Token(VAR s: ARRAY OF CHAR; cond: SET): BOOLEAN;
+			VAR i: LONGINT; quote: BOOLEAN;
+			BEGIN
+				quote := FALSE;
+				WHILE (sym * cond = {}) OR (quote & (sym # eoln)) DO
+					s[i] := c; INC(i); IF (c = '"') OR (c = "'") THEN quote := ~quote END; Scan
+				END;
+				s[i] := 0X;
+				RETURN ~quote
+			END Token;
+
+			PROCEDURE Cmd(): Command;
+			VAR i: LONGINT; cmd: Command; arg : Streams.StringReader;
+			BEGIN Skip;
+				IF (sym = char) THEN
+					NEW(cmd);
+					i := 0;
+					WHILE (sym = char) DO cmd.command[i] := c; INC(i); Scan END; cmd.command[i] := 0X; Skip;
+					IF (cmd.command # "") THEN
+						IF (sym * EndOfParam = {}) THEN
+							IF ~Token(cmd.parameters, EndOfParam) THEN cmd := NIL END
+						END;
+						REPEAT UNTIL ~ReplaceAlias(cmd);
+						NEW(arg, LEN(cmd.parameters)); arg.SetRaw(cmd.parameters, 0, LEN(cmd.parameters));
+						NEW(cmd.context, context.in, arg, context.out, context.error, SELF);
+					ELSE cmd := NIL	(* invalid command (empty string) *)
+					END
+				ELSE cmd := NIL
+				END;
+				RETURN cmd
+			END Cmd;
+
+			PROCEDURE CmdLine(VAR command: Command): LONGINT;
+			VAR cmd, prev: Command; fn: Files.FileName; f: Files.File; fr: Files.Reader; fw: Files.Writer;
+				r: Streams.Reader; w: Streams.Writer; append, piped: BOOLEAN; s: ARRAY 64 OF CHAR;
+			BEGIN
+				cmd := NIL; prev := NIL; command := NIL; res := 0; piped := FALSE;
+				Init;
+				REPEAT
+					cmd := Cmd();
+					IF (cmd # NIL) THEN
+						IF (command = NIL) THEN command := cmd END;
+						IF piped THEN
+							piped := FALSE;
+							IF (prev # NIL) THEN
+								IF (prev.context.out = context.out) & (cmd.context.in = context.in) THEN
+									NEW(prev.pipe, 1024);
+									Streams.OpenReader(r, prev.pipe.Receive); Streams.OpenWriter(w, prev.pipe.Send);
+									prev.context.Init(r, prev.context.arg, w, prev.context.error, SELF);
+									prev.next := cmd
+								ELSE  res := ErrAlreadyPiped (* already piped *)
+								END
+							ELSE res := ErrPipeAtBeginning (* pipe cannot be first symbol *)
+							END
+						END;
+
+						IF Match(inputFile) THEN (* "<" filename *)
+							IF (cmd.context.in = context.in) THEN
+								Skip;
+								IF Token(fn, -char) & (fn # "") THEN
+									f := Files.Old(fn);
+									IF (f # NIL) THEN
+										Files.OpenReader(fr, f, 0);
+										cmd.context.Init(fr, cmd.context.arg, cmd.context.out, cmd.context.error, SELF)
+									ELSE res := ErrFileNotFound (* file not found *)
+									END
+								ELSE res := ErrInvalidFilename (* invalid filename *)
+								END
+							ELSE res := ErrAlreadyPiped (* error: already piped *)
+							END
+						ELSIF Match(pipe) THEN (* "|" command *)
+							piped := TRUE
+						END;
+						prev := cmd
+					ELSE res := ErrInvalidCommand (* invalid command *)
+					END
+				UNTIL (res # 0) OR (cmd = NIL) OR ~piped;
+				IF (res = 0) THEN
+					IF (sym * (outputFile+outputFileAppend) # {}) THEN (* ">"[">"] filename *)
+						append := (sym = outputFileAppend);
+						Scan; Skip;
+						IF Token (fn, EndOfParam (*-char *)) & (fn # "") THEN
+							Skip; f := NIL;
+							IF append THEN f := Files.Old(fn) END;
+							IF (f = NIL) THEN f := Files.New(fn); Files.Register(f) END;
+							IF (f # NIL) THEN
+								IF append THEN
+									Files.OpenWriter(fw, f, f.Length());
+								ELSE
+									Files.OpenWriter(fw, f, 0);
+								END;
+								cmd.context.Init(cmd.context.in, cmd.context.arg, fw, cmd.context.error, SELF);
+								fw.Update;
+							ELSE res := ErrFileNotFound (* cannot open output file *)
+							END
+						ELSE res := ErrInvalidFilename (* invalid filename *)
+						END
+					END
+				END;
+				IF (res = 0) THEN
+					wait := ~Match(ampersand);
+					WHILE (sym # eoln) & Match(whitespace) DO END;
+					IF ~Match(eoln) THEN res := ErrEolnExpected END (* end of line expected *)
+				END;
+				IF (res # 0) THEN
+					context.error.String("Error at position "); context.error.Int(pos, 0); context.error.String(": ");
+					CASE res OF
+					| ErrFileNotFound: COPY("file not found.", s)
+					| ErrInvalidFilename: COPY("invalid file name.", s)
+					| ErrAlreadyPiped: COPY("two input streams.", s)
+					| ErrPipeAtBeginning: COPY("syntax error.", s)
+					| ErrInvalidCommand: COPY("invalid command.", s)
+					| ErrEolnExpected: COPY("too many arguments.", s)
+					ELSE COPY("unknown error.", s)
+					END;
+					context.error.String(s); context.error.Ln; context.error.Update;
+					command := NIL
+				END;
+				RETURN res
+			END CmdLine;
+
+		BEGIN
+			wait := TRUE;
+			RETURN CmdLine(cmd)
+		END Parse;
+	*)
+		PROCEDURE ReadAlias(cmd : Command; verbose : BOOLEAN);
+		VAR s: ARRAY MaxLen OF CHAR; alias, p, q: Alias; i, k: LONGINT; c: CHAR;
+		BEGIN
+			IF (cmd.parameters # "") THEN
+				COPY(cmd.parameters, s);
+				NEW(alias);
+				i := 0; c := s[i];
+				WHILE (c # 0X) & (c # "=") DO alias.alias[i] := c; INC(i); c := s[i] END;
+				IF (c = "=") THEN
+					k := 0; INC(i); c := s[i];
+					WHILE (c # 0X) & (c # " ") & (c # TAB) DO alias.command[k] := c; INC(k); INC(i); c := s[i] END;
+				END;
+
+				IF verbose THEN context.out.String(alias.alias); END;
+				IF (alias.command # "") THEN (* add an alias *)
+					WHILE (c # 0X) & ((c = " ") OR (c = TAB)) DO INC(i); c := s[i] END;
+					k := 0;
+					WHILE (c # 0X) DO alias.parameters[k] := c; INC(k); INC(i); c := s[i] END;
+					p := aliases; q := NIL;
+					WHILE (p # NIL) & (p.alias < alias.alias) DO q := p; p := p.next END;
+					IF (q = NIL) THEN aliases := alias; aliases.next := p
+					ELSE q.next := alias; alias.next := p
+					END;
+					IF verbose THEN
+						context.out.String(" = "); context.out.String(alias.command); context.out.Char(" "); context.out.String(alias.parameters);
+					END;
+				ELSE (* remove an alias *)
+					p := aliases; q := NIL;
+					WHILE (p # NIL) & (p.alias < alias.alias) DO q := p; p := p.next END;
+					IF (p # NIL) & (p.alias = alias.alias) THEN
+						IF (q = NIL) THEN aliases := aliases.next
+						ELSE q.next := p.next
+						END
+					END;
+					IF verbose THEN context.out.String(" removed"); END;
+				END;
+				IF verbose THEN context.out.Ln; END;
+			ELSE (* list aliases *)
+				p := aliases;
+				WHILE (p # NIL) DO
+					IF verbose THEN
+						context.out.String(p.alias); context.out.String(" = "); context.out.String(p.command); context.out.Char(" ");
+						context.out.String(p.parameters); context.out.Ln;
+					END;
+					p := p.next
+				END
+			END
+		END ReadAlias;
+		(*
+		PROCEDURE ReplaceAlias(cmd: Command): BOOLEAN;
+		VAR a: Alias; d, i: LONGINT;
+		BEGIN
+			a := aliases;
+			WHILE (a # NIL) & (a.alias < cmd.command) DO a := a.next END;
+			IF (a # NIL) & (a.alias = cmd.command) THEN
+				COPY(a.command, cmd.command);
+				IF (a.parameters # "") THEN
+					IF (cmd.parameters = "") THEN COPY(a.parameters, cmd.parameters)
+					ELSE
+						d := Strings.Length(a.parameters) + 1;
+						FOR i := Strings.Length(cmd.parameters) TO 0 BY -1 DO
+							cmd.parameters[i+d] := cmd.parameters[i]
+						END;
+						FOR i := 0 TO d-2 DO cmd.parameters[i] := a.parameters[i] END;
+						cmd.parameters[d-1] := " "
+					END
+				END;
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END
+		END ReplaceAlias;
+
+		PROCEDURE ShowHelp;
+		BEGIN
+			context.out.String("--- Help --- "); context.out.Ln;
+			context.out.String("alias: Show list of aliases"); context.out.Ln;
+			context.out.String("alias 'string'='command': Create alias for command"); context.out.Ln;
+			context.out.String("alias 'string': Remove alias"); context.out.Ln;
+			context.out.String("batch: start a new instance of Shell"); context.out.Ln;
+			context.out.String("clear: Clear screen"); context.out.Ln;
+			context.out.String("version: Show BimboShell version"); context.out.Ln;
+			context.out.String("help: Show this help text"); context.out.Ln;
+			context.out.String("exit: Exit Shell"); context.out.Ln;
+			context.out.Update;
+		END ShowHelp;
+
+		PROCEDURE Execute(cmd: Command; wait: BOOLEAN; VAR exit: BOOLEAN);
+		VAR
+			c: Command; flags: SET;
+			res : LONGINT; msg: ARRAY MaxLen OF CHAR; oldContext: Commands.Context;
+			moduleName, commandName : Modules.Name; errormsg : ARRAY 128 OF CHAR;
+		BEGIN
+			IF (cmd.command = "alias") THEN
+				ReadAlias(cmd, TRUE)
+			ELSIF (cmd.command = "loadalias") THEN
+				LoadAliasesFromFile(cmd.parameters);
+			ELSIF (cmd.command = "batch") THEN
+				context.out.String(Version); context.out.Ln; context.out.Update;
+				oldContext := context; context := cmd.context;
+				INC(nestingLevel);
+				Run;
+				context := oldContext
+			ELSIF (cmd.command = "exit") THEN
+				DEC(nestingLevel);
+				exit := TRUE
+			ELSIF (cmd.command = "version") THEN
+				context.out.String(Version); context.out.Ln; context.out.Update;
+			ELSIF (cmd.command = "help") THEN
+				ShowHelp;
+			ELSIF (cmd.command = "clear") THEN
+				IF upcall # NIL THEN upcall(Clear); END;
+			ELSE
+				c := cmd; res := 0;
+				WHILE (c # NIL) & (res = 0) DO
+					IF (c.next = NIL) & wait THEN flags := {Commands.Wait}
+					ELSE flags := {}
+					END;
+					Commands.Split(c.command, moduleName, commandName, res, errormsg);
+					IF (res # Commands.Ok) THEN
+						context.error.String(errormsg); context.error.Ln;
+					ELSE
+						Commands.Activate(c.command, c.context, flags, res, msg);
+				(*		IF wait & (cmd.pipe # NIL) THEN
+							KernelLog.String("Pipe closed"); KernelLog.Ln;
+							cmd.pipe.Close;
+						END; *)
+						IF (res # 0) THEN
+							context.error.String("Error in command: "); context.error.String(cmd.command);
+							context.error.String(", params: ");
+							IF c.parameters # "" THEN
+								context.error.String(c.parameters);
+							ELSE
+								context.error.String("None");
+							END;
+							context.error.String(", res: "); context.error.Int(res, 0);
+							context.error.String(" ("); context.error.String(msg); context.error.Char(")");
+							context.error.Ln
+						ELSE c := c.next
+						END;
+					END;
+				END
+			END;
+			context.out.Update; context.error.Update
+		END Execute;
+		*)
+
+		PROCEDURE Run;
+		VAR cmdList: Command; wait, exit: BOOLEAN; i : LONGINT; interpreter: Interpreter.Interpreter; s: Scanner.StringMaker; w: Streams.Writer; r: Streams.Reader;
+			scanner: Scanner.Scanner; parser: Interpreter.Parser; diagnostics: Diagnostics.StreamDiagnostics; seq: SyntaxTree.StatementSequence;
+			str: Scanner.StringType; len: LONGINT; container: Interpreter.Container; scope: Interpreter.Scope; e: SyntaxTree.Expression; value: Interpreter.Value;
+		BEGIN
+			NEW(s,0);
+			w := s.GetWriter();
+			NEW(diagnostics, context.out);
+			exit := FALSE;
+			NEW(container);
+			NEW(scope, Interpreter.global, container);
+			NEW(interpreter, scope, diagnostics, context);
+			WHILE ~close & ~exit & (context.in.res = Streams.Ok) DO
+				IF (prompt # "") THEN
+					context.out.Ln;
+					context.out.String(prompt);
+					FOR i := 0 TO nestingLevel-1 DO
+						context.out.String(NestingLevelIndicator);
+					END;
+					context.out.Update
+				END;
+				s.Clear;
+				ReadCommand(w);w.Update;
+				context.out.Ln; context.out.String("------------");
+				context.out.Ln; context.out.Update;
+				str := s.GetString(len);
+				NEW(scanner, "", s.GetReader(), 0, diagnostics);
+				NEW(parser, scanner, NIL); (* silent *)
+				e := parser.Expression();
+				interpreter.Reset;
+				IF ~parser.error & parser.Optional(Scanner.EndOfText) THEN
+					IF interpreter.GetValue(e,value) THEN
+						value(InterpreterSymbols.Value).WriteValue(context.out); context.out.Update;
+					END;
+				ELSE
+					str := s.GetString(len);
+					NEW(scanner, "", s.GetReader(), 0, diagnostics);
+					NEW(parser, scanner, diagnostics);
+					seq := parser.StatementSequence(NIL);
+					IF parser.Mandatory(Scanner.EndOfText) THEN
+						interpreter.StatementSequence(seq);
+						IF ~interpreter.error THEN
+							context.out.String("[ok]");
+						END;
+					END;
+				END;
+			END;
+			context.out.Update; context.error.Update
+		END Run;
+
+		PROCEDURE AwaitDeath*;
+		BEGIN {EXCLUSIVE}
+			AWAIT(dead)
+		END AwaitDeath;
+
+		PROCEDURE SetUpcall*(proc : NotifyProcedure);
+		BEGIN
+			ASSERT((proc # NIL) & (upcall = NIL));
+			upcall := proc;
+		END SetUpcall;
+
+		PROCEDURE ParseAliases(r : Files.Reader);
+		VAR cmd : Command;
+		BEGIN
+			NEW(cmd);
+			LOOP
+				cmd.parameters := "";
+				r.Ln(cmd.parameters);
+				IF r.res # Streams.Ok THEN EXIT; END;
+				ReadAlias(cmd, FALSE);
+			END;
+		END ParseAliases;
+
+		(* Read aliases from specified file. Returns NIL if file not found or parsing failed. *)
+		PROCEDURE LoadAliasesFromFile(filename : ARRAY OF CHAR);
+		VAR in : Files.Reader; f : Files.File;
+		BEGIN
+			IF filename = "" THEN COPY(DefaultAliasFile, filename); END;
+			f := Files.Old(filename);
+			IF f # NIL THEN
+				Files.OpenReader(in, f, 0);
+				IF in # NIL THEN
+					context.out.String("Loading aliases from "); context.out.String(filename); context.out.String("...");
+					ParseAliases(in);
+					context.out.String("done."); context.out.Ln;
+				END;
+			ELSE
+				context.out.String("Loading aliases failed: File "); context.out.String(filename);
+				context.out.String(" not found."); context.out.Ln;
+			END;
+			context.out.Update;
+		END LoadAliasesFromFile;
+
+	BEGIN {ACTIVE, SAFE}
+		context.out.String(Version); context.out.Ln;
+		context.out.String("Evaluate statement sequence with SHIFT-ENTER"); context.out.Ln;
+		context.out.Update;
+		Run;
+		IF (upcall # NIL) THEN upcall(ExitShell); END;
+		BEGIN {EXCLUSIVE} dead := TRUE; END;
+	END Shell;
+
+END InterpreterShell.
+
+SystemTools.Free Shell ~
+
+WMShell.Open ~

source/PersistentObjects.Mod

@@ -0,0 +1,1179 @@
+MODULE PersistentObjects; (** AUTHOR "fof"; PURPOSE "objects that can be stored with a generic reader / writer"; *)
+IMPORT XML, XMLParser, XMLScanner, Basic := FoxBasic, Strings, StringPool, Streams, Commands, FoxBasic, Files, XMLObjects, Modules, D:= Debugging;
+
+CONST
+	Persistent = 0;
+	None* = -1; (* no index *)
+	
+	EnableTrace = FALSE;
+
+TYPE
+	(** the translation object is used to translate enumeration values to integers (and reverse) *)
+	Translation* = OBJECT
+	TYPE
+		Entry = RECORD name: ARRAY 32 OF CHAR; key: LONGINT END;
+		Table= POINTER TO ARRAY OF Entry;
+	VAR
+		table: Table;
+		len: LONGINT;
+
+		PROCEDURE & Init*;
+		BEGIN len := 0; NEW(table,4);
+		END Init;
+
+		PROCEDURE Grow;
+		VAR i: LONGINT; new: Table;
+		BEGIN
+			NEW(new, 2*LEN(table));
+			FOR i := 0 TO LEN(table)-1 DO new[i] := table[i] END;
+			table := new
+		END Grow;
+
+		PROCEDURE Add*(CONST name: ARRAY OF CHAR; key: LONGINT);
+		VAR i: LONGINT;
+		BEGIN
+			IF len = LEN(table) THEN Grow END;
+			COPY(name, table[len].name); table[len].key := key;
+			INC(len);
+		END Add;
+
+		PROCEDURE Key*(CONST name: ARRAY OF CHAR; VAR key: LONGINT): BOOLEAN;
+		VAR i: LONGINT;
+		BEGIN
+			FOR i := 0 TO len-1 DO
+				IF table[i].name = name THEN key := table[i].key; RETURN TRUE END;
+			END;
+			RETURN FALSE
+		END Key;
+
+		PROCEDURE Name*(index: LONGINT; VAR name: ARRAY OF CHAR): BOOLEAN;
+		VAR i: LONGINT;
+		BEGIN
+			FOR i := 0 TO len-1 DO
+				IF table[i].key = index THEN COPY(table[i].name,name); RETURN TRUE END;
+			END;
+			HALT(100);
+		END Name;
+
+	END Translation;
+
+	Action*=PROCEDURE {DELEGATE} (o: Object);
+
+	Class* = ENUM Char*,Object*, String*, Integer*, Float*, Boolean*, Enum*, Name*, Range*, Set* END;
+
+	Name= ARRAY 128 OF CHAR;
+
+	Content*= OBJECT
+	VAR
+		class*: Class;
+		name*, type*: Name;
+		string*: Strings.String;
+		persistent*: BOOLEAN;
+
+		object*: Object;
+		char*: CHAR;
+		integer*: LONGINT;
+		float*: LONGREAL;
+		boolean*: BOOLEAN;
+		translation*: Translation;
+		range*: RANGE;
+		set*: SET;
+
+		success*: BOOLEAN;
+
+		PROCEDURE SetClass*(class: Class; persistent: BOOLEAN);
+		BEGIN
+			SELF.class := class; SELF.persistent := persistent
+		END SetClass;
+
+		PROCEDURE GetChar*(VAR char: CHAR);
+		BEGIN
+			IF SELF.class = Class.Char THEN char := SELF.char; success := TRUE ELSE HALT(200) END;
+		END GetChar;
+
+		PROCEDURE SetChar*(char: CHAR);
+		BEGIN
+			SELF.class := Class.Char; SELF.char := char;success := TRUE; persistent := TRUE;
+		END SetChar;
+
+		PROCEDURE GetString*(VAR string: Strings.String);
+		BEGIN
+			IF SELF.class = Class.String THEN string := SELF.string; success := TRUE ELSE HALT(200) END;
+		END GetString;
+
+		PROCEDURE SetString*(string: Strings.String);
+		BEGIN
+			SELF.class := Class.String; SELF.string := string;success := TRUE; persistent := TRUE;
+		END SetString;
+
+		PROCEDURE SetAsString*(CONST s: ARRAY OF CHAR);
+		VAR split: Strings.StringArray; first, last, step: LONGINT;
+		BEGIN
+			CASE class OF
+				Class.String: string := Strings.NewString(s)
+				|Class.Name: COPY(s, name);
+				|Class.Boolean: boolean := (s="true") OR (s="1") OR (s="yes") OR (s="TRUE");
+				|Class.Integer: Strings.StrToInt(s, integer);
+				|Class.Float: Strings.StrToFloat(s, float);
+				|Class.Enum:  Strings.StrToInt(s, integer);
+				|Class.Range:
+					split := Strings.Split(s, ":");
+					Strings.StrToInt(split[0]^, first);
+					IF (LEN(split) > 1) & (split[1]^ # "") THEN
+						Strings.StrToInt(split[1]^, last)
+					ELSE
+						last := MAX(LONGINT)
+					END;
+					IF (LEN(split) >2) & (split[2]^ # "") THEN
+						Strings.StrToInt(split[2]^, step)
+					ELSE
+						step := 1
+					END;
+					range := first .. last BY step;
+				|Class.Set:
+					Strings.StrToSet(s, set);
+			ELSE HALT(100)
+			END;
+		END SetAsString;
+
+		PROCEDURE Equals*(CONST s: ARRAY OF CHAR): BOOLEAN;
+		VAR int: LONGINT; flt: LONGREAL; st: SET; split: Strings.StringArray; first, last, step: LONGINT;
+		BEGIN
+			CASE class OF
+				Class.String: RETURN (string # NIL) & (string^ = s)
+				|Class.Name: RETURN (s = name)
+				|Class.Boolean: RETURN boolean = (s="true") OR (s="1") OR (s="yes") OR (s="TRUE");
+				|Class.Integer: Strings.StrToInt(s, int); RETURN integer = int
+				|Class.Float: Strings.StrToFloat(s, flt); RETURN float = flt
+				|Class.Enum:  Strings.StrToInt(s, int); RETURN integer = int
+				|Class.Range:
+					split := Strings.Split(s, ":");
+					Strings.StrToInt(split[0]^, first);
+					IF (LEN(split) > 1) & (split[1]^ # "") THEN
+						Strings.StrToInt(split[1]^, last)
+					ELSE
+						last := MAX(LONGINT)
+					END;
+					IF (LEN(split) >2) & (split[2]^ # "") THEN
+						Strings.StrToInt(split[2]^, step)
+					ELSE
+						step := 1
+					END;
+					RETURN range = first .. last BY step;
+				|Class.Set:
+					Strings.StrToSet(s, st); RETURN set = st
+			ELSE RETURN FALSE
+			END;
+		END Equals;
+
+		PROCEDURE GetName*(VAR name: ARRAY OF CHAR);
+		BEGIN
+			IF SELF.class = Class.Name THEN COPY(SELF.name, name); success := TRUE ELSE HALT(200) END;
+		END GetName;
+
+		PROCEDURE SetName*(CONST name: ARRAY OF CHAR);
+		BEGIN
+			SELF.class := Class.Name; COPY(name, SELF.name);success := TRUE; persistent := TRUE;
+		END SetName;
+
+		PROCEDURE GetInteger*(VAR integer: LONGINT);
+		BEGIN
+			IF SELF.class = Class.Integer THEN integer := SELF.integer; success := TRUE ELSE HALT(200) END;
+		END GetInteger;
+
+		PROCEDURE SetInteger*(integer: LONGINT);
+		BEGIN
+			SELF.class := Class.Integer; SELF.integer := integer;success := TRUE; persistent := TRUE;
+		END SetInteger;
+
+		PROCEDURE GetSet*(VAR set: SET);
+		BEGIN
+			IF SELF.class = Class.Set THEN set := SELF.set; success := TRUE ELSE HALT(200) END;
+		END GetSet;
+
+		PROCEDURE SetSet*(set: SET);
+		BEGIN
+			SELF.class := Class.Set; SELF.set := set;success := TRUE; persistent := TRUE;
+		END SetSet;
+
+		PROCEDURE GetEnum*(translation: Translation; VAR integer: LONGINT);
+		BEGIN
+			SELF.translation := translation;
+			IF SELF.class = Class.Enum THEN integer := SELF.integer; success := TRUE ELSE HALT(200) END;
+		END GetEnum;
+
+		PROCEDURE SetEnum*(translation: Translation; integer: LONGINT);
+		BEGIN
+			SELF.translation := translation;
+			SELF.class := Class.Enum; SELF.integer := integer;  success := TRUE; persistent := TRUE;
+		END SetEnum;
+
+		PROCEDURE GetRange*(VAR range: RANGE);
+		BEGIN
+			IF SELF.class = Class.Range THEN range := SELF.range; success := TRUE ELSE HALT(200) END;
+		END GetRange;
+
+		PROCEDURE SetRange*(CONST range: RANGE);
+		BEGIN
+			SELF.class := Class.Range; SELF.range := range; success := TRUE; persistent := TRUE;
+		END SetRange;
+
+		PROCEDURE GetFloat*(VAR float: LONGREAL);
+		BEGIN
+			IF SELF.class = Class.Float THEN float := SELF.float; success := TRUE ELSE HALT(200) END;
+		END GetFloat;
+
+		PROCEDURE SetFloat*(float: LONGREAL);
+		BEGIN
+			SELF.class := Class.Float; SELF.float := float;success := TRUE; persistent := TRUE;
+		END SetFloat;
+
+		PROCEDURE GetBoolean*(VAR boolean: BOOLEAN);
+		BEGIN
+			IF SELF.class = Class.Boolean THEN boolean := SELF.boolean; success := TRUE ELSE HALT(200) END;
+		END GetBoolean;
+
+		PROCEDURE SetBoolean*(boolean: BOOLEAN);
+		BEGIN
+			SELF.class := Class.Boolean; SELF.boolean := boolean;success := TRUE; persistent := TRUE;
+		END SetBoolean;
+
+		PROCEDURE GetObject*(VAR object: Object);
+		BEGIN
+			IF SELF.class = Class.Object THEN object := SELF.object; success := TRUE ELSE HALT(200) END;
+		END GetObject;
+
+		PROCEDURE SetObject*(object: Object; CONST optionalType: ARRAY OF CHAR);
+		BEGIN
+			SELF.class := Class.Object; SELF.object := object; COPY(optionalType, SELF.type); success := TRUE; persistent := TRUE;
+		END SetObject;
+
+	END Content;
+
+	Enumerator* = PROCEDURE{DELEGATE} (CONST name: ARRAY OF CHAR; array: BOOLEAN);
+
+	(** the interpretation record contains interpretable strings that are associated with attributes of an object
+		an interpreter can use the strings in order to resolve values at runtime.
+	*)
+	Interpretation*=
+		POINTER TO RECORD
+			name-, str-: Strings.String;
+			next-: Interpretation;
+		END;
+
+	Object* = OBJECT
+	VAR
+		reader: Reader;
+		writer: Writer;
+		content: Content;
+		action: Action;
+		firstTranslation-: Interpretation;
+
+	CONST
+		StrType = "type";
+	VAR
+		type*: ARRAY 64 OF CHAR;
+
+		PROCEDURE & InitObject *;
+		BEGIN NEW(content); type := "Object";
+		END InitObject;
+
+		(*
+		PROCEDURE Write*(w: Writer);
+		BEGIN
+		END Write;
+
+		PROCEDURE Read*(w: Reader): BOOLEAN;
+		BEGIN
+			RETURN TRUE
+		END Read;
+		*)
+
+		PROCEDURE ActionEnumerator(CONST name: ARRAY OF CHAR; array: BOOLEAN);
+		VAR index: LONGINT;
+		BEGIN
+			index := 0;
+			REPEAT
+				Get(name, index, content);
+				IF content.success THEN
+					CASE content.class OF
+						|Class.Object:
+							IF content.object = NIL THEN (* break when no object any more in list *)
+								content.success := FALSE
+							ELSE
+								action(content.object)
+							END;
+					ELSE
+					END;
+				END;
+				INC(index);
+			UNTIL ~content.success OR ~array
+		END ActionEnumerator;
+
+		PROCEDURE Traverse*(action: Action);
+		BEGIN
+			IF content = NIL THEN NEW(content) END;
+			SELF.action := action;
+			Enumerate(ActionEnumerator);
+		END Traverse;
+
+		PROCEDURE Enumerate*(enum: Enumerator);
+		BEGIN enum(StrType,FALSE);
+		END Enumerate;
+
+		PROCEDURE Set*(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		BEGIN
+			IF name = StrType THEN c.GetName(type);
+			ELSIF c.class = Class.Object THEN reader.Error("can not set attribute ", name);
+			ELSIF reader # NIL THEN reader.Error("unsupported attribute (Set)", name);
+			END;
+		END Set;
+
+		PROCEDURE Get*(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		BEGIN
+			IF name = StrType THEN c.SetName(type);
+			ELSIF reader # NIL THEN reader.Error("unsupported attribute (Get)", name);
+			END;
+		END Get;
+
+		PROCEDURE AddTranslation*(CONST name: ARRAY OF CHAR; str: Strings.String);
+		VAR translation: Interpretation;
+		BEGIN
+			NEW(translation); translation.name := Strings.NewString(name); translation.str := str;
+			translation.next := firstTranslation;
+			firstTranslation := translation;
+		END AddTranslation;
+
+		PROCEDURE FindTranslation*(CONST name: ARRAY OF CHAR; VAR translation: Interpretation): BOOLEAN;
+		BEGIN
+			translation := firstTranslation;
+			WHILE (translation # NIL) & (translation.name^ # name) DO
+				translation := translation.next;
+			END;
+			RETURN translation # NIL;
+		END FindTranslation;
+
+		PROCEDURE RemoveTranslation*(CONST name: ARRAY OF CHAR): BOOLEAN;
+		VAR translation, prev: Interpretation;
+		BEGIN
+			IF name = "*" THEN
+				firstTranslation := NIL; RETURN TRUE
+			END;
+
+			prev := NIL;
+			translation := firstTranslation;
+			WHILE (translation # NIL) & ((translation.name^ # name)) DO
+				prev := translation;
+				translation := translation.next;
+			END;
+			IF translation # NIL THEN
+				IF prev = NIL THEN firstTranslation := translation.next
+				ELSE prev.next := translation.next
+				END;
+			END;
+			RETURN translation # NIL;
+		END RemoveTranslation;
+
+
+		PROCEDURE ReadContent*(CONST name: ARRAY OF CHAR; array: BOOLEAN);
+		VAR index: LONGINT; str: Strings.String;
+		BEGIN
+			index := 0;
+			REPEAT
+				Get(name, index, content);
+				IF content.success (*& content.persistent*) THEN
+					IF reader.AttributeNeedingTranslation(name, str) THEN
+						AddTranslation(name, str);
+					END;
+					CASE content.class OF
+						|Class.String: content.success := reader.StringAttribute(name, content.string);
+						|Class.Object: content.success := reader.ReadObject(name, content.type, index, content.object);
+						|Class.Name: content.success := reader.NameAttribute(name, content.name);
+						|Class.Boolean: content.success := reader.BooleanAttribute(name, content.boolean);
+						|Class.Integer: content.success := reader.IntegerAttribute(name, content.integer);
+						|Class.Float: content.success := reader.FloatAttribute(name, content.float);
+						|Class.Enum: content.success := reader.EnumAttribute(name, content.translation, content.integer)
+						|Class.Range: content.success := reader.RangeAttribute(name, content.range)
+						|Class.Set: content.success := reader.SetAttribute(name, content.set)
+					END;
+					IF content.success THEN
+						Set(name, index, content)
+					END;
+				END;
+				INC(index);
+			UNTIL ~content.success OR ~array
+		END ReadContent;
+
+		PROCEDURE WriteContent*(CONST name: ARRAY OF CHAR; array: BOOLEAN);
+		VAR index: LONGINT; translation: Interpretation;
+		BEGIN
+			index := 0;
+			REPEAT
+				content.success := FALSE;
+				Get(name, index, content);
+				IF content.persistent & (~array OR content.success) THEN
+					IF FindTranslation(name, translation) THEN
+						writer.StringAttribute(name, translation.str);
+					ELSE
+					CASE content.class OF
+						|Class.String: writer.StringAttribute(name, content.string);
+						|Class.Object:
+							IF content.object = NIL THEN
+								content.success := FALSE
+							ELSE
+								writer.WriteObject(name, index, content.object)
+							END;
+						|Class.Name: writer.NameAttribute(name, content.name);
+						|Class.Boolean: writer.BooleanAttribute(name, content.boolean);
+						|Class.Integer:  writer.IntegerAttribute(name, content.integer);
+						|Class.Float: writer.FloatAttribute(name, content.float);
+						|Class.Enum: writer.EnumAttribute(name, content.translation, content.integer)
+						|Class.Range: writer.RangeAttribute(name, content.range)
+						|Class.Set: writer.SetAttribute(name, content.set)
+					END;
+					END;
+				END;
+				INC(index);
+			UNTIL ~array OR ~content.success
+		END WriteContent;
+
+		PROCEDURE Write*(w: Writer);
+		VAR translation: Interpretation; prev: Writer;
+		BEGIN
+			prev := writer;
+			IF content = NIL THEN NEW(content) END;
+			writer := w;
+			Enumerate(WriteContent);
+
+			translation := firstTranslation;
+			WHILE translation # NIL DO
+				IF EnableTrace THEN D.Str("translation "); D.Str(translation.name^); D.Str("==>"); D.Str(translation.str^); D.Ln; END;
+				translation := translation.next;
+			END;
+			writer := prev;
+		END Write;
+
+		PROCEDURE Read*(r: Reader): BOOLEAN;
+		VAR prev: Reader;
+		BEGIN
+			IF content = NIL THEN NEW(content) END;
+			prev := reader;
+			reader := r;
+			Enumerate(ReadContent);
+			reader := prev;
+			RETURN TRUE
+		END Read;
+
+		PROCEDURE Dump*(log: Streams.Writer; CONST name: ARRAY OF CHAR);
+		VAR writer: Writer;
+		BEGIN
+			writer := NewXMLWriter(log);
+			writer.WriteObject(name, None, SELF);
+			writer.Close;
+		END Dump;
+
+
+	END Object;
+
+	(** Object list *)
+	ObjectList* = OBJECT (Object)
+	VAR
+		list*: FoxBasic.List;
+		baseType*: Name;
+
+		PROCEDURE &InitList*(initialSize: LONGINT; CONST baseType: ARRAY OF CHAR);
+		BEGIN
+			InitObject;
+			NEW(list, initialSize);
+			COPY(baseType, SELF.baseType);
+			type := "ObjectList";
+		END InitList;
+
+		PROCEDURE Length*(): LONGINT;
+		BEGIN RETURN list.Length()
+		END Length;
+
+		PROCEDURE GetElement*(i: LONGINT): Object;
+		VAR obj: ANY;
+		BEGIN
+			IF (i >= 0) & (i < list.Length()) THEN
+				obj := list.Get(i);
+				IF obj # NIL THEN RETURN obj(Object); ELSE RETURN NIL; END;
+			ELSE RETURN NIL;
+			END;
+		END GetElement;
+
+		PROCEDURE SetElement*(i: LONGINT; o: Object);
+		BEGIN
+			(*WHILE list.Length() <= i DO list.Add(NIL) END;*)
+			IF list.Length() = i THEN list.Add(o) ELSE list.Set(i,o) END;
+		END SetElement;
+
+		PROCEDURE Enumerate(enum: Enumerator);
+		BEGIN
+			Enumerate^(enum);
+			enum("element", TRUE);
+		END Enumerate;
+
+		PROCEDURE Get*(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		BEGIN
+			IF (name = "element") OR (name="") THEN
+				c.SetObject(GetElement(index), baseType);
+				c.success := TRUE; (* irrespective of content that can be nil, success should be considered given *)
+			ELSE Get^(name, index, c)
+			END;
+		END Get;
+
+		PROCEDURE Set*(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		VAR object: Object;
+		BEGIN
+			IF (name = "element") OR (name="") THEN
+				c.GetObject(object); SetElement(index, object);
+				c.success := TRUE;
+			ELSE Set^(name, index, c)
+			END;
+		END Set;
+
+		PROCEDURE Add*(o: Object);
+		BEGIN
+			list.Add(o)
+		END Add;
+
+		PROCEDURE Contains*(o: Object): BOOLEAN;
+		BEGIN
+			RETURN list.Contains(o);
+		END Contains;
+
+		PROCEDURE Traverse*(action: Action);
+		VAR i: LONGINT;
+		BEGIN
+			FOR i := 0 TO Length()-1 DO
+				action(GetElement(i));
+			END;
+		END Traverse;
+
+		PROCEDURE IndexOf*(o: Object): LONGINT;
+		BEGIN
+			RETURN list.IndexOf(o)
+		END IndexOf;
+
+	END ObjectList;
+
+
+	Generator = PROCEDURE {DELEGATE} (CONST type: ARRAY OF CHAR): Object;
+
+	Reader* = OBJECT
+	VAR generator: Generator;
+		error: Streams.Writer;
+		err-: BOOLEAN;
+		filename*: Files.FileName; (* debugging *)
+
+		PROCEDURE & InitReader(gen: Generator);
+		BEGIN
+			SELF.generator := gen;
+			error := Commands.GetContext().error;
+		END InitReader;
+
+		PROCEDURE Error(CONST s1,s2: ARRAY OF CHAR);
+		BEGIN
+			err := TRUE;
+			error.String("error in file "); error.String(filename); error.String(" ");
+			error.Update;
+		END Error;
+
+		PROCEDURE StringAttribute*(CONST name: ARRAY OF CHAR; VAR str: Strings.String): BOOLEAN;
+		END StringAttribute;
+
+		PROCEDURE ReadObject*(CONST name, optionalType: ARRAY OF CHAR; index: LONGINT; VAR o: Object): BOOLEAN ;
+		BEGIN
+		END ReadObject;
+
+		PROCEDURE NeedsTranslation(CONST s: ARRAY OF CHAR): BOOLEAN;
+		VAR i: LONGINT; start: BOOLEAN;
+		BEGIN
+			i := 0; start := FALSE;
+			WHILE s[i] # 0X DO
+				IF s[i] = "?" THEN start := TRUE
+				ELSIF start THEN
+					IF s[i] = "{" THEN RETURN TRUE
+					ELSE start := FALSE
+					END;
+				END;
+				INC(i);
+			END;
+			RETURN FALSE
+		END NeedsTranslation;
+
+		PROCEDURE AttributeNeedingTranslation*(CONST name: ARRAY OF CHAR; VAR str: Strings.String): BOOLEAN;
+		BEGIN
+			IF StringAttribute(name, str) & NeedsTranslation(str^) THEN RETURN TRUE ELSE RETURN FALSE END;
+		END AttributeNeedingTranslation;
+
+		PROCEDURE NameAttribute*(CONST name: ARRAY OF CHAR; VAR str: ARRAY OF CHAR): BOOLEAN;
+		VAR s: Strings.String;
+		BEGIN
+			IF StringAttribute(name, s) THEN COPY(s^, str); RETURN TRUE ELSE RETURN FALSE END;
+		END NameAttribute;
+
+		PROCEDURE BooleanAttribute*(CONST name: ARRAY OF CHAR; VAR value: BOOLEAN): BOOLEAN;
+		VAR s: ARRAY 32 OF CHAR;
+		BEGIN
+			IF NameAttribute(name, s) THEN value := (s="true") OR (s="1") OR (s="yes") OR (s="TRUE"); RETURN TRUE ELSE RETURN FALSE END;
+		END BooleanAttribute;
+
+		PROCEDURE IntegerAttribute*(CONST name: ARRAY OF CHAR; VAR value: LONGINT): BOOLEAN;
+		VAR s: ARRAY 64 OF CHAR; v: LONGINT;
+		BEGIN
+			IF NameAttribute(name, s) THEN Strings.StrToInt(s, v); value := v; RETURN TRUE ELSE RETURN FALSE END;
+		END IntegerAttribute;
+
+		PROCEDURE FloatAttribute*(CONST name: ARRAY OF CHAR; VAR value: LONGREAL): BOOLEAN;
+		VAR str: ARRAY 64 OF CHAR;
+		BEGIN
+			IF NameAttribute(name, str) THEN
+				Strings.StrToFloat(str, value);
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END
+		END FloatAttribute;
+
+		PROCEDURE EnumAttribute*(CONST name: ARRAY OF CHAR; translation: Translation; VAR value: LONGINT): BOOLEAN;
+		VAR str: ARRAY 32 OF CHAR;
+		BEGIN
+			IF NameAttribute(name, str) & translation.Key(str, value) THEN RETURN TRUE ELSE RETURN FALSE END;
+		END EnumAttribute;
+
+		PROCEDURE RangeAttribute*(CONST name: ARRAY OF CHAR; VAR value: RANGE): BOOLEAN;
+		VAR str: ARRAY 64 OF CHAR; first, last , step: LONGINT;  split:Strings.StringArray;
+		BEGIN
+			IF NameAttribute(name, str) THEN
+				split := Strings.Split(str, ":");
+				Strings.StrToInt(split[0]^, first);
+				IF (LEN(split) > 1) & (split[1]^ # "") THEN
+					Strings.StrToInt(split[1]^, last)
+				ELSE
+					last := MAX(LONGINT)
+				END;
+				IF (LEN(split) >2) & (split[2]^ # "") THEN
+					Strings.StrToInt(split[2]^, step)
+				ELSE
+					step := 1
+				END;
+				value := first .. last BY step;
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END
+		END RangeAttribute;
+
+		PROCEDURE SetAttribute*(CONST name: ARRAY OF CHAR; VAR set: SET): BOOLEAN;
+		VAR str: ARRAY 64 OF CHAR;
+		BEGIN
+			IF NameAttribute(name, str) THEN
+				Strings.StrToSet(str, set);
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END;
+		END SetAttribute;
+
+	END Reader;
+
+	Writer* = OBJECT
+
+		PROCEDURE & InitWriter*;
+		BEGIN
+		END InitWriter;
+
+		PROCEDURE Close*;
+		END Close;
+
+		(* minimal interface to be implemented *)
+		PROCEDURE NameAttribute*(CONST name, str: ARRAY OF CHAR);
+		END NameAttribute;
+
+		PROCEDURE WriteObject*(CONST name: ARRAY OF CHAR; index: LONGINT; o: Object);
+		END WriteObject;
+
+		PROCEDURE StartObjectArray*(CONST name: ARRAY OF CHAR);
+		BEGIN
+		END StartObjectArray;
+
+		(* functions that provide necessary functionaliy based on minimal methods above but can be overwritten for optimisations *)
+		PROCEDURE StringAttribute*(CONST name: ARRAY OF CHAR; str: Strings.String);
+		BEGIN
+			IF str #  NIL THEN
+				NameAttribute(name, str^)
+			END;
+		END StringAttribute;
+
+		PROCEDURE IntegerAttribute*(CONST name: ARRAY OF CHAR; value: HUGEINT);
+		VAR str: ARRAY 64 OF CHAR;
+		BEGIN
+			Strings.IntToStr(SHORT(value), str);
+			NameAttribute(name, str);
+		END IntegerAttribute;
+
+		PROCEDURE FloatAttribute*(CONST name: ARRAY OF CHAR; value: LONGREAL);
+		VAR str: ARRAY 64 OF CHAR; sw: Streams.StringWriter;
+		BEGIN
+			NEW(sw, 32); sw.Float(value, 31); sw.Update;
+			sw.Get(str); Strings.TrimWS(str); NameAttribute(name, str)
+		END FloatAttribute;
+
+		PROCEDURE BooleanAttribute*(CONST name: ARRAY OF CHAR; value: BOOLEAN);
+		BEGIN
+			IF value THEN NameAttribute(name,"true") ELSE NameAttribute(name,"false") END;
+		END BooleanAttribute;
+
+		PROCEDURE EnumAttribute*(CONST name: ARRAY OF CHAR; translation: Translation; value: LONGINT);
+		VAR str: ARRAY 32 OF CHAR;
+		BEGIN
+			IF translation.Name(value, str) THEN NameAttribute(name, str) ELSE NameAttribute(name, "unknown") END;
+		END EnumAttribute;
+
+		PROCEDURE RangeAttribute*(CONST name: ARRAY OF CHAR; value: RANGE);
+		VAR str: ARRAY 64 OF CHAR;
+		BEGIN
+			Strings.IntToStr(FIRST(value), str);
+			Strings.Append(str, ":");
+			IF LAST(value) # MAX(LONGINT) THEN
+				Strings.AppendInt(str, LAST(value));
+			END;
+			IF STEP(value) # 1 THEN
+				Strings.Append(str,":");
+				Strings.AppendInt(str, STEP(value));
+			END;
+			NameAttribute(name, str);
+		END RangeAttribute;
+
+		PROCEDURE SetAttribute*(CONST name: ARRAY OF CHAR; value: SET);
+		VAR str: ARRAY 64 OF CHAR;
+		BEGIN
+			Strings.SetToStr(value, str);
+			NameAttribute(name, str);
+		END SetAttribute;
+
+
+	END Writer;
+
+	WrittenTable = OBJECT (Basic.HashTable)
+	TYPE
+		ObjectId = POINTER TO RECORD num: LONGINT END;
+	VAR length: LONGINT;
+
+		PROCEDURE Enter(o: Object; VAR entry: LONGINT): BOOLEAN;
+		VAR any: ANY; id: ObjectId;
+		BEGIN
+			any := Get(o);
+			IF any # NIL THEN entry := any(ObjectId).num; RETURN FALSE
+			ELSE entry := length; INC(length); NEW(id); id.num := entry; Put(o, id); RETURN TRUE
+			END;
+		END Enter;
+
+	END WrittenTable;
+
+	XMLWriter*= OBJECT (Writer)
+	VAR w: Streams.Writer;
+		document-: XML.Document; element: XML.Element; current: XML.Container;
+		scope: Scope;
+		written: WrittenTable;
+
+		PROCEDURE & InitXMLWriter*(writer: Streams.Writer);
+		BEGIN
+			w := writer; NEW(document); NEW(written,16); current := document; NEW(scope,current);
+		END InitXMLWriter;
+
+		PROCEDURE Close;
+		BEGIN
+			IF w # NIL THEN
+				document.Write(w,NIL,-1); w.Update;
+			END
+		END Close;
+
+		PROCEDURE NameAttribute(CONST name, str: ARRAY OF CHAR);
+		BEGIN
+			element.SetAttributeValue(name, str);
+		END NameAttribute;
+
+		PROCEDURE Enter(CONST name: ARRAY OF CHAR; o: Object);
+		VAR e: XML.Element;
+		BEGIN
+			NEW(e); e.SetName(name); current.AddContent(e);
+			scope.EnterElement(e);
+			scope.Enter(e); current := e; element := e;
+		END Enter;
+
+		PROCEDURE Exit(CONST name: ARRAY OF CHAR);
+		BEGIN
+			scope.Exit(current);
+			IF (current IS XML.Element) THEN element := current(XML.Element) ELSE element := NIL END;
+		END Exit;
+
+		PROCEDURE WriteObject(CONST name: ARRAY OF CHAR; index: LONGINT; o: Object);
+		VAR guid: LONGINT;
+		BEGIN
+			IF o # NIL THEN
+				Enter(name,o);
+				IF written.Enter(o,guid) THEN
+					o.Write(SELF);
+					IntegerAttribute("guid", guid);
+				ELSE
+					IntegerAttribute("guid_reference",guid)
+				END;
+				Exit(name);
+			END;
+		END WriteObject;
+
+	END XMLWriter;
+
+	ReadTable = OBJECT (Basic.List)
+
+		PROCEDURE Enter(o: Object);
+		BEGIN	 Add(o);
+		END Enter;
+
+		PROCEDURE GetObject(index: LONGINT): Object;
+		BEGIN
+			RETURN Get(index)(Object)
+		END GetObject;
+
+	END ReadTable;
+
+	Element=POINTER TO RECORD
+		index: LONGINT;
+		e: XML.Element;
+		next: Element;
+	END;
+
+	Symbol = POINTER TO RECORD
+		name: LONGINT;
+		first, last: Element;
+		numberElements: LONGINT;
+		next: Symbol;
+	END;
+
+	Stack = POINTER TO RECORD
+		container: XML.Container;
+		symbols: Basic.HashTableInt;
+		firstSymbol: Symbol;
+		used: Basic.HashTable;
+		next: Stack
+	END;
+
+	Scope = OBJECT
+	VAR
+		stack: Stack;
+
+		PROCEDURE & InitScope(c: XML.Container);
+		BEGIN
+			stack := NIL; Enter(c);
+		END InitScope;
+
+		PROCEDURE Enter(c: XML.Container);
+		VAR new: Stack;
+		BEGIN
+			Use(c);
+			NEW(new);
+			new.container := c; NEW(new.symbols,32); NEW(new.used,4);
+			new.next := stack;  new.firstSymbol := NIL;
+			stack := new;
+			Register(c);
+		END Enter;
+
+		PROCEDURE Register(c: XML.Container);
+		VAR e: XML.Content;
+		BEGIN
+			e := c.GetFirst();
+			WHILE e # NIL DO
+				IF (e IS XML.Element) (* & ~scope.Used(e) *) THEN
+					EnterElement(e(XML.Element));
+				END;
+				e := c.GetNext(e);
+			END;
+		END Register;
+
+		PROCEDURE Exit(VAR c: XML.Container);
+		BEGIN
+			stack := stack.next;
+			c := stack.container;
+		END Exit;
+
+		PROCEDURE Use(o: ANY);
+		BEGIN
+			IF (stack # NIL) & ~stack.used.Has(o) THEN stack.used.Put(o,o) END;
+		END Use;
+
+		PROCEDURE Used(o: ANY): BOOLEAN;
+		BEGIN
+			RETURN stack.used.Has(o)
+		END Used;
+
+		PROCEDURE AddSymbol(CONST name: ARRAY OF CHAR): Symbol;
+		VAR id: LONGINT; any: ANY; symbol: Symbol;
+		BEGIN
+			id := StringPool.GetIndex1(name);
+			any := stack.symbols.Get(id);
+			IF any = NIL THEN
+				NEW(symbol);
+				stack.symbols.Put(id, symbol);
+				symbol.name := id;
+				symbol.next := stack.firstSymbol;
+				symbol.numberElements := 0;
+				stack.firstSymbol := symbol;
+			ELSE
+				symbol := any(Symbol)
+			END;
+			RETURN symbol
+		END AddSymbol;
+
+		PROCEDURE FindElement(CONST name: ARRAY OF CHAR; index: LONGINT): XML.Element;
+		VAR id: LONGINT; any: ANY; symbol: Symbol; element: Element;
+		BEGIN
+			IF name = "" THEN
+				symbol := stack.firstSymbol;
+				WHILE (symbol # NIL) & (index >= symbol.numberElements) DO
+					DEC(index, symbol.numberElements);
+					symbol := symbol.next;
+				END;
+				IF symbol = NIL THEN RETURN NIL END;
+			ELSE
+				id := StringPool.GetIndex1(name);
+				any := stack.symbols.Get(id);
+				IF any = NIL THEN
+					RETURN NIL
+				ELSE
+					symbol := any(Symbol)
+				END;
+			END;
+			element := symbol.first;
+			WHILE (element # NIL) &  (element.index < index) DO
+				element := element.next;
+			END;
+			IF element = NIL THEN RETURN NIL
+			ELSE RETURN element.e
+			END;
+		END FindElement;
+
+		(* fifo *)
+		PROCEDURE PutElement(symbol: Symbol; element: Element);
+		BEGIN
+			IF symbol.first = NIL THEN
+				symbol.first := element; symbol.last := element; element.index := 0;
+			ELSE
+				element.index := symbol.last.index + 1;
+				symbol.last.next := element; symbol.last := element
+			END;
+			INC(symbol.numberElements);
+		END PutElement;
+
+		PROCEDURE EnterElement(e: XML.Element);
+		VAR name: Strings.String; symbol: Symbol; element: Element;
+		BEGIN
+			name := e.GetName();
+			symbol := AddSymbol(name^);
+			NEW(element); element.e := e;
+			PutElement(symbol, element);
+		END EnterElement;
+
+		PROCEDURE Write(w: Streams.Writer);
+
+			PROCEDURE WriteStack(s: Stack);
+			VAR name: Strings.String;
+			BEGIN
+				IF s # NIL THEN
+					WriteStack(s.next);
+					IF s.container IS XML.Element THEN
+						name := s.container(XML.Element).GetName();
+						IF name # NIL THEN w.String("/"); w.String(name^) END
+					END
+				END;
+			END WriteStack;
+
+		BEGIN
+			WriteStack(stack);
+		END Write;
+
+	END Scope;
+
+	XMLReader* = OBJECT (Reader)
+	VAR
+		element: XML.Element;
+		current: XML.Container;
+		scope: Scope;
+		read: ReadTable;
+
+		PROCEDURE ReportXMLError(pos, line,col: LONGINT; CONST msg: ARRAY OF CHAR);
+		BEGIN
+			IF ~err THEN
+				error.Char(CHR(9H)); error.Char(CHR(9H)); error.String("pos "); error.Int(pos, 6);
+				error.String(", line "); error.Int(line, 0); error.String(", column "); error.Int(col, 0);
+				error.String("    "); error.String(msg); error.Ln
+			END;
+			err := TRUE;
+		END ReportXMLError;
+
+		PROCEDURE & InitXMLReader*(reader: Streams.Reader; generator: Generator);
+		VAR scanner: XMLScanner.Scanner; parser: XMLParser.Parser;
+		BEGIN
+			InitReader(generator);
+			NEW(scanner, reader);
+			NEW(parser, scanner);
+			err := FALSE;
+			parser.reportError := ReportXMLError;
+			current := parser.Parse();
+			NEW(scope, current);
+			element := NIL;
+			NEW(read,16);
+		END InitXMLReader;
+
+		PROCEDURE Error(CONST s1,s2: ARRAY OF CHAR);
+		BEGIN
+			err := TRUE;
+			error.String("error in file "); error.String(filename); error.String(" ");
+			error.String("in scope "); scope.Write(error); error.String(": "); error.String(s1); error.String(" "); error.String(s2); error.Ln;
+			error.Update;
+		END Error;
+
+		PROCEDURE StringAttribute(CONST name: ARRAY OF CHAR; VAR str: Strings.String): BOOLEAN;
+		BEGIN
+			IF element # NIL THEN
+				str := element.GetAttributeValue(name);
+				scope.Use(element.GetAttribute(name));
+			END;
+			RETURN str # NIL;
+		END StringAttribute;
+
+		PROCEDURE Enter(CONST name: ARRAY OF CHAR; index: LONGINT; VAR o: Object): BOOLEAN;
+		VAR e: XML.Element;
+		BEGIN
+			e := scope.FindElement(name, index);
+			IF e # NIL THEN
+				element := e;
+				current := element;
+				scope.Enter(current);
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END;
+		END Enter;
+
+		PROCEDURE Exit(CONST name: ARRAY OF CHAR);
+		BEGIN
+			scope.Exit(current);
+			IF current IS XML.Element THEN element := current(XML.Element) ELSE element := NIL END;
+		END Exit;
+
+		PROCEDURE CheckUse(o: ANY);
+		VAR e: XML.Content; enum: XMLObjects.Enumerator; name: XML.String; a: ANY; n: ARRAY 512 OF CHAR;
+			type: Modules.TypeDesc;
+		BEGIN
+			IF current IS XML.Element THEN
+				enum := current(XML.Element).GetAttributes();
+				WHILE enum.HasMoreElements() DO
+					a := enum.GetNext();
+					IF ~scope.Used(a) THEN
+						name := a(XML.Attribute).GetName();
+						type := Modules.TypeOf(o);
+						COPY(name^, n);
+						Strings.Append(n," in type ");
+						Strings.Append(n, type.mod.name);
+						Strings.Append(n,".");
+						Strings.Append(n, type.name);
+						Error("not used ", n);
+					END;
+				END;
+			END;
+
+			e := current.GetFirst();
+			WHILE e # NIL DO
+				IF (e IS XML.Element)  & ~scope.Used(e)  THEN
+					name := e(XML.Element).GetName();
+					type := Modules.TypeOf(o);
+					COPY(name^, n);
+					Strings.Append(n," in type ");
+					Strings.Append(n,type.mod.name);
+					Strings.Append(n,".");
+					Strings.Append(n,type.name);
+					Error("not used ", n);
+				END;
+				e := current.GetNext(e);
+			END;
+		END CheckUse;
+
+		PROCEDURE ReadObject(CONST name, optionalType: ARRAY OF CHAR; index: LONGINT; VAR o: Object): BOOLEAN;
+		VAR type: ARRAY 32 OF CHAR; id: LONGINT;
+		BEGIN
+			(*IF err THEN RETURN FALSE END;*)
+
+			IF Enter(name, index, o) THEN
+				IF IntegerAttribute("guid_reference", id) THEN
+					o := read.GetObject(id);
+				ELSE
+					IF IntegerAttribute("guid", id) THEN (* ignore *) END;
+					IF ~NameAttribute("type",type) THEN COPY(optionalType, type) END;
+					o := generator(type);
+					IF o = NIL THEN
+						Error(name,"could not be created");
+						Exit(name);
+						RETURN FALSE
+					ELSE
+						read.Enter(o);
+						IF ~o.Read(SELF) THEN
+							Error(name,"could not be read");
+						END;
+					END;
+				END;
+
+				CheckUse(o);
+				Exit(name);
+				RETURN TRUE
+			ELSE
+				RETURN FALSE
+			END;
+		END ReadObject;
+
+	END XMLReader;
+
+
+PROCEDURE NewXMLWriter*(w: Streams.Writer): Writer;
+VAR writer: XMLWriter;
+BEGIN
+	NEW(writer, w); RETURN writer
+END NewXMLWriter;
+
+PROCEDURE NewXMLReader*(r: Streams.Reader; generator: Generator): Reader;
+VAR reader: XMLReader;
+BEGIN
+	NEW(reader, r, generator); RETURN reader
+END NewXMLReader;
+
+PROCEDURE Clone*(o: Object; gen: Generator): Object;
+VAR w: XMLWriter; r : XMLReader; f: Files.File; writer: Files.Writer; reader: Files.Reader; clone: Object;
+BEGIN
+	f := Files.New(""); (* anonymous file *)
+	Files.OpenWriter(writer,f,0);
+	NEW(w, writer);
+	w.WriteObject("object",None, o);
+	w.Close;
+	writer.Update;
+
+	NEW(reader, f, 0);
+	NEW(r,reader, gen);
+	IF ~r.ReadObject("object","",None, clone) THEN TRACE(clone) END;
+	RETURN clone
+END Clone;
+
+PROCEDURE Trace*(o: Object);
+VAR w: Streams.Writer; writer: Writer;
+BEGIN
+	writer := NewXMLWriter(D.Log);
+	writer.WriteObject("specification", None, o);
+	writer.Close;
+	D.Ln;
+END Trace;
+
+
+
+END PersistentObjects.

source/WMInterpreterShell.Mod

@@ -0,0 +1,391 @@
+MODULE WMInterpreterShell; (** AUTHOR "staubesv"; PURPOSE "GUI for shell"; *)
+(**
+ * Usage:
+ *
+ *	WMShell.Open ~ opens new shell
+ *	SystemTools.Free WMShell ~ closes all open shells
+ *
+ * History:
+ *
+ *	25.06.2007	First release (staubesv)
+ *
+ * TODO:
+ * 	- nice shutdown when freeing module
+ *)
+
+IMPORT
+	Shell := InterpreterShell, Streams, Pipes, Texts, TextUtilities, Strings,
+	Modules, Kernel, Inputs,
+	WMGraphics, WMWindowManager, WMMessages, WMRestorable,
+	WMComponents, WMDocumentEditor;
+
+CONST
+
+	(* Default size of window at start up *)
+	DefaultWidth = 640; DefaultHeight = 300;
+
+	ReceiveBufferSize = 256;
+
+	Prompt = ">";
+
+	Backspace = 08X;
+	ESC = 1BX;
+	DEL = 7FX;
+
+TYPE
+
+	ShellComponent = OBJECT(WMComponents.VisualComponent)
+	VAR
+		out : Streams.Writer;
+		in : Streams.Reader;
+
+		pipeOut, pipeIn : Pipes.Pipe;
+
+		(* Terminal window text writer *)
+		w: TextUtilities.TextWriter;
+		r: Texts.TextReader;
+		text : Texts.Text;
+
+		shell : Shell.Shell;
+
+		editor : WMDocumentEditor.Editor;
+
+		running, dead : BOOLEAN;
+		timer : Kernel.Timer;
+
+		begPos: LONGINT;
+		selectedAll: BOOLEAN;
+		
+		buf: POINTER TO ARRAY OF CHAR;
+
+		PROCEDURE Clear;
+		BEGIN
+			editor.Clear;
+			NewLine(Prompt);
+			Invalidate;
+		END Clear;
+
+		PROCEDURE ExtPointerUp(x, y : LONGINT; keys : SET; VAR handled : BOOLEAN);
+		BEGIN
+			text.AcquireRead;
+			editor.editor.tv.cursor.SetPosition(text.GetLength());
+			text.ReleaseRead;
+		END ExtPointerUp;
+
+		PROCEDURE ExtKeyPressed(ucs : LONGINT; flags : SET; VAR keySym : LONGINT; VAR handled : BOOLEAN);
+		VAR 
+			i, len, n, u: LONGINT;
+		BEGIN
+			handled := FALSE;
+			IF editor.HandleShortcut(ucs, flags, keySym) THEN handled := TRUE; END;
+
+			selectedAll := FALSE;
+
+			IF ~handled & ~(Inputs.Release IN flags) THEN
+				handled := TRUE;
+				IF keySym = 01H THEN (* Ctrl-A *)
+
+					text.AcquireRead;
+					IF editor.editor.tv.cursor.GetPosition() > begPos THEN
+						editor.editor.tv.selection.SetFromTo(begPos,text.GetLength());
+						Texts.SetLastSelection(text,editor.editor.tv.selection.from,editor.editor.tv.selection.to);
+					END;
+					text.ReleaseRead;
+
+					selectedAll := TRUE;
+				(*ELSIF keySym = 03H THEN (* Ctrl-C *)
+					editor.editor.tv.CopySelection
+				ELSIF keySym = 16H THEN (* Ctrl-V *)
+					CopyFromClipboard;
+	 			ELSIF (keySym = 0FF63H) & (flags * Inputs.Ctrl # {}) THEN  (*Ctrl Insert *)
+	 				editor.editor.tv.CopySelection*)
+				ELSIF keySym = 0FF56H THEN (* Page Down *)
+					editor.editor.tv.PageDown(flags * Inputs.Shift # {})
+				ELSIF keySym = 0FF55H THEN (* Page Up *)
+					editor.editor.tv.PageUp(flags * Inputs.Shift # {})
+				ELSIF keySym = 0FF50H THEN (* Cursor Home *)
+					editor.editor.tv.Home(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
+				ELSIF keySym = 0FF57H THEN (* Cursor End *)
+					editor.editor.tv.End(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
+				ELSIF (keySym = Inputs.KsBackSpace) & (flags * Inputs.Ctrl # {}) THEN  (*Ctrl Backspace *)
+					Clear;
+				ELSIF (keySym = Inputs.KsReturn) & (flags*Inputs.Shift # {}) THEN (* SHIFT ENTER *)
+					text.AcquireRead;
+					len := text.GetLength()-begPos;
+					
+					IF len > 0 THEN
+						IF len >= LEN(buf) THEN NEW(buf,len+(len DIV 4)); END;
+						NEW(r,text);
+						r.SetPosition(begPos);
+					
+						n := 0;
+						FOR i := 0 TO len-1 DO
+							r.ReadCh(u);
+							IF (u >= 32) & (u <= 126) THEN (* take only characters *)
+								buf[n] := CHR(u); INC(n);
+							END; buf[n] := 0X;
+						END;
+					END;
+					text.ReleaseRead;
+					
+					IF len > 0 THEN
+						out.String(buf^);
+						out.Char(ESC); out.Char(0DX); out.Update;
+					END;
+
+				ELSIF ((keySym = Inputs.KsLeft) OR (keySym = Inputs.KsUp) OR (keySym = Inputs.KsDown)) & (editor.editor.tv.cursor.GetPosition() = begPos) THEN
+					
+				ELSIF (keySym = Inputs.KsBackSpace) & (flags = {}) THEN
+					IF editor.editor.tv.cursor.GetPosition() # begPos THEN
+						handled := FALSE;
+					END;
+				ELSE
+					handled := FALSE;
+				END
+			END;
+
+			IF ~handled & (ucs > 0) & (ucs < 256) THEN
+				editor.editor.KeyPressed(ucs,flags,keySym,handled);
+			END;
+		END ExtKeyPressed;
+
+		PROCEDURE Wait(ms : LONGINT);
+		BEGIN
+			timer.Sleep(ms);
+		END Wait;
+
+		PROCEDURE InitShell;
+		VAR shellIn : Streams.Reader; shellOut : Streams.Writer;
+		BEGIN
+			NEW(pipeOut, 256); NEW(pipeIn, 256);
+
+			(* wire pipes *)
+			NEW(shellIn, pipeOut.Receive, 256);
+			NEW(shellOut, pipeIn.Send, 256);
+
+			NEW(out, pipeOut.Send, 256);
+			NEW(in, pipeIn.Receive, 256);
+
+			NEW(shell, shellIn,shellOut, shellOut, FALSE, "");
+		END InitShell;
+
+		PROCEDURE CopyFromClipboard;
+		VAR string : POINTER TO ARRAY OF CHAR;
+		BEGIN
+			Texts.clipboard.AcquireRead;
+			IF Texts.clipboard.GetLength() > 0 THEN
+				NEW(string, Texts.clipboard.GetLength()+1);
+				TextUtilities.TextToStr(Texts.clipboard, string^);
+			END;
+			Texts.clipboard.ReleaseRead;
+			out.String(string^); out.Update;
+			TRACE(string^);
+		END CopyFromClipboard;
+
+		PROCEDURE Finalize;
+		BEGIN
+(*			pipeIn.Close; pipeOut.Close; *)
+			shell.Exit;
+			BEGIN {EXCLUSIVE}
+				running := FALSE;
+				AWAIT(dead);
+			END;
+		END Finalize;
+
+		PROCEDURE DeleteNCharacters(nbrOfCharacters : LONGINT);
+		VAR pos : LONGINT;
+		BEGIN
+			text.AcquireWrite;
+			pos := editor.editor.tv.cursor.GetPosition();
+			text.Delete(pos - nbrOfCharacters, nbrOfCharacters);
+			text.ReleaseWrite;
+		END DeleteNCharacters;
+		
+		PROCEDURE NewLine(CONST prompt: ARRAY OF CHAR);
+		BEGIN
+			w.Ln; w.String(prompt); w.Update;
+			text.AcquireRead;
+			editor.editor.tv.cursor.SetPosition(text.GetLength());
+			begPos := editor.editor.tv.cursor.GetPosition();
+			text.ReleaseRead;
+		END NewLine;
+
+		PROCEDURE ReceiveCharacters;
+		VAR ch : CHAR; buffer : ARRAY ReceiveBufferSize OF CHAR; backspaces, i, size, len : LONGINT;
+		BEGIN
+			(* Receive at least one character *)
+			size := in.Available();
+			IF size > ReceiveBufferSize THEN size := ReceiveBufferSize; END;
+			in.Bytes(buffer, 0, size, len);
+			IF in.res = Streams.Ok THEN
+				FOR i := 0 TO len-1 DO
+					ch := buffer[i];
+					IF (ch = DEL) OR (ch = Backspace) THEN
+						INC(backspaces);
+					ELSE
+						IF (backspaces > 0) THEN
+							w.Update;
+							DeleteNCharacters(backspaces);
+							backspaces := 0;
+						END;
+						w.Char(ch);
+					END;
+				END;
+				w.Update;
+				NewLine(Prompt);
+			END;
+			DeleteNCharacters(backspaces);
+		END ReceiveCharacters;
+
+		PROCEDURE &Init*;
+		BEGIN
+			Init^;
+			running := TRUE;
+			NEW(timer);
+
+			NEW(editor); editor.alignment.Set(WMComponents.AlignClient);
+			editor.SetToolbar(WMDocumentEditor.StoreButton + WMDocumentEditor.WrapButton + WMDocumentEditor.SearchButton + WMDocumentEditor.ClearButton);
+			editor.editor.tv.SetExtKeyEventHandler(ExtKeyPressed);
+			editor.editor.tv.SetExtPointerUpHandler(ExtPointerUp);
+			AddContent(editor);
+
+			NEW(text);
+			NEW(w, text); w.SetFontName("Courier");
+			editor.SetText(text);
+			InitShell;
+			SetNameAsString(StrShellComponent);
+			
+			NEW(buf,65536);
+		END Init;
+
+	BEGIN {ACTIVE}
+		WHILE running DO
+			IF running & (in.Available() > 0) THEN ReceiveCharacters; END;
+			Wait(2);
+		END;
+		BEGIN {EXCLUSIVE} dead := TRUE; END;
+	END ShellComponent;
+
+TYPE
+
+	KillerMsg = OBJECT
+	END KillerMsg;
+
+	Window* = OBJECT (WMComponents.FormWindow)
+	VAR
+		shell : ShellComponent;
+
+		PROCEDURE HandleUpcall(command : LONGINT);
+		BEGIN
+			IF command = Shell.Clear THEN
+				shell.Clear;
+			ELSIF command = Shell.ExitShell THEN
+				Close;
+			END;
+		END HandleUpcall;
+
+		PROCEDURE &New*(c : WMRestorable.Context);
+		BEGIN
+			IncCount;
+
+			NEW(shell); shell.alignment.Set(WMComponents.AlignClient);
+			shell.shell.SetUpcall(HandleUpcall);
+
+			Init(DefaultWidth, DefaultHeight, FALSE);
+
+			SetContent(shell);
+			SetTitle(Strings.NewString("BlueShell"));
+			SetIcon(WMGraphics.LoadImage("WMIcons.tar://WMShell.png", TRUE));
+
+			IF c # NIL THEN
+				WMRestorable.AddByContext(SELF, c);
+				Resized(GetWidth(), GetHeight());
+			ELSE
+				WMWindowManager.DefaultAddWindow(SELF);
+			END;
+			shell.editor.editor.SetFocus();
+		END New;
+
+		PROCEDURE Close;
+		BEGIN
+			Close^;
+			DecCount
+		END Close;
+
+		PROCEDURE Handle(VAR x : WMMessages.Message);
+		BEGIN
+			IF (x.msgType = WMMessages.MsgExt) & (x.ext # NIL) THEN
+				IF (x.ext IS KillerMsg) THEN
+					Close;
+				ELSIF (x.ext IS WMRestorable.Storage) THEN
+					x.ext(WMRestorable.Storage).Add("Shell", "WMShell.Restore", SELF, NIL);
+				ELSE
+					Handle^(x);
+				END;
+			ELSE Handle^(x)
+			END
+		END Handle;
+
+	END Window;
+
+VAR
+	nofWindows : LONGINT;
+
+	StrShellComponent : Strings.String;
+
+PROCEDURE InitStrings;
+BEGIN
+	StrShellComponent := Strings.NewString("ShellComponent");
+END InitStrings;
+
+PROCEDURE Restore*(context : WMRestorable.Context);
+VAR window : Window;
+BEGIN
+	ASSERT(context # NIL);
+	NEW(window, context);
+END Restore;
+
+PROCEDURE Open*;
+VAR window : Window;
+BEGIN
+	NEW(window, NIL);
+END Open;
+
+PROCEDURE IncCount;
+BEGIN {EXCLUSIVE}
+	INC(nofWindows)
+END IncCount;
+
+PROCEDURE DecCount;
+BEGIN {EXCLUSIVE}
+	DEC(nofWindows)
+END DecCount;
+
+PROCEDURE Cleanup;
+VAR die : KillerMsg;
+	 msg : WMMessages.Message;
+	 m : WMWindowManager.WindowManager;
+BEGIN {EXCLUSIVE}
+	NEW(die);
+	msg.ext := die;
+	msg.msgType := WMMessages.MsgExt;
+	m := WMWindowManager.GetDefaultManager();
+	m.Broadcast(msg);
+	AWAIT(nofWindows = 0)
+END Cleanup;
+
+BEGIN
+	Modules.InstallTermHandler(Cleanup);
+	InitStrings;
+END WMInterpreterShell.
+
+WMInterpreterShell.Open ~
+
+SystemTools.Free WMInterpreterShell ~
+SystemTools.Free WMInterpreterShell InterpreterShell ~
+
+FOR i := 0 TO 100 DO
+	CMD "SystemTools.Show ?{i}?"
+END;
+
+