Software of the Month Club 1995 December/SOFM_Dec1995.bin/pc/os2/vpascal/source/rtl/strings.pas

Pascal/Delphi Source File | 1995-10-31 | 16.7 KB | 532 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Runtime Library.  Version 1.0.    █}
{█      String Handling Unit (ASCIIZ)                    █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995 B&M&T Corporation             █}
{█      ─────────────────────────────────────────────────█}
{█      Written by Vitaly Miryanov                       █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$S-,R-,Q-,I-,Cdecl-,OrgName-,AlignRec-}

unit Strings;

interface

uses Use32;

function StrLen(Str: PChar): Word;
function StrEnd(Str: PChar): PChar;
function StrMove(Dest, Source: PChar; Count: Word): PChar;
function StrCopy(Dest, Source: PChar): PChar;
function StrECopy(Dest, Source: PChar): PChar;
function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar;
function StrPCopy(Dest: PChar; Source: String): PChar;
function StrCat(Dest, Source: PChar): PChar;
function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar;
function StrComp(Str1, Str2: PChar): Integer;
function StrIComp(Str1, Str2: PChar): Integer;
function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer;
function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer;
function StrScan(Str: PChar; Chr: Char): PChar;
function StrRScan(Str: PChar; Chr: Char): PChar;
function StrPos(Str1, Str2: PChar): PChar;
function StrUpper(Str: PChar): PChar;
function StrLower(Str: PChar): PChar;
function StrPas(Str: PChar): String;
function StrNew(Str: PChar): PChar;
procedure StrDispose(Str: PChar);

implementation

{ Returns the number of characters in Str, not counting the null        }
{ terminator.                                                           }

function StrLen(Str: PChar): Word; assembler; {$USES edi} {$FRAME-}
asm
                cld
                mov     edi,Str
                or      ecx,-1
                xor     eax,eax
                repne   scasb
                sub     eax,ecx
        sub    eax,2
end;

{ Returns a pointer to the null character that terminates Str.          }

function StrEnd(Str: PChar): PChar; assembler; {$USES edi} {$FRAME-}
asm
                cld
                mov     edi,Str
                or      ecx,-1
                xor     al,al
                repne   scasb
                lea     eax,[edi-1]
end;

{ Copies exactly Count characters from Source to Dest and returns Dest. }
{ Source and Dest may overlap.                                          }

function StrMove(Dest, Source: PChar; Count: Word): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     esi,Source
                mov     edi,Dest
                mov     edx,edi
                mov     ecx,Count
                cmp     esi,edi
                jae     @@1
                std
                add     esi,ecx
                add     edi,ecx
                mov     eax,ecx
                and     ecx,11b
                shr     eax,2
                dec     esi
                dec     edi
                rep     movsb
                mov     ecx,eax
                sub     esi,3
                sub     edi,3
                rep     movsd
                jmp     @@2
              @@1:
                cld
                mov     eax,ecx
                shr     ecx,2
                and     al,11b
                rep     movsd
                mov     cl,al
                rep     movsb
              @@2:
                mov     eax,edx
end;

{ Copies Source to Dest and returns Dest.                               }

function StrCopy(Dest, Source: PChar): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Source
                mov     esi,edi
                xor     al,al
                or      ecx,-1
                repne   scasb
                not     ecx
                mov     dl,cl
                mov     edi,Dest
                mov     eax,edi
                shr     ecx,2
                and     dl,11b
                rep     movsd
                mov     cl,dl
                rep     movsb
end;

{ Copies Source to Dest and returns StrEnd(Dest).                       }

function StrECopy(Dest, Source: PChar): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Source
                mov     esi,edi
                xor     al,al
                or      ecx,-1
                repne   scasb
                not     ecx
                mov     al,cl
                mov     edi,Dest
                shr     ecx,2
                and     al,11b
                rep     movsd
                mov     cl,al
                rep     movsb
                lea     eax,[edi-1]
end;

{ Copies at most MaxLen characters from Source to Dest and returns Dest.}

function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Source
                mov     esi,edi
                mov     ecx,MaxLen
                mov     edx,ecx
                xor     al,al
                repne   scasb
                sub     edx,ecx
                mov     ecx,edx
                mov     edi,Dest
                mov     eax,edi
                shr     ecx,2
                and     dl,11b
                rep     movsd
                mov     cl,dl
                rep     movsb
                mov     [edi].Byte,0
end;

{ Copies the Pascal style string Source into Dest and returns Dest.     }

