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

* added FillQWord, IndexQWord, but CompareQWord is still missing

Browse Source 
git-svn-id: trunk@13282 -
This commit is contained in:
ivost 2009-06-15 21:35:52 +00:00
parent a444d4e786
commit 02d177c885
2 changed files with 64 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
rtl/inc/generic.inc
View File

@ -124,8 +124,9 @@ begin
begin begin
v:=(value shl 8) or value; v:=(value shl 8) or value;
v:=(v shl 16) or v; v:=(v shl 16) or v;
if sizeof(ptruint)=8 then {$ifdef CPU64}
v:=(v shl 32) or v; v:=(v shl 32) or v;
{$endif CPU64}
{ Align on native pointer size } { Align on native pointer size }
pend:=pbyte(align(pdest,sizeof(PtrUInt))); pend:=pbyte(align(pdest,sizeof(PtrUInt)));
dec(count,pend-pdest); dec(count,pend-pdest);
@ -241,6 +242,24 @@ end;
{$endif FPC_SYSTEM_HAS_FILLDWORD} {$endif FPC_SYSTEM_HAS_FILLDWORD}
{$ifndef FPC_SYSTEM_HAS_FILLQWORD}
procedure fillqword(var x;count : SizeInt;value : qword);
var
pdest,pend : pqword;
begin
if count <= 0 then
exit;
pdest:=@x;
pend:=pdest+count;
while pdest<pend do
begin
pdest^:=value;
inc(pdest);
end;
end;
{$endif FPC_SYSTEM_HAS_FILLQWORD}
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE} {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt;
var var
@ -351,6 +370,47 @@ end;
{$endif not FPC_SYSTEM_HAS_INDEXDWORD} {$endif not FPC_SYSTEM_HAS_INDEXDWORD}
{$ifndef FPC_SYSTEM_HAS_INDEXQWORD}
function IndexQWord(Const buf;len:SizeInt;b:QWord):SizeInt;
var
psrc,pend : pqword;
begin
psrc:=@buf;
{ simulate assembler implementations behaviour, which is expected }
{ fpc_pchar_to_ansistr in astrings.inc }
if (len < 0) or
(len > high(PtrInt) div 4) or
(psrc+len < psrc) then
pend:=pqword(high(PtrUInt)-sizeof(qword))
else
pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
if (ptruint(psrc) mod 8)<>0 then
while psrc<pend do
begin
if unaligned(psrc^)=b then
begin
result:=psrc-pqword(@buf);
exit;
end;
inc(psrc);
end
else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
while psrc<pend do
begin
if psrc^=b then
begin
result:=psrc-pqword(@buf);
exit;
end;
inc(psrc);
end;
result:=-1;
end;
{$endif not FPC_SYSTEM_HAS_INDEXQWORD}
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE} {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt;
var var

2
rtl/inc/systemh.inc
View File

@ -517,10 +517,12 @@ Procedure FillChar(var x;count:SizeInt;Value:Char);
procedure FillByte(var x;count:SizeInt;value:byte); procedure FillByte(var x;count:SizeInt;value:byte);
Procedure FillWord(var x;count:SizeInt;Value:Word); Procedure FillWord(var x;count:SizeInt;Value:Word);
procedure FillDWord(var x;count:SizeInt;value:DWord); procedure FillDWord(var x;count:SizeInt;value:DWord);
procedure FillQWord(var x;count:SizeInt;value:QWord);
function IndexChar(const buf;len:SizeInt;b:char):SizeInt; function IndexChar(const buf;len:SizeInt;b:char):SizeInt;
function IndexByte(const buf;len:SizeInt;b:byte):SizeInt; function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;
function Indexword(const buf;len:SizeInt;b:word):SizeInt; function Indexword(const buf;len:SizeInt;b:word):SizeInt;
function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt; function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
function IndexQWord(const buf;len:SizeInt;b:QWord):SizeInt;
function CompareChar(const buf1,buf2;len:SizeInt):SizeInt; function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
function CompareByte(const buf1,buf2;len:SizeInt):SizeInt; function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;
function CompareWord(const buf1,buf2;len:SizeInt):SizeInt; function CompareWord(const buf1,buf2;len:SizeInt):SizeInt;