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

* Removed sets from Tcallnode.det_resulttype

Browse Source 
+ Added read/write notifications of variables. These will be usefull
   for providing information for several optimizations. For example
   the value of the loop variable of a for loop does matter is the
   variable is read after the for loop, but if it's no longer used
   or written, it doesn't matter and this can be used to optimize
   the loop code generation.
This commit is contained in:
daniel 2002-09-01 08:01:16 +00:00
parent 431b9fac81
commit 4b82d30953
8 changed files with 313 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compiler/nbas.pas
View File

@ -117,11 +117,17 @@ interface
{ a node which is a reference to a certain temp } { a node which is a reference to a certain temp }
ttemprefnode = class(tnode) ttemprefnode = class(tnode)
{$ifdef var_notification}
writeaccess:boolean;
{$endif}
constructor create(const temp: ttempcreatenode); virtual; constructor create(const temp: ttempcreatenode); virtual;
constructor create_offset(const temp: ttempcreatenode;aoffset:longint); constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
function getcopy: tnode; override; function getcopy: tnode; override;
function pass_1 : tnode; override; function pass_1 : tnode; override;
function det_resulttype : tnode; override; function det_resulttype : tnode; override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
function docompare(p: tnode): boolean; override; function docompare(p: tnode): boolean; override;
protected protected
tempinfo: ptempinfo; tempinfo: ptempinfo;
@ -670,6 +676,15 @@ implementation
(ttemprefnode(p).tempinfo = tempinfo); (ttemprefnode(p).tempinfo = tempinfo);
end; end;
{$ifdef var_notification}
procedure Ttemprefnode.mark_write;
begin
writeaccess:=true;
end;
{$endif}
{***************************************************************************** {*****************************************************************************
TEMPDELETENODE TEMPDELETENODE
*****************************************************************************} *****************************************************************************}
@ -746,7 +761,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.34 2002-08-18 20:06:23 peter Revision 1.35 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.34 2002/08/18 20:06:23 peter
* inlining is now also allowed in interface * inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload * renamed write/load to ppuwrite/ppuload
* tnode storing in ppu * tnode storing in ppu

138
compiler/ncal.pas
View File

