* gen high tree makes copy in temp when there is a calln

compiler/nbas.pas

@@ -193,6 +193,7 @@ interface
        { Create a blocknode and statement node for multiple statements
          generated internally by the parser }
        function  internalstatements(var laststatement:tstatementnode):tblocknode;
+       function  laststatement(block:tblocknode):tstatementnode;
        procedure addstatement(var laststatement:tstatementnode;n:tnode);
 
 
@@ -220,6 +221,14 @@ implementation
       end;
 
 
+    function laststatement(block:tblocknode):tstatementnode;
+      begin
+        result:=tstatementnode(block.left);
+        while assigned(result) do
+          result:=tstatementnode(result.right);
+      end;
+
+
     procedure addstatement(var laststatement:tstatementnode;n:tnode);
       begin
         if assigned(laststatement.right) then
@@ -1018,7 +1027,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.87  2004-09-26 17:45:30  peter
+  Revision 1.88  2004-10-12 14:36:38  peter
+    * gen high tree makes copy in temp when there is a calln
+
+  Revision 1.87  2004/09/26 17:45:30  peter
     * simple regvar support, not yet finished
 
   Revision 1.86  2004/07/16 19:45:15  jonas

compiler/ncal.pas

@@ -87,7 +87,7 @@ interface
           procdefinitionderef : tderef;
           { tree that contains the pointer to the object for this method }
           methodpointerinit,
-          methodpointerdone,
+          methodpointerdone : tblocknode;
           methodpointer  : tnode;
           { inline function body }
           inlinecode : tnode;
@@ -220,7 +220,58 @@ type
       end;
 
 
-    function gen_high_tree(p:tnode;paradef:tdef):tnode;
+    procedure maybe_load_para_in_temp(var p:tnode);
+      var
+        hp    : tnode;
+        ptemp : ttempcreatenode;
+        newinitstatement,
+        newdonestatement : tstatementnode;
+      begin
+        if not assigned(aktcallnode) then
+          internalerror(200410121);
+
+        hp:=p;
+        while assigned(hp) and
+              (hp.nodetype=typeconvn) do
+          hp:=tunarynode(hp).left;
+        if assigned(hp) and
+           (
+            { call result must always be loaded in temp to prevent
+              double creation }
+            (hp.nodetype=calln)
+            { Also optimize also complex loads }
+{$warning Complex loads can also be optimized}
+//            or not(hp.nodetype in [typen,loadvmtaddrn,loadn])
+           )  then
+          begin
+            if not assigned(aktcallnode.methodpointerinit) then
+              begin
+                aktcallnode.methodpointerinit:=internalstatements(newinitstatement);
+                aktcallnode.methodpointerdone:=internalstatements(newdonestatement);
+              end
+            else
+              begin
+                newinitstatement:=laststatement(aktcallnode.methodpointerinit);
+                newdonestatement:=laststatement(aktcallnode.methodpointerdone);
+              end;
+            { temp create }
+            ptemp:=ctempcreatenode.create_reg(p.resulttype,p.resulttype.def.size,tt_persistent);
+            addstatement(newinitstatement,ptemp);
+            addstatement(newinitstatement,cassignmentnode.create(
+                ctemprefnode.create(ptemp),
+                p));
+            resulttypepass(aktcallnode.methodpointerinit);
+            { new tree is only a temp reference }
+            p:=ctemprefnode.create(ptemp);
+            resulttypepass(p);
+            { temp release }
+            addstatement(newdonestatement,ctempdeletenode.create(ptemp));
+            resulttypepass(aktcallnode.methodpointerdone);
+          end;
+      end;
+
+
+    function gen_high_tree(var p:tnode;paradef:tdef):tnode;
       var
         temp: tnode;
         len : integer;
@@ -240,6 +291,7 @@ type
                 len:=0
               else
                 begin
+                  maybe_load_para_in_temp(p);
                   { handle via a normal inline in_high_x node }
                   loadconst := false;
                   hightree := geninlinenode(in_high_x,false,p.getcopy);
@@ -258,6 +310,7 @@ type
             begin
               if is_open_string(paradef) then
                begin
+                 maybe_load_para_in_temp(p);
                  { handle via a normal inline in_high_x node }
                  loadconst := false;
                  hightree := geninlinenode(in_high_x,false,p.getcopy);
@@ -273,6 +326,7 @@ type
                    end
                  else
                    begin
+                     maybe_load_para_in_temp(p);
                      hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
                                                cordconstnode.create(1,s32inttype,false));
                      loadconst:=false;
@@ -789,8 +843,8 @@ type
         ppufile.getderef(procdefinitionderef);
         ppufile.getsmallset(callnodeflags);
         methodpointer:=ppuloadnode(ppufile);
-        methodpointerinit:=ppuloadnode(ppufile);
-        methodpointerdone:=ppuloadnode(ppufile);
+        methodpointerinit:=tblocknode(ppuloadnode(ppufile));
+        methodpointerdone:=tblocknode(ppuloadnode(ppufile));
         _funcretnode:=ppuloadnode(ppufile);
         inlinecode:=ppuloadnode(ppufile);
       end;
@@ -885,7 +939,7 @@ type
         n.restype := restype;
         n.callnodeflags := callnodeflags;
         if assigned(methodpointerinit) then
