Browse Source

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

daniel 23 years ago
parent
commit
eeae0e4c00
11 changed files with 426 additions and 35 deletions
  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;
           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

+ 23 - 2
compiler/nbas.pas

@@ -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;
 
 
@@ -290,7 +293,7 @@ implementation
            registersmmx:=right.registersmmx;
            registersmmx:=right.registersmmx;
 {$endif}
 {$endif}
       end;
       end;
-
+      
 {$ifdef extdebug}
 {$ifdef extdebug}
     procedure tstatementnode.dowrite;
     procedure tstatementnode.dowrite;
 
 
@@ -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
 
 

+ 39 - 12
compiler/ncal.pas

@@ -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 }
@@ -1632,13 +1638,13 @@ implementation
 
 
              { It doesn't hurt to calculate it already though :) (JM) }
              { It doesn't hurt to calculate it already though :) (JM) }
              rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
              rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
-
+             
            end;
            end;
 
 
          { 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
-    * 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
   Revision 1.78  2002/07/04 20:43:00  florian
     * first x86-64 patches
     * first x86-64 patches
@@ -1987,4 +2014,4 @@ end.
   Revision 1.62  2002/01/19 11:57:05  peter
   Revision 1.62  2002/01/19 11:57:05  peter
     * fixed path appending for lib
     * fixed path appending for lib
 
 
-}
+}

+ 17 - 1
compiler/ncon.pas

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

+ 58 - 4
compiler/nflw.pas

@@ -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
-    * 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
   Revision 1.33  2002/07/01 18:46:23  peter
     * internal linker
     * internal linker

+ 34 - 5
compiler/nld.pas

@@ -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
-    * 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
   Revision 1.42  2002/05/18 13:34:10  peter
     * readded missing revisions
     * readded missing revisions

+ 17 - 1
compiler/node.pas

@@ -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 - 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;*)
       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

+ 17 - 2
compiler/pass_1.pas

@@ -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}
@@ -193,11 +196,23 @@ implementation
          firstpass(p);
          firstpass(p);
          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

+ 20 - 6
compiler/psub.pas

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