@ -894,7 +894,6 @@ implementation
else if (treeparas.left.nodetype=ordconstn) and is_integer(to_def) then else if (treeparas.left.nodetype=ordconstn) and is_integer(to_def) then
begin begin
inc(equal_count); inc(equal_count);
{To do: What to do with overflow??}
ordspace:=ordspace+(double(Torddef(from_def).low)-Torddef(to_def).low)+ ordspace:=ordspace+(double(Torddef(from_def).low)-Torddef(to_def).low)+
(double(Torddef(to_def).high)-Torddef(from_def).high); (double(Torddef(to_def).high)-Torddef(from_def).high);
end end
@ -924,13 +923,16 @@ implementation
end; end;
end; end;
var candidates_left,candidate_count,c1,c2:byte; type Tcandidate_array=array[1..$ffff] of Tprocdef;
Pcandidate_array=^Tcandidate_array;
var candidate_alloc,candidates_left,candidate_count:cardinal;
c1,c2,delete_start:cardinal;
cl2_count1,cl1_count1,equal_count1,exact_count1:byte; cl2_count1,cl1_count1,equal_count1,exact_count1:byte;
ordspace1:double; ordspace1:double;
cl2_count2,cl1_count2,equal_count2,exact_count2:byte; cl2_count2,cl1_count2,equal_count2,exact_count2:byte;
ordspace2:double; ordspace2:double;
i,n:byte; i,n:cardinal;
cont:boolean;
pt:Tcallparanode; pt:Tcallparanode;
def:Tprocdef; def:Tprocdef;
hcvt:Tconverttype; hcvt:Tconverttype;
@ -938,12 +940,11 @@ implementation
hpt:Tnode; hpt:Tnode;
srprocsym:Tprocsym; srprocsym:Tprocsym;
srsymtable:Tsymtable; srsymtable:Tsymtable;
candidates:set of 0..255; candidate_defs:Pcandidate_array;
candidates_exactmatch:set of 0..255;
delete_mask:set of 0..255;
candidate_defs:array[0..255] of Tprocdef;
begin begin
if fileinfo.line=398 then
i:=0;
choose_definition_to_call:=nil; choose_definition_to_call:=nil;
errorexit:=true; errorexit:=true;
@ -955,25 +956,32 @@ implementation
(symtableprocentry.owner.symtabletype=objectsymtable) then (symtableprocentry.owner.symtabletype=objectsymtable) then
search_class_overloads(symtableprocentry); search_class_overloads(symtableprocentry);
candidates:=[];
candidates_exactmatch:=[];
{Collect all procedures which have the same # of parameters } {Collect all procedures which have the same # of parameters }
candidates_left:=0;
candidate_count:=0; candidate_count:=0;
candidate_alloc:=32;
getmem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
srprocsym:=symtableprocentry; srprocsym:=symtableprocentry;
srsymtable:=symtableprocentry.owner; srsymtable:=symtableprocentry.owner;
repeat repeat
for i:=1 to srprocsym.procdef_count do for i:=1 to srprocsym.procdef_count do
begin begin
def:=srprocsym.procdef(i); def:=srprocsym.procdef(i);
candidate_defs[i-1]:=def; { only when the # of parameters are supported by the procedure }
{ only when the # of parameter are supported by the
procedure }
if (paralength>=def.minparacount) and if (paralength>=def.minparacount) and
((po_varargs in def.procoptions) or { varargs } ((po_varargs in def.procoptions) or (paralength<=def.maxparacount)) then
(paralength<=def.maxparacount)) then begin
include(candidates,i-1); candidate_defs^[i]:=def;
inc(candidates_left);
end
else
candidate_defs^[i]:=nil;
inc(candidate_count); inc(candidate_count);
if candidate_alloc=candidate_count then
begin
candidate_alloc:=candidate_alloc*2;
reallocmem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
end;
end; end;
if po_overload in srprocsym.first_procdef.procoptions then if po_overload in srprocsym.first_procdef.procoptions then
begin begin
@ -984,15 +992,16 @@ implementation
if assigned(srsymtable) then if assigned(srsymtable) then
srprocsym:=Tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue)); srprocsym:=Tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
until (srsymtable=nil) or (srprocsym<>nil); until (srsymtable=nil) or (srprocsym<>nil);
cont:=assigned(srprocsym); if not assigned(srprocsym) then
break;
end end
else else
cont:=false; break;
until not cont; until false;
{ no procedures found? then there is something wrong { no procedures found? then there is something wrong
with the parameter size } with the parameter size }
if candidates=[] then if candidates_left=0 then
begin begin
{ in tp mode we can try to convert to procvar if { in tp mode we can try to convert to procvar if
there are no parameters specified } there are no parameters specified }
@ -1010,7 +1019,7 @@ implementation
begin begin
if assigned(left) then if assigned(left) then
aktfilepos:=left.fileinfo; aktfilepos:=left.fileinfo;
CGMessage(parser_e_wrong_parameter_size); cgmessage(parser_e_wrong_parameter_size);
symtableprocentry.write_parameter_lists(nil); symtableprocentry.write_parameter_lists(nil);
end; end;
exit; exit;
@ -1018,9 +1027,9 @@ implementation
{Walk through all candidates and remove the ones {Walk through all candidates and remove the ones
that have incompatible parameters.} that have incompatible parameters.}
for i:=1 to candidate_count do for i:=1 to candidate_count do
if (i-1) in candidates then if assigned(candidate_defs^[i]) then
begin begin
def:=candidate_defs[i-1]; def:=candidate_defs^[i];
{Walk through all parameters.} {Walk through all parameters.}
pdc:=Tparaitem(def.para.first); pdc:=Tparaitem(def.para.first);
pt:=Tcallparanode(left); pt:=Tcallparanode(left);
@ -1030,8 +1039,12 @@ implementation
if is_var_para_incompatible(pt.resulttype.def,pdc.paratype.def) and if is_var_para_incompatible(pt.resulttype.def,pdc.paratype.def) and
not(is_shortstring(pt.resulttype.def) and is_shortstring(pdc.paratype.def)) and not(is_shortstring(pt.resulttype.def) and is_shortstring(pdc.paratype.def)) and
(pdc.paratype.def.deftype<>formaldef) then (pdc.paratype.def.deftype<>formaldef) then
{Not convertable, def is no longer a candidate.} begin
exclude(candidates,i-1) {Not convertable, def is no longer a candidate.}
candidate_defs^[i]:=nil;
dec(candidates_left);
break;
end
else else
exclude(pt.callparaflags,cpf_nomatchfound) exclude(pt.callparaflags,cpf_nomatchfound)
else else
@ -1039,19 +1052,18 @@ implementation
((isconvertable(pt.resulttype.def,pdc.paratype.def, ((isconvertable(pt.resulttype.def,pdc.paratype.def,
hcvt,pt.left.nodetype,false)=0) and hcvt,pt.left.nodetype,false)=0) and
not is_equal(pt,pdc.paratype.def)) then not is_equal(pt,pdc.paratype.def)) then
{Not convertable, def is no longer a candidate.} begin
exclude(candidates,i-1) {Not convertable, def is no longer a candidate.}
candidate_defs^[i]:=nil;
dec(candidates_left);
break;
end
else else
exclude(pt.callparaflags,cpf_nomatchfound); exclude(pt.callparaflags,cpf_nomatchfound);
pdc:=Tparaitem(pdc.next); pdc:=Tparaitem(pdc.next);
pt:=Tcallparanode(pt.right); pt:=Tcallparanode(pt.right);
end; end;
end; end;
{Count the candidates that are left.}
candidates_left:=0;
for i:=1 to candidate_count do
if (i-1) in candidates then
inc(candidates_left);
{Are there any candidates left?} {Are there any candidates left?}
if candidates_left=0 then if candidates_left=0 then
begin begin
@ -1100,33 +1112,31 @@ implementation
{Find the first candidate.} {Find the first candidate.}
c1:=1; c1:=1;
while c1<=candidate_count do while c1<=candidate_count do
if (c1-1) in candidates then if assigned(candidate_defs^[c1]) then
break break
else else
inc(c1); inc(c1);
delete_mask:=[c1-1]; delete_start:=c1;
{Get information about candidate c1.} {Get information about candidate c1.}
get_candidate_information(cl2_count1,cl1_count1,equal_count1, get_candidate_information(cl2_count1,cl1_count1,equal_count1,
exact_count1,ordspace1,Tcallparanode(left), exact_count1,ordspace1,Tcallparanode(left),
Tparaitem(candidate_defs[c1-1].para.first)); Tparaitem(candidate_defs^[c1].para.first));
{Find the other candidates and eliminate the lesser ones.} {Find the other candidates and eliminate the lesser ones.}
c2:=c1+1; c2:=c1+1;
while c2<=candidate_count do while c2<=candidate_count do
if (c2-1) in candidates then if assigned(candidate_defs^[c2]) then
begin begin
{Candidate found, get information on it.} {Candidate found, get information on it.}
get_candidate_information(cl2_count2,cl1_count2,equal_count2, get_candidate_information(cl2_count2,cl1_count2,equal_count2,
exact_count2,ordspace2,Tcallparanode(left), exact_count2,ordspace2,Tcallparanode(left),
Tparaitem(candidate_defs[c2-1].para.first)); Tparaitem(candidate_defs^[c2].para.first));
{Is c1 the better candidate?} {Is c1 the better candidate?}
if (cl2_count1<cl2_count2) or if (cl2_count1<cl2_count2) or
((cl2_count1=cl2_count2) and (exact_count1>exact_count2)) or ((cl2_count1=cl2_count2) and (exact_count1>exact_count2)) or
((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1>equal_count2)) or ((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1>equal_count2)) or
((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1=equal_count2) and (ordspace1<ordspace2)) then ((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1=equal_count2) and (ordspace1<ordspace2)) then
begin {C1 is better, drop c2.}
{C1 is better, drop c2.} candidate_defs^[c2]:=nil
exclude(candidates,c2-1);
end
{Is c2 the better candidate?} {Is c2 the better candidate?}
else if (cl2_count2<cl2_count1) or else if (cl2_count2<cl2_count1) or
((cl2_count2=cl2_count1) and (exact_count2>exact_count1)) or ((cl2_count2=cl2_count1) and (exact_count2>exact_count1)) or
@ -1135,17 +1145,16 @@ implementation
begin begin
{C2 is better, drop all previous {C2 is better, drop all previous
candidates.} candidates.}
include(delete_mask,c1-1); for i:=delete_start to c2-1 do
candidates:=candidates-delete_mask; candidate_defs^[i]:=nil;
c1:=c2; delete_start:=c2;
cl2_count1:=cl2_count2; c1:=c2;
cl1_count1:=cl1_count2; cl2_count1:=cl2_count2;
equal_count1:=equal_count2; cl1_count1:=cl1_count2;
exact_count1:=exact_count2; equal_count1:=equal_count2;
ordspace1:=ordspace2; exact_count1:=exact_count2;
end ordspace1:=ordspace2;
else end;
include(delete_mask,c2-1);
{else the candidates have no advantage over each other, {else the candidates have no advantage over each other,
do nothing} do nothing}
inc(c2); inc(c2);
@ -1156,20 +1165,18 @@ implementation
{Count the candidates that are left.} {Count the candidates that are left.}
candidates_left:=0; candidates_left:=0;
for i:=1 to candidate_count do for i:=1 to candidate_count do
if (i-1) in candidates then if assigned(candidate_defs^[i]) then
begin
inc(candidates_left); inc(candidates_left);
procdefinition:=candidate_defs^[i];
end;
if candidates_left>1 then if candidates_left>1 then
begin begin
cgmessage(cg_e_cant_choose_overload_function); cgmessage(cg_e_cant_choose_overload_function);
symtableprocentry.write_parameter_lists(nil); symtableprocentry.write_parameter_lists(nil);
exit; exit;
end; end;
for i:=1 to candidate_count do freemem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
if (i-1) in candidates then
begin
procdefinition:=candidate_defs[i-1];
break;
end;
if make_ref then if make_ref then
begin begin
Tprocdef(procdefinition).lastref:=Tref.create(Tprocdef(procdefinition).lastref,@fileinfo); Tprocdef(procdefinition).lastref:=Tref.create(Tprocdef(procdefinition).lastref,@fileinfo);
@ -2587,7 +2594,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.89 2002-08-23 16:13:16 peter Revision 1.90 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.89 2002/08/23 16:13:16 peter
* also firstpass funcretrefnode if available. This was breaking the * also firstpass funcretrefnode if available. This was breaking the
asnode compilerproc code asnode compilerproc code

