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

* let all the case code generation work with tconstexprint instead of aint,

Browse Source 
so it also works for 32 bit targets and a high level code generator
    (where aint is still 32 bit, but 64 bit operations are not decomposed)

git-svn-id: trunk@41441 -
(cherry picked from commit 07bd4ba517)

With local change to fix compilation for x86_64 CPU
This commit is contained in:
Jonas Maebe 2019-02-24 19:58:37 +00:00 committed by Pierre Muller
parent d7dcda75b9
commit 197f5cbec5
10 changed files with 99 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/aarch64/ncpuset.pas
View File

@ -31,9 +31,9 @@ interface
type type
taarch64casenode = class(tcgcasenode) taarch64casenode = class(tcgcasenode)
protected protected
procedure optimizevalues(var max_linear_list: aint; var max_dist: aword);override; procedure optimizevalues(var max_linear_list: int64; var max_dist: qword);override;
function has_jumptable: boolean;override; function has_jumptable: boolean;override;
procedure genjumptable(hp: pcaselabel ;min_, max_: aint);override; procedure genjumptable(hp: pcaselabel ;min_, max_: int64);override;
end; end;
@ -56,7 +56,7 @@ implementation
*****************************************************************************} *****************************************************************************}
procedure taarch64casenode.optimizevalues(var max_linear_list: aint; var max_dist: aword); procedure taarch64casenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
begin begin
max_linear_list:=10; max_linear_list:=10;
end; end;
@ -68,7 +68,7 @@ implementation
end; end;
procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: aint); procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: int64);
var var
last: TConstExprInt; last: TConstExprInt;
tablelabel: TAsmLabel; tablelabel: TAsmLabel;
@ -80,7 +80,7 @@ implementation
procedure genitem(list:TAsmList;t : pcaselabel); procedure genitem(list:TAsmList;t : pcaselabel);
var var
i : aint; i : int64;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(list,t^.less); genitem(list,t^.less);

40
compiler/arm/narmset.pas
View File

@ -41,9 +41,9 @@ interface
end; end;
tarmcasenode = class(tcgcasenode) tarmcasenode = class(tcgcasenode)
procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
function has_jumptable : boolean;override; function has_jumptable : boolean;override;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
procedure genlinearlist(hp : pcaselabel);override; procedure genlinearlist(hp : pcaselabel);override;
procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override; procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
end; end;
@ -136,7 +136,7 @@ implementation
TARMCASENODE TARMCASENODE
*****************************************************************************} *****************************************************************************}
procedure tarmcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); procedure tarmcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
begin begin
inc(max_linear_list,2) inc(max_linear_list,2)
end; end;
@ -148,7 +148,7 @@ implementation
end; end;
procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
var var
last : TConstExprInt; last : TConstExprInt;
tmpreg, tmpreg,
@ -161,22 +161,30 @@ implementation
procedure genitem(list:TAsmList;t : pcaselabel); procedure genitem(list:TAsmList;t : pcaselabel);
var var
i : aint; i : int64;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(list,t^.less); genitem(list,t^.less);
{ fill possible hole } { fill possible hole }
for i:=last.svalue+1 to t^._low.svalue-1 do i:=last+1;
if cs_create_pic in current_settings.moduleswitches then while i<=t^._low-1 do
list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset)) begin
else if cs_create_pic in current_settings.moduleswitches then
list.concat(Tai_const.Create_sym(elselabel)); list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
for i:=t^._low.svalue to t^._high.svalue do else
if cs_create_pic in current_settings.moduleswitches then list.concat(Tai_const.Create_sym(elselabel));
list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset)) i:=i+1;
else end;
list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); i:=t^._low;
last:=t^._high.svalue; while i<=t^._high do
begin
if cs_create_pic in current_settings.moduleswitches then
list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
else
list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
i:=i+1;
end;
last:=t^._high;
if assigned(t^.greater) then if assigned(t^.greater) then
genitem(list,t^.greater); genitem(list,t^.greater);
end; end;

