Processing and Converting Strings

Turbo Pascal uses few functions and procedures to process, check and convert strings - Char type and zero-based character arrays can also be considered as strings.

This function checks if string (or Char) is constant and sets expression to typed constant.
Function TExpression.IsConstantString (Size: Word; Var StringLen: Byte): Boolean;
Var StringPtr: PString;
begin
  IsConstantString := False;
  If Location <> elConstant then Exit;
  Case TypeDefPtr^.BaseType of
    btString: begin
                StringPtr := Ptr (DSeg, Value.Word);
                StringLen := Length (StringPtr^);
                If StringLen = 0 then StringLen := 1 else Inc (PChar (StringPtr));
              end;
    btChar: begin
            StringPtr := @Value;
            StringLen := 1;
          end;
    else Exit;
  end;
  If Size <> 0 then If StringLen <> Size then Exit;
  SetExpressionToStringTypedConstant (StringPtr, StringLen);
  IsConstantString := True;
end;
This procedure stores string data to typed constants table and sets expression accordingly.
Procedure TExpression.SetExpressionToStringTypedConstant (Str: Pointer; Size: Word);
begin
  LocationData.Flags := [efTypedConstant, segDS];
  Location := elMemory;
  Value.Offset := StoreConstant (stTypedConstants, Str, TypedConstantsOffsetBeforeConstantValueProcessing, Size) -
                    LastTypedConstantsSize;
  Value.BlockRecord := SymbolTable [stTypedConstantsBlocks].NextRecordOffset;
  Value.Segment := SymbolTable [stMain].Segment;
end;
This procedure stores constant string to code block.
Procedure TExpression.StoreStringConstantToCodeBlock;
Var StringConstant: PString;
begin
  If Location = elConstant then
    begin
      StringConstant := PString (Ptr (DSeg, Value.Word));
      StoreExpressionConstantToCodeBlock (StringConstant, Length (StringConstant^) + 1);
    end;
end;
This procedure checks and converts zero-based character array to string and puts it to stack frame.
Procedure TExpression.CopyCharArrayCompatibleWithStringToStackFrameAsString;
Var Len: Byte;
begin
  If not PArrayTypeDefinition (TypeDefPtr)^.IsCharacterArrayCompatibleWithString (Len) then Exit;
  ConvertToPointerAndPush;
  CreateSpaceInStackFrameAndPushAddressToIt ($0100);
  Calculate;
  GenerateCodeToPushWord (Len);
  GenerateInstruction_CALL_FAR (SysProc_SPacked);
  EndIntermediateCodeSubroutine;
  UsedRegisters := [urBX, urDX, urCX, urAX];
  TypeDefPtr := Ptr (SystemUnitSegment, String_TypeOffset);
end;
This procedure positions expression to string length byte.
  Case Location of
    elMemory: begin
         DataType := [itUnsigned];
         TypeDefPtr := Ptr (SystemUnitSegment, LongInt_TypeOffset);
       end;
    elConstant: begin
         CheckOrdinalOverflowAndStore (Mem [DSeg : Value.Word], False);
         TypeDefPtr := Ptr (SystemUnitSegment, LongInt_TypeOffset);
       end;
    else begin
           PopPointerAndConvertToMemory (Self);
           DataType := [itUnsigned];
           TypeDefPtr := Ptr (SystemUnitSegment, LongInt_TypeOffset);
         end;
  end;
end;

                                                                                                                             {
This procedure converts Char type to String with one character.
Procedure TExpression.ConvertCharToString;
Var TempString: PString;
begin
  If TypeDefPtr^.BaseType = btChar then
    Case Location of
      elConstant: begin
                    TempString := Ptr (DSeg, GetTempBufferOffset (2));
                    TempString^ := Value.Char;
                    Value.Word := Ofs (TempString^);
                    DataType := [];
                    TypeDefPtr := Ptr (SystemUnitSegment, String_TypeOffset);
                  end;
      else begin
             PushExpression;
             CreateSpaceInStackFrameAndPushAddressToIt ($100);
             Calculate;
             GenerateInstruction_CALL_FAR (SysProc_SChar);
             EndIntermediateCodeSubroutine;
             UsedRegisters := [urSP, urDX, urAX];
             TypeDefPtr := Ptr (SystemUnitSegment, String_TypeOffset);
           end;
    end;
end;
This function checks if it is possible to convert zero-based character array to PChar.
Procedure TExpression.CheckForConversionOfZeroBasedCharacterArrayToPChar (SecondExpressionTypeDef: PTypeDefinition);
begin
  If (SecondExpressionTypeDef^.BaseType = btInteger) or
     (SecondExpressionTypeDef = Ptr (SystemUnitSegment, PChar_TypeOffset)) then ConvertZeroBasedCharacterArrayToPChar;
end;
This procedure converts zero-based character array to PChar.
Procedure TExpression.ConvertZeroBasedCharacterArrayToPChar;
begin
  If PArrayTypeDefinition (TypeDefPtr)^.IsZeroBasedCharacterArray then
    begin
      Location := elPointerToMemory;
      DataType := [it32Bit, it16Bit, itSigned];
      TypeDefPtr := Ptr (SystemUnitSegment, PChar_TypeOffset);
    end;
end;
 
 
 
© 2017 Turbo Pascal | Privacy Policy