-         n.methodpointerinit:=methodpointerinit.getcopy
+         n.methodpointerinit:=tblocknode(methodpointerinit.getcopy)
         else
          n.methodpointerinit:=nil;
         { methodpointerinit is copied, now references to the temp will also be copied
@@ -899,7 +953,7 @@ type
         else
          n.methodpointer:=nil;
         if assigned(methodpointerdone) then
-         n.methodpointerdone:=methodpointerdone.getcopy
+         n.methodpointerdone:=tblocknode(methodpointerdone.getcopy)
         else
          n.methodpointerdone:=nil;
         if assigned(_funcretnode) then
@@ -1352,8 +1406,6 @@ type
         method_must_be_valid,
         is_const : boolean;
         hp : tnode;
-        mptemp : ttempcreatenode;
-        newstatement : tstatementnode;
       label
         errorexit;
       begin
@@ -1361,7 +1413,7 @@ type
          candidates:=nil;
 
          oldcallnode:=aktcallnode;
-         aktcallnode:=nil;
+         aktcallnode:=self;
 
          { determine length of parameter list }
          pt:=tcallparanode(left);
@@ -1383,35 +1435,7 @@ type
          if assigned(methodpointer) then
            begin
              resulttypepass(methodpointer);
-             hp:=methodpointer;
-             while assigned(hp) and
-                   (hp.nodetype=typeconvn) do
-               hp:=tunarynode(hp).left;
-             if assigned(hp) and
-                (
-                 { call result must always be loaded in temp to prevent
-                   double creation }
-                 (hp.nodetype=calln)
-                 { Also optimize also complex loads }
-{$warning Complex loads can also be optimized}
-//                 not(hp.nodetype in [typen,loadvmtaddrn,loadn])
-                )  then
-               begin
-                 { methodpointer loading }
-                 methodpointerinit:=internalstatements(newstatement);
-                 mptemp:=ctempcreatenode.create_reg(methodpointer.resulttype,methodpointer.resulttype.def.size,tt_persistent);
-                 addstatement(newstatement,mptemp);
-                 addstatement(newstatement,cassignmentnode.create(
-                     ctemprefnode.create(mptemp),
-                     methodpointer));
-                 resulttypepass(methodpointerinit);
-                 { new methodpointer is only a temp reference }
-                 methodpointer:=ctemprefnode.create(mptemp);
-                 resulttypepass(methodpointer);
-                 { methodpointer cleanup }
-                 methodpointerdone:=ctempdeletenode.create(mptemp);
-                 resulttypepass(methodpointerdone);
-               end;
+             maybe_load_para_in_temp(methodpointer);
            end;
 
          { procedure variable ? }
@@ -1745,7 +1769,6 @@ type
            convert_carg_array_of_const;
 
          { bind paraitems to the callparanodes and insert hidden parameters }
-         aktcallnode:=self;
          bind_paraitem;
 
          { methodpointer is only needed for virtual calls, and
@@ -2392,7 +2415,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.250  2004-10-10 20:22:53  peter
+  Revision 1.251  2004-10-12 14:36:38  peter
+    * gen high tree makes copy in temp when there is a calln
+
+  Revision 1.250  2004/10/10 20:22:53  peter
     * symtable allocation rewritten
     * loading of parameters to local temps/regs cleanup
     * regvar support for parameters

compiler/pdecvar.pas

@@ -169,7 +169,7 @@ implementation
                                      IncompatibleTypes(p.resulttype.def,tarraydef(def).rangetype.def);
                                  end
                                else
-                                Message(parser_e_illegal_expression)
+                                Message(type_e_ordinal_expr_expected)
                              end;
                             p.free;
                             pl.addconst(sl_vec,idx);
@@ -334,7 +334,7 @@ implementation
               consume(_COLON);
               { insert types in global symtable }
               oldsymtablestack:=symtablestack;
-	      while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
+              while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
                 symtablestack:=symtablestack.next;
               single_type(p.proptype,hs,false);
               symtablestack:=oldsymtablestack;
@@ -769,7 +769,7 @@ implementation
                   newtype.free;
                end;
 {$ifdef powerpc}
-               { from gcc/gcc/config/rs6000/rs6000.h: 
+               { from gcc/gcc/config/rs6000/rs6000.h:
                 /* APPLE LOCAL begin Macintosh alignment 2002-1-22 ff */
                 /* Return the alignment of a struct based on the Macintosh PowerPC
                    alignment rules.  In general the alignment of a struct is
@@ -791,7 +791,7 @@ implementation
                      maxpadalign := tempdef.alignment
                    else
                      maxpadalign := trecorddef(tempdef).padalignment;
-                       
+
                    if (maxpadalign > 4) and
                       (maxpadalign > trecordsymtable(symtablestack).padalignment) then
                      trecordsymtable(symtablestack).padalignment := maxpadalign;
@@ -1288,7 +1288,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.79  2004-08-17 16:29:21  jonas
+  Revision 1.80  2004-10-12 14:36:38  peter
+    * gen high tree makes copy in temp when there is a calln
+
+  Revision 1.79  2004/08/17 16:29:21  jonas
     + padalgingment field for recordsymtables (saved by recorddefs)
     + support for Macintosh PowerPC alignment (if the first field of a record
       or union has an alignment > 4, then the record or union size must be