BIN
compiler/gppcarm Executable file
View File

Binary file not shown.

4
compiler/i386/n386set.pas
View File

@ -31,7 +31,7 @@ interface
type type
ti386casenode = class(tx86casenode) ti386casenode = class(tx86casenode)
procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
end; end;
@ -44,7 +44,7 @@ implementation
TI386CASENODE TI386CASENODE
*****************************************************************************} *****************************************************************************}
procedure ti386casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); procedure ti386casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
begin begin
{ a jump table crashes the pipeline! } { a jump table crashes the pipeline! }
if current_settings.optimizecputype=cpu_386 then if current_settings.optimizecputype=cpu_386 then

26
compiler/mips/ncpuset.pas
View File

@ -33,9 +33,9 @@ uses
type type
tcpucasenode = class(tcgcasenode) tcpucasenode = class(tcgcasenode)
protected protected
procedure optimizevalues(var max_linear_list: aint; var max_dist: aword); override; procedure optimizevalues(var max_linear_list: int64; var max_dist: qword); override;
function has_jumptable: boolean; override; function has_jumptable: boolean; override;
procedure genjumptable(hp: pcaselabel; min_, max_: aint); override; procedure genjumptable(hp: pcaselabel; min_, max_: int64); override;
end; end;
@ -50,7 +50,7 @@ uses
cgbase, cgutils, cgobj, cgbase, cgutils, cgobj,
defutil,procinfo; defutil,procinfo;
procedure tcpucasenode.optimizevalues(var max_linear_list: aint; var max_dist: aword); procedure tcpucasenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
begin begin
{ give the jump table a higher priority } { give the jump table a higher priority }
max_dist := (max_dist * 3) div 2; max_dist := (max_dist * 3) div 2;
@ -63,7 +63,7 @@ begin
end; end;
procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: aint); procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: int64);
var var
table: tasmlabel; table: tasmlabel;
last: TConstExprInt; last: TConstExprInt;
@ -75,15 +75,23 @@ var
procedure genitem(t: pcaselabel); procedure genitem(t: pcaselabel);
var var
i: aint; i: TConstExprInt;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(t^.less); genitem(t^.less);
{ fill possible hole } { fill possible hole }
for i := last.svalue+1 to t^._low.svalue-1 do i:=last+1;
jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel)); while i<=t^._low-1 do
for i := t^._low.svalue to t^._high.svalue do begin
jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid))); jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
i:=i+1;
end;
i:= t^._low;
while i<=t^._high do
begin
jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
i:=i+1;
end;
last := t^._high; last := t^._high;
if assigned(t^.greater) then if assigned(t^.greater) then
genitem(t^.greater); genitem(t^.greater);

19
compiler/ncgset.pas
View File

