Bladeren bron

+ Added the beginning of a state tracker. This will track the values of
variables through procedures and optimize things away.

daniel 23 jaren geleden
bovenliggende
commit
eeae0e4c00
11 gewijzigde bestanden met toevoegingen van 426 en 35 verwijderingen
  1. 37 1
      compiler/nadd.pas
  2. 23 2
      compiler/nbas.pas
  3. 39 12
      compiler/ncal.pas
  4. 17 1
      compiler/ncon.pas
  5. 58 4
      compiler/nflw.pas
  6. 34 5
      compiler/nld.pas
  7. 17 1
      compiler/node.pas
  8. 132 0
      compiler/nstate.pas
  9. 32 1
      compiler/oglx.pas
  10. 17 2
      compiler/pass_1.pas
  11. 20 6
      compiler/psub.pas

+ 37 - 1
compiler/nadd.pas

@@ -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

+ 23 - 2
compiler/nbas.pas

@@ -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
 

+ 39 - 12
compiler/ncal.pas

@@ -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
 
-}
+}

+ 17 - 1
compiler/ncon.pas

@@ -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
 

+ 58 - 4
compiler/nflw.pas

@@ -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

+ 34 - 5
compiler/nld.pas

@@ -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

+ 17 - 1
compiler/node.pas

@@ -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 - 0
compiler/nstate.pas

@@ -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.

+ 32 - 1
compiler/oglx.pas

@@ -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

+ 17 - 2
compiler/pass_1.pas

@@ -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

+ 20 - 6
compiler/psub.pas

@@ -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