+ ability to change the location of a ttempref node with changelocation()

    method. Useful to use instead of copying the contents from one temp to
    another
  + some shortstring optimizations in tassignmentnode that avoid some
    copying (required some shortstring optimizations to be moved from
    resulttype to firstpass, because they work on callnodes and string
    addnodes are only changed to callnodes in the firstpass)
  * allow setting/changing the funcretnode of callnodes after the
    resulttypepass has been done, funcretnode is now a property
  (all of the above should have a quite big effect on callparatemp)

compiler/nbas.pas

@@ -127,6 +127,11 @@ interface
           function det_resulttype : tnode; override;
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
+          { Changes the location of this temp to ref. Useful when assigning }
+          { another temp to this one. The current location will be freed.   }
+          { Can only be called in pass 2 (since earlier, the temp location  }
+          { isn't known yet)                                                }
+          procedure changelocation(const ref: treference);
          protected
           tempinfo: ptempinfo;
           offset : longint;
@@ -715,6 +720,22 @@ implementation
     end;
 
 
+    procedure ttemprefnode.changelocation(const ref: treference);
+      begin
+        { check if the temp is valid }
+        if not tempinfo^.valid then
+          internalerror(200306081);
+        if (tempinfo^.temptype = tt_persistent) then
+          tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal);
+        tg.ungettemp(exprasmlist,tempinfo^.ref);
+        tempinfo^.ref := ref;
+        tg.ChangeTempType(exprasmlist,tempinfo^.ref,tempinfo^.temptype);
+        { adapt location }
+        location.reference := ref;
+        inc(location.reference.offset,offset);
+      end;
+
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -802,7 +823,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2003-05-30 21:01:44  jonas
+  Revision 1.54  2003-06-08 18:27:15  jonas
+    + ability to change the location of a ttempref node with changelocation()
+      method. Useful to use instead of copying the contents from one temp to
+      another
+    + some shortstring optimizations in tassignmentnode that avoid some
+      copying (required some shortstring optimizations to be moved from
+      resulttype to firstpass, because they work on callnodes and string
+      addnodes are only changed to callnodes in the firstpass)
+    * allow setting/changing the funcretnode of callnodes after the
+      resulttypepass has been done, funcretnode is now a property
+    (all of the above should have a quite big effect on callparatemp)
+
+  Revision 1.53  2003/05/30 21:01:44  jonas
     - disabled "result := value; exit;" -> exit(value) optimization because
       a) it was wrong
       b) exit(value) works now exactly the same as that

compiler/ncal.pas

@@ -69,6 +69,11 @@ interface
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
           procedure bind_paraitem;
+
+          { function return node, this is used to pass the data for a
+            ret_in_param return value }
+          _funcretnode    : tnode;
+          procedure setfuncretnode(const returnnode: tnode);
        public
           { the symbol containing the definition of the procedure }
           { to call                                               }
@@ -81,11 +86,12 @@ interface
           procdefinitionderef : tderef;
           { tree that contains the pointer to the object for this method }
           methodpointer  : tnode;
-          { function return node, this is used to pass the data for a
-            ret_in_param return value }
-          funcretnode    : tnode;
           { inline function body }
           inlinecode : tnode;
