* for-node cleanup, checking for uninitialzed from and to values

    is now supported

compiler/ncgflw.pas

@@ -329,7 +329,6 @@ implementation
       var
          l3,oldclabel,oldblabel : tasmlabel;
          temptovalue : boolean;
-         hs : byte;
          temp1 : treference;
          hop : topcg;
          hcond : topcmp;
@@ -348,31 +347,40 @@ implementation
          objectlibrary.getlabel(l3);
 
          { only calculate reference }
-         secondpass(t2);
-         hs := t2.resulttype.def.size;
-         opsize := def_cgsize(t2.resulttype.def);
+         opsize := def_cgsize(left.resulttype.def);
+         count_var_is_signed:=is_signed(left.resulttype.def);
 
          { first set the to value
            because the count var can be in the expression !! }
          do_loopvar_at_end:=lnf_dont_mind_loopvar_on_exit in loopflags;
 
-         secondpass(right);
+         secondpass(t1);
          { calculate pointer value and check if changeable and if so }
          { load into temporary variable                       }
-         if right.nodetype<>ordconstn then
+         if t1.nodetype<>ordconstn then
            begin
               do_loopvar_at_end:=false;
-              tg.GetTemp(exprasmlist,hs,tt_normal,temp1);
+              tg.GetTemp(exprasmlist,t1.resulttype.def.size,tt_normal,temp1);
               temptovalue:=true;
-              cg.a_load_loc_ref(exprasmlist,opsize,right.location,temp1);
-              location_freetemp(exprasmlist,right.location);
+              cg.a_load_loc_ref(exprasmlist,opsize,t1.location,temp1);
+              location_freetemp(exprasmlist,t1.location);
            end
          else
            temptovalue:=false;
 
          { produce start assignment }
          secondpass(left);
-         count_var_is_signed:=is_signed(t2.resulttype.def);
+         secondpass(right);
+         case left.location.loc of
+           LOC_REFERENCE,
+           LOC_CREFERENCE :
+             cg.a_load_loc_ref(exprasmlist,left.location.size,right.location,left.location.reference);
+           LOC_REGISTER,
+           LOC_CREGISTER :
+             cg.a_load_loc_reg(exprasmlist,left.location.size,right.location,left.location.register);
+           else
+             internalerror(200501311);
+         end;
 
          if lnf_backward in loopflags then
            if count_var_is_signed then
@@ -392,15 +400,15 @@ implementation
          if temptovalue then
            begin
              cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,
-               temp1,t2.location,aktbreaklabel);
+               temp1,left.location,aktbreaklabel);
            end
          else
            begin
              if lnf_testatbegin in loopflags then
                begin
                  cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
-                   tordconstnode(right).value,
-                   t2.location,aktbreaklabel);
+                   tordconstnode(t1).value,
+                   left.location,aktbreaklabel);
                end;
            end;
 
@@ -413,11 +421,11 @@ implementation
                 hop:=OP_ADD
               else
                 hop:=OP_SUB;
-              cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
+              cg.a_op_const_loc(exprasmlist,hop,1,left.location);
             end;
 
+         { align loop target }
          if not(cs_littlesize in aktglobalswitches) then
-            { align loop target }
             exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
          cg.a_label(exprasmlist,l3);
 
@@ -430,13 +438,12 @@ implementation
                 hop:=OP_SUB
               else
                 hop:=OP_ADD;
-              cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
+              cg.a_op_const_loc(exprasmlist,hop,1,left.location);
             end;
 
-         { help register must not be in instruction block }
-         if assigned(t1) then
+         if assigned(t2) then
            begin
-             secondpass(t1);
+             secondpass(t2);
 {$ifdef OLDREGVARS}
              load_all_regvars(exprasmlist);
 {$endif OLDREGVARS}
@@ -451,7 +458,7 @@ implementation
                 hop:=OP_SUB
               else
                 hop:=OP_ADD;
-              cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
+              cg.a_op_const_loc(exprasmlist,hop,1,left.location);
             end;
 
          cg.a_label(exprasmlist,aktcontinuelabel);
@@ -487,12 +494,12 @@ implementation
          if temptovalue then
            begin
              cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1,
-               t2.location,l3);
+               left.location,l3);
              tg.ungetiftemp(exprasmlist,temp1);
            end
          else
            begin
-             cmp_const:=Tordconstnode(right).value;
+             cmp_const:=Tordconstnode(t1).value;
              if do_loopvar_at_end then
                begin
                  {Watch out for wrap around 255 -> 0.}
