String System Functions

These procedures process system functions Pos, Length, Copy and Concat.

Procedure Func_Length; Far;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  Expression^.ExpectStringExpression;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  With Expression^ do If Location = elMemory then Include (LocationData.Flags, efSegment);
  Expression^.PositionToStringLength;
end;

Procedure Func_Pos; Far;
Var TempExpression: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  Expression^.ExpectAndStoreStringAndPushPointer;
  ExpectTokenAndGetNext (Token_Comma);
  TempExpression.ExpectAndStoreStringAndPushPointer;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  Expression^.Calculate;
  StoreCode_icGoSub (TempExpression.Value.Word);
  GenerateInstruction_CALL_FAR (SysProc_SPos);
  With Expression^ do
    begin
      Expression^.EndIntermediateCodeSubroutine;
      Location := elRegister;
      DataType := [itSigned, it16Bit];
      UsedRegisters := [urSP, urDX, urAX];
      LocationData.Register := rDX_AX;
      TypeDefPtr := Ptr (SystemUnitSegment, LongInt_TypeOffset);
    end;
end;

Procedure Func_Copy; Far;
Var StartPosExpression, LengthExpression: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  Expression^.ExpectAndStoreStringAndPushPointer;
  ExpectTokenAndGetNext (Token_Comma);
  StartPosExpression.ExpectIntegerExpression;
  StartPosExpression.CheckOrdinalRange (Ptr (SystemUnitSegment, Integer_TypeOffset));
  StartPosExpression.PushExpression;
  ExpectTokenAndGetNext (Token_Comma);
  LengthExpression.ExpectIntegerExpression;
  LengthExpression.CheckOrdinalRange (Ptr (SystemUnitSegment, Integer_TypeOffset));
  LengthExpression.PushExpression;
  ExpectTokenAndGetNext (Token_RightParenthesis);
  Expression^.CreateSpaceInStackFrameAndPushAddressToIt ($0100);
  Expression^.Calculate;
  StoreCode_icGoSub (StartPosExpression.IntermediateCodeOffset);
  StoreCode_icGoSub (LengthExpression.IntermediateCodeOffset);
  GenerateInstruction_CALL_FAR (SysProc_SCopy);
  Expression^.EndIntermediateCodeSubroutine;
  Expression^.UsedRegisters := [urSP, urDX, urAX];
end;

Procedure Func_Concat; Far;
Var TempString: TExpression;
begin
  ExpectTokenAndGetNext (Token_LeftParenthesis);
  Expression^.ExpectStringExpression;
  Expression^.CopyStringToStackFrame ($0100);
  While CheckAndGetNextToken (Token_Comma) do
    begin
      TempString.ExpectStringExpression;
      TempString.StoreStringConstantToCodeBlock;
      Expression^.ConvertToPointerAndPush;
      Expression^.Calculate;
      StoreCode_icGoSub (Expression^.IntermediateCodeOffset);
      GenerateInstruction_CALL_FAR (SysProc_SConcat);
      Expression^.EndIntermediateCodeSubroutine;
      Expression^.UsedRegisters := [urSP, urDX, urAX];
    end;
  ExpectTokenAndGetNext (Token_RightParenthesis);
end;