* moved use_fixed_stack from cgutils to a method in paramgr so it can

    be used outside the code generator
  * renamed tabstractprocdef.requiredargarea into callerargareasize,
    and also added calleeargareasize field; added init_paraloc_info(side)
    method to init the parameter locations and init those size fields and
    replaced all "if not procdef.has_paraloc_info then ..." blocks with
    procdef.init_paraloc_info(callersize)"
  * moved detection of stack tainting parameters from psub to
    symdef/tabstractprocdef
  + added tcallparanode.contains_stack_tainting_call(), which detects
    whether a parameter contains a call that makes use of stack paramters
  * record for each parameter whether or not any following parameter
    contains a call with stack parameters; if not, in case the current
    parameter itself is a stack parameter immediately place it in its
    final location also for use_fixed_stack platforms rather than
    first putting it in a temporary location (part of mantis #17442)
  * on use_fixed_stack platforms, always first evaluate parameters
    containing a stack tainting call, since those force any preceding
    stack parameters of the current call to be stored in a temp location
    and copied to the final location afterwards

git-svn-id: trunk@16050 -

compiler/arm/cgcpu.pas

@@ -2140,11 +2140,7 @@ unit cgcpu;
         shift : byte;
       begin
         { calculate the parameter info for the procdef }
-        if not procdef.has_paraloc_info then
-          begin
-            procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
-            procdef.has_paraloc_info:=true;
-          end;
+        procdef.init_paraloc_info(callerside);
         hsym:=tsym(procdef.parast.Find('self'));
         if not(assigned(hsym) and
           (hsym.typ=paravarsym)) then

compiler/cgobj.pas

@@ -4124,11 +4124,7 @@ implementation
         paraloc : Pcgparalocation;
       begin
         { calculate the parameter info for the procdef }
-        if not procdef.has_paraloc_info then
-          begin
-            procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
-            procdef.has_paraloc_info:=true;
-          end;
+        procdef.init_paraloc_info(callerside);
         hsym:=tsym(procdef.parast.Find('self'));
         if not(assigned(hsym) and
                (hsym.typ=paravarsym)) then

compiler/cgutils.pas

@@ -148,10 +148,6 @@ unit cgutils;
     procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
     procedure location_swap(var destloc,sourceloc : tlocation);
 
-
-    { allocate room for parameters on the stack in the entry code? }
-    function use_fixed_stack: boolean;
-
     { returns r with the given alignment }
     function setalignment(const r : treference;b : byte) : treference;
 
@@ -248,18 +244,5 @@ uses
       end;
 
 
-    function use_fixed_stack: boolean;
-      begin
-{$ifdef i386}
-        result := (target_info.system in [system_i386_darwin,system_x86_64_darwin]);
-{$else i386}
-{$ifdef cputargethasfixedstack}
-        result := true;
-{$else cputargethasfixedstack}
-        result := false;
-{$endif cputargethasfixedstack}
-{$endif i386}
-      end;
-
 end.
 

compiler/i386/cgcpu.pas

@@ -75,7 +75,7 @@ unit cgcpu;
 
     function use_push(const cgpara:tcgpara):boolean;
       begin
-        result:=(not use_fixed_stack) and
+        result:=(not paramanager.use_fixed_stack) and
                 assigned(cgpara.location) and
                 (cgpara.location^.loc=LOC_REFERENCE) and
                 (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
@@ -325,7 +325,7 @@ unit cgcpu;
           end
         { Routines with the poclearstack flag set use only a ret }
         else if (current_procinfo.procdef.proccalloption in clearstack_pocalls) and
-                (not use_fixed_stack)  then
+                (not paramanager.use_fixed_stack)  then
          begin
            { complex return values are removed from stack in C code PM }
            { but not on win32 }
@@ -361,7 +361,7 @@ unit cgcpu;
         again,ok : tasmlabel;
 {$endif}
       begin
-        if use_fixed_stack then
+        if paramanager.use_fixed_stack then
           begin
             inherited g_copyvaluepara_openarray(list,ref,lenloc,elesize,destreg);
             exit;
@@ -471,7 +471,7 @@ unit cgcpu;
 
     procedure tcg386.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       begin
-        if use_fixed_stack then
+        if paramanager.use_fixed_stack then
           begin
             inherited g_releasevaluepara_openarray(list,l);
             exit;
@@ -482,7 +482,7 @@ unit cgcpu;
 
     procedure tcg386.g_exception_reason_save(list : TAsmList; const href : treference);
       begin
-        if not use_fixed_stack then
+        if not paramanager.use_fixed_stack then
           list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
         else
          inherited g_exception_reason_save(list,href);
@@ -491,7 +491,7 @@ unit cgcpu;
 
     procedure tcg386.g_exception_reason_save_const(list : TAsmList;const href : treference; a: aint);
       begin
-        if not use_fixed_stack then
+        if not paramanager.use_fixed_stack then
           list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[OS_INT],a))
         else
           inherited g_exception_reason_save_const(list,href,a);
