浏览代码

* make fparainit and fparacopyback public
+ process fparainit and fparacopyback in foreachnode
+ print fparainit and fparacopyback
+ do not break if tcallparanode.copy_value_by_ref_para is called multiple times

git-svn-id: trunk@45236 -

florian 5 年之前
父节点
当前提交
b80d051249
共有 2 个文件被更改,包括 49 次插入7 次删除
  1. 39 7
      compiler/ncal.pas
  2. 10 0
      compiler/nutils.pas

+ 39 - 7
compiler/ncal.pas

@@ -228,18 +228,17 @@ interface
        private
        private
           fcontains_stack_tainting_call_cached,
           fcontains_stack_tainting_call_cached,
           ffollowed_by_stack_tainting_call_cached : boolean;
           ffollowed_by_stack_tainting_call_cached : boolean;
-       protected
-          { in case of copy-out parameters: initialization code, and the code to
-            copy back the parameter value after the call (including any required
-            finalization code) }
-          fparainit,
-          fparacopyback: tnode;
           procedure handlemanagedbyrefpara(orgparadef: tdef);virtual;
           procedure handlemanagedbyrefpara(orgparadef: tdef);virtual;
           { on some targets, value parameters that are passed by reference must
           { on some targets, value parameters that are passed by reference must
             be copied to a temp location by the caller (and then a reference to
             be copied to a temp location by the caller (and then a reference to
             this temp location must be passed) }
             this temp location must be passed) }
           procedure copy_value_by_ref_para;
           procedure copy_value_by_ref_para;
        public
        public
+          { in case of copy-out parameters: initialization code, and the code to
+            copy back the parameter value after the call (including any required
+            finalization code) }
+          fparainit,
+          fparacopyback: tnode;
           callparaflags : tcallparaflags;
           callparaflags : tcallparaflags;
           parasym       : tparavarsym;
           parasym       : tparavarsym;
           { only the processor specific nodes need to override this }
           { only the processor specific nodes need to override this }
@@ -745,6 +744,9 @@ implementation
           to be copied by the caller. It's basically the node-level equivalent
           to be copied by the caller. It's basically the node-level equivalent
           of thlcgobj.g_copyvalueparas }
           of thlcgobj.g_copyvalueparas }
 
 
+        if assigned(fparainit) then
+          exit;
+
         { in case of an array constructor, we don't need a copy since the array
         { in case of an array constructor, we don't need a copy since the array
           constructor itself is already constructed on the fly (and hence if
           constructor itself is already constructed on the fly (and hence if
           it's modified by the caller, that's no problem) }
           it's modified by the caller, that's no problem) }
@@ -1462,8 +1464,38 @@ implementation
 
 
 
 
     procedure tcallparanode.printnodetree(var t:text);
     procedure tcallparanode.printnodetree(var t:text);
+      var
+        hp: tbinarynode;
       begin
       begin
-        printnodelist(t);
+        hp:=self;
+        while assigned(hp) do
+         begin
+           write(t,printnodeindention,'(');
+           printnodeindent;
+           hp.printnodeinfo(t);
+           writeln(t);
+           if assigned(tcallparanode(hp).fparainit) then
+             begin
+               writeln(t,printnodeindention,'(parainit =');
+               printnodeindent;
+               printnode(t,tcallparanode(hp).fparainit);
+               printnodeunindent;
+               writeln(t,printnodeindention,')');
+             end;
+           if assigned(tcallparanode(hp).fparacopyback) then
+             begin
+               writeln(t,printnodeindention,'(fparacopyback =');
+               printnodeindent;
+               printnode(t,tcallparanode(hp).fparacopyback);
+               printnodeunindent;
+               writeln(t,printnodeindention,')');
+             end;
+           printnode(t,hp.left);
+           writeln(t);
+           printnodeunindent;
+           writeln(t,printnodeindention,')');
+           hp:=tbinarynode(hp.right);
+         end;
       end;
       end;
 
 
 
 

+ 10 - 0
compiler/nutils.pas

@@ -219,6 +219,11 @@ implementation
               result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
               result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
             end;
             end;
+          callparan:
+            begin
+              result := foreachnode(procmethod,tnode(tcallparanode(n).fparainit),f,arg) or result;
+              result := foreachnode(procmethod,tcallparanode(n).fparacopyback,f,arg) or result;
+            end;
           ifn, whilerepeatn, forn, tryexceptn:
           ifn, whilerepeatn, forn, tryexceptn:
             begin
             begin
               { not in one statement, won't work because of b- }
               { not in one statement, won't work because of b- }
@@ -322,6 +327,11 @@ implementation
               result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
               result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
             end;
             end;
+          callparan:
+            begin
+              result := foreachnodestatic(procmethod,tnode(tcallparanode(n).fparainit),f,arg) or result;
+              result := foreachnodestatic(procmethod,tcallparanode(n).fparacopyback,f,arg) or result;
+            end;
           ifn, whilerepeatn, forn, tryexceptn:
           ifn, whilerepeatn, forn, tryexceptn:
             begin
             begin
               { not in one statement, won't work because of b- }
               { not in one statement, won't work because of b- }