Value-Type Semantics: experimental Oberon-2 integration

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

source/FoxGlobal.Mod

@@ -479,7 +479,7 @@ TYPE
 					parameter.SetOffset(offset);
 					size := SizeOfParameter(parameter);
 					IF size < 0 THEN RETURN FALSE END;
-					INC(offset,SizeOfParameter(parameter));
+					INC(offset,size);
 					parameter := parameter.prevParameter;
 				END;
 				parameter := procedureType.returnParameter;
@@ -488,7 +488,15 @@ TYPE
 					parameter.SetOffset(offset);
 					size := SizeOfParameter(parameter);
 					IF size < 0 THEN RETURN FALSE END;
-					INC(offset,SizeOfParameter(parameter));
+					INC(offset,size);
+				END;
+				parameter := procedureType.selfParameter;
+				IF parameter # NIL THEN
+					Basic.Align(offset,addressSize);
+					parameter.SetOffset(offset);
+					size := SizeOfParameter(parameter);
+					IF size < 0 THEN RETURN FALSE END;
+					INC(offset,size);
 				END;
 			ELSE
 				parameter := procedureType.firstParameter;
@@ -501,7 +509,7 @@ TYPE
 					parameter := parameter.nextParameter;
 				END;
 			END;
-			IF (procedureType.isDelegate) THEN
+			IF procedureType.isDelegate & (procedureType.selfParameter = NIL) THEN
 				INC(offset,addressSize); (* parameter offset of delegate *)
 			END;
 			RETURN TRUE
@@ -614,7 +622,9 @@ TYPE
 					RETURN SizeOf(rangeType) (* array range components are materialized on stack for both value and const parameters *)
 				END
 			ELSIF par.type.resolved IS SyntaxTree.RecordType THEN
-				IF (par.kind IN {SyntaxTree.ConstParameter,SyntaxTree.VarParameter}) THEN
+				IF par.selfParameter THEN
+					RETURN addressSize
+				ELSIF (par.kind IN {SyntaxTree.ConstParameter,SyntaxTree.VarParameter}) THEN
 					IF IsOberonProcedure(par.ownerType) THEN
 						RETURN 2*addressSize
 					ELSE

source/FoxIntermediateBackend.Mod

@@ -837,7 +837,7 @@ TYPE
 						implementationVisitor.SetLabel(implementationVisitor.exitLabel);
 						IF backend.cooperative THEN
 							IF HasPointers (scope) THEN 
-								IF ~ReturnedAsParameter(procedureType.returnType) THEN
+								IF ~SemanticChecker.ReturnedAsParameter(procedureType.returnType) THEN
 									res := implementationVisitor.NewRegisterOperand(IntermediateCode.GetType(system, procedureType.returnType));
 									ir.Emit(Result(x.position, res));
 									ir.Emit(Push(x.position, res)); 
@@ -850,7 +850,7 @@ TYPE
 									IF implementationVisitor.profile & ~isModuleBody THEN implementationVisitor.ProfilerEnterExit(implementationVisitor.numberProcedures-1, FALSE) END;
 								END;
 							ELSIF  implementationVisitor.profile & ~isModuleBody THEN
-								IF ~ReturnedAsParameter(procedureType.returnType) THEN
+								IF ~SemanticChecker.ReturnedAsParameter(procedureType.returnType) THEN
 									res := implementationVisitor.NewRegisterOperand(IntermediateCode.GetType(system, procedureType.returnType));
 									ir.Emit(Result(x.position, res));
 									ir.Emit(Push(x.position, res)); 
@@ -5600,13 +5600,17 @@ TYPE
 			Evaluate(x.left, operand);
 
 			IF symbol IS SyntaxTree.Procedure THEN