@@ -597,18 +604,18 @@ implementation
                      begin
                        if lnf_backward in loopflags then
                          begin
-                           if integer(cmp_const)=high(integer) then
+                           if integer(cmp_const)=high(smallint) then
                              begin
                                hcond:=OC_NE;
-                               cmp_const:=low(integer);
+                               cmp_const:=low(smallint);
                              end
                          end
                        else
                          begin
-                           if integer(cmp_const)=low(integer) then
+                           if integer(cmp_const)=low(smallint) then
                              begin
                                hcond:=OC_NE;
-                               cmp_const:=high(integer);
+                               cmp_const:=high(smallint);
                              end
                          end
                      end;
@@ -656,7 +663,7 @@ implementation
                end;
 
              cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
-               cmp_const,t2.location,l3);
+               cmp_const,left.location,l3);
            end;
 
          { this is the break label: }
@@ -1443,7 +1450,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.102  2004-11-08 22:09:59  peter
+  Revision 1.103  2005-01-31 16:16:21  peter
+    * for-node cleanup, checking for uninitialzed from and to values
+      is now supported
+
+  Revision 1.102  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.101  2004/10/24 11:44:28  peter

compiler/nflw.pas

@@ -68,7 +68,7 @@ interface
        end;
 
        twhilerepeatnode = class(tloopnode)
-          constructor create(l,r,_t1:Tnode;tab,cn:boolean);virtual;
+          constructor create(l,r:Tnode;tab,cn:boolean);virtual;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
 {$ifdef state_tracking}
@@ -196,9 +196,6 @@ interface
        end;
        tonnodeclass = class of tonnode;
 
-    { for compatibilty }
-    function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
-
     var
        cwhilerepeatnode : twhilerepeatnodeclass;
        cifnode : tifnodeclass;
@@ -227,28 +224,6 @@ implementation
       cgbase,procinfo
       ;
 
-    function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
-
-      var
-         p : tnode;
-
-      begin
-         case t of
-            ifn:
-               p:=cifnode.create(l,r,n1);
-            whilerepeatn:
-               if back then
-                  {Repeat until.}
-                  p:=cwhilerepeatnode.create(l,r,n1,false,true)
-               else
-                  {While do.}
-                  p:=cwhilerepeatnode.create(l,r,n1,true,false);
-            forn:
-               p:=cfornode.create(l,r,n1,nil,back);
-         end;
-         resulttypepass(p);
-         genloopnode:=p;
-      end;
 
 {****************************************************************************
                                  TLOOPNODE
@@ -361,9 +336,9 @@ implementation
                                TWHILEREPEATNODE
 *****************************************************************************}
 
-    constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean);
+    constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
       begin
-          inherited create(whilerepeatn,l,r,_t1,nil);
+          inherited create(whilerepeatn,l,r,nil,nil);
           if tab then
               include(loopflags, lnf_testatbegin);
           if cn then
@@ -705,42 +680,39 @@ implementation
          resulttype:=voidtype;
 
          {Can we spare the first comparision?}
-         if (right.nodetype=ordconstn) and
-            (Tassignmentnode(left).right.nodetype=ordconstn) and
+         if (t1.nodetype=ordconstn) and
+            (right.nodetype=ordconstn) and
             (
              (
               (lnf_backward in loopflags) and
-              (Tordconstnode(Tassignmentnode(left).right).value>=Tordconstnode(right).value)
+              (Tordconstnode(right).value>=Tordconstnode(t1).value)
              ) or
              (
                not(lnf_backward in loopflags) and
-               (Tordconstnode(Tassignmentnode(left).right).value<=Tordconstnode(right).value)
+               (Tordconstnode(right).value<=Tordconstnode(t1).value)
              )
             ) then
            exclude(loopflags,lnf_testatbegin);
 
-         { save counter var }
-         t2:=tassignmentnode(left).left.getcopy;
-
+         { process the loopvar, from and to }
          resulttypepass(left);
-         set_varstate(left,vs_used,true);
+         resulttypepass(right);
+         resulttypepass(t1);
 
-         if assigned(t1) then
-           begin
-             resulttypepass(t1);
-             if codegenerror then
-               exit;
-           end;
+         { first set the varstate for from and to, so
+           uses of loopvar in those expressions will also
+           trigger a warning when it is not used yet }
+         set_varstate(right,vs_used,true);
+         set_varstate(t1,vs_used,true);
+         set_varstate(left,vs_used,false);
 
