Calling a Procedure or Function

Calls to all procedures, functions and methods are processed from this procedure. It takes care for pushing all parameters and generates instruction to call the procedure.
    OffsetOfMethodAddress: Word;
    MainBlockPtr: Pointer;
    ProcedureParameterData: PProcedureParameterData;
    InlineRecord: PInlineRecord absolute ProcedureParameterData;

                                                                                                                             {
    begin
      PushProcedureParameters;
      Calculate;
      GenerateInstructionWithExpressionInMemOrReg ($FF, $18);
      ES_DI_PointerDestroyed;
      EndIntermediateCodeSubroutine;
      Exit;
    end;
  ProcedureIdentifierData := PProcedureIdentifierData (PChar (TypeDefPtr) - 10);
  With ProcedureIdentifierData^ do
    begin
      If not (mcStatic in DataType) and (W8 <> 0) and not (pfConstructor in Flags) then
          begin
            PushProcedureParameters;
            PushMethodParameters;
            OffsetOfMethodAddress := MethodAddressOffset;
            If not (pfDynamic in ProcedureIdentifierData^.Flags) then
              begin
                GenerateInstructionForStackFrameDisplacement ($FF, $1D, OffsetOfMethodAddress);
                ES_DI_PointerDestroyed;
              end;
            EndIntermediateCodeSubroutine;
            Exit;
          end;
      PushProcedureParameters;
      If pfInterrupt in Flags then Error (CannotCallAnInterruptProcedure);
      If pfInline in Flags then
        begin
          GenerateIntermediateCodeForInlineRecords (InlineRecord, ProceduresRecordOffset);
          EndIntermediateCodeSubroutine;
          Exit;
        end;
      If pfMethod in Flags then PushMethodParameters else
        If OuterBlockProcedureIdentifier <> 0 then
          begin
            If OuterBlockProcedureIdentifier = CurrentProcedureIdentifier then GenerateInstruction_Byte (PUSH_BP) else
              begin
                Load_ES_DI (OuterBlockProcedureIdentifier, 0, 0);
                GenerateInstruction_Byte (PUSH_DI);
              end;
          end;
      If pfFar in Flags then
        begin
          If Seg (TypeDefPtr^) = SymbolTable [stMain].Segment then
            begin
              GenerateInstruction_Byte ($0E);
              GenerateInstruction_Byte ($E8);
              GenerateReference (Seg (TypeDefPtr^), ProceduresRecordOffset, 0, []);
            end else begin
                       GenerateInstruction_Byte ($9A);
                       GenerateReference (Seg (TypeDefPtr^), ProceduresRecordOffset, 0, [rfSegment, rfOffset]);
                     end;
        end else begin
                   GenerateInstruction_Byte ($E8);
                   GenerateReference (Seg (TypeDefPtr^), ProceduresRecordOffset, 0, []);
                 end;
      ES_DI_PointerDestroyed;
      EndIntermediateCodeSubroutine;
    end;
end;

                                                                                                                             {
When a procedure is called actual parameters need to bo calculated and pushed on the stack. Depending on the parameter type (called by reference - Var, open parameter or normal parameter) appropriate procedure is called.
      ParameterIntermediateCodeOffsets: TIntermediateCodeOffsets;
      ParameterExpression: Texpression;
      ParameterTypeDef: PTypeDefinition;
      Parameter: Word;
      VarFlags: TVarFlagsSet;

                                                                                                                             {
    If PProcedureTypeDefinition (TypeDefPtr)^.NumberOfParameters <> 0 then
      begin
        ParameterIntermediateCodeOffsets.NumberOfStatements := 0;
        ExpectTokenAndGetNext (Token_LeftParenthesis);
        For Parameter := 1 to PProcedureTypeDefinition (TypeDefPtr)^.NumberOfParameters do
          begin
            ParameterTypeDef := PointerFromOffsets (ProcedureParameterData^.UnitTypeOffsets);
            VarFlags := ProcedureParameterData^.VarFlags;
            If vfOpenParameter in VarFlags then PushOpenParameter else
              If vfVar in VarFlags then PushPointerToParameter else PushParameter;
            AddCallToIntermediateCodeSubroutine (ParameterIntermediateCodeOffsets, ParameterExpression.IntermediateCodeOffset);
            Inc (ProcedureParameterData);
            If Parameter <> PProcedureTypeDefinition (TypeDefPtr)^.NumberOfParameters then ExpectTokenAndGetNext (Token_Comma);
          end;
        ExpectTokenAndGetNext (Token_RightParenthesis);
        Generate_icGoSub_ForEachSubroutine (ParameterIntermediateCodeOffsets);
      end;
  end;

                                                                                                                             {
This procedure pushes normal parameters. Larger parameters are not pushed directly - a pointer to the actual parameter is pushed to save stack space.
      With ParameterExpression do
        begin
          CalculateExpressionWithType (ParameterTypeDef);
          AdjustExpressionToType      (ParameterTypeDef);
          CheckTypeCompatibility      (ParameterTypeDef);
          CheckRange                  (ParameterTypeDef);
          Case TypeDefPtr^.BaseType of
            btPointer,
            btFunctionProcedure,
            btInteger..btEnumeration: PushExpression;
            btSet: If it32Bytes in DataType then
                     begin
                       If IsExpressionInOverlaidCode then ExpandSetToStackFrameAndPushPointer (0);
                       ConvertToPointerAndPush;
                     end else PushExpression;
            btString: begin
                        StoreStringConstantToCodeBlock;
                        If IsExpressionInOverlaidCode then CopyStringToStackFrame ($0100);
                        ConvertToPointerAndPush;
                      end;
            btExtended: Push_FP_Expression (ParameterTypeDef);
            btReal: PushRealExpression;
            else If SetDataTypeForSimpleType then PushExpression else
                   ConvertToPointerAndPush;
          end;
        end;
    end;

  begin
For open parameters also the highest index of the array is pushed.
        ArrayTypeDefinition: PArrayTypeDefinition absolute TypeDefPtr;
    begin
      With ParameterExpression do
        begin
          If not (vfArray in VarFlags) then
            begin
              ExpectAssignableVariableReferenceExceptProcedureOrFunction;
              If TypeDefPtr^.BaseType <> btString then Error (TypeMismatch);
              PushArrayPointerAndHighestIndex;
              Exit;
            end;
          If vfVar in VarFlags then ExpectAssignableVariableReferenceExceptProcedureOrFunction else
            begin
              CalculateExpression;
              If (ParameterTypeDef = Ptr (SystemUnitSegment, Char_TypeOffset)) and IsConstantString (0, StringLen) then
                begin
                  ConvertToPointerAndPush;
                  Calculate;
                  GenerateCodeToPushWord (StringLen - 1);
                  EndIntermediateCodeSubroutine;
                  Exit;
                end;
            end;
          If Location <> elMemory then Error (InvalidVariableReference);
          If TypeDefPtr = ParameterTypeDef then
            begin
              ConvertToPointerAndPush;
              Calculate;
              GenerateCodeToPushWord (0);
              EndIntermediateCodeSubroutine;
              Exit;
            end;
          If TypeDefPtr^.BaseType <> btArray then Error (TypeMismatch);
          If PointerFromOffsets (ArrayTypeDefinition^.ElementTypeOffset) <> ParameterTypeDef then Error (TypeMismatch);
          PushArrayPointerAndHighestIndex;
        end;
    end;

                                                                                                                             {
      With ParameterExpression do
        begin
          If vfConst in VarFlags then ExpectVariableReferenceExceptProcedureOrFunction else
                                        ExpectAssignableVariableReferenceExceptProcedureOrFunction;
          Case ParameterTypeDef^.BaseType of
            btUntyped: ConvertToPointerAndPush;
            btString: Case StrictVarStrings in StatementCompilerSwitches of
                        True: If TypeDefPtr = ParameterTypeDef then ConvertToPointerAndPush else
                                Error (TypeMismatch);
                        else If TypeDefPtr^.BaseType = btString then ConvertToPointerAndPush else
                                Error (TypeMismatch);
                      end;
            btObject: If InObjectTypeDomain (PObjectTypeDefinition (TypeDefPtr),
                                PObjectTypeDefinition (ParameterTypeDef)) then
                        ConvertToPointerAndPush else Error (TypeMismatch);
            else If TypeDefPtr = ParameterTypeDef then
                   ConvertToPointerAndPush else Error (TypeMismatch);
          end;
        end
    end;

                                                                                                                             {
Methods need also Self address which is always loaded to the ES:DI register pair.
      MethodIdentifier: PIdentifier;
      MethodIdentifierData: PProcedureIdentifierData;
  begin
    ObjectTypeDefinition := Value.ObjectTypeDefinition;
    If pfConstructor in ProcedureIdentifierData^.Flags then
      begin
        If mcStatic in DataType then GenerateInstruction_Word ($C031) else
          begin
            GenerateInstruction_Byte ($B8);
            GenerateReference (Seg (ObjectTypeDefinition^),
                                   ObjectTypeDefinition^.VMT_TypedConstantsBlockRecordOffset, 0,
                                   [rfDataSegment, rfConstant, rfOffset]);
          end;
        GenerateInstruction_Byte ($50);
      end else
        If pfDestructor in ProcedureIdentifierData^.Flags then
          begin
            Case mcDispose in DataType of
              True: GenerateInstruction_Word ($01B0);
              else GenerateInstruction_Word ($C031);
            end;
            GenerateInstruction_Byte ($50);
          end;
    If mcStatic in DataType then
      begin
        If not FindCurrentMethod (MethodIdentifier, MethodIdentifierData) then Error (InvalidProcedureOrFunctionReference);
        If not InObjectTypeDomain (Ptr (Seg (MethodIdentifierData^),
                 MethodIdentifierData^.OuterBlockProcedureIdentifier), ObjectTypeDefinition) then
          Error (InvalidProcedureOrFunctionReference);
        Load_ES_DI (Ofs (MethodIdentifier^), 6, 0);
        LocationData.Flags := [ofsDI, segES];
        Value.Offset := 0;
        GenerateInstruction_Word ($5706);
        Exit;
      end;
    If mcNew in DataType then
      begin
        GenerateInstruction_Word ($C031);
        GenerateInstruction_Word ($5050);
        Exit;
      end;
    Calculate;
    GenerateInstruction_TwoBytes (Load_DI_AndReturnSegment or $06, $57);
  end;

                                                                                                                             {
  begin
    LocationData.Flags := LocationData.Flags * [segCS, segSS, segDS] + [segES];
    GenerateSegmentOverride;
    AncestorType := Ptr (Seg (ProcedureIdentifierData^), ProcedureIdentifierData^.OuterBlockProcedureIdentifier);
    GenerateInstructionForStackFrameDisplacement ($8B, $3D, AncestorType^.OffsetOf_VMT_Offset);
    Case pfDynamic in ProcedureIdentifierData^.Flags of
      True: begin
              GenerateInstruction_Byte ($B8);
              GenerateInstruction_Word (ProcedureIdentifierData^.W8);
              GenerateInstruction_CALL_FAR (SysProc_CallMethod);
              UsedRegisters := [urBX, urDX, urCX, urAX];
              MethodAddressOffset := 0;
            end;
      else If RangeChecking in StatementCompilerSwitches then
             begin
               GenerateInstruction_CALL_FAR (SysProc_MethodCheck);
              UsedRegisters := [urBX, urDX, urCX, urAX];
              MethodAddressOffset := ProcedureIdentifierData^.W8;
             end;
    end;
  end;

begin
 
 
 
© 2017 Turbo Pascal | Privacy Policy