@ -75,9 +75,9 @@ interface
min_label : tconstexprint; min_label : tconstexprint;
function blocklabel(id:longint):tasmlabel; function blocklabel(id:longint):tasmlabel;
procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual; procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);virtual;
function has_jumptable : boolean;virtual; function has_jumptable : boolean;virtual;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint); virtual; procedure genjumptable(hp : pcaselabel;min_,max_ : int64); virtual;
procedure genlinearlist(hp : pcaselabel); virtual; procedure genlinearlist(hp : pcaselabel); virtual;
procedure genlinearcmplist(hp : pcaselabel); virtual; procedure genlinearcmplist(hp : pcaselabel); virtual;
@ -532,7 +532,7 @@ implementation
end; end;
procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); procedure tcgcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
begin begin
{ no changes by default } { no changes by default }
end; end;
@ -545,7 +545,7 @@ implementation
end; end;
procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
begin begin
internalerror(200209161); internalerror(200209161);
end; end;
@ -728,7 +728,7 @@ implementation
else else
{$endif} {$endif}
begin begin
hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, aint(t^._low.svalue),hregister, blocklabel(t^.blockid)); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(t^._low),hregister, blocklabel(t^.blockid));
end; end;
{ Reset last here, because we've only checked for one value and need to compare { Reset last here, because we've only checked for one value and need to compare
for the next range both the lower and upper bound } for the next range both the lower and upper bound }
@ -833,7 +833,7 @@ implementation
else else
{$endif} {$endif}
begin begin
hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(t^._low.svalue), hregister, hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, tcgint(t^._low), hregister,
elselabel); elselabel);
end; end;
end; end;
@ -923,7 +923,7 @@ implementation
else else
{$endif} {$endif}
begin begin
hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, aint(t^._high.svalue), hregister, blocklabel(t^.blockid)); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, tcgint(t^._high.svalue), hregister, blocklabel(t^.blockid));
end; end;
last:=t^._high; last:=t^._high;
@ -1050,8 +1050,9 @@ implementation
lv,hv, lv,hv,
max_label: tconstexprint; max_label: tconstexprint;
labelcnt : tcgint; labelcnt : tcgint;
max_linear_list : aint; max_linear_list : int64;
max_dist : aword; max_dist : qword;
ShortcutElse: Boolean;
begin begin
location_reset(location,LOC_VOID,OS_NO); location_reset(location,LOC_VOID,OS_NO);

8
compiler/ppcgen/ngppcset.pas
View File

@ -31,9 +31,9 @@ interface
type type
tgppccasenode = class(tcgcasenode) tgppccasenode = class(tcgcasenode)
protected protected
procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override; procedure optimizevalues(var max_linear_list : int64; var max_dist : qword);override;
function has_jumptable : boolean;override; function has_jumptable : boolean;override;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
procedure genlinearlist(hp : pcaselabel); override; procedure genlinearlist(hp : pcaselabel); override;
end; end;
@ -57,7 +57,7 @@ implementation
*****************************************************************************} *****************************************************************************}
procedure tgppccasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword); procedure tgppccasenode.optimizevalues(var max_linear_list : int64; var max_dist : qword);
begin begin
max_linear_list := 10; max_linear_list := 10;
end; end;
@ -69,7 +69,7 @@ implementation
end; end;
procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
var var
table : tasmlabel; table : tasmlabel;
last : TConstExprInt; last : TConstExprInt;

22
compiler/sparcgen/ncpuset.pas
View File

@ -34,9 +34,9 @@ unit ncpuset;
type type
tcpucasenode = class(tcgcasenode) tcpucasenode = class(tcgcasenode)
protected protected
procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
function has_jumptable : boolean;override; function has_jumptable : boolean;override;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
end; end;
@ -50,7 +50,7 @@ unit ncpuset;
cgbase,cgutils,cgobj, cgbase,cgutils,cgobj,
defutil,procinfo; defutil,procinfo;
procedure tcpucasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); procedure tcpucasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
begin begin
{ give the jump table a higher priority } { give the jump table a higher priority }
max_dist:=(max_dist*3) div 2; max_dist:=(max_dist*3) div 2;
@ -63,7 +63,7 @@ unit ncpuset;
end; end;
procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
var var
base, base,
table : tasmlabel; table : tasmlabel;
@ -74,22 +74,22 @@ unit ncpuset;
procedure genitem(list:TAsmList;t : pcaselabel); procedure genitem(list:TAsmList;t : pcaselabel);
var var
i : aint; i : TConstExprInt;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(list,t^.less); genitem(list,t^.less);
{ fill possible hole } { fill possible hole }
i:=last.svalue+1; i:=last+1;
while i<=t^._low.svalue-1 do while i<=t^._low-1 do
begin begin
list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,elselabel)); list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,elselabel));
inc(i); i:=i+1;
end; end;
i:=t^._low.svalue; i:=t^._low;
while i<=t^._high.svalue do while i<=t^._high do
begin begin
list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,blocklabel(t^.blockid))); list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,blocklabel(t^.blockid)));
inc(i); i:=i+1;
end; end;
last:=t^._high; last:=t^._high;
if assigned(t^.greater) then if assigned(t^.greater) then

