Prechádzať zdrojové kódy

Moved parts of the calling / stack convention to front-end. Stack layout harmonized:

(pars)     [by caller]
caller PC  [callee (push lr) or caller]                           
old FP     [push fp]
(procedure descriptor) <-- FP [push procedure, if cooperative]
(vars)       [enter]
(special)    [enter]
(spillstack) [enter]

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6358 8c9fc860-2736-0410-a75d-ab315db34111
felixf 9 rokov pred
rodič
commit
5f23454cbf

+ 0 - 64
source/FoxAMDBackend.Mod

@@ -1257,54 +1257,7 @@ TYPE
 			stackSize := SHORT(instruction.op2.intValue);
 			size := stackSize;
 
-			(*
-			IF stackSize > 512 THEN D.String("large stack size "); Basic.WriteSegmentedName(D.Log, in.name); D.String(": "); D.Int(stackSize,1); D.Ln; END;
-			*)
 			INC(traceStackSize, stackSize);
-
-			emitter.Emit1(InstructionSet.opPUSH,opBP);
-			IF instruction.op1.mode # IntermediateCode.ModeNumber THEN
-				ASSERT (backend.cooperative);
-				EmitPush(instruction.op1,Low);
-				cc := SyntaxTree.OberonCallingConvention;
-			ELSE
-				IF backend.cooperative THEN
-					Assembler.InitImm(imm, SHORTINT (cpuBits DIV 8), 0);
-					emitter.Emit1(InstructionSet.opPUSH,imm);
-				END;				
-				cc := SHORT(instruction.op1.intValue);
-			END;
-			emitter.Emit2(InstructionSet.opMOV,opBP,opSP);
-			
-			IF backend.cooperative & (in.symbol # NIL) & (in.symbol IS SyntaxTree.Procedure) THEN
-				body := in.symbol(SyntaxTree.Procedure).procedureScope.body;
-				IF (body # NIL) & (body.code = NIL) & ~body.isUnchecked THEN
-					Assembler.InitMem(op1,SHORT(SHORT(cpuBits DIV 8)),SP,-stackSize);
-					emitter.Emit2(InstructionSet.opLEA,opRA,op1);
-					emitter.Emit2(InstructionSet.opCMP,opSP,opRA);
-					Assembler.InitImm8(imm, FirstOffset);
-					emitter.Emit1(InstructionSet.opJB,imm);
-					firstPC := out.pc;
-					Assembler.InitMem(op1,SHORT(SHORT(cpuBits DIV 8)),RC,IntermediateBackend.StackLimitOffset * cpuBits DIV 8);
-					emitter.Emit2(InstructionSet.opCMP,opRA,op1);
-					Assembler.InitImm8(imm, SecondOffset);
-					emitter.Emit1(InstructionSet.opJAE,imm);
-					secondPC := out.pc;
-					ASSERT (out.pc - firstPC = FirstOffset);
-					emitter.Emit1(InstructionSet.opPUSH,opRA);
-					parametersSize := IntermediateBackend.ProcedureParametersSize(backend.system, in.symbol(SyntaxTree.Procedure));
-					Assembler.InitImm(imm, SHORTINT (cpuBits DIV 8), parametersSize);
-					emitter.Emit1(InstructionSet.opPUSH,imm);
-					Basic.ToSegmentedName ("Activities.ExpandStack", name);
-					Assembler.InitOffset32(target,0);
-					Assembler.SetSymbol (target,name,0,0,0);
-					emitter.Emit1(InstructionSet.opCALL,target);
-					x := out.pc - secondPC;
-					ASSERT (out.pc - secondPC = SecondOffset);
-					Assembler.InitMem(op1,SHORT(SHORT(cpuBits DIV 8)),RA,stackSize);
-					emitter.Emit2(InstructionSet.opLEA,opSP,op1);
-				END;
-			END;
 			
 			IF initialize THEN
 				(* always including this instruction make trace insertion possible *)
@@ -1356,16 +1309,6 @@ TYPE
 				emitter.Emit1(InstructionSet.opPUSH,opESI);
 			END;
 			spillStackStart := stackSize;
-
-			(*
-			IF (stackSize+spillStack.MaxSize()  > 128) THEN
-			D.String("section "); Basic.WriteSegmentedName(D.Log, in.name);
-			D.String(" stack size "); D.Int(stackSize,1);
-			D.String(" spill size "); D.Int(spillStack.MaxSize(),1);
-			D.Ln;
-			END;
-			*)
-
 		END EmitEnter;
 
 		PROCEDURE EmitLeave(CONST instruction: IntermediateCode.Instruction);
@@ -1377,13 +1320,6 @@ TYPE
 				emitter.Emit1(InstructionSet.opPOP,opEDI);
 				emitter.Emit1(InstructionSet.opPOP,opEBX);
 			END;
-			IF instruction.op2.intValue # 0 THEN
-				Assembler.InitMem(offset,SHORT(SHORT(cpuBits DIV 8)),BP,SHORT(instruction.op2.intValue));
-				emitter.Emit2(InstructionSet.opLEA,opSP,offset);
-			ELSE
-				emitter.Emit2(InstructionSet.opMOV,opSP,opBP);
-			END;
-			emitter.Emit1(InstructionSet.opPOP,opBP);
 		END EmitLeave;
 
 		PROCEDURE EmitExit(CONST instruction: IntermediateCode.Instruction);

+ 13 - 34
source/FoxARMBackend.Mod

@@ -878,6 +878,8 @@ TYPE
 				result := InstructionSet.FP
 			ELSIF virtualRegisterNumber = IntermediateCode.SP THEN
 				result := InstructionSet.SP
+			ELSIF virtualRegisterNumber = IntermediateCode.LR THEN
+				result := InstructionSet.LR
 			ELSE
 				ticket := virtualRegisters.Mapped(virtualRegisterNumber, part);
 				IF ticket = NIL THEN
@@ -1790,61 +1792,37 @@ TYPE
 		PROCEDURE EmitEnter(CONST irInstruction: IntermediateCode.Instruction);
 		VAR allocationSize: LONGINT;
 		BEGIN
-			(* STMFD (Full Descending) aka STMDB (Decrement Before) *)
-
+			(* store registers for interrupts, if required *)
 			IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN (* TODO: needed? *)
 				(* push R0-R11, FP and LR *)
-				Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {0..11, InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
-				stackSize := 14*4;
-			ELSE
-				(* push FP and LR *)
-				Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
-				stackSize := 2*4;
-
-				(* altenative:
-				AllocateStack(2 * 4, TRUE);
-				Emit2(opSTR, opFP, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment}));
-				Emit2(opSTR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}))
-				*)
+				Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR, 0..11}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
+				Emit2(opMOV, opFP, opSP);
 			END;
