paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 13:29:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Readded old set code. To use it define 'oldset'. Activated by default

Browse Source 
for ppc.
This commit is contained in:
daniel 2002-07-23 12:34:29 +00:00
parent 950b60d3f8
commit 1130395e7e
9 changed files with 231 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/fpcdefs.inc
View File

@ -33,10 +33,17 @@
{$ifdef x86_64}
{$define x86}
{$endif x86_64}
{$ifdef ppc}
{$define oldset}
{$endif}
{
$Log$
Revision 1.3 2002-07-04 18:56:50 florian
Revision 1.4 2002-07-23 12:34:29 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.3 2002/07/04 18:56:50 florian
+ log added
}

84
compiler/nadd.pas
View File

@ -472,6 +472,81 @@ implementation
left:=nil;
exit;
end;
{$ifdef oldset}
case nodetype of
addn :
begin
for i:=0 to 31 do
resultset[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
t:=csetconstnode.create(@resultset,left.resulttype);
end;
muln :
begin
for i:=0 to 31 do
resultset[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
t:=csetconstnode.create(@resultset,left.resulttype);
end;
subn :
begin
for i:=0 to 31 do
resultset[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
t:=csetconstnode.create(@resultset,left.resulttype);
end;
symdifn :
begin
for i:=0 to 31 do
resultset[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
t:=csetconstnode.create(@resultset,left.resulttype);
end;
unequaln :
begin
b:=true;
for i:=0 to 31 do
if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
begin
b:=false;
break;
end;
t:=cordconstnode.create(ord(b),booltype);
end;
equaln :
begin
b:=true;
for i:=0 to 31 do
if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
begin
b:=false;
break;
end;
t:=cordconstnode.create(ord(b),booltype);
end;
lten :
begin
b := true;
for i := 0 to 31 Do
if (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
tsetconstnode(left).value_set^[i] Then
begin
b := false;
break
end;
t := cordconstnode.create(ord(b),booltype);
end;
gten :
begin
b := true;
for i := 0 to 31 Do
If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
tsetconstnode(right).value_set^[i] Then
begin
b := false;
break
end;
t := cordconstnode.create(ord(b),booltype);
end;
end;
{$else}
case nodetype of
addn :
begin
@ -485,7 +560,7 @@ implementation
end;
subn :
begin
resultset:=tsetconstnode(right).value_set^ - tsetconstnode(left).value_set^;
resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
t:=csetconstnode.create(@resultset,left.resulttype);
end;
symdifn :
@ -514,6 +589,7 @@ implementation
t:=cordconstnode.create(byte(b),booltype);
end;
end;
{$endif}
result:=t;
exit;
end;
@ -1632,7 +1708,11 @@ begin
end.
{
$Log$
Revision 1.55 2002-07-22 11:48:04 daniel
Revision 1.56 2002-07-23 12:34:29 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.55 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.54 2002/07/20 11:57:53 florian

10
compiler/ncgcon.pas
View File

@ -423,7 +423,11 @@ implementation
i:=0;
while assigned(hp1) and (i<32) do
begin
{$ifdef oldset}
if tai_const(hp1).value<>value_set^[i] then
{$else}
if tai_const(hp1).value<>Psetbytes(value_set)^[i] then
{$endif}
break;
inc(i);
hp1:=tai(hp1.next);
@ -522,7 +526,11 @@ begin
end.
{
$Log$
Revision 1.14 2002-07-22 11:48:04 daniel
Revision 1.15 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.14 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.13 2002/07/20 11:57:53 florian

22
compiler/ncgset.pas
View File

@ -137,10 +137,15 @@ implementation
pushedregs : tmaybesave;
l,l2,l3 : tasmlabel;
{$ifdef oldset}
function analizeset(Aset:Pconstset;is_small:boolean):boolean;
type
byteset=set of byte;
{$else}
function analizeset(const Aset:Tconstset;is_small:boolean):boolean;
{$endif}
var
compares,maxcompares:word;
i:byte;
begin
analizeset:=false;
@ -159,7 +164,11 @@ implementation
if is_small then
maxcompares:=3;
for i:=0 to 255 do
{$ifdef oldset}
if i in byteset(Aset^) then
{$else}
if i in Aset then
{$endif}
begin
if (numparts=0) or (i<>setparts[numparts].stop+1) then
begin
@ -207,8 +216,13 @@ implementation
(left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
{ Can we generate jumps? Possible for all types of sets }
{$ifdef oldset}
genjumps:=(right.nodetype=setconstn) and
analizeset(Tsetconstnode(right).value_set,use_small);
{$else}
genjumps:=(right.nodetype=setconstn) and
analizeset(Tsetconstnode(right).value_set^,use_small);
{$endif}
{ calculate both operators }
{ the complex one first }
firstcomplex(self);
@ -570,7 +584,11 @@ begin
end.
{
$Log$
Revision 1.8 2002-07-22 11:48:04 daniel
Revision 1.9 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.8 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.7 2002/07/21 16:58:20 jonas

25
compiler/ncnv.pas
View File

@ -239,6 +239,11 @@ implementation
procedure do_set(pos : longint);
{$ifdef oldset}
var
mask,l : longint;
{$endif}
begin
if (pos and not $ff)<>0 then
Message(parser_e_illegal_set_expr);
@ -246,7 +251,17 @@ implementation
constsethi:=pos;
if pos<constsetlo then
constsetlo:=pos;
{$ifdef oldset}
{ to do this correctly we use the 32bit array }
l:=pos shr 5;
mask:=1 shl (pos mod 32);
{ do we allow the same twice }
if (pconst32bitset(constset)^[l] and mask)<>0 then
Message(parser_e_illegal_set_expr);
pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
{$else}
include(constset^,pos);
{$endif}
end;
var
@ -257,7 +272,11 @@ implementation
if p.nodetype<>arrayconstructorn then
internalerror(200205105);
new(constset);
{$ifdef oldset}
FillChar(constset^,sizeof(constset^),0);
{$else}
constset^:=[];
{$endif}
htype.reset;
constsetlo:=0;
constsethi:=0;
@ -1751,7 +1770,11 @@ begin
end.
{
$Log$
Revision 1.63 2002-07-23 09:51:22 daniel
Revision 1.64 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.63 2002/07/23 09:51:22 daniel
* Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
are worth comitting.

41
compiler/ncon.pas
View File

@ -250,13 +250,28 @@ implementation
str_length:=tstringconstnode(p).len;
end;
{$ifdef oldset}
function is_emptyset(p : tnode):boolean;
var
i : longint;
begin
i:=0;
if p.nodetype=setconstn then
begin
while (i<32) and (tsetconstnode(p).value_set^[i]=0) do
inc(i);
end;
is_emptyset:=(i=32);
end;
{$else}
function is_emptyset(p : tnode):boolean;
begin
is_emptyset:=(p.nodetype=setconstn) and
(Tsetconstnode(p).value_set^=[]);
end;
{$endif}
function genconstsymtree(p : tconstsym) : tnode;
@ -633,12 +648,32 @@ implementation
location.loc:=LOC_CREFERENCE;
end;
{$ifdef oldset}
function tsetconstnode.docompare(p: tnode): boolean;
var
i: 0..31;
begin
if inherited docompare(p) then
begin
for i := 0 to 31 do
if (value_set^[i] <> tsetconstnode(p).value_set^[i]) then
begin
docompare := false;
exit
end;
docompare := true;
end
else
docompare := false;
end;
{$else}
function tsetconstnode.docompare(p: tnode): boolean;
begin
docompare:=(inherited docompare(p))
and (value_set^=Tsetconstnode(p).value_set^);
end;
{$endif}
{*****************************************************************************
TNILNODE
@ -715,7 +750,11 @@ begin
end.
{
$Log$
Revision 1.36 2002-07-22 11:48:04 daniel
Revision 1.37 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.36 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.35 2002/07/20 11:57:54 florian

12
compiler/node.pas
View File

@ -35,9 +35,13 @@ interface
type
pconstset = ^tconstset;
tconstset = set of 0..255;
{$ifdef oldset}
tconstset = array[0..31] of byte;
pconst32bitset = ^tconst32bitset;
tconst32bitset = array[0..7] of longint;
{$else}
tconstset = set of 0..255;
{$endif}
tnodetype = (
addn, {Represents the + operator.}
@ -823,7 +827,11 @@ implementation
end.
{
$Log$
Revision 1.32 2002-07-22 11:48:04 daniel
Revision 1.33 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.32 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.31 2002/07/21 06:58:49 daniel

24
compiler/nset.pas
View File

@ -177,6 +177,10 @@ implementation
function tinnode.det_resulttype:tnode;
{$ifdef oldset}
type
byteset = set of byte;
{$endif}
var
t : tnode;
pst : pconstset;
@ -194,14 +198,22 @@ implementation
pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum);
while assigned(pes) do
begin
{$ifdef oldset}
pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8));
{$else}
include(pcs^,pes.value);
{$endif}
pes:=pes.nextenum;
end;
end;
orddef :
begin
for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do
{$ifdef oldset}
pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8));
{$else}
include(pcs^,i);
{$endif}
end;
end;
createsetconst:=pcs;
@ -255,10 +267,14 @@ implementation
exit;
end;
{ constant evaulation }
{ constant evaluation }
if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then
begin
{$ifdef oldset}
t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype);
{$else}
t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),booltype);
{$endif}
resulttypepass(t);
result:=t;
exit;
@ -575,7 +591,11 @@ begin
end.
{
$Log$
Revision 1.28 2002-07-22 11:48:04 daniel
Revision 1.29 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.28 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.27 2002/07/20 11:57:55 florian

17
compiler/ptconst.pas
View File

@ -445,7 +445,11 @@ implementation
if source_info.endian = target_info.endian then
begin
for l:=0 to p.resulttype.def.size-1 do
{$ifdef oldset}
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l]));
{$else}
curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[l]));
{$endif}
end
else
begin
@ -453,10 +457,17 @@ implementation
j:=0;
for l:=0 to ((p.resulttype.def.size-1) div 4) do
begin
{$ifdef oldset}
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+3]));
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+2]));
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+1]));
curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j]));
{$else}
curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+3]));
curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+2]));
curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+1]));
curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j]));
{$endif}
Inc(j,4);
end;
end;
@ -975,7 +986,11 @@ implementation
end.
{
$Log$
Revision 1.52 2002-07-22 11:48:04 daniel
Revision 1.53 2002-07-23 12:34:30 daniel
* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.
Revision 1.52 2002/07/22 11:48:04 daniel
* Sets are now internally sets.
Revision 1.51 2002/07/20 11:57:56 florian