Experimental "fictive" fields for better high-level expressiveness of low-level heap data structures -- might become very handy for device drivers but should better never be used in normal programming (allows, in principle, to implement unions)

Some patches for indexer operators

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

source/FoxGlobal.Mod

@@ -17,6 +17,7 @@ CONST
 	StringExit*= "FINAL";
 	StringNoPAF*="NOPAF";
 	StringFixed*="FIXED";
+	StringFictive*="FICTIVE";
 	StringAligned*="ALIGNED";
 	StringAlignStack*="ALIGNSTACK";
 	StringFinal*="FINAL";
@@ -184,7 +185,7 @@ VAR
 	(* names *)
 	SelfParameterName-,ReturnParameterName-,SystemName-,systemName-,PointerReturnName-, ResultName-,
 	A2Name-,OberonName-,ArrayBaseName-,RecordBodyName-,ModuleBodyName-,
-	NameWinAPI-,NameC-,NameMovable-,NameUntraced-,NameDelegate-,NameInterrupt-, NamePcOffset-, NameNoPAF-,NameEntry-, NameExit-, NameFixed-,NameAligned-,NameStackAligned-,
+	NameWinAPI-,NameC-,NameMovable-,NameUntraced-,NameDelegate-,NameInterrupt-, NamePcOffset-, NameNoPAF-,NameEntry-, NameExit-, NameFixed-,NameFictive-, NameAligned-,NameStackAligned-,
 	NameExclusive-,NameActive-,NamePriority-,NameSafe-,NameRealtime-, NameDynamic-, NameDataMemorySize-, NameCodeMemorySize-
 	, NameChannelWidth-, NameChannelDepth-, NameChannelModule-, NameVector-, NameFloatingPoint-, NameNoMul-,NameNonBlockingIO-, NameTRM-, NameTRMS-, NameEngine-, NameFinal-, NameAbstract-,
 	NameFrequencyDivider-, NameRegister-,NameNoReturn-,NamePlain-,NameUnsafe-,NameDisposable-,NameUnchecked-,NameUncooperative-: SyntaxTree.Identifier;