-
-			Emit2(opMOV, opFP, opSP);
-
+			stackSize := 0;
+			(* allocate space on stack for local variables *)
 			allocationSize := LONGINT(irInstruction.op2.intValue);
 			Basic.Align(allocationSize, 4); (* 4 byte alignment *)
-			(* allocate space on stack for local variables *)
 			AllocateStack(allocationSize, TRUE, backend.initLocals);
-			
-			
-
 			(* allocate space on stack for register spills *)
-			spillStackStart := stackSize; IF spillStack.MaxSize() > 0 THEN AllocateStack(spillStack.MaxSize(), TRUE, FALSE) END
+			spillStackStart := -stackSize; 
+			IF spillStack.MaxSize() > 0 THEN AllocateStack(spillStack.MaxSize(), TRUE, FALSE) END
 		END EmitEnter;
 
 		(* leave <callingConvention> *)
 		PROCEDURE EmitLeave(CONST irInstruction: IntermediateCode.Instruction);
 		BEGIN
-			Emit2(opMOV, opSP, opFP);
-
 			(* LDMFD (Full Descending) aka LDMIA (Increment After) *)
 			IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN
 				(* pop R0-R11, FP and LR *)
-				Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {0..11, InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
-			ELSE
-				(* pop FP and LR *)
-				Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
-
-				(* alternative:
-				Emit2(opLDR, opFP, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment}));
-				Emit2(opLDR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}));
-				AllocateStack(-2 * 4, TRUE)
-				*)
+				Emit2(opMOV, opSP, opFP);
+				Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR, 0..11}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
 			END
 		END EmitLeave;
 
 		(* exit <parSize>, <pcOffset> *)
 		PROCEDURE EmitExit(CONST irInstruction: IntermediateCode.Instruction);
 		BEGIN
+			Emit2(opLDR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}));
 			IF (irInstruction.op1.intValue = 0) & (irInstruction.op2.intValue # SyntaxTree.InterruptCallingConvention) THEN
 				(* Emit2(opMOV, opPC, opLR) *)
 				Emit1(opBX, opLR) (* recommended for better interoperability between ARM and Thumb *)
@@ -3062,6 +3040,7 @@ TYPE
 			SetNewObjectFile(TRUE,FALSE);
 			system := NIL;
 			initLocals := TRUE;
+			SetHasLinkRegister;
 		END InitBackendARM;
 
 		PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System; activeCellsSpecification: ActiveCells.Specification);

+ 8 - 1
source/FoxBackend.Mod

@@ -22,6 +22,7 @@ TYPE
 		capabilities-: SET;
 		oberon07-: BOOLEAN;
 		instructionWidth -: LONGINT;
+		hasLinkRegister-: BOOLEAN;
 
 		(* constructor *)
 		PROCEDURE & InitBackend *;