22
compiler/ncnv.pas
View File

@ -43,6 +43,9 @@ interface
function getcopy : tnode;override; function getcopy : tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
function docompare(p: tnode) : boolean; override; function docompare(p: tnode) : boolean; override;
private private
function resulttype_cord_to_pointer : tnode; function resulttype_cord_to_pointer : tnode;
@ -1319,6 +1322,14 @@ implementation
result:=resulttype_call_helper(convtype); result:=resulttype_call_helper(convtype);
end; end;
{$ifdef var_notification}
procedure Ttypeconvnode.mark_write;
begin
left.mark_write;
end;
{$endif}
function ttypeconvnode.first_cord_to_pointer : tnode; function ttypeconvnode.first_cord_to_pointer : tnode;
@ -2015,7 +2026,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.73 2002-08-23 16:14:49 peter Revision 1.74 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.73 2002/08/23 16:14:49 peter
* tempgen cleanup * tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode * tt_noreuse temp type added that will be used in genentrycode

48
compiler/nflw.pas
View File

@ -30,6 +30,9 @@ interface
uses uses
node,cpubase, node,cpubase,
aasmbase,aasmtai,aasmcpu, aasmbase,aasmtai,aasmcpu,
{$ifdef var_notification}
symnot,
{$endif}
symppu,symtype,symbase,symdef,symsym; symppu,symtype,symbase,symdef,symsym;
type type
@ -66,7 +69,13 @@ interface
tifnodeclass = class of tifnode; tifnodeclass = class of tifnode;
tfornode = class(tloopnode) tfornode = class(tloopnode)
{$ifdef var_notification}
loopvar_notid:cardinal;
{$endif}
constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual; constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
{$ifdef var_notification}
procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
{$endif}
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
end; end;
@ -622,6 +631,13 @@ implementation
include(flags,nf_testatbegin); include(flags,nf_testatbegin);
end; end;
{$ifdef var_notification}
procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
symbol:Tsym);
begin
end;
{$endif}
function tfornode.det_resulttype:tnode; function tfornode.det_resulttype:tnode;
var var
@ -656,24 +672,24 @@ implementation
set_varstate(left,false); set_varstate(left,false);
if assigned(t1) then if assigned(t1) then
begin begin
resulttypepass(t1); resulttypepass(t1);
if codegenerror then if codegenerror then
exit; exit;
end; end;
{ process count var } { process count var }
resulttypepass(t2); resulttypepass(t2);
set_varstate(t2,true); set_varstate(t2,true);
if codegenerror then if codegenerror then
exit; exit;
{ Check count var, record fields are also allowed in tp7 } { Check count var, record fields are also allowed in tp7 }
hp:=t2; hp:=t2;
while (hp.nodetype=subscriptn) or while (hp.nodetype=subscriptn) or
((hp.nodetype=vecn) and ((hp.nodetype=vecn) and
is_constintnode(tvecnode(hp).right)) do is_constintnode(tvecnode(hp).right)) do
hp:=tunarynode(hp).left; hp:=tunarynode(hp).left;
{ we need a simple loadn, but the load must be in a global symtable or { we need a simple loadn, but the load must be in a global symtable or
in the same lexlevel } in the same lexlevel }
if (hp.nodetype=funcretn) or if (hp.nodetype=funcretn) or
@ -688,11 +704,16 @@ implementation
CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected); CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
end end
else else
CGMessagePos(hp.fileinfo,cg_e_illegal_count_var); CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
resulttypepass(right); resulttypepass(right);
set_varstate(right,true); set_varstate(right,true);
inserttypeconv(right,t2.resulttype); inserttypeconv(right,t2.resulttype);
{$ifdef var_notification}
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}
end; end;
@ -1365,7 +1386,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.48 2002-08-22 15:15:20 daniel Revision 1.49 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.48 2002/08/22 15:15:20 daniel
* Fixed the detection wether the first check of a for loop can be skipped * Fixed the detection wether the first check of a for loop can be skipped
Revision 1.47 2002/08/19 19:36:43 peter Revision 1.47 2002/08/19 19:36:43 peter

