Browse Source

Recursion problems solved: Support of value typed objects complete.

TYPE R = RECORD
  x,y: LONGINT;
  PROCEDURE AnyMethod();
  BEGIN x := 10; y := 11
  END AnyMethod;
END R;

PROCEDURE (r: R) Add(CONST t: R): R;
VAR res: R;
BEGIN
  res.x := r.x + t.x; res.y := r.y + r.y; RETURN res;
END Add;


git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@7049 8c9fc860-2736-0410-a75d-ab315db34111
felixf 8 years ago
parent
commit
1fc9dac2e3

+ 5 - 1
source/FoxFingerPrinter.Mod

@@ -861,7 +861,7 @@ TYPE
 	                      <*> FP(parameterType) [-> Name(parameterName)]  }
 	                      <*> FP(parameterType) [-> Name(parameterName)]  }
 		 *)
 		 *)
 		PROCEDURE FPSignature(VAR fp: LONGINT; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
 		PROCEDURE FPSignature(VAR fp: LONGINT; t: SyntaxTree.ProcedureType; isOperator: BOOLEAN);
-		VAR par,self: SyntaxTree.Parameter;
+		VAR par,self: SyntaxTree.Parameter; deep: BOOLEAN;
 
 
 			(* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
 			(* fp = fp & (fpModeVarPar | fpModeConstPar | fpModePar) [ & Name ] *)
 			PROCEDURE FPPar(VAR fp: LONGINT;  par: SyntaxTree.Parameter);
 			PROCEDURE FPPar(VAR fp: LONGINT;  par: SyntaxTree.Parameter);
@@ -894,7 +894,11 @@ TYPE
 			IF Trace THEN
 			IF Trace THEN
 				TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,-8); D.Ln;
 				TraceIndent; D.Str("FPSignature enter "); D.Hex(fp,-8); D.Ln;
 			END;
 			END;
+			deep := SELF.deep;
+			SELF.deep := FALSE;
 			FPType(fp,t.returnType);
 			FPType(fp,t.returnType);
+			SELF.deep := deep;
+			
 			IF Trace THEN
 			IF Trace THEN
 				TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,-8); D.Ln;
 				TraceIndent; D.Str("FPSignature after return type "); D.Hex(fp,-8); D.Ln;
 			END;
 			END;

+ 3 - 0
source/FoxIntermediateBackend.Mod

@@ -9088,6 +9088,9 @@ TYPE
 				IF backend.cooperative THEN
 				IF backend.cooperative THEN
 					IntermediateCode.AddOffset(result.op,ToMemoryUnits(system,addressType.sizeInBits));
 					IntermediateCode.AddOffset(result.op,ToMemoryUnits(system,addressType.sizeInBits));
 				END;
 				END;
+				IF ~x.type.resolved.IsPointer() THEN (* var par ! *)
+					MakeMemory(result.op, result.op, addressType, 0);
+				END;
 				(* tag must be loaded when dereferencing SELF pointer *)
 				(* tag must be loaded when dereferencing SELF pointer *)
 			END;
 			END;
 			destination := dest;
 			destination := dest;

+ 1 - 0
source/FoxParser.Mod

@@ -1486,6 +1486,7 @@ TYPE
 					IF Peek(Scanner.Identifier) THEN VariableDeclaration( recordScope ) END;
 					IF Peek(Scanner.Identifier) THEN VariableDeclaration( recordScope ) END;
 				UNTIL ~Optional( Scanner.Semicolon );
 				UNTIL ~Optional( Scanner.Semicolon );
 			END;
 			END;
+			WHILE Optional(Scanner.Procedure) DO ProcedureDeclaration(recordScope); Ignore(Scanner.Semicolon) END; 
 			Check( Scanner.End );
 			Check( Scanner.End );
 			IF Trace THEN E( "RecordType" ) END;
 			IF Trace THEN E( "RecordType" ) END;
 			RETURN recordType
 			RETURN recordType

+ 32 - 11
source/FoxSemanticChecker.Mod

@@ -1035,7 +1035,11 @@ TYPE
 						Error(position, "invalid inheritance of disposable types");
 						Error(position, "invalid inheritance of disposable types");
 					END;
 					END;
 				END;
 				END;
-				Declarations(x.recordScope, FALSE);
+				Declarations(x.recordScope, FALSE, FALSE, TRUE);
+				
+				x.SetState(SyntaxTree.Resolved);
+				
+				Declarations(x.recordScope, FALSE, TRUE, FALSE);
 
 
 				ResolveArrayStructure(x);
 				ResolveArrayStructure(x);
 
 
@@ -1207,7 +1211,7 @@ TYPE
 					END;
 					END;
 				CheckModifiers(modifier, FALSE);
 				CheckModifiers(modifier, FALSE);
 
 
