paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:39:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ implemented cdecl'd varargs on arm

Browse Source 
+ -dCMEM supported by the compiler
  * label/goto asmsymbol type with -dextdebug fixed
This commit is contained in:
florian 2004-03-20 20:55:36 +00:00
parent 3fe222fbd7
commit c65e094bba
3 changed files with 198 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

310
compiler/arm/cpupara.pas
View File

@ -30,7 +30,7 @@ unit cpupara;
uses uses
globtype, globtype,
aasmtai, aasmtai,
cpubase,cgbase, cpuinfo,cpubase,cgbase,
symconst,symbase,symtype,symdef,paramgr; symconst,symbase,symtype,symdef,paramgr;
type type
@ -39,16 +39,19 @@ unit cpupara;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override; function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override; function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
// procedure freeintparaloc(list: taasmoutput; nr : longint); override;
procedure alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);override; procedure alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
private
procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
end; end;
implementation implementation
uses uses
verbose,systems, verbose,systems,
cpuinfo,
rgobj, rgobj,
defutil,symsym; defutil,symsym;
@ -85,22 +88,6 @@ unit cpupara;
result.size := OS_INT; result.size := OS_INT;
end; end;
{
procedure tarmparamanager.freeintparaloc(list: taasmoutput; nr : longint);
var
r: tregister;
begin
if nr<1 then
internalerror(2003060401)
else if nr<=4 then
begin
r:=newreg(R_INTREGISTER,RS_R0+nr,R_SUBWHOLE);
rg.ungetregisterint(list,r);
end;
end;
}
function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc; function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
begin begin
@ -159,6 +146,7 @@ unit cpupara;
end; end;
end; end;
function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin begin
if varspez in [vs_var,vs_out] then if varspez in [vs_var,vs_out] then
@ -186,47 +174,53 @@ unit cpupara;
end; end;
function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
begin
curintreg:=RS_R0;
curfloatreg:=RS_F0;
curmmreg:=RS_D0;
cur_stack_offset:=0;
end;
function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
var var
nextintreg,nextfloatreg,nextmmreg : tsuperregister; nextintreg,nextfloatreg,nextmmreg : tsuperregister;
paradef : tdef; paradef : tdef;
paraloc : tparalocation; paraloc : tparalocation;
stack_offset : aword; stack_offset : aword;
hp : tparaitem; hp : tparaitem;
loc : tcgloc; loc : tcgloc;
is_64bit: boolean; is_64bit: boolean;
procedure assignintreg; procedure assignintreg;
begin begin
if nextintreg<=ord(NR_R3) then if nextintreg<=ord(NR_R3) then
begin begin
paraloc.loc:=LOC_REGISTER; paraloc.loc:=LOC_REGISTER;
paraloc.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); paraloc.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg); inc(nextintreg);
end end
else else
begin begin
paraloc.loc:=LOC_REFERENCE; paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG; paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset; paraloc.reference.offset:=stack_offset;
inc(stack_offset,4); inc(stack_offset,4);
end; end;
end; end;
begin begin
result:=0; result:=0;
{ zero alignment bytes } nextintreg:=curintreg;
fillchar(nextintreg,sizeof(nextintreg),0); nextfloatreg:=curfloatreg;
fillchar(nextfloatreg,sizeof(nextfloatreg),0); nextmmreg:=curmmreg;
fillchar(nextmmreg,sizeof(nextmmreg),0); stack_offset:=cur_stack_offset;
nextintreg:=RS_R0;
nextfloatreg:=RS_F0;
nextmmreg:=RS_D0;
stack_offset:=0;
hp:=tparaitem(p.para.first); hp:=firstpara;
while assigned(hp) do while assigned(hp) do
begin begin
if (hp.paratyp in [vs_var,vs_out]) then if (hp.paratyp in [vs_var,vs_out]) then
@ -245,66 +239,66 @@ unit cpupara;
case loc of case loc of
LOC_REGISTER: LOC_REGISTER:
begin begin
paraloc.size := def_cgsize(paradef); paraloc.size := def_cgsize(paradef);
{ for things like formaldef } { for things like formaldef }
if paraloc.size = OS_NO then if paraloc.size = OS_NO then
paraloc.size := OS_ADDR; paraloc.size := OS_ADDR;
is_64bit := paraloc.size in [OS_64,OS_S64,OS_F64]; is_64bit := paraloc.size in [OS_64,OS_S64,OS_F64];
{ this is not abi compliant } { this is not abi compliant }
if nextintreg<=(RS_R3-ord(is_64bit)) then if nextintreg<=(RS_R3-ord(is_64bit)) then
begin
paraloc.loc:=LOC_REGISTER;
paraloc.registerlow:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
if is_64bit then
begin
paraloc.lochigh:=LOC_REGISTER;
paraloc.registerhigh:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
end;
end
else
begin begin
paraloc.loc:=LOC_REGISTER; nextintreg:=RS_R4;
paraloc.registerlow:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); paraloc.loc:=LOC_REFERENCE;
inc(nextintreg); paraloc.reference.index:=NR_STACK_POINTER_REG;
if is_64bit then paraloc.reference.offset:=stack_offset;
begin if not is_64bit then
paraloc.lochigh:=LOC_REGISTER; inc(stack_offset,4)
paraloc.registerhigh:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); else
inc(nextintreg); inc(stack_offset,8);
end; end;
end
else
begin
nextintreg:=RS_R4;
paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset;
if not is_64bit then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end; end;
LOC_FPUREGISTER: LOC_FPUREGISTER:
begin begin
paraloc.size:=def_cgsize(paradef); paraloc.size:=def_cgsize(paradef);
if nextfloatreg<=RS_F3 then if nextfloatreg<=RS_F3 then
begin begin
paraloc.loc:=LOC_FPUREGISTER; paraloc.loc:=LOC_FPUREGISTER;
paraloc.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE); paraloc.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
inc(nextfloatreg); inc(nextfloatreg);
end end
else else
begin begin
{!!!!!!!} {!!!!!!!}
paraloc.size:=def_cgsize(paradef); paraloc.size:=def_cgsize(paradef);
internalerror(2002071004); internalerror(2002071004);
end; end;
end; end;
LOC_REFERENCE: LOC_REFERENCE:
begin begin
paraloc.size:=OS_ADDR; paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratyp,paradef,p.proccalloption) or if push_addr_param(hp.paratyp,paradef,p.proccalloption) or
is_open_array(paradef) or is_open_array(paradef) or
is_array_of_const(paradef) then is_array_of_const(paradef) then
assignintreg assignintreg
else else
begin begin
paraloc.loc:=LOC_REFERENCE; paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG; paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset; paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size); inc(stack_offset,hp.paratype.def.size);
end; end;
end; end;
else else
internalerror(2002071002); internalerror(2002071002);
@ -320,35 +314,53 @@ unit cpupara;
hp.paraloc[side]:=paraloc; hp.paraloc[side]:=paraloc;
hp:=tparaitem(hp.next); hp:=tparaitem(hp.next);
end; end;
{ Function return } curintreg:=nextintreg;
fillchar(paraloc,sizeof(tparalocation),0); curfloatreg:=nextfloatreg;
paraloc.lochigh:=LOC_INVALID; curmmreg:=nextmmreg;
paraloc.size:=def_cgsize(p.rettype.def); cur_stack_offset:=stack_offset;
{ Return in FPU register? } result:=cur_stack_offset;
if p.rettype.def.deftype=floatdef then end;
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register:=NR_FPU_RESULT_REG; function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
end var
else paraloc : tparalocation;
{ Return in register? } cur_stack_offset: aword;
if not ret_in_param(p.rettype.def,p.proccalloption) then curintreg, curfloatreg, curmmreg: tsuperregister;
begin begin
paraloc.loc:=LOC_REGISTER; init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
if paraloc.size in [OS_64,OS_S64] then
begin result:=create_paraloc_info_intern(p,side,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
paraloc.lochigh:=LOC_REGISTER;
paraloc.register:=NR_FUNCTION_RETURN64_LOW_REG; { Function return }
paraloc.registerhigh:=NR_FUNCTION_RETURN64_HIGH_REG; fillchar(paraloc,sizeof(tparalocation),0);
end paraloc.lochigh:=LOC_INVALID;
else paraloc.size:=def_cgsize(p.rettype.def);
paraloc.register:=NR_FUNCTION_RETURN_REG; { Return in FPU register? }
end if p.rettype.def.deftype=floatdef then
else begin
begin paraloc.loc:=LOC_FPUREGISTER;
paraloc.loc:=LOC_REFERENCE; paraloc.register:=NR_FPU_RESULT_REG;
end; end
p.funcret_paraloc[side]:=paraloc; else
{ Return in register? }
if not ret_in_param(p.rettype.def,p.proccalloption) then
begin
paraloc.loc:=LOC_REGISTER;
if paraloc.size in [OS_64,OS_S64] then
begin
paraloc.lochigh:=LOC_REGISTER;
paraloc.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc.registerhigh:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
paraloc.register:=NR_FUNCTION_RETURN_REG;
end
else
begin
paraloc.loc:=LOC_REFERENCE;
end;
p.funcret_paraloc[side]:=paraloc;
end; end;
@ -372,12 +384,52 @@ unit cpupara;
end; end;
function tarmparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;
var
cur_stack_offset: aword;
parasize, l: longint;
curintreg, curfloatreg, curmmreg: tsuperregister;
hp: tparaitem;
paraloc: tparalocation;
begin
init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
result:=create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
{ just continue loading the parameters in the registers }
result:=create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),curintreg,curfloatreg,curmmreg,cur_stack_offset)
else
begin
hp:=tparaitem(varargspara.first);
parasize:=cur_stack_offset;
while assigned(hp) do
begin
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.lochigh:=LOC_INVALID;
paraloc.loc:=LOC_REFERENCE;
paraloc.alignment:=4;
paraloc.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
paraloc.reference.offset:=parasize;
parasize:=parasize+l;
hp.paraloc[callerside]:=paraloc;
hp:=tparaitem(hp.next);
end;
result := parasize;
end;
end;
begin begin
paramanager:=tarmparamanager.create; paramanager:=tarmparamanager.create;
end. end.
{ {
$Log$ $Log$
Revision 1.15 2004-03-07 00:16:59 florian Revision 1.16 2004-03-20 20:55:36 florian
+ implemented cdecl'd varargs on arm
+ -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed
Revision 1.15 2004/03/07 00:16:59 florian
* compilation of arm rtl fixed * compilation of arm rtl fixed
Revision 1.14 2004/02/09 22:48:45 florian Revision 1.14 2004/02/09 22:48:45 florian

16
compiler/pdecl.pas
View File

@ -258,14 +258,7 @@ implementation
consume(_ID) consume(_ID)
else else
begin begin
if (cs_create_smart in aktmoduleswitches) then objectlibrary.getlabel(hl);
begin
objectlibrary.getdatalabel(hl);
{ we still want a warning if unused }
hl.decrefs;
end
else
objectlibrary.getlabel(hl);
if token=_ID then if token=_ID then
symtablestack.insert(tlabelsym.create(orgpattern,hl)) symtablestack.insert(tlabelsym.create(orgpattern,hl))
else else
@ -675,7 +668,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.83 2004-03-08 22:07:47 peter Revision 1.84 2004-03-20 20:55:36 florian
+ implemented cdecl'd varargs on arm
+ -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed
Revision 1.83 2004/03/08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used * stabs updates to write stabs for def for all implictly used
units units

11
compiler/pp.pas
View File

@ -26,6 +26,7 @@ program pp;
possible compiler switches (* marks a currently required switch): possible compiler switches (* marks a currently required switch):
----------------------------------------------------------------- -----------------------------------------------------------------
GDB* support of the GNU Debugger GDB* support of the GNU Debugger
CMEM use cmem unit for better memory debugging
I386 generate a compiler for the Intel i386+ I386 generate a compiler for the Intel i386+
x86_64 generate a compiler for the AMD x86-64 architecture x86_64 generate a compiler for the AMD x86-64 architecture
M68K generate a compiler for the M68000 M68K generate a compiler for the M68000
@ -129,6 +130,9 @@ program pp;
{$endif} {$endif}
uses uses
{$ifdef cmem}
cmem,
{$endif cmem}
{$ifdef FPC} {$ifdef FPC}
{$ifdef profile} {$ifdef profile}
profile, profile,
@ -203,7 +207,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.29 2004-01-26 17:39:12 florian Revision 1.30 2004-03-20 20:55:36 florian
+ implemented cdecl'd varargs on arm
+ -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed
Revision 1.29 2004/01/26 17:39:12 florian
* when compiled with -dnocatch, known rtes aren't translated anymore * when compiled with -dnocatch, known rtes aren't translated anymore
and a stack dump is written and a stack dump is written