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

* cleanup and simplify the set type handling

Browse Source 
git-svn-id: trunk@10432 -
This commit is contained in:
peter 2008-03-02 17:48:27 +00:00
parent 400ad32882
commit 8f239d04b6
27 changed files with 378 additions and 602 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/arm/cpupara.pas
View File

@ -173,7 +173,7 @@ unit cpupara;
is_array_of_const(def) or
is_array_constructor(def);
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
stringdef :
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
end;

2
compiler/avr/cpupara.pas
View File

@ -173,7 +173,7 @@ unit cpupara;
is_array_of_const(def) or
is_array_constructor(def);
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
stringdef :
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
end;

9
compiler/browcol.pas
View File

@ -1388,14 +1388,7 @@ end;
function GetSetDefStr(def: tsetdef): string;
var Name: string;
begin
Name:='';
case def.settype of
normset : Name:='set';
smallset : Name:='set';
varset : Name:='varset';
end;
Name:=Name+' of ';
Name:=Name+GetDefinitionStr(def.elementdef);
Name:='set of '+GetDefinitionStr(def.elementdef);
GetSetDefStr:=Name;
end;
function GetPointerDefStr(def: tpointerdef): string;

15
compiler/defutil.pas
View File

@ -233,9 +233,6 @@ interface
{# returns true, if the type passed is can be used with windows automation }
function is_automatable(p : tdef) : boolean;
{# returns true, if the type passed is a varset }
function is_varset(p : tdef) : boolean;
{ # returns true if the procdef has no parameters and no specified return type }
function is_bareprocdef(pd : tprocdef): boolean;
@ -665,14 +662,6 @@ implementation
end;
{ true if p is a smallset def }
function is_smallset(p : tdef) : boolean;
begin
is_smallset:=(p.typ=setdef) and
(tsetdef(p).settype=smallset);
end;
{ true, if def is a 32 bit int type }
function is_32bitint(def : tdef) : boolean;
begin
@ -999,9 +988,9 @@ implementation
{# returns true, if the type passed is a varset }
function is_varset(p : tdef) : boolean;
function is_smallset(p : tdef) : boolean;
begin
result:=(p.typ=setdef) and not(p.size in [1,2,4])
result:=(p.typ=setdef) and (p.size in [1,2,4])
end;

2
compiler/i386/cpupara.pas
View File

@ -210,7 +210,7 @@ unit cpupara;
procvardef :
result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (po_methodpointer in tprocvardef(def).procoptions);
setdef :
result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (tsetdef(def).settype<>smallset);
result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (not is_smallset(def));
end;
end;

6
compiler/m68k/cpupara.pas
View File

@ -168,7 +168,7 @@ unit cpupara;
objectdef :
result:=is_object(def);
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
stringdef :
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
procvardef :
@ -293,7 +293,7 @@ unit cpupara;
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
{ syscall for AmigaOS can have already a paraloc set }
if (vo_has_explicit_paraloc in hp.varoptions) then
begin
@ -302,7 +302,7 @@ unit cpupara;
continue;
end;
hp.paraloc[side].reset;
{ currently only support C-style array of const }
if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
is_array_of_const(paradef) then

292
compiler/nadd.pas
View File

@ -1067,7 +1067,7 @@ implementation
else
inserttypeconv(left,right.resultdef)
end
else
else
begin
if (rd.size=ld.size) and
is_signed(rd) then
@ -1251,7 +1251,7 @@ implementation
{ note: ld cannot be an empty set with elementdef=nil in }
{ case right is not a set, arrayconstructor_to_set takes }
{ care of that }
{ 1: rd is a set with an assigned elementdef, and ld is }
{ either an empty set without elementdef or a set whose }
{ elementdef fits in rd's elementdef -> convert to rd }
@ -1307,7 +1307,7 @@ implementation
if (rd.typ=setdef) then
inserttypeconv(right,nd)
else
inserttypeconv(right,tsetdef(nd).elementdef);
inserttypeconv(right,tsetdef(nd).elementdef);
end;
end;
end
@ -1971,43 +1971,72 @@ implementation
newstatement : tstatementnode;
temp : ttempcreatenode;
begin
if (is_varset(left.resultdef) or is_varset(right.resultdef)) then
begin
case nodetype of
equaln,unequaln,lten,gten:
begin
case nodetype of
equaln,unequaln:
procname := 'fpc_varset_comp_sets';
lten,gten:
result:=nil;
case nodetype of
equaln,unequaln,lten,gten:
begin
case nodetype of
equaln,unequaln:
procname := 'fpc_varset_comp_sets';
lten,gten:
begin
procname := 'fpc_varset_contains_sets';
{ (left >= right) = (right <= left) }
if nodetype = gten then
begin
procname := 'fpc_varset_contains_sets';
{ (left >= right) = (right <= left) }
if nodetype = gten then
begin
tempn := left;
left := right;
right := tempn;
end;
end;
end;
result := ccallnode.createinternres(procname,
ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
ccallparanode.create(right,
ccallparanode.create(left,nil))),resultdef);
{ left and right are reused as parameters }
left := nil;
right := nil;
{ for an unequaln, we have to negate the result of comp_sets }
if nodetype = unequaln then
result := cnotnode.create(result);
tempn := left;
left := right;
right := tempn;
end;
end;
end;
addn:
result := ccallnode.createinternres(procname,
ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
ccallparanode.create(right,
ccallparanode.create(left,nil))),resultdef);
{ left and right are reused as parameters }
left := nil;
right := nil;
{ for an unequaln, we have to negate the result of comp_sets }
if nodetype = unequaln then
result := cnotnode.create(result);
end;
addn:
begin
{ optimize first loading of a set }
if (right.nodetype=setelementn) and
not(assigned(tsetelementnode(right).right)) and
is_emptyset(left) then
begin
{ optimize first loading of a set }
if (right.nodetype=setelementn) and
not(assigned(tsetelementnode(right).right)) and
is_emptyset(left) then
result:=internalstatements(newstatement);
{ create temp for result }
temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
addstatement(newstatement,temp);
{ adjust for set base }
tsetelementnode(right).left:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).left,nil))))
);
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
tsetelementnode(right).left := nil;
end
else
begin
if right.nodetype=setelementn then
begin
result:=internalstatements(newstatement);
@ -2020,85 +2049,52 @@ implementation
ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).left,nil))))
);
{ add a range or a single element? }
if assigned(tsetelementnode(right).right) then
begin
{ adjust for set base }
tsetelementnode(right).right:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).right,
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil))))))
);
end
else
addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil)))))
);
{ remove reused parts from original node }
tsetelementnode(right).right:=nil;
tsetelementnode(right).left:=nil;
left:=nil;
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
tsetelementnode(right).left := nil;
end
else
begin
if right.nodetype=setelementn then
begin
result:=internalstatements(newstatement);
{ create temp for result }
temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
addstatement(newstatement,temp);
{ adjust for set base }
tsetelementnode(right).left:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
{ add a range or a single element? }
if assigned(tsetelementnode(right).right) then
begin
{ adjust for set base }
tsetelementnode(right).right:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).right,
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil))))))
);
end
else
addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil)))))
);
{ remove reused parts from original node }
tsetelementnode(right).right:=nil;
tsetelementnode(right).left:=nil;
left:=nil;
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
end
else
call_varset_helper('fpc_varset_add_sets');
end
end;
subn:
call_varset_helper('fpc_varset_sub_sets');
symdifn:
call_varset_helper('fpc_varset_symdif_sets');
muln:
call_varset_helper('fpc_varset_mul_sets');
else
internalerror(200609241);
call_varset_helper('fpc_varset_add_sets');
end
end;
end
else
internalerror(2007091601);
subn:
call_varset_helper('fpc_varset_sub_sets');
symdifn:
call_varset_helper('fpc_varset_symdif_sets');
muln:
call_varset_helper('fpc_varset_mul_sets');
else
internalerror(200609241);
end;
end;
@ -2488,82 +2484,26 @@ implementation
else array constructor can be seen as array of char (PFV) }
else if (ld.typ=setdef) then
begin
if not(is_varset(ld)) then
{ small sets are handled inline by the compiler.
small set doesn't have support for adding ranges }
if is_smallset(ld) and
not(
(right.nodetype=setelementn) and
assigned(tsetelementnode(right).right)
) then
begin
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
expectloc:=LOC_FLAGS
else
expectloc:=LOC_REGISTER;
{ are we adding set elements ? }
if right.nodetype=setelementn then
begin
{ add range?
the smallset code can't handle set ranges }
if assigned(tsetelementnode(right).right) then
begin
result:=internalstatements(newstatement);
{ create temp for result }
temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
addstatement(newstatement,temp);
{ adjust for set base }
tsetelementnode(right).left:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
{ add a range or a single element? }
if assigned(tsetelementnode(right).right) then
begin
{ adjust for set base }
tsetelementnode(right).right:=caddnode.create(subn,
ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).right,
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil))))))
)
end
else
addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(ctemprefnode.create(temp),
ccallparanode.create(left,nil)))))
);
{ remove reused parts from original node }
tsetelementnode(right).right:=nil;
tsetelementnode(right).left:=nil;
left:=nil;
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
end;
end;
end
else
{$ifdef MMXSET}
{$ifdef i386}
if cs_mmx in current_settings.localswitches then
expectloc:=LOC_MMXREGISTER
else
{$endif}
{$endif MMXSET}
begin
result := first_addset;
if assigned(result) then
exit;
expectloc:=LOC_CREFERENCE;
{ here we call SET... }
include(current_procinfo.flags,pi_do_call);
end;
begin
result := first_addset;
if assigned(result) then
exit;
expectloc:=LOC_CREFERENCE;
end;
end
{ compare pchar by addresses like BP/Delphi }

