mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 18:41:31 +02:00
7f5c2fa3aa
This patch improves the compiler where "case" statements are concerned, using jump tables more often and creating more efficient machine code in some situations:
* If a case block only contains one branch (not including the else block), the initial range check is removed, since this becomes wasted effort.
* If the else block is empty, the else label is set to the end label - though this doesn't decrease the code size, it takes a bit of strain off the peephole optimizer.
* On -O2 and above, some node analysis is now done on the branch labels. Most of the time this just redirects it to the end
label for empty blocks, but if the block contains a goto statement, it will redirect it to its destination instead,
thus increasing performance by not having multiple jumps (this won't get picked up by the peephole optimiser if the label addresses are in a jump table).
* Some checks now use what I call the 'true count' rather than the 'label count'. The true count includes each
individual value in a range - for example, 0..2 counts as 3. This increases the chance that a jump table will be
utilised in situations where it is more efficient than a linear list.
* For jump tables, if the case block almost covers the entire range (32 entries or fewer from full coverage),
the initial range check is removed and the gaps included in the jump table (pointing to the else label).
git-svn-id: trunk@40676 -
1165 lines
36 KiB
ObjectPascal
1165 lines
36 KiB
ObjectPascal
{
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
Type checking and register allocation for set/case nodes
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit nset;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cclasses,constexp,
|
|
node,globtype,globals,
|
|
aasmbase,ncon,nflw,symtype;
|
|
|
|
type
|
|
TLabelType = (ltOrdinal, ltConstString);
|
|
|
|
pcaselabel = ^tcaselabel;
|
|
tcaselabel = record
|
|
{ unique blockid }
|
|
blockid : longint;
|
|
{ left and right tree node }
|
|
less,
|
|
greater : pcaselabel;
|
|
|
|
labellabel : TAsmLabel;
|
|
|
|
{ range type }
|
|
case label_type : TLabelType of
|
|
ltOrdinal:
|
|
(
|
|
_low,
|
|
_high : TConstExprInt;
|
|
);
|
|
ltConstString:
|
|
(
|
|
_low_str,
|
|
_high_str : tstringconstnode;
|
|
);
|
|
end;
|
|
|
|
pcaseblock = ^tcaseblock;
|
|
tcaseblock = record
|
|
{ label (only used in pass_generate_code) }
|
|
blocklabel : tasmlabel;
|
|
|
|
{ shortcut - set to true if blocklabel isn't actually unique to the
|
|
case block due to one of the following conditions:
|
|
- if the node contains a jump, then the label is set to that jump's destination,
|
|
- if the node is empty, the label is set to the end label. }
|
|
shortcut: Boolean;
|
|
|
|
statementlabel : tlabelnode;
|
|
{ instructions }
|
|
statement : tnode;
|
|
end;
|
|
|
|
tsetelementnode = class(tbinarynode)
|
|
constructor create(l,r : tnode);virtual;
|
|
function pass_typecheck:tnode;override;
|
|
function pass_1 : tnode;override;
|
|
end;
|
|
tsetelementnodeclass = class of tsetelementnode;
|
|
|
|
tinnode = class(tbinopnode)
|
|
constructor create(l,r : tnode);virtual;reintroduce;
|
|
function pass_typecheck:tnode;override;
|
|
function simplify(forinline : boolean):tnode;override;
|
|
function pass_1 : tnode;override;
|
|
end;
|
|
tinnodeclass = class of tinnode;
|
|
|
|
trangenode = class(tbinarynode)
|
|
constructor create(l,r : tnode);virtual;
|
|
function pass_typecheck:tnode;override;
|
|
function pass_1 : tnode;override;
|
|
end;
|
|
trangenodeclass = class of trangenode;
|
|
|
|
tcasenode = class(tunarynode)
|
|
labels : pcaselabel;
|
|
blocks : TFPList;
|
|
elseblock : tnode;
|
|
constructor create(l:tnode);virtual;
|
|
destructor destroy;override;
|
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure buildderefimpl;override;
|
|
procedure derefimpl;override;
|
|
function dogetcopy : tnode;override;
|
|
procedure printnodetree(var t:text);override;
|
|
procedure insertintolist(l : tnodelist);override;
|
|
function pass_typecheck:tnode;override;
|
|
function pass_1 : tnode;override;
|
|
function simplify(forinline:boolean):tnode;override;
|
|
function docompare(p: tnode): boolean; override;
|
|
procedure addlabel(blockid:longint;const l,h : TConstExprInt); overload;
|
|
procedure addlabel(blockid:longint;l,h : tstringconstnode); overload;
|
|
procedure addblock(blockid:longint;instr:tnode);
|
|
procedure addelseblock(instr:tnode);
|
|
end;
|
|
tcasenodeclass = class of tcasenode;
|
|
|
|
var
|
|
csetelementnode : tsetelementnodeclass = tsetelementnode;
|
|
cinnode : tinnodeclass = tinnode;
|
|
crangenode : trangenodeclass = trangenode;
|
|
ccasenode : tcasenodeclass = tcasenode;
|
|
|
|
{ counts the labels }
|
|
function case_count_labels(root : pcaselabel) : longint;
|
|
{ Returns the true count in a case block, which includes each individual
|
|
value in a range (e.g. "0..2" counts as 3) }
|
|
function case_true_count(root : pcaselabel) : longint;
|
|
{ searches the highest label }
|
|
function case_get_max(root : pcaselabel) : tconstexprint;
|
|
{ searches the lowest label }
|
|
function case_get_min(root : pcaselabel) : tconstexprint;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,
|
|
symconst,symdef,symsym,symtable,defutil,defcmp,
|
|
htypechk,pass_1,
|
|
nadd,nbas,ncnv,nld,cgbase;
|
|
|
|
|
|
{*****************************************************************************
|
|
TSETELEMENTNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tsetelementnode.create(l,r : tnode);
|
|
|
|
begin
|
|
inherited create(setelementn,l,r);
|
|
end;
|
|
|
|
|
|
function tsetelementnode.pass_typecheck:tnode;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
if assigned(right) then
|
|
typecheckpass(right);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
|
|
|
|
function tsetelementnode.pass_1 : tnode;
|
|
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if assigned(right) then
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
expectloc:=left.expectloc;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TINNODE
|
|
*****************************************************************************}
|
|
|
|
constructor tinnode.create(l,r : tnode);
|
|
begin
|
|
inherited create(inn,l,r);
|
|
end;
|
|
|
|
|
|
function tinnode.pass_typecheck:tnode;
|
|
|
|
var
|
|
t : tnode;
|
|
|
|
function createsetconst(psd : tsetdef) : pconstset;
|
|
var
|
|
pcs : pconstset;
|
|
i : longint;
|
|
begin
|
|
new(pcs);
|
|
case psd.elementdef.typ of
|
|
enumdef :
|
|
begin
|
|
for i := 0 to tenumdef(psd.elementdef).symtable.SymList.Count - 1 do
|
|
begin
|
|
include(pcs^,tenumsym(tenumdef(psd.elementdef).symtable.SymList[i]).value);
|
|
end;
|
|
end;
|
|
orddef :
|
|
begin
|
|
for i:=int64(torddef(psd.elementdef).low) to int64(torddef(psd.elementdef).high) do
|
|
include(pcs^,i);
|
|
end;
|
|
end;
|
|
createsetconst:=pcs;
|
|
end;
|
|
|
|
begin
|
|
result:=nil;
|
|
resultdef:=pasbool1type;
|
|
typecheckpass(right);
|
|
set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ Convert array constructor first to set }
|
|
if is_array_constructor(right.resultdef) then
|
|
begin
|
|
arrayconstructor_to_set(right);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
end;
|
|
|
|
typecheckpass(left);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
if not assigned(left.resultdef) then
|
|
internalerror(20021126);
|
|
|
|
t:=self;
|
|
if isbinaryoverloaded(t,[]) then
|
|
begin
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
if right.resultdef.typ<>setdef then
|
|
CGMessage(sym_e_set_expected);
|
|
|
|
if codegenerror then
|
|
exit;
|
|
|
|
if (m_tp7 in current_settings.modeswitches) then
|
|
begin
|
|
{ insert a hint that a range check error might occur on non-byte
|
|
elements with the in operator.
|
|
}
|
|
if (
|
|
(left.resultdef.typ = orddef) and not
|
|
(torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool1,pasbool8,bool8bit])
|
|
)
|
|
or
|
|
(
|
|
(left.resultdef.typ = enumdef) and
|
|
(tenumdef(left.resultdef).maxval > 255)
|
|
)
|
|
then
|
|
CGMessage(type_h_in_range_check);
|
|
|
|
{ type conversion/check }
|
|
if assigned(tsetdef(right.resultdef).elementdef) then
|
|
inserttypeconv(left,tsetdef(right.resultdef).elementdef);
|
|
end
|
|
else if not is_ordinal(left.resultdef) or (left.resultdef.size > u32inttype.size) then
|
|
begin
|
|
CGMessage(type_h_in_range_check);
|
|
if is_signed(left.resultdef) then
|
|
inserttypeconv(left,s32inttype)
|
|
else
|
|
inserttypeconv(left,u32inttype);
|
|
end
|
|
else if assigned(tsetdef(right.resultdef).elementdef) and
|
|
not(is_integer(tsetdef(right.resultdef).elementdef) and
|
|
is_integer(left.resultdef)) then
|
|
{ Type conversion to check things like 'char in set_of_byte'. }
|
|
{ Can't use is_subequal because that will fail for }
|
|
{ 'widechar in set_of_char' }
|
|
{ Can't use the type conversion for integers because then }
|
|
{ "longint in set_of_byte" will give a range check error }
|
|
{ instead of false }
|
|
inserttypeconv(left,tsetdef(right.resultdef).elementdef);
|
|
|
|
{ empty set then return false }
|
|
if not assigned(tsetdef(right.resultdef).elementdef) or
|
|
((right.nodetype = setconstn) and
|
|
(tnormalset(tsetconstnode(right).value_set^) = [])) then
|
|
begin
|
|
t:=cordconstnode.create(0,pasbool1type,false);
|
|
typecheckpass(t);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
result:=simplify(false);
|
|
end;
|
|
|
|
|
|
function tinnode.simplify(forinline : boolean):tnode;
|
|
var
|
|
t : tnode;
|
|
begin
|
|
result:=nil;
|
|
{ constant evaluation }
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
if (right.nodetype=setconstn) then
|
|
begin
|
|
{ tordconstnode.value is int64 -> signed -> the expression }
|
|
{ below will be converted to longint on 32 bit systems due }
|
|
{ to the rule above -> will give range check error if }
|
|
{ value > high(longint) if we don't take the signedness }
|
|
{ into account }
|
|
if Tordconstnode(left).value.signed then
|
|
t:=cordconstnode.create(byte(tordconstnode(left).value.svalue in Tsetconstnode(right).value_set^),
|
|
pasbool1type,true)
|
|
else
|
|
t:=cordconstnode.create(byte(tordconstnode(left).value.uvalue in Tsetconstnode(right).value_set^),
|
|
pasbool1type,true);
|
|
typecheckpass(t);
|
|
result:=t;
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
if (Tordconstnode(left).value<int64(tsetdef(right.resultdef).setbase)) or
|
|
(Tordconstnode(left).value>int64(Tsetdef(right.resultdef).setmax)) then
|
|
begin
|
|
t:=cordconstnode.create(0, pasbool1type, true);
|
|
typecheckpass(t);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tinnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
expectloc:=LOC_REGISTER;
|
|
|
|
firstpass(right);
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TRANGENODE
|
|
*****************************************************************************}
|
|
|
|
constructor trangenode.create(l,r : tnode);
|
|
var
|
|
value: string;
|
|
|
|
begin
|
|
{ if right is char and left is string then }
|
|
{ right should be treated as one-symbol string }
|
|
if is_conststringnode(l) and is_constcharnode(r) then
|
|
begin
|
|
value := char(tordconstnode(r).value.uvalue) + ''#0;
|
|
r.free;
|
|
r := cstringconstnode.createstr(value);
|
|
do_typecheckpass(r);
|
|
end;
|
|
inherited create(rangen,l,r);
|
|
end;
|
|
|
|
|
|
function trangenode.pass_typecheck : tnode;
|
|
begin
|
|
result:=nil;
|
|
typecheckpass(left);
|
|
typecheckpass(right);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
{ both types must be compatible }
|
|
if compare_defs(left.resultdef,right.resultdef,left.nodetype)=te_incompatible then
|
|
IncompatibleTypes(left.resultdef,right.resultdef);
|
|
{ Check if only when its a constant set }
|
|
if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
|
|
begin
|
|
{ upper limit must be greater or equal than lower limit }
|
|
if (tordconstnode(left).value>tordconstnode(right).value) and
|
|
((tordconstnode(left).value<0) or (tordconstnode(right).value>=0)) then
|
|
CGMessage(parser_e_upper_lower_than_lower);
|
|
end;
|
|
resultdef:=left.resultdef;
|
|
end;
|
|
|
|
|
|
function trangenode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
expectloc:=left.expectloc;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Case Helpers
|
|
*****************************************************************************}
|
|
|
|
function case_count_labels(root : pcaselabel) : longint;
|
|
var
|
|
_l : longint;
|
|
|
|
procedure count(p : pcaselabel);
|
|
begin
|
|
inc(_l);
|
|
if assigned(p^.less) then
|
|
count(p^.less);
|
|
if assigned(p^.greater) then
|
|
count(p^.greater);
|
|
end;
|
|
|
|
begin
|
|
_l:=0;
|
|
count(root);
|
|
case_count_labels:=_l;
|
|
end;
|
|
|
|
|
|
{ Returns the true count in a case block, which includes each individual
|
|
value in a range (e.g. "0..2" counts as 3) }
|
|
function case_true_count(root : pcaselabel) : longint;
|
|
var
|
|
_l : longint;
|
|
|
|
procedure count(p : pcaselabel);
|
|
begin
|
|
inc(_l, (p^._high.svalue - p^._low.svalue) + 1);
|
|
if assigned(p^.less) then
|
|
count(p^.less);
|
|
if assigned(p^.greater) then
|
|
count(p^.greater);
|
|
end;
|
|
|
|
begin
|
|
_l:=0;
|
|
count(root);
|
|
case_true_count:=_l;
|
|
end;
|
|
|
|
|
|
|
|
function case_get_max(root : pcaselabel) : tconstexprint;
|
|
var
|
|
hp : pcaselabel;
|
|
begin
|
|
hp:=root;
|
|
while assigned(hp^.greater) do
|
|
hp:=hp^.greater;
|
|
case_get_max:=hp^._high;
|
|
end;
|
|
|
|
|
|
function case_get_min(root : pcaselabel) : tconstexprint;
|
|
var
|
|
hp : pcaselabel;
|
|
begin
|
|
hp:=root;
|
|
while assigned(hp^.less) do
|
|
hp:=hp^.less;
|
|
case_get_min:=hp^._low;
|
|
end;
|
|
|
|
procedure deletecaselabels(p : pcaselabel);
|
|
|
|
begin
|
|
if assigned(p^.greater) then
|
|
deletecaselabels(p^.greater);
|
|
if assigned(p^.less) then
|
|
deletecaselabels(p^.less);
|
|
if (p^.label_type = ltConstString) then
|
|
begin
|
|
p^._low_str.Free;
|
|
p^._high_str.Free;
|
|
end;
|
|
dispose(p);
|
|
end;
|
|
|
|
function copycaselabel(p : pcaselabel) : pcaselabel;
|
|
|
|
var
|
|
n : pcaselabel;
|
|
|
|
begin
|
|
new(n);
|
|
n^:=p^;
|
|
if (p^.label_type = ltConstString) then
|
|
begin
|
|
n^._low_str := tstringconstnode(p^._low_str.getcopy);
|
|
n^._high_str := tstringconstnode(p^._high_str.getcopy);
|
|
end;
|
|
if assigned(p^.greater) then
|
|
n^.greater:=copycaselabel(p^.greater);
|
|
if assigned(p^.less) then
|
|
n^.less:=copycaselabel(p^.less);
|
|
copycaselabel:=n;
|
|
end;
|
|
|
|
|
|
procedure ppuwritecaselabel(ppufile:tcompilerppufile;p : pcaselabel);
|
|
var
|
|
b : byte;
|
|
begin
|
|
ppufile.putboolean(p^.label_type = ltConstString);
|
|
if (p^.label_type = ltConstString) then
|
|
begin
|
|
p^._low_str.ppuwrite(ppufile);
|
|
p^._high_str.ppuwrite(ppufile);
|
|
end
|
|
else
|
|
begin
|
|
ppufile.putexprint(p^._low);
|
|
ppufile.putexprint(p^._high);
|
|
end;
|
|
|
|
ppufile.putlongint(p^.blockid);
|
|
b:=ord(assigned(p^.greater)) or (ord(assigned(p^.less)) shl 1);
|
|
ppufile.putbyte(b);
|
|
if assigned(p^.greater) then
|
|
ppuwritecaselabel(ppufile,p^.greater);
|
|
if assigned(p^.less) then
|
|
ppuwritecaselabel(ppufile,p^.less);
|
|
end;
|
|
|
|
|
|
function ppuloadcaselabel(ppufile:tcompilerppufile):pcaselabel;
|
|
var
|
|
b : byte;
|
|
p : pcaselabel;
|
|
begin
|
|
new(p);
|
|
if ppufile.getboolean then
|
|
begin
|
|
p^.label_type := ltConstString;
|
|
p^._low_str := cstringconstnode.ppuload(stringconstn,ppufile);
|
|
p^._high_str := cstringconstnode.ppuload(stringconstn,ppufile);
|
|
end
|
|
else
|
|
begin
|
|
p^.label_type := ltOrdinal;
|
|
|
|
p^._low:=ppufile.getexprint;
|
|
p^._high:=ppufile.getexprint;
|
|
end;
|
|
|
|
p^.blockid:=ppufile.getlongint;
|
|
b:=ppufile.getbyte;
|
|
if (b and 1)=1 then
|
|
p^.greater:=ppuloadcaselabel(ppufile)
|
|
else
|
|
p^.greater:=nil;
|
|
if (b and 2)=2 then
|
|
p^.less:=ppuloadcaselabel(ppufile)
|
|
else
|
|
p^.less:=nil;
|
|
ppuloadcaselabel:=p;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCASENODE
|
|
*****************************************************************************}
|
|
|
|
constructor tcasenode.create(l:tnode);
|
|
begin
|
|
inherited create(casen,l);
|
|
labels:=nil;
|
|
blocks:=TFPList.create;
|
|
elseblock:=nil;
|
|
end;
|
|
|
|
|
|
destructor tcasenode.destroy;
|
|
var
|
|
i : longint;
|
|
hp : pcaseblock;
|
|
begin
|
|
elseblock.free;
|
|
deletecaselabels(labels);
|
|
for i:=0 to blocks.count-1 do
|
|
begin
|
|
pcaseblock(blocks[i])^.statement.free;
|
|
hp:=pcaseblock(blocks[i]);
|
|
dispose(hp);
|
|
end;
|
|
blocks.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
constructor tcasenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
|
var
|
|
cnt,i : longint;
|
|
begin
|
|
inherited ppuload(t,ppufile);
|
|
elseblock:=ppuloadnode(ppufile);
|
|
cnt:=ppufile.getlongint();
|
|
blocks:=TFPList.create;
|
|
for i:=0 to cnt-1 do
|
|
addblock(i,ppuloadnode(ppufile));
|
|
labels:=ppuloadcaselabel(ppufile);
|
|
end;
|
|
|
|
|
|
procedure tcasenode.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
i : longint;
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
ppuwritenode(ppufile,elseblock);
|
|
ppufile.putlongint(blocks.count);
|
|
for i:=0 to blocks.count-1 do
|
|
ppuwritenode(ppufile,pcaseblock(blocks[i])^.statement);
|
|
ppuwritecaselabel(ppufile,labels);
|
|
end;
|
|
|
|
|
|
procedure tcasenode.buildderefimpl;
|
|
var
|
|
i : integer;
|
|
begin
|
|
inherited buildderefimpl;
|
|
if assigned(elseblock) then
|
|
elseblock.buildderefimpl;
|
|
for i:=0 to blocks.count-1 do
|
|
pcaseblock(blocks[i])^.statement.buildderefimpl;
|
|
end;
|
|
|
|
|
|
procedure tcasenode.derefimpl;
|
|
var
|
|
i : integer;
|
|
begin
|
|
inherited derefimpl;
|
|
if assigned(elseblock) then
|
|
elseblock.derefimpl;
|
|
for i:=0 to blocks.count-1 do
|
|
pcaseblock(blocks[i])^.statement.derefimpl;
|
|
end;
|
|
|
|
|
|
function tcasenode.pass_typecheck : tnode;
|
|
var
|
|
i : integer;
|
|
begin
|
|
result:=nil;
|
|
|
|
do_typecheckpass(left);
|
|
|
|
for i:=0 to blocks.count-1 do
|
|
typecheckpass(pcaseblock(blocks[i])^.statement);
|
|
|
|
if assigned(elseblock) then
|
|
typecheckpass(elseblock);
|
|
|
|
resultdef:=voidtype;
|
|
end;
|
|
|
|
|
|
type
|
|
TLinkedListCaseLabelItem = class(TLinkedListItem)
|
|
casenode: pcaselabel;
|
|
constructor create(c: pcaselabel);
|
|
end;
|
|
|
|
constructor TLinkedListCaseLabelItem.create(c: pcaselabel);
|
|
begin
|
|
inherited create;
|
|
casenode:=c;
|
|
end;
|
|
|
|
|
|
function tcasenode.pass_1 : tnode;
|
|
var
|
|
i: integer;
|
|
node_thenblock, node_elseblock, if_node,temp_cleanup : tnode;
|
|
tempcaseexpr : ttempcreatenode;
|
|
if_block, init_block: tblocknode;
|
|
stmt: tstatementnode;
|
|
|
|
procedure add_label_to_blockid_list(list: tfpobjectlist; lab: pcaselabel);
|
|
begin
|
|
if not assigned(lab) then
|
|
exit;
|
|
if not assigned(list[lab^.blockid]) then
|
|
list[lab^.blockid]:=tfpobjectlist.create(true);
|
|
tfpobjectlist(list[lab^.blockid]).add(TLinkedListCaseLabelItem.create(lab));
|
|
add_label_to_blockid_list(list,lab^.less);
|
|
add_label_to_blockid_list(list,lab^.greater);
|
|
end;
|
|
|
|
function order_labels_by_blockid: tfpobjectlist;
|
|
begin
|
|
result:=tfpobjectlist.create(true);
|
|
result.count:=blocks.count;
|
|
add_label_to_blockid_list(result,labels);
|
|
end;
|
|
|
|
function makeifblock(elseblock : tnode): tnode;
|
|
var
|
|
i, j: longint;
|
|
check: taddnode;
|
|
newcheck: ^taddnode;
|
|
blocklist, lablist: tfpobjectlist;
|
|
labitem: pcaselabel;
|
|
begin
|
|
result:=elseblock;
|
|
blocklist:=order_labels_by_blockid;
|
|
{ in reverse order so that the case options at the start of the case
|
|
statement are evaluated first, as they presumably are the most
|
|
common }
|
|
for i:=blocklist.count-1 downto 0 do
|
|
begin
|
|
lablist:=tfpobjectlist(blocklist[i]);
|
|
check:=nil;
|
|
for j:=0 to lablist.count-1 do
|
|
begin
|
|
if assigned(check) then
|
|
begin
|
|
check:=caddnode.create(orn,check,nil);
|
|
newcheck:=@check.right
|
|
end
|
|
else
|
|
newcheck:=@check;
|
|
labitem:=TLinkedListCaseLabelItem(lablist[j]).casenode;
|
|
newcheck^:=caddnode.create(equaln,left.getcopy,labitem^._low_str.getcopy);
|
|
if (labitem^._low_str.fullcompare(labitem^._high_str)<>0) then
|
|
begin
|
|
newcheck^.nodetype:=gten;
|
|
newcheck^:=caddnode.create(
|
|
andn,newcheck^,caddnode.create(
|
|
lten,left.getcopy,labitem^._high_str.getcopy));
|
|
end;
|
|
end;
|
|
result:=cifnode.create(check,
|
|
pcaseblock(blocks[i])^.statement,result);
|
|
pcaseblock(blocks[i])^.statement:=nil;
|
|
end;
|
|
{ will free its elements too because of create(true) }
|
|
blocklist.free;
|
|
typecheckpass(result);
|
|
end;
|
|
|
|
begin
|
|
result:=nil;
|
|
init_block:=nil;
|
|
temp_cleanup:=nil;
|
|
expectloc:=LOC_VOID;
|
|
|
|
{ evalutes the case expression }
|
|
firstpass(left);
|
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ Load caseexpr into temp var if complex. }
|
|
{ No need to do this for ordinal, because }
|
|
{ in that case caseexpr is generated once }
|
|
if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and
|
|
(blocks.count > 0) then
|
|
begin
|
|
init_block := internalstatements(stmt);
|
|
tempcaseexpr :=
|
|
ctempcreatenode.create(
|
|
left.resultdef, left.resultdef.size, tt_persistent, true);
|
|
temp_cleanup := ctempdeletenode.create(tempcaseexpr);
|
|
typecheckpass(tnode(tempcaseexpr));
|
|
|
|
addstatement(stmt, tempcaseexpr);
|
|
addstatement(
|
|
stmt, cassignmentnode.create(
|
|
ctemprefnode.create(tempcaseexpr), left));
|
|
|
|
left := ctemprefnode.create(tempcaseexpr);
|
|
typecheckpass(left);
|
|
end;
|
|
|
|
{ first case }
|
|
for i:=0 to blocks.count-1 do
|
|
firstpass(pcaseblock(blocks[i])^.statement);
|
|
|
|
{ may be handle else tree }
|
|
if assigned(elseblock) then
|
|
begin
|
|
firstpass(elseblock);
|
|
|
|
{ kill case? }
|
|
if blocks.count=0 then
|
|
begin
|
|
result:=elseblock;
|
|
elseblock:=nil;
|
|
exit;
|
|
end;
|
|
end
|
|
else
|
|
if blocks.count=0 then
|
|
begin
|
|
result:=cnothingnode.create;
|
|
exit;
|
|
end;
|
|
|
|
if (labels^.label_type = ltConstString) then
|
|
begin
|
|
if_node:=makeifblock(elseblock);
|
|
|
|
if assigned(init_block) then
|
|
firstpass(tnode(init_block));
|
|
|
|
if_block:=internalstatements(stmt);
|
|
|
|
if assigned(init_block) then
|
|
addstatement(stmt, init_block);
|
|
addstatement(stmt,if_node);
|
|
if assigned(temp_cleanup) then
|
|
addstatement(stmt,temp_cleanup);
|
|
result:=if_block;
|
|
elseblock:= nil;
|
|
exit;
|
|
end;
|
|
|
|
if is_boolean(left.resultdef) then
|
|
begin
|
|
case blocks.count of
|
|
2:
|
|
begin
|
|
if boolean(qword(labels^._low))=false then
|
|
begin
|
|
node_thenblock:=pcaseblock(blocks[labels^.greater^.blockid])^.statement;
|
|
node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement;
|
|
pcaseblock(blocks[labels^.greater^.blockid])^.statement:=nil;
|
|
end
|
|
else
|
|
begin
|
|
node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement;
|
|
node_elseblock:=pcaseblock(blocks[labels^.less^.blockid])^.statement;
|
|
pcaseblock(blocks[labels^.less^.blockid])^.statement:=nil;
|
|
end;
|
|
pcaseblock(blocks[labels^.blockid])^.statement:=nil;
|
|
end;
|
|
1:
|
|
begin
|
|
if labels^._low=labels^._high then
|
|
begin
|
|
if boolean(qword(labels^._low))=false then
|
|
begin
|
|
node_thenblock:=elseblock;
|
|
node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement;
|
|
end
|
|
else
|
|
begin
|
|
node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement;
|
|
node_elseblock:=elseblock;
|
|
end;
|
|
pcaseblock(blocks[labels^.blockid])^.statement:=nil;
|
|
elseblock:=nil;
|
|
end
|
|
else
|
|
begin
|
|
result:=pcaseblock(blocks[labels^.blockid])^.statement;
|
|
pcaseblock(blocks[labels^.blockid])^.statement:=nil;
|
|
elseblock:=nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(200805031);
|
|
end;
|
|
result:=cifnode.create(left,node_thenblock,node_elseblock);
|
|
left:=nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tcasenode.simplify(forinline:boolean):tnode;
|
|
var
|
|
tmp: pcaselabel;
|
|
begin
|
|
result:=nil;
|
|
if left.nodetype=ordconstn then
|
|
begin
|
|
tmp:=labels;
|
|
{ check all case labels until we find one that fits }
|
|
while assigned(tmp) do
|
|
begin
|
|
if (tmp^._low<=tordconstnode(left).value) and
|
|
(tmp^._high>=tordconstnode(left).value) then
|
|
begin
|
|
if tmp^.blockid>=blocks.count then
|
|
internalerror(2014022101);
|
|
result:=pcaseblock(blocks[tmp^.blockid])^.statement;
|
|
if not assigned(result) then
|
|
internalerror(2014022102);
|
|
result:=result.getcopy;
|
|
exit;
|
|
end;
|
|
|
|
if tmp^._high<tordconstnode(left).value then
|
|
tmp:=tmp^.greater
|
|
else
|
|
tmp:=tmp^.less;
|
|
end;
|
|
{ no label did match; use the else block if available }
|
|
if assigned(elseblock) then
|
|
result:=elseblock.getcopy
|
|
else
|
|
{ no else block, so there is no code to execute at all }
|
|
result:=cnothingnode.create;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tcasenode.dogetcopy : tnode;
|
|
var
|
|
n : tcasenode;
|
|
i : longint;
|
|
begin
|
|
n:=tcasenode(inherited dogetcopy);
|
|
if assigned(elseblock) then
|
|
n.elseblock:=elseblock.dogetcopy
|
|
else
|
|
n.elseblock:=nil;
|
|
if assigned(labels) then
|
|
n.labels:=copycaselabel(labels)
|
|
else
|
|
n.labels:=nil;
|
|
if assigned(blocks) then
|
|
begin
|
|
n.blocks:=TFPList.create;
|
|
for i:=0 to blocks.count-1 do
|
|
begin
|
|
if not assigned(blocks[i]) then
|
|
internalerror(200411302);
|
|
n.addblock(i,pcaseblock(blocks[i])^.statement.dogetcopy);
|
|
end;
|
|
end
|
|
else
|
|
n.blocks:=nil;
|
|
dogetcopy:=n;
|
|
end;
|
|
|
|
|
|
procedure tcasenode.printnodetree(var t: text);
|
|
var
|
|
i : longint;
|
|
begin
|
|
write(t,printnodeindention,'(');
|
|
printnodeindent;
|
|
printnodeinfo(t);
|
|
writeln(t);
|
|
printnode(t,left);
|
|
i:=0;
|
|
for i:=0 to blocks.count-1 do
|
|
begin
|
|
writeln(t,printnodeindention,'(caseblock blockid: ',i);
|
|
printnodeindent;
|
|
printnode(t,pcaseblock(blocks[i])^.statement);
|
|
printnodeunindent;
|
|
writeln(t,printnodeindention,')');
|
|
end;
|
|
if assigned(elseblock) then
|
|
begin
|
|
writeln(t,printnodeindention,'(else: ',i);
|
|
printnodeindent;
|
|
printnode(t,elseblock);
|
|
printnodeunindent;
|
|
writeln(t,printnodeindention,')');
|
|
end;
|
|
printnodeunindent;
|
|
writeln(t,printnodeindention,')');
|
|
end;
|
|
|
|
|
|
procedure tcasenode.insertintolist(l : tnodelist);
|
|
begin
|
|
end;
|
|
|
|
|
|
function caselabelsequal(n1,n2: pcaselabel): boolean;
|
|
begin
|
|
result :=
|
|
(not assigned(n1) and not assigned(n2)) or
|
|
(assigned(n1) and assigned(n2) and
|
|
(n1^._low = n2^._low) and
|
|
(n1^._high = n2^._high) and
|
|
{ the rest of the fields don't matter for equality (JM) }
|
|
caselabelsequal(n1^.less,n2^.less) and
|
|
caselabelsequal(n1^.greater,n2^.greater))
|
|
end;
|
|
|
|
|
|
function caseblocksequal(b1,b2:TFPList): boolean;
|
|
var
|
|
i : longint;
|
|
begin
|
|
result:=false;
|
|
if b1.count<>b2.count then
|
|
exit;
|
|
for i:=0 to b1.count-1 do
|
|
begin
|
|
if not pcaseblock(b1[i])^.statement.isequal(pcaseblock(b2[i])^.statement) then
|
|
exit;
|
|
end;
|
|
result:=true;
|
|
end;
|
|
|
|
|
|
function tcasenode.docompare(p: tnode): boolean;
|
|
begin
|
|
result :=
|
|
inherited docompare(p) and
|
|
caselabelsequal(labels,tcasenode(p).labels) and
|
|
caseblocksequal(blocks,tcasenode(p).blocks) and
|
|
elseblock.isequal(tcasenode(p).elseblock);
|
|
end;
|
|
|
|
|
|
procedure tcasenode.addblock(blockid:longint;instr:tnode);
|
|
var
|
|
hcaseblock : pcaseblock;
|
|
begin
|
|
new(hcaseblock);
|
|
fillchar(hcaseblock^,sizeof(hcaseblock^),0);
|
|
hcaseblock^.statement:=instr;
|
|
if blockid>=blocks.count then
|
|
blocks.count:=blockid+1;
|
|
blocks[blockid]:=hcaseblock;
|
|
end;
|
|
|
|
|
|
procedure tcasenode.addelseblock(instr:tnode);
|
|
begin
|
|
elseblock:=instr;
|
|
end;
|
|
|
|
|
|
procedure tcasenode.addlabel(blockid:longint;const l,h : TConstExprInt);
|
|
var
|
|
hcaselabel : pcaselabel;
|
|
|
|
function insertlabel(var p : pcaselabel):pcaselabel;
|
|
begin
|
|
if p=nil then
|
|
begin
|
|
p:=hcaselabel;
|
|
result:=p;
|
|
end
|
|
else
|
|
if (p^._low>hcaselabel^._low) and
|
|
(p^._low>hcaselabel^._high) then
|
|
begin
|
|
if (hcaselabel^.blockid = p^.blockid) and
|
|
(p^._low = hcaselabel^._high + 1) then
|
|
begin
|
|
p^._low := hcaselabel^._low;
|
|
dispose(hcaselabel);
|
|
result:=p;
|
|
end
|
|
else
|
|
result:=insertlabel(p^.less)
|
|
end
|
|
else
|
|
if (p^._high<hcaselabel^._low) and
|
|
(p^._high<hcaselabel^._high) then
|
|
begin
|
|
if (hcaselabel^.blockid = p^.blockid) and
|
|
(p^._high+1 = hcaselabel^._low) then
|
|
begin
|
|
p^._high := hcaselabel^._high;
|
|
dispose(hcaselabel);
|
|
result:=p;
|
|
end
|
|
else
|
|
result:=insertlabel(p^.greater);
|
|
end
|
|
else
|
|
begin
|
|
dispose(hcaselabel);
|
|
Message(parser_e_double_caselabel);
|
|
result:=nil;
|
|
end
|
|
end;
|
|
|
|
begin
|
|
new(hcaselabel);
|
|
fillchar(hcaselabel^,sizeof(tcaselabel),0);
|
|
hcaselabel^.blockid:=blockid;
|
|
hcaselabel^.label_type:=ltOrdinal;
|
|
hcaselabel^._low:=l;
|
|
hcaselabel^._high:=h;
|
|
insertlabel(labels);
|
|
end;
|
|
|
|
procedure tcasenode.addlabel(blockid: longint; l, h: tstringconstnode);
|
|
|
|
var
|
|
hcaselabel : pcaselabel;
|
|
|
|
function insertlabel(var p : pcaselabel) : pcaselabel;
|
|
begin
|
|
if not assigned(p) then
|
|
begin
|
|
p := hcaselabel;
|
|
result := p;
|
|
end
|
|
else
|
|
if (p^._low_str.fullcompare(hcaselabel^._high_str) > 0) then
|
|
result := insertlabel(p^.less)
|
|
else
|
|
if (p^._high_str.fullcompare(hcaselabel^._low_str) < 0) then
|
|
result := insertlabel(p^.greater)
|
|
else
|
|
begin
|
|
hcaselabel^._low_str.free;
|
|
hcaselabel^._high_str.free;
|
|
dispose(hcaselabel);
|
|
Message(parser_e_double_caselabel);
|
|
result:=nil;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
new(hcaselabel);
|
|
fillchar(hcaselabel^, sizeof(tcaselabel), 0);
|
|
hcaselabel^.blockid := blockid;
|
|
hcaselabel^.label_type := ltConstString;
|
|
|
|
hcaselabel^._low_str := tstringconstnode(l.getcopy);
|
|
hcaselabel^._high_str := tstringconstnode(h.getcopy);
|
|
|
|
insertlabel(labels);
|
|
end;
|
|
|
|
end.
|