Procedure Entry and Exit Code |
Procedures and functions (including methods) also need initialization and finalization code.
This function generates entry code:
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;
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; |