@@ -500,7 +500,7 @@ unit cgcpu;
 
     procedure tcg386.g_exception_reason_load(list : TAsmList; const href : treference);
       begin
-        if not use_fixed_stack then
+        if not paramanager.use_fixed_stack then
           begin
             cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
             list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))

compiler/i386/cpupara.pas

@@ -48,7 +48,7 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
+          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;override;
        private
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
@@ -735,19 +735,16 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
+    procedure ti386paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       var
         paraloc : pcgparalocation;
       begin
         paraloc:=parasym.paraloc[callerside].location;
-        { No need for temps when value is pushed }
-        if not(use_fixed_stack) and
-           assigned(paraloc) and
-           (paraloc^.loc=LOC_REFERENCE) and
-           (paraloc^.reference.index=NR_STACK_POINTER_REG) then
-          duplicateparaloc(list,calloption,parasym,cgpara)
-        else
-          inherited createtempparaloc(list,calloption,parasym,cgpara);
+        { Never a need for temps when value is pushed (calls inside parameters
+          will simply allocate even more stack space for their parameters) }
+        if not(use_fixed_stack) then
+          can_use_final_stack_loc:=true;
+        inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
 

compiler/i386/cpupi.pas

@@ -45,7 +45,7 @@ unit cpupi;
     uses
       cutils,
       systems,globals,globtype,
-      cgobj,tgobj,
+      cgobj,tgobj,paramgr,
       cpubase,
       cgutils,
       symconst;
@@ -59,7 +59,7 @@ unit cpupi;
 
     procedure ti386procinfo.set_first_temp_offset;
       begin
-        if use_fixed_stack then
+        if paramanager.use_fixed_stack then
           begin
             if not(po_assembler in procdef.procoptions) and
                (tg.direction > 0) then
@@ -85,7 +85,7 @@ unit cpupi;
         { Para_stack_size is only used to determine how many bytes to remove }
         { from the stack at the end of the procedure (in the "ret $xx").     }
         { If the stack is fixed, nothing has to be removed by the callee     }
-        if use_fixed_stack then
+        if paramanager.use_fixed_stack then
           para_stack_size := 0;
       end;
 

compiler/i386/n386cal.pas

@@ -69,7 +69,7 @@ implementation
       var
         hreg : tregister;
       begin
-        if (use_fixed_stack) then
+        if (paramanager.use_fixed_stack) then
           begin
             { very weird: in this case the callee does a "ret $4" and the }
             { caller immediately a "subl $4,%esp". Possibly this is for   }

compiler/m68k/cgcpu.pas

@@ -206,7 +206,7 @@ unit cgcpu;
 
     function use_push(const cgpara:tcgpara):boolean;
       begin
-        result:=(not use_fixed_stack) and
+        result:=(not paramanager.use_fixed_stack) and
                 assigned(cgpara.location) and
                 (cgpara.location^.loc=LOC_REFERENCE) and
                 (cgpara.location^.reference.index=NR_STACK_POINTER_REG);

compiler/m68k/cpupara.pas

@@ -45,7 +45,7 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
-          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
+          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
          private
           procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
@@ -565,22 +565,18 @@ unit cpupara;
       end;
 
 
