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

* for-node cleanup, checking for uninitialzed from and to values

Browse Source 
is now supported
This commit is contained in:
peter 2005-01-31 16:16:21 +00:00
parent be1808953c
commit cc2789b680
3 changed files with 198 additions and 221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
compiler/ncgflw.pas
View File

@ -329,7 +329,6 @@ implementation
var
l3,oldclabel,oldblabel : tasmlabel;
temptovalue : boolean;
hs : byte;
temp1 : treference;
hop : topcg;
hcond : topcmp;
@ -348,31 +347,40 @@ implementation
objectlibrary.getlabel(l3);
{ only calculate reference }
secondpass(t2);
hs := t2.resulttype.def.size;
opsize := def_cgsize(t2.resulttype.def);
opsize := def_cgsize(left.resulttype.def);
count_var_is_signed:=is_signed(left.resulttype.def);
{ first set the to value
because the count var can be in the expression !! }
do_loopvar_at_end:=lnf_dont_mind_loopvar_on_exit in loopflags;
secondpass(right);
secondpass(t1);
{ calculate pointer value and check if changeable and if so }
{ load into temporary variable }
if right.nodetype<>ordconstn then
if t1.nodetype<>ordconstn then
begin
do_loopvar_at_end:=false;
tg.GetTemp(exprasmlist,hs,tt_normal,temp1);
tg.GetTemp(exprasmlist,t1.resulttype.def.size,tt_normal,temp1);
temptovalue:=true;
cg.a_load_loc_ref(exprasmlist,opsize,right.location,temp1);
location_freetemp(exprasmlist,right.location);
cg.a_load_loc_ref(exprasmlist,opsize,t1.location,temp1);
location_freetemp(exprasmlist,t1.location);
end
else
temptovalue:=false;
{ produce start assignment }
secondpass(left);
count_var_is_signed:=is_signed(t2.resulttype.def);
secondpass(right);
case left.location.loc of
LOC_REFERENCE,
LOC_CREFERENCE :
cg.a_load_loc_ref(exprasmlist,left.location.size,right.location,left.location.reference);
LOC_REGISTER,
LOC_CREGISTER :
cg.a_load_loc_reg(exprasmlist,left.location.size,right.location,left.location.register);
else
internalerror(200501311);
end;
if lnf_backward in loopflags then
if count_var_is_signed then
@ -392,15 +400,15 @@ implementation
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,
temp1,t2.location,aktbreaklabel);
temp1,left.location,aktbreaklabel);
end
else
begin
if lnf_testatbegin in loopflags then
begin
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
tordconstnode(right).value,
t2.location,aktbreaklabel);
tordconstnode(t1).value,
left.location,aktbreaklabel);
end;
end;
@ -413,11 +421,11 @@ implementation
hop:=OP_ADD
else
hop:=OP_SUB;
cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
cg.a_op_const_loc(exprasmlist,hop,1,left.location);
end;
{ align loop target }
if not(cs_littlesize in aktglobalswitches) then
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
cg.a_label(exprasmlist,l3);
@ -430,13 +438,12 @@ implementation
hop:=OP_SUB
else
hop:=OP_ADD;
cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
cg.a_op_const_loc(exprasmlist,hop,1,left.location);
end;
{ help register must not be in instruction block }
if assigned(t1) then
if assigned(t2) then
begin
secondpass(t1);
secondpass(t2);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
@ -451,7 +458,7 @@ implementation
hop:=OP_SUB
else
hop:=OP_ADD;
cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
cg.a_op_const_loc(exprasmlist,hop,1,left.location);
end;
cg.a_label(exprasmlist,aktcontinuelabel);
@ -487,12 +494,12 @@ implementation
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1,
t2.location,l3);
left.location,l3);
tg.ungetiftemp(exprasmlist,temp1);
end
else
begin
cmp_const:=Tordconstnode(right).value;
cmp_const:=Tordconstnode(t1).value;
if do_loopvar_at_end then
begin
{Watch out for wrap around 255 -> 0.}
@ -597,18 +604,18 @@ implementation
begin
if lnf_backward in loopflags then
begin
if integer(cmp_const)=high(integer) then
if integer(cmp_const)=high(smallint) then
begin
hcond:=OC_NE;
cmp_const:=low(integer);
cmp_const:=low(smallint);
end
end
else
begin
if integer(cmp_const)=low(integer) then
if integer(cmp_const)=low(smallint) then
begin
hcond:=OC_NE;
cmp_const:=high(integer);
cmp_const:=high(smallint);
end
end
end;
@ -656,7 +663,7 @@ implementation
end;
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
cmp_const,t2.location,l3);
cmp_const,left.location,l3);
end;
{ this is the break label: }
@ -1443,7 +1450,11 @@ begin
end.
{
$Log$
Revision 1.102 2004-11-08 22:09:59 peter
Revision 1.103 2005-01-31 16:16:21 peter
* for-node cleanup, checking for uninitialzed from and to values
is now supported
Revision 1.102 2004/11/08 22:09:59 peter
* tvarsym splitted
Revision 1.101 2004/10/24 11:44:28 peter

154
compiler/nflw.pas
View File

@ -68,7 +68,7 @@ interface
end;
twhilerepeatnode = class(tloopnode)
constructor create(l,r,_t1:Tnode;tab,cn:boolean);virtual;
constructor create(l,r:Tnode;tab,cn:boolean);virtual;
function det_resulttype:tnode;override;
function pass_1 : tnode;override;
{$ifdef state_tracking}
@ -196,9 +196,6 @@ interface
end;
tonnodeclass = class of tonnode;
{ for compatibilty }
function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
var
cwhilerepeatnode : twhilerepeatnodeclass;
cifnode : tifnodeclass;
@ -227,28 +224,6 @@ implementation
cgbase,procinfo
;
function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
var
p : tnode;
begin
case t of
ifn:
p:=cifnode.create(l,r,n1);
whilerepeatn:
if back then
{Repeat until.}
p:=cwhilerepeatnode.create(l,r,n1,false,true)
else
{While do.}
p:=cwhilerepeatnode.create(l,r,n1,true,false);
forn:
p:=cfornode.create(l,r,n1,nil,back);
end;
resulttypepass(p);
genloopnode:=p;
end;
{****************************************************************************
TLOOPNODE
@ -361,9 +336,9 @@ implementation
TWHILEREPEATNODE
*****************************************************************************}
constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean);
constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
begin
inherited create(whilerepeatn,l,r,_t1,nil);
inherited create(whilerepeatn,l,r,nil,nil);
if tab then
include(loopflags, lnf_testatbegin);
if cn then
@ -705,42 +680,39 @@ implementation
resulttype:=voidtype;
{Can we spare the first comparision?}
if (right.nodetype=ordconstn) and
(Tassignmentnode(left).right.nodetype=ordconstn) and
if (t1.nodetype=ordconstn) and
(right.nodetype=ordconstn) and
(
(
(lnf_backward in loopflags) and
(Tordconstnode(Tassignmentnode(left).right).value>=Tordconstnode(right).value)
(Tordconstnode(right).value>=Tordconstnode(t1).value)
) or
(
not(lnf_backward in loopflags) and
(Tordconstnode(Tassignmentnode(left).right).value<=Tordconstnode(right).value)
(Tordconstnode(right).value<=Tordconstnode(t1).value)
)
) then
exclude(loopflags,lnf_testatbegin);
{ save counter var }
t2:=tassignmentnode(left).left.getcopy;
{ process the loopvar, from and to }
resulttypepass(left);
set_varstate(left,vs_used,true);
if assigned(t1) then
begin
resulttypepass(t1);
if codegenerror then
exit;
end;
{ process count var }
resulttypepass(t2);
set_varstate(t2,vs_used,false);
if codegenerror then
exit;
resulttypepass(right);
resulttypepass(t1);
{ first set the varstate for from and to, so
uses of loopvar in those expressions will also
trigger a warning when it is not used yet }
set_varstate(right,vs_used,true);
inserttypeconv(right,t2.resulttype);
set_varstate(t1,vs_used,true);
set_varstate(left,vs_used,false);
{ Make sure that the loop var and the
from and to values are compatible types }
inserttypeconv(right,left.resulttype);
inserttypeconv(t1,left.resulttype);
if assigned(t2) then
resulttypepass(t2);
end;
@ -750,25 +722,8 @@ implementation
begin
result:=nil;
expectloc:=LOC_VOID;
{ Calc register weight }
old_t_times:=cg.t_times;
if not(cs_littlesize in aktglobalswitches) then
cg.t_times:=cg.t_times*8;
firstpass(left);
if assigned(t1) then
begin
firstpass(t1);
if codegenerror then
exit;
end;
registersint:=t1.registersint;
registersfpu:=t1.registersfpu;
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
if left.registersint>registersint then
registersint:=left.registersint;
if left.registersfpu>registersfpu then
@ -778,32 +733,7 @@ implementation
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
{ process count var }
firstpass(t2);
if codegenerror then
exit;
if t2.registersint>registersint then
registersint:=t2.registersint;
if t2.registersfpu>registersfpu then
registersfpu:=t2.registersfpu;
{$ifdef SUPPORT_MMX}
if t2.registersmmx>registersmmx then
registersmmx:=t2.registersmmx;
{$endif SUPPORT_MMX}
firstpass(right);
{$ifdef loopvar_dont_mind}
{ Check count var, record fields are also allowed in tp7 }
include(loopflags,lnf_dont_mind_loopvar_on_exit);
hp:=t2;
while (hp.nodetype=subscriptn) or
((hp.nodetype=vecn) and
is_constintnode(tvecnode(hp).right)) do
hp:=tunarynode(hp).left;
if (hp.nodetype=loadn) and (Tloadnode(hp).symtableentry.typ=varsym) then
loopvar_notid:=Tvarsym(Tloadnode(hp).symtableentry).
register_notification([vn_onread,vn_onwrite],@loop_var_access);
{$endif}
if right.registersint>registersint then
registersint:=right.registersint;
if right.registersfpu>registersfpu then
@ -812,10 +742,40 @@ implementation
if right.registersmmx>registersmmx then
registersmmx:=right.registersmmx;
{$endif SUPPORT_MMX}
firstpass(t1);
if t1.registersint>registersint then
registersint:=t1.registersint;
if t1.registersfpu>registersfpu then
registersfpu:=t1.registersfpu;
{$ifdef SUPPORT_MMX}
if t1.registersmmx>registersmmx then
registersmmx:=t1.registersmmx;
{$endif SUPPORT_MMX}
if assigned(t2) then
begin
{ Calc register weight }
old_t_times:=cg.t_times;
if not(cs_littlesize in aktglobalswitches) then
cg.t_times:=cg.t_times*8;
firstpass(t2);
if codegenerror then
exit;
if t2.registersint>registersint then
registersint:=t2.registersint;
if t2.registersfpu>registersfpu then
registersfpu:=t2.registersfpu;
{$ifdef SUPPORT_MMX}
if t2.registersmmx>registersmmx then
registersmmx:=t2.registersmmx;
{$endif SUPPORT_MMX}
cg.t_times:=old_t_times;
end;
{ we need at least one register for comparisons PM }
if registersint=0 then
inc(registersint);
cg.t_times:=old_t_times;
end;
@ -1441,7 +1401,11 @@ begin
end.
{
$Log$
Revision 1.106 2005-01-16 14:44:03 peter
Revision 1.107 2005-01-31 16:16:21 peter
* for-node cleanup, checking for uninitialzed from and to values
is now supported
Revision 1.106 2005/01/16 14:44:03 peter
* fix unreachable code check for repeat loop
Revision 1.105 2005/01/16 10:50:32 peter

198
compiler/pstatmnt.pas
View File

@ -81,7 +81,7 @@ implementation
else_a:=statement
else
else_a:=nil;
if_statement:=genloopnode(ifn,ex,if_a,else_a,false);
result:=cifnode.create(ex,if_a,else_a);
end;
{ creates a block (list) of statements, til the next END token }
@ -116,7 +116,7 @@ implementation
function case_statement : tnode;
var
casedef : tdef;
code,caseexpr,p,instruc,elseblock : tnode;
caseexpr,p : tnode;
blockid : longint;
hl1,hl2 : TConstExprInt;
casedeferror : boolean;
@ -221,10 +221,7 @@ implementation
casenode.addelseblock(statements_til_end);
end
else
begin
elseblock:=nil;
consume(_END);
end;
consume(_END);
result:=casenode;
end;
@ -259,7 +256,7 @@ implementation
first:=cblocknode.create(first);
p_e:=comp_expr(true);
repeat_statement:=genloopnode(whilerepeatn,p_e,first,nil,true);
result:=cwhilerepeatnode.create(p_e,first,false,true);
end;
@ -273,133 +270,131 @@ implementation
p_e:=comp_expr(true);
consume(_DO);
p_a:=statement;
while_statement:=genloopnode(whilerepeatn,p_e,p_a,nil,false);
result:=cwhilerepeatnode.create(p_e,p_a,true,false);
end;
function for_statement : tnode;
var
p_e,tovalue,p_a : tnode;
hp,
hloopvar,
hblock,
hto,hfrom : tnode;
backward : boolean;
loopvarsym : tabstractvarsym;
hp : tnode;
begin
{ parse loop header }
consume(_FOR);
p_e:=expr;
hloopvar:=factor(false);
{ Check loop variable }
hp:=nil;
loopvarsym:=nil;
if (p_e.nodetype=assignn) then
begin
hp:=tassignmentnode(p_e).left;
{ variable must be an ordinal, int64 is not allowed for 32bit targets }
if not(is_ordinal(hp.resulttype.def))
{ variable must be an ordinal, int64 is not allowed for 32bit targets }
if not(is_ordinal(hloopvar.resulttype.def))
{$ifndef cpu64bit}
or is_64bitint(hp.resulttype.def)
or is_64bitint(hloopvar.resulttype.def)
{$endif cpu64bit}
then
MessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
then
MessagePos(hloopvar.fileinfo,type_e_ordinal_expr_expected);
while assigned(hp) and
(
{ record/object fields are allowed }
(
(hp.nodetype=subscriptn) and
((tsubscriptnode(hp).left.resulttype.def.deftype=recorddef) or
is_object(tsubscriptnode(hp).left.resulttype.def))
) or
{ constant array index }
(
(hp.nodetype=vecn) and
is_constintnode(tvecnode(hp).right)
) or
{ equal typeconversions }
(
(hp.nodetype=typeconvn) and
(ttypeconvnode(hp).convtype=tc_equal)
)
) do
begin
{ Use the recordfield for loopvarsym }
if not assigned(loopvarsym) and
(hp.nodetype=subscriptn) then
loopvarsym:=tsubscriptnode(hp).vs;
hp:=tunarynode(hp).left;
end;
hp:=hloopvar;
while assigned(hp) and
(
{ record/object fields are allowed in tp7 mode only }
(
(m_tp7 in aktmodeswitches) and
(hp.nodetype=subscriptn) and
((tsubscriptnode(hp).left.resulttype.def.deftype=recorddef) or
is_object(tsubscriptnode(hp).left.resulttype.def))
) or
{ constant array index }
(
(hp.nodetype=vecn) and
is_constintnode(tvecnode(hp).right)
) or
{ equal typeconversions }
(
(hp.nodetype=typeconvn) and
(ttypeconvnode(hp).convtype=tc_equal)
)
) do
begin
{ Use the recordfield for loopvarsym }
if not assigned(loopvarsym) and
(hp.nodetype=subscriptn) then
loopvarsym:=tsubscriptnode(hp).vs;
hp:=tunarynode(hp).left;
end;
if assigned(hp) and
(hp.nodetype=loadn) then
begin
case tloadnode(hp).symtableentry.typ of
globalvarsym,
localvarsym,
paravarsym :
if assigned(hp) and
(hp.nodetype=loadn) then
begin
case tloadnode(hp).symtableentry.typ of
globalvarsym,
localvarsym,
paravarsym :
begin
{ we need a simple loadn and the load must be in a global symtable or
in the same level as the para of the current proc }
if (
(tloadnode(hp).symtable.symtablelevel=main_program_level) or
(tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel)
) and
not(
((tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_var,vs_out]) or
(vo_is_thread_var in tabstractvarsym(tloadnode(hp).symtableentry).varoptions))
) then
begin
{ we need a simple loadn and the load must be in a global symtable or
in the same level as the para of the current proc }
if (
(tloadnode(hp).symtable.symtablelevel=main_program_level) or
(tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel)
) and
not(
((tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_var,vs_out]) or
(vo_is_thread_var in tabstractvarsym(tloadnode(hp).symtableentry).varoptions))
) then
begin
tabstractvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
{ Assigning for-loop variable is only allowed in tp7 }
if not(m_tp7 in aktmodeswitches) then
begin
if not assigned(loopvarsym) then
loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry);
include(loopvarsym.varoptions,vo_is_loop_counter);
end;
end
else
MessagePos(hp.fileinfo,type_e_illegal_count_var);
end;
typedconstsym :
begin
{ Bad programming, only allowed in tp7 mode }
{ Assigning for-loop variable is only allowed in tp7 }
if not(m_tp7 in aktmodeswitches) then
MessagePos(hp.fileinfo,type_e_illegal_count_var);
end;
begin
if not assigned(loopvarsym) then
loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry);
include(loopvarsym.varoptions,vo_is_loop_counter);
end;
end
else
MessagePos(hp.fileinfo,type_e_illegal_count_var);
end;
end
else
MessagePos(tassignmentnode(p_e).left.fileinfo,type_e_illegal_count_var);
typedconstsym :
begin
{ Bad programming, only allowed in tp7 mode }
if not(m_tp7 in aktmodeswitches) then
MessagePos(hp.fileinfo,type_e_illegal_count_var);
end;
else
MessagePos(hp.fileinfo,type_e_illegal_count_var);
end;
end
else
Message(parser_e_illegal_expression);
MessagePos(hloopvar.fileinfo,type_e_illegal_count_var);
if token=_DOWNTO then
begin
consume(_DOWNTO);
backward:=true;
end
consume(_ASSIGNMENT);
hfrom:=comp_expr(true);
if try_to_consume(_DOWNTO) then
backward:=true
else
begin
consume(_TO);
backward:=false;
consume(_TO);
backward:=false;
end;
tovalue:=comp_expr(true);
hto:=comp_expr(true);
consume(_DO);
{ ... now the instruction block }
p_a:=statement;
hblock:=statement;
{ variable is not used a loop counter anymore }
if assigned(loopvarsym) then
exclude(loopvarsym.varoptions,vo_is_loop_counter);
for_statement:=genloopnode(forn,p_e,tovalue,p_a,backward);
result:=cfornode.create(hloopvar,hfrom,hto,hblock,backward);
end;
@ -1025,7 +1020,10 @@ implementation
end;
end;
if assigned(code) then
code.fileinfo:=filepos;
begin
resulttypepass(code);
code.fileinfo:=filepos;
end;
statement:=code;
end;
@ -1147,7 +1145,11 @@ implementation
end.
{
$Log$
Revision 1.149 2004-12-26 16:22:01 peter
Revision 1.150 2005-01-31 16:16:21 peter
* for-node cleanup, checking for uninitialzed from and to values
is now supported
Revision 1.149 2004/12/26 16:22:01 peter
* fix lineinfo for with blocks
Revision 1.148 2004/12/07 16:11:52 peter