mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-23 07:09:18 +02:00
* varset helpers completed
git-svn-id: trunk@4635 -
This commit is contained in:
parent
d4bf6d2aed
commit
77193410b2
@ -210,17 +210,13 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
|
|||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
|
{$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
|
||||||
{ Error No pascal version of FPC_SET_LOAD_SMALL}
|
|
||||||
{ THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
|
|
||||||
Not anymore PM}
|
|
||||||
|
|
||||||
function fpc_varset_load_small(l: fpc_small_set): fpc_normal_set; compilerproc;
|
|
||||||
{
|
{
|
||||||
load a normal set p from a smallset l
|
load a normal set p from a smallset l
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_load_small(l: fpc_small_set;var dest); compilerproc;
|
||||||
begin
|
begin
|
||||||
result[0] := l;
|
move(l,plongint(@dest)^,4);
|
||||||
FillDWord(result[1],7,0);
|
FillChar((@dest+4)^,size-4,0);
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
|
||||||
|
|
||||||
@ -231,10 +227,10 @@ function fpc_varset_load_small(l: fpc_small_set): fpc_normal_set; compilerproc;
|
|||||||
}
|
}
|
||||||
procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
|
procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
|
||||||
type
|
type
|
||||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
begin
|
begin
|
||||||
FillChar(data,size,0);
|
FillChar(data,size,0);
|
||||||
longintarray(data)[b div 32]:=1 shl (b mod 32);
|
tbytearray(data)[b div 8]:=1 shl (b mod 8);
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CREATE_ELEMENT}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CREATE_ELEMENT}
|
||||||
|
|
||||||
@ -243,12 +239,12 @@ procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
|
|||||||
{
|
{
|
||||||
add the element b to the set "source"
|
add the element b to the set "source"
|
||||||
}
|
}
|
||||||
procedure fpc_varset_set_byte(var source,dest; b,size : ptrint); compilerproc;
|
procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc;
|
||||||
type
|
type
|
||||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
begin
|
begin
|
||||||
move(source,dest,sizeof(source));
|
move(source,dest,sizeof(source));
|
||||||
longintarray(dest)[b div 32]:=longintarray(dest)[b div 32] or (1 shl (b mod 32));
|
tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] or (1 shl (b mod 8));
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_BYTE}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_BYTE}
|
||||||
|
|
||||||
@ -258,108 +254,106 @@ procedure fpc_varset_set_byte(var source,dest; b,size : ptrint); compilerproc;
|
|||||||
suppresses the element b to the set pointed by p
|
suppresses the element b to the set pointed by p
|
||||||
used for exclude(set,element)
|
used for exclude(set,element)
|
||||||
}
|
}
|
||||||
procedure fpc_varset_unset_byte(var source,dest; b,size : ptrint); compilerproc;
|
procedure fpc_varset_unset(var source,dest; b,size : ptrint); compilerproc;
|
||||||
type
|
type
|
||||||
longintarray = array [0..high(sizeint) div 4-1] of longint;
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
begin
|
begin
|
||||||
move(source,dest,size);
|
move(source,dest,size);
|
||||||
longintarray(dest)[b div 32]:=longintarray(dest)[b div 32] and not (1 shl (b mod 32));
|
tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] and not (1 shl (b mod 8));
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_UNSET_BYTE}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_UNSET_BYTE}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SET_RANGE}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SET_RANGE}
|
||||||
function fpc_varset_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
|
|
||||||
{
|
{
|
||||||
adds the range [l..h] to the set orgset
|
adds the range [l..h] to the set orgset
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i: integer;
|
i : ptrint;
|
||||||
c: longint;
|
|
||||||
begin
|
begin
|
||||||
move(orgset,fpc_varset_set_range,sizeof(orgset));
|
move(orgset,dest,size);
|
||||||
for i:=l to h do
|
for i:=l to h do
|
||||||
begin
|
tbytearray(dest)[i div 8]:=(1 shl (i mod 8)) or tbytearray(dest)[i div 8];
|
||||||
c := fpc_varset_set_range[i div 32];
|
|
||||||
c := (1 shl (i mod 32)) or c;
|
|
||||||
fpc_varset_set_range[i div 32] := c;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_RANGE}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_RANGE}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
|
||||||
|
|
||||||
function fpc_varset_in_byte(const p: fpc_normal_set; b: byte): boolean; compilerproc;
|
|
||||||
{
|
{
|
||||||
tests if the element b is in the set p the carryflag is set if it present
|
tests if the element b is in the set p the carryflag is set if it present
|
||||||
}
|
}
|
||||||
|
function fpc_varset_in(const p; b : ptrint): boolean; compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
begin
|
begin
|
||||||
fpc_varset_in_byte := (p[b div 32] and (1 shl (b mod 32))) <> 0;
|
fpc_varset_in:=(tbytearray(p)[b div 8] and (1 shl (b mod 8)))<>0;
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
|
||||||
function fpc_varset_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
|
|
||||||
var
|
|
||||||
dest: fpc_normal_set absolute fpc_varset_add_sets;
|
|
||||||
{
|
{
|
||||||
adds set1 and set2 into set dest
|
adds set1 and set2 into set dest
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i: integer;
|
i : ptrint;
|
||||||
begin
|
begin
|
||||||
for i:=0 to 7 do
|
for i:=0 to size-1 do
|
||||||
dest[i] := set1[i] or set2[i];
|
tbytearray(dest)[i]:=tbytearray(set1)[i] or tbytearray(set2)[i];
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_MUL_SETS}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_MUL_SETS}
|
||||||
function fpc_varset_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
|
|
||||||
var
|
|
||||||
dest: fpc_normal_set absolute fpc_varset_mul_sets;
|
|
||||||
{
|
{
|
||||||
multiplies (takes common elements of) set1 and set2 result put in dest
|
multiplies (takes common elements of) set1 and set2 result put in dest
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i: integer;
|
i : ptrint;
|
||||||
begin
|
begin
|
||||||
for i:=0 to 7 do
|
for i:=0 to size-1 do
|
||||||
dest[i] := set1[i] and set2[i];
|
tbytearray(dest)[i]:=tbytearray(set1)[i] and tbytearray(set2)[i];
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_MUL_SETS}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_MUL_SETS}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SUB_SETS}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SUB_SETS}
|
||||||
function fpc_varset_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'fpc_varset_SUB_SETS']; compilerproc;
|
|
||||||
var
|
|
||||||
dest: fpc_normal_set absolute fpc_varset_sub_sets;
|
|
||||||
{
|
{
|
||||||
computes the diff from set1 to set2 result in dest
|
computes the diff from set1 to set2 result in dest
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i: integer;
|
i : ptrint;
|
||||||
begin
|
begin
|
||||||
for i:=0 to 7 do
|
for i:=0 to size-1 do
|
||||||
dest[i] := set1[i] and not set2[i];
|
tbytearray(dest)[i]:=tbytearray(set1)[i] and not tbytearray(set2)[i];
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SUB_SETS}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SUB_SETS}
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SYMDIF_SETS}
|
{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_SYMDIF_SETS}
|
||||||
function fpc_varset_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'fpc_varset_SYMDIF_SETS']; compilerproc;
|
|
||||||
var
|
|
||||||
dest: fpc_normal_set absolute fpc_varset_symdif_sets;
|
|
||||||
{
|
{
|
||||||
computes the symetric diff from set1 to set2 result in dest
|
computes the symetric diff from set1 to set2 result in dest
|
||||||
}
|
}
|
||||||
|
procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i: integer;
|
i : ptrint;
|
||||||
begin
|
begin
|
||||||
for i:=0 to 7 do
|
for i:=0 to size-1 do
|
||||||
dest[i] := set1[i] xor set2[i];
|
tbytearray(dest)[i]:=tbytearray(set1)[i] xor tbytearray(set2)[i];
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SYMDIF_SETS}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SYMDIF_SETS}
|
||||||
|
|
||||||
@ -368,13 +362,15 @@ procedure fpc_varset_unset_byte(var source,dest; b,size : ptrint); compilerproc;
|
|||||||
{
|
{
|
||||||
compares set1 and set2 zeroflag is set if they are equal
|
compares set1 and set2 zeroflag is set if they are equal
|
||||||
}
|
}
|
||||||
function fpc_varset_comp_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'fpc_varset_COMP_SETS'];compilerproc;
|
function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerproc;
|
||||||
|
type
|
||||||
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
i : ptrint;
|
i : ptrint;
|
||||||
begin
|
begin
|
||||||
fpc_varset_comp_sets:= false;
|
fpc_varset_comp_sets:= false;
|
||||||
for i:=0 to 7 do
|
for i:=0 to size-1 do
|
||||||
if set1[i] <> set2[i] then
|
if tbytearray(set1)[i]<>tbytearray(set2)[i] then
|
||||||
exit;
|
exit;
|
||||||
fpc_varset_comp_sets:=true;
|
fpc_varset_comp_sets:=true;
|
||||||
end;
|
end;
|
||||||
@ -385,7 +381,7 @@ function fpc_varset_comp_sets(const set1,set2 : fpc_normal_set):boolean;[public,
|
|||||||
{
|
{
|
||||||
on exit, zero flag is set if set1 <= set2 (set2 contains set1)
|
on exit, zero flag is set if set1 <= set2 (set2 contains set1)
|
||||||
}
|
}
|
||||||
function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean;[public,alias:'fpc_varset_CONTAINS_SETS'];compilerproc;
|
function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean; compilerproc;
|
||||||
type
|
type
|
||||||
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
tbytearray = array[0..sizeof(sizeint)-1] of byte;
|
||||||
var
|
var
|
||||||
@ -398,5 +394,3 @@ function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean;[public
|
|||||||
fpc_varset_contains_sets:=true;
|
fpc_varset_contains_sets:=true;
|
||||||
end;
|
end;
|
||||||
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CONTAINS_SET}
|
{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CONTAINS_SET}
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user