@@ -34,6 +35,7 @@ TYPE
 			findSectionName := "";
 			findSectionOffset := 0;
 			instructionWidth := -1;
+			hasLinkRegister := FALSE;
 		END InitBackend;
 
 		PROCEDURE SetOberon07*;
@@ -49,7 +51,12 @@ TYPE
 		BEGIN
 			SELF.capabilities := capabilities;
 		END SetCapabilities;
-
+		
+		PROCEDURE SetHasLinkRegister*;
+		BEGIN
+			hasLinkRegister := TRUE;
+		END SetHasLinkRegister;
+		
 
 		PROCEDURE SetInstructionWidth* (instructionWidth: LONGINT);
 		BEGIN

+ 114 - 63
source/FoxIntermediateBackend.Mod

@@ -575,7 +575,6 @@ TYPE
 				IF implementationVisitor.emitLabels THEN ir.Emit(LabelInstruction(scope.body.position)) END;
 				registerNumber := 0;
 				IF ~inline THEN
-					pc := ir.pc;
 					IF scope.lastVariable = NIL THEN
 						stackSize := 0
 					ELSE
@@ -587,7 +586,8 @@ TYPE
 					ir.Emit(Nop(position)); (* placeholder for stack frame check *)
 					ir.Emit(Nop(position)); (* placeholder for stack frame check (2) *)
 					*)
-					ir.Emit(Nop(-1)); (* placeholder for enter *)
+					implementationVisitor.EmitEnter(ir,x.position,x,cc,ToMemoryUnits(system,stackSize),registerNumber);
+					pc := ir.pc-1;
 					(*
 					ir.Emit(Nop(position)); (* placeholder for fill *)
 					*)
@@ -637,7 +637,7 @@ TYPE
 					END;
 
 
-					ir.EmitAt(pc(*+2*),implementationVisitor.Enter(x.position,x,cc,ToMemoryUnits(system,stackSize),registerNumber)); (*!!*)
+					ir.EmitAt(pc(*+2*),implementationVisitor.Enter(x.position,cc,ToMemoryUnits(system,stackSize))); (*!!*)
 
 					IF stackSize > 0 THEN
 						IF (stackSize MOD system.addressSize = 0) THEN
@@ -674,7 +674,7 @@ TYPE
 								implementationVisitor.ProfilerEnterExit(implementationVisitor.numberProcedures-1, FALSE) 
 							END;
 						END;
-						ir.Emit(implementationVisitor.Leave(x.position,x,cc));
+						implementationVisitor.EmitLeave(ir, x.position,cc);
 						IF finalizer THEN
 							Basic.ToSegmentedName("BaseTypes.Object.Finalize", name);
 							IntermediateCode.InitAddress(dest, addressType, name , 0, 0);
@@ -714,7 +714,7 @@ TYPE
 								END;
 							END;
 							
-							ir.Emit(implementationVisitor.Leave(x.position,x,cc));
+							implementationVisitor.EmitLeave(ir,x.position,cc);
 							ir.Emit(Exit(x.position,procedureType.pcOffset,cc));
 						ELSE
 							ir.Emit(Nop(x.position));
@@ -722,13 +722,13 @@ TYPE
 					END
 				END;
 			ELSE (* force body for procedures *)
-				ir.Emit(implementationVisitor.Enter(x.position,x,cc,0,0));
+				implementationVisitor.EmitEnter(ir, x.position,x,cc,0,0);
 				ir.EnterValidPAF;
 				implementationVisitor.usedRegisters := NIL;
 				implementationVisitor.Body(scope.body,currentScope,ir,x = module.module.moduleScope.bodyProcedure);
 				IF implementationVisitor.usedRegisters # NIL THEN D.TraceBack END;
 				ir.ExitValidPAF;
-				ir.Emit(implementationVisitor.Leave(x.position,x,cc));
+				implementationVisitor.EmitLeave(ir,x.position,cc);
 				ir.Emit(Exit(x.position,procedureType.pcOffset,cc));
 			END;
 			Scope(scope);
@@ -870,7 +870,7 @@ TYPE
 				implementationVisitor.profileId.Emit(Reserve(-1,ToMemoryUnits(system,system.SizeOf(system.longintType))));
 				Global.GetModuleSegmentedName(module.module,name); Basic.SuffixSegmentedName(name, Basic.MakeString("@InitProfiler"));
 				implementationVisitor.profileInit := implementationVisitor.NewSection(module.allSections, Sections.CodeSection, name,NIL,dump);
-				implementationVisitor.profileInit.Emit(implementationVisitor.Enter(-1,NIL,0,0,0));
+				implementationVisitor.EmitEnter(implementationVisitor.profileInit,-1,NIL,0,0,0);
 
 				Global.GetModuleName(module.module,idstr);
 				implementationVisitor.ProfilerAddModule(idstr);