-    procedure tm68kparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
+    procedure tm68kparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       var
         paraloc : pcgparalocation;
       begin
         paraloc:=parasym.paraloc[callerside].location;
-        { No need for temps when value is pushed }
-        if not(use_fixed_stack) and
-           assigned(paraloc) and
-           (paraloc^.loc=LOC_REFERENCE) and
-           (paraloc^.reference.index=NR_STACK_POINTER_REG) then
-          duplicateparaloc(list,calloption,parasym,cgpara)
-        else
-          inherited createtempparaloc(list,calloption,parasym,cgpara);
+        { Never a need for temps when value is pushed (calls inside parameters
+          will simply allocate even more stack space for their parameters) }
+        if not(use_fixed_stack) then
+          can_use_final_stack_loc:=true;
+        inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
-
 begin
   paramanager:=tm68kparamanager.create;
 end.

compiler/ncal.pas

@@ -174,6 +174,9 @@ interface
        tcallparaflags = set of tcallparaflag;
 
        tcallparanode = class(ttertiarynode)
+       private
+          fcontains_stack_tainting_call_cached,
+          ffollowed_by_stack_tainting_call_cached : boolean;
        public
           callparaflags : tcallparaflags;
           parasym       : tparavarsym;
@@ -199,6 +202,21 @@ interface
 
           property nextpara : tnode read right write right;
           property parametername : tnode read third write third;
+
+          { returns whether the evaluation of this parameter involves a
+            stack tainting call }
+          function contains_stack_tainting_call: boolean;
+          { initialises the fcontains_stack_tainting_call_cached field with the
+            result of contains_stack_tainting_call so that it can be quickly
+            accessed via the contains_stack_tainting_call_cached property }
+          procedure init_contains_stack_tainting_call_cache;
+          { returns result of contains_stack_tainting_call cached during last
+            call to init_contains_stack_tainting_call_cache }
+          property contains_stack_tainting_call_cached: boolean read fcontains_stack_tainting_call_cached;
+          { returns whether this parameter is followed by at least one other
+            parameter whose evaluation involves a stack tainting parameter
+            (result is only valid after order_parameters has been called) }
+          property followed_by_stack_tainting_call_cached: boolean read ffollowed_by_stack_tainting_call_cached;
        end;
        tcallparanodeclass = class of tcallparanode;
 
@@ -962,6 +980,28 @@ implementation
       end;
 
 