155
compiler/ncgadd.pas
View File

@ -50,9 +50,9 @@ interface
procedure second_addfloat;virtual;abstract;
procedure second_addboolean;virtual;
procedure second_addsmallset;virtual;
procedure second_addsmallsetelement;virtual;
{$ifdef x86}
{$ifdef SUPPORT_MMX}
procedure second_opmmxset;virtual;abstract;
procedure second_opmmx;virtual;abstract;
{$endif SUPPORT_MMX}
{$endif x86}
@ -253,11 +253,14 @@ interface
procedure tcgaddnode.second_opsmallset;
begin
{ when a setdef is passed, it has to be a smallset }
if is_varset(left.resultdef) or
is_varset(right.resultdef) then
if not(
((left.nodetype=setelementn) or is_smallset(left.resultdef)) and
((right.nodetype=setelementn) or is_smallset(right.resultdef))
) then
internalerror(200203302);
if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
if (left.nodetype=setelementn) or (right.nodetype=setelementn) then
second_addsmallsetelement
else if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
second_cmpsmallset
else
second_addsmallset;
@ -267,82 +270,16 @@ interface
procedure tcgaddnode.second_addsmallset;
var
tmpreg : tregister;
mask,
setbase : aint;
cgop : TOpCg;
opdone : boolean;
begin
opdone := false;
pass_left_right;
force_reg_left_right(true,true);
{ setelementn is a special case, it must be on right.
We need an extra check if left is a register because the
default case can skip the register loading when the
setelementn is in a register (PFV) }
if (nf_swapped in flags) and
(left.nodetype=setelementn) then
swapleftright;
if (right.nodetype=setelementn) and
(left.location.loc<>LOC_REGISTER) then
location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false);
set_result_location_reg;
if (left.resultdef.typ=setdef) then
setbase:=tsetdef(left.resultdef).setbase
else
setbase:=tsetdef(right.resultdef).setbase;
case nodetype of
addn :
begin
{ are we adding set elements ? }
if right.nodetype=setelementn then
begin
{ no range support for smallsets! }
if assigned(tsetelementnode(right).right) then
internalerror(43244);
if (right.location.loc = LOC_CONSTANT) then
begin
if (target_info.endian=endian_big) then
mask:=aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value-setbase))
else
mask:=aint(1 shl (right.location.value-setbase));
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
mask,left.location.register,location.register);
end
else
begin
if (target_info.endian=endian_big) then
begin
mask:=aint((aword(1) shl (resultdef.size*8-1)));
cgop:=OP_SHR
end
else
begin
mask:=1;
cgop:=OP_SHL
end;
tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,mask,tmpreg);
location_force_reg(current_asmdata.CurrAsmList,right.location,location.size,true);
register_maybe_adjust_setbase(current_asmdata.CurrAsmList,right.location,setbase);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.register,tmpreg);
if left.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,tmpreg,
left.location.register,location.register)
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
left.location.value,tmpreg,location.register);
end;
opdone := true;
end
else
cgop := OP_OR;
end;
cgop:=OP_OR;
symdifn :
cgop:=OP_XOR;
muln :
@ -402,6 +339,63 @@ interface
end;
procedure tcgaddnode.second_addsmallsetelement;
var
tmpreg : tregister;
mask,
setbase : aint;
cgop : TOpCg;
begin
if nodetype<>addn then
internalerror(20080302);
{ setelementn is a special case, it must be on right }
if (nf_swapped in flags) and
(left.nodetype=setelementn) then
swapleftright;
{ no range support for smallsets }
if assigned(tsetelementnode(right).right) then
internalerror(20080303);
pass_left_right;
force_reg_left_right(false,false);
set_result_location_reg;
setbase:=tsetdef(left.resultdef).setbase;
if (right.location.loc = LOC_CONSTANT) then
begin
if (target_info.endian=endian_big) then
mask:=aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value-setbase))
else
mask:=aint(1 shl (right.location.value-setbase));
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
mask,left.location.register,location.register);
end
else
begin
if (target_info.endian=endian_big) then
begin
mask:=aint((aword(1) shl (resultdef.size*8-1)));
cgop:=OP_SHR
end
else
begin
mask:=1;
cgop:=OP_SHL
end;
tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,mask,tmpreg);
location_force_reg(current_asmdata.CurrAsmList,right.location,location.size,true);
register_maybe_adjust_setbase(current_asmdata.CurrAsmList,right.location,setbase);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.register,tmpreg);
if left.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,tmpreg,
left.location.register,location.register)
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
left.location.value,tmpreg,location.register);
end;
end;
{*****************************************************************************
Boolean
*****************************************************************************}
@ -810,21 +804,10 @@ interface
end;
setdef :
begin
{Normalsets are already handled in pass1 if mmx
should not be used.}
if is_varset(tsetdef(left.resultdef)) then
begin
{$ifdef SUPPORT_MMX}
{$ifdef i386}
if cs_mmx in current_settings.localswitches then
second_opmmxset
else
{$endif}
{$endif SUPPORT_MMX}
internalerror(200109041);
end
if is_smallset(tsetdef(left.resultdef)) then
second_opsmallset
else
second_opsmallset;
internalerror(200109041);
end;
arraydef :
begin

