浏览代码

* guarantee the order of parameter pushes again after r31201 on platforms
that don't use a fixed stack (mantis #28454)
o moved the code to finalise managed out parameters from ncgcal to ncal,
and add it to the init code of the call node (so it's evaluated before
any parameters are processed, ensuring that mantis #28390 stays fixed)

git-svn-id: trunk@31328 -

Jonas Maebe 10 年之前
父节点
当前提交
e06181749c
共有 5 个文件被更改,包括 99 次插入37 次删除
  1. 1 0
      .gitattributes
  2. 3 0
      compiler/jvm/njvmcal.pas
  3. 57 13
      compiler/ncal.pas
  4. 1 24
      compiler/ncgcal.pas
  5. 37 0
      tests/webtbs/tw28454.pp

+ 1 - 0
.gitattributes

@@ -14680,6 +14680,7 @@ tests/webtbs/tw2834.pp svneol=native#text/plain
 tests/webtbs/tw28372.pp svneol=native#text/plain
 tests/webtbs/tw28372.pp svneol=native#text/plain
 tests/webtbs/tw2841.pp svneol=native#text/plain
 tests/webtbs/tw2841.pp svneol=native#text/plain
 tests/webtbs/tw28442.pp svneol=native#text/pascal
 tests/webtbs/tw28442.pp svneol=native#text/pascal
+tests/webtbs/tw28454.pp svneol=native#text/plain
 tests/webtbs/tw28475.pp svneol=native#text/plain
 tests/webtbs/tw28475.pp svneol=native#text/plain
 tests/webtbs/tw2853.pp svneol=native#text/plain
 tests/webtbs/tw2853.pp svneol=native#text/plain
 tests/webtbs/tw2853a.pp svneol=native#text/plain
 tests/webtbs/tw2853a.pp svneol=native#text/plain

+ 3 - 0
compiler/jvm/njvmcal.pas

@@ -171,6 +171,9 @@ implementation
         implicitptrpara,
         implicitptrpara,
         verifyout: boolean;
         verifyout: boolean;
       begin
       begin
+        { the original version doesn't do anything for garbage collected
+          platforms, but who knows in the future }
+        inherited;
         { implicit pointer types are already pointers -> no need to stuff them
         { implicit pointer types are already pointers -> no need to stuff them
           in an array to pass them by reference (except in case of a formal
           in an array to pass them by reference (except in case of a formal
           parameter, in which case everything is passed in an array since the
           parameter, in which case everything is passed in an array since the

+ 57 - 13
compiler/ncal.pas

@@ -216,7 +216,7 @@ interface
             finalization code }
             finalization code }
           fparainit,
           fparainit,
           fparacopyback: tnode;
           fparacopyback: tnode;
-          procedure handlemanagedbyrefpara(orgparadef: tdef);virtual;abstract;
+          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) }
@@ -612,6 +612,61 @@ implementation
                              TCALLPARANODE
                              TCALLPARANODE
  ****************************************************************************}
  ****************************************************************************}
 
 
