Patched support for REAL / LONGREAL

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

source/FoxInterpreter.Mod

@@ -289,7 +289,7 @@ TYPE
 		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)
+					IF value IS Integer THEN INCL(s, LONGINT(value(Integer).value))
 					ELSIF value IS Range THEN s := s + {FIRST(value(Range).value)..LAST(value(Range).value)}
 					ELSE Error("wrong value type")
 					END;
@@ -310,7 +310,7 @@ TYPE
 			item.object := a; value := TRUE;
 		END VisitMathArrayExpression;
 
-		PROCEDURE NewInt(i: LONGINT);
+		PROCEDURE NewInt(i: HUGEINT);
 		VAR v: Integer;
 		BEGIN
 			NEW(v, i); item.object := v; value := TRUE
@@ -353,7 +353,7 @@ TYPE
 		END NewChar;
 
 		PROCEDURE VisitUnaryExpression*(x: SyntaxTree.UnaryExpression);
-		VAR value: Value; i: LONGINT; r: LONGREAL; b: BOOLEAN; operator: LONGINT;
+		VAR value: Value; i: HUGEINT; r: LONGREAL; b: BOOLEAN; operator: LONGINT;
 		BEGIN
 			operator := x.operator;
 			IF ~GetValue(x, value) THEN RETURN END;
@@ -388,7 +388,7 @@ TYPE
 		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;
+		VAR left, right: Value; operator: LONGINT; li, ri: HUGEINT; 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;
@@ -476,7 +476,7 @@ TYPE
 		END VisitBinaryExpression;
 
 		PROCEDURE VisitRangeExpression*(x: SyntaxTree.RangeExpression);
-		VAR first,last,step: LONGINT; value: Integer;
+		VAR first,last,step: HUGEINT; value: Integer;
 		BEGIN
 			IF ~ExpectInteger(x.first, value) THEN RETURN END;
 			first := value.value;
@@ -588,16 +588,6 @@ TYPE
 				item.in := NIL;
 			END;
 		END VisitSelectorDesignator;
-
-		PROCEDURE PushParameters(e: SyntaxTree.ExpressionList);
-		VAR i: LONGINT; value: Value;
-		BEGIN
-			FOR i := 0 TO e.Length()-1 DO
-				IF GetValue(e.GetExpression(i), value) THEN
-					callStack.PushL(value(Integer).value);
-				END;
-			END;
-		END PushParameters;
 		
 	
 		PROCEDURE VisitParameterDesignator*(x: SyntaxTree.ParameterDesignator);
@@ -638,7 +628,7 @@ TYPE
 		PROCEDURE VisitBracketDesignator*(x: SyntaxTree.BracketDesignator);
 		VAR array: MathArrayValue; i: LONGINT; element: Value; index: Integer; obj: PersistentObjects.Object;
 			leftValue, rightValue: Value; filter: InterpreterSymbols.ObjectFilter; expression: SyntaxTree.Expression;