38
compiler/nld.pas
View File

@ -38,6 +38,7 @@ interface
symtableentry : tsym; symtableentry : tsym;
symtable : tsymtable; symtable : tsymtable;
procdef : tprocdef; procdef : tprocdef;
write_access : boolean;
constructor create(v : tsym;st : tsymtable);virtual; constructor create(v : tsym;st : tsymtable);virtual;
constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual; constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@ -47,6 +48,9 @@ interface
function getcopy : tnode;override; function getcopy : tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
function docompare(p: tnode): boolean; override; function docompare(p: tnode): boolean; override;
{$ifdef extdebug} {$ifdef extdebug}
procedure _dowrite;override; procedure _dowrite;override;
@ -73,6 +77,7 @@ interface
tassignmentnodeclass = class of tassignmentnode; tassignmentnodeclass = class of tassignmentnode;
tfuncretnode = class(tnode) tfuncretnode = class(tnode)
write_access : boolean;
funcretsym : tfuncretsym; funcretsym : tfuncretsym;
constructor create(v:tsym);virtual; constructor create(v:tsym);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@ -81,6 +86,9 @@ interface
function getcopy : tnode;override; function getcopy : tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
function docompare(p: tnode): boolean; override; function docompare(p: tnode): boolean; override;
end; end;
tfuncretnodeclass = class of tfuncretnode; tfuncretnodeclass = class of tfuncretnode;
@ -351,6 +359,14 @@ implementation
end; end;
end; end;
{$ifdef var_notification}
procedure Tloadnode.mark_write;
begin
write_access:=true;
end;
{$endif}
function tloadnode.pass_1 : tnode; function tloadnode.pass_1 : tnode;
begin begin
@ -465,6 +481,9 @@ implementation
begin begin
inherited create(assignn,l,r); inherited create(assignn,l,r);
{$ifdef var_notification}
l.mark_write;
{$endif}
assigntype:=at_normal; assigntype:=at_normal;
end; end;
@ -621,7 +640,6 @@ implementation
test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def); test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
end; end;
function tassignmentnode.pass_1 : tnode; function tassignmentnode.pass_1 : tnode;
@ -717,6 +735,13 @@ implementation
resulttype:=funcretsym.returntype; resulttype:=funcretsym.returntype;
end; end;
{$ifdef var_notification}
procedure Tfuncretnode.mark_write;
begin
write_access:=true;
end;
{$endif}
function tfuncretnode.pass_1 : tnode; function tfuncretnode.pass_1 : tnode;
begin begin
@ -1120,7 +1145,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.54 2002-08-25 19:25:19 peter Revision 1.55 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.54 2002/08/25 19:25:19 peter
* sym.insert_in_data removed * sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added * symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be * removed insert_in_data call from symtable.insert, it needs to be

