reactivated index operators on objects

(including proper handling of var parameters)

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

source/FoxBasic.Mod

@@ -2160,6 +2160,16 @@ VAR
 			Strings.Insert(by, in, pos);
 		END;
 	END Replace;
+	
+	OPERATOR "="*(CONST left: ARRAY OF CHAR; right: String): BOOLEAN;
+	BEGIN
+		RETURN right = StringPool.GetIndex1(left);
+	END "=";
+
+	OPERATOR "="*(left: String; CONST right: ARRAY OF CHAR): BOOLEAN;
+	BEGIN
+		RETURN right = left;
+	END "=";
 
 	PROCEDURE MessageS*(CONST format, s0: ARRAY OF CHAR): MessageString;
 	VAR message: MessageString;

source/FoxIntermediateBackend.Mod

@@ -117,6 +117,11 @@ TYPE
 	SupportedInstructionProcedure* = PROCEDURE {DELEGATE} (CONST instr: IntermediateCode.Instruction; VAR moduleName,procedureName: ARRAY OF CHAR): BOOLEAN;
 	SupportedImmediateProcedure* = PROCEDURE {DELEGATE} (CONST op: IntermediateCode.Operand): BOOLEAN;
 
+	WriteBackCall = POINTER TO RECORD
+		call: SyntaxTree.ProcedureCallDesignator;
+		next: WriteBackCall;
+	END;
+
 	Operand = RECORD
 		mode: SHORTINT;
 		op: IntermediateCode.Operand;
@@ -6178,7 +6183,48 @@ TYPE
 			procedure: SyntaxTree.Procedure;
 			callingConvention: SyntaxTree.CallingConvention;
 			type: IntermediateCode.Type;
