* Removed sets from Tcallnode.det_resulttype

 + Added read/write notifications of variables. These will be usefull
   for providing information for several optimizations. For example
   the value of the loop variable of a for loop does matter is the
   variable is read after the for loop, but if it's no longer used
   or written, it doesn't matter and this can be used to optimize
   the loop code generation.

compiler/nbas.pas

@@ -117,11 +117,17 @@ interface
 
         { a node which is a reference to a certain temp }
         ttemprefnode = class(tnode)
+        {$ifdef var_notification}
+          writeaccess:boolean;
+        {$endif}
           constructor create(const temp: ttempcreatenode); virtual;
           constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
           function getcopy: tnode; override;
           function pass_1 : tnode; override;
           function det_resulttype : tnode; override;
+        {$ifdef var_notification}
+          procedure mark_write;override;
+        {$endif}
           function docompare(p: tnode): boolean; override;
          protected
           tempinfo: ptempinfo;
@@ -670,6 +676,15 @@ implementation
           (ttemprefnode(p).tempinfo = tempinfo);
       end;
 
+{$ifdef var_notification}
+    procedure Ttemprefnode.mark_write;
+
+    begin
+      writeaccess:=true;
+    end;
+{$endif}
+
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -746,7 +761,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2002-08-18 20:06:23  peter
+  Revision 1.35  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.34  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/ncal.pas

@@ -894,7 +894,6 @@ implementation
                     else if (treeparas.left.nodetype=ordconstn) and is_integer(to_def) then
                         begin
                             inc(equal_count);
-                            {To do: What to do with overflow??}
                             ordspace:=ordspace+(double(Torddef(from_def).low)-Torddef(to_def).low)+
                                          (double(Torddef(to_def).high)-Torddef(from_def).high);
                         end
@@ -924,13 +923,16 @@ implementation
                 end;
         end;
 
-    var candidates_left,candidate_count,c1,c2:byte;
+    type  Tcandidate_array=array[1..$ffff] of Tprocdef;
+          Pcandidate_array=^Tcandidate_array;
+
+    var candidate_alloc,candidates_left,candidate_count:cardinal;
+        c1,c2,delete_start:cardinal;
         cl2_count1,cl1_count1,equal_count1,exact_count1:byte;
         ordspace1:double;
         cl2_count2,cl1_count2,equal_count2,exact_count2:byte;
         ordspace2:double;
-        i,n:byte;
-        cont:boolean;
+        i,n:cardinal;
         pt:Tcallparanode;
         def:Tprocdef;
         hcvt:Tconverttype;
@@ -938,12 +940,11 @@ implementation
         hpt:Tnode;
         srprocsym:Tprocsym;
         srsymtable:Tsymtable;
-        candidates:set of 0..255;
-        candidates_exactmatch:set of 0..255;
-        delete_mask:set of 0..255;
-        candidate_defs:array[0..255] of Tprocdef;
+        candidate_defs:Pcandidate_array;
 
     begin
+        if fileinfo.line=398 then
+          i:=0;
         choose_definition_to_call:=nil;
         errorexit:=true;
 
@@ -955,25 +956,32 @@ implementation
          (symtableprocentry.owner.symtabletype=objectsymtable) then
             search_class_overloads(symtableprocentry);
 