+    procedure tcallparanode.handlemanagedbyrefpara(orgparadef: tdef);
+      var
+        temp: ttempcreatenode;
+        npara: tcallparanode;
+        paraaddrtype: tdef;
+      begin
+        { release memory for reference counted out parameters }
+        if (parasym.varspez=vs_out) and
+           is_managed_type(orgparadef) and
+           (not is_open_array(resultdef) or
+            is_managed_type(orgparadef)) and
+           not(target_info.system in systems_garbage_collected_managed_types) then
+          begin
+            paraaddrtype:=cpointerdef.getreusable(orgparadef);
+            { create temp with address of the parameter }
+            temp:=ctempcreatenode.create(
+              paraaddrtype,paraaddrtype.size,tt_persistent,true);
+            { put this code in the init/done statement of the call node, because
+              we should finalize all out parameters before other parameters
+              are evaluated (in case e.g. a managed out parameter is also
+              passed by value, we must not pass the pointer to the now possibly
+              freed data as the value parameter, but the finalized/nil value }
+            aktcallnode.add_init_statement(temp);
+            aktcallnode.add_init_statement(
+              cassignmentnode.create(
+                ctemprefnode.create(temp),
+                caddrnode.create(left)));
+            if not is_open_array(resultdef) or
+               not is_managed_type(tarraydef(resultdef).elementdef) then
+              { finalize the entire parameter }
+              aktcallnode.add_init_statement(
+                cnodeutils.finalize_data_node(
+                  cderefnode.create(ctemprefnode.create(temp))))
+            else
+              begin
+                { passing a (part of, in case of slice) dynamic array as an
+                  open array -> finalize the dynamic array contents, not the
+                  dynamic array itself }
+                npara:=ccallparanode.create(
+                         { array length = high + 1 }
+                         caddnode.create(addn,third.getcopy,genintconstnode(1)),
+                       ccallparanode.create(caddrnode.create_internal
+                          (crttinode.create(tstoreddef(tarraydef(resultdef).elementdef),initrtti,rdt_normal)),
+                       ccallparanode.create(caddrnode.create_internal(
+                          cderefnode.create(ctemprefnode.create(temp))),nil)));
+                aktcallnode.add_init_statement(
+                  ccallnode.createintern('fpc_finalize_array',npara));
+              end;
+            left:=cderefnode.create(ctemprefnode.create(temp));
+            firstpass(left);
+            aktcallnode.add_done_statement(ctempdeletenode.create(temp));
+          end;
+      end;
+
+
     procedure tcallparanode.copy_value_by_ref_para;
     procedure tcallparanode.copy_value_by_ref_para;
       var
       var
         initstat,
         initstat,
@@ -945,7 +1000,6 @@ implementation
           get_paratype;
           get_paratype;
 
 
         if assigned(parasym) and
         if assigned(parasym) and
-           (target_info.system in systems_managed_vm) and
            (parasym.varspez in [vs_var,vs_out,vs_constref]) and
            (parasym.varspez in [vs_var,vs_out,vs_constref]) and
            (parasym.vardef.typ<>formaldef) and
            (parasym.vardef.typ<>formaldef) and
            { for record constructors }
            { for record constructors }
@@ -3803,18 +3857,8 @@ implementation
               them from keeping on chasing eachother's tail }
               them from keeping on chasing eachother's tail }
             while assigned(hp) do
             while assigned(hp) do
               begin
               begin
-                { ensure that out parameters are finalised before other
-                  parameters are processed, so that in case it has a reference
-                  count of one and is also passed as a value parameter, the
-                  value parameter does not get passed a pointer to a freed
-                  memory block }
-                if (hpcurr.parasym.varspez=vs_out) and
-                   is_managed_type(hpcurr.parasym.vardef) then
-                  break;
                 if paramanager.use_fixed_stack and
                 if paramanager.use_fixed_stack and
-                   hpcurr.contains_stack_tainting_call_cached and
-                   not((hp.parasym.varspez=vs_out) and
-                       is_managed_type(hp.parasym.vardef)) then
+                   hpcurr.contains_stack_tainting_call_cached then
                   break;
                   break;
                 case currloc of
                 case currloc of
                   LOC_REFERENCE :
                   LOC_REFERENCE :

+ 1 - 24
compiler/ncgcal.pas

@@ -1,4 +1,4 @@
- {
+{
     Copyright (c) 1998-2002 by Florian Klaempfl
     Copyright (c) 1998-2002 by Florian Klaempfl
 
 
     Generate assembler for call nodes
     Generate assembler for call nodes
@@ -283,29 +283,6 @@ implementation
 
 
              hlcg.maybe_change_load_node_reg(current_asmdata.CurrAsmList,left,true);
              hlcg.maybe_change_load_node_reg(current_asmdata.CurrAsmList,left,true);
 
 
-             { release memory for refcnt out parameters }
-             if (parasym.varspez=vs_out) and
-                is_managed_type(left.resultdef) and
-                not(target_info.system in systems_garbage_collected_managed_types) then
-               begin
-                 hlcg.location_get_data_ref(current_asmdata.CurrAsmList,left.resultdef,left.location,href,false,sizeof(pint));
-                 if is_open_array(resultdef) then
-                   begin
-                     { if elementdef is not managed, omit fpc_decref_array
-                       because it won't do anything anyway }
-                     if is_managed_type(tarraydef(resultdef).elementdef) then
-                       begin
-                         if third=nil then
-                           InternalError(201103063);
-                         secondpass(third);
-                         hlcg.g_array_rtti_helper(current_asmdata.CurrAsmList,tarraydef(resultdef).elementdef,
-                           href,third.location,'fpc_finalize_array');
-                       end;
-                   end
-                 else
-                   hlcg.g_finalize(current_asmdata.CurrAsmList,left.resultdef,href)
-               end;
-
              paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,not followed_by_stack_tainting_call_cached,tempcgpara);
              paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,not followed_by_stack_tainting_call_cached,tempcgpara);
 
 
              { handle varargs first, because parasym is not valid }
              { handle varargs first, because parasym is not valid }

+ 37 - 0
tests/webtbs/tw28454.pp

@@ -0,0 +1,37 @@
+{$mode objfpc}
+
+
+type
+  tc = class(tinterfacedobject)
+    l: longint;
+    constructor create(f: longint);
+  end;
+
+
+constructor tc.create(f: longint);
+  begin
+    l:=f;
+  end;
+
+
+procedure test(out i1,i2: iinterface; k3,k4,k5,k6,k7,k8: longint; out i9,i10: iinterface); stdcall;
+begin
+  i1:=tc.create(1);
+  i2:=tc.create(2);
+  i9:=tc.create(9);
+  i10:=tc.create(10);
+end;
+
+var
+  i1,i2,i9,i10: iinterface;
+begin
+  test(i1,i2,3,4,5,6,7,8,i9,i10);
+  if (i1 as tc).l<>1 then
+    halt(1);
+  if (i2 as tc).l<>2 then
+    halt(2);
+  if (i9 as tc).l<>9 then
+    halt(3);
+  if (i10 as tc).l<>10 then
+    halt(4);
+end.