Преглед изворни кода

* converted code to trash variables (-gt) to operate at the node tree level,
and also use this code to trash local variables in inlined routines
o fixes mantis #22088
o makes it possible to also implement it for the jvm target in the future

git-svn-id: trunk@21393 -

Jonas Maebe пре 13 година
родитељ
комит
baa8fa39a8
9 измењених фајлова са 196 додато и 281 уклоњено
  1. 1 9
      compiler/globals.pas
  2. 2 49
      compiler/hlcgobj.pas
  3. 3 3
      compiler/ncal.pas
  4. 34 180
      compiler/ncgutil.pas
  5. 147 3
      compiler/ngenutil.pas
  6. 0 31
      compiler/nutils.pas
  7. 7 4
      compiler/psub.pas
  8. 1 1
      rtl/inc/compproc.inc
  9. 1 1
      rtl/inc/system.inc

+ 1 - 9
compiler/globals.pas

@@ -113,15 +113,7 @@ interface
        localvartrashing: longint = -1;
        localvartrashing: longint = -1;
 
 
        nroftrashvalues = 4;
        nroftrashvalues = 4;
-{$ifdef cpu64bitalu}
-      trashintvalues: array[0..nroftrashvalues-1] of aint = ($5555555555555555,aint($AAAAAAAAAAAAAAAA),aint($EFEFEFEFEFEFEFEF),0);
-{$endif cpu64bitalu}
-{$ifdef cpu32bitalu}
-      trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0);
-{$endif cpu32bitalu}
-{$ifdef cpu8bitalu}
-      trashintvalues: array[0..nroftrashvalues-1] of aint = ($55,aint($AA),aint($EF),0);
-{$endif cpu8bitalu}
+       trashintvalues: array[0..nroftrashvalues-1] of int64 = ($5555555555555555,$AAAAAAAAAAAAAAAA,$EFEFEFEFEFEFEFEF,0);
 
 
 
 
     type
     type

+ 2 - 49
compiler/hlcgobj.pas

@@ -3633,19 +3633,12 @@ implementation
       eldef : tdef;
       eldef : tdef;
       list : TAsmList;
       list : TAsmList;
       highloc : tlocation;
       highloc : tlocation;
-      needs_inittable (*,
-      do_trashing     *)  : boolean;
+      needs_inittable  : boolean;
     begin
     begin
       list:=TAsmList(arg);
       list:=TAsmList(arg);
       if (tsym(p).typ=paravarsym) then
       if (tsym(p).typ=paravarsym) then
        begin
        begin
          needs_inittable:=is_managed_type(tparavarsym(p).vardef);
          needs_inittable:=is_managed_type(tparavarsym(p).vardef);
-(*
-         do_trashing:=
-           (localvartrashing <> -1) and
-           (not assigned(tparavarsym(p).defaultconstsym)) and
-           not needs_inittable;
-*)
          case tparavarsym(p).varspez of
          case tparavarsym(p).varspez of
            vs_value :
            vs_value :
              if needs_inittable then
              if needs_inittable then
@@ -3678,25 +3671,12 @@ implementation
                end;
                end;
            vs_out :
            vs_out :
              begin
              begin
-               if needs_inittable (*or
-                  do_trashing*) then
+               if needs_inittable then
                  begin
                  begin
                    { we have no idea about the alignment at the callee side,
                    { we have no idea about the alignment at the callee side,
                      and the user also cannot specify "unaligned" here, so
                      and the user also cannot specify "unaligned" here, so
                      assume worst case }
                      assume worst case }
                    location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
                    location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
-(*
-                   if do_trashing and
-                      { needs separate implementation to trash open arrays }
-                      { since their size is only known at run time         }
-                      not is_special_array(tparavarsym(p).vardef) then
-                      { may be an open string, even if is_open_string() returns }
-                      { false (for some helpers in the system unit)             }
-                     if not is_shortstring(tparavarsym(p).vardef) then
-                       trash_reference(list,href,tparavarsym(p).vardef.size)
-                     else
-                       trash_reference(list,href,2);
-*)
                    if needs_inittable then
                    if needs_inittable then
                      begin
                      begin
                        if is_open_array(tparavarsym(p).vardef) then
                        if is_open_array(tparavarsym(p).vardef) then
