mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 16:49:00 +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:
daniel
parent
2502bdbf59
commit
eeae0e4c00
@ -34,6 +34,9 @@ interface
|
||||
constructor create(tt : tnodetype;l,r : tnode);override;
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
{$ifdef state_tracking}
|
||||
procedure track_state_pass(exec_known:boolean);override;
|
||||
{$endif}
|
||||
protected
|
||||
{ override the following if you want to implement }
|
||||
{ parts explicitely in the code generator (JM) }
|
||||
@ -61,6 +64,9 @@ implementation
|
||||
cgbase,
|
||||
htypechk,pass_1,
|
||||
nmat,ncnv,ncon,nset,nopt,ncal,ninl,
|
||||
{$ifdef state_tracking}
|
||||
nstate,
|
||||
{$endif}
|
||||
cpubase;
|
||||
|
||||
|
||||
@ -94,6 +100,10 @@ implementation
|
||||
l1,l2 : longint;
|
||||
rv,lv : tconstexprint;
|
||||
rvd,lvd : bestreal;
|
||||
{$ifdef state_tracking}
|
||||
factval : Tnode;
|
||||
change : boolean;
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
result:=nil;
|
||||
@ -1336,6 +1346,7 @@ implementation
|
||||
{ first do the two subtrees }
|
||||
firstpass(left);
|
||||
firstpass(right);
|
||||
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
@ -1612,12 +1623,37 @@ implementation
|
||||
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
|
||||
caddnode:=taddnode;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.50 2002/05/16 19:46:37 carl
|
||||
|
||||
@ -69,6 +69,9 @@ interface
|
||||
constructor create(l : tnode);virtual;
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
{$ifdef state_tracking}
|
||||
procedure track_state_pass(exec_known:boolean);override;
|
||||
{$endif state_tracking}
|
||||
end;
|
||||
tblocknodeclass = class of tblocknode;
|
||||
|
||||
@ -290,7 +293,7 @@ implementation
|
||||
registersmmx:=right.registersmmx;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef extdebug}
|
||||
procedure tstatementnode.dowrite;
|
||||
|
||||
@ -433,6 +436,20 @@ implementation
|
||||
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
|
||||
@ -675,7 +692,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* reorganized aasm layer
|
||||
|
||||
|
||||
@ -29,6 +29,9 @@ interface
|
||||
|
||||
uses
|
||||
node,
|
||||
{$ifdef state_tracking}
|
||||
nstate,
|
||||
{$endif state_tracking}
|
||||
symbase,symtype,symsym,symdef,symtable;
|
||||
|
||||
type
|
||||
@ -63,6 +66,9 @@ interface
|
||||
procedure insertintolist(l : tnodelist);override;
|
||||
function pass_1 : 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;
|
||||
procedure set_procvar(procvar:tnode);
|
||||
end;
|
||||
@ -123,7 +129,7 @@ implementation
|
||||
uses
|
||||
cutils,globtype,systems,
|
||||
verbose,globals,
|
||||
symconst,paramgr,types,
|
||||
symconst,types,
|
||||
htypechk,pass_1,cpuinfo,cpubase,
|
||||
ncnv,nld,ninl,nadd,ncon,
|
||||
rgobj,cgbase
|
||||
@ -364,7 +370,7 @@ implementation
|
||||
if not(assigned(aktcallprocdef) and
|
||||
(aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) 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));
|
||||
|
||||
{ test conversions }
|
||||
@ -411,7 +417,7 @@ implementation
|
||||
left.resulttype.def.typename,defcoll.paratype.def.typename);
|
||||
end;
|
||||
{ Process open parameters }
|
||||
if paramanager.push_high_param(defcoll.paratype.def) then
|
||||
if push_high_param(defcoll.paratype.def) then
|
||||
begin
|
||||
{ insert type conv but hold the ranges of the array }
|
||||
oldtype:=left.resulttype;
|
||||
@ -676,7 +682,7 @@ implementation
|
||||
restypeset := true;
|
||||
{ both the normal and specified resulttype either have to be returned via a }
|
||||
{ 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);
|
||||
end;
|
||||
|
||||
@ -685,7 +691,7 @@ implementation
|
||||
begin
|
||||
self.createintern(name,params);
|
||||
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);
|
||||
end;
|
||||
|
||||
@ -1503,7 +1509,7 @@ implementation
|
||||
{ get a register for the return value }
|
||||
if (not is_void(resulttype.def)) then
|
||||
begin
|
||||
if paramanager.ret_in_acc(resulttype.def) then
|
||||
if ret_in_acc(resulttype.def) then
|
||||
begin
|
||||
{ wide- and ansistrings are returned in EAX }
|
||||
{ but they are imm. moved to a memory location }
|
||||
@ -1632,13 +1638,13 @@ implementation
|
||||
|
||||
{ It doesn't hurt to calculate it already though :) (JM) }
|
||||
rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
{ get a register for the return value }
|
||||
if (not is_void(resulttype.def)) then
|
||||
begin
|
||||
if paramanager.ret_in_param(resulttype.def) then
|
||||
if ret_in_param(resulttype.def) then
|
||||
begin
|
||||
location.loc:=LOC_CREFERENCE;
|
||||
end
|
||||
@ -1776,6 +1782,26 @@ implementation
|
||||
procdefinition.proccalloption:=pocall_inline;
|
||||
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;
|
||||
begin
|
||||
@ -1802,7 +1828,7 @@ implementation
|
||||
retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
|
||||
para_offset:=0;
|
||||
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);
|
||||
{ copy args }
|
||||
if assigned(code) then
|
||||
@ -1870,8 +1896,9 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.79 2002-07-11 14:41:27 florian
|
||||
* start of the new generic parameter handling
|
||||
Revision 1.80 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.78 2002/07/04 20:43:00 florian
|
||||
* first x86-64 patches
|
||||
@ -1987,4 +2014,4 @@ end.
|
||||
Revision 1.62 2002/01/19 11:57:05 peter
|
||||
* fixed path appending for lib
|
||||
|
||||
}
|
||||
}
|
||||
@ -53,6 +53,9 @@ interface
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
function docompare(p: tnode) : boolean; override;
|
||||
{$ifdef extdebug}
|
||||
procedure dowrite;override;
|
||||
{$endif}
|
||||
end;
|
||||
tordconstnodeclass = class of tordconstnode;
|
||||
|
||||
@ -398,6 +401,15 @@ implementation
|
||||
(value = tordconstnode(p).value);
|
||||
end;
|
||||
|
||||
{$ifdef extdebug}
|
||||
procedure Tordconstnode.dowrite;
|
||||
|
||||
begin
|
||||
inherited dowrite;
|
||||
write('[',value,']');
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{*****************************************************************************
|
||||
TPOINTERCONSTNODE
|
||||
*****************************************************************************}
|
||||
@ -721,7 +733,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* reorganized aasm layer
|
||||
|
||||
|
||||
@ -47,6 +47,9 @@ interface
|
||||
twhilerepeatnode = class(tloopnode)
|
||||
function det_resulttype:tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
{$ifdef state_tracking}
|
||||
procedure track_state_pass(exec_known:boolean);override;
|
||||
{$endif}
|
||||
end;
|
||||
twhilerepeatnodeclass = class of twhilerepeatnode;
|
||||
|
||||
@ -178,8 +181,11 @@ implementation
|
||||
uses
|
||||
globtype,systems,
|
||||
cutils,verbose,globals,
|
||||
symconst,symtable,paramgr,types,htypechk,pass_1,
|
||||
symconst,symtable,types,htypechk,pass_1,
|
||||
ncon,nmem,nld,ncnv,nbas,rgobj,
|
||||
{$ifdef state_tracking}
|
||||
nstate,
|
||||
{$endif}
|
||||
cgbase
|
||||
;
|
||||
|
||||
@ -330,6 +336,53 @@ implementation
|
||||
rg.t_times:=old_t_times;
|
||||
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
|
||||
@ -607,7 +660,7 @@ implementation
|
||||
if assigned(left) then
|
||||
begin
|
||||
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^.flags and pi_uses_exceptions)<>0) then
|
||||
begin
|
||||
@ -1113,8 +1166,9 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 2002-07-11 14:41:28 florian
|
||||
* start of the new generic parameter handling
|
||||
Revision 1.35 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.33 2002/07/01 18:46:23 peter
|
||||
* internal linker
|
||||
|
||||
@ -28,6 +28,9 @@ interface
|
||||
|
||||
uses
|
||||
node,
|
||||
{$ifdef state_tracking}
|
||||
nstate,
|
||||
{$endif}
|
||||
symconst,symbase,symtype,symsym,symdef;
|
||||
|
||||
type
|
||||
@ -54,6 +57,9 @@ interface
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : 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;
|
||||
end;
|
||||
tassignmentnodeclass = class of tassignmentnode;
|
||||
@ -122,7 +128,7 @@ implementation
|
||||
|
||||
uses
|
||||
cutils,verbose,globtype,globals,systems,
|
||||
symtable,paramgr,types,
|
||||
symtable,types,
|
||||
htypechk,pass_1,
|
||||
ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
|
||||
;
|
||||
@ -345,7 +351,7 @@ implementation
|
||||
{ we need a register for call by reference parameters }
|
||||
if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
|
||||
((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 }
|
||||
is_open_array(tvarsym(symtableentry).vartype.def) then
|
||||
registers32:=1;
|
||||
@ -547,6 +553,8 @@ implementation
|
||||
|
||||
|
||||
function tassignmentnode.pass_1 : tnode;
|
||||
|
||||
|
||||
begin
|
||||
result:=nil;
|
||||
|
||||
@ -569,6 +577,26 @@ implementation
|
||||
(assigntype = tassignmentnode(p).assigntype);
|
||||
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
|
||||
@ -603,7 +631,7 @@ implementation
|
||||
begin
|
||||
result:=nil;
|
||||
location.loc:=LOC_REFERENCE;
|
||||
if paramanager.ret_in_param(resulttype.def) or
|
||||
if ret_in_param(resulttype.def) or
|
||||
(lexlevel<>funcretsym.owner.symtablelevel) then
|
||||
registers32:=1;
|
||||
end;
|
||||
@ -955,8 +983,9 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.43 2002-07-11 14:41:28 florian
|
||||
* start of the new generic parameter handling
|
||||
Revision 1.44 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.42 2002/05/18 13:34:10 peter
|
||||
* readded missing revisions
|
||||
|
||||
@ -329,6 +329,11 @@ interface
|
||||
function det_resulttype : tnode;virtual;abstract;
|
||||
{ dermines the number of necessary temp. locations to evaluate
|
||||
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 pass_2;virtual;abstract;
|
||||
@ -516,6 +521,13 @@ implementation
|
||||
docompare(p));
|
||||
end;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
procedure Tnode.track_state_pass(exec_known:boolean);
|
||||
|
||||
begin
|
||||
end;
|
||||
{$endif state_tracking}
|
||||
|
||||
function tnode.docompare(p : tnode) : boolean;
|
||||
|
||||
begin
|
||||
@ -806,7 +818,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* 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;
|
||||
|
||||
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;
|
||||
|
||||
var header:Tlxheader;
|
||||
hsym:Tasmsymbol;
|
||||
code_object_header,data_object_header,bss_object_header,stack_object_header,
|
||||
heap_object_header:Tlxobject_table_entry;
|
||||
|
||||
|
||||
begin
|
||||
result:=false;
|
||||
@ -321,6 +336,7 @@ begin
|
||||
header.os_type:=1; {OS/2}
|
||||
{Set the initial EIP.}
|
||||
header.eip_object:=code_object;
|
||||
hsym:=tasmsymbol(globalsyms.search('start'));
|
||||
if not assigned(hsym) then
|
||||
begin
|
||||
comment(V_Error,'Entrypoint "start" not defined');
|
||||
@ -329,7 +345,18 @@ begin
|
||||
header.eip:=hsym.address-sections[sec_code].mempos;
|
||||
{Set the initial ESP.}
|
||||
header.esp_object:=stack_object;
|
||||
header.esp:=stacksize;
|
||||
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;
|
||||
end;
|
||||
|
||||
@ -372,7 +399,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.1 2002/07/08 19:22:22 daniel
|
||||
|
||||
@ -38,12 +38,15 @@ interface
|
||||
|
||||
procedure firstpass(var p : tnode);
|
||||
function do_firstpass(var p : tnode) : boolean;
|
||||
{$ifdef state_tracking}
|
||||
procedure do_track_state_pass(p:Tnode);
|
||||
{$endif}
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
globtype,systems,
|
||||
globtype,systems,cclasses,
|
||||
cutils,globals,
|
||||
cgbase,symdef,
|
||||
{$ifdef extdebug}
|
||||
@ -193,11 +196,23 @@ implementation
|
||||
firstpass(p);
|
||||
do_firstpass:=codegenerror;
|
||||
end;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
procedure do_track_state_pass(p:Tnode);
|
||||
|
||||
begin
|
||||
p.track_state_pass(true);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.23 2002/05/18 13:34:11 peter
|
||||
|
||||
@ -46,12 +46,15 @@ implementation
|
||||
{ aasm }
|
||||
cpubase,cpuinfo,aasmbase,aasmtai,
|
||||
{ symtable }
|
||||
symconst,symbase,symdef,symsym,symtype,symtable,types,paramgr,
|
||||
symconst,symbase,symdef,symsym,symtype,symtable,types,
|
||||
ppu,fmodule,
|
||||
{ pass 1 }
|
||||
node,
|
||||
nbas,
|
||||
pass_1,
|
||||
{$ifdef state_tracking}
|
||||
nstate,
|
||||
{$endif state_tracking}
|
||||
{ pass 2 }
|
||||
{$ifndef NOPASS2}
|
||||
pass_2,
|
||||
@ -103,7 +106,7 @@ implementation
|
||||
{ insert in local symtable }
|
||||
symtablestack.insert(aktprocdef.funcretsym);
|
||||
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
|
||||
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
||||
{ insert result also if support is on }
|
||||
@ -127,7 +130,7 @@ implementation
|
||||
{ because we don't know yet where the address is }
|
||||
if not is_void(aktprocdef.rettype.def) then
|
||||
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
|
||||
{ the space has been set in the local symtable }
|
||||
procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
|
||||
@ -244,6 +247,9 @@ implementation
|
||||
block_type:=bt_general;
|
||||
aktbreaklabel:=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 }
|
||||
if assigned(procinfo^._class) and not(parent_has_class) then
|
||||
@ -313,6 +319,10 @@ implementation
|
||||
{ the procedure is now defined }
|
||||
aktprocdef.forwarddef:=false;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
do_track_state_pass(code);
|
||||
{$endif}
|
||||
|
||||
{ only generate the code if no type errors are found, else
|
||||
finish at least the type checking pass }
|
||||
{$ifndef NOPASS2}
|
||||
@ -445,6 +455,9 @@ implementation
|
||||
|
||||
aktmaxfpuregisters:=oldaktmaxfpuregisters;
|
||||
|
||||
{$ifdef state_tracking}
|
||||
aktstate.destroy;
|
||||
{$endif state_tracking}
|
||||
{ restore filepos, the switches are already set }
|
||||
aktfilepos:=savepos;
|
||||
{ restore labels }
|
||||
@ -641,7 +654,7 @@ implementation
|
||||
{$endif i386}
|
||||
|
||||
{ pointer to the return value ? }
|
||||
if paramanager.ret_in_param(aktprocdef.rettype.def) then
|
||||
if ret_in_param(aktprocdef.rettype.def) then
|
||||
begin
|
||||
procinfo^.return_offset:=procinfo^.para_offset;
|
||||
inc(procinfo^.para_offset,pointer_size);
|
||||
@ -816,8 +829,9 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.57 2002-07-11 14:41:28 florian
|
||||
* start of the new generic parameter handling
|
||||
Revision 1.58 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.56 2002/07/07 09:52:32 florian
|
||||
* powerpc target fixed, very simple units can be compiled
|
||||
|
||||
Loading…
Reference in New Issue
Block a user