-				Declarations(x.cellScope, SkipImplementation(x));
+				Declarations(x.cellScope, SkipImplementation(x),TRUE,TRUE);
 				
 				
 				(* process parameters *)
 				(* process parameters *)
 				prev := currentScope;
 				prev := currentScope;
@@ -6412,7 +6416,7 @@ TYPE
 					resolvedExpression := NewSupercallDesignator(arrowDesignator.position,left);
 					resolvedExpression := NewSupercallDesignator(arrowDesignator.position,left);
 				ELSE
 				ELSE
 					IF IsPointerToObject(left.type) THEN
 					IF IsPointerToObject(left.type) THEN
-						Warning(arrowDesignator.position,  "forbidden dereference on object"); 
+						(* Warning(arrowDesignator.position,  "forbidden dereference on object"); *)
 					END;
 					END;
 					resolvedExpression := NewDereferenceDesignator(arrowDesignator.position,left)
 					resolvedExpression := NewDereferenceDesignator(arrowDesignator.position,left)
 				END
 				END
@@ -6592,6 +6596,7 @@ TYPE
 		BEGIN
 		BEGIN
 			IF Trace THEN D.Str("VisitTypeDeclaration "); D.Str0(typeDeclaration.name);  D.Ln;  END;
 			IF Trace THEN D.Str("VisitTypeDeclaration "); D.Str0(typeDeclaration.name);  D.Ln;  END;
 			IF SymbolNeedsResolution(typeDeclaration) THEN
 			IF SymbolNeedsResolution(typeDeclaration) THEN
+				typeDeclaration.SetState(SyntaxTree.Resolved);
 				prevScope := currentScope;
 				prevScope := currentScope;
 				currentScope := typeDeclaration.scope;
 				currentScope := typeDeclaration.scope;
 				typeDeclaration.SetType(SyntaxTree.typeDeclarationType);
 				typeDeclaration.SetType(SyntaxTree.typeDeclarationType);
@@ -6815,6 +6820,7 @@ TYPE
 		PROCEDURE VisitProcedure(procedure: SyntaxTree.Procedure);
 		PROCEDURE VisitProcedure(procedure: SyntaxTree.Procedure);
 		VAR super,proc: SyntaxTree.Procedure; record: SyntaxTree.RecordType;
 		VAR super,proc: SyntaxTree.Procedure; record: SyntaxTree.RecordType;
 			procedureType: SyntaxTree.ProcedureType;
 			procedureType: SyntaxTree.ProcedureType;
+			type: SyntaxTree.Type;
 			selfParameter: SyntaxTree.Parameter; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
 			selfParameter: SyntaxTree.Parameter; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
 			qualifiedType: SyntaxTree.QualifiedType;
 			qualifiedType: SyntaxTree.QualifiedType;
 			value: LONGINT;
 			value: LONGINT;
@@ -6887,6 +6893,7 @@ TYPE
 				CheckModifiers(modifiers, TRUE);
 				CheckModifiers(modifiers, TRUE);
 				
 				
 
 
+				procedure.SetState(SyntaxTree.Resolved);
 				
 				
 				FixProcedureType(procedureType);
 				FixProcedureType(procedureType);
 				currentIsRealtime := procedureType.isRealtime;
 				currentIsRealtime := procedureType.isRealtime;
@@ -6989,7 +6996,7 @@ TYPE
 				ELSIF procedure.isConstructor THEN
 				ELSIF procedure.isConstructor THEN
 					Error(procedure.position,"procedure illegaly marked as initializer - not in object scope");
 					Error(procedure.position,"procedure illegaly marked as initializer - not in object scope");
 				END;
 				END;
-				Declarations(procedure.procedureScope, FALSE);
+				Declarations(procedure.procedureScope, FALSE, TRUE,TRUE);
 				(* body resolution part done as late fix of the procedure type *)
 				(* body resolution part done as late fix of the procedure type *)
 				procedure.SetState(SyntaxTree.Resolved);
 				procedure.SetState(SyntaxTree.Resolved);
 				currentIsRealtime := recentIsRealtime;
 				currentIsRealtime := recentIsRealtime;
@@ -8304,7 +8311,7 @@ TYPE
 
 
 			Declarations depend on other declarations, this procedure is neither thread safe not would it be wise to try concurrency here
 			Declarations depend on other declarations, this procedure is neither thread safe not would it be wise to try concurrency here
 		**)
 		**)
-		PROCEDURE Declarations(scope: SyntaxTree.Scope; skipImplementation: BOOLEAN);
+		PROCEDURE Declarations(scope: SyntaxTree.Scope; skipImplementation: BOOLEAN; procedures, nonProcedures: BOOLEAN);
 		VAR
 		VAR
 			constant: SyntaxTree.Constant;
 			constant: SyntaxTree.Constant;
 			typeDeclaration: SyntaxTree.TypeDeclaration;
 			typeDeclaration: SyntaxTree.TypeDeclaration;
