paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improve generic large set operations: +, -, *, ><, =, <=, mostly by working in PtrUints.

Browse Source
This commit is contained in:
Rika Ichinose 2023-08-02 19:27:36 +03:00 committed by FPK
parent 9f93b88c1c
commit 1a6e6a1b0b
1 changed files with 116 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
rtl/inc/genset.inc
View File

@ -139,12 +139,29 @@ procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compil
procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
begin
for i:=0 to size-1 do
tbytearray(dest)[i]:=tbytearray(set1)[i] or tbytearray(set2)[i];
end;
if (size>=sizeof(PtrUint))
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
and ((PtrUint(@set1) or PtrUint(@set2) or PtrUint(@dest) or PtrUint(size)) and (sizeof(PtrUint)-1)=0)
{$endif}
then
begin
{ Work in PtrUints from the end. }
size:=size-sizeof(PtrUint);
repeat
PPtrUint(pointer(@dest)+size)^:=PPtrUint(pointer(@set1)+size)^ or PPtrUint(pointer(@set2)+size)^;
size:=size-sizeof(PtrUint);
until size<=0;
{ Head, overlapping in non-existing cases of size = sizeof(PtrUint) or size mod sizeof(PtrUint) <> 0.
“Or” is idempotent, so dest = set1 or set2 does not matter. }
PPtrUint(@dest)^:=PPtrUint(@set1)^ or PPtrUint(@set2)^;
exit;
end;
repeat
dec(size);
tbytearray(dest)[size]:=tbytearray(set1)[size] or tbytearray(set2)[size];
until size=0;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
@ -155,11 +172,26 @@ procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compiler
procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
begin
for i:=0 to size-1 do
tbytearray(dest)[i]:=tbytearray(set1)[i] and tbytearray(set2)[i];
{ fpc_varset_add_sets with 'or' instead of 'and'. }
if (size>=sizeof(PtrUint))
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
and ((PtrUint(@set1) or PtrUint(@set2) or PtrUint(@dest) or PtrUint(size)) and (sizeof(PtrUint)-1)=0)
{$endif}
then
begin
size:=size-sizeof(PtrUint);
repeat
PPtrUint(pointer(@dest)+size)^:=PPtrUint(pointer(@set1)+size)^ and PPtrUint(pointer(@set2)+size)^;
size:=size-sizeof(PtrUint);
until size<=0;
PPtrUint(@dest)^:=PPtrUint(@set1)^ and PPtrUint(@set2)^;
exit;
end;
repeat
dec(size);
tbytearray(dest)[size]:=tbytearray(set1)[size] and tbytearray(set2)[size];
until size=0;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_MUL_SETS}
@ -172,10 +204,30 @@ procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compiler
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
headval : ptruint;
begin
for i:=0 to size-1 do
tbytearray(dest)[i]:=tbytearray(set1)[i] and not tbytearray(set2)[i];
if (size>=sizeof(PtrUint))
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
and ((PtrUint(@set1) or PtrUint(@set2) or PtrUint(@dest) or PtrUint(size)) and (sizeof(PtrUint)-1)=0)
{$endif}
then
begin
{ Head, overlapping in non-existing cases of size = sizeof(PtrUint) or size mod sizeof(PtrUint) <> 0.
“And not” is not idempotent, so head must be calculated in advance to work correctly when, in this non-existing case, dest = set1 or set2. }
headval:=PPtrUint(@set1)^ and not PPtrUint(@set2)^;
{ Work in PtrUints from the end. }
size:=size-sizeof(PtrUint);
repeat
PPtrUint(pointer(@dest)+size)^:=PPtrUint(pointer(@set1)+size)^ and not PPtrUint(pointer(@set2)+size)^;
size:=size-sizeof(PtrUint);
until size<=0;
PPtrUint(@dest)^:=headval;
exit;
end;
repeat
dec(size);
tbytearray(dest)[size]:=tbytearray(set1)[size] and not tbytearray(set2)[size];
until size=0;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SUB_SETS}
@ -188,11 +240,29 @@ procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compi
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
begin
for i:=0 to size-1 do
tbytearray(dest)[i]:=tbytearray(set1)[i] xor tbytearray(set2)[i];
end;
headval : ptruint;
begin
{ fpc_varset_sub_sets with 'xor' instead of 'and not'. }
if (size>=sizeof(PtrUint))
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
and ((PtrUint(@set1) or PtrUint(@set2) or PtrUint(@dest) or PtrUint(size)) and (sizeof(PtrUint)-1)=0)
{$endif}
then
begin
headval:=PPtrUint(@set1)^ xor PPtrUint(@set2)^;
size:=size-sizeof(PtrUint);
repeat
PPtrUint(pointer(@dest)+size)^:=PPtrUint(pointer(@set1)+size)^ xor PPtrUint(pointer(@set2)+size)^;
size:=size-sizeof(PtrUint);
until size<=0;
PPtrUint(@dest)^:=headval;
exit;
end;
repeat
dec(size);
tbytearray(dest)[size]:=tbytearray(set1)[size] xor tbytearray(set2)[size];
until size=0;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SYMDIF_SETS}
@ -201,16 +271,8 @@ procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compi
compares set1 and set2 zeroflag is set if they are equal
}
function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerproc;
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
begin
fpc_varset_comp_sets:= false;
for i:=0 to size-1 do
if tbytearray(set1)[i]<>tbytearray(set2)[i] then
exit;
fpc_varset_comp_sets:=true;
result:=CompareByte(set1,set2,size)=0;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_COMP_SETS}
@ -220,15 +282,36 @@ function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerpr
on exit, zero flag is set if set1 <= set2 (set2 contains set1)
}
function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean; compilerproc;
type
tbytearray = array[0..maxsetsize-1] of byte;
var
i : ptrint;
set1p,set2p,set1tail : pointer;
begin
fpc_varset_contains_sets:= false;
for i:=0 to size-1 do
if (tbytearray(set1)[i] and not tbytearray(set2)[i])<>0 then
result:=false;
set1p:=@set1;
set2p:=@set2;
{ Should scan left to right because first bits are more likely to differ. }
if (size>=sizeof(PtrUint))
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
and ((PtrUint(@set1) or PtrUint(@set2) or PtrUint(size)) and (sizeof(PtrUint)-1)=0)
{$endif}
then
begin
set1tail:=set1p+size-sizeof(PtrUint);
repeat
if PPtrUint(set1p)^ and not PPtrUint(set2p)^<>0 then
exit;
inc(set1p,sizeof(PtrUint));
inc(set2p,sizeof(PtrUint));
until set1p>=set1tail;
dec(set2p,set1p-set1tail); { set2p = “set2tail” }
exit(PPtrUint(set1tail)^ and not PPtrUint(set2p)^=0);
end;
set1tail:=set1p+size;
repeat
if pbyte(set1p)^ and not pbyte(set2p)^<>0 then
exit;
fpc_varset_contains_sets:=true;
inc(set1p);
inc(set2p);
until set1p=set1tail;
result:=true;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CONTAINS_SET}