-			attribute, value: ARRAY 128 OF CHAR;
+			attribute, value: ARRAY 128 OF CHAR; val: LONGINT;
 		BEGIN
 			Expression(x.left);
 			IF (item.object # NIL) & (item.object IS MathArrayValue) THEN
@@ -646,7 +636,7 @@ TYPE
 				FOR i := 0 TO x.parameters.Length()-1 DO
 					array := element(MathArrayValue);
 					IF GetInteger(x.parameters.GetExpression(i), index) THEN
-						element := array.GetValue(index.value);
+						element := array.GetValue(LONGINT(index.value));
 					END;
 				END;
 				item.object := element;
@@ -670,9 +660,9 @@ TYPE
 								obj := filter.Filter(obj, "name", value);
 							ELSIF leftValue IS Integer THEN
 								IF obj IS PersistentObjects.ObjectList THEN
-									item.object := obj(PersistentObjects.ObjectList).GetElement(leftValue(Integer).value)
+									item.object := obj(PersistentObjects.ObjectList).GetElement(LONGINT(leftValue(Integer).value))
 								ELSIF obj IS Container THEN
-									item.object := obj(Container).GetItem(leftValue(Integer).value)
+									item.object := obj(Container).GetItem(LONGINT(leftValue(Integer).value))
 								ELSE Error("cannot be indexed")
 								END;
 							END;
@@ -1082,7 +1072,7 @@ TYPE
 		END VisitRepeatStatement;
 
 		PROCEDURE VisitForStatement*(x: SyntaxTree.ForStatement);
-		VAR fromV, toV, byV: Integer; from, to, by,i: LONGINT; int: Integer;
+		VAR fromV, toV, byV: Integer; from, to, by,i: HUGEINT; int: Integer;
 		BEGIN
 			IF ExpectInteger(x.from, fromV) & ExpectInteger(x.to, toV) THEN
 				from := fromV.value;

source/FoxInterpreterSymbols.Mod

@@ -101,6 +101,7 @@ TYPE
 			InitSymbol(name);
 			ASSERT(m # NIL);
 			self := FindType(m.typeInfo, "@Self");
+			ASSERT(self # NIL);
 		END InitModule;
 		
 		PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
@@ -218,75 +219,75 @@ TYPE
 		END PushSz;
 		
 		PROCEDURE Call(adr: ADDRESS);
-		VAR esp: ADDRESS; P: Procedure; h: HUGEINT
-		TYPE 
-			Procedure = PROCEDURE(): HUGEINT;
+		TYPE
+			P = PROCEDURE();
+		VAR
+			esp: ADDRESS;
+			p: P; 
 		BEGIN
-			P := SYSTEM.VAL(Procedure, adr); 
+			p := SYSTEM.VAL(P, adr);
 			esp := Machine.CurrentSP();
 			Machine.SetSP(esp-size);
 			IF size > 0 THEN 
 				SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
 			END;
-			H := P();
+			p();
 			Machine.SetSP(esp);
-		END Call;
-		
-		PROCEDURE ResH(): HUGEINT;
-		BEGIN
-			RETURN H;
-		END ResH;
-
-		PROCEDURE ResL(): LONGINT;
-		BEGIN
-			RETURN LONGINT(H);
-		END ResL;
-
-		PROCEDURE ResI(): INTEGER;
-		BEGIN
-			RETURN INTEGER(H);
-		END ResI;
-
-		PROCEDURE ResS(): SHORTINT;
-		BEGIN
-			RETURN SHORTINT(H);
-		END ResS;
-
-		PROCEDURE ResC(): CHAR;
-		BEGIN
-			RETURN CHR(H);
-		END ResC;
-
-		PROCEDURE ResB(): BOOLEAN;
-		BEGIN
-			RETURN SYSTEM.VAL(BOOLEAN, ResC());
-		END ResB;
-
-		PROCEDURE ResSet(): SET;
-		BEGIN
-			RETURN SYSTEM.VAL(SET,H);
-		END ResSet;
+		END Call; 
 
-		PROCEDURE ResSz(): SIZE;
+		PROCEDURE CallH(adr: ADDRESS): HUGEINT;
+		TYPE
+			P = PROCEDURE(): HUGEINT;
+		VAR
+			res: HUGEINT; esp: ADDRESS;
+			p: P; 
 		BEGIN
-			RETURN SYSTEM.VAL(SIZE, H);
-		END ResSz;
-
-		PROCEDURE ResA(): ADDRESS;
-		BEGIN
-			RETURN SYSTEM.VAL(ADDRESS, H)
-		END ResA;
+			p := SYSTEM.VAL(P, adr);
+			esp := Machine.CurrentSP();
+			Machine.SetSP(esp-size);
+			IF size > 0 THEN 
+				SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
+			END;
+			res := p();
+			Machine.SetSP(esp);
+			RETURN res;
+		END CallH; 
 
-		PROCEDURE ResR(): REAL;
+		PROCEDURE CallR(adr: ADDRESS): REAL;
+		TYPE
+			P = PROCEDURE(): REAL;
+		VAR
+			res: REAL; esp: ADDRESS;
+			p: P; 
 		BEGIN
-			RETURN SYSTEM.VAL(REAL, ResL())
-		END ResR;
+			p := SYSTEM.VAL(P, adr);
+			esp := Machine.CurrentSP();
+			Machine.SetSP(esp-size);
+			IF size > 0 THEN 
+				SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
+			END;
+			res := p();
+			Machine.SetSP(esp);
+			RETURN res;
+		END CallR; 
 
-		PROCEDURE ResX(): LONGREAL;
+		PROCEDURE CallX(adr: ADDRESS): LONGREAL;
+		TYPE
+			P = PROCEDURE(): LONGREAL;
+		VAR
+			res: LONGREAL; esp: ADDRESS;
+			p: P; 
 		BEGIN
-			RETURN SYSTEM.VAL(LONGREAL, ResH())
-		END ResX;
-
+			p := SYSTEM.VAL(P, adr);
+			esp := Machine.CurrentSP();
+			Machine.SetSP(esp-size);
+			IF size > 0 THEN 
+				SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
+			END;
+			res := p();
+			Machine.SetSP(esp);
+			RETURN res;
+		END CallX; 
 	END Callstack;
 
 	ProcedureResult*= OBJECT(SymbolResult)
@@ -406,28 +407,28 @@ TYPE
 			type := proc.returnType;
 			CASE type.class OF
 				sfTypeSHORTINT,sfTypeSIGNED8 : 
-					NEW(int, stack.ResS()); 
+					NEW(int, SHORTINT(stack.CallH(address))); 
 					RETURN int;
 			| sfTypeINTEGER,sfTypeSIGNED16 : 
-					NEW(int, stack.ResI()); 
+					NEW(int,  INTEGER(stack.CallH(address))); 
 					RETURN int;
 			| sfTypeLONGINT,sfTypeSIGNED32: 
-					NEW(int, stack.ResL()); 
+					NEW(int,  LONGINT(stack.CallH(address))); 
 					RETURN int;
 			| sfTypeHUGEINT,sfTypeSIGNED64: 
-					NEW(int, SHORT(stack.ResH())); 
+					NEW(int, stack.CallH(address)); 
 					RETURN int;
 			|sfTypeREAL:
-				 NEW(real, stack.ResR()); 
+				 NEW(real, stack.CallR(address)); 
 				 RETURN real
 			|sfTypeLONGREAL:
-				NEW(real, stack.ResX());
+				NEW(real, stack.CallX(address));
 				RETURN real; 
 			|sfTypeBOOLEAN:
-				NEW(bool, stack.ResB()); 
+				NEW(bool, SYSTEM.VAL(BOOLEAN, stack.CallH(address))); 
 				RETURN bool; 
 			|sfTypeSET:
-				NEW(set, stack.ResSet());
+				NEW(set,  SYSTEM.VAL(SET, stack.CallH(address))); 
 				RETURN set;
 			| sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord:  (* pointers are passed as varpars *)
 				RETURN NIL;
@@ -768,9 +769,9 @@ TYPE
 	END AddressValue;
 
 	IntegerValue*=OBJECT(Value)
-	VAR value*: LONGINT;
+	VAR value*: HUGEINT;
 
-		PROCEDURE & InitInteger*(value: LONGINT);
+		PROCEDURE & InitInteger*(value: HUGEINT);
 		BEGIN InitValue; SELF.value := value; type := "IntegerValue";
 		END InitInteger;
 
@@ -779,15 +780,16 @@ TYPE
 		END Enumerate;
 
 		PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
+		VAR val: LONGINT;
 		BEGIN
-			IF name = StrValue THEN c.GetInteger(value);
+			IF name = StrValue THEN c.GetInteger(val); value := val;
 			ELSE Set^(name, index, c);
 			END;
 		END Set;
 
 		PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
 		BEGIN
-			IF name = StrValue THEN c.SetInteger(value);
+			IF name = StrValue THEN c.SetInteger(LONGINT(value));
 			ELSE Get^(name, index, c);
 			END;
 		END Get;