@@ -3718,26 +3698,6 @@ implementation
                      end;
                      end;
                  end;
                  end;
              end;
              end;
-(*
-           else if do_trashing and
-                   ([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
-                 begin
-                   { should always have standard alignment. If a function is assigned
-                     to a non-aligned variable, the optimisation to pass this variable
-                     directly as hidden function result must/cannot be performed
-                     (see tcallnode.funcret_can_be_reused)
-                   }
-                   location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,
-                     used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
-                   { may be an open string, even if is_open_string() returns }
-                   { false (for some helpers in the system unit)             }
-                   if not is_shortstring(tparavarsym(p).vardef) then
-                     trash_reference(list,href,tparavarsym(p).vardef.size)
-                   else
-                     { an open string has at least size 2 }
-                     trash_reference(list,href,2);
-                 end
-*)
          end;
          end;
        end;
        end;
     end;
     end;
@@ -3767,13 +3727,6 @@ implementation
 
 
       if not(po_assembler in current_procinfo.procdef.procoptions) then
       if not(po_assembler in current_procinfo.procdef.procoptions) then
         begin
         begin
-          { has to be done here rather than in gen_initialize_code, because
-            the initialisation code is generated a) later and b) with
-            rad_backwards, so the register allocator would generate
-            information as if this code comes before loading the parameters
-            from their original registers to their local location }
-//          if (localvartrashing <> -1) then
-//            current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list);
           { initialize refcounted paras, and trash others. Needed here
           { initialize refcounted paras, and trash others. Needed here
             instead of in gen_initialize_code, because when a reference is
             instead of in gen_initialize_code, because when a reference is
             intialised or trashed while the pointer to that reference is kept
             intialised or trashed while the pointer to that reference is kept

+ 3 - 3
compiler/ncal.pas

@@ -265,7 +265,7 @@ implementation
       symconst,defutil,defcmp,
       symconst,defutil,defcmp,
       htypechk,pass_1,
       htypechk,pass_1,
       ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
       ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
-      objcutil,
+      ngenutil,objcutil,
       procinfo,cpuinfo,
       procinfo,cpuinfo,
       wpobase;
       wpobase;
 
 
@@ -3663,7 +3663,7 @@ implementation
             addstatement(inlineinitstatement,tempnode);
             addstatement(inlineinitstatement,tempnode);
 
 
             if localvartrashing <> -1 then
             if localvartrashing <> -1 then
-              addstatement(inlineinitstatement,trash_tempref(tempnode));
+              cnodeutils.maybe_trash_variable(inlineinitstatement,tabstractnormalvarsym(p),ctemprefnode.create(tempnode));
 
 
             addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
             addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
             { inherit addr_taken flag }
             { inherit addr_taken flag }
@@ -3816,7 +3816,7 @@ implementation
                         addstatement(inlineinitstatement,tempnode);
                         addstatement(inlineinitstatement,tempnode);
 
 
                         if localvartrashing <> -1 then
                         if localvartrashing <> -1 then
-                          addstatement(inlineinitstatement,trash_tempref(tempnode));
+                          cnodeutils.maybe_trash_variable(inlineinitstatement,para.parasym,ctemprefnode.create(tempnode));
 
 
                         addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
                         addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
                         addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
                         addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode),

+ 34 - 180
compiler/ncgutil.pas

@@ -706,106 +706,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure trash_reference(list: TAsmList; const ref: treference; size: aint);
-      var
-        countreg, valuereg: tregister;
-        hl: tasmlabel;
-        trashintval: aint;
-        tmpref: treference;
-      begin
-        trashintval := trashintvalues[localvartrashing];
-        case size of
-          0: ; { empty record }
-          1: cg.a_load_const_ref(list,OS_8,byte(trashintval),ref);
-          2: cg.a_load_const_ref(list,OS_16,word(trashintval),ref);
-          4: cg.a_load_const_ref(list,OS_32,longint(trashintval),ref);
-          {$ifdef cpu64bitalu}
-          8: cg.a_load_const_ref(list,OS_64,int64(trashintval),ref);
-          {$endif cpu64bitalu}
-          else
-            begin
-              countreg := cg.getintregister(list,OS_ADDR);
-              valuereg := cg.getintregister(list,OS_8);
-              cg.a_load_const_reg(list,OS_INT,size,countreg);
-              cg.a_load_const_reg(list,OS_8,byte(trashintval),valuereg);
-              current_asmdata.getjumplabel(hl);
-              tmpref := ref;
-              if (tmpref.index <> NR_NO) then
-                internalerror(200607201);
-              tmpref.index := countreg;
-              dec(tmpref.offset);
-              cg.a_label(list,hl);
-              cg.a_load_reg_ref(list,OS_8,OS_8,valuereg,tmpref);
-              cg.a_op_const_reg(list,OP_SUB,OS_INT,1,countreg);
-              cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,countreg,hl);
-              cg.a_reg_sync(list,tmpref.base);
-              cg.a_reg_sync(list,valuereg);
-            end;
-        end;
-      end;
-
-
-    { trash contents of local variables or parameters (function result) }
-    procedure trash_variable(p:TObject;arg:pointer);
-      var
-        trashintval: aint;
-        list: TAsmList absolute arg;
-      begin
-        if ((tsym(p).typ=localvarsym) or
-            ((tsym(p).typ=paravarsym) and
-             (vo_is_funcret in tparavarsym(p).varoptions))) and
-           not(is_managed_type(tabstractnormalvarsym(p).vardef)) and
-           not(assigned(tabstractnormalvarsym(p).defaultconstsym)) then
-         begin
-           trashintval := trashintvalues[localvartrashing];
-           case tabstractnormalvarsym(p).initialloc.loc of
-             LOC_CREGISTER :
-{$push}
-{$q-}
-               begin
-                 { avoid problems with broken x86 shifts }
-                 case tcgsize2size[tabstractnormalvarsym(p).initialloc.size] of
-                   1: cg.a_load_const_reg(list,OS_8,byte(trashintval),tabstractnormalvarsym(p).initialloc.register);
-                   2: cg.a_load_const_reg(list,OS_16,word(trashintval),tabstractnormalvarsym(p).initialloc.register);
-                   4: cg.a_load_const_reg(list,OS_32,longint(trashintval),tabstractnormalvarsym(p).initialloc.register);
-                   8:
-                     begin
-{$ifdef cpu64bitalu}
-                       cg.a_load_const_reg(list,OS_64,aint(trashintval),tabstractnormalvarsym(p).initialloc.register);
-{$else}
-                       cg64.a_load64_const_reg(list,int64(trashintval) shl 32 or int64(trashintval),tabstractnormalvarsym(p).initialloc.register64);
-{$endif}
-                     end;
-                   else
-                     internalerror(2010060801);
-                 end;
-               end;
-{$pop}
-             LOC_REFERENCE :
-               begin
-                   if ((tsym(p).typ=localvarsym) and
-                       not(vo_is_funcret in tabstractvarsym(p).varoptions)) or
-                      not is_shortstring(tabstractnormalvarsym(p).vardef) then
-                     trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
-                       tlocalvarsym(p).getsize)
-                   else
-                     { may be an open string, even if is_open_string() returns }
-                     { false (for some helpers in the system unit)             }
-                     { an open string has at least size 2                      }
-                     trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
-                       2);
-               end;
-             LOC_CMMREGISTER :
-               ;
-             LOC_CFPUREGISTER :
-               ;
-             else
-               internalerror(200410124);
-           end;
-         end;
-      end;
-
-
     { generates the code for incrementing the reference count of parameters and
     { generates the code for incrementing the reference count of parameters and
       initialize out parameters }
       initialize out parameters }
     procedure init_paras(p:TObject;arg:pointer);
     procedure init_paras(p:TObject;arg:pointer);