-        candidates:=[];
-        candidates_exactmatch:=[];
-
         {Collect all procedures which have the same # of parameters }
+        candidates_left:=0;
         candidate_count:=0;
+        candidate_alloc:=32;
+        getmem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
         srprocsym:=symtableprocentry;
         srsymtable:=symtableprocentry.owner;
         repeat
             for i:=1 to srprocsym.procdef_count do
                 begin
                     def:=srprocsym.procdef(i);
-                    candidate_defs[i-1]:=def;
-                    { only when the # of parameter are supported by the
-                      procedure }
+                    { only when the # of parameters are supported by the procedure }
                     if (paralength>=def.minparacount) and
-                     ((po_varargs in def.procoptions) or { varargs }
-                      (paralength<=def.maxparacount)) then
-                        include(candidates,i-1);
+                       ((po_varargs in def.procoptions) or (paralength<=def.maxparacount)) then
+                      begin
+                        candidate_defs^[i]:=def;
+                        inc(candidates_left);
+                      end
+                    else
+                      candidate_defs^[i]:=nil;
                     inc(candidate_count);
+                    if candidate_alloc=candidate_count then
+                      begin
+                        candidate_alloc:=candidate_alloc*2;
+                        reallocmem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
+                      end;
                 end;
             if po_overload in srprocsym.first_procdef.procoptions then
                 begin
@@ -984,15 +992,16 @@ implementation
                         if assigned(srsymtable) then
                             srprocsym:=Tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
                     until (srsymtable=nil) or (srprocsym<>nil);
-                    cont:=assigned(srprocsym);
+                    if not assigned(srprocsym) then
+                      break;
                 end
             else
-                cont:=false;
-        until not cont;
+                break;
+        until false;
 
         { no procedures found? then there is something wrong
           with the parameter size }
-        if candidates=[] then
+        if candidates_left=0 then
             begin
                 { in tp mode we can try to convert to procvar if
                   there are no parameters specified }
@@ -1010,7 +1019,7 @@ implementation
                     begin
                         if assigned(left) then
                             aktfilepos:=left.fileinfo;
-                        CGMessage(parser_e_wrong_parameter_size);
+                        cgmessage(parser_e_wrong_parameter_size);
                         symtableprocentry.write_parameter_lists(nil);
                     end;
                 exit;
@@ -1018,9 +1027,9 @@ implementation
         {Walk through all candidates and remove the ones
          that have incompatible parameters.}
         for i:=1 to candidate_count do
-            if (i-1) in candidates then
+            if assigned(candidate_defs^[i]) then
                 begin
-                    def:=candidate_defs[i-1];
+                    def:=candidate_defs^[i];
                     {Walk through all parameters.}
                     pdc:=Tparaitem(def.para.first);
                     pt:=Tcallparanode(left);
@@ -1030,8 +1039,12 @@ implementation
                                 if is_var_para_incompatible(pt.resulttype.def,pdc.paratype.def) and
                                  not(is_shortstring(pt.resulttype.def) and is_shortstring(pdc.paratype.def)) and
                                  (pdc.paratype.def.deftype<>formaldef) then
-                                    {Not convertable, def is no longer a candidate.}
-                                    exclude(candidates,i-1)
+                                    begin
+                                      {Not convertable, def is no longer a candidate.}
+                                      candidate_defs^[i]:=nil;
+                                      dec(candidates_left);
+                                      break;
+                                    end
                                 else
                                     exclude(pt.callparaflags,cpf_nomatchfound)
                             else
@@ -1039,19 +1052,18 @@ implementation
                                  ((isconvertable(pt.resulttype.def,pdc.paratype.def,
                                                  hcvt,pt.left.nodetype,false)=0) and
                                   not is_equal(pt,pdc.paratype.def)) then
-                                    {Not convertable, def is no longer a candidate.}
-                                    exclude(candidates,i-1)
+                                    begin
+                                      {Not convertable, def is no longer a candidate.}
+                                      candidate_defs^[i]:=nil;
+                                      dec(candidates_left);
+                                      break;
+                                    end
                                 else
                                     exclude(pt.callparaflags,cpf_nomatchfound);
                             pdc:=Tparaitem(pdc.next);
                             pt:=Tcallparanode(pt.right);
                         end;
                 end;
-        {Count the candidates that are left.}
-        candidates_left:=0;
-        for i:=1 to candidate_count do
-            if (i-1) in candidates then
-                inc(candidates_left);
         {Are there any candidates left?}
         if candidates_left=0 then
             begin
@@ -1100,33 +1112,31 @@ implementation
                 {Find the first candidate.}
                 c1:=1;
                 while c1<=candidate_count do
-                    if (c1-1) in candidates then
+                    if assigned(candidate_defs^[c1]) then
                         break
                     else
                         inc(c1);
-                delete_mask:=[c1-1];
+                delete_start:=c1;
                 {Get information about candidate c1.}
                 get_candidate_information(cl2_count1,cl1_count1,equal_count1,
                                           exact_count1,ordspace1,Tcallparanode(left),
-                                          Tparaitem(candidate_defs[c1-1].para.first));
+                                          Tparaitem(candidate_defs^[c1].para.first));
                 {Find the other candidates and eliminate the lesser ones.}
                 c2:=c1+1;
                 while c2<=candidate_count do
-                    if (c2-1) in candidates then
+                    if assigned(candidate_defs^[c2]) then
                         begin
                             {Candidate found, get information on it.}
                             get_candidate_information(cl2_count2,cl1_count2,equal_count2,
                                                       exact_count2,ordspace2,Tcallparanode(left),
-                                                      Tparaitem(candidate_defs[c2-1].para.first));
+                                                      Tparaitem(candidate_defs^[c2].para.first));
                             {Is c1 the better candidate?}
                             if (cl2_count1<cl2_count2) or
                              ((cl2_count1=cl2_count2) and (exact_count1>exact_count2)) or
                              ((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1>equal_count2)) or
                              ((cl2_count1=cl2_count2) and (exact_count1=exact_count2) and (equal_count1=equal_count2) and (ordspace1<ordspace2)) then
