diff --git a/rtl/i386/strings.inc b/rtl/i386/strings.inc index 85a888d6a3..2540949c88 100644 --- a/rtl/i386/strings.inc +++ b/rtl/i386/strings.inc @@ -17,6 +17,7 @@ {$ASMMODE ATT} +{$define FPC_UNIT_HAS_STRCOPY} function strcopy(dest,source : pchar) : pchar;assembler; asm movl source,%edi @@ -74,6 +75,7 @@ asm end ['EAX','EDX','ECX','ESI','EDI']; +{$define FPC_UNIT_HAS_STRECOPY} function strecopy(dest,source : pchar) : pchar;assembler; asm cld @@ -99,6 +101,7 @@ asm end ['EAX','ECX','ESI','EDI']; +{$define FPC_UNIT_HAS_STRLCOPY} function strlcopy(dest,source : pchar;maxlen : longint) : pchar;assembler; asm movl source,%esi @@ -123,10 +126,12 @@ asm end ['EAX','ECX','ESI','EDI']; +{$define FPC_UNIT_HAS_STRLEN} function strlen(p : pchar) : longint;assembler; {$i strlen.inc} +{$define FPC_UNIT_HAS_STREND} function strend(p : pchar) : pchar;assembler; asm cld @@ -144,6 +149,8 @@ asm end ['EDI','ECX','EAX']; + +{$define FPC_UNIT_HAS_STRCOMP} function strcomp(str1,str2 : pchar) : longint;assembler; asm movl str2,%edi @@ -163,6 +170,8 @@ asm end ['EAX','ECX','ESI','EDI']; + +{$define FPC_UNIT_HAS_STRLCOMP} function strlcomp(str1,str2 : pchar;l : longint) : longint;assembler; asm movl str2,%edi @@ -186,6 +195,8 @@ asm end ['EAX','ECX','ESI','EDI']; + +{$define FPC_UNIT_HAS_STRICOMP} function stricomp(str1,str2 : pchar) : longint;assembler; asm movl str2,%edi @@ -221,6 +232,8 @@ asm end ['EAX','EBX','ECX','ESI','EDI']; + +{$define FPC_UNIT_HAS_STRLICOMP} function strlicomp(str1,str2 : pchar;l : longint) : longint;assembler; asm movl str2,%edi @@ -260,6 +273,8 @@ asm end ['EAX','EBX','ECX','ESI','EDI']; + +{$define FPC_UNIT_HAS_STRSCAN} function strscan(p : pchar;c : char) : pchar;assembler; asm movl p,%eax @@ -378,6 +393,7 @@ asm end ['EAX','ECX','ESI','EDI','EDX']; +{$define FPC_UNIT_HAS_STRRSCAN} function strrscan(p : pchar;c : char) : pchar;assembler; asm xorl %eax,%eax @@ -406,6 +422,7 @@ asm end ['EAX','ECX','EDI']; +{$define FPC_UNIT_HAS_STRUPPER} function strupper(p : pchar) : pchar;assembler; asm movl p,%esi @@ -428,6 +445,7 @@ asm end ['EAX','ESI','EDI']; +{$define FPC_UNIT_HAS_STRLOWER} function strlower(p : pchar) : pchar;assembler; asm movl p,%esi @@ -451,7 +469,10 @@ end ['EAX','ESI','EDI']; { $Log$ - Revision 1.7 2002-09-07 16:01:19 peter - * old logs removed and tabs fixed + Revision 1.8 2003-04-30 16:36:39 florian + + support for generic pchar routines added + + some basic rtl stuff for x86-64 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 new file mode 100644 index 0000000000..5faea0c37b --- /dev/null +++ b/rtl/inc/genstr.inc @@ -0,0 +1,287 @@ +{ + $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_STRLEN} + function strlen(Str : pchar) : StrLenInt; + var + counter : StrLenInt; + Begin + counter := 0; + while Str[counter] <> #0 do + Inc(counter); + strlen := counter; + end; +{$endif FPC_UNIT_HAS_STRLEN} + + +{$ifndef FPC_UNIT_HAS_STREND} + Function StrEnd(Str: PChar): PChar; + var + counter: StrLenInt; + begin + counter := 0; + while Str[counter] <> #0 do + Inc(counter); + StrEnd := @(Str[Counter]); + end; +{$endif FPC_UNIT_HAS_STREND} + + +{$ifndef FPC_UNIT_HAS_STRCOPY} + Function StrCopy(Dest, Source:PChar): PChar; + var + counter : StrLenInt; + Begin + counter := 0; + while Source[counter] <> #0 do + begin + Dest[counter] := char(Source[counter]); + Inc(counter); + end; + { terminate the string } + Dest[counter] := #0; + StrCopy := Dest; + end; +{$endif FPC_UNIT_HAS_STRCOPY} + + + +{$ifndef FPC_UNIT_HAS_UPPER} + function StrUpper(Str: PChar): PChar; + var + counter: StrLenInt; + begin + counter := 0; + while (Str[counter] <> #0) do + begin + if Str[Counter] in [#97..#122,#128..#255] then + Str[counter] := Upcase(Str[counter]); + Inc(counter); + end; + StrUpper := Str; + end; +{$endif FPC_UNIT_HAS_UPPER} + + +{$ifndef FPC_UNIT_HAS_LOWER} + function StrLower(Str: PChar): PChar; + var + counter: StrLenInt; + begin + counter := 0; + while (Str[counter] <> #0) do + begin + if Str[counter] in [#65..#90] then + Str[Counter] := chr(ord(Str[Counter]) + 32); + Inc(counter); + end; + StrLower := Str; + end; +{$endif FPC_UNIT_HAS_LOWER} + + + +{$ifndef FPC_UNIT_HAS_STRSCAN} + function StrScan(Str: PChar; Ch: Char): PChar; + Var + count: StrLenInt; + Begin + + count := 0; + { As in Borland Pascal , if looking for NULL return null } + if ch = #0 then + begin + StrScan := @(Str[StrLen(Str)]); + exit; + end; + { Find first matching character of Ch in Str } + while Str[count] <> #0 do + begin + if Ch = Str[count] then + begin + StrScan := @(Str[count]); + exit; + end; + Inc(count); + end; + { nothing found. } + StrScan := nil; + end; +{$endif FPC_UNIT_HAS_STRSCAN} + + + +{$ifndef FPC_UNIT_HAS_STRRSCAN} + function StrRScan(Str: PChar; Ch: Char): PChar; + Var + count: StrLenInt; + index: StrLenInt; + Begin + count := Strlen(Str); + { As in Borland Pascal , if looking for NULL return null } + if ch = #0 then + begin + StrRScan := @(Str[count]); + exit; + end; + Dec(count); + for index := count downto 0 do + begin + if Ch = Str[index] then + begin + StrRScan := @(Str[index]); + exit; + end; + end; + { nothing found. } + StrRScan := nil; + end; +{$endif FPC_UNIT_HAS_STRRSCAN} + + +{$ifndef FPC_UNIT_HAS_STRECOPY} + Function StrECopy(Dest, Source: PChar): PChar; + { Equivalent to the following: } + { strcopy(Dest,Source); } + { StrECopy := StrEnd(Dest); } + var + counter : StrLenInt; + Begin + counter := 0; + while Source[counter] <> #0 do + begin + Dest[counter] := char(Source[counter]); + Inc(counter); + end; + { terminate the string } + Dest[counter] := #0; + StrECopy:=@(Dest[counter]); + end; +{$endif FPC_UNIT_HAS_STRECOPY} + + +{$ifndef FPC_UNIT_HAS_STRLCOPY} + Function StrLCopy(Dest,Source: PChar; MaxLen: StrLenInt): PChar; + var + counter: StrLenInt; + Begin + counter := 0; + { To be compatible with BP, on a null string, put two nulls } + If Source[0] = #0 then + Begin + Dest[0]:=Source[0]; + Inc(counter); + end; + while (Source[counter] <> #0) and (counter < MaxLen) do + Begin + Dest[counter] := char(Source[counter]); + Inc(counter); + end; + { terminate the string } + Dest[counter] := #0; + StrLCopy := Dest; + end; +{$endif FPC_UNIT_HAS_STRLCOPY} + + +{$ifndef FPC_UNIT_HAS_STRCOMP} + function StrComp(Str1, Str2 : PChar): Integer; + var + counter: StrLenInt; + Begin + counter := 0; + While str1[counter] = str2[counter] do + Begin + if (str2[counter] = #0) or (str1[counter] = #0) then + break; + Inc(counter); + end; + StrComp := ord(str1[counter]) - ord(str2[counter]); + end; +{$endif FPC_UNIT_HAS_STRCOMP} + + +{$ifndef FPC_UNIT_HAS_STRICOMP} + function StrIComp(Str1, Str2 : PChar): Integer; + var + counter: StrLenInt; + c1, c2: char; + Begin + counter := 0; + c1 := upcase(str1[counter]); + c2 := upcase(str2[counter]); + While c1 = c2 do + Begin + if (c1 = #0) or (c2 = #0) then break; + Inc(counter); + c1 := upcase(str1[counter]); + c2 := upcase(str2[counter]); + end; + StrIComp := ord(c1) - ord(c2); + end; +{$endif FPC_UNIT_HAS_STRICOMP} + + +{$ifndef FPC_UNIT_HAS_STRLCOMP} + function StrLComp(Str1, Str2 : PChar; MaxLen: StrLenInt): Integer; + var + counter: StrLenInt; + c1, c2: char; + Begin + counter := 0; + if MaxLen = 0 then + begin + StrLComp := 0; + exit; + end; + Repeat + if (c1 = #0) or (c2 = #0) then break; + c1 := str1[counter]; + c2 := str2[counter]; + Inc(counter); + Until (c1 <> c2) or (counter >= MaxLen); + StrLComp := ord(c1) - ord(c2); + end; +{$endif FPC_UNIT_HAS_STRLCOMP} + + +{$ifndef FPC_UNIT_HAS_STRLICOMP} + function StrLIComp(Str1, Str2 : PChar; MaxLen: StrLenInt): Integer; + var + counter: StrLenInt; + c1, c2: char; + Begin + counter := 0; + if MaxLen = 0 then + begin + StrLIComp := 0; + exit; + end; + Repeat + if (c1 = #0) or (c2 = #0) then break; + c1 := upcase(str1[counter]); + c2 := upcase(str2[counter]); + Inc(counter); + Until (c1 <> c2) or (counter >= MaxLen); + StrLIComp := ord(c1) - ord(c2); + end; +{$endif FPC_UNIT_HAS_STRLICOMP} + +{ + $Log$ + 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/systemh.inc b/rtl/inc/systemh.inc index 2b9af094d8..9ce99b1f75 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -85,7 +85,7 @@ Type {$endif CPUI386} {$ifdef CPUX86_64} - StrLenInt = LongInt; + StrLenInt = Int64; {$define DEFAULT_EXTENDED} @@ -666,7 +666,11 @@ const { $Log$ - Revision 1.67 2003-04-25 21:09:44 peter + Revision 1.68 2003-04-30 16:36:39 florian + + support for generic pchar routines added + + some basic rtl stuff for x86-64 added + + Revision 1.67 2003/04/25 21:09:44 peter * remove dos lf Revision 1.66 2003/04/23 22:46:41 florian diff --git a/rtl/x86_64/strings.inc b/rtl/x86_64/strings.inc new file mode 100644 index 0000000000..821333549b --- /dev/null +++ b/rtl/x86_64/strings.inc @@ -0,0 +1,28 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by Florian Klaempfl, 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. + + **********************************************************************} + +{$define FPC_UNIT_HAS_STRLEN} +function strlen(p : pchar) : longint;assembler; +{$i strlen.inc} + +{ + $Log$ + Revision 1.1 2003-04-30 16:36:39 florian + + support for generic pchar routines added + + some basic rtl stuff for x86-64 added +} \ No newline at end of file diff --git a/rtl/x86_64/strlen.inc b/rtl/x86_64/strlen.inc new file mode 100644 index 0000000000..d0ed6bf1cf --- /dev/null +++ b/rtl/x86_64/strlen.inc @@ -0,0 +1,140 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by the Free Pascal development team + + Processor specific implementation of strlen + + 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. + + **********************************************************************} +{ + Implemented using the code from glibc: libc/sysdeps/x86_64/strlen.S Version 1.2 +} +asm + movq %rdi, %rcx { Duplicate source pointer. } + andl $7, %ecx { mask alignment bits } + movq %rdi, %rax { duplicate destination. } + jz LFPC_STRLEN_1 { aligned => start loop } + + neg %ecx { We need to align to 8 bytes. } + addl $8,%ecx + { Search the first bytes directly. } +LFPC_STRLEN_0: + cmpb $0x0,(%rax) { is byte NUL? } + je LFPC_STRLEN_2 { yes => return } + incq %rax { increment pointer } + decl %ecx + jnz LFPC_STRLEN_0 + +LFPC_STRLEN_1: + movq $0xfefefefefefefeff,%r8 { Save magic. } + + .p2align 4 { Align loop. } +LFPC_STRLEN_4: { Main Loop is unrolled 4 times. } + { First unroll. } + movq (%rax), %rcx { get double word (= 8 bytes) in question } + addq $8,%rax { adjust pointer for next word } + movq %r8, %rdx { magic value } + addq %rcx, %rdx { add the magic value to the word. We get + carry bits reported for each byte which + is *not* 0 } + jnc LFPC_STRLEN_3 { highest byte is NUL => return pointer } + xorq %rcx, %rdx { (word+magic)^word } + orq %r8, %rdx { set all non-carry bits } + incq %rdx { add 1: if one carry bit was *not* set + the addition will not result in 0. } + jnz LFPC_STRLEN_3 { found NUL => return pointer } + + { Second unroll. } + movq (%rax), %rcx { get double word (= 8 bytes) in question } + addq $8,%rax { adjust pointer for next word } + movq %r8, %rdx { magic value } + addq %rcx, %rdx { add the magic value to the word. We get + carry bits reported for each byte which + is *not* 0 } + jnc LFPC_STRLEN_3 { highest byte is NUL => return pointer } + xorq %rcx, %rdx { (word+magic)^word } + orq %r8, %rdx { set all non-carry bits } + incq %rdx { add 1: if one carry bit was *not* set + the addition will not result in 0. } + jnz LFPC_STRLEN_3 { found NUL => return pointer } + + { Third unroll. } + movq (%rax), %rcx { get double word (= 8 bytes) in question } + addq $8,%rax { adjust pointer for next word } + movq %r8, %rdx { magic value } + addq %rcx, %rdx { add the magic value to the word. We get + carry bits reported for each byte which + is *not* 0 } + jnc LFPC_STRLEN_3 { highest byte is NUL => return pointer } + xorq %rcx, %rdx { (word+magic)^word } + orq %r8, %rdx { set all non-carry bits } + incq %rdx { add 1: if one carry bit was *not* set + the addition will not result in 0. } + jnz LFPC_STRLEN_3 { found NUL => return pointer } + + { Fourth unroll. } + movq (%rax), %rcx { get double word (= 8 bytes) in question } + addq $8,%rax { adjust pointer for next word } + movq %r8, %rdx { magic value } + addq %rcx, %rdx { add the magic value to the word. We get + carry bits reported for each byte which + is *not* 0 } + jnc LFPC_STRLEN_3 { highest byte is NUL => return pointer } + xorq %rcx, %rdx { (word+magic)^word } + orq %r8, %rdx { set all non-carry bits } + incq %rdx { add 1: if one carry bit was *not* set + the addition will not result in 0. } + jz LFPC_STRLEN_4 { no NUL found => continue loop } + + .p2align 4 { Align, it's a jump target. } +LFPC_STRLEN_3: + subq $8,%rax { correct pointer increment. } + + testb %cl, %cl { is first byte NUL? } + jz LFPC_STRLEN_2 { yes => return } + incq %rax { increment pointer } + + testb %ch, %ch { is second byte NUL? } + jz LFPC_STRLEN_2 { yes => return } + incq %rax { increment pointer } + + testl $0x00ff0000, %ecx { is third byte NUL? } + jz LFPC_STRLEN_2 { yes => return pointer } + incq %rax { increment pointer } + + testl $0xff000000, %ecx { is fourth byte NUL? } + jz LFPC_STRLEN_2 { yes => return pointer } + incq %rax { increment pointer } + + shrq $32, %rcx { look at other half. } + + testb %cl, %cl { is first byte NUL? } + jz LFPC_STRLEN_2 { yes => return } + incq %rax { increment pointer } + + testb %ch, %ch { is second byte NUL? } + jz LFPC_STRLEN_2 { yes => return } + incq %rax { increment pointer } + + testl $0xff0000, %ecx { is third byte NUL? } + jz LFPC_STRLEN_2 { yes => return pointer } + incq %rax { increment pointer } +LFPC_STRLEN_2: + subq %rdi, %rax { compute difference to string start } + ret +end; + + +{ + $Log$ + Revision 1.1 2003-04-30 16:36:39 florian + + support for generic pchar routines added + + some basic rtl stuff for x86-64 added +}