+ support for generic pchar routines added

+ some basic rtl stuff for x86-64 added

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
+  Revision 1.8  2003-04-30 16:36:39  florian
-    * old logs removed and tabs fixed
+    + 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
 }

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
+}

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

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
+}

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
+}