267
compiler/ncgcon.pas
View File

@ -513,144 +513,143 @@ implementation
*****************************************************************************}
procedure tcgsetconstnode.pass_generate_code;
var
hp1 : tai;
lastlabel : tasmlabel;
i, diff : longint;
neededtyp : taiconst_type;
type
setbytes=array[0..31] of byte;
Psetbytes=^setbytes;
procedure smallsetconst;
begin
location_reset(location,LOC_CONSTANT,int_cgsize(resultdef.size));
if (source_info.endian=target_info.endian) then
begin
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
{ not plongint, because that will "sign extend" the set on 64 bit platforms }
{ if changed to "paword", please also modify "32-resultdef.size*8" and }
{ cross-endian code below }
{ Extra aint type cast to avoid range errors }
location.value:=aint(pCardinal(value_set)^)
{$else}
location.value:=reverse_byte(Psetbytes(value_set)^[0]);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[1]) shl 8);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[2]) shl 16);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[3]) shl 24);
{$endif}
end
else
begin
location.value:=swapendian(Pcardinal(value_set)^);
location.value:= reverse_byte (location.value and $ff) or
(reverse_byte((location.value shr 8) and $ff) shl 8) or
(reverse_byte((location.value shr 16) and $ff) shl 16) or
(reverse_byte((location.value shr 24) and $ff) shl 24);
end;
if (target_info.endian=endian_big) then
location.value:=location.value shr (32-resultdef.size*8);
end;
procedure varsetconst;
var
hp1 : tai;
lastlabel : tasmlabel;
i, diff : longint;
neededtyp : taiconst_type;
type
setbytes=array[0..31] of byte;
Psetbytes=^setbytes;
begin
location_reset(location,LOC_CREFERENCE,OS_NO);
neededtyp:=aitconst_8bit;
lastlabel:=nil;
{ const already used ? }
if not assigned(lab_set) then
begin
{ tries to found an old entry }
hp1:=tai(current_asmdata.asmlists[al_typedconsts].first);
while assigned(hp1) do
begin
if hp1.typ=ait_label then
lastlabel:=tai_label(hp1).labsym
else
begin
if (lastlabel<>nil) and
(hp1.typ=ait_const) and
(tai_const(hp1).consttype=neededtyp) then
begin
if (tai_const(hp1).consttype=aitconst_8bit) then
begin
{ compare normal set }
i:=0;
while assigned(hp1) and (i<32) do
begin
if (source_info.endian=target_info.endian) then
begin
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
if tai_const(hp1).value<>Psetbytes(value_set)^[i ] then
{$else}
if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i xor 3]) then
{$endif}
break
end
else if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i]) then
break;
inc(i);
hp1:=tai(hp1.next);
end;
if i=32 then
begin
{ found! }
lab_set:=lastlabel;
break;
end;
{ leave when the end of consts is reached, so no
hp1.next is done }
if not assigned(hp1) then
break;
end
else
begin
{ compare small set }
if paint(value_set)^=tai_const(hp1).value then
begin
{ found! }
lab_set:=lastlabel;
break;
end;
end;
end;
lastlabel:=nil;
end;
hp1:=tai(hp1.next);
end;
{ :-(, we must generate a new entry }
if not assigned(lab_set) then
begin
current_asmdata.getdatalabel(lastlabel);
lab_set:=lastlabel;
maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint)));
current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
if (source_info.endian=target_info.endian) then
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
{$else}
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i xor 3])))
{$endif}
else
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
end;
end;
location.reference.symbol:=lab_set;
end;
begin
adjustforsetbase;
{ small sets are loaded as constants }
if not(is_varset(resultdef)) then
begin
location_reset(location,LOC_CONSTANT,int_cgsize(resultdef.size));
if (source_info.endian=target_info.endian) then
begin
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
{ not plongint, because that will "sign extend" the set on 64 bit platforms }
{ if changed to "paword", please also modify "32-resultdef.size*8" and }
{ cross-endian code below }
{ Extra aint type cast to avoid range errors }
location.value:=aint(pCardinal(value_set)^)
{$else}
location.value:=reverse_byte(Psetbytes(value_set)^[0]);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[1]) shl 8);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[2]) shl 16);
location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[3]) shl 24);
{$endif}
end
else
begin
location.value:=swapendian(Pcardinal(value_set)^);
location.value:= reverse_byte (location.value and $ff) or
(reverse_byte((location.value shr 8) and $ff) shl 8) or
(reverse_byte((location.value shr 16) and $ff) shl 16) or
(reverse_byte((location.value shr 24) and $ff) shl 24);
end;
if (target_info.endian=endian_big) then
location.value:=location.value shr (32-resultdef.size*8);
exit;
end;
location_reset(location,LOC_CREFERENCE,OS_NO);
neededtyp:=aitconst_8bit;
lastlabel:=nil;
{ const already used ? }
if not assigned(lab_set) then
begin
{ tries to found an old entry }
hp1:=tai(current_asmdata.asmlists[al_typedconsts].first);
while assigned(hp1) do
begin
if hp1.typ=ait_label then
lastlabel:=tai_label(hp1).labsym
else
begin
if (lastlabel<>nil) and
(hp1.typ=ait_const) and
(tai_const(hp1).consttype=neededtyp) then
begin
if (tai_const(hp1).consttype=aitconst_8bit) then
begin
{ compare normal set }
i:=0;
while assigned(hp1) and (i<32) do
begin
if (source_info.endian=target_info.endian) then
begin
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
if tai_const(hp1).value<>Psetbytes(value_set)^[i ] then
{$else}
if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i xor 3]) then
{$endif}
break
end
else if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i]) then
break;
inc(i);
hp1:=tai(hp1.next);
end;
if i=32 then
begin
{ found! }
lab_set:=lastlabel;
break;
end;
{ leave when the end of consts is reached, so no
hp1.next is done }
if not assigned(hp1) then
break;
end
else
begin
{ compare small set }
if paint(value_set)^=tai_const(hp1).value then
begin
{ found! }
lab_set:=lastlabel;
break;
end;
end;
end;
lastlabel:=nil;
end;
hp1:=tai(hp1.next);
end;
{ :-(, we must generate a new entry }
if not assigned(lab_set) then
begin
current_asmdata.getdatalabel(lastlabel);
lab_set:=lastlabel;
maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint)));
current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
{ already handled at the start of this method?? (JM)
if tsetdef(resultdef).settype=smallset then
begin
move(value_set^,i,sizeof(longint));
Consts.concat(Tai_const.Create_32bit(i));
end
else
}
begin
if (source_info.endian=target_info.endian) then
{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
{$else}
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i xor 3])))
{$endif}
else
for i:=0 to 31 do
current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
end;
end;
end;
location.reference.symbol:=lab_set;
if is_smallset(resultdef) then
smallsetconst
else
varsetconst;
end;