49
compiler/nmem.pas
View File

@ -77,14 +77,23 @@ interface
tdoubleaddrnodeclass = class of tdoubleaddrnode; tdoubleaddrnodeclass = class of tdoubleaddrnode;
tderefnode = class(tunarynode) tderefnode = class(tunarynode)
{$ifdef var_notification}
write_access:boolean;
{$endif}
constructor create(l : tnode);virtual; constructor create(l : tnode);virtual;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
end; end;
tderefnodeclass = class of tderefnode; tderefnodeclass = class of tderefnode;
tsubscriptnode = class(tunarynode) tsubscriptnode = class(tunarynode)
vs : tvarsym; vs : tvarsym;
{$ifdef var_notification}
write_access:boolean;
{$endif}
constructor create(varsym : tsym;l : tnode);virtual; constructor create(varsym : tsym;l : tnode);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -93,13 +102,20 @@ interface
function pass_1 : tnode;override; function pass_1 : tnode;override;
function docompare(p: tnode): boolean; override; function docompare(p: tnode): boolean; override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
end; end;
tsubscriptnodeclass = class of tsubscriptnode; tsubscriptnodeclass = class of tsubscriptnode;
tvecnode = class(tbinarynode) tvecnode = class(tbinarynode)
write_access:boolean;
constructor create(l,r : tnode);virtual; constructor create(l,r : tnode);virtual;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
{$ifdef var_notification}
procedure mark_write;override;
{$endif}
end; end;
tvecnodeclass = class of tvecnode; tvecnodeclass = class of tvecnode;
@ -569,6 +585,14 @@ implementation
CGMessage(cg_e_invalid_qualifier); CGMessage(cg_e_invalid_qualifier);
end; end;
{$ifdef var_notification}
procedure Tderefnode.mark_write;
begin
write_access:=true;
end;
{$endif}
function tderefnode.pass_1 : tnode; function tderefnode.pass_1 : tnode;
begin begin
result:=nil; result:=nil;
@ -638,6 +662,13 @@ implementation
resulttype:=vs.vartype; resulttype:=vs.vartype;
end; end;
{$ifdef var_notification}
procedure Tsubscriptnode.mark_write;
begin
write_access:=true;
end;
{$endif}
function tsubscriptnode.pass_1 : tnode; function tsubscriptnode.pass_1 : tnode;
begin begin
@ -752,6 +783,13 @@ implementation
CGMessage(type_e_array_required); CGMessage(type_e_array_required);
end; end;
{$ifdef var_notification}
procedure Tvecnode.mark_write;
begin
write_access:=true;
end;
{$endif}
function tvecnode.pass_1 : tnode; function tvecnode.pass_1 : tnode;
{$ifdef consteval} {$ifdef consteval}
@ -1020,7 +1058,16 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.36 2002-08-19 19:36:43 peter Revision 1.37 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.36 2002/08/19 19:36:43 peter
* More fixes for cross unit inlining, all tnodes are now implemented * More fixes for cross unit inlining, all tnodes are now implemented
* Moved pocall_internconst to po_internconst because it is not a * Moved pocall_internconst to po_internconst because it is not a
calling type at all and it conflicted when inlining of these small calling type at all and it conflicted when inlining of these small

