* fixed tests/cg/opt/tretopt, and also in more cases

perform the transformation of x:=f(hiddencomplexresult, ..)
    -> f(x, ...) (the compiler now performs some very
    conservative escape analysis for such types)

git-svn-id: trunk@8361 -

compiler/htypechk.pas

@@ -687,19 +687,28 @@ implementation
                else
                  make_not_regable_intern(ttypeconvnode(p).left,how,records_only);
             loadn :
-              if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) and
+              if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
-                 (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
+                begin
-                 ((not records_only) or
+                  { this is overly conservative (make_not_regable is also called in }
-                  (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
+                  { other situations), but it avoids having to do this all over the }
-                if (tloadnode(p).symtableentry.typ = paravarsym) then
+                  { the compiler                                                     }
-                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
+                  tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true;
-                else
+                  if (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
-                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
+                     ((not records_only) or
+                      (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
+                    if (tloadnode(p).symtableentry.typ = paravarsym) then
+                      tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
+                    else
+                      tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
+                end;
             temprefn :
-              if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
+              begin
-                 ((not records_only) or
+                include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken);
-                  (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
+                if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
-                exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
+                   ((not records_only) or
+                    (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
+                  exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
+              end;
          end;
       end;
 

compiler/nbas.pas

@@ -94,11 +94,12 @@ interface
 
        ttempcreatenode = class;
 
-       ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result);
+       ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result,
+        ti_addr_taken);
        ttempinfoflags = set of ttempinfoflag;
 
 const
-       tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result];
+       tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result,ti_addr_taken];
 
 type
        { to allow access to the location by temp references even after the temp has }

compiler/ncal.pas

@@ -2472,6 +2472,9 @@ implementation
                 addstatement(tempinfo^.createstatement,tempnode);
                 addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
               end;
+            { inherit addr_taken flag }
+            if (tabstractvarsym(p).addr_taken) then
+              include(tempnode.tempinfo^.flags,ti_addr_taken);
             inlinelocals[indexnr] := ctemprefnode.create(tempnode);
           end;
       end;
@@ -2629,6 +2632,9 @@ implementation
 
                     tempnode := ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size,tt_persistent,tparavarsym(para.parasym).is_regvar(false));
                     addstatement(createstatement,tempnode);
+                    { inherit addr_taken flag }
+                    if (tabstractvarsym(para.parasym).addr_taken) then
+                      include(tempnode.tempinfo^.flags,ti_addr_taken);
                     { assign the value of the parameter to the temp, except in case of the function result }
                     { (in that case, para.left is a block containing the creation of a new temp, while we  }
                     {  only need a temprefnode, so delete the old stuff)                                   }
@@ -2657,6 +2663,9 @@ implementation
                   begin
                     tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,tparavarsym(para.parasym).is_regvar(true));
                     addstatement(createstatement,tempnode);
+                    { inherit addr_taken flag }
+                    if (tabstractvarsym(para.parasym).addr_taken) then
+                      include(tempnode.tempinfo^.flags,ti_addr_taken);
                     addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
                       caddrnode.create_internal(para.left)));
                     para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resultdef);

compiler/nld.pas

@@ -781,6 +781,16 @@ implementation
          if codegenerror then
            exit;
 
+         { if right is a function call for which the address of the result  }
+         { is allocated by the caller and passed to the function via an     }
+         { invisible function result, try to pass the x in "x:=f(...)" as   }
+         { that function result instead. Condition: x cannot be accessible  }
+         { from within f. This is the case if x is a temp, or x is a local  }
+         { variable or value parameter of the current block and its address }
+         { is not passed to f. One problem: what if someone takes the       }
+         { address of x, puts it in a pointer variable/field and then       }
+         { accesses it that way from within the function? This is solved    }
+         { (in a conservative way) using the ti_addr_taken/addr_taken flags }
          if (cs_opt_level1 in current_settings.optimizerswitches) and
             (right.nodetype = calln) and
             (right.resultdef=left.resultdef) and
@@ -790,7 +800,25 @@ implementation
             { function                                                       }
             (
              (
-              (left.nodetype = temprefn) and
+              (((left.nodetype = temprefn) and
+                not(ti_addr_taken in ttemprefnode(left).tempinfo^.flags) and
+                not(ti_may_be_in_reg in ttemprefnode(left).tempinfo^.flags)) or
+               ((left.nodetype = loadn) and
+                { nested procedures may access the current procedure's locals }
+                (tcallnode(right).procdefinition.parast.symtablelevel=normal_function_level) and
+                { must be a local variable or a value para }
+                ((tloadnode(left).symtableentry.typ = localvarsym) or
+                 ((tloadnode(left).symtableentry.typ = paravarsym) and
+                  (tparavarsym(tloadnode(left).symtableentry).varspez = vs_value)
+                 )
+                ) and
+                { the address may not have been taken of the variable/parameter, because }
+                { otherwise it's possible that the called function can access it via a   }
+                { global variable or other stored state                                  }
+                not(tabstractvarsym(tloadnode(left).symtableentry).addr_taken) and
+                (tabstractvarsym(tloadnode(left).symtableentry).varregable in [vr_none,vr_addr])
+               )
+              ) and
               paramanager.ret_in_param(right.resultdef,tcallnode(right).procdefinition.proccalloption)
              ) or
              { there's special support for ansi/widestrings in the callnode }
@@ -798,7 +826,8 @@ implementation
              is_widestring(right.resultdef)
             )  then
            begin
-             make_not_regable(left,vr_addr);
+             if assigned(tcallnode(right).funcretnode) then
+               internalerror(2007080201);
              tcallnode(right).funcretnode := left;
              result := right;
              left := nil;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=84;
+  CurrentPPUVersion=85;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/symsym.pas

@@ -119,10 +119,15 @@ interface
 
        tabstractvarsym = class(tstoredsym)
           varoptions    : tvaroptions;
+          notifications : Tlinkedlist;
           varspez       : tvarspez;  { sets the type of access }
           varregable    : tvarregable;
           varstate      : tvarstate;
-          notifications : Tlinkedlist;
+          { Has the address of this variable potentially escaped the }
+          { block in which is was declared?                          }
+          { could also be part of tabstractnormalvarsym, but there's }
+          { one byte left here till the next 4 byte alignment        }
+          addr_taken     : boolean;
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -922,6 +927,7 @@ implementation
          varstate:=vs_readwritten;
          varspez:=tvarspez(ppufile.getbyte);
          varregable:=tvarregable(ppufile.getbyte);
+         addr_taken:=boolean(ppufile.getbyte);
          ppufile.getderef(vardefderef);
          ppufile.getsmallset(varoptions);
       end;
@@ -964,6 +970,7 @@ implementation
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
          ppufile.putbyte(byte(varregable));
+         ppufile.putbyte(byte(addr_taken));
          ppufile.do_crc:=oldintfcrc;
          ppufile.putderef(vardefderef);
          ppufile.putsmallset(varoptions);