paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ 1st attempt to have explicit funcretloc for Amiga/m68k

Browse Source 
git-svn-id: trunk@1978 -
This commit is contained in:
Károly Balogh 2005-12-18 03:58:27 +00:00
parent 12b1ff0df2
commit 739ae4c254
4 changed files with 99 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
compiler/m68k/cpupara.pas
View File

@ -43,12 +43,13 @@ unit cpupara;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
private
procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;
function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
end;
implementation
@ -190,6 +191,16 @@ unit cpupara;
retcgsize:=def_cgsize(p.rettype.def);
location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
{ explicit paraloc specified? }
if po_explicitparaloc in p.procoptions then
begin
p.funcretloc[side].loc:=LOC_REGISTER;
p.funcretloc[side].register:=p.exp_funcretloc;
p.funcretloc[side].size:=retcgsize;
exit;
end;
{ void has no location }
if is_void(p.rettype.def) then
begin
@ -414,6 +425,56 @@ unit cpupara;
end;
}
function tm68kparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;
begin
result:=false;
case target_info.system of
system_m68k_amiga:
begin
if s='D0' then
p.exp_funcretloc:=NR_D0
else if s='D1' then
p.exp_funcretloc:=NR_D1
else if s='D2' then
p.exp_funcretloc:=NR_D2
else if s='D3' then
p.exp_funcretloc:=NR_D3
else if s='D4' then
p.exp_funcretloc:=NR_D4
else if s='D5' then
p.exp_funcretloc:=NR_D5
else if s='D6' then
p.exp_funcretloc:=NR_D6
else if s='D7' then
p.exp_funcretloc:=NR_D7
else if s='A0' then
p.exp_funcretloc:=NR_A0
else if s='A1' then
p.exp_funcretloc:=NR_A1
else if s='A2' then
p.exp_funcretloc:=NR_A2
else if s='A3' then
p.exp_funcretloc:=NR_A3
else if s='A4' then
p.exp_funcretloc:=NR_A4
else if s='A5' then
p.exp_funcretloc:=NR_A5
{ 'A6' is problematic, since it's the frame pointer in fpc,
so it should be saved before a call! }
else if s='A6' then
p.exp_funcretloc:=NR_A6
{ 'A7' is the stack pointer on 68k, can't be overwritten by API calls }
else
p.exp_funcretloc:=NR_NO;
if p.exp_funcretloc<>NR_NO then result:=true;
end;
else
internalerror(2005121801);
end;
end;
function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
var
paraloc : pcgparalocation;

1
compiler/paramgr.pas
View File

@ -112,6 +112,7 @@ unit paramgr;
procedure duplicateparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual;abstract;
function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual;abstract;
end;

34
compiler/pdecsub.pas
View File

@ -862,7 +862,9 @@ implementation
var
pd : tprocdef;
isclassmethod : boolean;
locationstr: string;
begin
locationstr:='';
pd:=nil;
isclassmethod:=false;
{ read class method }
@ -892,6 +894,30 @@ implementation
single_type(pd.rettype,false);
pd.test_if_fpu_result;
dec(testcurobject);
if (target_info.system in [system_m68k_amiga]) then
begin
if (idtoken=_LOCATION) then
begin
if po_explicitparaloc in pd.procoptions then
begin
consume(_LOCATION);
locationstr:=pattern;
consume(_CSTRING);
end
else
{ I guess this needs a new message... (KB) }
Message(parser_e_paraloc_all_paras);
end
else
begin
if po_explicitparaloc in pd.procoptions then
{ assign default locationstr, if none specified }
{ and we've arguments with explicit paraloc }
locationstr:='D0';
end;
end;
end
else
begin
@ -1021,6 +1047,13 @@ implementation
if not(check_proc_directive(false)) then
consume(_SEMICOLON);
result:=pd;
if locationstr<>'' then
begin
if not(paramanager.parsefuncretloc(pd,upper(locationstr))) then
{ I guess this needs a new message... (KB) }
message(parser_e_illegal_explicit_paraloc);
end;
end;
@ -1264,7 +1297,6 @@ begin
else
Message(parser_e_32bitint_or_pointer_variable_expected);
end;
{ FIX ME!!! 68k amigaos syscalls needs explicit funcretloc support to be complete (KB) }
(paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside);
(paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside);
end;

3
compiler/symdef.pas
View File

@ -385,6 +385,9 @@ interface
{$ifdef i386}
fpu_used : longint; { how many stack fpu must be empty }
{$endif i386}
{$ifdef m68k}
exp_funcretloc : tregister; { explicit funcretloc for AmigaOS }
{$endif}
funcretloc : array[tcallercallee] of TLocation;
has_paraloc_info : boolean; { paraloc info is available }
constructor create(level:byte);