diff --git a/rtl/i386/stringss.inc b/rtl/i386/stringss.inc index 3f1e69e888..1a0c70b0a9 100644 --- a/rtl/i386/stringss.inc +++ b/rtl/i386/stringss.inc @@ -15,9 +15,12 @@ **********************************************************************} + +{$define FPC_UNIT_HAS_STRPAS} function strpas(p : pchar) : string; {$i strpas.inc} +{$define FPC_UNIT_HAS_STRPCOPY} function strpcopy(d : pchar;const s : string) : pchar;assembler; asm pushl %esi // Save ESI @@ -35,7 +38,10 @@ end ['EDI','EAX','ECX']; { $Log$ - Revision 1.7 2002-09-07 16:01:19 peter + Revision 1.8 2003-07-07 20:22:05 peter + * generic string routines added + + Revision 1.7 2002/09/07 16:01:19 peter * old logs removed and tabs fixed } diff --git a/rtl/inc/genstr.inc b/rtl/inc/genstr.inc index 5faea0c37b..af93d561c0 100644 --- a/rtl/inc/genstr.inc +++ b/rtl/inc/genstr.inc @@ -14,12 +14,12 @@ **********************************************************************} {$ifndef FPC_UNIT_HAS_STRLEN} - function strlen(Str : pchar) : StrLenInt; + function strlen(P : pchar) : StrLenInt; var counter : StrLenInt; Begin counter := 0; - while Str[counter] <> #0 do + while P[counter] <> #0 do Inc(counter); strlen := counter; end; @@ -27,14 +27,14 @@ {$ifndef FPC_UNIT_HAS_STREND} - Function StrEnd(Str: PChar): PChar; + Function StrEnd(P: PChar): PChar; var counter: StrLenInt; begin counter := 0; - while Str[counter] <> #0 do + while P[counter] <> #0 do Inc(counter); - StrEnd := @(Str[Counter]); + StrEnd := @(P[Counter]); end; {$endif FPC_UNIT_HAS_STREND} @@ -58,60 +58,60 @@ -{$ifndef FPC_UNIT_HAS_UPPER} - function StrUpper(Str: PChar): PChar; +{$ifndef FPC_UNIT_HAS_STRUPPER} + function StrUpper(P: PChar): PChar; var counter: StrLenInt; begin counter := 0; - while (Str[counter] <> #0) do + while (P[counter] <> #0) do begin - if Str[Counter] in [#97..#122,#128..#255] then - Str[counter] := Upcase(Str[counter]); + if P[Counter] in [#97..#122,#128..#255] then + P[counter] := Upcase(P[counter]); Inc(counter); end; - StrUpper := Str; + StrUpper := P; end; -{$endif FPC_UNIT_HAS_UPPER} +{$endif FPC_UNIT_HAS_STRUPPER} -{$ifndef FPC_UNIT_HAS_LOWER} - function StrLower(Str: PChar): PChar; +{$ifndef FPC_UNIT_HAS_STRLOWER} + function StrLower(P: PChar): PChar; var counter: StrLenInt; begin counter := 0; - while (Str[counter] <> #0) do + while (P[counter] <> #0) do begin - if Str[counter] in [#65..#90] then - Str[Counter] := chr(ord(Str[Counter]) + 32); + if P[counter] in [#65..#90] then + P[Counter] := chr(ord(P[Counter]) + 32); Inc(counter); end; - StrLower := Str; + StrLower := P; end; -{$endif FPC_UNIT_HAS_LOWER} +{$endif FPC_UNIT_HAS_STRLOWER} {$ifndef FPC_UNIT_HAS_STRSCAN} - function StrScan(Str: PChar; Ch: Char): PChar; + function StrScan(P: PChar; C: Char): PChar; Var count: StrLenInt; Begin count := 0; { As in Borland Pascal , if looking for NULL return null } - if ch = #0 then + if C = #0 then begin - StrScan := @(Str[StrLen(Str)]); + StrScan := @(P[StrLen(P)]); exit; end; { Find first matching character of Ch in Str } - while Str[count] <> #0 do + while P[count] <> #0 do begin - if Ch = Str[count] then + if C = P[count] then begin - StrScan := @(Str[count]); + StrScan := @(P[count]); exit; end; Inc(count); @@ -124,24 +124,24 @@ {$ifndef FPC_UNIT_HAS_STRRSCAN} - function StrRScan(Str: PChar; Ch: Char): PChar; + function StrRScan(P: PChar; C: Char): PChar; Var count: StrLenInt; index: StrLenInt; Begin - count := Strlen(Str); + count := Strlen(P); { As in Borland Pascal , if looking for NULL return null } - if ch = #0 then + if C = #0 then begin - StrRScan := @(Str[count]); + StrRScan := @(P[count]); exit; end; Dec(count); for index := count downto 0 do begin - if Ch = Str[index] then + if C = P[index] then begin - StrRScan := @(Str[index]); + StrRScan := @(P[index]); exit; end; end; @@ -197,7 +197,7 @@ {$ifndef FPC_UNIT_HAS_STRCOMP} - function StrComp(Str1, Str2 : PChar): Integer; + function StrComp(Str1, Str2 : PChar): StrLenInt; var counter: StrLenInt; Begin @@ -214,7 +214,7 @@ {$ifndef FPC_UNIT_HAS_STRICOMP} - function StrIComp(Str1, Str2 : PChar): Integer; + function StrIComp(Str1, Str2 : PChar): StrLenInt; var counter: StrLenInt; c1, c2: char; @@ -235,53 +235,56 @@ {$ifndef FPC_UNIT_HAS_STRLCOMP} - function StrLComp(Str1, Str2 : PChar; MaxLen: StrLenInt): Integer; + function StrLComp(Str1, Str2 : PChar; L: StrLenInt): StrLenInt; var counter: StrLenInt; c1, c2: char; Begin counter := 0; - if MaxLen = 0 then + if L = 0 then begin StrLComp := 0; exit; end; Repeat - if (c1 = #0) or (c2 = #0) then break; c1 := str1[counter]; c2 := str2[counter]; + if (c1 = #0) or (c2 = #0) then break; Inc(counter); - Until (c1 <> c2) or (counter >= MaxLen); + Until (c1 <> c2) or (counter >= L); StrLComp := ord(c1) - ord(c2); end; {$endif FPC_UNIT_HAS_STRLCOMP} {$ifndef FPC_UNIT_HAS_STRLICOMP} - function StrLIComp(Str1, Str2 : PChar; MaxLen: StrLenInt): Integer; + function StrLIComp(Str1, Str2 : PChar; L: StrLenInt): StrLenInt; var counter: StrLenInt; c1, c2: char; Begin counter := 0; - if MaxLen = 0 then + if L = 0 then begin StrLIComp := 0; exit; end; Repeat - if (c1 = #0) or (c2 = #0) then break; c1 := upcase(str1[counter]); c2 := upcase(str2[counter]); + if (c1 = #0) or (c2 = #0) then break; Inc(counter); - Until (c1 <> c2) or (counter >= MaxLen); + Until (c1 <> c2) or (counter >= L); StrLIComp := ord(c1) - ord(c2); end; {$endif FPC_UNIT_HAS_STRLICOMP} { $Log$ - Revision 1.1 2003-04-30 16:36:39 florian + Revision 1.2 2003-07-07 20:22:05 peter + * generic string routines added + + Revision 1.1 2003/04/30 16:36:39 florian + support for generic pchar routines added + some basic rtl stuff for x86-64 added } diff --git a/rtl/inc/genstrs.inc b/rtl/inc/genstrs.inc new file mode 100644 index 0000000000..1fec4e8e7b --- /dev/null +++ b/rtl/inc/genstrs.inc @@ -0,0 +1,48 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by Carl-Eric Codere, + member of the Free Pascal development team. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{$ifndef FPC_UNIT_HAS_STRPCOPY} + function strpcopy(d : pchar;const s : string) : pchar; + var + counter : byte; + Begin + counter := 0; + { if empty pascal string } + { then setup and exit now } + if s = '' then + Begin + D[0] := #0; + StrPCopy := D; + exit; + end; + for counter:=1 to length(S) do + D[counter-1] := S[counter]; + { terminate the string } + D[counter] := #0; + StrPCopy:=D; + end; +{$endif FPC_UNIT_HAS_STRPCOPY} + +{$ifndef FPC_UNIT_HAS_STRPAS} +{ also add a strpas alias for internal use in the system unit (JM) } +function strpas(p:pchar):string; [external name 'FPC_PCHAR_TO_SHORTSTR']; +{$endif FPC_UNIT_HAS_STRPCOPY} + +{ + $Log$ + Revision 1.1 2003-07-07 20:22:05 peter + * generic string routines added + +} diff --git a/rtl/inc/strings.pp b/rtl/inc/strings.pp index ef146d7f58..b046b0aed2 100644 --- a/rtl/inc/strings.pp +++ b/rtl/inc/strings.pp @@ -99,6 +99,10 @@ implementation { Read processor denpendent part, NOT shared with sysutils unit } {$i stringss.inc } +{ Read generic string functions that are not implemented for the processor } +{$i genstr.inc} +{$i genstrs.inc} + { Functions not in assembler, but shared with sysutils unit } {$i stringsi.inc} @@ -140,7 +144,10 @@ end. { $Log$ - Revision 1.4 2002-09-07 15:07:46 peter + Revision 1.5 2003-07-07 20:22:05 peter + * generic string routines added + + Revision 1.4 2002/09/07 15:07:46 peter * old logs removed and tabs fixed } diff --git a/rtl/sparc/strings.inc b/rtl/sparc/strings.inc new file mode 100644 index 0000000000..ba0a6480b4 --- /dev/null +++ b/rtl/sparc/strings.inc @@ -0,0 +1,25 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2000 by Jonas Maebe, member of the + Free Pascal development team + + Processor dependent part of strings.pp, that can be shared with + sysutils unit. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{ + $Log$ + Revision 1.1 2003-07-07 20:22:05 peter + * generic string routines added + +} diff --git a/rtl/sparc/stringss.inc b/rtl/sparc/stringss.inc new file mode 100644 index 0000000000..750f157036 --- /dev/null +++ b/rtl/sparc/stringss.inc @@ -0,0 +1,25 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by Jonas Maebe, member of the + Free Pascal development team + + Processor dependent part of strings.pp, not shared with + sysutils unit. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{ + $Log$ + Revision 1.1 2003-07-07 20:22:05 peter + * generic string routines added + +}