fpc/rtl/powerpc/strings.inc

{
    $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.

 **********************************************************************}

{ Note: the implementation of these routines is for BIG ENDIAN only!! (JM) }

{$ifndef FPC_UNIT_HAS_STRCOPY}
{$define FPC_UNIT_HAS_STRCOPY}
function strcopy(dest,source : pchar) : pchar;assembler;
{ in: dest in r3, source in r4 }
{ out: result (dest) in r3     }
asm
{  in: dest in r3, source in r4  }
{  out: result (dest) in r3      }
        {  load the begin of the source string in the data cache }
        dcbt    0,r4
        {  get # of misaligned bytes  }
        rlwinm. r10,r4,0,31-2+1,31
        subfic  r10,r10,4
        mtctr   r10
        {  since we have to return dest intact, use another register for  }
        {  dest in the copy loop                                          }
        subi    r9,r3,1
        subi    r4,r4,1
        beq     .LStrCopyAligned
.LStrCopyAlignLoop:
        {  load next byte  }
        lbzu    r0,1(r4)
        {  end of string?  }
        cmplwi  cr0,r0,0
        {  store byte  }
        stbu    r0,1(r9)
        {  loop if misaligned bytes left and not end of string found }
        bdnzf   cr0*4+eq,.LStrCopyAlignLoop
        beq     .LStrCopyDone
.LStrCopyAligned:
        subi    r4,r4,3
        subi    r9,r9,3
        { setup magic constants }
        {$ifdef macos}
        {  load constant 0xfefefeff }
        lis     r8,0xfefe
        addi    r8,r8,0xfeff
        {  load constant 0x80808080}
        lis     r7,0x8080
        addi    r7,r7,0x8080
        {$else}
        lis     r8,(0xfefefeff)@ha
        addi    r8,r8,(0xfefefeff)@l
        lis     r7,(0x80808080)@ha
        addi    r7,r7,(0x80808080)@l
        {$endif}
        { load first 4 bytes  }
        lwzu    r0,4(r4)

.LStrCopyAlignedLoop:
        { test for zero byte }
        add     r10,r0,r8
        andc    r10,r10,r0
        and.    r10,r10,r7
        bne     .LStrCopyEndFound
        stwu    r0,4(r9)
        { load next 4 bytes (do it here so the load can begin while the }
        { the branch is processed)                                      }
        lwzu    r0,4(r4)
        b       .LStrCopyAlignedLoop
.LStrCopyEndFound:
        { adjust for possible $01 bytes coming before the terminating 0 byte }
        rlwinm  r8,r0,7,0,31
        andc    r10,r10,r8
        { result is either 0, 8, 16 or 24 depending on which byte is zero }
        cntlzw  r10,r10
        addi    r9,r9,3
.LStrCopyWrapUpLoop:
        subic.  r10,r10,8
        rlwinm  r0,r0,8,0,31
        stbu    r0,1(r9)
        bge     .LStrCopyWrapUpLoop
.LStrCopyDone:
        {  r3 still contains dest here  }
end;
{$endif FPC_UNIT_HAS_STRCOPY}


{$ifndef FPC_UNIT_HAS_STRECOPY}
{$define FPC_UNIT_HAS_STRECOPY}
function strecopy(dest,source : pchar) : pchar;assembler;
{ in: dest in r3, source in r4        }
{ out: result (end of new dest) in r3 }
asm
        {  load the begin of the source string in the data cache }
        dcbt    0,r4
        {  get # of misaligned bytes  }
        rlwinm. r10,r4,0,31-2+1,31
        subfic  r10,r10,4
        mtctr   r10
        subi    r3,r3,1
        subi    r4,r4,1
        beq     .LStrECopyAligned
.LStrECopyAlignLoop:
        {  load next byte  }
        lbzu    r0,1(r4)
        {  end of string?  }
        cmplwi  cr0,r0,0
        {  store byte  }
        stbu    r0,1(r3)
        {  loop if misaligned bytes left and not end of string found }
        bdnzf   cr0*4+eq,.LStrECopyAlignLoop
        beq     .LStrECopyDone
.LStrECopyAligned:
        subi    r4,r4,3
        subi    r3,r3,3
        { setup magic constants }
        {$ifdef macos}
        {  load constant 0xfefefeff }
        lis     r8,0xfefe
        addi    r8,r8,0xfeff
        {  load constant 0x80808080}
        lis     r7,0x8080
        addi    r7,r7,0x8080
        {$else}
        lis     r8,(0xfefefeff)@ha
        addi    r8,r8,(0xfefefeff)@l
        lis     r7,(0x80808080)@ha
        addi    r7,r7,(0x80808080)@l
        {$endif}
{
        li      r8,-257        { 0x0feff }
        andis.  r8,r8,0x0fefe
        li      r9,-32640      { 0x08080 }
        andis.  r9,r9,0x08080
}
.LStrECopyAlignedLoop:

        {  load next 4 bytes  }
        lwzu    r0,4(r4)

        { test for zero byte }
        add     r10,r0,r8
        andc    r10,r10,r0
        and.    r10,r10,r7
        bne     .LStrECopyEndFound
        stwu    r0,4(r3)
        b       .LStrECopyAlignedLoop
.LStrECopyEndFound:
        { adjust for possible $01 bytes coming before the terminating 0 byte }
        rlwinm  r8,r0,7,0,31
        andc    r10,r10,r8
        { result is either 0, 8, 16 or 24 depending on which byte is zero }
        cntlzw  r10,r10
        addi    r3,r3,3
.LStrECopyWrapUpLoop:
        subic.  r10,r10,8
        rlwinm  r0,r0,8,0,31
        stbu    r0,1(r3)
        bge     .LStrECopyWrapUpLoop
.LStrECopyDone:
        {  r3 contains new dest here  }
end;
{$endif FPC_UNIT_HAS_STRECOPY}


{$ifndef FPC_UNIT_HAS_STRLCOPY}
{$define FPC_UNIT_HAS_STRLCOPY}
function strlcopy(dest,source : pchar;maxlen : longint) : pchar;assembler;
{ in: dest in r3, source in r4, maxlen in r5 }
{ out: result (dest) in r3                   }
asm
        {  load the begin of the source string in the data cache }
        dcbt    0,r4
        mtctr   r5
        subi    r4,r4,1
        subi    r10,r3,1
.LStrlCopyLoop:
        lbzu    r0,1(r4)
        cmplwi  r0,0
        stbu    r0,1(r10)
        bdnzf   cr0*4+eq, .LStrlCopyLoop
        { if we stopped because we copied a #0, we're done }
        beq     .LStrlCopyDone
        { otherwise add the #0 }
        li      r0,0
        stb     r0,1(r10)
.LStrlCopyDone:
end;
{$endif FPC_UNIT_HAS_STRLCOPY}


{$ifndef FPC_UNIT_HAS_STREND}
{$define FPC_UNIT_HAS_STREND}
function strend(p : pchar) : pchar;assembler;
{ in: p in r3                  }
{ out: result (end of p) in r3 }
asm
        {  load the begin of the string in the data cache }
        dcbt    0,r3
        { empty/invalid string? }
        cmplwi  r3,0
        { if yes, do nothing }
        beq     .LStrEndDone
        subi    r3,r3,1
.LStrEndLoop:
        lbzu    r0,1(r3)
        cmplwi  r0,0
        bne     .LStrEndLoop
.LStrEndDone:
end;
{$endif FPC_UNIT_HAS_STREND}


{$ifndef FPC_UNIT_HAS_STRCOMP}
{$define FPC_UNIT_HAS_STRCOMP}
function strcomp(str1,str2 : pchar) : longint;assembler;
{ in: str1 in r3, str2 in r4                                                }
{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
{      in r3                                                                }
asm
        { use r0 instead of r3 for str1 since r3 contains result }
        subi    r9,r3,1
        subi    r4,r4,1
.LStrCompLoop:
        { load next chars }
        lbzu    r0,1(r9)
        { check if one is zero }
        cmplwi  cr1,r0,0
        lbzu    r10,1(r4)
        { calculate difference }
        sub.    r3,r0,r10
        { if chars not equal, we're ready }
        bne     .LStrCompDone
        { if they are equal and one is zero, then the other one is zero too }
        { and we're done as well (r3 also contains 0 then)                  }
        { otherwise loop                                                    }
        bne     cr1,.LStrCompLoop
.LStrCompDone:
end;
{$endif FPC_UNIT_HAS_STRCOMP}


{$ifndef FPC_UNIT_HAS_STRLCOMP}
{$define FPC_UNIT_HAS_STRLCOMP}
function strlcomp(str1,str2 : pchar;l : longint) : longint;assembler;
{ (same as strcomp, but maximally compare until l'th character)             }
{ in: str1 in r3, str2 in r4, l in r5                                       }
{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
{      in r3                                                                }
asm
        { load the begin of one of the strings in the data cache }
        dcbt    0,r3
        { use r0 instead of r3 for str1 since r3 contains result }
        cmplwi  r5,0
        subi    r9,r3,1
        li      r3,0
        beq     .LStrlCompDone
        mtctr   r5
        subi    r4,r4,1
.LStrlCompLoop:
        { load next chars }
        lbzu    r0,1(r9)
        { check if one is zero }
        cmplwi  cr1,r0,0
        lbzu    r10,1(r4)
        { calculate difference }
        sub.    r3,r0,r10
        { if chars not equal, we're ready }
        bne     .LStrlCompDone
        { if they are equal and one is zero, then the other one is zero too }
        { and we're done as well (r3 also contains 0 then)                  }
        { otherwise loop (if ctr <> 0)                                      }
        bdnzf  cr1*4+eq,.LStrlCompLoop
.LStrlCompDone:
end;
{$endif FPC_UNIT_HAS_STRLCOMP}


{$ifndef FPC_UNIT_HAS_STRICOMP}
{$define FPC_UNIT_HAS_STRICOMP}
function stricomp(str1,str2 : pchar) : longint;assembler;
{ in: str1 in r3, str2 in r4                                 }
{ out: result of case insensitive comparison (< 0, = 0, > 0) }
asm
        { use r5 instead of r3 for str1 since r3 contains result }
        subi    r5,r3,1
        subi    r4,r4,1
.LStriCompLoop:
        { load next chars }
        lbzu    r6,1(r5)
        { check if one is zero }
        cmplwi  cr1,r6,0
        lbzu    r7,1(r4)
        { calculate difference }
        sub.    r3,r6,r7
        { if chars are equal, no further test is necessary }
        beq+    .LStriCompEqual

        { make both lowercase, no branches }

        { r3 := pred('A') - r6 }
        subfic    r3,r6,64
        { if r6 < 'A' then r8 := 0 else r8 := $ffffffff }
        subfe    r8,r8,r8
        { same for r7 }
        subfic   r3,r7,64
        subfe    r9,r9,r9

        { r3 := r6 - succ('Z') }
        subic    r3,r6,91
        { if r6 < 'A' then r8 := 0 else r8 := $20 }
        andi.    r8,r8,0x020
        { if r6 > Z then r10 := 0 else r10 := $ffffffff }
        subfe    r10,r10,r10
        { same for r7 }
        subic    r3,r7,91
        andi.    r9,r9,0x020
        subfe    r11,r11,r11

        { if (r6 in ['A'..'Z'] then r8 := $20 else r8 := 0 }
        and      r8,r8,r10
        { same for r7 }
        and      r9,r9,r11

        { make lowercase }
        add      r6,r6,r8
        { same for r7 }
        add      r7,r7,r9

        { compare again }
        sub.     r3,r6,r7
        bne-      .LStriCompDone
.LStriCompEqual:
        { if they are equal and one is zero, then the other one is zero too }
        { and we're done as well (r3 also contains 0 then)                  }
        { otherwise loop                                                    }
        bne     cr1,.LStriCompLoop
.LStriCompDone:
end;
{$endif FPC_UNIT_HAS_STRICOMP}


{$ifndef FPC_UNIT_HAS_STRLICOMP}
{$define FPC_UNIT_HAS_STRLICOMP}
function strlicomp(str1,str2 : pchar;l : longint) : longint;assembler;
{ (same as stricomp, but maximally compare until l'th character) }
{ in: str1 in r3, str2 in r4, l in r5                            }
{ out: result of case insensitive comparison (< 0, = 0, > 0)     }
asm
        {  load the begin of one of the string in the data cache }
        dcbt    0,r3
        { use r0 instead of r3 for str1 since r3 contains result }
        cmplwi  r5,0
        subi    r9,r3,1
        li      r3,0
        beq-    .LStrliCompDone
        mtctr   r5
        subi    r4,r4,1
.LStrliCompLoop:
        { load next chars }
        lbzu    r0,1(r9)
        { check if one is zero }
        cmplwi  cr1,r0,0
        lbzu    r10,1(r4)
        { calculate difference }
        sub.    r3,r0,r10
        { if chars are equal, no further test is necessary }
        beq     .LStrliCompEqual

        { see stricomp for explanation }

        subfic   r3,r0,64
        subfe    r8,r8,r8
        subfic   r3,r10,64
        subfe    r5,r5,r5

        subic    r3,r0,91
        andi.    r8,r8,0x020
        subfe    r7,r7,r7
        subic    r3,r10,91
        andi.    r5,r5,0x020
        subfe    r11,r11,r11

        and      r8,r8,r7
        and      r5,r5,r11
        add      r0,r0,r8
        add      r10,r10,r5

        { compare again }
        sub.     r3,r0,r10
        bne      .LStrliCompDone
.LStrliCompEqual:
        { if they are equal and one is zero, then the other one is zero too }
        { and we're done as well (r3 also contains 0 then)                  }
        { otherwise loop (if ctr <> 0)                                      }
        bdnzf    cr1*4+eq,.LStrliCompLoop
.LStrliCompDone:
end;
{$endif FPC_UNIT_HAS_STRLICOMP}


{$ifndef FPC_UNIT_HAS_STRSCAN}
{$define FPC_UNIT_HAS_STRSCAN}
function strscan(p : pchar;c : char) : pchar;assembler;
asm
        { empty/invalid string? }
        cmplwi  r3,0
        { if yes, do nothing }
        beq     .LStrScanDone
        subi    r3,r3,1
.LStrScanLoop:
        lbzu    r0,1(r3)
        cmplw   cr1,r0,r4
        cmplwi  r0,0
        beq     cr1,.LStrScanDone
        bne     .LStrScanLoop
        li      r3, 0
.LStrScanDone:
end;
{$endif FPC_UNIT_HAS_STRSCAN}


{$ifndef FPC_UNIT_HAS_STRRSCAN}
{$define FPC_UNIT_HAS_STRRSCAN}
function strrscan(p : pchar;c : char) : pchar;assembler;
asm
        { empty/invalid string? }
        cmplwi  r3,0
        { if yes, do nothing }
        beq     .LStrrScanDone
        { make r5 will be walking through the string }
        subi    r5,r3,1
        { assume not found }
        li      r3,0
.LStrrScanLoop:
        lbzu    r10,1(r5)
        cmplw   cr1,r10,r4
        cmplwi  cr0,r10,0
        bne+    cr1,.LStrrScanNotFound
        { store address of found position }
        mr      r3,r5
.LStrrScanNotFound:
        bne     .LStrrScanLoop
.LStrrScanDone:
end;
{$endif FPC_UNIT_HAS_STRRSCAN}


{$ifndef FPC_UNIT_HAS_STRUPPER}
{$define FPC_UNIT_HAS_STRUPPER}
function strupper(p : pchar) : pchar;assembler;
asm
        cmplwi  r3,0
        beq     .LStrUpperNil
        subi    r9,r3,1
.LStrUpperLoop:
        lbzu    r10,1(r9)
        { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
        subi    r0,r10,97
        cmplwi  r0,122-97
        cmplwi  cr1,r10,0
        subi    r10,r10,0x20
        bgt     .LStrUpper1
        stb     r10,0(r9)
.LStrUpper1:
        bne     cr1,.LStrUpperLoop
.LStrUpperNil:
end;
{$endif FPC_UNIT_HAS_STRUPPER}


{$ifndef FPC_UNIT_HAS_STRLOWER}
{$define FPC_UNIT_HAS_STRLOWER}
function strlower(p : pchar) : pchar;assembler;
asm
        cmplwi  r3,0
        beq     .LStrLowerNil
        subi    r9,r3,1
.LStrLowerLoop:
        lbzu    r10,1(r9)
        { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
        subi    r0,r10,65
        cmplwi  r0,90-65
        cmplwi  cr1,r10,0
        addi    r10,r10,0x20
        bgt     .LStrLower1
        stb     r10,0(r9)
.LStrLower1:
        bne     cr1,.LStrLowerLoop
.LStrLowerNil:
end;
{$endif FPC_UNIT_HAS_STRLOWER}


{
  $Log$
  Revision 1.27  2004-11-21 15:35:23  peter
    * float routines all use internproc and compilerproc helpers

  Revision 1.26  2004/08/17 13:34:15  olle
    * bugfix

  Revision 1.25  2004/08/09 16:43:33  jonas
    * fixed stricomp() and strlicomp()

  Revision 1.24  2004/05/01 17:02:37  jonas
    * use some more string routines from libc if FPC_USE_LIBC is used

  Revision 1.23  2003/12/28 22:33:35  florian
    * strscan fix from Jonas

  Revision 1.22  2003/11/29 16:27:19  jonas
    * fixed several ppc assembler reader related problems
    * local vars in assembler procedures now start at offset 4
    * fixed second_int_to_bool (apparently an integer can be in  LOC_JUMP??)

  Revision 1.21  2003/08/24 20:51:27  olle
    + added MacOS compatible constant loading

  Revision 1.20  2003/07/07 20:23:46  peter
    * added defines to override generic implementations

  Revision 1.19  2003/06/14 12:41:08  jonas
    * fixed compilation problems (removed unnecessary modified registers
      lists from procedures)

  Revision 1.18  2003/05/28 19:18:10  jonas
    * fixed strcopy and strecopy if there are #1 chars right before the end
      of the string to copied

  Revision 1.17  2003/05/24 10:16:24  jonas
    * fixed strscan and strrscan

  Revision 1.16  2003/05/17 12:55:30  florian
    * fixed copy&paste bug in strecopy

  Revision 1.15  2003/05/17 00:01:13  jonas
    * fixed strcopy

  Revision 1.14  2002/09/11 07:49:40  jonas
    * fixed assembler errors

  Revision 1.13  2002/09/07 16:01:26  peter
    * old logs removed and tabs fixed

  Revision 1.12  2002/09/06 16:58:43  jonas
    * fixed wrong references (used r0 as base register)

  Revision 1.11  2002/08/10 17:14:36  jonas
    * various fixes, mostly changing the names of the modifies registers to
      upper case since that seems to be required by the compiler

}