function StrPCopy(Dest: PChar; Source: String): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     esi,Source
                mov     edi,Dest
                mov     eax,edi
                xor     ecx,ecx
                mov     cl,[esi]
                inc     esi
                mov     dl,cl
                shr     ecx,2
                and     dl,11b
                rep     movsd
                mov     cl,dl
                rep     movsb
                mov     [edi].Byte,0
end;

{ Appends a copy of Source to the end of Dest and returns Dest.         }

function StrCat(Dest, Source: PChar): PChar; assembler; {$USES None} {$FRAME+}
asm
                push    Dest
                Call    StrEnd
                push    eax
                push    Source
                Call    StrCopy
                mov     eax,Dest
end;

{ Appends at most MaxLen - StrLen(Dest) characters from Source to the   }
{ end of Dest, and returns Dest.                                        }

function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar; assembler; {$USES None} {$FRAME+}
asm
                push    Dest
                Call    StrEnd
                mov     ecx,Dest
                add     ecx,MaxLen
                sub     ecx,eax
                jbe     @@1
                push    eax
                push    Source
                push    ecx
                Call    StrLCopy
              @@1:
                mov     eax,Dest
end;

{ Compares Str1 to Str2. The return value is less than 0 if Str1 < Str2,}
{ 0 if Str1 = Str2, or greater than 0 if Str1 > Str2.                   }

function StrComp(Str1, Str2: PChar): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Str2
                mov     esi,edi
                or      ecx,-1
                xor     eax,eax
                xor     edx,edx
                repne   scasb
                not     ecx
                mov     edi,esi
                mov     esi,Str1
                repe    cmpsb
                mov     al,[esi-1]
                mov     dl,[edi-1]
                sub     eax,edx
end;

{ Compares Str1 to Str2, without case sensitivity. The return value is  }
{ the same as StrComp.                                                  }

function StrIComp(Str1, Str2: PChar): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Str2
                mov     esi,edi
                or      ecx,-1
                xor     eax,eax
                xor     edx,edx
                repne   scasb
                not     ecx
                mov     edi,esi
                mov     esi,Str1
              @@1:
                repe    cmpsb
                je      @@4
                mov     al,[esi-1]
                cmp     al,'a'
                jb      @@2
                cmp     al,'z'
                ja      @@2
                sub     al,'a'-'A'
              @@2:
                mov     dl,[edi-1]
                cmp     dl,'a'
                jb      @@3
                cmp     dl,'z'
                ja      @@3
                sub     dl,'a'-'A'
              @@3:
                sub     eax,edx
                je      @@1
              @@4:
end;

{ Compares Str1 to Str2, for a maximum length of MaxLen characters. The }
{ return value is the same as StrComp.                                  }

function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Str2
                mov     esi,edi
                mov     eax,MaxLen
                mov     ecx,eax
                jecxz   @@1
                mov     edx,eax
                xor     eax,eax
                repne   scasb
                sub     edx,ecx
                mov     ecx,edx
                mov     edi,esi
                mov     esi,Str1
                repe    cmpsb
                xor     edx,edx
                mov     al,[esi-1]
                mov     dl,[edi-1]
                sub     eax,edx
              @@1:
end;

{ Compares Str1 to Str2, for a maximum length of MaxLen characters,     }
{ without case sensitivity. The return value is the same as StrComp.    }

function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
                mov     edi,Str2
                mov     esi,edi
                mov     eax,MaxLen
                mov     ecx,eax
                jecxz   @@4
                cld
                mov     edx,eax
                xor     eax,eax
                repne   scasb
                sub     edx,ecx
                mov     ecx,edx
                mov     edi,esi
                mov     esi,Str1
                xor     edx,edx
              @@1:
                repe    cmpsb
                je      @@4
                mov     al,[esi-1]
                cmp     al,'a'
                jb      @@2
                cmp     al,'z'
                ja      @@2
                sub     al,'a'-'A'
              @@2:
                mov     dl,[edi-1]
                cmp     dl,'a'
                jb      @@3
                cmp     dl,'z'
                ja      @@3
                sub     dl,'a'-'A'
              @@3:
                sub     eax,edx
                je      @@1
              @@4:
end;

{ Returns a pointer to the first occurrence of Chr in Str. If Chr does  }
{ not occur in Str, StrScan returns NIL. The null terminator is         }
{ considered to be part of the string.                                  }

