Procedure Entry and Exit Code
Procedures and functions (including methods) also need initialization and finalization code.
This function generates entry code:
- it generates code to create stack frame if needed
- it generates code to copy all parameters by value
- for constructor method it generates code to construct the object
Function GenerateProcedureEntryCode: Word;
Var NegativeSizeOfPassedParameters, StackFrameOffset: Word;
DS_Changed: Boolean;
N: Word;
ProcedureIdentifierData: PProcedureIdentifierData;
ProcedureParameterData: PProcedureParameterData;
ParameterTypeDef: PTypeDefinition;
ParameterTypeDefRec: PtrRec absolute ParameterTypeDef;
Procedure CheckAndCopyParameterValue (TypeDef: PTypeDefinition; ParameterFlags: TVarFlagsSet);
Var ValueParameterCopySize, OffsetTo_VMT_Offset: Word;
ObjectTypeDefinition: PObjectTypeDefinition absolute TypeDef;
Procedure CopyParameterValue;
Var DataOffset: Byte;
Procedure Multiply_AX (Factor: Word);
Var Expression: TExpression;
begin
With Expression do
begin
Location := elRegister;
DataType := itWord;
UsedRegisters := [urAX];
LocationData.Register := rAX;
IntegerMultiplicationWithConstant (rAX, Factor);
end;
end;
begin
If not DS_Changed then
begin
DS_Changed := True;
GenerateInstruction_Word ($D38C);
GenerateInstruction_Word ($C38E);
GenerateInstruction_Word ($DB8C);
GenerateInstruction_Byte ($FC);
end;
If not (vfOpenParameter in ParameterFlags) then
begin
GenerateInstructionForStackFrameDisplacement ($8D, $3E, StackFrameOffset);
GenerateInstructionForStackFrameDisplacement ($C5, $36, NegativeSizeOfPassedParameters);
Case TypeDef^.BaseType of
btString: begin
GenerateInstruction_Byte ($AC);
If TypeDef^.Size <> 0 then
begin
GenerateInstruction_TwoBytes ($3C, TypeDef^.Size - 1);
GenerateInstruction_Word ($0272);
GenerateInstruction_TwoBytes ($B0, TypeDef^.Size - 1);
end;
GenerateInstruction_Word ($91AA);
GenerateInstruction_Word ($ED30);
end;
btSet: begin
PSetTypeDefinition (TypeDef)^.GetSetSizeAndLowestElementDataOffset (DataOffset);
If DataOffset <> 0 then
begin
GenerateInstruction_Word ($C683);
GenerateInstruction_Byte (DataOffset);
end;
GenerateInstruction_Byte ($B9);
GenerateInstruction_Word (TypeDef^.Size);
end;
else begin
GenerateInstruction_Byte ($B9);
GenerateInstruction_Word (TypeDef^.Size);
end;
end;
GenerateInstruction_Word ($A4F3);
Exit;
end;
GenerateInstructionForStackFrameDisplacement ($8B, $06, NegativeSizeOfPassedParameters);
GenerateInstruction_Byte ($40);
Multiply_AX (TypeDef^.Size);
GenerateInstruction_Word ($C189);
If StackChecking in StatementCompilerSwitches then
begin
GenerateInstruction_Word ($DB8E);
GenerateInstruction_CALL_FAR (SysProc_StackCheck);
end;
GenerateInstruction_Word ($CC29);
If TypeDef^.Size = 1 then
begin
GenerateInstruction_Word ($E483);
GenerateInstruction_Byte ($FE);
end;
GenerateInstruction_Word ($E789);
GenerateInstructionForStackFrameDisplacement ($C5, $36, NegativeSizeOfPassedParameters + 2);
GenerateInstructionForStackFrameDisplacement ($89, $3E, NegativeSizeOfPassedParameters + 2);
GenerateInstructionForStackFrameDisplacement ($8C, $06, NegativeSizeOfPassedParameters + 4);
Inc (NumberOfLocalParameters);
GenerateInstruction_Word ($A4F3);
end;
begin
Dec (NegativeSizeOfPassedParameters, SizeOfPassedParameter (TypeDef, ParameterFlags, ValueParameterCopySize, False));
Dec (StackFrameOffset, ValueParameterCopySize);
If not (vfOpenParameter in ParameterFlags) or (ParameterFlags * [vfConst, vfVar] <> []) then
begin
If ValueParameterCopySize > 0 then
begin
If (ValueParameterCopySize <> 1) and (WordAlignment in ModuleCompilerSwitches) then
StackFrameOffset := StackFrameOffset and $FFFE;
CopyParameterValue;
end;
end else CopyParameterValue;
If (ParameterFlags * [vfOpenParameter, vfVar] = []) and (TypeDef^.BaseType = btObject) and
(ObjectTypeDefinition^.VMT_Size <> 0) then
begin
If ValueParameterCopySize <> 0 then
OffsetTo_VMT_Offset := StackFrameOffset else
OffsetTo_VMT_Offset := NegativeSizeOfPassedParameters;
Inc (OffsetTo_VMT_Offset, PObjectTypeDefinition (TypeDef)^.OffsetOf_VMT_Offset);
GenerateInstructionForStackFrameDisplacement (MOV_RegisterOrMemory_Immediate_16Bit,
rmSS_BP_Displacement,
OffsetTo_VMT_Offset);
GenerateReference (Seg (TypeDef^), PObjectTypeDefinition (TypeDef)^.VMT_TypedConstantsBlockRecordOffset, 0,
[rfDataSegment, rfConstant, rfOffset]);
end;
end;
Procedure ConstructObject (OffsetOf_VMT_Offset: Word);
begin
GenerateInstruction_MOV_16BitReg_Immediate (rDI, OffsetOf_VMT_Offset);
GenerateInstruction_CALL_FAR (SysProc_Construct);
GenerateCodeForNearJump (LastJumpToProgramBlockExit, $74);
end;
begin
ProcedureIdentifierData := Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset);
With ProcedureIdentifierData^ do
begin
If pfStackFrame in Flags then CreateStackFrame;
If (ProcedureTypeDefinition.NumberOfParameters <> 0) and not (pfAssembler in Flags) then
begin
NegativeSizeOfPassedParameters := OffsetAfterLastParameter;
StackFrameOffset := FunctionResultNegativeSize;
DS_Changed := False;
ProcedureParameterData := PProcedureParameterData (PChar (ProcedureIdentifierData) + 10 + 14);
For N := 1 to ProcedureTypeDefinition.NumberOfParameters do
begin
ParameterTypeDefRec.Seg := PUnitIdentifierData (Ptr (Seg (ProcedureParameterData^),
ProcedureParameterData^.UnitTypeOffsets.UnitIdentifierData))^.UnitSegment;
ParameterTypeDefRec.Ofs := ProcedureParameterData^.UnitTypeOffsets.TypeOffset;
CheckAndCopyParameterValue (ParameterTypeDef, ProcedureParameterData^.VarFlags);
Inc (ProcedureParameterData);
end;
If DS_Changed then GenerateInstruction_Word (MOV_DS_BX);
end;
If pfConstructor in Flags then
ConstructObject (PObjectTypeDefinition (Ptr (Seg (ProcedureIdentifierData^),
OuterBlockProcedureIdentifier))^.OffsetOf_VMT_Offset);
end;
GenerateProcedureEntryCode := EndSubroutine
end;This function generates exit code for procedure or function:
- for constructors: a pointer to object is loaded to
DX:AXregister pair - for destructors:
SysProc_Destructis called to deallocate the object from heap - for functions: the result is loaded to registers or FPU stack
- for all procedures it also destroyes stack frame
Function GenerateProcedureExitCode: Word;
Var ProcedureIdentifierData: PProcedureIdentifierData;
ResultType: PTypeDefinition;
FOpCode: WordRec;
ReturnOpCode: Byte;
Procedure LoadFunctionResultToRegisters (StackFrameOffset: ShortInt; ReturnSize: Word);
begin
Case ReturnSize of
1: GenerateInstruction_Word ($468A);
2: GenerateInstruction_Word ($468B);
4: begin
GenerateInstruction_Word ($468B);
GenerateInstruction_Byte (StackFrameOffset);
Inc (StackFrameOffset, 2);
GenerateInstruction_Word ($568B);
end;
else begin
GenerateInstruction_Word ($468B);
GenerateInstruction_Byte (StackFrameOffset);
Inc (StackFrameOffset, 2);
GenerateInstruction_Word ($5E8B);
GenerateInstruction_Byte (StackFrameOffset);
Inc (StackFrameOffset, 2);
GenerateInstruction_Word ($568B);
end;
end;
GenerateInstruction_Byte (StackFrameOffset);
end;
begin
ProcedureIdentifierData := Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset);
With ProcedureIdentifierData^ do
begin
If pfConstructor in Flags then
begin
GenerateInstruction_Word ($46C4);
GenerateInstruction_Byte ($06);
GenerateInstruction_Word ($C28C);
end else If pfDestructor in Flags then
begin
GenerateInstruction_MOV_16BitReg_Immediate (rDI,
PObjectTypeDefinition (Ptr (Seg (ProcedureIdentifierData^),
OuterBlockProcedureIdentifier))^.OffsetOf_VMT_Offset);
GenerateInstruction_CALL_FAR (SysProc_Destruct);
end;
If (ProcedureTypeDefinition.ResultTypeOffset.UnitIdentifierData <> 0) and not (pfAssembler in Flags) then
begin
ResultType := PointerFromOffsets (ProcedureTypeDefinition.ResultTypeOffset);
Case ResultType^.BaseType of
btPointer,
btReal,
btInteger..btEnumeration: LoadFunctionResultToRegisters (FunctionResultNegativeSize, ResultType^.Size);
btExtended: begin
FOpCode.Word := $06D9 or Byte (ResultType^.DataType);
If fpExtended in ResultType^.DataType then FOpCode.ByteH := $2E;
GenerateFPUInstructionForStackFrameDisplacement (FOpCode.Word, FunctionResultNegativeSize);
GenerateInstruction_TwoBytes ($CD, $3D);
end;
end;
end;
If pfStackFrame in Flags then DestroyStackFrame;
If pfFar in Flags then ReturnOpCode := $CB else ReturnOpCode := $C3;
Case PushedParametersSize of
0: GenerateInstruction_Byte (ReturnOpCode);
else begin
GenerateInstruction_Byte (ReturnOpCode - 1);
GenerateInstruction_Word (PushedParametersSize);
end;
end;
end;
GenerateProcedureExitCode := EndSubroutine;
end;This function returns the size of passed parameter and the size of value parameter that needs to be copied to stack frame.
Function SizeOfPassedParameter (Var TypeDef: PTypeDefinition; Var ParameterFlags: TVarFlagsSet;
Var ValueParameterCopySize: Word; AssemblerProcedure: Boolean): Word;
Var Size: Word;
ExitFlag: Boolean;
Procedure PassPointer;
begin
ExitFlag := True;
If (vfConst in ParameterFlags) or AssemblerProcedure then
begin
Include (ParameterFlags, vfVar);
If TypeDef^.BaseType <> btSet then SizeOfPassedParameter := 4 else
begin
TypeDef := PointerFromOffsets (POrdinalTypeDefinition (
PointerFromOffsets (PSetTypeDefinition (TypeDef)^.BaseSetTypeOffset))^.OrdinalType);
SizeOfPassedParameter := 4;
end;
end else begin
ValueParameterCopySize := Size;
SizeOfPassedParameter := 4;
end;
end;
begin
ExitFlag := False;
ValueParameterCopySize := 0;
If vfOpenParameter in ParameterFlags then SizeOfPassedParameter := 6 else
If vfVar in ParameterFlags then SizeOfPassedParameter := 4 else
begin
Size := TypeDef^.Size;
Case TypeDef^.BaseType of
btUntyped..btText: Case Size of
1, 2, 4:
else PassPointer;
end;
btSet: If it32Bytes in TypeDef^.DataType then PassPointer;
btString: PassPointer;
end;
If not ExitFlag then SizeOfPassedParameter := (Size + 1) and $FFFE;
end;
end;