3
compiler/ncgset.pas
View File

@ -182,7 +182,8 @@ implementation
begin
{ check if we can use smallset operation using btl which is limited
to 32 bits, the left side may also not contain higher values !! }
use_small:=(tsetdef(right.resultdef).settype=smallset) and not is_signed(left.resultdef) and
use_small:=is_smallset(right.resultdef) and
not is_signed(left.resultdef) and
((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<32) or
(left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32));

39
compiler/ncnv.pas
View File

@ -240,13 +240,8 @@ implementation
end;
{ don't insert obsolete type conversions }
if equal_defs(p.resultdef,def) and
not ((p.resultdef.typ=setdef) and
(tsetdef(p.resultdef).settype <>
tsetdef(def).settype)) then
begin
p.resultdef:=def;
end
if equal_defs(p.resultdef,def) then
p.resultdef:=def
else
begin
p:=ctypeconvnode.create(p,def);
@ -266,13 +261,8 @@ implementation
end;
{ don't insert obsolete type conversions }
if equal_defs(p.resultdef,def) and
not ((p.resultdef.typ=setdef) and
(tsetdef(p.resultdef).settype <>
tsetdef(def).settype)) then
begin
p.resultdef:=def;
end
if equal_defs(p.resultdef,def) then
p.resultdef:=def
else
begin
p:=ctypeconvnode.create_internal(p,def);
@ -2597,10 +2587,11 @@ implementation
begin
left.resultdef:=resultdef;
result:=left;
left:=nil;
end
{ equal sets for the code generator? }
else if (left.resultdef.size=resultdef.size) and
(tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) then
(tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) then
{$warning This causes wrong (but Delphi-compatible) results for disjoint subsets}
{ e.g., this prints true because of this:
var
@ -2614,9 +2605,11 @@ implementation
writeln(b in sb);
end.
}
result:=left
begin
result:=left;
left:=nil;
end
else
// if is_varset(resultdef) then
begin
result:=internalstatements(newstatement);
@ -2651,18 +2644,8 @@ implementation
);
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
left:=nil;
end;
{
else
begin
srsym:=search_system_type('FPC_SMALL_SET');
result :=
ccallnode.createinternres('fpc_set_load_small',
ccallparanode.create(ctypeconvnode.create_internal(left,srsym.typedef),nil),resultdef);
end;
}
{ reused }
left:=nil;
end;

2
compiler/ncon.pas
View File

@ -1060,7 +1060,7 @@ implementation
function tsetconstnode.pass_1 : tnode;
begin
result:=nil;
if tsetdef(resultdef).settype=smallset then
if is_smallset(resultdef) then
expectloc:=LOC_CONSTANT
else
expectloc:=LOC_CREFERENCE;

2
compiler/paramgr.pas
View File

@ -144,7 +144,7 @@ implementation
{ interfaces are also passed by reference to be compatible with delphi and COM }
((def.typ=objectdef) and (is_object(def) or is_interface(def))) or
(def.typ=variantdef) or
((def.typ=setdef) and (tsetdef(def).settype<>smallset));
((def.typ=setdef) and not is_smallset(def));
end;

10
compiler/pdecvar.pas
View File

@ -573,10 +573,12 @@ implementation
is_class(p.propdef) or
is_single(p.propdef) or
(p.propdef.typ in [classrefdef,pointerdef]) or
((p.propdef.typ=setdef) and
(tsetdef(p.propdef).settype=smallset))) or
((p.propdef.typ=arraydef) and
(ppo_indexed in p.propoptions)) or
is_smallset(p.propdef)
) or
(
(p.propdef.typ=arraydef) and
(ppo_indexed in p.propoptions)
) or
(ppo_hasparameters in p.propoptions) then
begin
Message(parser_e_property_cant_have_a_default_value);