+    function check_contains_stack_tainting_call(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        if (n.nodetype=calln) and
+           tcallnode(n).procdefinition.stack_tainting_parameter(callerside) then
+          result:=fen_norecurse_true
+        else
+          result:=fen_false;
+      end;
+
+
+    function tcallparanode.contains_stack_tainting_call: boolean;
+      begin
+        result:=foreachnodestatic(pm_postprocess,left,@check_contains_stack_tainting_call,nil);
+      end;
+
+
+    procedure tcallparanode.init_contains_stack_tainting_call_cache;
+      begin
+        fcontains_stack_tainting_call_cached:=contains_stack_tainting_call;
+      end;
+
+
     function tcallparanode.docompare(p: tnode): boolean;
       begin
         docompare :=
@@ -2998,6 +3038,14 @@ implementation
       begin
         hpfirst:=nil;
         hpcurr:=tcallparanode(left);
+        { cache all info about parameters containing stack tainting calls,
+          since we will need it a lot below and calculting it can be expensive }
+        while assigned(hpcurr) do
+          begin
+            hpcurr.init_contains_stack_tainting_call_cache;
+            hpcurr:=tcallparanode(hpcurr.right);
+          end;
+        hpcurr:=tcallparanode(left);
         while assigned(hpcurr) do
           begin
             { pull out }
@@ -3030,8 +3078,17 @@ implementation
             currloc:=hpcurr.parasym.paraloc[callerside].location^.loc;
             hpprev:=nil;
             hp:=hpfirst;
+            { on fixed_stack targets, always evaluate parameters containing
+              a call with stack parameters before all other parameters,
+              because they will prevent any other parameters from being put
+              in their final place; if both the current and the next para
+              contain a stack tainting call, don't do anything to prevent
+              them from keeping on chasing eachother's tail }
             while assigned(hp) do
               begin
+                if paramanager.use_fixed_stack and
+                   hpcurr.contains_stack_tainting_call_cached then
+                  break;
                 case currloc of
                   LOC_REFERENCE :
                     begin
@@ -3050,8 +3107,11 @@ implementation
 {$ifdef i386}
                             { the i386 code generator expects all reference }
                             { parameter to be in this order so it can use   }
-                            { pushes                                        }
-                            if (hpcurr.parasym.paraloc[callerside].location^.reference.offset>hp.parasym.paraloc[callerside].location^.reference.offset) then
+                            { pushes in case of no fixed stack              }
+                            if (not paramanager.use_fixed_stack and
+                                (hpcurr.parasym.paraloc[callerside].location^.reference.offset>hp.parasym.paraloc[callerside].location^.reference.offset)) or
+                               (paramanager.use_fixed_stack and
+                                (node_complexity(hpcurr)<node_complexity(hp))) then
 {$else i386}
                             if (node_complexity(hpcurr)<node_complexity(hp)) then
 {$endif i386}
@@ -3084,6 +3144,30 @@ implementation
             hpcurr:=hpnext;
           end;
         left:=hpfirst;
+        { now mark each parameter that is followed by a stack-tainting call,
+          to determine on use_fixed_stack targets which ones can immediately be
+          put in their final destination. Unforunately we can never put register
+          parameters immediately in their final destination (even on register-
+          rich architectures such as the PowerPC), because the code generator
+          can still insert extra calls that only make use of register
+          parameters (fpc_move() etc. }
+        hpcurr:=hpfirst;
+        while assigned(hpcurr) do
+          begin
+            if hpcurr.contains_stack_tainting_call_cached then
+              begin
+                { all parameters before this one are followed by a stack
+                  tainting call }
+                hp:=hpfirst;
+                while hp<>hpcurr do
+                  begin
+                    hp.ffollowed_by_stack_tainting_call_cached:=true;
+                    hp:=tcallparanode(hp.right);
+                  end;
+                hpfirst:=hpcurr;
+              end;
+            hpcurr:=tcallparanode(hpcurr.right);
+          end;
       end;
 
 
@@ -3206,17 +3290,13 @@ implementation
          result:=nil;
 
          { calculate the parameter info for the procdef }
-         if not procdefinition.has_paraloc_info then
-           begin
-             procdefinition.requiredargarea:=paramanager.create_paraloc_info(procdefinition,callerside);
-             procdefinition.has_paraloc_info:=true;
-           end;
+         procdefinition.init_paraloc_info(callerside);
 
          { calculate the parameter size needed for this call include varargs if they are available }
          if assigned(varargsparas) then
            pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,varargsparas)
          else
-           pushedparasize:=procdefinition.requiredargarea;
+           pushedparasize:=procdefinition.callerargareasize;
 
          { record maximum parameter size used in this proc }
          current_procinfo.allocate_push_parasize(pushedparasize);

compiler/ncgcal.pas

@@ -170,7 +170,7 @@ implementation
                  cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
                end;
 
-             paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,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 }
              if (cpf_varargs_para in callparaflags) then
@@ -485,6 +485,7 @@ implementation
          href : treference;
          calleralignment,
          tmpalignment: longint;
+         skipmemloc: boolean;
        begin
          { copy all resources to the allocated registers }
          ppn:=tcgcallparanode(left);
@@ -504,6 +505,10 @@ implementation
                     (calleralignment=0) then
                    internalerror(2009020701);
                  callerparaloc:=ppn.parasym.paraloc[callerside].location;
+                 skipmemloc:=
+                   (not paramanager.use_fixed_stack or
+                    not(ppn.followed_by_stack_tainting_call_cached)) and
+                   paramanager.is_simple_stack_paraloc(callerparaloc);
                  while assigned(callerparaloc) do
                    begin
                      { Every paraloc must have a matching tmpparaloc }
@@ -540,7 +545,7 @@ implementation
                          end;
                        LOC_REFERENCE:
                          begin
-                           if use_fixed_stack then
+                           if not skipmemloc then
                              begin
                                { Can't have a data copied to the stack, every location
                                  must contain a valid size field }
@@ -624,7 +629,7 @@ implementation
 {$endif x86_64}
       begin
          if not assigned(procdefinition) or
-            not procdefinition.has_paraloc_info then
+            not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then
            internalerror(200305264);
 
          if assigned(callinitblock) then
@@ -852,7 +857,7 @@ implementation
          { frame pointer parameter is popped by the caller when it's passed the
            Delphi way }
          else if (po_delphi_nested_cc in procdefinition.procoptions) and
-                 not use_fixed_stack then
+                 not paramanager.use_fixed_stack then
            pop_parasize(sizeof(pint));
          { Release registers, but not the registers that contain the
            function result }

compiler/ncgutil.pas

@@ -235,7 +235,7 @@ implementation
           LOC_REFERENCE,
           LOC_CREFERENCE :
             begin
-              if use_fixed_stack then
+              if paramanager.use_fixed_stack then
                 location_freetemp(list,location);
             end;
           else
@@ -805,7 +805,7 @@ implementation
                    LOC_REFERENCE:
                      begin
                        size:=align(locintsize,cgpara.alignment);
-                       if (not use_fixed_stack) and
+                       if (not paramanager.use_fixed_stack) and
                           (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
                          begin
                            cg.g_stackpointer_alloc(list,size);
@@ -850,7 +850,7 @@ implementation
                        { can't use TCGSize2Size[l.size], because the size of an
                          80 bit extended parameter can be either 10 or 12 bytes }
                        size:=align(locintsize,cgpara.alignment);
-                       if (not use_fixed_stack) and
+                       if (not paramanager.use_fixed_stack) and
                           (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
                          begin
                            cg.g_stackpointer_alloc(list,size);
@@ -878,7 +878,7 @@ implementation
                    LOC_REFERENCE:
                      begin
                        size:=align(locintsize,cgpara.alignment);
-                       if (not use_fixed_stack) and
+                       if (not paramanager.use_fixed_stack) and
                           (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
                          cg.a_load_ref_cgpara(list,locsize,l.reference,cgpara)
                        else
@@ -2347,7 +2347,7 @@ implementation
             parasize:=current_procinfo.para_stack_size;
             { the parent frame pointer para has to be removed by the caller in
               case of Delphi-style parent frame pointer passing }
-            if not use_fixed_stack and
+            if not paramanager.use_fixed_stack and
                (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
               dec(parasize,sizeof(pint));
           end;

compiler/objcutil.pas

@@ -205,11 +205,7 @@ end;
       begin
         result:='';
         totalsize:=0;
-        if not pd.has_paraloc_info then
-          begin
-            pd.requiredargarea:=paramanager.create_paraloc_info(pd,callerside);
-            pd.has_paraloc_info:=true;
-          end;
+        pd.init_paraloc_info(callerside);
 {$if defined(powerpc) and defined(dummy)}
         { Disabled, because neither Clang nor gcc does this, and the ObjC
           runtime contains an explicit fix to detect this error.  }

compiler/paramgr.pas

@@ -38,6 +38,9 @@ unit paramgr;
        {# This class defines some methods to take care of routine
           parameters. It should be overriden for each new processor
        }
+
+       { tparamanager }
+
        tparamanager = class
           { true if the location in paraloc can be reused as localloc }
           function param_use_paraloc(const cgpara:tcgpara):boolean;virtual;
@@ -121,11 +124,15 @@ unit paramgr;
           }
           function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract;
 
-          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);virtual;
+          function is_simple_stack_paraloc(paraloc: pcgparalocation): boolean;
+          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);virtual;
           procedure duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
 
           function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual;
           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual;
+
+          { allocate room for parameters on the stack in the entry code? }
+          function use_fixed_stack: boolean;
        end;
 
 
@@ -320,13 +327,31 @@ implementation
       end;
 
 
-    procedure tparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
+    function tparamanager.is_simple_stack_paraloc(paraloc: pcgparalocation): boolean;
+      begin
+        result:=
+          assigned(paraloc) and
+          (paraloc^.loc=LOC_REFERENCE) and
+          (paraloc^.reference.index=NR_STACK_POINTER_REG) and
+          not assigned(paraloc^.next);
+      end;
+
+
+    procedure tparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       var
         href : treference;
         len  : aint;
         paraloc,
         newparaloc : pcgparalocation;
       begin
+        paraloc:=parasym.paraloc[callerside].location;
+        if can_use_final_stack_loc and
+           is_simple_stack_paraloc(paraloc) then
+          begin
+            duplicateparaloc(list,calloption,parasym,cgpara);
+            exit;
+          end;
+
         cgpara.reset;
         cgpara.size:=parasym.paraloc[callerside].size;
         cgpara.intsize:=parasym.paraloc[callerside].intsize;
@@ -334,7 +359,6 @@ implementation
 {$ifdef powerpc}
         cgpara.composite:=parasym.paraloc[callerside].composite;
 {$endif powerpc}
-        paraloc:=parasym.paraloc[callerside].location;
         while assigned(paraloc) do
           begin
             if paraloc^.size=OS_NO then
@@ -398,8 +422,8 @@ implementation
     function tparamanager.create_inline_paraloc_info(p : tabstractprocdef):longint;
       begin
         { We need to return the size allocated }
-        create_paraloc_info(p,callerside);
-        result:=create_paraloc_info(p,calleeside);
+        p.init_paraloc_info(callbothsides);
+        result:=p.calleeargareasize;
       end;
       
 
@@ -416,6 +440,21 @@ implementation
         internalerror(200807236);
       end;
 
+
+    function tparamanager.use_fixed_stack: boolean;
+      begin
+{$ifdef i386}
+        result := (target_info.system in [system_i386_darwin,system_x86_64_darwin]);
+{$else i386}
+{$ifdef cputargethasfixedstack}
+        result := true;
+{$else cputargethasfixedstack}
+        result := false;
+{$endif cputargethasfixedstack}
+{$endif i386}
+      end;
+
+
 initialization
   ;
 finalization

compiler/pdecsub.pas

@@ -699,7 +699,7 @@ implementation
 
         if explicit_paraloc then
           begin
-            pd.has_paraloc_info:=true;
+            pd.has_paraloc_info:=callerside;
             include(pd.procoptions,po_explicitparaloc);
           end;
         { remove parasymtable from stack }

compiler/powerpc/cpupara.pas

@@ -704,26 +704,6 @@ unit cpupara;
         result:=true;
       end;
 
-{
-
-    breaks e.g. tests/test/cg/tpara1
-
-    procedure tppcparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
-      var
-        paraloc : pcgparalocation;
-      begin
-        paraloc:=parasym.paraloc[callerside].location;
-        { No need for temps when value is pushed }
-        if assigned(paraloc) and
-           (paraloc^.loc=LOC_REFERENCE) and
-           (paraloc^.reference.index=NR_STACK_POINTER_REG) then
-          duplicateparaloc(list,calloption,parasym,cgpara)
-        else
-          inherited createtempparaloc(list,calloption,parasym,cgpara);
-      end;
-}
-
-
 begin
    paramanager:=tppcparamanager.create;
 end.

compiler/powerpc64/cpupara.pas

@@ -520,25 +520,6 @@ begin
 end;
 
 
-{
-
-    breaks e.g. tests/test/cg/tpara1
-
-procedure tppcparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
-var
-  paraloc : pcgparalocation;
-begin
-  paraloc:=parasym.paraloc[callerside].location;
-  { Do not create a temporary if the value is pushed }
-  if assigned(paraloc) and
-    (paraloc^.loc=LOC_REFERENCE) and
-    (paraloc^.reference.index=NR_STACK_POINTER_REG) then
-    duplicateparaloc(list,calloption,parasym,cgpara)
-  else
-    inherited createtempparaloc(list,calloption,parasym,cgpara);
-end;
-}
-
 begin
   paramanager := tppcparamanager.create;
 end.

compiler/procinfo.pas

@@ -68,7 +68,7 @@ unit procinfo;
           exitswitches  : tlocalswitches;
 
           { Size of the parameters on the stack }
-          para_stack_size : longint;
+          para_stack_size : pint;
 
           { Offset of temp after para/local are allocated }
           tempstart : longint;
@@ -195,9 +195,10 @@ implementation
 
     procedure tprocinfo.generate_parameter_info;
       begin
-        { generate callee paraloc register info, it returns the size that
+        { generate callee paraloc register info, it initialises the size that
           is allocated on the stack }
-        para_stack_size:=paramanager.create_paraloc_info(procdef,calleeside);
+        procdef.init_paraloc_info(calleeside);
+        para_stack_size:=procdef.calleeargareasize;
       end;
 
 

compiler/psub.pas

@@ -57,7 +57,6 @@ interface
         procedure remove_from_symtablestack;
         procedure parse_body;
 
-        function stack_tainting_parameter : boolean;
         function has_assembler_child : boolean;
       end;
 
@@ -784,29 +783,6 @@ implementation
       end;
 
 
-    procedure check_for_stack(p:TObject;arg:pointer);
-      begin
-         if tsym(p).typ=paravarsym then
-           begin
-             { check if there no parameter of the current procedure is stack dependend }
-             if is_open_array(tparavarsym(p).vardef) or
-               is_array_of_const(tparavarsym(p).vardef) then
-               pboolean(arg)^:=true;
-             if assigned(p) and
-                assigned(tparavarsym(p).paraloc[calleeside].location) and
-               (tparavarsym(p).paraloc[calleeside].location^.loc=LOC_REFERENCE) then
-               pboolean(arg)^:=true;
-           end;
-      end;
-
-
-    function tcgprocinfo.stack_tainting_parameter : boolean;
-      begin
-        result:=false;
-        procdef.parast.SymList.ForEachCall(@check_for_stack,@result);
-      end;
-
-
     function tcgprocinfo.has_assembler_child : boolean;
       var
         hp : tcgprocinfo;
@@ -1006,9 +982,10 @@ implementation
                    parameters on the stack
 
                    calling generate_parameter_info doesn't hurt but it costs time
+                   (necessary to init para_stack_size)
                  }
                  generate_parameter_info;
-                 if not(stack_tainting_parameter) and
+                 if not(procdef.stack_tainting_parameter(calleeside)) and
                    not(has_assembler_child) and (para_stack_size=0) then
                    begin
                      { Only need to set the framepointer }
@@ -1049,11 +1026,7 @@ implementation
 
             { caller paraloc info is also necessary in the stackframe_entry
               code of the ppc (and possibly other processors)               }
-            if not procdef.has_paraloc_info then
-              begin
-                procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
-                procdef.has_paraloc_info:=true;
-              end;
+            procdef.init_paraloc_info(callerside);
 
             { generate code for the node tree }
             do_secondpass(code);

compiler/symconst.pas

@@ -225,7 +225,7 @@ type
     vt_normalvariant,vt_olevariant
   );
 
-  tcallercallee = (callerside,calleeside);
+  tcallercallee = (callnoside,callerside,calleeside,callbothsides);
 
   { basic type for tprocdef and tprocvardef }
   tproctypeoption=(potype_none,

compiler/symdef.pas

@@ -403,7 +403,8 @@ interface
           proctypeoption  : tproctypeoption;
           proccalloption  : tproccalloption;
           procoptions     : tprocoptions;
-          requiredargarea : aint;
+          callerargareasize,
+          calleeargareasize: pint;
           { number of user visibile parameters }
           maxparacount,
           minparacount    : byte;
@@ -411,7 +412,7 @@ interface
           exp_funcretloc : tregister;   { explicit funcretloc for AmigaOS }
 {$endif}
           funcretloc : array[tcallercallee] of TCGPara;
-          has_paraloc_info : boolean; { paraloc info is available }
+          has_paraloc_info : tcallercallee; { paraloc info is available }
           constructor create(dt:tdeftyp;level:byte);
           constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
           destructor destroy;override;
@@ -424,6 +425,8 @@ interface
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
           procedure check_mark_as_nested;
+          procedure init_paraloc_info(side: tcallercallee);
+          function stack_tainting_parameter(side: tcallercallee): boolean;
        private
           procedure count_para(p:TObject;arg:pointer);
           procedure insert_para(p:TObject;arg:pointer);
@@ -2760,8 +2763,9 @@ implementation
          procoptions:=[];
          returndef:=voidtype;
          savesize:=sizeof(pint);
-         requiredargarea:=0;
-         has_paraloc_info:=false;
+         callerargareasize:=0;
+         calleeargareasize:=0;
+         has_paraloc_info:=callnoside;
          funcretloc[callerside].init;
          funcretloc[calleeside].init;
          check_mark_as_nested;
@@ -2885,7 +2889,8 @@ implementation
            funcretloc[callerside].ppuload(ppufile);
 
          savesize:=sizeof(pint);
-         has_paraloc_info:=(po_explicitparaloc in procoptions);
+         if (po_explicitparaloc in procoptions) then
+           has_paraloc_info:=callerside;
       end;
 
 
@@ -3035,6 +3040,53 @@ implementation
       end;
 
 
+    procedure tabstractprocdef.init_paraloc_info(side: tcallercallee);
+      begin
+        if (side in [callerside,callbothsides]) and
+           not(has_paraloc_info in [callerside,callbothsides]) then
+          begin
+            callerargareasize:=paramanager.create_paraloc_info(self,callerside);
+            if has_paraloc_info in [calleeside,callbothsides] then
+              has_paraloc_info:=callbothsides
+            else
+              has_paraloc_info:=callerside;
+          end;
+        if (side in [calleeside,callbothsides]) and
+           not(has_paraloc_info in [calleeside,callbothsides]) then
+          begin
+            calleeargareasize:=paramanager.create_paraloc_info(self,calleeside);
+            if has_paraloc_info in [callerside,callbothsides] then
+              has_paraloc_info:=callbothsides
+            else
+              has_paraloc_info:=calleeside;
+          end;
+      end;
+
+
+    function tabstractprocdef.stack_tainting_parameter(side: tcallercallee): boolean;
+      var
+        p: tparavarsym;
+        i: longint;
+      begin
+        result:=false;
+        init_paraloc_info(side);
+        for i:=0 to parast.SymList.Count-1 do
+          if tsym(parast.SymList[i]).typ=paravarsym then
+            begin
+              p:=tparavarsym(parast.SymList[i]);
+              { check if no parameter is located on the stack }
+              if is_open_array(p.vardef) or
+                 is_array_of_const(p.vardef) then
+                result:=true;
+              if assigned(p.paraloc[side].location) and
+                 (p.paraloc[side].location^.loc=LOC_REFERENCE) then
+                result:=true;
+            end;
+      end;
+
+
+
+
 {***************************************************************************
                                   TPROCDEF
 ***************************************************************************}
@@ -3760,7 +3812,8 @@ implementation
         tprocvardef(result).proctypeoption:=proctypeoption;
         tprocvardef(result).proccalloption:=proccalloption;
         tprocvardef(result).procoptions:=procoptions;
-        tprocvardef(result).requiredargarea:=requiredargarea;
+        tprocvardef(result).callerargareasize:=callerargareasize;
+        tprocvardef(result).calleeargareasize:=calleeargareasize;
         tprocvardef(result).maxparacount:=maxparacount;
         tprocvardef(result).minparacount:=minparacount;
         for i:=low(tcallercallee) to high(tcallercallee) do

compiler/systems/t_bsd.pas

@@ -159,7 +159,8 @@ begin
                On 64bit systems, page zero is 4GB by default, so no problems
                there.
              }
-             ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -pagezero_size 0x10000 -multiply_defined suppress -L. -o $EXE `cat $RES`';
+//             ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -pagezero_size 0x10000 -multiply_defined suppress -L. -o $EXE `cat $RES`';
+             ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE `cat $RES`';
 {$else ndef cpu64bitaddr}
              ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE `cat $RES`';
 {$endif ndef cpu64bitaddr}