-				IF x.left IS SyntaxTree.SupercallDesignator THEN
+				IF (procedureType.selfParameter # NIL) THEN
+					Emit(Push(position,operand.tag));
+				ELSIF x.left IS SyntaxTree.SupercallDesignator THEN
 					Emit(Push(position,operand.tag));
 				ELSIF (procedureType.isDelegate) THEN
 					Emit(Push(position,operand.tag));
 				END;
 			ELSIF (symbol IS SyntaxTree.Variable) OR (symbol IS SyntaxTree.Parameter) THEN
-				IF (procedureType.isDelegate) THEN (* push self pointer only if procedure is a method *)
+				IF (procedureType.selfParameter # NIL) THEN
+					Emit(Push(position,operand.tag));
+				ELSIF (procedureType.isDelegate) THEN (* push self pointer only if procedure is a method *)
 					Emit(Push(position,operand.tag));
 				END;
 			ELSE HALT(200);
@@ -5616,7 +5620,7 @@ TYPE
 			operand.tag := emptyOperand;
 
 			(* determine if a structured return type is needed *)
-			structuredReturnType := StructuredReturnType(procedureType);
+			structuredReturnType := SemanticChecker.StructuredReturnType(procedureType);
 
 			IF structuredReturnType THEN
 				IF resultDesignator  # NIL THEN
@@ -9494,9 +9498,10 @@ TYPE
 					END;
 				END;
 			ELSIF (x.kind = SyntaxTree.VarParameter) OR (x.kind = SyntaxTree.ConstParameter) & (type IS SyntaxTree.RecordType) THEN
+			
+				IF x.selfParameter THEN TRACE(x, x.offsetInBits) END;
 				IntermediateCode.AddOffset(result.op,ToMemoryUnits(system,x.offsetInBits));
 				IntermediateCode.MakeMemory(result.op,addressType);
-
 			ELSIF (x.kind = SyntaxTree.ValueParameter) OR (x.kind = SyntaxTree.ConstParameter) THEN
 				IntermediateCode.AddOffset(result.op,ToMemoryUnits(system,x.offsetInBits));
 			END;
@@ -9518,13 +9523,13 @@ TYPE
 					result.tag := nil;
 				END;
 			(* tag for pointer type computed not here but during dereferencing *)
-			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & (x.kind IN {SyntaxTree.VarParameter, SyntaxTree.ConstParameter}) THEN
+			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & (x.kind IN {SyntaxTree.VarParameter, SyntaxTree.ConstParameter}) & ~(x.selfParameter) THEN
 				ReleaseIntermediateOperand(result.tag);
 				result.tag := basereg;
 				IntermediateCode.AddOffset(result.tag,ToMemoryUnits(system,x.offsetInBits+system.addressSize));
 				IntermediateCode.MakeMemory(result.tag,addressType);
 				UseIntermediateOperand(result.tag);
-			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & (x.kind = SyntaxTree.ValueParameter) THEN
+			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & ((x.kind = SyntaxTree.ValueParameter) OR x.selfParameter) THEN
 				ReleaseIntermediateOperand(result.tag);
 				result.tag := TypeDescriptorAdr(type);
 				IF ~newObjectFile THEN
@@ -9620,7 +9625,7 @@ TYPE
 		(* handle expressions of the form designator.procedure or procedure *)
 		BEGIN
 			IF Trace THEN TraceEnter("VisitProcedure") END;
-			IF  (x.type(SyntaxTree.ProcedureType).isDelegate) & ~SemanticChecker.IsStaticProcedure(x) THEN
+			IF  (x.type(SyntaxTree.ProcedureType).isDelegate) & ~SemanticChecker.IsStaticProcedure(x) & ~(result.tag.mode = IntermediateCode.ModeImmediate) THEN
 				DynamicCallOperand(result,x);
 			ELSIF x.isInline THEN
 				StaticCallOperand(result,x);
@@ -9763,7 +9768,7 @@ TYPE
 			PROCEDURE CanPassAsResultParameter(right: SyntaxTree.Expression): BOOLEAN;
 			VAR procedureType: SyntaxTree.ProcedureType;
 			BEGIN
-				IF ReturnedAsParameter(right.type)  THEN
+				IF SemanticChecker.ReturnedAsParameter(right.type)  THEN
 					IF right IS SyntaxTree.ProcedureCallDesignator THEN
 						procedureType := right(SyntaxTree.ProcedureCallDesignator).left.type.resolved(SyntaxTree.ProcedureType);
 						RETURN procedureType.callingConvention = SyntaxTree.OberonCallingConvention
@@ -10714,7 +10719,7 @@ TYPE
 			IF return.mode # IntermediateCode.Undefined THEN
 
 				IF currentIsInline THEN
-				ELSIF ReturnedAsParameter(procedureType.returnType) THEN
+				ELSIF SemanticChecker.ReturnedAsParameter(procedureType.returnType) THEN
 					Symbol(procedureType.returnParameter, par);
 					MakeMemory(mem, par.op, return.type, 0);
 					ReleaseOperand(par);
@@ -13751,7 +13756,7 @@ TYPE
 	BEGIN
 		parSize := 0;
 
-		IF StructuredReturnType(procedureType) THEN
+		IF SemanticChecker.StructuredReturnType(procedureType) THEN
 			parameter := procedureType.returnParameter;
 			INC(parSize,system.SizeOfParameter(parameter));
 			parSize := parSize + (-parSize) MOD system.addressSize;
@@ -13764,27 +13769,18 @@ TYPE
 			parameter := parameter.prevParameter;
 		END;
 
-		IF procedureType.isDelegate THEN INC(parSize,system.addressSize) END; (* method => self pointer *)
+		IF procedureType.selfParameter # NIL THEN
+			parameter := procedureType.selfParameter;
+			INC(parSize,system.SizeOfParameter(parameter));
+			parSize := parSize + (-parSize) MOD system.addressSize;
+		ELSIF procedureType.isDelegate THEN INC(parSize,system.addressSize) 
+		END; (* method => self pointer *)
+		
 		IF isNested THEN INC(parSize,system.addressSize) END; (* nested procedure => static base *)
 
 		RETURN ToMemoryUnits(system,parSize)
 	END ParametersSize;
 
-	PROCEDURE ReturnedAsParameter(type: SyntaxTree.Type): BOOLEAN;
-	BEGIN
-		IF type = NIL THEN RETURN FALSE
-		ELSE
-			type := type.resolved;
-			RETURN (type IS SyntaxTree.RecordType) OR (type IS SyntaxTree.RangeType) OR (type IS SyntaxTree.ComplexType) OR (type IS SyntaxTree.ProcedureType) OR SemanticChecker.IsPointerType(type)
-				OR (type IS SyntaxTree.ArrayType) OR (type IS SyntaxTree.MathArrayType);
-		END
-	END ReturnedAsParameter;
-
-	PROCEDURE StructuredReturnType(procedureType: SyntaxTree.ProcedureType): BOOLEAN;
-	BEGIN
-		RETURN (procedureType # NIL) & (procedureType.callingConvention=SyntaxTree.OberonCallingConvention) & ReturnedAsParameter(procedureType.returnType);
-	END StructuredReturnType;
-
 	PROCEDURE IsNested(procedure: SyntaxTree.Procedure): BOOLEAN;
 	BEGIN
 		RETURN (procedure.scope IS SyntaxTree.ProcedureScope) & (procedure.externalName = NIL);
@@ -13797,7 +13793,6 @@ TYPE
 		END;
 		RETURN scope # NIL;
 	END InCellScope;
-	
 
 	PROCEDURE ProcedureParametersSize*(system: Global.System; procedure: SyntaxTree.Procedure): LONGINT;
 	BEGIN

source/FoxParser.Mod

@@ -1287,7 +1287,7 @@ TYPE
 				(*! todo: make this a hidden symbol. Problematic when used with paco. *)
 				procedure.SetAccess(SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal);
 			END;
-			parentScope.AddProcedure(procedure);
+			parentScope.AddProcedureDeclaration(procedure);
 			procedure.SetType(SyntaxTree.NewProcedureType(SyntaxTree.invalidPosition,parentScope));
 			procedure.SetBodyProcedure(TRUE);
 			procedureScope.SetBody(Body(procedureScope));
@@ -1858,6 +1858,10 @@ TYPE
 			modifiers: SyntaxTree.Modifier;
 			forwardDeclaration: BOOLEAN;
 			string: Scanner.StringType;
+			parameter: SyntaxTree.Parameter;
+			qualifiedIdentifier : SyntaxTree.QualifiedIdentifier;
+			identifier: SyntaxTree.Identifier;
+			kind: LONGINT;
 		BEGIN
 			IF Trace THEN S( "Procedure" ) END;
 			(* symbol procedure has already been consumed *)
@@ -1891,11 +1895,30 @@ TYPE
 				OperatorDeclaration( parentScope );
 				RETURN
 			END;
+			
+			procedureScope := SyntaxTree.NewProcedureScope(parentScope);
+
+			IF Optional(Scanner.LeftParenthesis) THEN (* type bound *)
+				IF Optional(Scanner.Var) THEN
+					kind := SyntaxTree.VarParameter
+				ELSIF Optional(Scanner.Const) THEN
+					kind := SyntaxTree.ConstParameter;
+				ELSE
+					kind := SyntaxTree.ConstParameter;
+				END;
+				identifier := Identifier(position);
+				parameter := SyntaxTree.NewParameter(position, procedureType, identifier, kind);
+				Check(Scanner.Colon);
+				qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position, SyntaxTree.invalidIdentifier, Identifier(position));
+				parameter.SetType(SyntaxTree.NewQualifiedType(position, procedureScope, qualifiedIdentifier));
+				Check(Scanner.RightParenthesis);
+				procedureType.SetSelfParameter(parameter);
+				parameter.SetSelfParameter(TRUE);
+			END;
 
 			position:= symbol.position;
 			IdentifierDefinition( name, access,TRUE);
 
-			procedureScope := SyntaxTree.NewProcedureScope(parentScope);
 			procedure := SyntaxTree.NewProcedure( position, name, procedureScope);
 			procedure.SetConstructor(isConstructor);
 			procedure.SetFinalizer(isFinalizer);
@@ -1917,7 +1940,7 @@ TYPE
 				Check(Scanner.End);
 				IF ExpectThisIdentifier( name ) THEN END;
 			END;
-			parentScope.AddProcedure( procedure );
+			parentScope.AddProcedureDeclaration( procedure );
 
 			IF Trace THEN E( "Procedure") END;
 		END ProcedureDeclaration;
@@ -1982,7 +2005,7 @@ TYPE
 				END;
 				IF Mandatory(Scanner.End) & ExpectThisString(string^) THEN END;
 			END;
-			parentScope.AddProcedure(operator);
+			parentScope.AddProcedureDeclaration(operator);
 			IF parentScope IS SyntaxTree.ModuleScope THEN
 				parentScope(SyntaxTree.ModuleScope).AddOperator(operator);
 			ELSIF parentScope IS SyntaxTree.RecordScope THEN

source/FoxSemanticChecker.Mod

@@ -778,7 +778,7 @@ TYPE
 				END;
 
 				procedureType.SetReturnType(resolved);
-				IF (resolved # NIL) THEN
+				IF (resolved # NIL) & StructuredReturnType (procedureType) THEN
 					parameter := SyntaxTree.NewParameter(procedureType.position,procedureType,Global.ResultName, SyntaxTree.VarParameter);
 					parameter.SetType(procedureType.returnType);
 					parameter.SetAccess(SyntaxTree.Hidden);
@@ -793,6 +793,10 @@ TYPE
 					VisitParameter(parameter);
 					parameter := parameter.nextParameter;
 				END;
+				parameter := procedureType.selfParameter;
+				IF parameter # NIL THEN 
+					VisitParameter(parameter) 
+				END;
 		END FixProcedureType;
 
 		PROCEDURE HasFlag(VAR modifiers: SyntaxTree.Modifier; name: SyntaxTree.Identifier; VAR position: Position): BOOLEAN;
@@ -4610,7 +4614,9 @@ TYPE
 			IF (currentIsRealtime) & ~(formalType.isRealtime) THEN
 				Error(position, "forbidden call of non-realtime procedure in realtime block");
 			END;
-
+			
+			
+			
 			IF ~ExpressionList(actualParameters) THEN
 				result := SyntaxTree.invalidDesignator
 			ELSE
@@ -6889,17 +6895,19 @@ TYPE
 					record := procedure.scope(SyntaxTree.RecordScope).ownerRecord;
 					procedureType.SetDelegate(TRUE);
 
-
-					selfParameter := SyntaxTree.NewParameter(procedure.position,procedureType,Global.SelfParameterName,SyntaxTree.ValueParameter);
-					IF record.pointerType.typeDeclaration = NIL THEN
-						selfParameter.SetType(record.pointerType);
-					ELSE
-						qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(procedure.position,SyntaxTree.invalidIdentifier,record.pointerType.typeDeclaration.name);
-						qualifiedType := SyntaxTree.NewQualifiedType(procedure.position,procedure.scope,qualifiedIdentifier);
-						qualifiedType.SetResolved(record.pointerType);
-						selfParameter.SetType(qualifiedType);
+					IF (record.pointerType # NIL) & (procedureType.selfParameter = NIL) THEN
+						(* add auto-self *)
+						selfParameter := SyntaxTree.NewParameter(procedure.position,procedureType,Global.SelfParameterName,SyntaxTree.ValueParameter);
+						IF (record.pointerType.typeDeclaration = NIL) THEN
+							selfParameter.SetType(record.pointerType);
+						ELSE
+							qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(procedure.position,SyntaxTree.invalidIdentifier,record.pointerType.typeDeclaration.name);
+							qualifiedType := SyntaxTree.NewQualifiedType(procedure.position,procedure.scope,qualifiedIdentifier);
+							qualifiedType.SetResolved(record.pointerType);
+							selfParameter.SetType(qualifiedType);
+						END;
+						selfParameter.SetAccess(SyntaxTree.Hidden);
 					END;
-					selfParameter.SetAccess(SyntaxTree.Hidden);
 
 					(*! constructor information is redundant, we can remove "isConstructor" and repplace by constructor procedure reference *)
 					IF procedure.isConstructor THEN
@@ -8289,12 +8297,14 @@ TYPE
 			typeDeclaration: SyntaxTree.TypeDeclaration;
 			variable: SyntaxTree.Variable;
 			procedure: SyntaxTree.Procedure;
+			procedureType : SyntaxTree.ProcedureType;
 			prevScope: SyntaxTree.Scope;
 			parameter: SyntaxTree.Parameter;
 			import: SyntaxTree.Import;
 			symbol: SyntaxTree.Symbol;
 			prevPhase: LONGINT;
 			prevError : BOOLEAN;
+			i: LONGINT;
 			
 			PROCEDURE DeclareCell(type: SyntaxTree.CellType);
 			VAR baseType: SyntaxTree.Type; property, prop: SyntaxTree.Property; variable: SyntaxTree.Variable;
@@ -8368,12 +8378,18 @@ TYPE
 				END;
 			ELSIF scope IS SyntaxTree.ProcedureScope THEN
 				(* enter parameters for a procedure scope *)
-				parameter := scope(SyntaxTree.ProcedureScope).ownerProcedure.type.resolved(SyntaxTree.ProcedureType).firstParameter;
+				procedureType := scope(SyntaxTree.ProcedureScope).ownerProcedure.type.resolved(SyntaxTree.ProcedureType);
+				parameter := procedureType.firstParameter;
 				WHILE(parameter # NIL) DO
 					Register(parameter,currentScope, FALSE); parameter := parameter.nextParameter;
 				END;
-				parameter := scope(SyntaxTree.ProcedureScope).ownerProcedure.type.resolved(SyntaxTree.ProcedureType).returnParameter;
+				parameter := procedureType.returnParameter;
 				IF parameter # NIL THEN Register(parameter, currentScope, FALSE); END;
+				parameter := procedureType.selfParameter;
+				IF parameter # NIL THEN 
+					Register(parameter, currentScope, FALSE); 
+					parameter.SetState(SyntaxTree.Resolved); (* would lead to cycles, otherwise *)
+				END;
 			ELSIF scope IS SyntaxTree.CellScope THEN
 				DeclareCell(scope(SyntaxTree.CellScope).ownerCell);
 				IF~skipImplementation THEN
@@ -8412,10 +8428,55 @@ TYPE
 				Register(variable, currentScope, FALSE); variable := variable.nextVariable;
 			END;
 			(* procedures *)
+			IF scope.procedures # NIL THEN
+				FOR i := 0 TO scope.procedures.Length()-1 DO
+					procedure := scope.procedures.GetProcedure(i);
+					procedureType := procedure.type.resolved(SyntaxTree.ProcedureType);
+					IF procedureType.selfParameter = NIL THEN
+						scope.AddProcedure(procedure);
+						Register(procedure, currentScope, procedure IS SyntaxTree.Operator);
+					ELSE
+						typeDeclaration := currentScope.FindTypeDeclaration(procedureType.selfParameter.type(SyntaxTree.QualifiedType).qualifiedIdentifier.suffix);
+						IF typeDeclaration = NIL THEN 
+							Error(procedureType.selfParameter.position, "No such type declaration");
+						ELSE
+							procedureType.selfParameter.type(SyntaxTree.QualifiedType).SetResolved(typeDeclaration.declaredType.resolved);
+							procedureType.selfParameter.SetState(SyntaxTree.Resolved);
+							typeDeclaration.declaredType(SyntaxTree.RecordType).recordScope.AddProcedure(procedure);
+							Register(procedure, typeDeclaration.declaredType(SyntaxTree.RecordType).recordScope, procedure IS SyntaxTree.Operator);
+						END;
+					END;
+				END;
+			END;
+			(*
 			procedure := scope.firstProcedure;
 			WHILE (procedure # NIL) DO
-				Register(procedure, currentScope, procedure IS SyntaxTree.Operator); procedure := procedure.nextProcedure;
+				procedureType := procedure.type.resolved(SyntaxTree.ProcedureType);
+				IF procedureType.selfParameter = NIL THEN
+					Register(procedure, currentScope, procedure IS SyntaxTree.Operator);
+				END;
+				procedure := procedure.nextProcedure;
 			END;
+			*)
+
+			(* type bound procedures *)
+			(*
+			procedure := scope.firstProcedure;
+			WHILE (procedure # NIL) DO
+				procedureType := procedure.type.resolved(SyntaxTree.ProcedureType);
+				IF procedureType.selfParameter # NIL THEN
+					typeDeclaration := currentScope.FindTypeDeclaration(procedureType.selfParameter.type(SyntaxTree.QualifiedType).qualifiedIdentifier.suffix);
+					IF typeDeclaration = NIL THEN 
+						Error(procedureType.selfParameter.position, "No such type declaration");
+					ELSE
+						procedureType.selfParameter.type(SyntaxTree.QualifiedType).SetResolved(typeDeclaration.declaredType.resolved);
+						procedureType.selfParameter.SetState(SyntaxTree.Resolved);
+					END;
+					Register(procedure, typeDeclaration.declaredType(SyntaxTree.RecordType).recordScope, procedure IS SyntaxTree.Operator);
+				END;
+				procedure := procedure.nextProcedure;
+			END;
+			*)
 
 			(* now process all symbols without any presumption on the order *)
 			symbol := scope.firstSymbol;
@@ -10041,6 +10102,22 @@ TYPE
 		RETURN ~OptimizeMethodTable OR IsStaticProcedure(procedure)
 	END InMethodTable;
 	
+	PROCEDURE ReturnedAsParameter*(type: SyntaxTree.Type): BOOLEAN;
+	BEGIN
+		IF type = NIL THEN RETURN FALSE
+		ELSE
+			type := type.resolved;
+			RETURN (type IS SyntaxTree.RecordType) OR (type IS SyntaxTree.RangeType) OR (type IS SyntaxTree.ComplexType) OR (type IS SyntaxTree.ProcedureType) OR IsPointerType(type)
+				OR (type IS SyntaxTree.ArrayType) OR (type IS SyntaxTree.MathArrayType);
+		END
+	END ReturnedAsParameter;
+
+	PROCEDURE StructuredReturnType*(procedureType: SyntaxTree.ProcedureType): BOOLEAN;
+	BEGIN
+		RETURN (procedureType # NIL) & (procedureType.callingConvention=SyntaxTree.OberonCallingConvention) & ReturnedAsParameter(procedureType.returnType);
+	END StructuredReturnType;
+
+
 
 
 END FoxSemanticChecker.

source/FoxSyntaxTree.Mod

@@ -1716,6 +1716,7 @@ TYPE
 			hasUntracedReturn-: BOOLEAN;
 			firstParameter-,lastParameter-: Parameter; numberParameters-: LONGINT;  (* parameters *)
 			returnParameter-: Parameter; (* not really necessary in syntax tree but very handy for backends *)
+			selfParameter-: Parameter;
 
 			isDelegate-,isInterrupt-,noPAF-,noReturn-: BOOLEAN;
 			pcOffset-: LONGINT; (* PC offset: used for ARM interrupt procedures *)
@@ -1737,6 +1738,7 @@ TYPE
 			pcOffset := 0;
 			hasUntracedReturn := FALSE;
 			returnTypeModifiers := NIL;
+			selfParameter := NIL;
 		END InitProcedureType;
 
 		PROCEDURE SetNoPAF*(noPAF: BOOLEAN);
@@ -1784,6 +1786,10 @@ TYPE
 		PROCEDURE SetReturnParameter*(parameter: Parameter);
 		BEGIN returnParameter := parameter
 		END SetReturnParameter;
+		
+		PROCEDURE SetSelfParameter*(parameter: Parameter);
+		BEGIN selfParameter := parameter
+		END SetSelfParameter;
 
 		PROCEDURE SetCallingConvention*(cc: CallingConvention);
 		BEGIN callingConvention := cc
@@ -1837,6 +1843,12 @@ TYPE
 					result := result & (callingConvention = this.callingConvention);
 					result := result & (noReturn = this.noReturn);
 					IF result THEN
+						(*
+						p1 := selfParameter; p2 := this.selfParameter;
+						IF (p1 = NIL) # (p2=NIL) OR (p1 # NIL) & ((p1.access # p2.access) OR (p1.kind # p2.kind) OR ~p1.type.SameType(p2.type)) THEN
+							RETURN FALSE
+						END;
+						*)
 						p1 := firstParameter; p2 := this.firstParameter;
 						WHILE (p1 # NIL) & (p2 # NIL) & (p1.access # Hidden) & (p2.access # Hidden) & (p1.kind = p2.kind) & (p1.type.SameType(p2.type) OR (p2.type.resolved # NIL) & p1.type.SameType(p2.type.resolved) OR (p1.type.resolved IS AddressType) & (p2.type.resolved IS PointerType) & p2.type.resolved(PointerType).isUnsafe) DO
 							p1 := p1.nextParameter; p2 := p2.nextParameter
@@ -3282,6 +3294,7 @@ TYPE
 		ownerType-: Type;
 		untraced-: BOOLEAN;
 		movable-: BOOLEAN;
+		selfParameter-: BOOLEAN;
 
 		PROCEDURE & InitParameter( position: Position;  ownerType: Type ; name: Identifier; kind: LONGINT);
 		BEGIN
@@ -3294,6 +3307,7 @@ TYPE
 			untraced := FALSE;
 			defaultValue := NIL;
 			movable := FALSE;
+			selfParameter := FALSE;
 		END InitParameter;
 
 		PROCEDURE SetModifiers*(flag: Modifier);
@@ -3307,6 +3321,11 @@ TYPE
 		PROCEDURE SetMoveable*(movable: BOOLEAN);
 		BEGIN SELF.movable := movable
 		END SetMoveable;
+		
+		PROCEDURE SetSelfParameter*(b: BOOLEAN);
+		BEGIN
+			selfParameter := b;
+		END SetSelfParameter;
 
 		PROCEDURE SetDefaultValue*(e: Expression);
 		BEGIN defaultValue := e
@@ -4481,6 +4500,8 @@ TYPE
 		firstVariable-,lastVariable-: Variable; numberVariables-: LONGINT;  (* variables *)
 		firstProcedure-,lastProcedure-: Procedure; numberProcedures-: LONGINT;  (* procedures *)
 
+		procedures-: ProcedureList;
+		
 		outerScope-: Scope; nextScope-: Scope;
 
 		ownerModule-: Module;
@@ -4606,6 +4627,13 @@ TYPE
 			INC(numberProcedures);
 			lastProcedure := p;
 		END AddProcedure;
+		
+		PROCEDURE AddProcedureDeclaration*(p: Procedure);
+		BEGIN
+			IF procedures = NIL THEN NEW(procedures) END;
+			procedures.AddProcedure(p);
+		END AddProcedureDeclaration;
+		
 
 		PROCEDURE FindProcedure*(identifier: Identifier): Procedure;
 		VAR p: Procedure;
@@ -5193,6 +5221,48 @@ TYPE
 
 	END SymbolList;
 
+	ProcedureList* = OBJECT
+		VAR list: Basic.List;
+
+		PROCEDURE & InitList*;
+		BEGIN NEW( list,8 );
+		END InitList;
+
+		PROCEDURE Length*( ): LONGINT;
+		BEGIN RETURN list.Length();
+		END Length;
+
+		PROCEDURE AddProcedure*( d: Procedure );
+		BEGIN list.Add(d)
+		END AddProcedure;
+
+		PROCEDURE GetProcedure*( index: LONGINT ): Procedure;
+		VAR p: ANY;
+		BEGIN
+			p := list.Get(index); RETURN p(Procedure);
+		END GetProcedure;
+
+		PROCEDURE SetProcedure*(index: LONGINT; expression: Procedure);
+		BEGIN list.Set(index,expression)
+		END SetProcedure;
+
+		PROCEDURE RemoveProcedure*(i: LONGINT);
+		BEGIN list.RemoveByIndex(i);
+		END RemoveProcedure;
+
+		(*
+		PROCEDURE Clone*(VAR list: ProcedureList);
+		VAR i: LONGINT;
+		BEGIN
+			IF list = NIL THEN NEW(list) END;
+			FOR i := 0 TO Length()-1 DO
+				list.AddProcedure(CloneProcedure(GetProcedure(i)));
+			END;
+		END Clone;
+		*)
+
+	END ProcedureList;
+
 VAR
 	(* invalid items used, for example, by parser and checker *)
 	invalidIdentifier-: Identifier;