-         { process count var }
-         resulttypepass(t2);
-         set_varstate(t2,vs_used,false);
-         if codegenerror then
-           exit;
+         { Make sure that the loop var and the
+           from and to values are compatible types }
+         inserttypeconv(right,left.resulttype);
+         inserttypeconv(t1,left.resulttype);
 
-         resulttypepass(right);
-         set_varstate(right,vs_used,true);
-         inserttypeconv(right,t2.resulttype);
+         if assigned(t2) then
+           resulttypepass(t2);
       end;
 
 
@@ -750,25 +722,8 @@ implementation
      begin
          result:=nil;
          expectloc:=LOC_VOID;
-         { Calc register weight }
-         old_t_times:=cg.t_times;
-         if not(cs_littlesize in aktglobalswitches) then
-           cg.t_times:=cg.t_times*8;
 
          firstpass(left);
-
-         if assigned(t1) then
-          begin
-            firstpass(t1);
-            if codegenerror then
-             exit;
-          end;
-
-         registersint:=t1.registersint;
-         registersfpu:=t1.registersfpu;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
          if left.registersint>registersint then
            registersint:=left.registersint;
          if left.registersfpu>registersfpu then
@@ -778,32 +733,7 @@ implementation
            registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
 
-         { process count var }
-         firstpass(t2);
-         if codegenerror then
-          exit;
-         if t2.registersint>registersint then
-           registersint:=t2.registersint;
-         if t2.registersfpu>registersfpu then
-           registersfpu:=t2.registersfpu;
-{$ifdef SUPPORT_MMX}
-         if t2.registersmmx>registersmmx then
-           registersmmx:=t2.registersmmx;
-{$endif SUPPORT_MMX}
-
          firstpass(right);
-      {$ifdef loopvar_dont_mind}
-         { Check count var, record fields are also allowed in tp7 }
-         include(loopflags,lnf_dont_mind_loopvar_on_exit);
-         hp:=t2;
-         while (hp.nodetype=subscriptn) or
-               ((hp.nodetype=vecn) and
-                is_constintnode(tvecnode(hp).right)) do
-           hp:=tunarynode(hp).left;
-         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}
          if right.registersint>registersint then
            registersint:=right.registersint;
          if right.registersfpu>registersfpu then
@@ -812,10 +742,40 @@ implementation
          if right.registersmmx>registersmmx then
            registersmmx:=right.registersmmx;
 {$endif SUPPORT_MMX}
+
+         firstpass(t1);
+         if t1.registersint>registersint then
+           registersint:=t1.registersint;
+         if t1.registersfpu>registersfpu then
+           registersfpu:=t1.registersfpu;
+{$ifdef SUPPORT_MMX}
+         if t1.registersmmx>registersmmx then
+           registersmmx:=t1.registersmmx;
+{$endif SUPPORT_MMX}
+
+         if assigned(t2) then
+          begin
+            { Calc register weight }
+            old_t_times:=cg.t_times;
+            if not(cs_littlesize in aktglobalswitches) then
+              cg.t_times:=cg.t_times*8;
+            firstpass(t2);
+            if codegenerror then
+             exit;
+            if t2.registersint>registersint then
+              registersint:=t2.registersint;
+            if t2.registersfpu>registersfpu then
+              registersfpu:=t2.registersfpu;
+{$ifdef SUPPORT_MMX}
+            if t2.registersmmx>registersmmx then
+              registersmmx:=t2.registersmmx;
+{$endif SUPPORT_MMX}
+            cg.t_times:=old_t_times;
+          end;
+
          { we need at least one register for comparisons PM }
          if registersint=0 then
            inc(registersint);
-         cg.t_times:=old_t_times;
       end;
 
 
@@ -1441,7 +1401,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.106  2005-01-16 14:44:03  peter
+  Revision 1.107  2005-01-31 16:16:21  peter
+    * for-node cleanup, checking for uninitialzed from and to values
+      is now supported
+
+  Revision 1.106  2005/01/16 14:44:03  peter
     * fix unreachable code check for repeat loop
 
   Revision 1.105  2005/01/16 10:50:32  peter

compiler/pstatmnt.pas

@@ -81,7 +81,7 @@ implementation
             else_a:=statement
          else
            else_a:=nil;
-         if_statement:=genloopnode(ifn,ex,if_a,else_a,false);
+         result:=cifnode.create(ex,if_a,else_a);
       end;
 
     { creates a block (list) of statements, til the next END token }
@@ -116,7 +116,7 @@ implementation
     function case_statement : tnode;
       var
          casedef : tdef;