@@ -8374,7 +8381,8 @@ TYPE
 			prevScope := currentScope;
 			prevScope := currentScope;
 			currentScope := scope;
 			currentScope := scope;
 			error := FALSE;
 			error := FALSE;
-
+			
+			IF nonProcedures THEN
 			(* first enter all symbols in scope *)
 			(* first enter all symbols in scope *)
 			IF scope IS SyntaxTree.ModuleScope THEN
 			IF scope IS SyntaxTree.ModuleScope THEN
 				(* treat imports first for a module scope, , set default context if necessary *)
 				(* treat imports first for a module scope, , set default context if necessary *)
@@ -8461,6 +8469,7 @@ TYPE
 					END;
 					END;
 				END;
 				END;
 			END;
 			END;
+			END;
 			(*
 			(*
 			procedure := scope.firstProcedure;
 			procedure := scope.firstProcedure;
 			WHILE (procedure # NIL) DO
 			WHILE (procedure # NIL) DO
@@ -8495,10 +8504,20 @@ TYPE
 			symbol := scope.firstSymbol;
 			symbol := scope.firstSymbol;
 			WHILE(symbol # NIL) DO
 			WHILE(symbol # NIL) DO
 				IF ~(symbol IS SyntaxTree.Parameter) OR (symbol(SyntaxTree.Parameter).ownerType IS SyntaxTree.CellType) THEN
 				IF ~(symbol IS SyntaxTree.Parameter) OR (symbol(SyntaxTree.Parameter).ownerType IS SyntaxTree.CellType) THEN
-					ResolveSymbol(symbol);
+					IF (symbol IS SyntaxTree.Procedure) THEN
+						IF procedures THEN
+							ResolveSymbol(symbol);
+						END;
+					ELSE
+						IF nonProcedures THEN
+							ResolveSymbol(symbol);
+						END;
+					END;
 				END;
 				END;
 				symbol := symbol.nextSymbol;
 				symbol := symbol.nextSymbol;
 			END;
 			END;
+			
+			
 
 
 			IF (scope IS SyntaxTree.ProcedureScope) & scope(SyntaxTree.ProcedureScope).ownerProcedure.type.isRealtime THEN
 			IF (scope IS SyntaxTree.ProcedureScope) & scope(SyntaxTree.ProcedureScope).ownerProcedure.type.isRealtime THEN
 				symbol := scope.firstSymbol;
 				symbol := scope.firstSymbol;
@@ -8515,11 +8534,11 @@ TYPE
 				END;
 				END;
 			END;
 			END;
 
 
-			IF ~error & ~system.GenerateVariableOffsets(scope) THEN
+			IF ~error & procedures & ~system.GenerateVariableOffsets(scope) THEN
 				Error(Basic.invalidPosition,"problems during offset computation in module");
 				Error(Basic.invalidPosition,"problems during offset computation in module");
 			END;
 			END;
 
 
-			IF  (scope.ownerModule # NIL) THEN
+			IF  (scope.ownerModule # NIL) & procedures   THEN
 				(* add scope to global list of all scopes, very handy for code generation and for checking implementations *)
 				(* add scope to global list of all scopes, very handy for code generation and for checking implementations *)
 				scope.ownerModule.AddScope(scope);
 				scope.ownerModule.AddScope(scope);
 			END;
 			END;
@@ -8632,7 +8651,7 @@ TYPE
 			IF (x.name = Global.SystemName) OR (x.name = Global.systemName) THEN Error(x.position,"name reserved") END;
 			IF (x.name = Global.SystemName) OR (x.name = Global.systemName) THEN Error(x.position,"name reserved") END;
 			IF x.context = SyntaxTree.invalidIdentifier THEN x.SetContext(Global.A2Name) END;
 			IF x.context = SyntaxTree.invalidIdentifier THEN x.SetContext(Global.A2Name) END;
 			RemoveModuleFromCache(importCache,x);
 			RemoveModuleFromCache(importCache,x);
-			Declarations(x.moduleScope, FALSE);
+			Declarations(x.moduleScope, FALSE, TRUE, TRUE);
 			FixTypes();
 			FixTypes();
 
 
 			IF module.isCellNet THEN
 			IF module.isCellNet THEN
@@ -8782,7 +8801,9 @@ TYPE
 		BEGIN	END VisitParameter;
 		BEGIN	END VisitParameter;
 
 
 		PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
 		PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
-		BEGIN Scope(x.procedureScope) END VisitProcedure;
+		BEGIN 
+			Scope(x.procedureScope) 
+		END VisitProcedure;
 
 
 		PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
 		PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
 		BEGIN END VisitOperator;
 		BEGIN END VisitOperator;