@@ -891,13 +891,13 @@ TYPE
 				EnsureBodyProcedure(x.moduleScope);
 				Global.GetModuleSegmentedName(module.module,name); Basic.SuffixSegmentedName(name, Basic.MakeString("@OperatorInitialization"));
 				implementationVisitor.operatorInitializationCodeSection := implementationVisitor.NewSection(module.allSections, Sections.CodeSection,name, NIL, dump);
-				implementationVisitor.operatorInitializationCodeSection.Emit(implementationVisitor.Enter(-1,NIL,0,0,0));
+				implementationVisitor.EmitEnter(implementationVisitor.operatorInitializationCodeSection,-1,NIL,0,0,0);
 			END;
 
 			Scope(x.moduleScope);
 
 			IF hasDynamicOperatorDeclarations THEN
-				implementationVisitor.operatorInitializationCodeSection.Emit(implementationVisitor.Leave(-1,NIL,0));
+				implementationVisitor.EmitLeave(implementationVisitor.operatorInitializationCodeSection,-1,0);
 				implementationVisitor.operatorInitializationCodeSection.Emit(Exit(-1,0,0));
 			END;
 
@@ -1189,6 +1189,7 @@ TYPE
 			fp := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.FP);
 			sp := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.SP);
 			ap := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.AP);
+			lr := IntermediateCode.Register(addressType,IntermediateCode.GeneralPurposeRegister,IntermediateCode.LR);
 			nil := IntermediateCode.Immediate(addressType,0);
 
 			IntermediateCode.InitOperand(destination);
@@ -1335,11 +1336,20 @@ TYPE
 			END;
 		END EmitTrap;
 
-		PROCEDURE Enter (position: LONGINT; procedure: SyntaxTree.Procedure; callconv: LONGINT; varSize: LONGINT; numRegs: LONGINT): IntermediateCode.Instruction;
+		PROCEDURE EmitEnter (section: IntermediateCode.Section; position: LONGINT; procedure: SyntaxTree.Procedure; callconv: LONGINT; varSize: LONGINT; numRegs: LONGINT);
 		VAR name: Basic.SegmentedName;
-		VAR op1,op2,op3: IntermediateCode.Operand;
-		VAR instruction: IntermediateCode.Instruction;
+		VAR op1, op2, reg: IntermediateCode.Operand;
+		VAR call, nocall: Label;
+		VAR parametersSize: LONGINT;
+		VAR prevSection: IntermediateCode.Section;
 		BEGIN