-                                begin
-                                    {C1 is better, drop c2.}
-                                    exclude(candidates,c2-1);
-                                end
+                                {C1 is better, drop c2.}
+                                candidate_defs^[c2]:=nil
                             {Is c2 the better candidate?}
                             else if (cl2_count2<cl2_count1) or
                              ((cl2_count2=cl2_count1) and (exact_count2>exact_count1)) or
@@ -1135,17 +1145,16 @@ implementation
                                 begin
                                     {C2 is better, drop all previous
                                      candidates.}
-                                     include(delete_mask,c1-1);
-                                     candidates:=candidates-delete_mask;
-                                     c1:=c2;
-                                     cl2_count1:=cl2_count2;
-                                     cl1_count1:=cl1_count2;
-                                     equal_count1:=equal_count2;
-                                     exact_count1:=exact_count2;
-                                     ordspace1:=ordspace2;
-                                end
-                            else
-                                include(delete_mask,c2-1);
+                                    for i:=delete_start to c2-1 do
+                                      candidate_defs^[i]:=nil;
+                                    delete_start:=c2;
+                                    c1:=c2;
+                                    cl2_count1:=cl2_count2;
+                                    cl1_count1:=cl1_count2;
+                                    equal_count1:=equal_count2;
+                                    exact_count1:=exact_count2;
+                                    ordspace1:=ordspace2;
+                                end;
                             {else the candidates have no advantage over each other,
                              do nothing}
                             inc(c2);
@@ -1156,20 +1165,18 @@ implementation
         {Count the candidates that are left.}
         candidates_left:=0;
         for i:=1 to candidate_count do
-            if (i-1) in candidates then
+            if assigned(candidate_defs^[i]) then
+              begin
                 inc(candidates_left);
+                procdefinition:=candidate_defs^[i];
+              end;
         if candidates_left>1 then
             begin
                 cgmessage(cg_e_cant_choose_overload_function);
                 symtableprocentry.write_parameter_lists(nil);
                 exit;
             end;
-        for i:=1 to candidate_count do
-            if (i-1) in candidates then
-                begin
-                    procdefinition:=candidate_defs[i-1];
-                    break;
-                end;
+        freemem(candidate_defs,candidate_alloc*sizeof(Tprocdef));
         if make_ref then
             begin
                 Tprocdef(procdefinition).lastref:=Tref.create(Tprocdef(procdefinition).lastref,@fileinfo);
