paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 02:51:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2010-09-26 21:24:14 +00:00
parent 27948a5f06
commit f13f6627c4
22 changed files with 245 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/arm/cgcpu.pas
View File

@ -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

6
compiler/cgobj.pas
View File

@ -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

17
compiler/cgutils.pas
View File

@ -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.

14
compiler/i386/cgcpu.pas
View File

@ -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))

17
compiler/i386/cpupara.pas
View File

@ -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;

6
compiler/i386/cpupi.pas
View File

@ -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;

2
compiler/i386/n386cal.pas
View File

@ -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 }

2
compiler/m68k/cgcpu.pas
View File

@ -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);

18
compiler/m68k/cpupara.pas
View File

@ -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.

96
compiler/ncal.pas
View File

@ -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);

13
compiler/ncgcal.pas
View File

@ -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 }

10
compiler/ncgutil.pas
View File

@ -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;

6
compiler/objcutil.pas
View File

@ -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. }

49
compiler/paramgr.pas
View File

@ -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

2
compiler/pdecsub.pas
View File

@ -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 }

20
compiler/powerpc/cpupara.pas
View File

@ -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.

19
compiler/powerpc64/cpupara.pas
View File

@ -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.

7
compiler/procinfo.pas
View File

@ -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;

33
compiler/psub.pas
View File

@ -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);

2
compiler/symconst.pas
View File

@ -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,

65
compiler/symdef.pas
View File

@ -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

3
compiler/systems/t_bsd.pas
View File

@ -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}