paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Joined strings and sysutils

Browse Source
This commit is contained in:
michael 1999-02-25 07:39:17 +00:00
parent 30176e2c49
commit 7865673a04
11 changed files with 383 additions and 557 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
rtl/go32v1/Makefile
View File

@ -144,8 +144,10 @@ prt0$(OEXT) : prt0.as
$(SYSTEMPPU) : system.pp $(SYSDEPS) $(SYSTEMPPU) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp $(REDIR) $(COMPILER) -Us -Sg system.pp $(REDIR)
strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(COMPILER) $(PROCINC)/strings.pp $(REDIR) $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$($(SYSTEMPPU)
$(COMPILER) $(INC)/strings.pp $(REDIR)
go32$(PPUEXT) : go32.pp $(SYSTEMPPU) go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
$(COMPILER) go32.pp $(REDIR) $(COMPILER) go32.pp $(REDIR)
@ -232,7 +234,10 @@ include $(CFG)/makefile.def
# #
# $Log$ # $Log$
# Revision 1.3 1999-01-15 11:47:12 peter # Revision 1.4 1999-02-25 07:39:21 michael
# * Joined strings and sysutils
#
# Revision 1.3 1999/01/15 11:47:12 peter
# + added math unit to objects # + added math unit to objects
# #
# Revision 1.2 1998/12/28 23:37:38 peter # Revision 1.2 1998/12/28 23:37:38 peter

11
rtl/go32v2/Makefile
View File

@ -152,8 +152,10 @@ fpu$(OEXT) : fpu.as
$(SYSTEMPPU) : system.pp $(SYSDEPS) $(SYSTEMPPU) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp $(REDIR) $(COMPILER) -Us -Sg system.pp $(REDIR)
strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(COMPILER) $(PROCINC)/strings.pp $(REDIR) $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$($(SYSTEMPPU)
$(COMPILER) $(INC)/strings.pp $(REDIR)
go32$(PPUEXT) : go32.pp $(SYSTEMPPU) go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
$(COMPILER) go32.pp $(REDIR) $(COMPILER) go32.pp $(REDIR)
@ -260,7 +262,10 @@ include $(CFG)/makefile.def
# #
# $Log$ # $Log$
# Revision 1.6 1999-02-09 17:16:58 florian # Revision 1.7 1999-02-25 07:39:20 michael
# * Joined strings and sysutils
#
# Revision 1.6 1999/02/09 17:16:58 florian
# + typinfo is now also in the makefile for go32v2 # + typinfo is now also in the makefile for go32v2
# + sysutils.filetruncate for go32v2 # + sysutils.filetruncate for go32v2
# #

241
rtl/i386/strings.pp → rtl/i386/strings.inc
View File

@ -1,10 +1,11 @@
{ {
$Id$ $Id$
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team. Copyright (c) 1998 by the Free Pascal development team
Strings unit for PChar (asciiz/C compatible strings) handling
Processor dependent part of strings.pp, that can be shared with
sysutils unit.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -13,84 +14,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
unit strings;
interface
{ Returns the length of a string }
function strlen(p : pchar) : longint;
{ Converts a Pascal string to a null-terminated string }
function strpcopy(d : pchar;const s : string) : pchar;
{ Converts a null-terminated string to a Pascal string }
function strpas(p : pchar) : string;
{ Copies source to dest, returns a pointer to dest }
function strcopy(dest,source : pchar) : pchar;
{ Copies at most maxlen bytes from source to dest. }
{ Returns a pointer to dest }
function strlcopy(dest,source : pchar;maxlen : longint) : pchar;
{ Copies source to dest and returns a pointer to the terminating }
{ null character. }
function strecopy(dest,source : pchar) : pchar;
{ Returns a pointer tro the terminating null character of p }
function strend(p : pchar) : pchar;
{ Appends source to dest, returns a pointer do dest}
function strcat(dest,source : pchar) : pchar;
{ Compares str1 und str2, returns }
{ a value <0 if str1<str2; }
{ 0 when str1=str2 }
{ and a value >0 if str1>str2 }
function strcomp(str1,str2 : pchar) : longint;
{ The same as strcomp, but at most l characters are compared }
function strlcomp(str1,str2 : pchar;l : longint) : longint;
{ The same as strcomp but case insensitive }
function stricomp(str1,str2 : pchar) : longint;
{ Copies l characters from source to dest, returns dest. }
function strmove(dest,source : pchar;l : longint) : pchar;
{ Appends at most l characters from source to dest }
function strlcat(dest,source : pchar;l : longint) : pchar;
{ Returns a pointer to the first occurrence of c in p }
{ If c doesn't occur, nil is returned }
function strscan(p : pchar;c : char) : pchar;
{ Returns a pointer to the last occurrence of c in p }
{ If c doesn't occur, nil is returned }
function strrscan(p : pchar;c : char) : pchar;
{ converts p to all-lowercase, returns p }
function strlower(p : pchar) : pchar;
{ converts p to all-uppercase, returns p }
function strupper(p : pchar) : pchar;
{ The same al stricomp, but at most l characters are compared }
function strlicomp(str1,str2 : pchar;l : longint) : longint;
{ Returns a pointer to the first occurrence of str2 in }
{ str2 Otherwise returns nil }
function strpos(str1,str2 : pchar) : pchar;
{ Makes a copy of p on the heap, and returns a pointer to this copy }
function strnew(p : pchar) : pchar;
{ Allocates L bytes on the heap, returns a pchar pointer to it }
function stralloc(L : longint) : pchar;
{ Releases a null-terminated string from the heap }
procedure strdispose(p : pchar);
implementation
{$ASMMODE ATT} {$ASMMODE ATT}
@ -211,83 +134,6 @@ implementation
end ['EDI','ECX','EAX']; end ['EDI','ECX','EAX'];
end; end;
function strpcopy(d : pchar;const s : string) : pchar;
begin
asm
pushl %esi // Save ESI
cld
movl 8(%ebp),%edi // load destination address
movl 12(%ebp),%esi // Load Source adress
movl %edi,%ebx // Set return value
lodsb // load length in ECX
movzbl %al,%ecx
rep
movsb
xorb %al,%al // Set #0
stosb
movl %ebx,%eax // return value to EAX
popl %esi
leave // ... and ready
ret $8
end ['EDI','ESI','EBX','EAX','ECX'];
end;
{$ASMMODE DIRECT}
function strpas(p : pchar) : string;
begin
asm
cld
movl 12(%ebp),%edi
movl $0xff,%ecx
xorl %eax,%eax
movl %edi,%esi
repne
scasb
movl %ecx,%eax
movl 8(%ebp),%edi
notb %al
decl %eax
stosb
cmpl $7,%eax
jl .LStrPas2
movl %edi,%ecx // Align on 32bits
negl %ecx
andl $3,%ecx
subl %ecx,%eax
rep
movsb
movl %eax,%ecx
andl $3,%eax
shrl $2,%ecx
rep
movsl
.LStrPas2:
movl %eax,%ecx
rep
movsb
end ['ECX','EAX','ESI','EDI'];
end;
{$ASMMODE ATT}
function strcat(dest,source : pchar) : pchar;
begin
strcat:=strcopy(strend(dest),source);
end;
function strlcat(dest,source : pchar;l : longint) : pchar;
var
destend : pchar;
begin
destend:=strend(dest);
l:=l-(destend-dest);
strlcat:=strlcopy(destend,source,l);
end;
function strcomp(str1,str2 : pchar) : longint; function strcomp(str1,str2 : pchar) : longint;
begin begin
@ -425,13 +271,6 @@ implementation
end ['EAX','ECX','ESI','EDI']; end ['EAX','ECX','ESI','EDI'];
end; end;
function strmove(dest,source : pchar;l : longint) : pchar;
begin
move(source^,dest^,l);
strmove:=dest;
end;
function strscan(p : pchar;c : char) : pchar; function strscan(p : pchar;c : char) : pchar;
begin begin
@ -531,75 +370,3 @@ implementation
ret $4 ret $4
end; end;
end; end;
function strpos(str1,str2 : pchar) : pchar;
var
p : pchar;
lstr2 : longint;
begin
strpos:=nil;
p:=strscan(str1,str2^);
if p=nil then
exit;
lstr2:=strlen(str2);
while p<>nil do
begin
if strlcomp(p,str2,lstr2)=0 then
begin
strpos:=p;
exit;
end;
inc(longint(p));
p:=strscan(p,str2^);
end;
end;
procedure strdispose(p : pchar);
begin
if p<>nil then
freemem(p,strlen(p)+1);
end;
function strnew(p : pchar) : pchar;
var
len : longint;
begin
strnew:=nil;
if (p=nil) or (p^=#0) then
exit;
len:=strlen(p)+1;
getmem(strnew,len);
if strnew<>nil then
strmove(strnew,p,len);
end;
function stralloc(L : longint) : pchar;
begin
StrAlloc:=Nil;
GetMem (Stralloc,l);
end;
end.
{
$Log$
Revision 1.7 1998-08-05 08:59:53 michael
reverted to non-assmebler version, florians fix is applied.
Revision 1.4 1998/05/31 14:15:52 peter
* force to use ATT or direct parsing
Revision 1.3 1998/05/30 14:30:22 peter
* force att reading
Revision 1.2 1998/05/23 01:14:06 peter
+ I386_ATT switch
}

77
rtl/i386/stringss.inc Normal file
View File

@ -0,0 +1,77 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1998 by 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.
**********************************************************************}
{$ASMMODE DIRECT}
function strpas(p : pchar) : string;
begin
asm
cld
movl 12(%ebp),%edi
movl $0xff,%ecx
xorl %eax,%eax
movl %edi,%esi
repne
scasb
movl %ecx,%eax
movl 8(%ebp),%edi
notb %al
decl %eax
stosb
cmpl $7,%eax
jl .LStrPas2
movl %edi,%ecx // Align on 32bits
negl %ecx
andl $3,%ecx
subl %ecx,%eax
rep
movsb
movl %eax,%ecx
andl $3,%eax
shrl $2,%ecx
rep
movsl
.LStrPas2:
movl %eax,%ecx
rep
movsb
end ['ECX','EAX','ESI','EDI'];
end;
{$ASMMODE ATT}
function strpcopy(d : pchar;const s : string) : pchar;
begin
asm
pushl %esi // Save ESI
cld
movl 8(%ebp),%edi // load destination address
movl 12(%ebp),%esi // Load Source adress
movl %edi,%ebx // Set return value
lodsb // load length in ECX
movzbl %al,%ecx
rep
movsb
xorb %al,%al // Set #0
stosb
movl %ebx,%eax // return value to EAX
popl %esi
leave // ... and ready
ret $8
end ['EDI','ESI','EBX','EAX','ECX'];
end;

140
rtl/inc/strings.pp Normal file
View File

@ -0,0 +1,140 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team.
Strings unit for PChar (asciiz/C compatible strings) handling
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.
**********************************************************************}
unit strings;
interface
{ Returns the length of a string }
function strlen(p : pchar) : longint;
{ Converts a Pascal string to a null-terminated string }
function strpcopy(d : pchar;const s : string) : pchar;
{ Converts a null-terminated string to a Pascal string }
function strpas(p : pchar) : string;
{ Copies source to dest, returns a pointer to dest }
function strcopy(dest,source : pchar) : pchar;
{ Copies at most maxlen bytes from source to dest. }
{ Returns a pointer to dest }
function strlcopy(dest,source : pchar;maxlen : longint) : pchar;
{ Copies source to dest and returns a pointer to the terminating }
{ null character. }
function strecopy(dest,source : pchar) : pchar;
{ Returns a pointer tro the terminating null character of p }
function strend(p : pchar) : pchar;
{ Appends source to dest, returns a pointer do dest}
function strcat(dest,source : pchar) : pchar;
{ Compares str1 und str2, returns }
{ a value <0 if str1<str2; }
{ 0 when str1=str2 }
{ and a value >0 if str1>str2 }
function strcomp(str1,str2 : pchar) : longint;
{ The same as strcomp, but at most l characters are compared }
function strlcomp(str1,str2 : pchar;l : longint) : longint;
{ The same as strcomp but case insensitive }
function stricomp(str1,str2 : pchar) : longint;
{ Copies l characters from source to dest, returns dest. }
function strmove(dest,source : pchar;l : longint) : pchar;
{ Appends at most l characters from source to dest }
function strlcat(dest,source : pchar;l : longint) : pchar;
{ Returns a pointer to the first occurrence of c in p }
{ If c doesn't occur, nil is returned }
function strscan(p : pchar;c : char) : pchar;
{ Returns a pointer to the last occurrence of c in p }
{ If c doesn't occur, nil is returned }
function strrscan(p : pchar;c : char) : pchar;
{ converts p to all-lowercase, returns p }
function strlower(p : pchar) : pchar;
{ converts p to all-uppercase, returns p }
function strupper(p : pchar) : pchar;
{ The same al stricomp, but at most l characters are compared }
function strlicomp(str1,str2 : pchar;l : longint) : longint;
{ Returns a pointer to the first occurrence of str2 in }
{ str2 Otherwise returns nil }
function strpos(str1,str2 : pchar) : pchar;
{ Makes a copy of p on the heap, and returns a pointer to this copy }
function strnew(p : pchar) : pchar;
{ Allocates L bytes on the heap, returns a pchar pointer to it }
function stralloc(L : longint) : pchar;
{ Releases a null-terminated string from the heap }
procedure strdispose(p : pchar);
implementation
{ Read Processor dependent part, shared with sysutils unit }
{$i strings.inc }
{ Read processor denpendent part, NOT shared with sysutils unit }
{$i stringss.inc }
{ Functions not in assembler, but shared with sysutils unit }
{$i stringsi.inc}
{ Functions, different from the one in sysutils }
procedure strdispose(p : pchar);
begin
if p<>nil then
freemem(p,strlen(p)+1);
end;
function stralloc(L : longint) : pchar;
begin
StrAlloc:=Nil;
GetMem (Stralloc,l);
end;
end.
{
$Log$
Revision 1.1 1999-02-25 07:42:03 michael
* Joined strings and sysutils
Revision 1.7 1998/08/05 08:59:53 michael
reverted to non-assmebler version, florians fix is applied.
Revision 1.4 1998/05/31 14:15:52 peter
* force to use ATT or direct parsing
Revision 1.3 1998/05/30 14:30:22 peter
* force att reading
Revision 1.2 1998/05/23 01:14:06 peter
+ I386_ATT switch
}

63
rtl/inc/stringsi.inc Normal file
View File

@ -0,0 +1,63 @@
function strcat(dest,source : pchar) : pchar;
begin
strcat:=strcopy(strend(dest),source);
end;
function strlcat(dest,source : pchar;l : longint) : pchar;
var
destend : pchar;
begin
destend:=strend(dest);
l:=l-(destend-dest);
strlcat:=strlcopy(destend,source,l);
end;
function strmove(dest,source : pchar;l : longint) : pchar;
begin
move(source^,dest^,l);
strmove:=dest;
end;
function strpos(str1,str2 : pchar) : pchar;
var
p : pchar;
lstr2 : longint;
begin
strpos:=nil;
p:=strscan(str1,str2^);
if p=nil then
exit;
lstr2:=strlen(str2);
while p<>nil do
begin
if strlcomp(p,str2,lstr2)=0 then
begin
strpos:=p;
exit;
end;
inc(longint(p));
p:=strscan(p,str2^);
end;
end;
function strnew(p : pchar) : pchar;
var
len : longint;
begin
strnew:=nil;
if (p=nil) or (p^=#0) then
exit;
len:=strlen(p)+1;
getmem(strnew,len);
if strnew<>nil then
strmove(strnew,p,len);
end;

11
rtl/linux/Makefile
View File

@ -232,8 +232,10 @@ lprt$(OEXT) : lprt.c
$(SYSTEMPPU) : syslinux.pp $(SYSLINUXDEPS) $(SYSDEPS) $(SYSTEMPPU) : syslinux.pp $(SYSLINUXDEPS) $(SYSDEPS)
$(COMPILER) -Us -Sg syslinux.pp $(REDIR) $(COMPILER) -Us -Sg syslinux.pp $(REDIR)
strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(COMPILER) $(PROCINC)/strings.pp $(REDIR) $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$($(SYSTEMPPU)
$(COMPILER) $(INC)/strings.pp $(REDIR)
linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \ linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
syscalls.inc systypes.inc sysconst.inc $(SYSTEMPPU) syscalls.inc systypes.inc sysconst.inc $(SYSTEMPPU)
@ -336,7 +338,10 @@ include $(CFG)/makefile.def
# #
# $Log$ # $Log$
# Revision 1.13 1999-01-15 11:45:14 peter # Revision 1.14 1999-02-25 07:39:17 michael
# * Joined strings and sysutils
#
# Revision 1.13 1999/01/15 11:45:14 peter
# * added math unit to objects # * added math unit to objects
# #
# Revision 1.12 1998/12/21 13:07:05 peter # Revision 1.12 1998/12/21 13:07:05 peter

316
rtl/objpas/syspch.inc
View File

@ -27,66 +27,33 @@ type
pbyte = ^byte; pbyte = ^byte;
CharArray = array[0..0] of char; CharArray = array[0..0] of char;
{ StrLen returns the length of Str ( terminator not included ) } { Processor dependent part, shared withs strings unit }
{$i strings.inc }
function StrLen(Str: PChar): cardinal; { Processor independent part, shared with strings unit }
{$i stringsi.inc }
{ StrPas converts a PChar to a pascal string }
function StrPas(Str: PChar): string;
begin begin
result := 0; SetLength(result, StrLen(Str));
if Str <> nil then begin Move(Str^, result[1], Length(result));
while CharArray(Str^)[result] <> #0 do
result := result + 1;
end ;
end ; end ;
{ StrEnd returns a pointer to the last character (terminator) of Str } { StrAlloc allocates a buffer of Size + 4
the size of the allocated buffer is stored at result - 4
StrDispose should be used to destroy the buffer }
function StrEnd(Str: PChar): PChar; function StrAlloc(Size: cardinal): PChar;
var Temp: pointer;
begin begin
result := Str; GetMem(Temp, Size + SizeOf(cardinal));
if Str <> nil then begin Move(Size, Temp^, SizeOf(cardinal));
while result^ <> #0 do pbyte(Temp + SizeOf(cardinal))^ := 0;
result := result + 1; result := PChar(Temp + SizeOf(cardinal));
end ;
end ; end ;
{ StrMove copies Count bytes from source to dest, source and dest may overlap. }
function StrMove(Dest, Source: PChar; Count: cardinal): PChar;
begin
result := Dest;
if (Dest <> nil) and (Source <> nil) and (Count > 0) then
move(Source^, Dest^, Count);
end ;
{ StrCopy copies StrLen(Source) characters from Source to Dest and returns Dest }
function StrCopy(Dest, Source: PChar): PChar;
begin
result := StrMove(Dest, Source, 1 + StrLen(Source)); { copy nul character too ! }
end ;
{ StrECopy copies StrLen(Source) characters from Source to Dest and returns StrEnd(Dest) }
function StrECopy(Dest, Source: PChar): PChar;
begin
StrMove(Dest, Source, 1 + StrLen(Source));
result := StrEnd(Dest);
end ;
{ StrLCopy copies MaxLen or less characters from Source to Dest and returns Dest }
function StrLCopy(Dest, Source: PChar; MaxLen: cardinal): PChar;
var count: cardinal;
begin
result := Dest;
if result <> Nil then begin
count := StrLen(Source);
if count > MaxLen then
count := MaxLen;
StrMove(Dest, Source, count);
CharArray(result^)[Count] := #0; { terminate ! }
end ;
end ;
{ StrPCopy copies the pascal string Source to Dest and returns Dest } { StrPCopy copies the pascal string Source to Dest and returns Dest }
@ -111,236 +78,6 @@ if (Result <> Nil) and (MaxLen <> 0) then begin
end ; end ;
end ; end ;
{ StrCat concatenates Dest and Source and returns Dest }
function StrCat(Dest, Source: PChar): PChar;
begin
result := Dest;
StrMove(StrEnd(Dest), Source, 1 + StrLen(Source)); { include #0 }
end ;
{ StrLCat concatenates Dest and MaxLen - StrLen(Dest) (or less) characters
from Source, and returns Dest }
function StrLCat(Dest, Source: PChar; MaxLen: cardinal): PChar;
var Count: cardinal; P: PChar;
begin
result := Dest;
if (Dest <> nil) and (MaxLen <> 0) then begin
P := StrEnd(Dest);
Count := StrLen(Source);
if Count > MaxLen - (P - Dest) then
Count := MaxLen - (P - Dest);
if Count <> 0 then begin
StrMove(P, Source, Count);
CharArray(p^)[Count] := #0; { terminate Dest }
end ;
end ;
end ;
{ StrComp returns 0 if Str1 and Str2 are equal,
a value less than 0 in case Str1 < Str2
and a value greater than 0 in case Str1 > Str2 }
function StrComp(Str1, Str2: PChar): integer;
begin
result := 0;
if (Str1 <> Nil) and (Str2 <> Nil) then begin
while result = 0 do begin
result := byte(Str1^) - byte(Str2^);
if (Str1^ = #0) or (Str2^ = #0) then break;
Str1 := Str1 + 1;
Str2 := Str2 + 1;
end ;
end ;
end ;
{ StrIComp returns 0 if Str1 and Str2 are equal,
a value less than 0 in case Str1 < Str2
and a value greater than 0 in case Str1 > Str2;
comparison is case insensitive }
function StrIComp(Str1, Str2: PChar): integer;
var Chr1, Chr2: byte;
begin
result := 0;
if (Str1 <> Nil) and (Str2 <> Nil) then begin
while result = 0 do begin
Chr1 := byte(Str1^);
Chr2 := byte(Str2^);
if Chr1 in [97..122] then Chr1 := Chr1 - 32;
if Chr2 in [97..122] then Chr2 := Chr2 - 32;
result := Chr1 - Chr2;
if (Chr1 = 0) or (Chr2 = 0) then break;
Str1 := Str1 + 1;
Str2 := Str2 + 1;
end ;
end ;
end ;
{ StrLComp returns 0 if Str1 and Str2 are equal,
a value less than 0 in case Str1 < Str2
and a value greater than 0 in case Str1 > Str2;
MaxLen or less characters are compared }
function StrLComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
var I: integer;
begin
result := 0;
if (Str1 <> Nil) and (Str2 <> Nil) then begin
I := 0;
while (I < MaxLen) and (result = 0) do begin
result := byte(Str1^) - byte(Str2^);
if (Str1^ = #0) or (Str2^ = #0) then break;
Str1 := Str1 + 1;
Str2 := Str2 + 1;
I := I + 1;
end ;
end ;
end ;
{ StrLIComp returns 0 if Str1 and Str2 are equal,
a value less than 0 in case Str1 < Str2
and a value greater than 0 in case Str1 > Str2;
comparison is case insensitive and MaxLen or less characters are compared }
function StrLIComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
var Chr1, Chr2: byte; I: integer;
begin
result := 0;
if (Str1 <> Nil) and (Str2 <> Nil) then begin
I := 0;
while (I < MaxLen) and (result = 0) do begin
Chr1 := byte(Str1^);
Chr2 := byte(Str2^);
if Chr1 in [97..122] then Chr1 := Chr1 - 32;
if Chr2 in [97..122] then Chr2 := Chr2 - 32;
result := Chr1 - Chr2;
if (Chr1 = 0) or (Chr2 = 0) then break;
Str1 := Str1 + 1;
Str2 := Str2 + 1;
I := I + 1;
end ;
end ;
end ;
{ StrScan returns a PChar to the first character Chr in Str }
function StrScan(Str: PChar; Chr: char): PChar;
var P: PChar;
begin
result := Nil;
if Str <> Nil then begin
P := Str;
while (P^ <> #0) and (P^ <> Chr) do
P := P + 1;
if P^ = Chr then result := P;
end ;
end ;
{ StrRScan returns a PChar to the last character Chr in Str }
function StrRScan(Str: PChar; Chr: char): PChar;
var P: PChar;
begin
result := Nil;
if Str <> Nil then begin
P := StrEnd(Str);
While (P^ <> Chr) and (P <> Str) do
P := P - 1;
If P^ = Chr then result := P;
end ;
end ;
{ StrPos returns a PChar to the first occurance of Str2 contained in Str1
if no occurance can be found StrPos returns Nil }
function StrPos(Str1, Str2: PChar): PChar;
var E: PChar; Count1, Count2: Cardinal;
begin
Count1 := StrLen(Str1);
Count2 := StrLen(Str2);
if (Str1 <> Nil) and (Str2 <> Nil) and (Count1 > 0) and (Count1 >= Count2) then begin
E := Str1 + 1 + Count1 - Count2;
result := Str1;
While result <> E do begin
if StrLComp(result, Str2, Count2) = 0 then
exit;
result := result + 1;
end ;
end ;
result := Nil;
end ;
{ StrUpper converts all lowercase characters in Str to uppercase }
function StrUpper(Str: PChar): PChar;
begin
Result := Str;
if Str <> Nil then begin
While Str^ <> #0 do begin
if Str^ in ['a'..'z'] then
dec(byte(Str^), 32);
Str := Str + 1;
end ;
end ;
end ;
{ StrLower converts all uppercase characters in Str to lowercase }
function StrLower(Str: PChar): PChar;
begin
Result := Str;
if Str <> Nil then begin
While Str^ <> #0 do begin
if Str^ in ['A'..'Z'] then
inc(byte(Str^), 32);
Str := Str + 1;
end ;
end ;
end ;
{ StrPas converts a PChar to a pascal string }
function StrPas(Str: PChar): string;
begin
SetLength(result, StrLen(Str));
Move(Str^, result[1], Length(result));
end ;
{ StrAlloc allocates a buffer of Size + 4
the size of the allocated buffer is stored at result - 4
StrDispose should be used to destroy the buffer }
function StrAlloc(Size: cardinal): PChar;
var Temp: pointer;
begin
GetMem(Temp, Size + SizeOf(cardinal));
Move(Size, Temp^, SizeOf(cardinal));
pbyte(Temp + SizeOf(cardinal))^ := 0;
result := PChar(Temp + SizeOf(cardinal));
end ;
{ StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc }
function StrBufSize(var Str: PChar): cardinal;
begin
if Str <> Nil then
result := Cardinal(pointer(Str - SizeOf(cardinal))^)
else
result := 0;
end ;
{ StrNew creates an exact copy of Str }
function StrNew(Str: PChar): PChar;
begin
if Str <> Nil then begin
result := StrAlloc(1 + StrLen(Str));
StrCopy(result, Str);
end
else result := Nil;
end ;
{ StrDispose clears the memory allocated with StrAlloc } { StrDispose clears the memory allocated with StrAlloc }
@ -355,9 +92,22 @@ if (Str <> Nil) then begin
end ; end ;
end ; end ;
{ StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc }
function StrBufSize(var Str: PChar): cardinal;
begin
if Str <> Nil then
result := Cardinal(pointer(Str - SizeOf(cardinal))^)
else
result := 0;
end ;
{ {
$Log$ $Log$
Revision 1.3 1999-02-10 22:15:11 michael Revision 1.4 1999-02-25 07:39:57 michael
* Joined strings and sysutils
Revision 1.3 1999/02/10 22:15:11 michael
+ Changed to ansistrings + Changed to ansistrings
Revision 1.2 1998/09/16 08:28:40 michael Revision 1.2 1998/09/16 08:28:40 michael

46
rtl/objpas/syspchh.inc
View File

@ -21,34 +21,40 @@
System Utilities For Free Pascal System Utilities For Free Pascal
} }
function StrLen(Str: PChar): cardinal; { shared with strings unit }
function StrEnd(Str: PChar): PChar; function strlen(p : pchar) : longint;
function StrMove(Dest, Source: PChar; Count: cardinal): PChar; function strcopy(dest,source : pchar) : pchar;
function StrCopy(Dest, Source: PChar): PChar; function strlcopy(dest,source : pchar;maxlen : longint) : pchar;
function StrECopy(Dest, Source: PChar): PChar; function strecopy(dest,source : pchar) : pchar;
function StrLCopy(Dest, Source: PChar; MaxLen: cardinal): PChar; function strend(p : pchar) : pchar;
function strcat(dest,source : pchar) : pchar;
function strcomp(str1,str2 : pchar) : longint;
function strlcomp(str1,str2 : pchar;l : longint) : longint;
function stricomp(str1,str2 : pchar) : longint;
function strmove(dest,source : pchar;l : longint) : pchar;
function strlcat(dest,source : pchar;l : longint) : pchar;
function strscan(p : pchar;c : char) : pchar;
function strrscan(p : pchar;c : char) : pchar;
function strlower(p : pchar) : pchar;
function strupper(p : pchar) : pchar;
function strlicomp(str1,str2 : pchar;l : longint) : longint;
function strpos(str1,str2 : pchar) : pchar;
function strnew(p : pchar) : pchar;
{ Different from strings unit - ansistrings or different behaviour }
function StrPas(Str: PChar): string;
function StrPCopy(Dest: PChar; Source: string): PChar; function StrPCopy(Dest: PChar; Source: string): PChar;
function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar; function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
function StrCat(Dest, Source: PChar): PChar;
function StrLCat(Dest, Source: PChar; MaxLen: cardinal): PChar;
function StrComp(Str1, Str2: PChar): integer;
function StrIComp(Str1, Str2: PChar): integer;
function StrLComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
function StrLIComp(Str1, Str2: PChar; MaxLen: cardinal): 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 StrAlloc(Size: cardinal): PChar; function StrAlloc(Size: cardinal): PChar;
function StrBufSize(var Str: PChar): cardinal; function StrBufSize(var Str: PChar): cardinal;
function StrNew(Str: PChar): PChar;
procedure StrDispose(var Str: PChar); procedure StrDispose(var Str: PChar);
{ {
$Log$ $Log$
Revision 1.2 1998-09-16 08:28:41 michael Revision 1.3 1999-02-25 07:39:58 michael
* Joined strings and sysutils
Revision 1.2 1998/09/16 08:28:41 michael
Update from gertjan Schouten, plus small fix for linux Update from gertjan Schouten, plus small fix for linux
Revision 1.1 1998/04/10 15:17:46 michael Revision 1.1 1998/04/10 15:17:46 michael

13
rtl/os2/Makefile
View File

@ -157,10 +157,10 @@ clean :
$(SYSTEMPPU) : sysos2.pas $(SYSDEPS) $(SYSTEMPPU) : sysos2.pas $(SYSDEPS)
$(COMPILER) -Us -Sg sysos2.pas $(REDIR) $(COMPILER) -Us -Sg sysos2.pas $(REDIR)
strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(COPY) $(PROCINC)/strings.pp . $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$(COMPILER) strings $(REDIR) $($(SYSTEMPPU)
$(DEL) strings.pp $(COMPILER) $(INC)/strings.pp $(REDIR)
# #
# Delphi Object Model # Delphi Object Model
@ -230,7 +230,10 @@ include $(CFG)/makefile.def
# #
# $Log$ # $Log$
# Revision 1.4 1998-11-24 19:51:21 jonas # Revision 1.5 1999-02-25 07:39:22 michael
# * Joined strings and sysutils
#
# Revision 1.4 1998/11/24 19:51:21 jonas
# + added warning about TABs # + added warning about TABs
# #
# Revision 1.3 1998/10/27 15:14:03 pierre # Revision 1.3 1998/10/27 15:14:03 pierre

11
rtl/win32/Makefile
View File

@ -154,8 +154,10 @@ wdllprt0$(OEXT) : wdllprt0.as
$(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS) $(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS)
$(COMPILER) -Us -Sg syswin32.pp $(REDIR) $(COMPILER) -Us -Sg syswin32.pp $(REDIR)
strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(COMPILER) $(PROCINC)/strings.pp $(REDIR) $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$($(SYSTEMPPU)
$(COMPILER) $(INC)/strings.pp $(REDIR)
# #
# Delphi Object Model # Delphi Object Model
@ -378,7 +380,10 @@ include $(CFG)/makefile.def
# #
# $Log$ # $Log$
# Revision 1.17 1999-01-15 11:47:19 peter # Revision 1.18 1999-02-25 07:39:19 michael
# * Joined strings and sysutils
#
# Revision 1.17 1999/01/15 11:47:19 peter
# + added math unit to objects # + added math unit to objects
# #
# Revision 1.16 1999/01/04 11:57:45 peter # Revision 1.16 1999/01/04 11:57:45 peter