mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 13:39:36 +02:00
* optimized generic implementations to use pointers instead of
array accesses. This also allows better register variable
optimizations
git-svn-id: trunk@8742 -
This commit is contained in:
peter
parent
36f7d56e91
commit
e8322a83e4
@ -831,7 +831,6 @@ const
|
||||
fastmoveproc_forward : pointer = @Forwards_IA32_3;
|
||||
fastmoveproc_backward : pointer = @Backwards_IA32_3;
|
||||
|
||||
{$ifndef INTERNALMOVEFILLCHAR}
|
||||
procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
|
||||
asm
|
||||
cmp ecx,SMALLMOVESIZE
|
||||
@ -862,7 +861,6 @@ asm
|
||||
jmp dword ptr fastmoveproc_backward {Source/Dest Overlap}
|
||||
@Done:
|
||||
end;
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
|
||||
{$asmmode att}
|
||||
{$ifdef FPC_HAS_VALGRINDBOOL}
|
||||
|
||||
@ -94,10 +94,10 @@ function mmx_support : boolean;
|
||||
mmx_support:=false;
|
||||
end;
|
||||
|
||||
{$if not defined(INTERNALMOVEFILLCHAR) and not defined(FPC_SYSTEM_HAS_MOVE)}
|
||||
{$ifndef FPC_SYSTEM_HAS_MOVE}
|
||||
{$define USE_FASTMOVE}
|
||||
{$i fastmove.inc}
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
{$endif FPC_SYSTEM_HAS_MOVE}
|
||||
|
||||
procedure fpc_cpuinit;
|
||||
begin
|
||||
@ -113,80 +113,6 @@ procedure fpc_cpuinit;
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_MOVE}
|
||||
{$define FPC_SYSTEM_HAS_MOVE}
|
||||
{$ifdef INTERNALMOVEFILLCHAR}
|
||||
|
||||
procedure SysMoveForward(const source;var dest;count:SizeInt);assembler;
|
||||
var
|
||||
saveesi,saveedi : longint;
|
||||
asm
|
||||
movl %edi,saveedi
|
||||
movl %esi,saveesi
|
||||
movl %eax,%esi
|
||||
movl %edx,%edi
|
||||
movl %ecx,%edx
|
||||
cld
|
||||
cmpl $15,%edx
|
||||
jl .LFMove1
|
||||
movl %edi,%ecx { Align on 32bits }
|
||||
negl %ecx
|
||||
andl $3,%ecx
|
||||
subl %ecx,%edx
|
||||
rep
|
||||
movsb
|
||||
movl %edx,%ecx
|
||||
andl $3,%edx
|
||||
shrl $2,%ecx
|
||||
rep
|
||||
movsl
|
||||
.LFMove1:
|
||||
movl %edx,%ecx
|
||||
rep
|
||||
movsb
|
||||
movl saveedi,%edi
|
||||
movl saveesi,%esi
|
||||
end;
|
||||
|
||||
procedure SysMoveBackward(const source;var dest;count:SizeInt);assembler;
|
||||
var
|
||||
saveesi,saveedi : longint;
|
||||
asm
|
||||
movl %edi,saveedi
|
||||
movl %esi,saveesi
|
||||
movl %eax,%esi
|
||||
movl %edx,%edi
|
||||
movl %ecx,%edx
|
||||
std
|
||||
addl %edx,%esi
|
||||
addl %edx,%edi
|
||||
movl %edi,%ecx
|
||||
decl %esi
|
||||
decl %edi
|
||||
cmpl $15,%edx
|
||||
jl .LBMove1
|
||||
negl %ecx { Align on 32bits }
|
||||
andl $3,%ecx
|
||||
subl %ecx,%edx
|
||||
rep
|
||||
movsb
|
||||
movl %edx,%ecx
|
||||
andl $3,%edx
|
||||
shrl $2,%ecx
|
||||
subl $3,%esi
|
||||
subl $3,%edi
|
||||
rep
|
||||
movsl
|
||||
addl $3,%esi
|
||||
addl $3,%edi
|
||||
.LBMove1:
|
||||
movl %edx,%ecx
|
||||
rep
|
||||
movsb
|
||||
cld
|
||||
movl saveedi,%edi
|
||||
movl saveesi,%esi
|
||||
end;
|
||||
|
||||
{$else INTERNALMOVEFILLCHAR}
|
||||
|
||||
procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler;
|
||||
var
|
||||
@ -268,17 +194,12 @@ asm
|
||||
movl saveesi,%esi
|
||||
end;
|
||||
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
{$endif FPC_SYSTEM_HAS_MOVE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
|
||||
{$define FPC_SYSTEM_HAS_FILLCHAR}
|
||||
{$ifdef INTERNALMOVEFILLCHAR}
|
||||
Procedure SysFillChar(var x;count:SizeInt;value:byte);assembler;
|
||||
{$else INTERNALMOVEFILLCHAR}
|
||||
Procedure FillChar(var x;count:SizeInt;value:byte);assembler;
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
asm
|
||||
{A push is prefered over a local variable because a local
|
||||
variable causes the compiler to generate a stackframe.}
|
||||
|
||||
@ -46,23 +46,12 @@ end;
|
||||
{$endif FPC_SYSTEM_HAS_FILLCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
|
||||
{$define FPC_SYSTEM_HAS_FILLBYTE}
|
||||
procedure FillByte (var x;count : sizeint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
if count <= 0 then
|
||||
exit;
|
||||
FillChar (X,Count,value);
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_FILLBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
{$define FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
{$define FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
|
||||
function memchr(const buf; b: sizeuint; len: cardinal): pointer; cdecl; external 'c';
|
||||
|
||||
function IndexChar(Const buf;len:sizeint;b:char):sizeint;
|
||||
function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
var
|
||||
res: pointer;
|
||||
begin
|
||||
@ -73,27 +62,18 @@ begin
|
||||
{ unsigned) }
|
||||
res := memchr(buf,longint(b),cardinal(len));
|
||||
if (res <> nil) then
|
||||
IndexChar := SizeInt(res-@buf)
|
||||
IndexByte := SizeInt(res-@buf)
|
||||
else
|
||||
IndexChar := -1;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
{$define FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
IndexByte:=IndexChar(buf,len,char(b));
|
||||
IndexByte := -1;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
{$define FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
function memcmp_comparechar(Const buf1,buf2;len:sizeuint):longint; cdecl; external 'c' name 'memcmp';
|
||||
|
||||
function CompareChar(Const buf1,buf2;len:sizeint):sizeint;
|
||||
function CompareByte(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
var
|
||||
res: longint;
|
||||
begin
|
||||
@ -101,20 +81,11 @@ begin
|
||||
exit(0);
|
||||
res := memcmp_comparechar(buf1,buf2,len);
|
||||
if res < 0 then
|
||||
CompareChar := -1
|
||||
CompareByte := -1
|
||||
else if res > 0 then
|
||||
CompareChar := 1
|
||||
CompareByte := 1
|
||||
else
|
||||
CompareChar := 0;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
function CompareByte(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
CompareByte := CompareChar(buf1,buf2,len);
|
||||
CompareByte := 0;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
|
||||
|
||||
@ -23,22 +23,81 @@ type
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_MOVE}
|
||||
procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
|
||||
type
|
||||
bytearray = array [0..high(sizeint)-1] of byte;
|
||||
var
|
||||
i:longint;
|
||||
aligncount : sizeint;
|
||||
pdest,psrc,pend : pbyte;
|
||||
begin
|
||||
if count <= 0 then exit;
|
||||
Dec(count);
|
||||
if @source<@dest then
|
||||
if (@dest=@source) or (count<=0) then
|
||||
exit;
|
||||
if @dest<@source then
|
||||
begin
|
||||
for i:=count downto 0 do
|
||||
bytearray(dest)[i]:=bytearray(source)[i];
|
||||
{ Forward Move }
|
||||
psrc:=@source;
|
||||
pdest:=@dest;
|
||||
if Count>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1));
|
||||
dec(count,aligncount);
|
||||
pend:=psrc+aligncount;
|
||||
while psrc<pend do
|
||||
begin
|
||||
pdest^:=psrc^;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(psrc)+(sizeuint(count) div sizeof(ptruint));
|
||||
while psrc<pend do
|
||||
begin
|
||||
pptruint(pdest)^:=pptruint(psrc)^;
|
||||
inc(pptruint(pdest));
|
||||
inc(pptruint(psrc));
|
||||
end;
|
||||
count:=count and (sizeof(PtrUInt)-1);
|
||||
end;
|
||||
pend:=psrc+count;
|
||||
while psrc<pend do
|
||||
begin
|
||||
pdest^:=psrc^;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for i:=0 to count do
|
||||
bytearray(dest)[i]:=bytearray(source)[i];
|
||||
{ Backward Move }
|
||||
psrc:=@source+count;
|
||||
pdest:=@dest+count;
|
||||
if Count>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1));
|
||||
dec(count,aligncount);
|
||||
pend:=psrc-aligncount;
|
||||
while psrc>pend do
|
||||
begin
|
||||
dec(pdest);
|
||||
dec(psrc);
|
||||
pdest^:=psrc^;
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(psrc)-(sizeuint(count) div sizeof(ptruint));
|
||||
while psrc>pend do
|
||||
begin
|
||||
dec(pptruint(pdest));
|
||||
dec(pptruint(psrc));
|
||||
pptruint(pdest)^:=pptruint(psrc)^;
|
||||
end;
|
||||
count:=count and (sizeof(PtrUInt)-1);
|
||||
end;
|
||||
pend:=psrc-count;
|
||||
while psrc>pend do
|
||||
begin
|
||||
dec(pdest);
|
||||
dec(psrc);
|
||||
pdest^:=psrc^;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_MOVE}
|
||||
@ -46,244 +105,397 @@ end;
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
|
||||
Procedure FillChar(var x;count:SizeInt;value:byte);
|
||||
type
|
||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
||||
bytearray = array [0..high(sizeint)-1] of byte;
|
||||
var
|
||||
i,v : longint;
|
||||
aligncount : sizeint;
|
||||
pdest,pend : pbyte;
|
||||
v : ptruint;
|
||||
begin
|
||||
if count <= 0 then exit;
|
||||
v := 0;
|
||||
{ aligned? }
|
||||
if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
|
||||
if count <= 0 then
|
||||
exit;
|
||||
pdest:=@x;
|
||||
if Count>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
for i:=0 to count-1 do
|
||||
bytearray(x)[i]:=value;
|
||||
end
|
||||
else
|
||||
v:=(value shl 8) or value;
|
||||
v:=(v shl 16) or v;
|
||||
if sizeof(ptruint)=8 then
|
||||
v:=(v shl 32) or v;
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1));
|
||||
dec(count,aligncount);
|
||||
pend:=pdest+aligncount;
|
||||
while pdest<pend do
|
||||
begin
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(pdest)+(sizeuint(count) div sizeof(ptruint));
|
||||
while pdest<pend do
|
||||
begin
|
||||
pptruint(pdest)^:=v;
|
||||
inc(pptruint(pdest));
|
||||
end;
|
||||
count:=count and (sizeof(ptruint)-1);
|
||||
end;
|
||||
pend:=pdest+count;
|
||||
while pdest<pend do
|
||||
begin
|
||||
v:=(value shl 8) or (value and $FF);
|
||||
v:=(v shl 16) or (v and $ffff);
|
||||
for i:=0 to (count div 4)-1 do
|
||||
longintarray(x)[i]:=v;
|
||||
for i:=(count div 4)*4 to count-1 do
|
||||
bytearray(x)[i]:=value;
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
end;
|
||||
{$endif FPC_SYSTEM_HAS_FILLCHAR}
|
||||
|
||||
|
||||
{$ifndef INTERNALMOVEFILLCHAR}
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
|
||||
procedure FillByte (var x;count : SizeInt;value : byte );
|
||||
begin
|
||||
FillChar (X,Count,CHR(VALUE));
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_FILLBYTE}
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLWORD}
|
||||
procedure fillword(var x;count : SizeInt;value : word);
|
||||
type
|
||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
||||
wordarray = array [0..high(sizeint) div 2-1] of word;
|
||||
var
|
||||
i,v : longint;
|
||||
aligncount : sizeint;
|
||||
pdest,pend : pword;
|
||||
v : ptruint;
|
||||
begin
|
||||
if Count <= 0 then exit;
|
||||
{ aligned? }
|
||||
if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
|
||||
if count <= 0 then
|
||||
exit;
|
||||
pdest:=@x;
|
||||
if Count>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
for i:=0 to count-1 do
|
||||
wordarray(x)[i]:=value;
|
||||
end
|
||||
else
|
||||
v:=(value shl 16) or value;
|
||||
if sizeof(ptruint)=8 then
|
||||
v:=(v shl 32) or v;
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 1;
|
||||
dec(count,aligncount);
|
||||
pend:=pdest+aligncount;
|
||||
while pdest<pend do
|
||||
begin
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(pdest)+((sizeuint(count)*2) div sizeof(ptruint));
|
||||
while pdest<pend do
|
||||
begin
|
||||
pptruint(pdest)^:=v;
|
||||
inc(pptruint(pdest));
|
||||
end;
|
||||
count:=((count*2) and (sizeof(ptruint)-1)) shr 1;
|
||||
end;
|
||||
pend:=pdest+count;
|
||||
while pdest<pend do
|
||||
begin
|
||||
v:=value*$10000+value;
|
||||
for i:=0 to (count div 2) -1 do
|
||||
longintarray(x)[i]:=v;
|
||||
for i:=(count div 2)*2 to count-1 do
|
||||
wordarray(x)[i]:=value;
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_FILLWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
|
||||
procedure FillDWord(var x;count : SizeInt;value : DWord);
|
||||
type
|
||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
||||
procedure filldword(var x;count : SizeInt;value : dword);
|
||||
var
|
||||
aligncount : sizeint;
|
||||
pdest,pend : pdword;
|
||||
v : ptruint;
|
||||
begin
|
||||
if count <= 0 then exit;
|
||||
while Count<>0 do
|
||||
begin
|
||||
{ range checking must be disabled here }
|
||||
longintarray(x)[count-1]:=longint(value);
|
||||
Dec(count);
|
||||
end;
|
||||
if count <= 0 then
|
||||
exit;
|
||||
pdest:=@x;
|
||||
if Count>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
v:=value;
|
||||
if sizeof(ptruint)=8 then
|
||||
v:=(v shl 32) or v;
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 2;
|
||||
dec(count,aligncount);
|
||||
pend:=pdest+aligncount;
|
||||
while pdest<pend do
|
||||
begin
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(pdest)+((sizeuint(count)*4) div sizeof(ptruint));
|
||||
while pdest<pend do
|
||||
begin
|
||||
pptruint(pdest)^:=v;
|
||||
inc(pptruint(pdest));
|
||||
end;
|
||||
count:=((count*4) and (sizeof(ptruint)-1)) shr 2;
|
||||
end;
|
||||
pend:=pdest+count;
|
||||
while pdest<pend do
|
||||
begin
|
||||
pdest^:=value;
|
||||
inc(pdest);
|
||||
end;
|
||||
end;
|
||||
{$endif FPC_SYSTEM_HAS_FILLDWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
function IndexChar(Const buf;len:SizeInt;b:char):SizeInt;
|
||||
begin
|
||||
IndexChar:=IndexByte(Buf,Len,byte(B));
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt;
|
||||
type
|
||||
bytearray = array [0..high(sizeint)-1] of byte;
|
||||
var
|
||||
I : longint;
|
||||
psrc,pend : pbyte;
|
||||
begin
|
||||
I:=0;
|
||||
psrc:=@buf;
|
||||
{ simulate assembler implementations behaviour, which is expected }
|
||||
{ fpc_pchar_to_ansistr in astrings.inc }
|
||||
if (len < 0) then
|
||||
len := high(longint);
|
||||
while (I<Len) and (bytearray(buf)[I]<>b) do
|
||||
inc(I);
|
||||
if (i=Len) then
|
||||
i:=-1; {Can't use 0, since it is a possible value}
|
||||
IndexByte:=I;
|
||||
pend:=pbyte(high(PtrUInt)-sizeof(byte))
|
||||
else
|
||||
pend:=psrc+len;
|
||||
while (psrc<pend) do
|
||||
begin
|
||||
if psrc^=b then
|
||||
begin
|
||||
result:=psrc-pbyte(@buf);
|
||||
exit;
|
||||
end;
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=-1;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
|
||||
function Indexword(Const buf;len:SizeInt;b:word):SizeInt;
|
||||
type
|
||||
wordarray = array [0..high(sizeint) div 2-1] of word;
|
||||
var
|
||||
I : longint;
|
||||
psrc,pend : pword;
|
||||
begin
|
||||
I:=0;
|
||||
psrc:=@buf;
|
||||
{ simulate assembler implementations behaviour, which is expected }
|
||||
{ fpc_pchar_to_ansistr in astrings.inc }
|
||||
if (len < 0) then
|
||||
len := high(longint);
|
||||
while (I<Len) and (wordarray(buf)[I]<>b) do
|
||||
inc(I);
|
||||
if (i=Len) then
|
||||
i:=-1; {Can't use 0, since it is a possible value for index}
|
||||
Indexword:=I;
|
||||
pend:=pword(high(PtrUInt)-sizeof(word))
|
||||
else
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
if psrc^=b then
|
||||
begin
|
||||
result:=psrc-pword(@buf);
|
||||
exit;
|
||||
end;
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=-1;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
|
||||
function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt;
|
||||
type
|
||||
dwordarray = array [0..high(sizeint) div 4-1] of dword;
|
||||
var
|
||||
I : longint;
|
||||
psrc,pend : pdword;
|
||||
begin
|
||||
I:=0;
|
||||
psrc:=@buf;
|
||||
{ simulate assembler implementations behaviour, which is expected }
|
||||
{ fpc_pchar_to_ansistr in astrings.inc }
|
||||
if (len < 0) then
|
||||
len := high(longint);
|
||||
while (I<Len) and (dwordarray(buf)[I]<>b) do
|
||||
inc(I);
|
||||
if (i=Len) then
|
||||
i:=-1; {Can't use 0, since it is a possible value for index}
|
||||
IndexDWord:=I;
|
||||
pend:=pdword(high(PtrUInt)-sizeof(dword))
|
||||
else
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
if psrc^=b then
|
||||
begin
|
||||
result:=psrc-pdword(@buf);
|
||||
exit;
|
||||
end;
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=-1;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXDWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
function CompareChar(Const buf1,buf2;len:SizeInt):SizeInt;
|
||||
begin
|
||||
CompareChar:=CompareByte(buf1,buf2,len);
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt;
|
||||
type
|
||||
bytearray = array [0..high(sizeint)-1] of byte;
|
||||
var
|
||||
I : longint;
|
||||
aligncount : sizeint;
|
||||
psrc,pdest,pend : pbyte;
|
||||
b : ptrint;
|
||||
begin
|
||||
I:=0;
|
||||
if (Len<>0) and (@Buf1<>@Buf2) then
|
||||
begin
|
||||
while (bytearray(Buf1)[I]=bytearray(Buf2)[I]) and (I<Len) do
|
||||
inc(I);
|
||||
if I=Len then {No difference}
|
||||
I:=0
|
||||
else
|
||||
begin
|
||||
I:=longint(bytearray(Buf1)[I])-longint(bytearray(Buf2)[I]);
|
||||
if I>0 then
|
||||
I:=1
|
||||
else
|
||||
if I<0 then
|
||||
I:=-1;
|
||||
end;
|
||||
end;
|
||||
CompareByte:=I;
|
||||
b:=0;
|
||||
psrc:=@buf1;
|
||||
pdest:=@buf2;
|
||||
if len>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1));
|
||||
dec(len,aligncount);
|
||||
pend:=psrc+aligncount;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(psrc)+(sizeuint(len) div sizeof(ptruint));
|
||||
len:=len and (sizeof(PtrUInt)-1) shr 1;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(pptrint(psrc)^-pptrint(pdest)^);
|
||||
if b<>0 then
|
||||
begin
|
||||
len:=sizeof(ptruint);
|
||||
break;
|
||||
end;
|
||||
inc(pptruint(pdest));
|
||||
inc(pptruint(psrc));
|
||||
end;
|
||||
end;
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=0;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
|
||||
function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt;
|
||||
type
|
||||
wordarray = array [0..high(sizeint) div 2-1] of word;
|
||||
var
|
||||
I : longint;
|
||||
aligncount : sizeint;
|
||||
psrc,pdest,pend : pword;
|
||||
b : ptrint;
|
||||
begin
|
||||
I:=0;
|
||||
if (Len<>0) and (@Buf1<>@Buf2) then
|
||||
begin
|
||||
while (wordarray(Buf1)[I]=wordarray(Buf2)[I]) and (I<Len) do
|
||||
inc(I);
|
||||
if I=Len then {No difference}
|
||||
I:=0
|
||||
else
|
||||
begin
|
||||
I:=longint(wordarray(Buf1)[I])-longint(wordarray(Buf2)[I]);
|
||||
if I>0 then
|
||||
I:=1
|
||||
else
|
||||
if I<0 then
|
||||
I:=-1;
|
||||
end;
|
||||
end;
|
||||
CompareWord:=I;
|
||||
b:=0;
|
||||
psrc:=@buf1;
|
||||
pdest:=@buf2;
|
||||
if len>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 1;
|
||||
dec(len,aligncount);
|
||||
pend:=psrc+aligncount;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(psrc)+(sizeuint(len)*2 div sizeof(ptruint));
|
||||
len:=len and (sizeof(PtrUInt)-1) shr 1;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(pptrint(psrc)^-pptrint(pdest)^);
|
||||
if b<>0 then
|
||||
begin
|
||||
len:=sizeof(ptruint) shr 1;
|
||||
break;
|
||||
end;
|
||||
inc(pptruint(pdest));
|
||||
inc(pptruint(psrc));
|
||||
end;
|
||||
end;
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=0;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPAREWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
|
||||
function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt;
|
||||
type
|
||||
cardinalarray = array [0..high(sizeint) div 4-1] of cardinal;
|
||||
var
|
||||
I : int64;
|
||||
aligncount : sizeint;
|
||||
psrc,pdest,pend : pdword;
|
||||
b : ptrint;
|
||||
begin
|
||||
I:=0;
|
||||
if (Len<>0) and (@Buf1<>@Buf2) then
|
||||
begin
|
||||
while (cardinalarray(Buf1)[I]=cardinalarray(Buf2)[I]) and (I<Len) do
|
||||
inc(I);
|
||||
if I=Len then {No difference}
|
||||
I:=0
|
||||
else
|
||||
begin
|
||||
I:=int64(cardinalarray(Buf1)[I])-int64(cardinalarray(Buf2)[I]);
|
||||
if I>0 then
|
||||
I:=1
|
||||
else
|
||||
if I<0 then
|
||||
I:=-1;
|
||||
end;
|
||||
end;
|
||||
CompareDWord:=I;
|
||||
b:=0;
|
||||
psrc:=@buf1;
|
||||
pdest:=@buf2;
|
||||
if len>4*sizeof(ptruint)-1 then
|
||||
begin
|
||||
{ Align on native pointer size }
|
||||
aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 2;
|
||||
dec(len,aligncount);
|
||||
pend:=psrc+aligncount;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
{ use sizeuint typecast to force shr optimization }
|
||||
pptruint(pend):=pptruint(psrc)+(sizeuint(len)*4 div sizeof(ptruint));
|
||||
len:=len and (sizeof(PtrUInt)-1) shr 2;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(pptrint(psrc)^-pptrint(pdest)^);
|
||||
if b<>0 then
|
||||
begin
|
||||
len:=sizeof(ptruint) shr 2;
|
||||
break;
|
||||
end;
|
||||
inc(pptruint(pdest));
|
||||
inc(pptruint(psrc));
|
||||
end;
|
||||
end;
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if b<>0 then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=0;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_COMPAREDWORD}
|
||||
|
||||
@ -291,9 +503,10 @@ end;
|
||||
{$ifndef FPC_SYSTEM_HAS_MOVECHAR0}
|
||||
procedure MoveChar0(Const buf1;var buf2;len:SizeInt);
|
||||
var
|
||||
I : longint;
|
||||
I : SizeInt;
|
||||
begin
|
||||
if Len = 0 then exit;
|
||||
if Len = 0 then
|
||||
exit;
|
||||
I:=IndexByte(Buf1,Len,0);
|
||||
if I<>-1 then
|
||||
Move(Buf1,Buf2,I)
|
||||
@ -306,50 +519,54 @@ end;
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
|
||||
function IndexChar0(Const buf;len:SizeInt;b:Char):SizeInt;
|
||||
var
|
||||
I : longint;
|
||||
psrc,pend : pbyte;
|
||||
begin
|
||||
if Len<>0 then
|
||||
begin
|
||||
I:=IndexByte(Buf,Len,0);
|
||||
If (I=-1) then
|
||||
I:=Len;
|
||||
IndexChar0:=IndexByte(Buf,I,byte(b));
|
||||
end
|
||||
psrc:=@buf;
|
||||
{ simulate assembler implementations behaviour, which is expected }
|
||||
{ fpc_pchar_to_ansistr in astrings.inc }
|
||||
if (len < 0) then
|
||||
pend:=pbyte(high(PtrUInt)-sizeof(byte))
|
||||
else
|
||||
IndexChar0:=0;
|
||||
pend:=psrc+len;
|
||||
while (psrc<pend) and (psrc^<>0) do
|
||||
begin
|
||||
if (psrc^=byte(b)) then
|
||||
begin
|
||||
result:=psrc-pbyte(@buf);
|
||||
exit;
|
||||
end;
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=-1;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_INDEXCHAR0}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
|
||||
function CompareChar0(Const buf1,buf2;len:SizeInt):SizeInt;
|
||||
type
|
||||
bytearray = array [0..high(sizeint)-1] of byte;
|
||||
var
|
||||
i : longint;
|
||||
aligncount : sizeint;
|
||||
psrc,pdest,pend : pbyte;
|
||||
b : ptrint;
|
||||
begin
|
||||
I:=0;
|
||||
if (Len<>0) and (@Buf1<>@Buf2) then
|
||||
begin
|
||||
while (I<Len) And
|
||||
((Pbyte(@Buf1)[i]<>0) and (PByte(@buf2)[i]<>0)) and
|
||||
(pbyte(@Buf1)[I]=pbyte(@Buf2)[I]) do
|
||||
inc(I);
|
||||
if (I=Len) or
|
||||
(PByte(@Buf1)[i]=0) or
|
||||
(PByte(@buf2)[I]=0) then {No difference or 0 reached }
|
||||
I:=0
|
||||
else
|
||||
begin
|
||||
I:=longint(bytearray(Buf1)[I])-longint(bytearray(Buf2)[I]);
|
||||
if I>0 then
|
||||
I:=1
|
||||
else
|
||||
if I<0 then
|
||||
I:=-1;
|
||||
end;
|
||||
end;
|
||||
CompareChar0:=I;
|
||||
b:=0;
|
||||
psrc:=@buf1;
|
||||
pdest:=@buf2;
|
||||
pend:=psrc+len;
|
||||
while psrc<pend do
|
||||
begin
|
||||
b:=(ptrint(psrc^)-ptrint(pdest^));
|
||||
if (b<>0) or (psrc^=0) or (pdest^=0) then
|
||||
begin
|
||||
if b<0 then
|
||||
exit(-1)
|
||||
else
|
||||
exit(1);
|
||||
end;
|
||||
inc(pdest);
|
||||
inc(psrc);
|
||||
end;
|
||||
result:=0;
|
||||
end;
|
||||
{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
|
||||
|
||||
|
||||
@ -86,7 +86,7 @@
|
||||
if assigned(S) then
|
||||
begin
|
||||
if IUnknown(S).QueryInterface(iid,tmp)<>S_OK then
|
||||
handleerror(219);
|
||||
handleerror(219);
|
||||
if assigned(D) then
|
||||
IUnknown(D)._Release;
|
||||
D:=tmp;
|
||||
@ -748,7 +748,7 @@
|
||||
if NewInstance<>nil then
|
||||
TInterfacedObject(NewInstance).frefcount:=1;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TAGGREGATEDOBJECT
|
||||
****************************************************************************}
|
||||
@ -778,13 +778,13 @@
|
||||
|
||||
begin
|
||||
Result := IUnknown(fcontroller)._Release;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TAggregatedObject.GetController : IUnknown;
|
||||
|
||||
begin
|
||||
Result := IUnknown(fcontroller);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
|
||||
@ -141,17 +141,36 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt; forward;
|
||||
{$define SYSPROCDEFINED}
|
||||
{$endif cpuarm}
|
||||
|
||||
{$ifndef INTERNALMOVEFILLCHAR}
|
||||
|
||||
procedure fillchar(var x;count : SizeInt;value : boolean);{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
fillchar(x,count,byte(value));
|
||||
end;
|
||||
|
||||
|
||||
procedure fillchar(var x;count : SizeInt;value : char);{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
fillchar(x,count,byte(value));
|
||||
end;
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
|
||||
|
||||
procedure FillByte (var x;count : SizeInt;value : byte ); {$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
FillChar (X,Count,VALUE);
|
||||
end;
|
||||
|
||||
|
||||
function IndexChar(Const buf;len:SizeInt;b:char):SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
IndexChar:=IndexByte(Buf,Len,byte(B));
|
||||
end;
|
||||
|
||||
|
||||
function CompareChar(Const buf1,buf2;len:SizeInt):SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
begin
|
||||
CompareChar:=CompareByte(buf1,buf2,len);
|
||||
end;
|
||||
|
||||
|
||||
{ Include generic pascal only routines which are not defined in the processor
|
||||
specific include file }
|
||||
|
||||
@ -408,30 +408,23 @@ ThreadVar
|
||||
****************************************************************************}
|
||||
|
||||
{$ifdef FPC_USE_LIBC}
|
||||
{$ifdef SYSTEMINLINE}
|
||||
{$define INLINEGENERICS}
|
||||
{$endif}
|
||||
{$ifdef SYSTEMINLINE}
|
||||
{$define INLINEGENERICS}
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{$ifdef INTERNALMOVEFILLCHAR}
|
||||
Procedure SysMoveForward(const source;var dest;count:SizeInt);
|
||||
Procedure SysMoveBackward(const source;var dest;count:SizeInt);
|
||||
Procedure SysFillChar(var x;count:SizeInt;Value:Byte);
|
||||
procedure FillByte(var x;count:SizeInt;value:byte);[INTERNPROC: fpc_in_fillchar_x];
|
||||
{$else INTERNALMOVEFILLCHAR}
|
||||
Procedure Move(const source;var dest;count:SizeInt);{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
Procedure FillChar(var x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
Procedure FillChar(var x;count:SizeInt;Value:Boolean);{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
Procedure FillChar(var x;count:SizeInt;Value:Char);{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
Procedure FillChar(var x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
procedure FillByte(var x;count:SizeInt;value:byte);{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
procedure FillByte(var x;count:SizeInt;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
Procedure FillWord(var x;count:SizeInt;Value:Word);
|
||||
procedure FillDWord(var x;count:SizeInt;value:DWord);
|
||||
function IndexChar(const buf;len:SizeInt;b:char):SizeInt;
|
||||
function IndexChar(const buf;len:SizeInt;b:char):SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
function Indexword(const buf;len:SizeInt;b:word):SizeInt;
|
||||
function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
|
||||
function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
|
||||
function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
function CompareWord(const buf1,buf2;len:SizeInt):SizeInt;
|
||||
function CompareDWord(const buf1,buf2;len:SizeInt):SizeInt;
|
||||
@ -444,12 +437,6 @@ procedure ReadDependencyBarrier;{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
procedure ReadWriteBarrier;{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
procedure WriteBarrier;{$ifdef INLINEGENERICS}inline;{$endif}
|
||||
|
||||
{$ifdef INTERNALMOVEFILLCHAR}
|
||||
var
|
||||
fpc_moveforward_proc : pointer = @SysMoveForward public name 'FPC_MOVEFORWARD_PROC';
|
||||
fpc_movebackward_proc : pointer = @SysMoveBackward public name 'FPC_MOVEBACKWARD_PROC';
|
||||
fpc_fillchar_proc : pointer = @SysFillChar public name 'FPC_FILLCHAR_PROC';
|
||||
{$endif INTERNALMOVEFILLCHAR}
|
||||
|
||||
{****************************************************************************
|
||||
Math Routines
|
||||
|
||||
Loading…
Reference in New Issue
Block a user