-	
+			
+			firstWriteBackCall, currentWriteBackCall: WriteBackCall;
+						
+			(** do preparations before parameter push for array-structured object types (ASOTs):
+				if ASOT is passed as VAR parameter:
+				- allocate temporary variable of math array type
+				- copy contents of ASOT to be passed to temporary variable
+				- use temporary variable as the actual parameter instead
+				- create and store a write-back call in a list (an index operator call that writes the contents of the temp. variable back into the ASOT)
+			**)
+			PROCEDURE PrepareParameter(VAR actualParameter: SyntaxTree.Expression; formalParameter: SyntaxTree.Parameter);
+			VAR
+				expression, left: SyntaxTree.Expression; tempVariableDesignator : SyntaxTree.Designator;
+			BEGIN
+				IF (formalParameter.kind = SyntaxTree.VarParameter) & SemanticChecker.IsIndexOperator(actualParameter) THEN
+					WITH actualParameter: SyntaxTree.ProcedureCallDesignator DO
+						(* prepare writeback for any other "normal" indexer *)
+						variable := GetTemporaryVariable(actualParameter.type.resolved, FALSE, TRUE (* untraced *));
+						tempVariableDesignator := SyntaxTree.NewSymbolDesignator(Basic.invalidPosition, NIL, variable);
+						tempVariableDesignator.SetType(actualParameter.type.resolved);
+						Assign(tempVariableDesignator, actualParameter);
+						IF firstWriteBackCall = NIL THEN
+							NEW(firstWriteBackCall);
+							currentWriteBackCall := firstWriteBackCall
+						ELSE
+							ASSERT(currentWriteBackCall # NIL);
+							NEW(currentWriteBackCall.next);
+							currentWriteBackCall := currentWriteBackCall.next
+						END;
+						
+						(* a [^] . P[] ()*)
+						left := actualParameter.left; (* procedure call designator --> procedure call *)
+						left := left(SyntaxTree.Designator).left; (* procedure call --> caller object *)
+						IF left IS SyntaxTree.DereferenceDesignator THEN (* dereference, if required *)
+							left := left(SyntaxTree.Designator).left;
+						END;
+	 					expression := checker.NewObjectOperatorCall(Basic.invalidPosition, left, 0, actualParameter.parameters, tempVariableDesignator);
+						currentWriteBackCall.call := expression(SyntaxTree.ProcedureCallDesignator);
+					END;
+					actualParameter := tempVariableDesignator;
+				END
+			END PrepareParameter;
 			
 		BEGIN
 			IF Trace THEN TraceEnter("VisitProcedureCallDesignator") END;
@@ -6382,6 +6428,7 @@ TYPE
 				formalParameter := procedureType.firstParameter;
 				FOR i := 0 TO parameters.Length() - 1 DO
 					actualParameter := parameters.GetExpression(i);
+					PrepareParameter(actualParameter, formalParameter);
 
 					IF formalParameter # NIL THEN (* TENTATIVE *)
 						IF isCallOfDynamicOperator  & IsStrictlyPointerToRecord(formalParameter.type) & (formalParameter.access # SyntaxTree.Hidden) THEN (* TODO: remove hidden parameters *)
@@ -6556,8 +6603,27 @@ TYPE
 				END;
 			END;
 
-			IF (resultDesignator = NIL) & (procedureType.returnType # NIL) THEN
+			IF alignment > 1 THEN
+				Emit(Pop(position,sp));
+			END;
 
+			IF backend.cooperative & (callingConvention = SyntaxTree.WinAPICallingConvention) THEN
+				Emit(Pop(position, ap));
+			END;
+
+			
+			IF firstWriteBackCall # NIL THEN 
+				SaveRegisters(); ReleaseUsedRegisters(saved2);					
+				(* perform all write-back calls in the list *)
+				currentWriteBackCall := firstWriteBackCall;
+				WHILE currentWriteBackCall # NIL DO
+					VisitProcedureCallDesignator(currentWriteBackCall.call);
+					currentWriteBackCall := currentWriteBackCall.next
+				END;
+				RestoreRegisters(saved2);
+			END; 
+
+			IF (resultDesignator = NIL) & (procedureType.returnType # NIL) THEN
 				IF structuredReturnType THEN
 					RestoreRegisters(saved);
 					InitOperand(result,ModeReference);
@@ -6569,16 +6635,8 @@ TYPE
 				END;
 			END;
 
-			IF alignment > 1 THEN
-				Emit(Pop(position,sp));
-			END;
-
-			IF backend.cooperative & (callingConvention = SyntaxTree.WinAPICallingConvention) THEN
-				Emit(Pop(position, ap));
-			END;
-
 			destination := dest;
-
+			
 			IF Trace THEN TraceExit("VisitProcedureCallDesignator") END;
 		END VisitProcedureCallDesignator;
 

source/FoxSemanticChecker.Mod

@@ -3925,6 +3925,7 @@ TYPE
 
 			PROCEDURE FindOperator(recordType: SyntaxTree.RecordType; identifier: SyntaxTree.Identifier; actualParameters: SyntaxTree.ExpressionList): SyntaxTree.Operator;
 			VAR bestOperator: SyntaxTree.Operator; bestDistance: LONGINT; numberParameters: LONGINT; procedureType: SyntaxTree.ProcedureType;
+					
 
 				PROCEDURE FindInScope(scope: SyntaxTree.RecordScope; access: SET);
 				VAR operator: SyntaxTree.Operator; distance,i: LONGINT;
@@ -4082,6 +4083,7 @@ TYPE
 					leftBracketDesignator.parameters.AddExpression(bracketDesignator.parameters.GetExpression(i))
 				END;
 				(* only resolve left bracket designator and use as final result *)
+				bracketDesignator.SetRelatedRhs(leftBracketDesignator.relatedRhs);
 				resolvedExpression := ResolveExpression(leftBracketDesignator)
 
 			ELSE
@@ -4095,7 +4097,7 @@ TYPE
 				IF (type IS SyntaxTree.PointerType) & (type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.RecordType) 
 					OR (type IS SyntaxTree.RecordType)
 				THEN
-					resolvedExpression := NewObjectOperatorCall(bracketDesignator.position, designator, 0, bracketDesignator.parameters,NIL);
+					resolvedExpression := NewObjectOperatorCall(bracketDesignator.position, designator, 0, bracketDesignator.parameters,bracketDesignator.relatedRhs);
 					IF resolvedExpression = NIL THEN 
 						Error(bracketDesignator.position,"undefined operator");
 						resolvedExpression := SyntaxTree.invalidDesignator
@@ -7079,10 +7081,15 @@ TYPE
 
 		BEGIN
 			right := ResolveExpression(assignment.right);
+			assignment.left.SetRelatedRhs(right);
 			left := ResolveDesignator(assignment.left);
 
 			IF (left = SyntaxTree.invalidDesignator) OR (right = SyntaxTree.invalidExpression) THEN
 				(* error already handled *)
+			ELSIF IsIndexOperator(left) & left.assignable THEN
+				(* LHS is index write operator call *)
+				procedureCallDesignator :=  left(SyntaxTree.ProcedureCallDesignator);
+				resolvedStatement := SyntaxTree.NewProcedureCallStatement(assignment.position, procedureCallDesignator, assignment.outer);
 			ELSIF CheckVariable(left) THEN
 				expression := NewOperatorCall(assignment.position, Scanner.Becomes, left, right, NIL);
 				IF (expression # NIL) & (expression IS SyntaxTree.ProcedureCallDesignator) THEN
@@ -9382,6 +9389,27 @@ TYPE
 		END;
 		RETURN result
 	END IsExtensibleType;
+	
+	PROCEDURE IsIndexOperator*(expression: SyntaxTree.Expression): BOOLEAN;
+	VAR left: SyntaxTree.Expression; symbol: SyntaxTree.Symbol;
+	BEGIN
+		WITH expression: SyntaxTree.ProcedureCallDesignator DO
+			left := expression.left;
+			WITH left: SyntaxTree.SymbolDesignator DO
+				symbol := left.symbol;
+				WITH symbol: SyntaxTree.Operator DO
+					RETURN symbol.name = "[]";
+				ELSE
+					RETURN FALSE
+				END;
+			ELSE
+				RETURN FALSE
+			END;
+		ELSE
+			RETURN FALSE
+		END;
+	END IsIndexOperator;
+
 
 	PROCEDURE IsUnextensibleRecord(d: SyntaxTree.Expression): BOOLEAN;
 	BEGIN

source/FoxSyntaxTree.Mod

@@ -2193,12 +2193,14 @@ TYPE
 		VAR
 			left-: Expression; (* currently only designators are allowed but for later purposes ... (as for example (a+b).c) *)
 			modifiers-: Modifier;
+			relatedRhs-: Expression;
 
 		PROCEDURE &InitDesignator*(position: Position);
 		BEGIN
 			InitExpression(position);
 			left := NIL;
 			modifiers := NIL;
+			relatedRhs := NIL;
 		END InitDesignator;
 
 		PROCEDURE SetLeft*(expression: Expression);
@@ -2208,6 +2210,12 @@ TYPE
 		PROCEDURE SetModifiers*(flags: Modifier);
 		BEGIN modifiers := flags
 		END SetModifiers;
+		
+		PROCEDURE SetRelatedRhs*(expression: Expression);
+		BEGIN
+			relatedRhs := expression;
+		END SetRelatedRhs;
+		
 
 		PROCEDURE Clone(): Expression;
 		VAR clone: Designator;

source/Oberon.Execution.Test

@@ -7813,3 +7813,62 @@ positive: check push of UNSIGNED constants
 		Check(MAX(UNSIGNED16)); 
 		Check(MAX(UNSIGNED32));
 	END Test.
+
+positive: index operators on objects
+	MODULE Test; (** AUTHOR ""; PURPOSE ""; *)
+
+	TYPE O* = OBJECT
+	VAR a: ARRAY 100 OF LONGINT;
+
+		OPERATOR "[]"* (index: LONGINT): LONGINT;
+		BEGIN
+			RETURN a[index]
+		END "[]";
+
+		OPERATOR "[]"* (index: LONGINT; value: LONGINT);
+		BEGIN
+			a[index] := value;
+		END "[]";
+
+	END O; 
+
+	TYPE Q = OBJECT
+	VAR a: ARRAY 100 OF LONGINT;
+
+		OPERATOR "[]" (index: LONGINT): LONGINT;
+		BEGIN
+			RETURN a[index]
+		END "[]";
+
+		OPERATOR "[]" (index: LONGINT; value: LONGINT);
+		BEGIN
+			a[index] := value;
+		END "[]";
+
+	END Q; 
+
+	PROCEDURE VarTest(VAR a: LONGINT): LONGINT;
+	BEGIN 
+		a := 1000;
+		RETURN 123;
+	END VarTest;
+
+	PROCEDURE Test*;
+	VAR o: O; q: Q;
+	BEGIN
+		NEW(o); 
+		ASSERT(VarTest(o[10])=123);
+		ASSERT(o[10]=1000);
+		o[5] := 555;
+		ASSERT (o[5] = 555);
+		NEW(q); 
+		ASSERT(VarTest(q[10])=123);
+		ASSERT(q[10]=1000);
+		q[5] := 555;
+		ASSERT (q[5] = 555);
+	END Test;
+
+	BEGIN
+		Test;
+	END Test.
+