+          { node that specifies where the result should be put for calls }
+          { that return their result in a parameter                      }
+          property funcretnode: tnode read _funcretnode write setfuncretnode;
+          
 
           { separately specified resulttype for some compilerprocs (e.g. }
           { you can't have a function with an "array of char" resulttype }
@@ -874,7 +880,7 @@ type
          methodpointer:=mp;
          procdefinition:=nil;
          restypeset:=false;
-         funcretnode:=nil;
+         _funcretnode:=nil;
          inlinecode:=nil;
          paralength:=-1;
       end;
@@ -889,7 +895,7 @@ type
          methodpointer:=mp;
          procdefinition:=def;
          restypeset:=false;
-         funcretnode:=nil;
+         _funcretnode:=nil;
          inlinecode:=nil;
          paralength:=-1;
       end;
@@ -904,7 +910,7 @@ type
          methodpointer:=nil;
          procdefinition:=nil;
          restypeset:=false;
-         funcretnode:=nil;
+         _funcretnode:=nil;
          inlinecode:=nil;
          paralength:=-1;
       end;
@@ -954,16 +960,45 @@ type
     constructor tcallnode.createinternreturn(const name: string; params: tnode; returnnode : tnode);
       begin
         self.createintern(name,params);
-        funcretnode:=returnnode;
+        _funcretnode:=returnnode;
         if not paramanager.ret_in_param(symtableprocentry.first_procdef.rettype.def,symtableprocentry.first_procdef.proccalloption) then
           internalerror(200204247);
       end;
 
 
+    procedure tcallnode.setfuncretnode(const returnnode: tnode);
+      var
+        para: tcallparanode;
+      begin
+        if assigned(_funcretnode) then
+          _funcretnode.free;
+        _funcretnode := returnnode;
+        { if the resulttype pass hasn't occurred yet, that one will do }
+        { everything                                                   }
+        if assigned(resulttype.def) then
+          begin
+            para := tcallparanode(left);
+            while assigned(para) do
+              begin
+                if para.paraitem.is_hidden and
+                   (vo_is_funcret in tvarsym(para.paraitem.parasym).varoptions) then
+                 begin
+                   para.left.free;
+                   para.left := _funcretnode.getcopy;
+                   exit;
+                 end;
+                 para := tcallparanode(para.right);
+              end;
+            { no hidden resultpara found, error! }
+            internalerror(200306087);
+          end;
+      end;
+
+
     destructor tcallnode.destroy;
       begin
          methodpointer.free;
-         funcretnode.free;
+         _funcretnode.free;
          inlinecode.free;
          inherited destroy;
       end;
@@ -980,7 +1015,7 @@ type
         ppufile.getderef(procdefinitionderef);
         restypeset:=boolean(ppufile.getbyte);
         methodpointer:=ppuloadnode(ppufile);
-        funcretnode:=ppuloadnode(ppufile);
+        _funcretnode:=ppuloadnode(ppufile);
         inlinecode:=ppuloadnode(ppufile);
       end;
 
@@ -992,7 +1027,7 @@ type
         ppufile.putderef(procdefinition,procdefinitionderef);
         ppufile.putbyte(byte(restypeset));
         ppuwritenode(ppufile,methodpointer);
-        ppuwritenode(ppufile,funcretnode);
+        ppuwritenode(ppufile,_funcretnode);
         ppuwritenode(ppufile,inlinecode);
       end;
 
@@ -1005,8 +1040,8 @@ type
         procdefinition:=tprocdef(procdefinitionderef.resolve);
         if assigned(methodpointer) then
           methodpointer.derefimpl;
-        if assigned(funcretnode) then
-          funcretnode.derefimpl;
+        if assigned(_funcretnode) then
+          _funcretnode.derefimpl;
         if assigned(inlinecode) then
           inlinecode.derefimpl;
       end;
@@ -1026,10 +1061,10 @@ type
          n.methodpointer:=methodpointer.getcopy
         else
          n.methodpointer:=nil;
-        if assigned(funcretnode) then
-         n.funcretnode:=funcretnode.getcopy
+        if assigned(_funcretnode) then
+         n._funcretnode:=_funcretnode.getcopy
         else
-         n.funcretnode:=nil;
+         n._funcretnode:=nil;
         if assigned(inlinecode) then
          n.inlinecode:=inlinecode.getcopy
         else
@@ -2296,8 +2331,8 @@ type
 {$endif callparatemp}
 
          { function result node }
-         if assigned(funcretnode) then
-           firstpass(funcretnode);
+         if assigned(_funcretnode) then
+           firstpass(_funcretnode);
 
          { procedure variable ? }
          if assigned(right) then
@@ -2592,7 +2627,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.166  2003-06-08 11:42:33  peter
+  Revision 1.167  2003-06-08 18:27:15  jonas
+    + ability to change the location of a ttempref node with changelocation()
+      method. Useful to use instead of copying the contents from one temp to
+      another
+    + some shortstring optimizations in tassignmentnode that avoid some
+      copying (required some shortstring optimizations to be moved from
+      resulttype to firstpass, because they work on callnodes and string
+      addnodes are only changed to callnodes in the firstpass)
+    * allow setting/changing the funcretnode of callnodes after the
+      resulttypepass has been done, funcretnode is now a property
+    (all of the above should have a quite big effect on callparatemp)
+
+  Revision 1.166  2003/06/08 11:42:33  peter
     * creating class with abstract call checking fixed
     * there will be only one warning for each class, the methods
       are listed as hint

compiler/ncgld.pas

@@ -50,7 +50,7 @@ implementation
       systems,
       verbose,globtype,globals,
       symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
-      ncnv,ncon,nmem,
+      ncnv,ncon,nmem,nbas,
       aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
@@ -481,8 +481,25 @@ implementation
 
         releaseright:=true;
 
+        { optimize temp to temp copies }
+        if (left.nodetype = temprefn) and
+{$ifdef newra}
+           { we may store certain temps in registers in the future, then this }
+           { optimization will have to be adapted                             }
+           (left.location.loc = LOC_REFERENCE) and
+{$endif newra}
+           (right.location.loc = LOC_REFERENCE) and
+           tg.istemp(right.location.reference) and
+           (tg.sizeoftemp(exprasmlist,right.location.reference) = tg.sizeoftemp(exprasmlist,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 }
+            ttemprefnode(left).changelocation(right.location.reference);
+          end
         { shortstring assignments are handled separately }
-        if is_shortstring(left.resulttype.def) then
+        else if is_shortstring(left.resulttype.def) then
           begin
             {
               we can get here only in the following situations
@@ -935,7 +952,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.67  2003-06-07 18:57:04  jonas
+  Revision 1.68  2003-06-08 18:27:15  jonas
+    + ability to change the location of a ttempref node with changelocation()
+      method. Useful to use instead of copying the contents from one temp to
+      another
+    + some shortstring optimizations in tassignmentnode that avoid some
+      copying (required some shortstring optimizations to be moved from
+      resulttype to firstpass, because they work on callnodes and string
+      addnodes are only changed to callnodes in the firstpass)
+    * allow setting/changing the funcretnode of callnodes after the
+      resulttypepass has been done, funcretnode is now a property
+    (all of the above should have a quite big effect on callparatemp)
+
+  Revision 1.67  2003/06/07 18:57:04  jonas
     + added freeintparaloc
     * ppc get/freeintparaloc now check whether the parameter regs are
       properly allocated/deallocated (and get an extra list para)

compiler/nld.pas

@@ -698,32 +698,6 @@ implementation
           so treat them separatly }
         if (is_shortstring(left.resulttype.def)) then
          begin
-            { test for s:=s+anything ... }
-            { the problem is for
-              s:=s+s+s;
-              this is broken here !! }
-{$ifdef newoptimizations2}
-            { the above is fixed now, but still problem with s := s + f(); if }
-            { f modifies s (bad programming, so only enable if uncertain      }
-            { optimizations are on) (JM)                                      }
-            if (cs_UncertainOpts in aktglobalswitches) then
-              begin
-                hp := right;
-                while hp.treetype=addn do
-                  hp:=hp.left;
-                if left.docompare(hp) then
-                  begin
-                    concat_string:=true;
-                    hp:=right;
-                    while hp.treetype=addn do
-                      begin
-                        hp.use_strconcat:=true;
-                        hp:=hp.left;
-                      end;
-                  end;
-              end;
-{$endif newoptimizations2}
-
            { insert typeconv, except for chars that are handled in
              secondpass and except for ansi/wide string that can
              be converted immediatly }
@@ -737,30 +711,22 @@ implementation
                 skip empty constant strings, that will be handled
                 in secondpass }
               if (right.nodetype=stringconstn) then
-               begin
-                 { verify if range fits within shortstring }
-                 { just emit a warning, delphi gives an    }
-                 { error, only if the type definition of   }
-                 { of the string is less  < 255 characters }
-                 if not is_open_string(left.resulttype.def) and
-                    (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
-                    cgmessage(type_w_string_too_long);
-                 inserttypeconv(right,left.resulttype);
-                 if (tstringconstnode(right).len=0) then
-                  useshelper:=false;
-               end;
-              if useshelper then
-               begin
-                 hp:=ccallparanode.create
-                         (right,
-                     ccallparanode.create(cinlinenode.create
-                         (in_high_x,false,left.getcopy),nil));
-                 result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
-                 left:=nil;
-                 right:=nil;
-                 exit;
-               end;
-            end;
+                begin
+                  { verify if range fits within shortstring }
+                  { just emit a warning, delphi gives an    }
+                  { error, only if the type definition of   }
+                  { of the string is less  < 255 characters }
+                  if not is_open_string(left.resulttype.def) and
+                     (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
+                     cgmessage(type_w_string_too_long);
+                  inserttypeconv(right,left.resulttype);
+                  if (tstringconstnode(right).len=0) then
+                    useshelper:=false;
+                end;
+             { rest is done in pass 1 (JM) }
+             if useshelper then
+               exit;
+            end
          end
         else
           begin
@@ -809,6 +775,8 @@ implementation
 
 
     function tassignmentnode.pass_1 : tnode;
+      var
+        hp: tnode;
       begin
          result:=nil;
          expectloc:=LOC_VOID;
@@ -823,6 +791,68 @@ implementation
          if codegenerror then
            exit;
 
+         
+        if (is_shortstring(left.resulttype.def)) then
+          begin
+           if right.resulttype.def.deftype=stringdef then
+            begin
+              if (right.nodetype<>stringconstn) or
+                 (tstringconstnode(right).len<>0) then
+               begin
+                 if (cs_optimize in aktglobalswitches) and
+                    (right.nodetype in [calln,blockn]) and
+                    (left.nodetype = temprefn) and
+                    is_shortstring(right.resulttype.def) and
+                    not is_open_string(left.resulttype.def) and
+                    (tstringdef(left.resulttype.def).len = 255) then
+                   begin
+                     { the blocknode case is handled in pass_2 at the temp }
+                     { reference level (mainly for callparatemp)  (JM)     }
+                     if (right.nodetype = calln) then
+                       begin
+                         tcallnode(right).funcretnode := left;
+                         result := right;
+                       end
+                     else
+                       exit;
+                   end
+                 else
+                   begin
+                     hp:=ccallparanode.create
+                           (right,
+                      ccallparanode.create(cinlinenode.create
+                           (in_high_x,false,left.getcopy),nil));
+                     result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
+                     firstpass(result);
+                   end;
+                 left:=nil;
+                 right:=nil;
+                 exit;
+               end;
+            end;
+           end;
+
+         if (cs_optimize in aktglobalswitches) and
+            (right.nodetype = calln) and
+            { left must be a temp, since otherwise as soon as you modify the }
+            { result, the current left node is modified and that one may     }
+            { still be an argument to the function or even accessed in the   }
+            { function                                                       }
+            (left.nodetype = temprefn) and
+            { doesn't work correctlyfor refcounted things }
+            not(not is_class(right.resulttype.def) and
+                right.resulttype.def.needs_inittable) and
+            paramanager.ret_in_param(right.resulttype.def,
+             tcallnode(right).procdefinition.proccalloption) then
+           begin
+             tcallnode(right).funcretnode := left;
+             result := right;
+             left := nil;
+             right := nil;
+             exit;
+           end;
+
+
          registers32:=left.registers32+right.registers32;
          registersfpu:=max(left.registersfpu,right.registersfpu);
 {$ifdef SUPPORT_MMX}
@@ -1256,7 +1286,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.99  2003-06-07 20:26:32  peter
+  Revision 1.100  2003-06-08 18:27:15  jonas
+    + ability to change the location of a ttempref node with changelocation()
+      method. Useful to use instead of copying the contents from one temp to
+      another
+    + some shortstring optimizations in tassignmentnode that avoid some
+      copying (required some shortstring optimizations to be moved from
+      resulttype to firstpass, because they work on callnodes and string
+      addnodes are only changed to callnodes in the firstpass)
+    * allow setting/changing the funcretnode of callnodes after the
+      resulttypepass has been done, funcretnode is now a property
+    (all of the above should have a quite big effect on callparatemp)
+
+  Revision 1.99  2003/06/07 20:26:32  peter
     * re-resolving added instead of reloading from ppu
     * tderef object added to store deref info for resolving