@@ -2587,7 +2594,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.89  2002-08-23 16:13:16  peter
+  Revision 1.90  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.89  2002/08/23 16:13:16  peter
     * also firstpass funcretrefnode if available. This was breaking the
       asnode compilerproc code
 

compiler/ncnv.pas

@@ -43,6 +43,9 @@ interface
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
           function docompare(p: tnode) : boolean; override;
        private
           function resulttype_cord_to_pointer : tnode;
@@ -1319,6 +1322,14 @@ implementation
         result:=resulttype_call_helper(convtype);
       end;
 
+    {$ifdef var_notification}
+      procedure Ttypeconvnode.mark_write;
+
+      begin
+        left.mark_write;
+      end;
+    {$endif}
+
 
     function ttypeconvnode.first_cord_to_pointer : tnode;
 
@@ -2015,7 +2026,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.73  2002-08-23 16:14:49  peter
+  Revision 1.74  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.73  2002/08/23 16:14:49  peter
     * tempgen cleanup
     * tt_noreuse temp type added that will be used in genentrycode
 

compiler/nflw.pas

@@ -30,6 +30,9 @@ interface
     uses
        node,cpubase,
        aasmbase,aasmtai,aasmcpu,
+    {$ifdef var_notification}
+       symnot,
+    {$endif}
        symppu,symtype,symbase,symdef,symsym;
 
     type
@@ -66,7 +69,13 @@ interface
        tifnodeclass = class of tifnode;
 
        tfornode = class(tloopnode)
+       {$ifdef var_notification}
+          loopvar_notid:cardinal;
+       {$endif}
           constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
+       {$ifdef var_notification}
+          procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
+       {$endif}
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
        end;
@@ -622,6 +631,13 @@ implementation
          include(flags,nf_testatbegin);
       end;
 
+{$ifdef var_notification}
+    procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
+                                       symbol:Tsym);
+
+    begin
+    end;
+{$endif}
 
     function tfornode.det_resulttype:tnode;
       var
@@ -656,24 +672,24 @@ implementation
          set_varstate(left,false);
 
          if assigned(t1) then
-          begin
-            resulttypepass(t1);
-            if codegenerror then
-             exit;
-          end;
+           begin
+             resulttypepass(t1);
+             if codegenerror then
+               exit;
+           end;
 
          { process count var }
          resulttypepass(t2);
          set_varstate(t2,true);
          if codegenerror then
-          exit;
+           exit;
 
          { Check count var, record fields are also allowed in tp7 }
          hp:=t2;
          while (hp.nodetype=subscriptn) or
                ((hp.nodetype=vecn) and
                 is_constintnode(tvecnode(hp).right)) do
-          hp:=tunarynode(hp).left;
+           hp:=tunarynode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
            in the same lexlevel }
          if (hp.nodetype=funcretn) or
@@ -688,11 +704,16 @@ implementation
               CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
           end
          else
-          CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
+           CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
 
          resulttypepass(right);
          set_varstate(right,true);
          inserttypeconv(right,t2.resulttype);
+      {$ifdef var_notification}
+         if (hp.nodetype=loadn) and (Tloadnode(hp).symtableentry.typ=varsym) then
+            loopvar_notid:=Tvarsym(Tloadnode(hp).symtableentry).
+             register_notification([vn_onread,vn_onwrite],@loop_var_access);
+      {$endif}
       end;
 
 
@@ -1365,7 +1386,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2002-08-22 15:15:20  daniel
+  Revision 1.49  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.48  2002/08/22 15:15:20  daniel
    * Fixed the detection wether the first check of a for loop can be skipped
 
   Revision 1.47  2002/08/19 19:36:43  peter

compiler/nld.pas

@@ -38,6 +38,7 @@ interface
           symtableentry : tsym;
           symtable : tsymtable;
           procdef : tprocdef;