@@ -814,93 +714,54 @@ implementation
         hsym : tparavarsym;
         hsym : tparavarsym;
         eldef : tdef;
         eldef : tdef;
         list : TAsmList;
         list : TAsmList;
-        needs_inittable,
-        do_trashing       : boolean;
+        needs_inittable : boolean;
       begin
       begin
         list:=TAsmList(arg);
         list:=TAsmList(arg);
         if (tsym(p).typ=paravarsym) then
         if (tsym(p).typ=paravarsym) then
          begin
          begin
            needs_inittable:=is_managed_type(tparavarsym(p).vardef);
            needs_inittable:=is_managed_type(tparavarsym(p).vardef);
-           do_trashing:=
-             (localvartrashing <> -1) and
-             (not assigned(tparavarsym(p).defaultconstsym)) and
-             not needs_inittable;
+           if not needs_inittable then
+             exit;
            case tparavarsym(p).varspez of
            case tparavarsym(p).varspez of
              vs_value :
              vs_value :
-               if needs_inittable then
-                 begin
-                   { variants are already handled by the call to fpc_variant_copy_overwrite if
-                     they are passed by reference }
-                   if not((tparavarsym(p).vardef.typ=variantdef) and
-                     paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
-                     begin
-                       hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
-                       if is_open_array(tparavarsym(p).vardef) then
-                         begin
-                           { open arrays do not contain correct element count in their rtti,
-                             the actual count must be passed separately. }
-                           hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
-                           eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
-                           if not assigned(hsym) then
-                             internalerror(201003031);
-                           cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
-                         end
-                       else
-                        cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
-                     end;
-                 end;
-             vs_out :
                begin
                begin
-                 if needs_inittable or
-                    do_trashing then
+                 { variants are already handled by the call to fpc_variant_copy_overwrite if
+                   they are passed by reference }
+                 if not((tparavarsym(p).vardef.typ=variantdef) and
+                    paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
                    begin
                    begin
-                     { we have no idea about the alignment at the callee side,
-                       and the user also cannot specify "unaligned" here, so
-                       assume worst case }
-                     hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
-                     if do_trashing and
-                        { needs separate implementation to trash open arrays }
-                        { since their size is only known at run time         }
-                        not is_special_array(tparavarsym(p).vardef) then
-                        { may be an open string, even if is_open_string() returns }
-                        { false (for some helpers in the system unit)             }
-                       if not is_shortstring(tparavarsym(p).vardef) then
-                         trash_reference(list,href,tparavarsym(p).vardef.size)
-                       else
-                         trash_reference(list,href,2);
-                     if needs_inittable then
+                     hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
+                     if is_open_array(tparavarsym(p).vardef) then
                        begin
                        begin
-                         if is_open_array(tparavarsym(p).vardef) then
-                           begin
-                             hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
-                             eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
-                             if not assigned(hsym) then
-                               internalerror(201103033);
-                             cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
-                           end
-                         else
-                           cg.g_initialize(list,tparavarsym(p).vardef,href);
-                       end;
+                         { open arrays do not contain correct element count in their rtti,
+                           the actual count must be passed separately. }
+                         hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
+                         eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                         if not assigned(hsym) then
+                           internalerror(201003031);
+                         cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
+                       end
+                     else
+                      cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
                    end;
                    end;
                end;
                end;
-             else if do_trashing and
-                     ([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
+             vs_out :
+               begin
+                 { we have no idea about the alignment at the callee side,
+                   and the user also cannot specify "unaligned" here, so
+                   assume worst case }
+                 hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
+                 if is_open_array(tparavarsym(p).vardef) then
                    begin
                    begin
-                     { should always have standard alignment. If a function is assigned
-                       to a non-aligned variable, the optimisation to pass this variable
-                       directly as hidden function result must/cannot be performed
-                       (see tcallnode.funcret_can_be_reused)
-                     }
-                     hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,
-                       used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
-                     { may be an open string, even if is_open_string() returns }
-                     { false (for some helpers in the system unit)             }
-                     if not is_shortstring(tparavarsym(p).vardef) then
-                       trash_reference(list,href,tparavarsym(p).vardef.size)
-                     else
-                       { an open string has at least size 2 }
-                       trash_reference(list,href,2);
+                     hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
+                     eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                     if not assigned(hsym) then
+                       internalerror(201103033);
+                     cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
                    end
                    end
+                 else
+                   cg.g_initialize(list,tparavarsym(p).vardef,href);
+               end;
            end;
            end;
          end;
          end;
       end;
       end;
@@ -1250,13 +1111,6 @@ implementation
 {$endif powerpc64}
 {$endif powerpc64}
         if not(po_assembler in current_procinfo.procdef.procoptions) then
         if not(po_assembler in current_procinfo.procdef.procoptions) then
           begin
           begin
-            { has to be done here rather than in gen_initialize_code, because
-              the initialisation code is generated a) later and b) with
-              rad_backwards, so the register allocator would generate
-              information as if this code comes before loading the parameters
-              from their original registers to their local location }
-            if (localvartrashing <> -1) then
-              current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list);
             { initialize refcounted paras, and trash others. Needed here
             { initialize refcounted paras, and trash others. Needed here
               instead of in gen_initialize_code, because when a reference is
               instead of in gen_initialize_code, because when a reference is
               intialised or trashed while the pointer to that reference is kept
               intialised or trashed while the pointer to that reference is kept

+ 147 - 3
compiler/ngenutil.pas

@@ -28,7 +28,7 @@ interface
 
 
   uses
   uses
     cclasses,
     cclasses,
-    node,symtype,symsym,symconst,symdef;
+    node,nbas,symtype,symsym,symconst,symdef;
 
 
 
 
   type
   type
@@ -49,6 +49,25 @@ interface
         initialisation via the node tree }
         initialisation via the node tree }
       class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
       class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
 
 
+      { trashes a paravarsym or localvarsym if possible (not a managed type,
+        "out" in case of parameter, ...) }
+      class procedure maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode); virtual;
+     strict protected
+      { called from wrap_proc_body to insert the trashing for the wrapped
+        routine's local variables and parameters }
+      class function  maybe_insert_trashing(pd: tprocdef; n: tnode): tnode; virtual;
+      { callback called for every local variable and parameter by
+        maybe_insert_trashing(), calls through to maybe_trash_variable() }
+      class procedure maybe_trash_variable_callback(p: TObject; statn: pointer);
+      { returns whether a particular sym can be trashed. If not,
+        maybe_trash_variable won't do anything }
+      class function  trashable_sym(p: tsym): boolean; virtual;
+      { trashing for 1/2/3/4/8-byte sized variables }
+      class procedure trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode); virtual;
+      { trashing for differently sized variables that those handled by
+        trash_small() }
+      class procedure trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64); virtual;
+     public
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
 
       class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
       class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
