paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 16:29:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

* parameter fixes

Browse Source
This commit is contained in:
peter 2003-09-25 21:28:00 +00:00
parent ab3d323e5b
commit 2392f28675
6 changed files with 84 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compiler/i386/cpupara.pas
View File

@ -249,7 +249,12 @@ unit cpupara;
{$warning HACK: framepointer reg shall be a normal parameter}
if p.parast.symtablelevel>normal_function_level then
inc(parasize,POINTER_SIZE);
{$warning callerparaloc shall not be the same as calleeparaloc}
{ we push Flags and CS as long
to cope with the IRETD
and we save 6 register + 4 selectors }
if po_interrupt in p.procoptions then
inc(parasize,8+6*4+4*2);
{ Assign fields }
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
@ -267,6 +272,11 @@ unit cpupara;
paraloc.reference.offset:=parasize+target_info.first_parm_offset;
varalign:=used_align(varalign,p.paraalign,p.paraalign);
parasize:=align(parasize+l,varalign);
if (side=callerside) then
begin
paraloc.reference.index:=NR_STACK_POINTER_REG;
dec(paraloc.reference.offset,POINTER_SIZE);
end;
hp.paraloc[side]:=paraloc;
hp:=tparaitem(hp.next);
end;
@ -291,7 +301,6 @@ unit cpupara;
{$warning HACK: framepointer reg shall be a normal parameter}
if p.parast.symtablelevel>normal_function_level then
inc(parasize,POINTER_SIZE);
{$warning callerparaloc shall not be the same as calleeparaloc}
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
@ -309,7 +318,7 @@ unit cpupara;
64bit values are in EAX:EDX or on the stack.
}
if (sr<=NR_ECX) and not(is_64bit) then
if (sr<=RS_ECX) and not(is_64bit) then
begin
paraloc.loc:=LOC_REGISTER;
if is_64bit then
@ -342,6 +351,12 @@ unit cpupara;
varalign:=used_align(varalign,p.paraalign,p.paraalign);
parasize:=align(parasize+l,varalign);
end;
if (side=callerside) and
(paraloc.loc=LOC_REFERENCE) then
begin
paraloc.reference.index:=NR_STACK_POINTER_REG;
dec(paraloc.reference.offset,POINTER_SIZE);
end;
hp.paraloc[side]:=paraloc;
hp:=tparaitem(hp.next);
end;
@ -372,7 +387,10 @@ begin
end.
{
$Log$
Revision 1.30 2003-09-23 17:56:06 peter
Revision 1.31 2003-09-25 21:30:11 peter
* parameter fixes
Revision 1.30 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

36
compiler/i386/cpupi.pas
View File

@ -33,9 +33,6 @@ unit cpupi;
type
ti386procinfo = class(tcgprocinfo)
procedure allocate_interrupt_parameter;override;
procedure allocate_framepointer_reg;override;
procedure handle_body_start;override;
end;
@ -44,40 +41,15 @@ unit cpupi;
uses
cgbase, cpubase, rgobj;
procedure ti386procinfo.allocate_interrupt_parameter;
begin
{ we push Flags and CS as long
to cope with the IRETD
and we save 6 register + 4 selectors }
{$warning TODO interrupt allocation}
// inc(procdef.parast.address_fixup,8+6*4+4*2);
end;
procedure ti386procinfo.allocate_framepointer_reg;
begin
if framepointer=NR_EBP then
begin
{ Make sure the register allocator won't allocate registers
into ebp }
include(rg.used_in_proc_int,RS_EBP);
exclude(rg.unusedregsint,RS_EBP);
end;
end;
procedure ti386procinfo.handle_body_start;
begin
inherited handle_body_start;
end;
begin
cprocinfo:=ti386procinfo;
end.
{
$Log$
Revision 1.12 2003-09-23 17:56:06 peter
Revision 1.13 2003-09-25 21:30:11 peter
* parameter fixes
Revision 1.12 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

11
compiler/i386/n386obj.pas
View File

@ -36,7 +36,7 @@ uses
symconst,symtype,symdef,symsym,
fmodule,
nobj,
cpubase,cginfo,
cpuinfo,cpubase,cginfo,
cga,tgobj,rgobj,cgobj;
type
@ -91,9 +91,9 @@ function getselfoffsetfromsp(procdef: tprocdef): longint;
begin
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
getselfoffsetfromsp:=4
getselfoffsetfromsp:=2*POINTER_SIZE
else
getselfoffsetfromsp:=0;
getselfoffsetfromsp:=POINTER_SIZE;
end;
@ -223,7 +223,10 @@ initialization
end.
{
$Log$
Revision 1.24 2003-09-25 14:59:06 peter
Revision 1.25 2003-09-25 21:30:11 peter
* parameter fixes
Revision 1.24 2003/09/25 14:59:06 peter
* fix intf wrapper code
Revision 1.23 2003/09/23 17:56:06 peter

8
compiler/ncal.pas
View File

@ -159,8 +159,7 @@ interface
procedure insert_typeconv(do_count : boolean);
procedure det_registers;
procedure firstcallparan(do_count : boolean);
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
para_alignment,para_offset : longint);virtual;abstract;
procedure secondcallparan(calloption:tproccalloption;alignment:byte);virtual;abstract;
function docompare(p: tnode): boolean; override;
procedure printnodetree(var t:text);override;
end;
@ -2514,7 +2513,10 @@ begin
end.
{
$Log$
Revision 1.181 2003-09-23 17:56:05 peter
Revision 1.182 2003-09-25 21:28:00 peter
* parameter fixes
Revision 1.181 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

132
compiler/ncgcal.pas
View File

@ -36,8 +36,7 @@ interface
private
tempparaloc : tparalocation;
public
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
para_alignment,para_offset : longint);override;
procedure secondcallparan(calloption:tproccalloption;alignment:byte);override;
end;
tcgcallnode = class(tcallnode)
@ -100,7 +99,7 @@ implementation
TCGCALLPARANODE
*****************************************************************************}
procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
procedure tcgcallparanode.secondcallparan(calloption:tproccalloption;alignment:byte);
var
otlabel,
oflabel : tasmlabel;
@ -111,16 +110,10 @@ implementation
assigned(paraitem.parasym)) then
internalerror(200304242);
{ set default para_alignment to target_info.stackalignment }
if para_alignment=0 then
para_alignment:=aktalignment.paraalign;
{ push from left to right if specified }
if push_from_left_to_right and assigned(right) then
begin
tcallparanode(right).secondcallparan(push_from_left_to_right,
calloption,para_alignment,para_offset);
end;
if assigned(right) and
(calloption in pushleftright_pocalls) then
tcallparanode(right).secondcallparan(calloption,alignment);
otlabel:=truelabel;
oflabel:=falselabel;
@ -145,7 +138,7 @@ implementation
location_release(exprasmlist,left.location);
end
else
push_value_para(exprasmlist,left,vs_value,calloption,para_offset,para_alignment,tempparaloc);
push_value_para(exprasmlist,left,vs_value,calloption,alignment,tempparaloc);
end
{ hidden parameters }
else if paraitem.is_hidden then
@ -160,22 +153,12 @@ implementation
internalerror(200305071);
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
rg.ungetregisterint(exprasmlist,tmpreg);
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
begin
push_value_para(exprasmlist,left,paraitem.paratyp,calloption,
para_offset,para_alignment,tempparaloc);
push_value_para(exprasmlist,left,paraitem.paratyp,calloption,alignment,tempparaloc);
end;
end
{ filter array of const c styled args }
@ -197,13 +180,7 @@ implementation
if (left.nodetype=addrn) and
(not(nf_procvarload in left.flags)) then
begin
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,href);
end
else
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
location_release(exprasmlist,left.location);
end
else
@ -211,55 +188,10 @@ implementation
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
internalerror(200304235);
if calloption=pocall_inline then
begin
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
rg.ungetregisterint(exprasmlist,tmpreg);
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end;
end
(*
{ handle call by reference parameter }
else if (paraitem.paratyp in [vs_var,vs_out]) or
{ win32 stdcall const parameters are also
call by reference, Delphi compatible }
(paraitem.paratyp=vs_const) and
(calloption=pocall_stdcall) and
(target_info.target=target_i386_win32) then
begin
if (left.location.loc<>LOC_REFERENCE) then
begin
{ passing self to a var parameter is allowed in
TP and delphi }
if not((left.location.loc=LOC_CREFERENCE) and
is_self_node(left)) then
internalerror(200106041);
end;
if (paraitem.paratyp=vs_out) and
assigned(paraitem.paratype.def) and
not is_class(paraitem.paratype.def) and
paraitem.paratype.def.needs_inittable then
cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
rg.ungetregisterint(exprasmlist,tmpreg);
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
*)
else
{ don't push a node that already generated a pointer type
by address for implicit hidden parameters }
@ -299,22 +231,12 @@ implementation
end;
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
rg.ungetregisterint(exprasmlist,tmpreg);
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
begin
push_value_para(exprasmlist,left,paraitem.paratyp,calloption,
para_offset,para_alignment,tempparaloc);
push_value_para(exprasmlist,left,paraitem.paratyp,calloption,alignment,tempparaloc);
end;
truelabel:=otlabel;
falselabel:=oflabel;
@ -322,16 +244,12 @@ implementation
{ update return location in callnode when this is the function
result }
if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) then
begin
location_copy(aktcallnode.location,left.location);
end;
location_copy(aktcallnode.location,left.location);
{ push from right to left }
if not push_from_left_to_right and assigned(right) then
begin
tcallparanode(right).secondcallparan(push_from_left_to_right,
calloption,para_alignment,para_offset);
end;
if assigned(right) and
not(calloption in pushleftright_pocalls) then
tcallparanode(right).secondcallparan(calloption,alignment);
end;
@ -377,7 +295,9 @@ implementation
else if (current_procinfo.procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
begin
hregister:=rg.getaddressregister(exprasmlist);
cg.g_load_parent_framepointer(exprasmlist,tprocdef(procdefinition).parast,hregister);
{ we need to push the framepointer of the owner of the called
nested procedure }
cg.g_load_parent_framepointer(exprasmlist,procdefinition.owner,hregister);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,framepointer_paraloc);
rg.ungetaddressregister(exprasmlist,hregister);
end;
@ -457,11 +377,6 @@ implementation
else
begin
cgsize:=def_cgsize(resulttype.def);
{ an object constructor is a function with pointer result }
if (procdefinition.proctypeoption=potype_constructor) then
cgsize:=OS_ADDR;
if cgsize<>OS_NO then
begin
location_reset(location,LOC_REGISTER,cgsize);
@ -735,9 +650,7 @@ implementation
{ Process parameters }
if assigned(left) then
begin
tcallparanode(left).secondcallparan(
(procdefinition.proccalloption in pushleftright_pocalls),procdefinition.proccalloption,
para_alignment,0);
tcallparanode(left).secondcallparan(procdefinition.proccalloption,procdefinition.paraalign);
pushparas;
end;
@ -1320,7 +1233,10 @@ begin
end.
{
$Log$
Revision 1.116 2003-09-23 17:56:05 peter
Revision 1.117 2003-09-25 21:28:00 peter
* parameter fixes
Revision 1.116 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

32
compiler/ncgutil.pas
View File

@ -53,8 +53,7 @@ interface
procedure push_value_para(list:taasmoutput;p:tnode;
varspez:tvarspez;
calloption:tproccalloption;
para_offset:longint;
alignment:longint;
alignment:byte;
const locpara : tparalocation);
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
@ -676,8 +675,7 @@ implementation
procedure push_value_para(list:taasmoutput;p:tnode;
varspez:tvarspez;
calloption:tproccalloption;
para_offset:longint;
alignment:longint;
alignment:byte;
const locpara : tparalocation);
var
href : treference;
@ -699,6 +697,7 @@ implementation
{ Handle Floating point types differently }
if p.resulttype.def.deftype=floatdef then
begin
(*
if calloption=pocall_inline then
begin
size:=align(tfloatdef(p.resulttype.def).size,alignment);
@ -716,6 +715,7 @@ implementation
end;
end
else
*)
begin
{$ifdef i386}
case p.location.loc of
@ -802,6 +802,7 @@ implementation
if cgsize in [OS_64,OS_S64] then
begin
inc(pushedparasize,8);
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
@ -814,11 +815,13 @@ implementation
cg64.a_load64_loc_ref(list,p.location,href);
end
else
*)
cg64.a_param64_loc(list,p.location,locpara);
end
else
begin
inc(pushedparasize,alignment);
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
@ -831,6 +834,7 @@ implementation
cg.a_load_loc_ref(list,p.location.size,p.location,href);
end
else
*)
cg.a_param_loc(list,p.location,locpara);
end;
location_release(list,p.location);
@ -840,12 +844,14 @@ implementation
LOC_CMMXREGISTER:
begin
inc(pushedparasize,8);
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_loadmm_reg_ref(list,p.location.register,href);
end
else
*)
cg.a_parammm_reg(list,p.location.register);
end;
{$endif SUPPORT_MMX}
@ -1967,6 +1973,7 @@ implementation
procedure gen_alloc_parast(list: taasmoutput;st:tparasymtable);
var
sym : tsym;
l : longint;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
@ -1975,12 +1982,14 @@ implementation
begin
with tvarsym(sym) do
begin
l:=getvaluesize;
{ Allocate local copy? }
if (vo_has_local_copy in varoptions) then
if (vo_has_local_copy in varoptions) and
(l>0) then
begin
localloc.loc:=LOC_REFERENCE;
localloc.size:=int_cgsize(getvaluesize);
tg.GetLocal(list,getvaluesize,localloc.reference);
localloc.size:=int_cgsize(l);
tg.GetLocal(list,l,localloc.reference);
end
else
begin
@ -2002,8 +2011,8 @@ implementation
localloc.register:=rg.getregisterint(list,localloc.size);
*)
localloc.loc:=LOC_REFERENCE;
localloc.size:=int_cgsize(getvaluesize);
tg.GetLocal(list,getvaluesize,localloc.reference);
localloc.size:=paraitem.paraloc[calleeside].size;
tg.GetLocal(list,tcgsize2size[localloc.size],localloc.reference);
end
else
localloc:=paraitem.paraloc[calleeside];
@ -2055,7 +2064,10 @@ implementation
end.
{
$Log$
Revision 1.147 2003-09-23 21:03:59 peter
Revision 1.148 2003-09-25 21:28:00 peter
* parameter fixes
Revision 1.147 2003/09/23 21:03:59 peter
* check for refs>0 in init/final local data
Revision 1.146 2003/09/23 17:56:05 peter