+			prevSection := SELF.section;
+			SELF.section := section;
+			IF backend.hasLinkRegister THEN
+				Emit(Push(-1, lr));
+			END;
+			Emit(Push(-1,fp));
+			
 			IF backend.cooperative & (callconv = SyntaxTree.OberonCallingConvention) THEN
 				IF (procedure # NIL) & (HasPointers (procedure.procedureScope) OR HasVariableParameters (procedure.procedureScope) OR IsNested (procedure)) THEN
 					GetCodeSectionNameForSymbol(procedure, name);
@@ -1348,28 +1358,69 @@ TYPE
 					Basic.ToSegmentedName ("BaseTypes.StackFrame",name);
 				END;
 				IntermediateCode.InitAddress(op1, addressType, name , 0, 0);
+				Emit(Push(-1,op1));
+				Emit(Mov(-1,fp, sp));
+				
+				NEW(call, section);
+				NEW(nocall, section);
+				reg := NewRegisterOperand(addressType);
+				IntermediateCode.InitImmediate(op1,addressType, varSize);
+				Emit(Sub(-1,reg, sp, op1));
+				BrltL(call, sp, reg);
+				IntermediateCode.InitMemory(op2, addressType,ap,ToMemoryUnits(system,system.addressSize*10));
+				BrgeL(nocall, sp, op2);
+				call.Resolve(section.pc);
+				parametersSize := ProcedureParametersSize(backend.system,procedure);
+				IntermediateCode.InitImmediate(op2,addressType, parametersSize);
+				Emit(Push(-1, op2));
+				Emit(Push(-1, reg));
+				ReleaseIntermediateOperand(reg);
+				CallThis(position, "Activities","ExpandStack",0);
+				Emit(Result(-1, sp));
+				ReleaseIntermediateOperand(reg);
+				nocall.Resolve(section.pc);
 			ELSE
-				IntermediateCode.InitNumber(op1,callconv);
+				Emit(Mov(-1, fp, sp));
 			END;
+			Emit(Enter(-1, callconv, varSize));
+			SELF.section := prevSection;
+		END EmitEnter;
+		
+		PROCEDURE Enter(position: LONGINT; callconv: LONGINT; varSize: LONGINT): IntermediateCode.Instruction;
+		VAR op1,op2: IntermediateCode.Operand;
+		VAR instruction: IntermediateCode.Instruction;
+		BEGIN
+			IntermediateCode.InitNumber(op1,callconv);
 			IntermediateCode.InitNumber(op2,varSize);
-			IntermediateCode.InitNumber(op3, numRegs);
-			IntermediateCode.InitInstruction(instruction, position, IntermediateCode.enter,op1,op2,op3);
-			RETURN instruction;
+			IntermediateCode.InitInstruction(instruction, position, IntermediateCode.enter,op1,op2,emptyOperand);
+			RETURN instruction
 		END Enter;
 
-		PROCEDURE Leave(position: LONGINT; procedure: SyntaxTree.Procedure; callconv: LONGINT): IntermediateCode.Instruction;
-		VAR op1,op2: IntermediateCode.Operand;
+		PROCEDURE Leave(position: LONGINT; callconv: LONGINT): IntermediateCode.Instruction;
+		VAR op1: IntermediateCode.Operand;
 		VAR instruction: IntermediateCode.Instruction;
 		BEGIN
 			IntermediateCode.InitNumber(op1,callconv);
+			IntermediateCode.InitInstruction(instruction, position, IntermediateCode.leave,op1,emptyOperand,emptyOperand);
+			RETURN instruction
+		END Leave;
+		
+		PROCEDURE EmitLeave(section: IntermediateCode.Section; position: LONGINT; callconv: LONGINT);
+		VAR prevSection: IntermediateCode.Section;
+		VAR op2: IntermediateCode.Operand;
+		BEGIN
+			prevSection := SELF.section;
+			SELF.section := section;
+			Emit(Leave(position, callconv)); 
 			IF backend.cooperative THEN
-				IntermediateCode.InitNumber(op2,ToMemoryUnits(system, system.addressSize));
+				IntermediateCode.InitImmediate(op2,addressType, ToMemoryUnits(system, system.addressSize));
+				Emit(Add(position, sp, fp, op2));
 			ELSE
-				IntermediateCode.InitNumber(op2,0);
+				Emit(Mov(position, sp, fp));
 			END;
-			IntermediateCode.InitInstruction(instruction, position, IntermediateCode.leave,op1,op2,emptyOperand);
-			RETURN instruction
-		END Leave;
+			Emit(Pop(position, fp));
+			SELF.section := prevSection;
+		END EmitLeave;
 
 		PROCEDURE Symbol(x: SyntaxTree.Symbol; VAR op: Operand);
 		VAR m: SymbolMap; e: SyntaxTree.Expression; o, t: IntermediateCode.Operand;
@@ -5667,7 +5718,7 @@ TYPE
 		BEGIN
 			IntermediateCode.InitImmediate(reg, IntermediateCode.GetType(system,system.longintType), numberProcedures);
 			profileInit.EmitAt(profileInitPatchPosition,Push(position,reg));
-			profileInit.Emit(Leave(position,NIL,0));
+			EmitLeave(profileInit,position,0);
 			profileInit.Emit(Exit(position,0,0));
 		END ProfilerPatchInit;
 
@@ -6505,13 +6556,13 @@ TYPE
 			procedure.SetAccess(SyntaxTree.Hidden);
 			currentScope := procedureScope;
 			section := NewSection(module.allSections, Sections.CodeSection, name, NIL,commentPrintout # NIL);
-			section.Emit(Enter(-1,NIL,0,0,0));
+			EmitEnter(section, -1,NIL,0,0,0);
 			RETURN section;
 		END OpenInitializer;
 		
 		PROCEDURE CloseInitializer(prev: IntermediateCode.Section);
 		BEGIN
-			Emit(Leave(0,NIL,0)); 
+			EmitLeave(section, 0, 0 );
 			Emit(Exit(-1,ToMemoryUnits(system,addressType.sizeInBits),0));
 			section := prev;
 		END CloseInitializer;
@@ -6584,47 +6635,47 @@ TYPE
 			
 			PROCEDURE AddPortProperty(port: SyntaxTree.Variable; modifier: SyntaxTree.Modifier; value: SyntaxTree.Expression);
 		VAR par: ActiveCells.Parameter; name: ARRAY 256 OF CHAR; op: Operand;  left, d: SyntaxTree.Designator;
-		BEGIN
+			BEGIN
 				Field(variable, op);
 				(*left := SyntaxTree.NewSymbolDesignator(-1,left,cell); left.SetType(system.anyType);
 				left := SyntaxTree.NewDereferenceDesignator(-1, left); left.SetType(x);
 				d := SyntaxTree.NewSymbolDesignator(-1, left, variable); d.SetType(variable.type);
 				Designate(d, op);*)
-				ToMemory(op.op,addressType,0);
-				Emit(Push(-1, op.op));
-				ReleaseOperand(op);			
-					
-				Basic.GetString(modifier.identifier, name);
-				PushConstString(name);
+					ToMemory(op.op,addressType,0);
+					Emit(Push(-1, op.op));
+					ReleaseOperand(op);			
+						
+					Basic.GetString(modifier.identifier, name);
+					PushConstString(name);
 
-				IF SemanticChecker.IsStringType(modifier.expression.type) THEN 
-					ASSERT(SemanticChecker.IsStringType(value.type));
-					Designate(value, op);
-					Emit(Push(modifier.position, op.tag));
-					Emit(Push(modifier.position, op.op));
-					ReleaseOperand(op);
-					CallThis(position,"ActiveCellsRuntime","AddPortStringProperty",5);
-				ELSIF (modifier.expression.type.resolved IS SyntaxTree.IntegerType) THEN
-					ASSERT(value.type.resolved IS SyntaxTree.IntegerType);
-					Evaluate(value, op); 
-					Emit(Push(modifier.position, op.op));
-					ReleaseOperand(op);
-					CallThis(position,"ActiveCellsRuntime","AddPortIntegerProperty",4);
-				ELSE
-					CallThis(position,"ActiveCellsRuntime","AddPortFlagProperty",3);
+					IF SemanticChecker.IsStringType(modifier.expression.type) THEN 
+						ASSERT(SemanticChecker.IsStringType(value.type));
+						Designate(value, op);
+						Emit(Push(modifier.position, op.tag));
+						Emit(Push(modifier.position, op.op));
+						ReleaseOperand(op);
+						CallThis(position,"ActiveCellsRuntime","AddPortStringProperty",5);
+					ELSIF (modifier.expression.type.resolved IS SyntaxTree.IntegerType) THEN
+						ASSERT(value.type.resolved IS SyntaxTree.IntegerType);
+						Evaluate(value, op); 
+						Emit(Push(modifier.position, op.op));
+						ReleaseOperand(op);
+						CallThis(position,"ActiveCellsRuntime","AddPortIntegerProperty",4);
+					ELSE
+						CallThis(position,"ActiveCellsRuntime","AddPortFlagProperty",3);
+					END;
+			END AddPortProperty;
+			
+			PROCEDURE AddPortProperties(variable: SyntaxTree.Variable);
+			VAR modifier: SyntaxTree.Modifier;
+			BEGIN
+				modifier := variable.modifiers;
+				WHILE modifier # NIL DO
+					AddPortProperty(variable,modifier, modifier.expression);
+					modifier := modifier.nextModifier;
 				END;
-		END AddPortProperty;
-		
-		PROCEDURE AddPortProperties(variable: SyntaxTree.Variable);
-		VAR modifier: SyntaxTree.Modifier;
-		BEGIN
-			modifier := variable.modifiers;
-			WHILE modifier # NIL DO
-				AddPortProperty(variable,modifier, modifier.expression);
-				modifier := modifier.nextModifier;
-			END;
-		END AddPortProperties;
-		
+			END AddPortProperties;
+			
 
 			
 			PROCEDURE Variable(name: ARRAY OF CHAR; variable: SyntaxTree.Variable);
@@ -10031,7 +10082,7 @@ TYPE
 			IF backend.cooperative THEN
 				BrL(exitLabel);
 			ELSE
-				Emit(Leave(position,procedure,procedure.type(SyntaxTree.ProcedureType).callingConvention));
+				EmitLeave(section, position,procedure.type(SyntaxTree.ProcedureType).callingConvention);
 				Emit(Exit(position,procedure.type(SyntaxTree.ProcedureType).pcOffset,procedure.type(SyntaxTree.ProcedureType).callingConvention));
 			END;
 			IF Trace THEN TraceExit("VisitReturnStatement") END;
@@ -10302,7 +10353,7 @@ TYPE
 				END;
 				IF currentIsInline THEN RETURN END;
 
-				Emit(Leave(position,procedure,procedureType(SyntaxTree.ProcedureType).callingConvention));
+				EmitLeave(section, position,procedureType(SyntaxTree.ProcedureType).callingConvention);
 				Emit(Exit(position,procedureType(SyntaxTree.ProcedureType).pcOffset,procedureType(SyntaxTree.ProcedureType).callingConvention));
 				ReleaseIntermediateOperand(return);
 			END;

+ 8 - 4
source/FoxIntermediateCode.Mod

@@ -53,6 +53,7 @@ CONST
 	SP*=-2; (* stack pointer *)
 	FP*=-3; (* frame pointer *)
 	AP*=-4; (* activity pointer *)
+	LR*=-5; (* link register *)
 	HwRegister*=-32; (* any value below or equal hwreg is a user defined hardware register *)
 
 	(* FoxProgTools.Enum -e -l=8
@@ -563,6 +564,8 @@ TYPE
 			w.String("fp")
 		ELSIF registerNumber = AP THEN
 			w.String("ap")
+		ELSIF registerNumber = LR THEN
+			w.String("lr")
 		ELSIF registerNumber > None THEN
 			w.String("r"); w.Int(registerNumber, 0);
 			IF registerClass.class = Parameter THEN w.String(":p"); w.Int(registerClass.number,0) END;
@@ -735,10 +738,10 @@ TYPE
 		AddFormat(conv, "conv", RegMem, RegMemImm, Undef, {Op1IsDestination});
 		(* call adr parSize - procedure call, second operand contains parameter size *)
 		AddFormat(call, "call", RegMemImm, Num, Undef,{});
-		(* enter cc pafSize regs - set up procedure activation frame;  op1 = calling convention, op2 = paf size, op3 = numberOfParameters in registers *)
-		AddFormat(enter, "enter", Num+Any, Num, Num ,{});
+		(* enter cc pafSize - set up procedure activation frame;  op1 = calling convention, op2 = size to be allocated on stack *)
+		AddFormat(enter, "enter", Num, Num, Undef ,{});
 		(* leave cc - remove paf, does not imply return, op1= calling convention, does not imply exit from procedure *)
-		AddFormat(leave, "leave", Num, Num, Undef ,{});
+		AddFormat(leave, "leave", Num, Undef, Undef ,{});
 		(* return value : return value, op1= returned value, if any, does not imply exit from procedure *)
 		AddFormat(return,"return",RegMemImm, Undef, Undef,{});
 		(* exit parSize pcOffset cc - exit from procedure, op1 = offset that has to be subtracted from return address (e.g., used for ARM interrupt procedures), op2 = calling convention *)
@@ -869,7 +872,7 @@ TYPE
 
 	PROCEDURE InitRegister*(VAR op: Operand; type: Type; registerClass: RegisterClass;  register: LONGINT);
 	BEGIN
-		Assert((register >0) OR (register = SP) OR (register = FP) OR (register = AP) OR (register <= HwRegister) ,"unmapped register number");
+		Assert((register >0) OR (register = SP) OR (register = FP) OR (register = AP) OR (register = LR) OR (register <= HwRegister) ,"unmapped register number");
 		InitOperand(op);
 		op.mode := ModeRegister;
 		op.type := type;
@@ -1101,6 +1104,7 @@ TYPE
 		ELSIF name = "sp" THEN register := SP; RETURN TRUE
 		ELSIF name = "fp" THEN register := FP ; RETURN TRUE
 		ELSIF name = "ap" THEN register := AP ; RETURN TRUE
+		ELSIF name = "lr" THEN register := LR ; RETURN TRUE
 		ELSE RETURN FALSE
 		END;
 	END DenotesRegister;

+ 26 - 48
source/FoxTRMBackend.Mod

@@ -14,6 +14,7 @@ CONST
 	HaltIRQNumber=8;
 	Registers = 8; None=-1;
 	Low=0; High=1;
+	FPSupported = TRUE; (* setting this to false increases code size slightly but also reduces register pressure *)
 
 	opAND= InstructionSet.opAND; opBIC* = InstructionSet.opBIC;
 	opOR= InstructionSet.opOR; opXOR= InstructionSet.opXOR;
@@ -193,7 +194,7 @@ TYPE
 		opSP, opLR, opFP, null, noOperand: InstructionSet.Operand;
 		instructionSet: InstructionSet.InstructionSet;
 
-		stackSize, enterStackSize, spillStackPosition: LONGINT;
+		stackSize, spillStackPosition: LONGINT;
 		stackSizeKnown: BOOLEAN;
 		inStackAllocation: BOOLEAN;
 		runtimeModuleName: SyntaxTree.IdentifierString;
@@ -239,15 +240,7 @@ TYPE
 					IF dump # NIL THEN
 						dump.String("stack size unknown ") ;
 					END;
-					(*
-					D.String("stack size unknown ") ; Basic.WriteSegmentedName(D.Log, in.name); D.Int(inPC,1); D.Ln;
-					*)
 					stackSizeKnown := FALSE;
-					(*
-					IF ~backend.supportFP & (in.type = Sections.CodeSection) THEN
-						Error("Stack size unknown and no FP support!");
-					END;
-					*)
 				END;
 			END;
 		END CheckStackPointer;
@@ -323,15 +316,16 @@ TYPE
 		BEGIN
 		
 		 
-			physicalRegisters(PhysicalRegisters).SupportFP(FALSE);
-			supportFP := FALSE;
+		 	
+			physicalRegisters(PhysicalRegisters).SupportFP(FPSupported);
+			supportFP := FPSupported;
 			tickets.Init;
 			spillStack.Init;
 			stackSizeKnown := TRUE;
 			forwardFixups.Init;
 			Section^(in,out);
 
-			IF stackSizeKnown = FALSE THEN
+			IF ~stackSizeKnown THEN
 				supportFP := TRUE;
 				tickets.Init;
 				spillStack.Init;
@@ -768,49 +762,39 @@ TYPE
 		BEGIN
 			stackSize := 0;
 			(*
+				stack layout:
 				p1
 				...
-				pm		<- SP + stackSize = FP + enterStackSize = logicalFP
+				pm	 													(parameters pushed by caller)
+				LR   													(explicitly pushed by frontend because hasLinkRegister = TRUE)
+				prev FP <-- FP = logicalFP 	(explicitly pushed by frontend)
 				v1
 				...
 				vn
-				spill1	<- logicalFP + spillStackPosition
+				spill1	<- logicalFP + spillStackPosition (negative)
 				...
-				spilln
-				LR	<- SP+1
-				FP <- SP = FP
+				spilln <-- SP
 			*)
 			cc := SHORT(instr.op1.intValue);
 			spillStackPosition := - LONGINT(instr.op2.intValue)-1; (* relative to logical frame pointer ! *)
-			AllocateStack(LONGINT(instr.op2.intValue+2+spillStack.MaxSize()), TRUE);
-			instructionSet.InitMemory(mem, InstructionSet.SP, 1);
-			Emit2(opST, opLR, mem);
-			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
-			Emit2(opST, opFP, mem);
-			enterStackSize := stackSize;
-			Emit2(opMOV, opFP, opSP);
+			AllocateStack(LONGINT(instr.op2.intValue+spillStack.MaxSize()), TRUE);
 		END EmitEnter;
 
 		PROCEDURE EmitLeave(CONST instr: IntermediateCode.Instruction);
 		VAR cc: LONGINT; mem: InstructionSet.Operand;
 		BEGIN
-			IF supportFP THEN
-				Emit2(opMOV, opSP, opFP);
-			END;
-			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
-			Emit2(opLD, opFP, mem);
-			instructionSet.InitMemory(mem, InstructionSet.SP, 1);
-			Emit2(opLD, opLR, mem);
-			IF supportFP THEN
-				AllocateStack(-enterStackSize, FALSE); (* revert stack *)
-			ELSE
-				ASSERT(enterStackSize = stackSize);
-				AllocateStack(-stackSize,FALSE);
+			IF ~supportFP THEN (* frame pointer might have been used *)
+				AllocateStack(-stackSize, FALSE);
+				Emit2(opMOV, opFP, opSP);
 			END;
 		END EmitLeave;
 
 		PROCEDURE EmitExit(CONST instr: IntermediateCode.Instruction);
+		VAR cc: LONGINT; mem: InstructionSet.Operand;
 		BEGIN
+			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
+			Emit2(opLD, opLR, mem);
+			AllocateStack(-1,FALSE);
 			Emit1(opBR, opLR);
 		END EmitExit;
 
@@ -1220,15 +1204,16 @@ TYPE
 		VAR register: LONGINT; fpOffset: LONGINT; ticket: Ticket;
 		BEGIN
 			IF virtualReg = IntermediateCode.FP THEN
-				IF supportFP THEN
-					register := InstructionSet.FP;
-					INC(offset, enterStackSize);
-				ELSE
+				IF stackSizeKnown THEN
 					register := InstructionSet.SP;
 					INC(offset, stackSize);
+				ELSE (* stack size unknown, actually fp must be supported *)
+					register := InstructionSet.FP;
 				END;
 			ELSIF virtualReg = IntermediateCode.SP THEN
 				register := InstructionSet.SP;
+			ELSIF virtualReg = IntermediateCode.LR THEN
+				register := InstructionSet.LR;
 			(*!ELSIF virtualReg <= IntermediateCode.ParameterRegister THEN
 				register := ParameterRegister(IntermediateCode.ParameterRegister-virtualReg, IntermediateCode.int32);
 			*)
@@ -2194,6 +2179,7 @@ TYPE
 			SetRuntimeModuleName(DefaultRuntimeModuleName);
 			SetNewObjectFile(TRUE,TRUE);
 			myInstructionSet:=defaultInstructionSet;
+			SetHasLinkRegister;
 		END InitBackendTRM;
 
 		PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System;
@@ -2219,15 +2205,7 @@ TYPE
 		PROCEDURE GetSystem(): Global.System;
 		VAR system: System;
 		BEGIN
-			(*
-			IF supportFP THEN
-			NEW(system, 18, 32, 32, 32, 32, 32, 32, 64 (* parameter offset: two words, one for LR and one for FP *));
-			ELSE
-			*)
 			NEW(system, 18, 32, 32, 32, 32, 32, 32, 0(* parameter offset 0: handled locally *), 0 (* no pass of parameters in registers *) , cooperative);
-			(*
-			END;
-			*)
 			Global.SetDefaultDeclarations(system,32);
 			Global.SetDefaultOperators(system);
 			RETURN system