@@ -84,7 +103,7 @@ implementation
       scanner,systems,procinfo,fmodule,
       scanner,systems,procinfo,fmodule,
       aasmbase,aasmdata,aasmtai,
       aasmbase,aasmdata,aasmtai,
       symbase,symtable,defutil,
       symbase,symtable,defutil,
-      nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils,
+      nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nobj,nutils,
       ppu,
       ppu,
       pass_1;
       pass_1;
 
 
@@ -247,7 +266,7 @@ implementation
       psym: tsym;
       psym: tsym;
       tcinitproc: tprocdef;
       tcinitproc: tprocdef;
     begin
     begin
-      result:=n;
+      result:=maybe_insert_trashing(pd,n);
       if target_info.system in systems_typed_constants_node_init then
       if target_info.system in systems_typed_constants_node_init then
         begin
         begin
           case pd.proctypeoption of
           case pd.proctypeoption of
@@ -308,6 +327,131 @@ implementation
     end;
     end;
 
 
 
 
+  class function tnodeutils.maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
+    var
+      stat: tstatementnode;
+    begin
+      result:=n;
+      if (localvartrashing<>-1)  and
+         not(po_assembler in pd.procoptions) then
+        begin
+          result:=internalstatements(stat);
+          pd.parast.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
+          pd.localst.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
+          addstatement(stat,n);
+        end;
+    end;
+
+
+  class function tnodeutils.trashable_sym(p: tsym): boolean;
+    begin
+      result:=
+        ((p.typ=localvarsym) or
+         ((p.typ=paravarsym) and
+          ((vo_is_funcret in tabstractnormalvarsym(p).varoptions) or
+           (tabstractnormalvarsym(p).varspez=vs_out)))) and
+         not is_managed_type(tabstractnormalvarsym(p).vardef) and
+         not assigned(tabstractnormalvarsym(p).defaultconstsym);
+    end;
+
+
+  class procedure tnodeutils.maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode);
+    var
+      size: asizeint;
+      trashintval: int64;
+    begin
+      if trashable_sym(p) then
+        begin
+          trashintval:=trashintvalues[localvartrashing];
+          if (p.vardef.typ=procvardef) and
+             ([m_tp_procvar,m_mac_procvar]*current_settings.modeswitches<>[]) then
+            begin
+              if tprocvardef(p.vardef).is_addressonly then
+                { in tp/delphi mode, you need @procvar to get at the contents of
+                  a procvar ... }
+                trashn:=caddrnode.create(trashn)
+              else
+                { ... but if it's a procedure of object, that will only return
+                  the procedure address -> cast to tmethod instead }
+                trashn:=ctypeconvnode.create_explicit(trashn,methodpointertype);
+            end;
+          if ((p.typ=localvarsym) and
+              (not(vo_is_funcret in p.varoptions) or
+               not is_shortstring(p.vardef))) or
+             ((p.typ=paravarsym) and
+              not is_shortstring(p.vardef)) then
+            begin
+              size:=p.getsize;
+              case size of
+                0:
+                  begin
+                    { open array -> at least size 1. Can also be zero-sized
+                      record, so check it's actually an array }
+                    if p.vardef.typ=arraydef then
+                      trash_large(stat,trashn,caddnode.create(addn,cinlinenode.create(in_high_x,false,trashn.getcopy),genintconstnode(1)),trashintval)
+                    else
+                      trashn.free;
+                  end;
+                1: trash_small(stat,
+                  ctypeconvnode.create_internal(trashn,s8inttype),
+                    genintconstnode(shortint(trashintval)));
+                2: trash_small(stat,
+                  ctypeconvnode.create_internal(trashn,s16inttype),
+                    genintconstnode(smallint(trashintval)));
+                4: trash_small(stat,
+                  ctypeconvnode.create_internal(trashn,s32inttype),
+                    genintconstnode(longint(trashintval)));
+                8: trash_small(stat,
+                  ctypeconvnode.create_internal(trashn,s64inttype),
+                    genintconstnode(int64(trashintval)));
+                else
+                  trash_large(stat,trashn,genintconstnode(size),trashintval);
+              end;
+            end
+          else
+            begin
+              { may be an open string, even if is_open_string() returns false
+                (for some helpers in the system unit)             }
+              { an open string has at least size 2                      }
+              trash_small(stat,
+                cvecnode.create(trashn.getcopy,genintconstnode(0)),
+                cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
+              trash_small(stat,
+                cvecnode.create(trashn,genintconstnode(1)),
+                cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
+            end;
+        end
+      else
+        trashn.free;
+    end;
+
+
+  class procedure tnodeutils.maybe_trash_variable_callback(p:TObject;statn:pointer);
+    var
+      stat: ^tstatementnode absolute statn;
+    begin
+      if not(tsym(p).typ in [localvarsym,paravarsym]) then
+        exit;
+      maybe_trash_variable(stat^,tabstractnormalvarsym(p),cloadnode.create(tsym(p),tsym(p).owner));
+    end;
+
+
+  class procedure tnodeutils.trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode);
+    begin
+      addstatement(stat,cassignmentnode.create(trashn,trashvaln));
+    end;
+
+
+  class procedure tnodeutils.trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64);
+    begin
+      addstatement(stat,ccallnode.createintern('fpc_fillmem',
+        ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
+        ccallparanode.Create(sizen,
+        ccallparanode.Create(trashn,nil)))
+        ));
+    end;
+
+
   class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
   class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
     var
     var
       l : asizeint;
       l : asizeint;