function StrScan(Str: PChar; Chr: Char): PChar; assembler; {$USES edi} {$FRAME-}
asm
                cld
                mov     edi,Str
                mov     edx,edi
                or      ecx,-1
                xor     eax,eax
                repne   scasb
                not     ecx
                mov     edi,edx
                mov     al,Chr
                repne   scasb
                mov     al,0
                jne     @@1
                lea     eax,[edi-1]
              @@1:
end;

{ Returns a pointer to the last occurrence of Chr in Str. If Chr does   }
{ not occur in Str, StrRScan returns NIL. The null terminator is        }
{ considered to be part of the string.                                  }

function StrRScan(Str: PChar; Chr: Char): PChar; assembler; {$USES edi} {$FRAME-}
asm
                cld
                mov     edi,Str
                or      ecx,-1
                xor     eax,eax
                repne   scasb
                not     ecx
                std
                dec     edi
                mov     al,Chr
                repne   scasb
                mov     al,0
                jne     @@1
                lea     eax,[edi+1]
              @@1:
end;

{ Returns a pointer to the first occurrence of Str2 in Str1. If Str2    }
{ does not occur in Str1, StrPos returns NIL.                           }

function StrPos(Str1, Str2: PChar): PChar; assembler; {$USES ebx,esi,edi} {$FRAME-}
asm
                cld
                xor     al,al
                mov     edi,Str2
                or      ecx,-1
                repne   scasb
                not     ecx
                dec     ecx
                je      @@2
                mov     edx,ecx
                mov     edi,Str1
                mov     ebx,edi
                or      ecx,-1
                repne   scasb
                not     ecx
                sub     ecx,edx
                jbe     @@2
                mov     edi,ebx
              @@1:
                mov     esi,Str2
                lodsb
                repne   scasb
                jne     @@2
                mov     eax,ecx
                mov     ebx,edi
                mov     ecx,edx
                dec     ecx
                repe    cmpsb
                mov     ecx,eax
                mov     edi,ebx
                jne     @@1
                lea     eax,[edi-1]
                jmp     @@3
              @@2:
                xor     eax,eax
              @@3:
end;

{ Converts Str to upper case and returns Str.                           }

function StrUpper(Str: PChar): PChar; assembler; {$USES esi} {$FRAME-}
asm
                cld
                mov     esi,Str
                mov     eax,esi
              @@1:
                mov     dl,[esi]
                test    dl,dl
                jz      @@2
                inc     esi
                cmp     dl,'a'
                jb      @@1
                cmp     dl,'z'
                ja      @@1
                sub     dl,'a'-'A'
                mov     [esi-1],dl
                jmp     @@1
              @@2:
end;

{ Converts Str to lower case and returns Str.                           }

function StrLower(Str: PChar): PChar; assembler; {$USES esi} {$FRAME-}
asm
                cld
                mov     esi,Str
                mov     eax,esi
              @@1:
                mov     dl,[esi]
                test    dl,dl
                jz      @@2
                inc     esi
                cmp     dl,'A'
                jb      @@1
                cmp     dl,'Z'
                ja      @@1
                add     dl,'a'-'A'
                mov     [esi-1],dl
                jmp     @@1
              @@2:
end;

{ StrPas converts Str to a Pascal style string.                         }

function StrPas(Str: PChar): String; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     edi,Str
                or      ecx,-1
                xor     al,al
                repne   scasb
                not     ecx
                dec     ecx
                cmp     ecx,255
                jbe     @@1
                mov     ecx,255
              @@1:
                mov     esi,Str
                mov     edi,@Result
                mov     al,cl
                stosb
                shr     ecx,2
                and     al,11b
                rep     movsd
                mov     cl,al
                rep     movsb
end;

{ Allocates a copy of Str on the heap. If Str is NIL or points to an    }
{ empty string, StrNew returns NIL and doesn't allocate any heap space. }
{ Otherwise, StrNew makes a duplicate of Str, obtaining space with a    }
{ call to the GetMem standard procedure, and returns a pointer to the   }
{ duplicated string. The allocated space is StrLen(Str) + 1 bytes long. }

function StrNew(Str: PChar): PChar;
var
  L: Word;
  P: PChar;
begin
  StrNew := nil;
  if (Str <> nil) and (Str^ <> #0) then
  begin
    L := StrLen(Str) + 1;
    GetMem(P, L);
    if P <> nil then StrNew := StrMove(P, Str, L);
  end;
end;

{ Disposes a string that was previously allocated with StrNew. If Str   }
{ is NIL, StrDispose does nothing.                                      }

procedure StrDispose(Str: PChar);
begin
  if Str <> nil then FreeMem(Str, StrLen(Str) + 1);
end;

end.