+ support for replacing the memory location of a temp (including

    local variables) with that of another temp to avoid unnecessary
    copies (mantis #8283)

git-svn-id: branches/fpc_2_3@6380 -

.gitattributes

@@ -8035,6 +8035,7 @@ tests/webtbs/tw8232.pp svneol=native#text/plain
 tests/webtbs/tw8258.pp svneol=native#text/plain
 tests/webtbs/tw8258a.pp svneol=native#text/plain
 tests/webtbs/tw8264.pp svneol=native#text/plain
+tests/webtbs/tw8283.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/ncgld.pas

@@ -27,12 +27,13 @@ unit ncgld;
 interface
 
     uses
-      node,nld;
+      node,nld,cgutils;
 
     type
        tcgloadnode = class(tloadnode)
           procedure pass_generate_code;override;
           procedure generate_picvaraccess;virtual;
+          procedure changereflocation(const ref: treference);
        end;
 
        tcgassignmentnode = class(tassignmentnode)
@@ -54,6 +55,7 @@ implementation
       cutils,
       systems,
       verbose,globtype,globals,
+      nutils,
       symconst,symtype,symdef,symsym,defutil,paramgr,
       ncnv,ncon,nmem,nbas,ncgrtti,
       aasmbase,aasmtai,aasmdata,aasmcpu,
@@ -61,9 +63,119 @@ implementation
       procinfo,
       cpubase,parabase,
       tgobj,ncgutil,
-      cgutils,cgobj,
+      cgobj,
       ncgbas,ncgflw;
 
+{*****************************************************************************
+                   SSA (for memory temps) support
+*****************************************************************************}
+
+    type
+      preplacerefrec = ^treplacerefrec;
+      treplacerefrec = record
+        old, new: preference;
+        ressym: tsym;
+      end;
+
+    function doreplaceref(var n: tnode; para: pointer): foreachnoderesult;
+      var
+        rr: preplacerefrec absolute para;
+      begin
+        result := fen_false;
+        case n.nodetype of
+          loadn:
+            begin
+                 { regular variable }
+              if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
+                 not assigned(tloadnode(n).left) and
+                 { not function result, or no exit in function }
+                 (((tloadnode(n).symtableentry <> rr^.ressym) and
+                   not(vo_is_funcret in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) or
+                  not(fc_exit in flowcontrol)) and
+                 { stored in memory... }
+                 (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_REFERENCE]) and
+                 { ... at the place we are looking for }
+                 references_equal(tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.reference,rr^.old^) then
+                begin
+                  { relocate variable }
+                  tcgloadnode(n).changereflocation(rr^.new^);
+                  result := fen_norecurse_true;
+                end;
+            end;
+          temprefn:
+            begin
+              if (ttemprefnode(n).tempinfo^.valid) and
+                 { memory temp... }
+                 (ttemprefnode(n).tempinfo^.location.loc in [LOC_REFERENCE]) and
+                 { ... at the place we are looking for }
+                 references_equal(ttemprefnode(n).tempinfo^.location.reference,rr^.old^) then
+                begin
+                  { relocate the temp }
+                  tcgtemprefnode(n).changelocation(rr^.new^);
+                  result := fen_norecurse_true;
+                end;
+            end;
+          { optimize the searching a bit }
+          derefn,addrn,
+          calln,inlinen,casen,
+          addn,subn,muln,
+          andn,orn,xorn,
+          ltn,lten,gtn,gten,equaln,unequaln,
+          slashn,divn,shrn,shln,notn,
+          inn,
+          asn,isn:
+            result := fen_norecurse_false;
+        end;
+      end;
+
+
+    function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;
+      var
+        rr: treplacerefrec;
+      begin
+        result := false;
+
+           { only do for -O2 or higher (breaks debugging since }
+           { variables move to different memory locations)     }
+        if not(cs_opt_level2 in current_settings.optimizerswitches) or
+           { must be a copy to a memory location ... }
+           (n.location.loc <> LOC_REFERENCE) or
+           { not inside a control flow statement and no goto's in sight }
+           ([fc_inflowcontrol,fc_gotolabel] * flowcontrol <> []) or
+           { source and destination are temps (= not global variables) }
+           not tg.istemp(n.location.reference) or
+           not tg.istemp(newref) or
+           { and both point to the start of a temp, and the source is a }
+           { non-persistent temp (otherwise we need some kind of copy-  }
+           { on-write support in case later on both are still used)     }
+           (tg.gettypeoftemp(newref) <> tt_normal) or
+           not (tg.gettypeoftemp(n.location.reference) in [tt_normal,tt_persistent]) or
+           { and both have the same size }
+           (tg.sizeoftemp(current_asmdata.CurrAsmList,newref) <> tg.sizeoftemp(current_asmdata.CurrAsmList,n.location.reference)) then
+          exit;
+
+        { find the source of the old reference (loadnode or tempnode) }
+        { and replace it with the new reference                       }
+        rr.old := @n.location.reference;
+        rr.new := @newref;
+        rr.ressym := nil;
+
+        if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
+           assigned(current_procinfo.procdef.funcretsym) and
+           (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
+          if (current_procinfo.procdef.proctypeoption=potype_constructor) then
+            rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
+         else
+            rr.ressym:=current_procinfo.procdef.funcretsym;
+
+        { if source not found, don't do anything }
+        if not foreachnodestatic(n,@doreplaceref,@rr) then
+          exit;
+
+        n.location.reference := newref;
+        result:=true;
+      end;
+
 {*****************************************************************************
                              SecondLoad
 *****************************************************************************}
@@ -77,6 +189,24 @@ implementation
       end;
 
 
+    procedure tcgloadnode.changereflocation(const ref: treference);
+      var
+        oldtemptype: ttemptype;
+      begin
+        if (location.loc<>LOC_REFERENCE) then
+          internalerror(2007020812);
+        if not tg.istemp(location.reference) then
+          internalerror(2007020813);
+        oldtemptype:=tg.gettypeoftemp(location.reference);
+        if (oldtemptype = tt_persistent) then
+          tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,tt_normal);
+        tg.ungettemp(current_asmdata.CurrAsmList,location.reference);
+        location.reference:=ref;
+        tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,oldtemptype);
+        tabstractnormalvarsym(symtableentry).localloc:=location;
+      end;
+
+
     procedure tcgloadnode.pass_generate_code;
       var
         hregister : tregister;
@@ -451,26 +581,7 @@ implementation
 
         releaseright:=true;
 
-        { optimize temp to temp copies }
-{$ifdef old_append_str}
-        if (left.nodetype = temprefn) and
-           { we may store certain temps in registers in the future, then this }
-           { optimization will have to be adapted                             }
-           (left.location.loc = LOC_REFERENCE) and
-           (right.location.loc = LOC_REFERENCE) and
-           tg.istemp(right.location.reference) and
-           (tg.sizeoftemp(current_asmdata.CurrAsmList,right.location.reference) = tg.sizeoftemp(current_asmdata.CurrAsmList,left.location.reference)) then
-          begin
-            { in theory, we should also make sure the left temp type is   }
-            { already more or less of the same kind (ie. we must not      }
-            { assign an ansistring to a normaltemp). In practice, the     }
-            { assignment node will have already taken care of this for us }
-            tcgtemprefnode(left).changelocation(right.location.reference);
-          end
         { shortstring assignments are handled separately }
-        else
-{$endif old_append_str}
-
         if is_shortstring(left.resultdef) then
           begin
             {
@@ -526,6 +637,13 @@ implementation
             else
               internalerror(200204249);
           end
+       { try to reuse memory locations instead of copying }
+           { copy to a memory location ... }
+        else if (right.location.loc = LOC_REFERENCE) and
+           maybechangetemp(current_asmdata.CurrAsmList,left,right.location.reference) then
+          begin
+            { if it worked, we're done }
+          end
         else
           begin
             { SSA support }

compiler/tgobj.pas

@@ -86,6 +86,7 @@ unit tgobj;
 
           function sizeoftemp(list: TAsmList; const ref: treference): longint;
           function changetemptype(list: TAsmList; const ref:treference;temptype:ttemptype):boolean;
+          function gettypeoftemp(const ref:treference): ttemptype;
 
           {# Returns TRUE if the reference ref is allocated in temporary volatile memory space,
              otherwise returns FALSE.
@@ -563,7 +564,7 @@ implementation
       end;
 
 
-    function ttgobj.ChangeTempType(list: TAsmList; const ref:treference;temptype:ttemptype):boolean;
+    function ttgobj.changetemptype(list: tasmList; const ref:treference; temptype:ttemptype):boolean;
       var
         hp : ptemprecord;
       begin
@@ -604,6 +605,27 @@ implementation
       end;
 
 
+    function ttgobj.gettypeoftemp(const ref:treference): ttemptype;
+      var
+        hp : ptemprecord;
+      begin
+         hp:=templist;
+         while assigned(hp) do
+          begin
+            if (hp^.pos=ref.offset) then
+             begin
+               if hp^.temptype<>tt_free then
+                 result:=hp^.temptype
+               else
+                 internalerror(2007020810);
+               exit;
+             end;
+            hp:=hp^.next;
+          end;
+        result:=tt_none;
+      end;
+
+
     procedure ttgobj.UnGetTemp(list: TAsmList; const ref : treference);
       begin
         FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent]);

tests/webtbs/tw8283.pp

@@ -0,0 +1,64 @@
+{ %opt=-O2 }
+
+type
+  Int96 = packed record
+    case Integer of
+      0:
+        (
+          {$IFDEF ENDIAN_LITTLE}
+          Lo32 : DWord;
+          case Integer of
+            0:
+              (
+                Mid32 : DWord;
+                Hi32 : LongInt;
+              );
+            1:
+              ( Hi64: Int64; );
+          {$ELSE ENDIAN_LITTLE}
+          Hi32 : LongInt;
+          case Integer of
+            0:
+              (
+                Mid32 : DWord;
+                Lo32 : DWord;
+              );
+            1:
+              ( Lo64: QWord; );
+          {$ENDIF ENDIAN_LITTLE}
+        );
+      1:
+        (
+          {$IFDEF ENDIAN_LITTLE}
+          Lo64 : QWord;
+          {$ELSE ENDIAN_LITTLE}
+          Hi64 : Int64;
+          {$ENDIF ENDIAN_LITTLE}
+        );
+  end;
+
+function f: int96;
+begin
+end;
+
+operator := (const Right: QWord) Result : Int96; inline;
+var
+  c: int96;
+begin
+  c := f;
+  Result.Lo64 := Right;
+  Result.Hi32 := 0;
+end;
+
+procedure Test;
+var
+  a : Int96;
+begin
+  a := 500000000000000;
+  if (a.lo64 <> 500000000000000) then
+    halt(1);
+end;
+
+begin
+  test
+end.