+          write_access : boolean;
           constructor create(v : tsym;st : tsymtable);virtual;
           constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@@ -47,6 +48,9 @@ interface
           function  getcopy : tnode;override;
           function  pass_1 : tnode;override;
           function  det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
           function  docompare(p: tnode): boolean; override;
        {$ifdef extdebug}
           procedure _dowrite;override;
@@ -73,6 +77,7 @@ interface
        tassignmentnodeclass = class of tassignmentnode;
 
        tfuncretnode = class(tnode)
+          write_access : boolean;
           funcretsym : tfuncretsym;
           constructor create(v:tsym);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@@ -81,6 +86,9 @@ interface
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
           function docompare(p: tnode): boolean; override;
        end;
        tfuncretnodeclass = class of tfuncretnode;
@@ -351,6 +359,14 @@ implementation
          end;
       end;
 
+{$ifdef var_notification}
+    procedure Tloadnode.mark_write;
+
+    begin
+      write_access:=true;
+    end;
+{$endif}
+
 
     function tloadnode.pass_1 : tnode;
       begin
@@ -465,6 +481,9 @@ implementation
 
       begin
          inherited create(assignn,l,r);
+      {$ifdef var_notification}
+         l.mark_write;
+      {$endif}
          assigntype:=at_normal;
       end;
 
@@ -621,7 +640,6 @@ implementation
           test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
       end;
 
-
     function tassignmentnode.pass_1 : tnode;
 
 
@@ -717,6 +735,13 @@ implementation
         resulttype:=funcretsym.returntype;
       end;
 
+{$ifdef var_notification}
+    procedure Tfuncretnode.mark_write;
+
+    begin
+      write_access:=true;
+    end;
+{$endif}
 
     function tfuncretnode.pass_1 : tnode;
       begin
@@ -1120,7 +1145,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.54  2002-08-25 19:25:19  peter
+  Revision 1.55  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.54  2002/08/25 19:25:19  peter
     * sym.insert_in_data removed
     * symtable.insertvardata/insertconstdata added
     * removed insert_in_data call from symtable.insert, it needs to be

compiler/nmem.pas

@@ -77,14 +77,23 @@ interface
        tdoubleaddrnodeclass = class of tdoubleaddrnode;
 
        tderefnode = class(tunarynode)