24
compiler/x86/nx86set.pas
View File

@ -37,7 +37,7 @@ interface
tx86casenode = class(tcgcasenode) tx86casenode = class(tcgcasenode)
function has_jumptable : boolean;override; function has_jumptable : boolean;override;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
procedure genlinearlist(hp : pcaselabel);override; procedure genlinearlist(hp : pcaselabel);override;
procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override; procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
end; end;
@ -66,7 +66,7 @@ implementation
end; end;
procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : aint); procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
var var
table : tasmlabel; table : tasmlabel;
last : TConstExprInt; last : TConstExprInt;
@ -76,25 +76,31 @@ implementation
opcgsize: tcgsize; opcgsize: tcgsize;
jumpreg: tregister; jumpreg: tregister;
labeltyp: taiconst_type; labeltyp: taiconst_type;
AlmostExhaustive: Boolean;
lv, hv: TConstExprInt;
ExhaustiveLimit, Range, x, oldmin : int64;
const
ExhaustiveLimitBase = 32;
procedure genitem(list:TAsmList;t : pcaselabel); procedure genitem(list:TAsmList;t : pcaselabel);
var var
i : aint; i : TConstExprInt;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(list,t^.less); genitem(list,t^.less);
{ fill possible hole } { fill possible hole }
i:=last.svalue+1; i:=last+1;
while i<=t^._low.svalue-1 do while i<=t^._low-1 do
begin begin
list.concat(Tai_const.Create_type_sym(labeltyp,elselabel)); list.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
inc(i); i:=i+1;
end; end;
i:=t^._low.svalue; i:=t^._low;
while i<=t^._high.svalue do while i<=t^._high do
begin begin
list.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid))); list.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
inc(i); i:=i+1;
end; end;
last:=t^._high; last:=t^._high;
if assigned(t^.greater) then if assigned(t^.greater) then

22
compiler/x86_64/nx64set.pas
View File

@ -31,8 +31,8 @@ interface
type type
tx8664casenode = class(tx86casenode) tx8664casenode = class(tx86casenode)
procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
end; end;
@ -52,7 +52,7 @@ implementation
TX8664CASENODE TX8664CASENODE
*****************************************************************************} *****************************************************************************}
procedure tx8664casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); procedure tx8664casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
begin begin
inc(max_linear_list,9); inc(max_linear_list,9);
end; end;
@ -60,7 +60,7 @@ implementation
{ Always generate position-independent jump table, it is twice less in size at a price { Always generate position-independent jump table, it is twice less in size at a price
of two extra instructions (which shouldn't cause more slowdown than pipeline trashing) } of two extra instructions (which shouldn't cause more slowdown than pipeline trashing) }
procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : aint); procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : int64);
var var
last: TConstExprInt; last: TConstExprInt;
tablelabel: TAsmLabel; tablelabel: TAsmLabel;
@ -72,22 +72,22 @@ implementation
procedure genitem(list:TAsmList;t : pcaselabel); procedure genitem(list:TAsmList;t : pcaselabel);
var var
i : aint; i : TConstExprInt;
begin begin
if assigned(t^.less) then if assigned(t^.less) then
genitem(list,t^.less); genitem(list,t^.less);
{ fill possible hole } { fill possible hole }
i:=last.svalue+1; i:=last+1;
while i<=t^._low.svalue-1 do while i<=t^._low-1 do
begin begin
list.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,elselabel)); list.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,elselabel));
inc(i); i:=i+1;
end; end;
i:=t^._low.svalue; i:=t^._low;
while i<=t^._high.svalue do while i<=t^._high do
begin begin
list.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,blocklabel(t^.blockid))); list.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,blocklabel(t^.blockid)));
inc(i); i:=i+1;
end; end;
last:=t^._high; last:=t^._high;
if assigned(t^.greater) then if assigned(t^.greater) then