mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 20:29:18 +02:00
+ Added the beginning of a state tracker. This will track the values of
variables through procedures and optimize things away.
This commit is contained in:
parent
2502bdbf59
commit
eeae0e4c00
@ -34,6 +34,9 @@ interface
|
|||||||
constructor create(tt : tnodetype;l,r : tnode);override;
|
constructor create(tt : tnodetype;l,r : tnode);override;
|
||||||
function pass_1 : tnode;override;
|
function pass_1 : tnode;override;
|
||||||
function det_resulttype:tnode;override;
|
function det_resulttype:tnode;override;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure track_state_pass(exec_known:boolean);override;
|
||||||
|
{$endif}
|
||||||
protected
|
protected
|
||||||
{ override the following if you want to implement }
|
{ override the following if you want to implement }
|
||||||
{ parts explicitely in the code generator (JM) }
|
{ parts explicitely in the code generator (JM) }
|
||||||
@ -61,6 +64,9 @@ implementation
|
|||||||
cgbase,
|
cgbase,
|
||||||
htypechk,pass_1,
|
htypechk,pass_1,
|
||||||
nmat,ncnv,ncon,nset,nopt,ncal,ninl,
|
nmat,ncnv,ncon,nset,nopt,ncal,ninl,
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
nstate,
|
||||||
|
{$endif}
|
||||||
cpubase;
|
cpubase;
|
||||||
|
|
||||||
|
|
||||||
@ -94,6 +100,10 @@ implementation
|
|||||||
l1,l2 : longint;
|
l1,l2 : longint;
|
||||||
rv,lv : tconstexprint;
|
rv,lv : tconstexprint;
|
||||||
rvd,lvd : bestreal;
|
rvd,lvd : bestreal;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
factval : Tnode;
|
||||||
|
change : boolean;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
@ -1336,6 +1346,7 @@ implementation
|
|||||||
{ first do the two subtrees }
|
{ first do the two subtrees }
|
||||||
firstpass(left);
|
firstpass(left);
|
||||||
firstpass(right);
|
firstpass(right);
|
||||||
|
|
||||||
if codegenerror then
|
if codegenerror then
|
||||||
exit;
|
exit;
|
||||||
|
|
||||||
@ -1612,12 +1623,37 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Taddnode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
var factval:Tnode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
factval:=aktstate.find_fact(left);
|
||||||
|
if factval<>nil then
|
||||||
|
begin
|
||||||
|
left.destroy;
|
||||||
|
left:=factval.getcopy;
|
||||||
|
end;
|
||||||
|
factval:=aktstate.find_fact(right);
|
||||||
|
if factval<>nil then
|
||||||
|
begin
|
||||||
|
right.destroy;
|
||||||
|
right:=factval.getcopy;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
caddnode:=taddnode;
|
caddnode:=taddnode;
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.51 2002-05-18 13:34:08 peter
|
Revision 1.52 2002-07-14 18:00:43 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.51 2002/05/18 13:34:08 peter
|
||||||
* readded missing revisions
|
* readded missing revisions
|
||||||
|
|
||||||
Revision 1.50 2002/05/16 19:46:37 carl
|
Revision 1.50 2002/05/16 19:46:37 carl
|
||||||
|
@ -69,6 +69,9 @@ interface
|
|||||||
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 state_tracking}
|
||||||
|
procedure track_state_pass(exec_known:boolean);override;
|
||||||
|
{$endif state_tracking}
|
||||||
end;
|
end;
|
||||||
tblocknodeclass = class of tblocknode;
|
tblocknodeclass = class of tblocknode;
|
||||||
|
|
||||||
@ -433,6 +436,20 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Tblocknode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
var hp:Tstatementnode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
hp:=Tstatementnode(left);
|
||||||
|
while assigned(hp) do
|
||||||
|
begin
|
||||||
|
hp.right.track_state_pass(exec_known);
|
||||||
|
hp:=Tstatementnode(hp.left);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif state_tracking}
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TASMNODE
|
TASMNODE
|
||||||
@ -675,7 +692,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.27 2002-07-01 18:46:22 peter
|
Revision 1.28 2002-07-14 18:00:43 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.27 2002/07/01 18:46:22 peter
|
||||||
* internal linker
|
* internal linker
|
||||||
* reorganized aasm layer
|
* reorganized aasm layer
|
||||||
|
|
||||||
|
@ -29,6 +29,9 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
node,
|
node,
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
nstate,
|
||||||
|
{$endif state_tracking}
|
||||||
symbase,symtype,symsym,symdef,symtable;
|
symbase,symtype,symsym,symdef,symtable;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -63,6 +66,9 @@ interface
|
|||||||
procedure insertintolist(l : tnodelist);override;
|
procedure insertintolist(l : tnodelist);override;
|
||||||
function pass_1 : tnode;override;
|
function pass_1 : tnode;override;
|
||||||
function det_resulttype:tnode;override;
|
function det_resulttype:tnode;override;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure track_state_pass(exec_known:boolean);override;
|
||||||
|
{$endif state_tracking}
|
||||||
function docompare(p: tnode): boolean; override;
|
function docompare(p: tnode): boolean; override;
|
||||||
procedure set_procvar(procvar:tnode);
|
procedure set_procvar(procvar:tnode);
|
||||||
end;
|
end;
|
||||||
@ -123,7 +129,7 @@ implementation
|
|||||||
uses
|
uses
|
||||||
cutils,globtype,systems,
|
cutils,globtype,systems,
|
||||||
verbose,globals,
|
verbose,globals,
|
||||||
symconst,paramgr,types,
|
symconst,types,
|
||||||
htypechk,pass_1,cpuinfo,cpubase,
|
htypechk,pass_1,cpuinfo,cpubase,
|
||||||
ncnv,nld,ninl,nadd,ncon,
|
ncnv,nld,ninl,nadd,ncon,
|
||||||
rgobj,cgbase
|
rgobj,cgbase
|
||||||
@ -364,7 +370,7 @@ implementation
|
|||||||
if not(assigned(aktcallprocdef) and
|
if not(assigned(aktcallprocdef) and
|
||||||
(aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
|
(aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
|
||||||
(po_external in aktcallprocdef.procoptions)) and
|
(po_external in aktcallprocdef.procoptions)) and
|
||||||
paramanager.push_high_param(defcoll.paratype.def) then
|
push_high_param(defcoll.paratype.def) then
|
||||||
gen_high_tree(is_open_string(defcoll.paratype.def));
|
gen_high_tree(is_open_string(defcoll.paratype.def));
|
||||||
|
|
||||||
{ test conversions }
|
{ test conversions }
|
||||||
@ -411,7 +417,7 @@ implementation
|
|||||||
left.resulttype.def.typename,defcoll.paratype.def.typename);
|
left.resulttype.def.typename,defcoll.paratype.def.typename);
|
||||||
end;
|
end;
|
||||||
{ Process open parameters }
|
{ Process open parameters }
|
||||||
if paramanager.push_high_param(defcoll.paratype.def) then
|
if push_high_param(defcoll.paratype.def) then
|
||||||
begin
|
begin
|
||||||
{ insert type conv but hold the ranges of the array }
|
{ insert type conv but hold the ranges of the array }
|
||||||
oldtype:=left.resulttype;
|
oldtype:=left.resulttype;
|
||||||
@ -676,7 +682,7 @@ implementation
|
|||||||
restypeset := true;
|
restypeset := true;
|
||||||
{ both the normal and specified resulttype either have to be returned via a }
|
{ both the normal and specified resulttype either have to be returned via a }
|
||||||
{ parameter or not, but no mixing (JM) }
|
{ parameter or not, but no mixing (JM) }
|
||||||
if paramanager.ret_in_param(restype.def) xor paramanager.ret_in_param(symtableprocentry.defs^.def.rettype.def) then
|
if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.defs^.def.rettype.def) then
|
||||||
internalerror(200108291);
|
internalerror(200108291);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -685,7 +691,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
self.createintern(name,params);
|
self.createintern(name,params);
|
||||||
funcretrefnode:=returnnode;
|
funcretrefnode:=returnnode;
|
||||||
if not paramanager.ret_in_param(symtableprocentry.defs^.def.rettype.def) then
|
if not ret_in_param(symtableprocentry.defs^.def.rettype.def) then
|
||||||
internalerror(200204247);
|
internalerror(200204247);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1503,7 +1509,7 @@ implementation
|
|||||||
{ get a register for the return value }
|
{ get a register for the return value }
|
||||||
if (not is_void(resulttype.def)) then
|
if (not is_void(resulttype.def)) then
|
||||||
begin
|
begin
|
||||||
if paramanager.ret_in_acc(resulttype.def) then
|
if ret_in_acc(resulttype.def) then
|
||||||
begin
|
begin
|
||||||
{ wide- and ansistrings are returned in EAX }
|
{ wide- and ansistrings are returned in EAX }
|
||||||
{ but they are imm. moved to a memory location }
|
{ but they are imm. moved to a memory location }
|
||||||
@ -1638,7 +1644,7 @@ implementation
|
|||||||
{ get a register for the return value }
|
{ get a register for the return value }
|
||||||
if (not is_void(resulttype.def)) then
|
if (not is_void(resulttype.def)) then
|
||||||
begin
|
begin
|
||||||
if paramanager.ret_in_param(resulttype.def) then
|
if ret_in_param(resulttype.def) then
|
||||||
begin
|
begin
|
||||||
location.loc:=LOC_CREFERENCE;
|
location.loc:=LOC_CREFERENCE;
|
||||||
end
|
end
|
||||||
@ -1776,6 +1782,26 @@ implementation
|
|||||||
procdefinition.proccalloption:=pocall_inline;
|
procdefinition.proccalloption:=pocall_inline;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Tcallnode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
var hp:Tcallparanode;
|
||||||
|
value:Tnode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
hp:=Tcallparanode(left);
|
||||||
|
while assigned(hp) do
|
||||||
|
begin
|
||||||
|
value:=aktstate.find_fact(hp.left);
|
||||||
|
if value<>nil then
|
||||||
|
begin
|
||||||
|
hp.left.destroy;
|
||||||
|
hp.left:=value.getcopy;
|
||||||
|
end;
|
||||||
|
hp:=Tcallparanode(hp.right);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
function tcallnode.docompare(p: tnode): boolean;
|
function tcallnode.docompare(p: tnode): boolean;
|
||||||
begin
|
begin
|
||||||
@ -1802,7 +1828,7 @@ implementation
|
|||||||
retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
|
retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
|
||||||
para_offset:=0;
|
para_offset:=0;
|
||||||
para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
|
para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
|
||||||
if paramanager.ret_in_param(inlineprocdef.rettype.def) then
|
if ret_in_param(inlineprocdef.rettype.def) then
|
||||||
inc(para_size,POINTER_SIZE);
|
inc(para_size,POINTER_SIZE);
|
||||||
{ copy args }
|
{ copy args }
|
||||||
if assigned(code) then
|
if assigned(code) then
|
||||||
@ -1870,8 +1896,9 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.79 2002-07-11 14:41:27 florian
|
Revision 1.80 2002-07-14 18:00:43 daniel
|
||||||
* start of the new generic parameter handling
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
Revision 1.78 2002/07/04 20:43:00 florian
|
Revision 1.78 2002/07/04 20:43:00 florian
|
||||||
* first x86-64 patches
|
* first x86-64 patches
|
||||||
|
@ -53,6 +53,9 @@ interface
|
|||||||
function pass_1 : tnode;override;
|
function pass_1 : tnode;override;
|
||||||
function det_resulttype:tnode;override;
|
function det_resulttype:tnode;override;
|
||||||
function docompare(p: tnode) : boolean; override;
|
function docompare(p: tnode) : boolean; override;
|
||||||
|
{$ifdef extdebug}
|
||||||
|
procedure dowrite;override;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
tordconstnodeclass = class of tordconstnode;
|
tordconstnodeclass = class of tordconstnode;
|
||||||
|
|
||||||
@ -398,6 +401,15 @@ implementation
|
|||||||
(value = tordconstnode(p).value);
|
(value = tordconstnode(p).value);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef extdebug}
|
||||||
|
procedure Tordconstnode.dowrite;
|
||||||
|
|
||||||
|
begin
|
||||||
|
inherited dowrite;
|
||||||
|
write('[',value,']');
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TPOINTERCONSTNODE
|
TPOINTERCONSTNODE
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -721,7 +733,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.33 2002-07-01 18:46:23 peter
|
Revision 1.34 2002-07-14 18:00:43 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.33 2002/07/01 18:46:23 peter
|
||||||
* internal linker
|
* internal linker
|
||||||
* reorganized aasm layer
|
* reorganized aasm layer
|
||||||
|
|
||||||
|
@ -47,6 +47,9 @@ interface
|
|||||||
twhilerepeatnode = class(tloopnode)
|
twhilerepeatnode = class(tloopnode)
|
||||||
function det_resulttype:tnode;override;
|
function det_resulttype:tnode;override;
|
||||||
function pass_1 : tnode;override;
|
function pass_1 : tnode;override;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure track_state_pass(exec_known:boolean);override;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
twhilerepeatnodeclass = class of twhilerepeatnode;
|
twhilerepeatnodeclass = class of twhilerepeatnode;
|
||||||
|
|
||||||
@ -178,8 +181,11 @@ implementation
|
|||||||
uses
|
uses
|
||||||
globtype,systems,
|
globtype,systems,
|
||||||
cutils,verbose,globals,
|
cutils,verbose,globals,
|
||||||
symconst,symtable,paramgr,types,htypechk,pass_1,
|
symconst,symtable,types,htypechk,pass_1,
|
||||||
ncon,nmem,nld,ncnv,nbas,rgobj,
|
ncon,nmem,nld,ncnv,nbas,rgobj,
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
nstate,
|
||||||
|
{$endif}
|
||||||
cgbase
|
cgbase
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -330,6 +336,53 @@ implementation
|
|||||||
rg.t_times:=old_t_times;
|
rg.t_times:=old_t_times;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Twhilerepeatnode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
var condition:Tnode;
|
||||||
|
code:Tnode;
|
||||||
|
done:boolean;
|
||||||
|
value:boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
done:=false;
|
||||||
|
repeat
|
||||||
|
condition:=left.getcopy;
|
||||||
|
condition.track_state_pass(exec_known);
|
||||||
|
{Force new resulttype pass.}
|
||||||
|
condition.resulttype.def:=nil;
|
||||||
|
do_resulttypepass(condition);
|
||||||
|
code:=right.getcopy;
|
||||||
|
if is_constboolnode(condition) then
|
||||||
|
begin
|
||||||
|
value:=Tordconstnode(condition).value<>0;
|
||||||
|
if value then
|
||||||
|
code.track_state_pass(exec_known)
|
||||||
|
else
|
||||||
|
done:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{Remove any modified variables from the state.}
|
||||||
|
code.track_state_pass(false);
|
||||||
|
code.destroy;
|
||||||
|
condition.destroy;
|
||||||
|
until done;
|
||||||
|
{The loop condition is also known, for example:
|
||||||
|
while i<10 do
|
||||||
|
begin
|
||||||
|
...
|
||||||
|
end;
|
||||||
|
|
||||||
|
When the loop is done, we do know that i<10 = false.
|
||||||
|
}
|
||||||
|
condition:=left.getcopy;
|
||||||
|
condition.track_state_pass(exec_known);
|
||||||
|
{Force new resulttype pass.}
|
||||||
|
condition.resulttype.def:=nil;
|
||||||
|
do_resulttypepass(condition);
|
||||||
|
aktstate.store_fact(condition,cordconstnode.create(0,booltype));
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TIFNODE
|
TIFNODE
|
||||||
@ -607,7 +660,7 @@ implementation
|
|||||||
if assigned(left) then
|
if assigned(left) then
|
||||||
begin
|
begin
|
||||||
inserttypeconv(left,aktprocdef.rettype);
|
inserttypeconv(left,aktprocdef.rettype);
|
||||||
if paramanager.ret_in_param(aktprocdef.rettype.def) or
|
if ret_in_param(aktprocdef.rettype.def) or
|
||||||
(procinfo^.no_fast_exit) or
|
(procinfo^.no_fast_exit) or
|
||||||
((procinfo^.flags and pi_uses_exceptions)<>0) then
|
((procinfo^.flags and pi_uses_exceptions)<>0) then
|
||||||
begin
|
begin
|
||||||
@ -1113,8 +1166,9 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.34 2002-07-11 14:41:28 florian
|
Revision 1.35 2002-07-14 18:00:44 daniel
|
||||||
* start of the new generic parameter handling
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
Revision 1.33 2002/07/01 18:46:23 peter
|
Revision 1.33 2002/07/01 18:46:23 peter
|
||||||
* internal linker
|
* internal linker
|
||||||
|
@ -28,6 +28,9 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
node,
|
node,
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
nstate,
|
||||||
|
{$endif}
|
||||||
symconst,symbase,symtype,symsym,symdef;
|
symconst,symbase,symtype,symsym,symdef;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -54,6 +57,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 state_tracking}
|
||||||
|
procedure track_state_pass(exec_known:boolean);override;
|
||||||
|
{$endif state_tracking}
|
||||||
function docompare(p: tnode): boolean; override;
|
function docompare(p: tnode): boolean; override;
|
||||||
end;
|
end;
|
||||||
tassignmentnodeclass = class of tassignmentnode;
|
tassignmentnodeclass = class of tassignmentnode;
|
||||||
@ -122,7 +128,7 @@ implementation
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
cutils,verbose,globtype,globals,systems,
|
cutils,verbose,globtype,globals,systems,
|
||||||
symtable,paramgr,types,
|
symtable,types,
|
||||||
htypechk,pass_1,
|
htypechk,pass_1,
|
||||||
ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
|
ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
|
||||||
;
|
;
|
||||||
@ -345,7 +351,7 @@ implementation
|
|||||||
{ we need a register for call by reference parameters }
|
{ we need a register for call by reference parameters }
|
||||||
if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
|
if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
|
||||||
((tvarsym(symtableentry).varspez=vs_const) and
|
((tvarsym(symtableentry).varspez=vs_const) and
|
||||||
paramanager.push_addr_param(tvarsym(symtableentry).vartype.def)) or
|
push_addr_param(tvarsym(symtableentry).vartype.def)) or
|
||||||
{ call by value open arrays are also indirect addressed }
|
{ call by value open arrays are also indirect addressed }
|
||||||
is_open_array(tvarsym(symtableentry).vartype.def) then
|
is_open_array(tvarsym(symtableentry).vartype.def) then
|
||||||
registers32:=1;
|
registers32:=1;
|
||||||
@ -547,6 +553,8 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tassignmentnode.pass_1 : tnode;
|
function tassignmentnode.pass_1 : tnode;
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
|
|
||||||
@ -569,6 +577,26 @@ implementation
|
|||||||
(assigntype = tassignmentnode(p).assigntype);
|
(assigntype = tassignmentnode(p).assigntype);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Tassignmentnode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
var se:Tstate_entry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if exec_known then
|
||||||
|
begin
|
||||||
|
right.track_state_pass(exec_known);
|
||||||
|
{Force a new resulttype pass.}
|
||||||
|
right.resulttype.def:=nil;
|
||||||
|
do_resulttypepass(right);
|
||||||
|
resulttypepass(right);
|
||||||
|
aktstate.store_fact(left.getcopy,right.getcopy);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
aktstate.delete_fact(left);
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TFUNCRETNODE
|
TFUNCRETNODE
|
||||||
@ -603,7 +631,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
location.loc:=LOC_REFERENCE;
|
location.loc:=LOC_REFERENCE;
|
||||||
if paramanager.ret_in_param(resulttype.def) or
|
if ret_in_param(resulttype.def) or
|
||||||
(lexlevel<>funcretsym.owner.symtablelevel) then
|
(lexlevel<>funcretsym.owner.symtablelevel) then
|
||||||
registers32:=1;
|
registers32:=1;
|
||||||
end;
|
end;
|
||||||
@ -955,8 +983,9 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.43 2002-07-11 14:41:28 florian
|
Revision 1.44 2002-07-14 18:00:44 daniel
|
||||||
* start of the new generic parameter handling
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
Revision 1.42 2002/05/18 13:34:10 peter
|
Revision 1.42 2002/05/18 13:34:10 peter
|
||||||
* readded missing revisions
|
* readded missing revisions
|
||||||
|
@ -329,6 +329,11 @@ interface
|
|||||||
function det_resulttype : tnode;virtual;abstract;
|
function det_resulttype : tnode;virtual;abstract;
|
||||||
{ 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}
|
||||||
|
{ Does optimizations by keeping track of the variable states
|
||||||
|
in a procedure }
|
||||||
|
procedure track_state_pass(exec_known:boolean);virtual;
|
||||||
|
{$endif}
|
||||||
procedure det_temp;virtual;abstract;
|
procedure det_temp;virtual;abstract;
|
||||||
|
|
||||||
procedure pass_2;virtual;abstract;
|
procedure pass_2;virtual;abstract;
|
||||||
@ -516,6 +521,13 @@ implementation
|
|||||||
docompare(p));
|
docompare(p));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure Tnode.track_state_pass(exec_known:boolean);
|
||||||
|
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
{$endif state_tracking}
|
||||||
|
|
||||||
function tnode.docompare(p : tnode) : boolean;
|
function tnode.docompare(p : tnode) : boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -806,7 +818,11 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.28 2002-07-01 18:46:24 peter
|
Revision 1.29 2002-07-14 18:00:44 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.28 2002/07/01 18:46:24 peter
|
||||||
* internal linker
|
* internal linker
|
||||||
* reorganized aasm layer
|
* reorganized aasm layer
|
||||||
|
|
||||||
|
132
compiler/nstate.pas
Normal file
132
compiler/nstate.pas
Normal file
@ -0,0 +1,132 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1998-2002 by Daniel Mantione
|
||||||
|
|
||||||
|
This unit contains support routines for the state tracker
|
||||||
|
|
||||||
|
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 nstate;
|
||||||
|
|
||||||
|
{$i fpcdefs.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses cclasses,node;
|
||||||
|
|
||||||
|
type Tstate_entry=class(Tlinkedlistitem)
|
||||||
|
what:Tnode;
|
||||||
|
value:Tnode;
|
||||||
|
constructor create(w,v:Tnode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Tstate_storage=class
|
||||||
|
storage:Tlinkedlist;
|
||||||
|
constructor create;
|
||||||
|
procedure store_fact(w,v:Tnode);
|
||||||
|
function find_fact(what:Tnode):Tnode;
|
||||||
|
procedure delete_fact(what:Tnode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var aktstate:Tstate_storage;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor Tstate_entry.create(w,v:Tnode);
|
||||||
|
|
||||||
|
begin
|
||||||
|
inherited create;
|
||||||
|
what:=w;
|
||||||
|
value:=v;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor Tstate_storage.create;
|
||||||
|
|
||||||
|
begin
|
||||||
|
storage:=Tlinkedlist.create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Tstate_storage.store_fact(w,v:Tnode);
|
||||||
|
|
||||||
|
var se:Tstate_entry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ writeln('fact:');
|
||||||
|
writenode(w);
|
||||||
|
writeln('=');
|
||||||
|
writenode(v);}
|
||||||
|
se:=Tstate_entry(storage.first);
|
||||||
|
while assigned(se) do
|
||||||
|
begin
|
||||||
|
if se.what.isequal(w) then
|
||||||
|
begin
|
||||||
|
storage.remove(se);
|
||||||
|
se.destroy;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
se:=Tstate_entry(se.next);
|
||||||
|
end;
|
||||||
|
se:=Tstate_entry.create(w,v);
|
||||||
|
storage.concat(se);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Tstate_storage.find_fact(what:Tnode):Tnode;
|
||||||
|
|
||||||
|
var se:Tstate_entry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
find_fact:=nil;
|
||||||
|
se:=storage.first as Tstate_entry;
|
||||||
|
while assigned(se) do
|
||||||
|
begin
|
||||||
|
if se.what.isequal(what) then
|
||||||
|
begin
|
||||||
|
find_fact:=se.value;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
se:=se.next as Tstate_entry;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Tstate_storage.delete_fact(what:Tnode);
|
||||||
|
|
||||||
|
var se:Tstate_entry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
se:=storage.first as Tstate_entry;
|
||||||
|
while assigned(se) do
|
||||||
|
begin
|
||||||
|
if se.what.isequal(what) then
|
||||||
|
begin
|
||||||
|
storage.remove(se);
|
||||||
|
se.destroy;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
se:=se.next as Tstate_entry;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2002-07-14 18:00:44 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
@ -307,11 +307,26 @@ uses
|
|||||||
end;*)
|
end;*)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function gen_section_header(sec:Tsection;obj:cardinal):Tlxobject_table_entry;
|
||||||
|
virtual_size:cardinal;
|
||||||
|
reloc_base_addr:cardinal;
|
||||||
|
object_flags:Tlxobject_flag_set;
|
||||||
|
page_table_index:cardinal;
|
||||||
|
page_count:cardinal;
|
||||||
|
reserved:cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
gen_section_header.virtual_size:=sections[sec.memsize];
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
function Tlxexeoutput.writedata:boolean;
|
function Tlxexeoutput.writedata:boolean;
|
||||||
|
|
||||||
var header:Tlxheader;
|
var header:Tlxheader;
|
||||||
hsym:Tasmsymbol;
|
hsym:Tasmsymbol;
|
||||||
|
code_object_header,data_object_header,bss_object_header,stack_object_header,
|
||||||
|
heap_object_header:Tlxobject_table_entry;
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
@ -321,6 +336,7 @@ begin
|
|||||||
header.os_type:=1; {OS/2}
|
header.os_type:=1; {OS/2}
|
||||||
{Set the initial EIP.}
|
{Set the initial EIP.}
|
||||||
header.eip_object:=code_object;
|
header.eip_object:=code_object;
|
||||||
|
hsym:=tasmsymbol(globalsyms.search('start'));
|
||||||
if not assigned(hsym) then
|
if not assigned(hsym) then
|
||||||
begin
|
begin
|
||||||
comment(V_Error,'Entrypoint "start" not defined');
|
comment(V_Error,'Entrypoint "start" not defined');
|
||||||
@ -329,7 +345,18 @@ begin
|
|||||||
header.eip:=hsym.address-sections[sec_code].mempos;
|
header.eip:=hsym.address-sections[sec_code].mempos;
|
||||||
{Set the initial ESP.}
|
{Set the initial ESP.}
|
||||||
header.esp_object:=stack_object;
|
header.esp_object:=stack_object;
|
||||||
|
header.esp:=stacksize;
|
||||||
Fwriter.write(header,sizeof(header));
|
Fwriter.write(header,sizeof(header));
|
||||||
|
for sec:=low(Tsection) to high(Tsection) do
|
||||||
|
if sections[sec].available then
|
||||||
|
if not(sec in [sec_code,sec_data,sec_bss,sec_stab,sec_stabstr]) then
|
||||||
|
begin
|
||||||
|
result:=false;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
code_object_header:=gen_section_header(sec_code,code_object);
|
||||||
|
data_object_header:=gen_section_header(sec_data,data_object);
|
||||||
|
bss_object_header:=gen_section_header(sec_bss,bss_object);
|
||||||
result:=true;
|
result:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -372,7 +399,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 2002-07-11 15:23:25 daniel
|
Revision 1.3 2002-07-14 18:00:44 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.2 2002/07/11 15:23:25 daniel
|
||||||
* Continued work on LX header
|
* Continued work on LX header
|
||||||
|
|
||||||
Revision 1.1 2002/07/08 19:22:22 daniel
|
Revision 1.1 2002/07/08 19:22:22 daniel
|
||||||
|
@ -38,12 +38,15 @@ interface
|
|||||||
|
|
||||||
procedure firstpass(var p : tnode);
|
procedure firstpass(var p : tnode);
|
||||||
function do_firstpass(var p : tnode) : boolean;
|
function do_firstpass(var p : tnode) : boolean;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure do_track_state_pass(p:Tnode);
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
globtype,systems,
|
globtype,systems,cclasses,
|
||||||
cutils,globals,
|
cutils,globals,
|
||||||
cgbase,symdef,
|
cgbase,symdef,
|
||||||
{$ifdef extdebug}
|
{$ifdef extdebug}
|
||||||
@ -194,10 +197,22 @@ implementation
|
|||||||
do_firstpass:=codegenerror;
|
do_firstpass:=codegenerror;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
procedure do_track_state_pass(p:Tnode);
|
||||||
|
|
||||||
|
begin
|
||||||
|
p.track_state_pass(true);
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.24 2002-06-16 08:15:54 carl
|
Revision 1.25 2002-07-14 18:00:44 daniel
|
||||||
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
|
Revision 1.24 2002/06/16 08:15:54 carl
|
||||||
* commented out uncompilable debug code
|
* commented out uncompilable debug code
|
||||||
|
|
||||||
Revision 1.23 2002/05/18 13:34:11 peter
|
Revision 1.23 2002/05/18 13:34:11 peter
|
||||||
|
@ -46,12 +46,15 @@ implementation
|
|||||||
{ aasm }
|
{ aasm }
|
||||||
cpubase,cpuinfo,aasmbase,aasmtai,
|
cpubase,cpuinfo,aasmbase,aasmtai,
|
||||||
{ symtable }
|
{ symtable }
|
||||||
symconst,symbase,symdef,symsym,symtype,symtable,types,paramgr,
|
symconst,symbase,symdef,symsym,symtype,symtable,types,
|
||||||
ppu,fmodule,
|
ppu,fmodule,
|
||||||
{ pass 1 }
|
{ pass 1 }
|
||||||
node,
|
node,
|
||||||
nbas,
|
nbas,
|
||||||
pass_1,
|
pass_1,
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
nstate,
|
||||||
|
{$endif state_tracking}
|
||||||
{ pass 2 }
|
{ pass 2 }
|
||||||
{$ifndef NOPASS2}
|
{$ifndef NOPASS2}
|
||||||
pass_2,
|
pass_2,
|
||||||
@ -103,7 +106,7 @@ implementation
|
|||||||
{ insert in local symtable }
|
{ insert in local symtable }
|
||||||
symtablestack.insert(aktprocdef.funcretsym);
|
symtablestack.insert(aktprocdef.funcretsym);
|
||||||
akttokenpos:=storepos;
|
akttokenpos:=storepos;
|
||||||
if paramanager.ret_in_acc(aktprocdef.rettype.def) or
|
if ret_in_acc(aktprocdef.rettype.def) or
|
||||||
(aktprocdef.rettype.def.deftype=floatdef) then
|
(aktprocdef.rettype.def.deftype=floatdef) then
|
||||||
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
||||||
{ insert result also if support is on }
|
{ insert result also if support is on }
|
||||||
@ -127,7 +130,7 @@ implementation
|
|||||||
{ because we don't know yet where the address is }
|
{ because we don't know yet where the address is }
|
||||||
if not is_void(aktprocdef.rettype.def) then
|
if not is_void(aktprocdef.rettype.def) then
|
||||||
begin
|
begin
|
||||||
if paramanager.ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
|
if ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
|
||||||
begin
|
begin
|
||||||
{ the space has been set in the local symtable }
|
{ the space has been set in the local symtable }
|
||||||
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
||||||
@ -244,6 +247,9 @@ implementation
|
|||||||
block_type:=bt_general;
|
block_type:=bt_general;
|
||||||
aktbreaklabel:=nil;
|
aktbreaklabel:=nil;
|
||||||
aktcontinuelabel:=nil;
|
aktcontinuelabel:=nil;
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
aktstate:=Tstate_storage.create;
|
||||||
|
{$endif state_tracking}
|
||||||
|
|
||||||
{ insert symtables for the class, by only if it is no nested function }
|
{ insert symtables for the class, by only if it is no nested function }
|
||||||
if assigned(procinfo^._class) and not(parent_has_class) then
|
if assigned(procinfo^._class) and not(parent_has_class) then
|
||||||
@ -313,6 +319,10 @@ implementation
|
|||||||
{ the procedure is now defined }
|
{ the procedure is now defined }
|
||||||
aktprocdef.forwarddef:=false;
|
aktprocdef.forwarddef:=false;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
do_track_state_pass(code);
|
||||||
|
{$endif}
|
||||||
|
|
||||||
{ only generate the code if no type errors are found, else
|
{ only generate the code if no type errors are found, else
|
||||||
finish at least the type checking pass }
|
finish at least the type checking pass }
|
||||||
{$ifndef NOPASS2}
|
{$ifndef NOPASS2}
|
||||||
@ -445,6 +455,9 @@ implementation
|
|||||||
|
|
||||||
aktmaxfpuregisters:=oldaktmaxfpuregisters;
|
aktmaxfpuregisters:=oldaktmaxfpuregisters;
|
||||||
|
|
||||||
|
{$ifdef state_tracking}
|
||||||
|
aktstate.destroy;
|
||||||
|
{$endif state_tracking}
|
||||||
{ restore filepos, the switches are already set }
|
{ restore filepos, the switches are already set }
|
||||||
aktfilepos:=savepos;
|
aktfilepos:=savepos;
|
||||||
{ restore labels }
|
{ restore labels }
|
||||||
@ -641,7 +654,7 @@ implementation
|
|||||||
{$endif i386}
|
{$endif i386}
|
||||||
|
|
||||||
{ pointer to the return value ? }
|
{ pointer to the return value ? }
|
||||||
if paramanager.ret_in_param(aktprocdef.rettype.def) then
|
if ret_in_param(aktprocdef.rettype.def) then
|
||||||
begin
|
begin
|
||||||
procinfo^.return_offset:=procinfo^.para_offset;
|
procinfo^.return_offset:=procinfo^.para_offset;
|
||||||
inc(procinfo^.para_offset,pointer_size);
|
inc(procinfo^.para_offset,pointer_size);
|
||||||
@ -816,8 +829,9 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.57 2002-07-11 14:41:28 florian
|
Revision 1.58 2002-07-14 18:00:44 daniel
|
||||||
* start of the new generic parameter handling
|
+ Added the beginning of a state tracker. This will track the values of
|
||||||
|
variables through procedures and optimize things away.
|
||||||
|
|
||||||
Revision 1.56 2002/07/07 09:52:32 florian
|
Revision 1.56 2002/07/07 09:52:32 florian
|
||||||
* powerpc target fixed, very simple units can be compiled
|
* powerpc target fixed, very simple units can be compiled
|
||||||
|
Loading…
Reference in New Issue
Block a user