+ 0 - 31
compiler/nutils.pas

@@ -114,9 +114,6 @@ interface
       rough estimation how large the tree "node" is }
       rough estimation how large the tree "node" is }
     function node_count(node : tnode) : dword;
     function node_count(node : tnode) : dword;
 
 
-    { trashes the given temp. node }
-    function trash_tempref(node : tnode) : tnode;
-
 implementation
 implementation
 
 
     uses
     uses
@@ -1135,32 +1132,4 @@ implementation
       end;
       end;
 
 
 
 
-    function trash_tempref(node : tnode) : tnode;
-      var
-        trashintval: aint;
-      begin
-        if node.nodetype<>tempcreaten then
-          internalerror(2012051901);
-        trashintval := trashintvalues[localvartrashing];
-        case ttempcreatenode(node).size of
-          0: ; { empty record }
-          1: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
-               ctypeconvnode.create_internal(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),ttempcreatenode(node).tempinfo^.typedef));
-          2: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
-               ctypeconvnode.create_internal(cordconstnode.create(word(trashintval),u16inttype,false),ttempcreatenode(node).tempinfo^.typedef));
-          4: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
-               ctypeconvnode.create_internal(cordconstnode.create(dword(trashintval),u32inttype,false),ttempcreatenode(node).tempinfo^.typedef));
-          8: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
-               ctypeconvnode.create_internal(cordconstnode.create(qword(trashintval),u64inttype,false),ttempcreatenode(node).tempinfo^.typedef));
-          else
-            begin
-              result:=ccallnode.createintern('fpc_fillmem',
-                ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
-                ccallparanode.Create(cordconstnode.create(ttempcreatenode(node).size,uinttype,false),
-                ccallparanode.Create(ctemprefnode.create(ttempcreatenode(node)),nil)))
-                );
-            end;
-        end;
-      end;
-
 end.
 end.