+       {$ifdef var_notification}
+          write_access:boolean;
+       {$endif}
           constructor create(l : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
        end;
        tderefnodeclass = class of tderefnode;
 
        tsubscriptnode = class(tunarynode)
           vs : tvarsym;
+       {$ifdef var_notification}
+          write_access:boolean;
+       {$endif}
           constructor create(varsym : tsym;l : tnode);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -93,13 +102,20 @@ interface
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
           function det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
        end;
        tsubscriptnodeclass = class of tsubscriptnode;
 
        tvecnode = class(tbinarynode)
+          write_access:boolean;
           constructor create(l,r : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+       {$ifdef var_notification}
+          procedure mark_write;override;
+       {$endif}
        end;
        tvecnodeclass = class of tvecnode;
 
@@ -569,6 +585,14 @@ implementation
           CGMessage(cg_e_invalid_qualifier);
       end;
 
+{$ifdef var_notification}
+    procedure Tderefnode.mark_write;
+
+    begin
+      write_access:=true;
+    end;
+{$endif}
+
     function tderefnode.pass_1 : tnode;
       begin
          result:=nil;
@@ -638,6 +662,13 @@ implementation
         resulttype:=vs.vartype;
       end;
 
+{$ifdef var_notification}
+    procedure Tsubscriptnode.mark_write;
+
+    begin
+      write_access:=true;
+    end;
+{$endif}
 
     function tsubscriptnode.pass_1 : tnode;
       begin
@@ -752,6 +783,13 @@ implementation
              CGMessage(type_e_array_required);
       end;
 
+{$ifdef var_notification}
+    procedure Tvecnode.mark_write;
+
+    begin
+      write_access:=true;
+    end;
+{$endif}
 
     function tvecnode.pass_1 : tnode;
 {$ifdef consteval}
@@ -1020,7 +1058,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-08-19 19:36:43  peter
+  Revision 1.37  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.36  2002/08/19 19:36:43  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small

compiler/node.pas

@@ -334,9 +334,14 @@ interface
           { 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 }
-      function track_state_pass(exec_known:boolean):boolean;virtual;
+          { Does optimizations by keeping track of the variable states
+            in a procedure }
+          function track_state_pass(exec_known:boolean):boolean;virtual;
+{$endif}
+{$ifdef var_notification}
+          { For a t1:=t2 tree, mark the part of the tree t1 that gets
+            written to (normally the loadnode) as write access. }
+          procedure mark_write;virtual;
 {$endif}
           procedure det_temp;virtual;abstract;
 
@@ -713,6 +718,16 @@ implementation
          fileinfo:=filepos;
       end;
 
+{$ifdef var_notification}
+          { For a t1:=t2 tree, mark the part of the tree t1 that gets
+            written to (normally the loadnode) as write access. }
+          procedure Tnode.mark_write;
+          begin
+             writenode(self);
+             runerror(211);
+          end;
+{$endif}
+
 
 {****************************************************************************
                                  TUNARYNODE
@@ -973,7 +988,16 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2002-08-22 11:21:45  florian
+  Revision 1.40  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.39  2002/08/22 11:21:45  florian
     + register32 is now written by tnode.dowrite
     * fixed write of value of tconstnode
 

compiler/symsym.pas

@@ -34,6 +34,9 @@ interface
        symconst,symbase,symtype,symdef,
        { ppu }
        ppu,symppu,
+{$ifdef var_notification}
+       cclasses,symnot,
+{$endif}
        { aasm }
        aasmbase,aasmtai,cpubase,
        globals
@@ -170,6 +173,9 @@ interface
           reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
           varspez       : tvarspez;  { sets the type of access }
           varstate      : tvarstate;
+{$ifdef var_notification}
+          notifications : Tlinkedlist;
+{$endif}
           constructor create(const n : string;const tt : ttype);
           constructor create_dll(const n : string;const tt : ttype);
           constructor create_C(const n,mangled : string;const tt : ttype);
@@ -182,6 +188,10 @@ interface
           function  getsize : longint;
           function  getvaluesize : longint;
           function  getpushsize(is_cdecl:boolean): longint;
+{$ifdef var_notification}
+          function register_notification(flags:Tnotification_flags;
+                                         callback:Tnotification_callback):cardinal;
+{$endif}
 {$ifdef GDB}
           function  stabstring : pchar;override;
           procedure concatstabto(asmlist : taasmoutput);override;
@@ -1536,7 +1546,11 @@ implementation
 
     destructor tvarsym.destroy;
       begin
-         inherited destroy;
+      {$ifdef var_notification}
+        if assigned(notifications) then
+          notifications.destroy;
+      {$endif}
+        inherited destroy;
       end;
 
 
@@ -1620,6 +1634,20 @@ implementation
            end;
       end;
 
+{$ifdef var_notification}
+    function Tvarsym.register_notification(flags:Tnotification_flags;callback:
+                                           Tnotification_callback):cardinal;
+
+    var n:Tnotification;
+
+    begin
+      if not assigned(notifications) then
+        notifications:=Tlinkedlist.create;
+      n:=Tnotification.create(flags,callback);
+      register_notification:=n.id;
+      notifications.concat(n);
+    end;
+{$endif}
 
 {$ifdef GDB}
     function tvarsym.stabstring : pchar;
@@ -2415,7 +2443,16 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  2002-08-25 19:25:21  peter
+  Revision 1.58  2002-09-01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.57  2002/08/25 19:25:21  peter
     * sym.insert_in_data removed
     * symtable.insertvardata/insertconstdata added
     * removed insert_in_data call from symtable.insert, it needs to be