32
compiler/node.pas
View File

@ -334,9 +334,14 @@ interface
{ dermines the number of necessary temp. locations to evaluate { dermines the number of necessary temp. locations to evaluate
the node } the node }
{$ifdef state_tracking} {$ifdef state_tracking}
{ Does optimizations by keeping track of the variable states { Does optimizations by keeping track of the variable states
in a procedure } in a procedure }
function track_state_pass(exec_known:boolean):boolean;virtual; function track_state_pass(exec_known:boolean):boolean;virtual;
{$endif}
{$ifdef var_notification}
{ For a t1:=t2 tree, mark the part of the tree t1 that gets
written to (normally the loadnode) as write access. }
procedure mark_write;virtual;
{$endif} {$endif}
procedure det_temp;virtual;abstract; procedure det_temp;virtual;abstract;
@ -713,6 +718,16 @@ implementation
fileinfo:=filepos; fileinfo:=filepos;
end; end;
{$ifdef var_notification}
{ For a t1:=t2 tree, mark the part of the tree t1 that gets
written to (normally the loadnode) as write access. }
procedure Tnode.mark_write;
begin
writenode(self);
runerror(211);
end;
{$endif}
{**************************************************************************** {****************************************************************************
TUNARYNODE TUNARYNODE
@ -973,7 +988,16 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.39 2002-08-22 11:21:45 florian Revision 1.40 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.39 2002/08/22 11:21:45 florian
+ register32 is now written by tnode.dowrite + register32 is now written by tnode.dowrite
* fixed write of value of tconstnode * fixed write of value of tconstnode

41
compiler/symsym.pas
View File

@ -34,6 +34,9 @@ interface
symconst,symbase,symtype,symdef, symconst,symbase,symtype,symdef,
{ ppu } { ppu }
ppu,symppu, ppu,symppu,
{$ifdef var_notification}
cclasses,symnot,
{$endif}
{ aasm } { aasm }
aasmbase,aasmtai,cpubase, aasmbase,aasmtai,cpubase,
globals globals
@ -170,6 +173,9 @@ interface
reg : tregister; { if reg<>R_NO, then the variable is an register variable } reg : tregister; { if reg<>R_NO, then the variable is an register variable }
varspez : tvarspez; { sets the type of access } varspez : tvarspez; { sets the type of access }
varstate : tvarstate; varstate : tvarstate;
{$ifdef var_notification}
notifications : Tlinkedlist;
{$endif}
constructor create(const n : string;const tt : ttype); constructor create(const n : string;const tt : ttype);
constructor create_dll(const n : string;const tt : ttype); constructor create_dll(const n : string;const tt : ttype);
constructor create_C(const n,mangled : string;const tt : ttype); constructor create_C(const n,mangled : string;const tt : ttype);
@ -182,6 +188,10 @@ interface
function getsize : longint; function getsize : longint;
function getvaluesize : longint; function getvaluesize : longint;
function getpushsize(is_cdecl:boolean): longint; function getpushsize(is_cdecl:boolean): longint;
{$ifdef var_notification}
function register_notification(flags:Tnotification_flags;
callback:Tnotification_callback):cardinal;
{$endif}
{$ifdef GDB} {$ifdef GDB}
function stabstring : pchar;override; function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override; procedure concatstabto(asmlist : taasmoutput);override;
@ -1536,7 +1546,11 @@ implementation
destructor tvarsym.destroy; destructor tvarsym.destroy;
begin begin
inherited destroy; {$ifdef var_notification}
if assigned(notifications) then
notifications.destroy;
{$endif}
inherited destroy;
end; end;
@ -1620,6 +1634,20 @@ implementation
end; end;
end; end;
{$ifdef var_notification}
function Tvarsym.register_notification(flags:Tnotification_flags;callback:
Tnotification_callback):cardinal;
var n:Tnotification;
begin
if not assigned(notifications) then
notifications:=Tlinkedlist.create;
n:=Tnotification.create(flags,callback);
register_notification:=n.id;
notifications.concat(n);
end;
{$endif}
{$ifdef GDB} {$ifdef GDB}
function tvarsym.stabstring : pchar; function tvarsym.stabstring : pchar;
@ -2415,7 +2443,16 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.57 2002-08-25 19:25:21 peter Revision 1.58 2002-09-01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.57 2002/08/25 19:25:21 peter
* sym.insert_in_data removed * sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added * symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be * removed insert_in_data call from symtable.insert, it needs to be