2
compiler/powerpc/cpupara.pas
View File

@ -200,7 +200,7 @@ unit cpupara;
objectdef :
result:=is_object(def);
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
stringdef :
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
end;

2
compiler/powerpc/nppcadd.pas
View File

@ -777,7 +777,7 @@ interface
setdef :
begin
{ normalsets are already handled in pass1 }
if (tsetdef(left.resultdef).settype<>smallset) then
if not is_smallset(left.resultdef) then
internalerror(200109042);
second_addsmallset;
exit;

18
compiler/powerpc64/cpupara.pas
View File

@ -186,7 +186,7 @@ begin
objectdef:
result := is_object(def);
setdef:
result := (tsetdef(def).settype <> smallset);
result := not is_smallset(def);
stringdef:
result := tstringdef(def).stringtype in [st_shortstring, st_longstring];
end;
@ -353,7 +353,7 @@ begin
end;
{ patch FPU values into integer registers if we currently have
to pass them as vararg parameters
to pass them as vararg parameters
}
if (isVararg) and (paradef.typ = floatdef) then begin
loc := LOC_REGISTER;
@ -385,7 +385,7 @@ begin
paracgsize := int_cgsize(paralen);
if (paracgsize in [OS_NO,OS_128,OS_S128]) then
paraloc^.size := OS_INT
else
else
paraloc^.size := paracgsize;
paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE);
@ -403,12 +403,12 @@ begin
inc(nextintreg);
inc(nextfloatreg);
dec(paralen, tcgsize2size[paraloc^.size]);
inc(stack_offset, tcgsize2size[OS_FLOAT]);
end else if (loc = LOC_MMREGISTER) then begin
{ Altivec not supported }
internalerror(200510192);
end else begin
end else begin
{ either LOC_REFERENCE, or one of the above which must be passed on the
stack because of insufficient registers }
paraloc^.loc := LOC_REFERENCE;
@ -440,7 +440,7 @@ begin
curintreg := nextintreg;
curfloatreg := nextfloatreg;
curmmreg := nextmmreg;
cur_stack_offset := stack_offset;
cur_stack_offset := stack_offset;
result := stack_offset;
end;
@ -449,7 +449,7 @@ function tppcparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
var
cur_stack_offset: aword;
parasize, l: longint;
curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
i: integer;
hp: tparavarsym;
paraloc: pcgparalocation;
@ -494,9 +494,9 @@ end;
{
breaks e.g. tests/test/cg/tpara1
procedure tppcparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
var
paraloc : pcgparalocation;

8
compiler/powerpc64/nppcadd.pas
View File

@ -96,8 +96,8 @@ begin
opsize := OS_32
else
opsize := OS_S32;
cg.a_load_reg_reg(current_asmdata.CurrAsmList, def_cgsize(left.resultdef), opsize,
left.location.register, left.location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList, def_cgsize(left.resultdef), opsize,
left.location.register, left.location.register);
end;
{ can we use an immediate, or do we have to load the
@ -173,7 +173,7 @@ begin
setdef:
begin
{ normalsets are already handled in pass1 }
if (tsetdef(left.resultdef).settype <> smallset) then
if not is_smallset(left.resultdef) then
internalerror(200109041);
second_addsmallset;
exit;
@ -218,7 +218,7 @@ begin
checkoverflow:=
(nodetype in [addn,subn,muln]) and
(cs_check_overflow in current_settings.localswitches) and
(left.resultdef.typ<>pointerdef) and
(left.resultdef.typ<>pointerdef) and
(right.resultdef.typ<>pointerdef);
load_left_right(cmpop, checkoverflow);

6
compiler/ppcgen/ngppcadd.pas
View File

@ -383,10 +383,8 @@ implementation
pass_left_and_right;
{ when a setdef is passed, it has to be a smallset }
if ((left.resultdef.typ=setdef) and
(tsetdef(left.resultdef).settype<>smallset)) or
((right.resultdef.typ=setdef) and
(tsetdef(right.resultdef).settype<>smallset)) then
if not is_smallset(left.resultdef) or
not is_smallset(right.resultdef) then
internalerror(200203301);
opdone := false;

2
compiler/sparc/cpupara.pas
View File

@ -133,7 +133,7 @@ implementation
procvardef :
result:=(po_methodpointer in tprocvardef(def).procoptions);
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
end;
end;

5
compiler/symconst.pas
View File

@ -191,11 +191,6 @@ type
st_unicodestring
);
{ set types }
tsettype = (
normset,smallset,varset
);
tvarianttype = (
vt_normalvariant,vt_olevariant
);

26
compiler/symdef.pas
View File

@ -542,7 +542,6 @@ interface
tsetdef = class(tstoreddef)
elementdef : tdef;
elementdefderef : tderef;
settype : tsettype;
setbase,
setmax : aword;
constructor create(def:tdef;low, high : aint);
@ -1065,7 +1064,7 @@ implementation
objectdef:
is_intregable:=(is_class(self) or is_interface(self)) and not needs_inittable;
setdef:
is_intregable:=(tsetdef(self).settype=smallset);
is_intregable:=is_smallset(self);
recorddef:
begin
recsize:=size;
@ -2043,15 +2042,9 @@ implementation
begin
setbase:=0;
if (high<32) then
begin
settype:=smallset;
savesize:=Sizeof(longint)
end
savesize:=Sizeof(longint)
else if (high<256) then
begin
settype:=normset;
savesize:=32
end
savesize:=32
else
savesize:=(high+7) div 8
end
@ -2061,14 +2054,8 @@ implementation
setbase:=low and not(setallocbits-1);
packedsavesize:=current_settings.setalloc*((((high+setallocbits)-setbase)) DIV setallocbits);
savesize:=packedsavesize;
if (packedsavesize<=4) then
begin
settype:=smallset;
if savesize=3 then
savesize:=4;
end
else if (packedsavesize<=32) then
settype:=normset;
if savesize=3 then
savesize:=4;
end;
end;
@ -2077,7 +2064,6 @@ implementation
begin
inherited ppuload(setdef,ppufile);
ppufile.getderef(elementdefderef);
settype:=tsettype(ppufile.getbyte);
savesize:=ppufile.getaint;
setbase:=ppufile.getaint;
setmax:=ppufile.getaint;
@ -2088,7 +2074,6 @@ implementation
begin
result:=tsetdef.create(elementdef,setbase,setmax);
{ the copy might have been created with a different setalloc setting }
tsetdef(result).settype:=settype;
tsetdef(result).savesize:=savesize;
end;
@ -2097,7 +2082,6 @@ implementation
begin
inherited ppuwrite(ppufile);
ppufile.putderef(elementdefderef);
ppufile.putbyte(byte(settype));
ppufile.putaint(savesize);
ppufile.putaint(setbase);
ppufile.putaint(setmax);

18
compiler/utils/ppudump.pp
View File

@ -1651,7 +1651,6 @@ end;
procedure readdefinitions(const s:string);
type
tsettype = (normset,smallset,varset);
tordtype = (
uvoid,
u8bit,u16bit,u32bit,u64bit,
@ -1960,20 +1959,9 @@ begin
readcommondef('Set definition');
write (space,' Element type : ');
readderef;
b:=getbyte;
// skip savesize
getaint;
case tsettype(b) of
smallset : write(space,' SmallSet');
normset : write(space,' NormalSet');
varset : write(space,' VarSet');
else writeln('!! Warning: Invalid set type ',b);
end;
// set base
l:=getaint;
// set max
j:=getaint;
writeln(' with ',j-l,' elements');
writeln(space,' Size : ',getaint);
writeln(space,' Set Base : ',getaint);
writeln(space,' Set Max : ',getaint);
end;
ibvariantdef :

80
compiler/x86/nx86add.pas
View File

@ -52,7 +52,6 @@ unit nx86add;
procedure second_cmp64bit;override;
procedure second_cmpordinal;override;
{$ifdef SUPPORT_MMX}
procedure second_opmmxset;override;
procedure second_opmmx;override;
{$endif SUPPORT_MMX}
procedure second_opvector;override;
@ -656,85 +655,6 @@ unit nx86add;
{$endif SUPPORT_MMX}
{*****************************************************************************
addmmxset
*****************************************************************************}
{$ifdef SUPPORT_MMX}
procedure tx86addnode.second_opmmxset;
var opsize : TCGSize;
op : TAsmOp;
cmpop,
noswap : boolean;
begin
pass_left_right;
cmpop:=false;
noswap:=false;
opsize:=OS_32;
case nodetype of
addn:
begin
{ are we adding set elements ? }
if right.nodetype=setelementn then
begin
{ adding elements is not commutative }
{ if nf_swapped in flags then
swapleftright;}
{ bts requires both elements to be registers }
{ location_force_reg(current_asmdata.CurrAsmList,left.location,opsize_2_cgsize[opsize],false);
location_force_reg(current_asmdata.CurrAsmList,right.location,opsize_2_cgsize[opsize],true);
op:=A_BTS;
noswap:=true;}
end
else
op:=A_POR;
end;
symdifn :
op:=A_PXOR;
muln:
op:=A_PAND;
subn:
op:=A_PANDN;
equaln,
unequaln :
begin
op:=A_PCMPEQD;
cmpop:=true;
end;
lten,gten:
begin
if (not(nf_swapped in flags) and (nodetype = lten)) or
((nf_swapped in flags) and (nodetype = gten)) then
swapleftright;
location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
emit_op_right_left(A_AND,opsize);
op:=A_PCMPEQD;
cmpop:=true;
{ warning: ugly hack, we need a JE so change the node to equaln }
nodetype:=equaln;
end;
xorn :
op:=A_PXOR;
orn :
op:=A_POR;
andn :
op:=A_PAND;
else
internalerror(2003042215);
end;
{ left must be a register }
left_must_be_reg(opsize,noswap);
{ emit_generic_code(op,opsize,true,extra_not,false);}
location_freetemp(current_asmdata.CurrAsmList,right.location);
if cmpop then
location_freetemp(current_asmdata.CurrAsmList,left.location);
end;
{$endif SUPPORT_MMX}
{*****************************************************************************
AddFloat
*****************************************************************************}

2
compiler/x86/nx86inl.pas
View File

@ -466,7 +466,7 @@ implementation
opsize,
orgsize: tcgsize;
begin
if not(is_varset(tcallparanode(left).resultdef)) then
if is_smallset(tcallparanode(left).resultdef) then
opsize:=int_cgsize(tcallparanode(left).resultdef.size)
else
opsize:=OS_32;

3
compiler/x86/nx86set.pas
View File

@ -155,7 +155,8 @@ implementation
{ check if we can use smallset operation using btl which is limited
to 32 bits, the left side may also not contain higher values or be signed !! }
use_small:=(tsetdef(right.resultdef).settype=smallset) and not is_signed(left.resultdef) and
use_small:=is_smallset(right.resultdef) and
not is_signed(left.resultdef) and
((left.resultdef.typ=orddef) and (torddef(left.resultdef).high.svalue<32) or
(left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32));

2
compiler/x86_64/cpupara.pas
View File

@ -310,7 +310,7 @@ unit cpupara;
result:=not structure_in_registers(varspez,def.size);
end;
setdef :
result:=(tsetdef(def).settype<>smallset);
result:=not is_smallset(def);
end;
end;