* fixed tail recursion optimization for code using methodpointerinit/done

git-svn-id: trunk@4896 -

compiler/node.pas

@@ -111,6 +111,9 @@ interface
           loadparentfpn  { Load the framepointer of the parent for nested procedures }
        );
 
+       tnodetypeset = set of tnodetype;
+       pnodetypeset = ^tnodetypeset;
+
       const
         nodetype2str : array[tnodetype] of string[24] = (
           '<emptynode>',

compiler/nutils.pas

@@ -55,6 +55,11 @@ interface
     function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
     function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
 
+    { checks if the given node tree contains only nodes of the given type,
+      if this isn't the case, an ie is thrown
+    }
+    procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
+
     procedure load_procvar_from_calln(var p1:tnode);
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
     function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
@@ -225,6 +230,20 @@ implementation
       end;
 
 
+    function do_check(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        if not(n.nodetype in pnodetypeset(arg)^) then
+          internalerror(200610141);
+        result:=fen_true;
+      end;
+
+
+    procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
+      begin
+        foreachnodestatic(n,@do_check,@typeset);
+      end;
+
+
     procedure load_procvar_from_calln(var p1:tnode);
       var
         p2 : tnode;

compiler/opttail.pas

@@ -36,7 +36,7 @@ unit opttail;
       globtype,
       symconst,symsym,
       defcmp,
-      nbas,nflw,ncal,nld,ncnv,
+      nutils,nbas,nflw,ncal,nld,ncnv,
       pass_1,
       paramgr;
 
@@ -76,6 +76,7 @@ unit opttail;
           paranode : tcallparanode;
           tempnode : ttempcreatenode;
           loadnode : tloadnode;
+          oldnodetree : tnode;
         begin
           { no tail call found and replaced so far }
           result:=false;
@@ -140,14 +141,32 @@ unit opttail;
                         paranode:=tcallparanode(paranode.right);
                       end;
 
-                    n.free;
+                    oldnodetree:=n;
                     n:=internalstatements(nodes);
+
+                    if assigned(usedcallnode.methodpointerinit) then
+                      begin
+                        addstatement(nodes,usedcallnode.methodpointerinit);
+                        usedcallnode.methodpointerinit:=nil;
+                      end;
+
                     addstatement(nodes,calcnodes);
                     addstatement(nodes,copynodes);
 
                     { create goto }
                     addstatement(nodes,cgotonode.create(labelnode));
 
+                    if assigned(usedcallnode.methodpointerdone) then
+                      begin
+                        { methodpointerdone should contain only temp. node clean up }
+                        checktreenodetypes(usedcallnode.methodpointerdone,
+                          [tempdeleten,blockn,statementn,temprefn,nothingn]);
+                        addstatement(nodes,usedcallnode.methodpointerdone);
+                        usedcallnode.methodpointerdone:=nil;
+                      end;
+
+                    oldnodetree.free;
+
                     do_firstpass(n);
                     result:=true;
                   end;