summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/arm/cpupara.pas2
-rw-r--r--compiler/avr/cpupara.pas2
-rw-r--r--compiler/browcol.pas9
-rw-r--r--compiler/defutil.pas15
-rw-r--r--compiler/i386/cpupara.pas2
-rw-r--r--compiler/m68k/cpupara.pas6
-rw-r--r--compiler/nadd.pas292
-rw-r--r--compiler/ncgadd.pas155
-rw-r--r--compiler/ncgcon.pas255
-rw-r--r--compiler/ncgset.pas3
-rw-r--r--compiler/ncnv.pas39
-rw-r--r--compiler/ncon.pas2
-rw-r--r--compiler/paramgr.pas2
-rw-r--r--compiler/pdecvar.pas10
-rw-r--r--compiler/powerpc/cpupara.pas2
-rw-r--r--compiler/powerpc/nppcadd.pas2
-rw-r--r--compiler/powerpc64/cpupara.pas18
-rw-r--r--compiler/powerpc64/nppcadd.pas8
-rw-r--r--compiler/ppcgen/ngppcadd.pas6
-rw-r--r--compiler/sparc/cpupara.pas2
-rw-r--r--compiler/symconst.pas5
-rw-r--r--compiler/symdef.pas26
-rw-r--r--compiler/utils/ppudump.pp18
-rw-r--r--compiler/x86/nx86add.pas80
-rw-r--r--compiler/x86/nx86inl.pas2
-rw-r--r--compiler/x86/nx86set.pas3
-rw-r--r--compiler/x86_64/cpupara.pas2
27 files changed, 372 insertions, 596 deletions
diff --git a/compiler/arm/cpupara.pas b/compiler/arm/cpupara.pas
index 2c5cf4ddfb..a9f78a3bac 100644
--- a/compiler/arm/cpupara.pas
+++ b/compiler/arm/cpupara.pas
@@ -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;
diff --git a/compiler/avr/cpupara.pas b/compiler/avr/cpupara.pas
index be965e484b..b56fc79db0 100644
--- a/compiler/avr/cpupara.pas
+++ b/compiler/avr/cpupara.pas
@@ -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;
diff --git a/compiler/browcol.pas b/compiler/browcol.pas
index 1f9da9cf7a..29c86aaf07 100644
--- a/compiler/browcol.pas
+++ b/compiler/browcol.pas
@@ -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;
diff --git a/compiler/defutil.pas b/compiler/defutil.pas
index 3654b4130e..cd3204bb52 100644
--- a/compiler/defutil.pas
+++ b/compiler/defutil.pas
@@ -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;
diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas
index 0012795b77..05b64bdc56 100644
--- a/compiler/i386/cpupara.pas
+++ b/compiler/i386/cpupara.pas
@@ -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;
diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas
index ec7279b7b2..7c11532d80 100644
--- a/compiler/m68k/cpupara.pas
+++ b/compiler/m68k/cpupara.pas
@@ -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
diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index 393fffa350..36b1f0fb68 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -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
+ 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
- { optimize first loading of a set }
- if (right.nodetype=setelementn) and
- not(assigned(tsetelementnode(right).right)) and
- is_emptyset(left) then
+ 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 }
diff --git a/compiler/ncgadd.pas b/compiler/ncgadd.pas
index 662df0f851..7387165082 100644
--- a/compiler/ncgadd.pas
+++ b/compiler/ncgadd.pas
@@ -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
diff --git a/compiler/ncgcon.pas b/compiler/ncgcon.pas
index 9ba0d85fbf..afaa194d26 100644
--- a/compiler/ncgcon.pas
+++ b/compiler/ncgcon.pas
@@ -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;
- 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
+ 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)^)
+ { 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);
+ 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
+ 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
+ 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
+ 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
+ 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]))
+ 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])))
+ 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;
+ 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 is_smallset(resultdef) then
+ smallsetconst
+ else
+ varsetconst;
end;
diff --git a/compiler/ncgset.pas b/compiler/ncgset.pas
index c65b7d57b6..568c9c1bf3 100644
--- a/compiler/ncgset.pas
+++ b/compiler/ncgset.pas
@@ -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));
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index be6f1a2bff..e80c39865b 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -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;
diff --git a/compiler/ncon.pas b/compiler/ncon.pas
index b6cab9f29f..7cf06ee3b7 100644
--- a/compiler/ncon.pas
+++ b/compiler/ncon.pas
@@ -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;
diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas
index 64668e5442..3438fb4f27 100644
--- a/compiler/paramgr.pas
+++ b/compiler/paramgr.pas
@@ -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;
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 27b3f20545..719d2268ac 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -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);
diff --git a/compiler/powerpc/cpupara.pas b/compiler/powerpc/cpupara.pas
index 816d53569e..03a00a2b71 100644
--- a/compiler/powerpc/cpupara.pas
+++ b/compiler/powerpc/cpupara.pas
@@ -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;
diff --git a/compiler/powerpc/nppcadd.pas b/compiler/powerpc/nppcadd.pas
index da500db3c4..ba3bd60f39 100644
--- a/compiler/powerpc/nppcadd.pas
+++ b/compiler/powerpc/nppcadd.pas
@@ -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;
diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas
index 79deeca529..0a368aebad 100644
--- a/compiler/powerpc64/cpupara.pas
+++ b/compiler/powerpc64/cpupara.pas
@@ -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;
diff --git a/compiler/powerpc64/nppcadd.pas b/compiler/powerpc64/nppcadd.pas
index 8024501379..57d2a6ad7a 100644
--- a/compiler/powerpc64/nppcadd.pas
+++ b/compiler/powerpc64/nppcadd.pas
@@ -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);
diff --git a/compiler/ppcgen/ngppcadd.pas b/compiler/ppcgen/ngppcadd.pas
index 1f5e13164f..6d1dfca012 100644
--- a/compiler/ppcgen/ngppcadd.pas
+++ b/compiler/ppcgen/ngppcadd.pas
@@ -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;
diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas
index a1c82176ae..89e3520dbc 100644
--- a/compiler/sparc/cpupara.pas
+++ b/compiler/sparc/cpupara.pas
@@ -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;
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index 11f822b2d8..f807fc6434 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -191,11 +191,6 @@ type
st_unicodestring
);
- { set types }
- tsettype = (
- normset,smallset,varset
- );
-
tvarianttype = (
vt_normalvariant,vt_olevariant
);
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 8c4cb0d538..997e628a6d 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -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);
diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp
index 2b5f8bffc5..b87f48a82a 100644
--- a/compiler/utils/ppudump.pp
+++ b/compiler/utils/ppudump.pp
@@ -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 :
diff --git a/compiler/x86/nx86add.pas b/compiler/x86/nx86add.pas
index 56781b834e..d0d6a63bb4 100644
--- a/compiler/x86/nx86add.pas
+++ b/compiler/x86/nx86add.pas
@@ -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;
@@ -657,85 +656,6 @@ unit nx86add;
{*****************************************************************************
- 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
*****************************************************************************}
diff --git a/compiler/x86/nx86inl.pas b/compiler/x86/nx86inl.pas
index 48e705ef43..4ac4cdcaa6 100644
--- a/compiler/x86/nx86inl.pas
+++ b/compiler/x86/nx86inl.pas
@@ -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;
diff --git a/compiler/x86/nx86set.pas b/compiler/x86/nx86set.pas
index fe8ddd5398..c5539bbcde 100644
--- a/compiler/x86/nx86set.pas
+++ b/compiler/x86/nx86set.pas
@@ -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));
diff --git a/compiler/x86_64/cpupara.pas b/compiler/x86_64/cpupara.pas
index 0de1691a9b..c5d88c6b3d 100644
--- a/compiler/x86_64/cpupara.pas
+++ b/compiler/x86_64/cpupara.pas
@@ -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;
View Lorry Controller Status