+ 7 - 4
compiler/psub.pas

@@ -361,10 +361,6 @@ implementation
                    finish_parentfpstruct(current_procinfo.procdef);
                    finish_parentfpstruct(current_procinfo.procdef);
                  end;
                  end;
             end;
             end;
-        { init/final code must be wrapped later (after code for main proc body
-          has been generated }
-        if not(current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
-          block:=cnodeutils.wrap_proc_body(current_procinfo.procdef,block);
       end;
       end;
 
 
 
 
@@ -1074,6 +1070,13 @@ implementation
         current_filepos:=entrypos;
         current_filepos:=entrypos;
         current_structdef:=procdef.struct;
         current_structdef:=procdef.struct;
 
 
+        { add wrapping code if necessary (initialization of typed constants on
+          some platforms, initing of local variables and out parameters with
+          trashing values, ... }
+        { init/final code must be wrapped later (after code for main proc body
+          has been generated }
+        if not(current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
+          code:=cnodeutils.wrap_proc_body(procdef,code);
 
 
         { automatic inlining? }
         { automatic inlining? }
         if (cs_opt_autoinline in current_settings.optimizerswitches) and
         if (cs_opt_autoinline in current_settings.optimizerswitches) and

+ 1 - 1
rtl/inc/compproc.inc

@@ -37,7 +37,7 @@ Procedure fpc_freemem(p:pointer);compilerproc;
 
 
 { used by Default() in code blocks }
 { used by Default() in code blocks }
 procedure fpc_zeromem(p:pointer;len:ptruint);compilerproc;
 procedure fpc_zeromem(p:pointer;len:ptruint);compilerproc;
-procedure fpc_fillmem(var data;len:ptruint;b : byte);compilerproc;
+procedure fpc_fillmem(out data;len:ptruint;b : byte);compilerproc;
 
 
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;

+ 1 - 1
rtl/inc/system.inc

@@ -287,7 +287,7 @@ begin
 end;
 end;
 
 
 
 
-procedure fpc_fillmem(var data;len:ptruint;b : byte);
+procedure fpc_fillmem(out data;len:ptruint;b : byte);
 begin
 begin
   FillByte(data,len,b);
   FillByte(data,len,b);
 end;
 end;