Răsfoiți Sursa

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

daniel 23 ani în urmă
părinte
comite
eeae0e4c00
11 a modificat fișierele cu 426 adăugiri și 35 ștergeri
  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