System Procedure Str

This function processes system procedure Str.
Function Proc_Str: Word; Far;
Var NumericValue, FieldWidth, DecimalWidth, StringVariable: TExpression;
    StringProc, PCharProc: Word;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  With NumericValue do
    begin
      ExpectIntegerOrFloatingPointExpression;
      If TypeDefPtr^.BaseType = btInteger then
        begin
          CheckOrdinalRange (Ptr (SystemUnitSegment, LongInt_TypeOffset));
          PushExpression;
          PushParameterSpecifier (0, FieldWidth);
          DecimalWidth.IntermediateCodeOffset := 0;
          StringProc := SysProc_StrInt;
          PCharProc := SysProc_StrIntC;
        end else If Instructions80x87 in StatementCompilerSwitches then
                   begin
                     ConvertRealToExtended;
                     LoadExpressionToFPU;
                     PushParameterSpecifier (23, FieldWidth);
                     PushParameterSpecifier ($FFFF, DecimalWidth);
                     StringProc := SysProc_StrFloat;
                     PCharProc := SysProc_StrFloatC;
                   end else begin
                              ConvertExtendedToReal;
                              PushRealExpression;
                              PushParameterSpecifier (17, FieldWidth);
                              PushParameterSpecifier ($FFFF, DecimalWidth);
                              StringProc := SysProc_StrReal;
                              PCharProc := SysProc_StrRealC;
                            end;
    end;
  ExpectTokenAndGetNext (Token_Comma);
  StringVariable.ExpectAssignableVariableReferenceExceptProcedureOrFunction;
  If StringVariable.TypeDefPtr^.BaseType <> btString then
    begin
       If not (ExtendedSyntax in StatementCompilerSwitches) then Error (StringVariableExpected);
       If not PArrayTypeDefinition (StringVariable.TypeDefPtr)^.IsZeroBasedCharacterArray then Error (StringVariableExpected);
    end;
  StringVariable.PushArrayPointerAndHighestIndex;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  StoreCode_icGoSub (NumericValue.IntermediateCodeOffset);
  StoreCode_icGoSub (FieldWidth.IntermediateCodeOffset);
  StoreCode_icGoSub (DecimalWidth.IntermediateCodeOffset);
  StoreCode_icGoSub (StringVariable.IntermediateCodeOffset);
  Case StringVariable.TypeDefPtr^.BaseType of
    btString: GenerateInstruction_CALL_FAR (StringProc);
    else GenerateInstruction_CALL_FAR (PCharProc);
  end;
  Proc_Str := EndSubroutine;
end;
 
 
 
© 2017 Turbo Pascal | Privacy Policy