@@ -304,19 +305,21 @@ TYPE
 
 			variable := x.recordScope.firstVariable;
 			WHILE (variable # NIL) DO
-				size := SizeOf(variable.type.resolved);
-				IF size < 0 THEN RETURN FALSE END;
+				IF ~variable.fictive THEN
+					size := SizeOf(variable.type.resolved);
+					IF size < 0 THEN RETURN FALSE END;
 
-				IF variable.alignment > 0 THEN
-					thisAlignment := variable.alignment*dataUnit;
-				ELSE
-					thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
-				END;
-				Basic.Align(offset, thisAlignment);
-				IF thisAlignment  > alignment THEN alignment := thisAlignment END;
+					IF variable.alignment > 0 THEN
+						thisAlignment := variable.alignment*dataUnit;
+					ELSE
+						thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
+					END;
+					Basic.Align(offset, thisAlignment);
+					IF thisAlignment  > alignment THEN alignment := thisAlignment END;
 
-				variable.SetOffset(offset);
-				INC(offset,size);
+					variable.SetOffset(offset);
+					INC(offset,size);
+				END;
 				variable := variable.nextVariable;
 			END;
 			x.SetAlignmentInBits(alignment);
@@ -351,19 +354,21 @@ TYPE
 
 			variable := x.cellScope.firstVariable;
 			WHILE (variable # NIL) DO
-				size := SizeOf(variable.type.resolved);
-				IF size < 0 THEN RETURN FALSE END;
+				IF ~variable.fictive THEN
+					size := SizeOf(variable.type.resolved);
+					IF size < 0 THEN RETURN FALSE END;
 
-				IF variable.alignment > 0 THEN
-					thisAlignment := variable.alignment*dataUnit;
-				ELSE
-					thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
-				END;
-				Basic.Align(offset, thisAlignment);
-				IF thisAlignment  > alignment THEN alignment := thisAlignment END;
+					IF variable.alignment > 0 THEN
+						thisAlignment := variable.alignment*dataUnit;
+					ELSE
+						thisAlignment := AlignmentOf(SELF.variableAlignment, variable.type.resolved);
+					END;
+					Basic.Align(offset, thisAlignment);
+					IF thisAlignment  > alignment THEN alignment := thisAlignment END;
 
-				variable.SetOffset(offset);
-				INC(offset,size);
+					variable.SetOffset(offset);
+					INC(offset,size);
+				END;
 				variable := variable.nextVariable;
 			END;
 			x.SetAlignmentInBits(alignment);
@@ -392,7 +397,7 @@ TYPE
 
 				variable := scope.firstVariable;
 				WHILE (variable # NIL) DO
-					IF variable.externalName = NIL THEN
+					IF (variable.externalName = NIL) & ~variable.fictive THEN
 						size := SizeOf(variable.type.resolved);
 						IF size < 0 THEN RETURN FALSE END;
 						DEC(offset,size);
@@ -1629,6 +1634,7 @@ TYPE
 		NameEntry := SyntaxTree.NewIdentifier(StringEntry);
 		NameExit := SyntaxTree.NewIdentifier(StringExit);
 		NameFixed := SyntaxTree.NewIdentifier(StringFixed);
+		NameFictive := SyntaxTree.NewIdentifier(StringFictive);
 		NameAligned := SyntaxTree.NewIdentifier(StringAligned);
 		NameStackAligned := SyntaxTree.NewIdentifier(StringAlignStack);
 		NameExclusive := SyntaxTree.NewIdentifier(StringExclusive);

source/FoxIntermediateBackend.Mod

@@ -5474,7 +5474,7 @@ TYPE
 							NEW(currentWriteBackCall.next);
 							currentWriteBackCall := currentWriteBackCall.next
 						END;
- 						expression := checker.NewObjectOperatorCall(SemanticChecker.InvalidPosition, designator.relatedAsot, designator.relatedIndexList, tempVariableDesignator);
+ 						expression := checker.NewObjectOperatorCall(SemanticChecker.InvalidPosition, designator.relatedAsot, 0, designator.relatedIndexList, tempVariableDesignator);
 						currentWriteBackCall.call := expression(SyntaxTree.ProcedureCallDesignator);
 					END
 				END

source/FoxSemanticChecker.Mod

@@ -2813,6 +2813,7 @@ TYPE
 			value: SyntaxTree.Value;
 			leftFirst, leftLast, leftStep, rightFirst, rightLast, rightStep: LONGINT;
 			integerConstantFolding: BOOLEAN;
+			list: SyntaxTree.ExpressionList;
 
 			PROCEDURE NewBool(v: BOOLEAN);
 			BEGIN
@@ -2889,6 +2890,12 @@ TYPE
 				operatorCall := NewOperatorCall(binaryExpression.position,operator,left,right,NIL);
 			END;
 
+			IF (operatorCall = NIL) & IsPointerToObject(left.type) THEN
+				list := SyntaxTree.NewExpressionList();
+				list.AddExpression(right);
+				operatorCall := NewObjectOperatorCall(binaryExpression.position, left, operator, NIL, right);
+			END;
+
 			IF operatorCall # NIL THEN
 				result := operatorCall;
 				type := operatorCall.type;
@@ -4150,18 +4157,18 @@ TYPE
 			RETURN result
 		END NewIndexOperatorCall;
 
-		PROCEDURE NewObjectOperatorCall*(position: LONGINT; left: SyntaxTree.Expression; parameters: SyntaxTree.ExpressionList; rhs: SyntaxTree.Expression): SyntaxTree.Designator;
+		PROCEDURE NewObjectOperatorCall*(position: LONGINT; left: SyntaxTree.Expression; oper: LONGINT; parameters: SyntaxTree.ExpressionList; rhs: SyntaxTree.Expression): SyntaxTree.Designator;
 		VAR type: SyntaxTree.Type; expression: SyntaxTree.Expression; op: SyntaxTree.Operator; recordType: SyntaxTree.RecordType;
 			actualParameters: SyntaxTree.ExpressionList; i: LONGINT; result: SyntaxTree.Designator;
 
 			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;
 				CONST trace = FALSE;
 				BEGIN
 					IF trace THEN
-
 						FOR i := 0 TO actualParameters.Length()-1 DO
 							Printout.Info("par", actualParameters.GetExpression(i));
 						END;
@@ -4184,7 +4191,12 @@ TYPE
 
 			BEGIN
 				bestDistance := Infinity; bestOperator := NIL; numberParameters := actualParameters.Length();
-				identifier := SyntaxTree.NewIdentifier("[]");
+				IF oper = 0 THEN  (* index *)
+					identifier := SyntaxTree.NewIdentifier("[]");
+				ELSE
+					identifier := Global.GetIdentifier(oper,currentScope.ownerModule.case);
+				END;
+				
 				WHILE (recordType # NIL) DO
 					FindInScope(recordType.recordScope,SyntaxTree.ReadOnly);
 					recordType := recordType.GetBaseRecord();
@@ -4193,13 +4205,15 @@ TYPE
 			END FindOperator;
 		BEGIN
 			type := left.type.resolved;
-
+			IF ~(type IS SyntaxTree.PointerType) THEN RETURN NIL END;
 			recordType := type(SyntaxTree.PointerType).pointerBase.resolved(SyntaxTree.RecordType);
 
 			actualParameters := SyntaxTree.NewExpressionList();
-			FOR i := 0 TO parameters.Length()-1 DO
-				expression := ResolveExpression(parameters.GetExpression(i));
-				actualParameters.AddExpression(expression);
+			IF parameters # NIL THEN
+				FOR i := 0 TO parameters.Length()-1 DO
+					expression := ResolveExpression(parameters.GetExpression(i));
+					actualParameters.AddExpression(expression);
+				END;
 			END;
 			IF rhs # NIL THEN actualParameters.AddExpression(rhs) END;
 
@@ -4226,8 +4240,7 @@ TYPE
 
 				IF rhs # NIL THEN result.SetAssignable(TRUE) END;
 			ELSE
-				Error(position,Diagnostics.Invalid,"undefined operator");
-				result := SyntaxTree.invalidDesignator
+				result := NIL;
 			END;
 			RETURN result;
 		END NewObjectOperatorCall;
@@ -4317,8 +4330,12 @@ TYPE
 
 				(*!!! clean up *)
 				IF (type IS SyntaxTree.PointerType) & (type(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.RecordType) & ~IsArrayStructuredObjectType(type) THEN
-					resolvedExpression := NewObjectOperatorCall(bracketDesignator.position, designator, bracketDesignator.parameters,bracketDesignator.relatedRhs);
-					RETURN
+					resolvedExpression := NewObjectOperatorCall(bracketDesignator.position, designator, 0, bracketDesignator.parameters,bracketDesignator.relatedRhs);
+					IF resolvedExpression = NIL THEN 
+						Error(bracketDesignator.position,Diagnostics.Invalid,"undefined operator");
+						resolvedExpression := SyntaxTree.invalidDesignator
+					END;
+					RETURN;
 				END;
 
 				i := 0;
@@ -6579,6 +6596,12 @@ TYPE
 						Error(position,Diagnostics.Invalid,"fixed position not possible in procedure");
 					END;
 					variable.SetAlignment(TRUE, value);
+				ELSIF HasValue(modifiers, Global.NameFictive, position, value) THEN
+					IF (variable.scope IS SyntaxTree.ProcedureScope) THEN
+						Error(position, Diagnostics.Invalid,"fictive offset not possible in procedure");
+					END;
+					variable.SetFictive(TRUE);
+					variable.SetOffset(value*system.dataUnit);
 				END;
 				IF HasFlag(modifiers, Global.NameRegister, position) THEN variable.SetUseRegister(TRUE) END;
 				IF variable.type.resolved IS SyntaxTree.CellType THEN
@@ -8716,7 +8739,7 @@ TYPE
 
 			ELSIF to IS SyntaxTree.PointerType THEN
 				result := (this IS SyntaxTree.NilType) OR ((this IS SyntaxTree.AddressType) OR (this IS SyntaxTree.IntegerType)) & to(SyntaxTree.PointerType).isUnsafe OR
-						IsPointerType(this) & (IsTypeExtension(to,this) OR ((to(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.ArrayType) & SameType(to,this)))
+						IsPointerType(this) & (IsTypeExtension(to,this) OR to(SyntaxTree.PointerType).isUnsafe OR ((to(SyntaxTree.PointerType).pointerBase.resolved IS SyntaxTree.ArrayType) & SameType(to,this)))
 				     & (~to.isRealtime OR this.isRealtime);
 			ELSIF to IS SyntaxTree.ProcedureType THEN
 				result := (this IS SyntaxTree.NilType) OR (this IS SyntaxTree.ProcedureType) & SameType(to(SyntaxTree.ProcedureType),this(SyntaxTree.ProcedureType))

source/FoxSyntaxTree.Mod

@@ -3192,6 +3192,7 @@ TYPE
 	VAR
 		nextVariable-: Variable;
 		untraced-: BOOLEAN;
+		fictive-: BOOLEAN; (* variable is not allocated but has a fixed offset *)
 		useRegister-: BOOLEAN; registerNumber-: LONGINT;
 		modifiers-: Modifier;
 		initializer-: Expression;
@@ -3209,6 +3210,7 @@ TYPE
 			registerNumber := -1;
 			usedAsReference := FALSE;
 			initializer := NIL;
+			fictive := FALSE;
 		END InitVariable;
 
 		PROCEDURE UsedAsReference*;
@@ -3216,7 +3218,6 @@ TYPE
 			usedAsReference := TRUE
 		END UsedAsReference;
 
-
 		PROCEDURE SetUntraced*(u: BOOLEAN);
 		BEGIN untraced := u
 		END SetUntraced;
@@ -3230,8 +3231,13 @@ TYPE
 		BEGIN
 			registerNumber := reg
 		END SetRegisterNumber;
-
-
+		
+		PROCEDURE SetFictive*(f: BOOLEAN);
+		BEGIN
+			fictive := f;
+			IF fictive THEN SetUntraced(TRUE) END;
+		END SetFictive;
+		
 		PROCEDURE SetModifiers*(flag: Modifier);
 		BEGIN SELF.modifiers := flag;
 		END SetModifiers;