* Fix code generation of for-loops. Keeping a copy of to-value in register during pass 2 is basically a hack, because register may be destroyed if an exception is raised and handled in loop body. This went unnoticed because generic setjmp-based exception handling is restoring registers to the state at entry to try block, and Win64 SEH also has some register-preserving features. However, for Win32 SEH it is not true.

Instead, to-value is now copied to a temp during pass 1, and this temp is forced into memory if loop body contains try..finally or try..except block.

git-svn-id: trunk@26192 -

compiler/ncgflw.pas

@@ -405,8 +405,8 @@ implementation
                  get_used_regvars(left,usedregvars);
                  { loop body }
                  get_used_regvars(t2,usedregvars);
-                 { end value (t1) is not necessary (it cannot be a regvar, }
-                 { see webtbs/tw8883)                                      }
+                 { end value can't be a regvar, but may be a temp in register }
+                 get_used_regvars(t1,usedregvars);
 
                  gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
                end
@@ -479,7 +479,6 @@ implementation
          if t1.nodetype<>ordconstn then
            begin
               do_loopvar_at_end:=false;
-              hlcg.location_force_reg(current_asmdata.CurrAsmList,t1.location,t1.resultdef,t1.resultdef,false);
               temptovalue:=true;
            end
          else
@@ -545,8 +544,16 @@ implementation
 
          if temptovalue then
            begin
-             hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,
-               t1.location.register,left.location,current_procinfo.CurrBreakLabel);
+             case t1.location.loc of
+               LOC_REGISTER,LOC_CREGISTER:
+                 hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,
+                   t1.location.register,left.location,current_procinfo.CurrBreakLabel);
+               LOC_REFERENCE,LOC_CREFERENCE:
+                 hlcg.a_cmp_ref_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,
+                   t1.location.reference,left.location,current_procinfo.CurrBreakLabel);
+             else
+               InternalError(2013051601);
+             end;
            end
          else
            begin
@@ -646,8 +653,16 @@ implementation
          { jump                                     }
          if temptovalue then
            begin
-             hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,t1.location.register,
-               left.location,l3);
+             case t1.location.loc of
+               LOC_REGISTER,LOC_CREGISTER:
+                 hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,t1.location.register,
+                   left.location,l3);
+               LOC_REFERENCE,LOC_CREFERENCE:
+                 hlcg.a_cmp_ref_loc_label(current_asmdata.CurrAsmList,left.resultdef,hcond,t1.location.reference,
+                   left.location,l3);
+             else
+               InternalError(2013051602);
+             end;
            end
          else
            begin
@@ -822,8 +837,6 @@ implementation
          hlcg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel);
 
          sync_regvars(false);
-         if temptovalue then
-           hlcg.a_reg_sync(current_asmdata.CurrAsmList,t1.location.register);
 
          current_procinfo.CurrContinueLabel:=oldclabel;
          current_procinfo.CurrBreakLabel:=oldblabel;

compiler/nflw.pas

@@ -102,6 +102,7 @@ interface
           loopvar_notid:cardinal;
           constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce;
           procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
+          function wrap_to_value:tnode;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function simplify(forinline : boolean) : tnode;override;
@@ -1465,6 +1466,40 @@ implementation
       end;
 
 
+    function has_exceptions(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        if (n.nodetype in [tryfinallyn,tryexceptn]) then
+          result:=fen_norecurse_true
+        else
+          result:=fen_false;
+      end;
+
+
+    function tfornode.wrap_to_value:tnode;
+      var
+        statements: tstatementnode;
+        temp: ttempcreatenode;
+        allowreg: boolean;
+      begin
+        allowreg:=not foreachnodestatic(t2,@has_exceptions,nil);
+        result:=internalstatements(statements);
+        temp:=ctempcreatenode.create(t1.resultdef,t1.resultdef.size,tt_persistent,allowreg);
+        addstatement(statements,temp);
+        addstatement(statements,cassignmentnode.create(
+          ctemprefnode.create(temp),
+          t1));
+        { create a new for node, it is cheaper than cloning entire loop body }
+        addstatement(statements,cfornode.create(
+          left,right,ctemprefnode.create(temp),t2,lnf_backward in loopflags));
+        addstatement(statements,ctempdeletenode.create(temp));
+        { all child nodes are reused }
+        left:=nil;
+        right:=nil;
+        t1:=nil;
+        t2:=nil;
+      end;
+
+
     function tfornode.pass_typecheck:tnode;
       var
         res : tnode;
@@ -1532,11 +1567,14 @@ implementation
          firstpass(t1);
 
          if assigned(t2) then
-          begin
-            firstpass(t2);
-            if codegenerror then
-             exit;
-          end;
+           firstpass(t2);
+         if codegenerror then
+           exit;
+
+         { 'to' value must be evaluated once before loop, so its possible modifications
+           inside loop body do not affect the number of iterations (see webtbs/tw8883). }
+         if not (t1.nodetype in [ordconstn,temprefn]) then
+           result:=wrap_to_value;
       end;