-         code,caseexpr,p,instruc,elseblock : tnode;
+         caseexpr,p : tnode;
          blockid : longint;
          hl1,hl2 : TConstExprInt;
          casedeferror : boolean;
@@ -221,10 +221,7 @@ implementation
               casenode.addelseblock(statements_til_end);
            end
          else
-           begin
-              elseblock:=nil;
-              consume(_END);
-           end;
+           consume(_END);
 
          result:=casenode;
       end;
@@ -259,7 +256,7 @@ implementation
 
          first:=cblocknode.create(first);
          p_e:=comp_expr(true);
-         repeat_statement:=genloopnode(whilerepeatn,p_e,first,nil,true);
+         result:=cwhilerepeatnode.create(p_e,first,false,true);
       end;
 
 
@@ -273,133 +270,131 @@ implementation
          p_e:=comp_expr(true);
          consume(_DO);
          p_a:=statement;
-         while_statement:=genloopnode(whilerepeatn,p_e,p_a,nil,false);
+         result:=cwhilerepeatnode.create(p_e,p_a,true,false);
       end;
 
 
     function for_statement : tnode;
 
       var
-         p_e,tovalue,p_a : tnode;
+         hp,
+         hloopvar,
+         hblock,
+         hto,hfrom : tnode;
          backward : boolean;
          loopvarsym : tabstractvarsym;
-         hp : tnode;
       begin
          { parse loop header }
          consume(_FOR);
-         p_e:=expr;
+
+         hloopvar:=factor(false);
 
          { Check loop variable }
-         hp:=nil;
          loopvarsym:=nil;
-         if (p_e.nodetype=assignn) then
-           begin
-             hp:=tassignmentnode(p_e).left;
 
-             { variable must be an ordinal, int64 is not allowed for 32bit targets }
-             if not(is_ordinal(hp.resulttype.def))
+         { variable must be an ordinal, int64 is not allowed for 32bit targets }
+         if not(is_ordinal(hloopvar.resulttype.def))
 {$ifndef cpu64bit}
-                or is_64bitint(hp.resulttype.def)
+            or is_64bitint(hloopvar.resulttype.def)
 {$endif cpu64bit}
-                then
-               MessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
-
-             while assigned(hp) and
-                   (
-                    { record/object fields are allowed }
-                    (
-                     (hp.nodetype=subscriptn) and
-                     ((tsubscriptnode(hp).left.resulttype.def.deftype=recorddef) or
-                      is_object(tsubscriptnode(hp).left.resulttype.def))
-                    ) or
-                    { constant array index }
-                    (
-                     (hp.nodetype=vecn) and
-                     is_constintnode(tvecnode(hp).right)
-                    ) or
-                    { equal typeconversions }
-                    (
-                     (hp.nodetype=typeconvn) and
-                     (ttypeconvnode(hp).convtype=tc_equal)
-                    )
-                   ) do
-               begin
-                 { Use the recordfield for loopvarsym }
-                 if not assigned(loopvarsym) and
-                    (hp.nodetype=subscriptn) then
-                   loopvarsym:=tsubscriptnode(hp).vs;
-                 hp:=tunarynode(hp).left;
-               end;
+            then
+           MessagePos(hloopvar.fileinfo,type_e_ordinal_expr_expected);
 
-             if assigned(hp) and
-                (hp.nodetype=loadn) then
-               begin
-                 case tloadnode(hp).symtableentry.typ of
-                   globalvarsym,
-                   localvarsym,
-                   paravarsym :
-                     begin
-                       { we need a simple loadn and the load must be in a global symtable or
-                         in the same level as the para of the current proc }
-                       if (
-                           (tloadnode(hp).symtable.symtablelevel=main_program_level) or
-                           (tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel)
-                          ) and
-                          not(
-                              ((tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_var,vs_out]) or
-                               (vo_is_thread_var in tabstractvarsym(tloadnode(hp).symtableentry).varoptions))
-                             ) then
-                         begin
-                           tabstractvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
-
-                           { Assigning for-loop variable is only allowed in tp7 }
-                           if not(m_tp7 in aktmodeswitches) then
-                             begin
-                               if not assigned(loopvarsym) then
-                                 loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry);
-                               include(loopvarsym.varoptions,vo_is_loop_counter);
-                             end;
-                         end
-                       else
-                         MessagePos(hp.fileinfo,type_e_illegal_count_var);
-                     end;
-                   typedconstsym :
+         hp:=hloopvar;
+         while assigned(hp) and
+               (
+                { record/object fields are allowed in tp7 mode only }
+                (
+                 (m_tp7 in aktmodeswitches) and
+                 (hp.nodetype=subscriptn) and
+                 ((tsubscriptnode(hp).left.resulttype.def.deftype=recorddef) or
+                  is_object(tsubscriptnode(hp).left.resulttype.def))
+                ) or
+                { constant array index }
+                (
+                 (hp.nodetype=vecn) and
+                 is_constintnode(tvecnode(hp).right)
+                ) or
+                { equal typeconversions }
+                (
+                 (hp.nodetype=typeconvn) and
+                 (ttypeconvnode(hp).convtype=tc_equal)
+                )
+               ) do
+           begin
+             { Use the recordfield for loopvarsym }
+             if not assigned(loopvarsym) and
+                (hp.nodetype=subscriptn) then
+               loopvarsym:=tsubscriptnode(hp).vs;
+             hp:=tunarynode(hp).left;
+           end;
+
+         if assigned(hp) and
+            (hp.nodetype=loadn) then
+           begin
+             case tloadnode(hp).symtableentry.typ of
+               globalvarsym,
+               localvarsym,
+               paravarsym :
+                 begin
+                   { we need a simple loadn and the load must be in a global symtable or
+                     in the same level as the para of the current proc }
+                   if (
+                       (tloadnode(hp).symtable.symtablelevel=main_program_level) or
+                       (tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel)
+                      ) and
+                      not(
+                          ((tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_var,vs_out]) or
+                           (vo_is_thread_var in tabstractvarsym(tloadnode(hp).symtableentry).varoptions))
+                         ) then
                      begin
-                       { Bad programming, only allowed in tp7 mode }
+                       { Assigning for-loop variable is only allowed in tp7 }
                        if not(m_tp7 in aktmodeswitches) then
-                         MessagePos(hp.fileinfo,type_e_illegal_count_var);
-                     end;
+                         begin
+                           if not assigned(loopvarsym) then
+                             loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry);
+                           include(loopvarsym.varoptions,vo_is_loop_counter);
+                         end;
+                     end
                    else
                      MessagePos(hp.fileinfo,type_e_illegal_count_var);
                  end;
-               end
-             else
-               MessagePos(tassignmentnode(p_e).left.fileinfo,type_e_illegal_count_var);
+               typedconstsym :
+                 begin
+                   { Bad programming, only allowed in tp7 mode }
+                   if not(m_tp7 in aktmodeswitches) then
+                     MessagePos(hp.fileinfo,type_e_illegal_count_var);
+                 end;
+               else
+                 MessagePos(hp.fileinfo,type_e_illegal_count_var);
+             end;
            end
          else
-           Message(parser_e_illegal_expression);
+           MessagePos(hloopvar.fileinfo,type_e_illegal_count_var);
 
-         if token=_DOWNTO then
-           begin
-              consume(_DOWNTO);
-              backward:=true;
-           end
+         consume(_ASSIGNMENT);
+
+         hfrom:=comp_expr(true);
+
+         if try_to_consume(_DOWNTO) then
+           backward:=true
          else
            begin
-              consume(_TO);
-              backward:=false;
+             consume(_TO);
+             backward:=false;
            end;
-         tovalue:=comp_expr(true);
+
+         hto:=comp_expr(true);
          consume(_DO);
 
          { ... now the instruction block }
-         p_a:=statement;
+         hblock:=statement;
 
          { variable is not used a loop counter anymore }
          if assigned(loopvarsym) then
            exclude(loopvarsym.varoptions,vo_is_loop_counter);
 
-         for_statement:=genloopnode(forn,p_e,tovalue,p_a,backward);
+         result:=cfornode.create(hloopvar,hfrom,hto,hblock,backward);
       end;
 
 
@@ -1025,7 +1020,10 @@ implementation
            end;
          end;
          if assigned(code) then
-           code.fileinfo:=filepos;
+           begin
+             resulttypepass(code);
+             code.fileinfo:=filepos;
+           end;
          statement:=code;
       end;
 
@@ -1147,7 +1145,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.149  2004-12-26 16:22:01  peter
+  Revision 1.150  2005-01-31 16:16:21  peter
+    * for-node cleanup, checking for uninitialzed from and to values
+      is now supported
+
+  Revision 1.149  2004/12/26 16:22:01  peter
     * fix lineinfo for with blocks
 
   Revision 1.148  2004/12/07 16:11:52  peter