diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index 93750212aa..0be63e809d 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -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; diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas index 1d0a0159e6..201d633a4f 100644 --- a/compiler/paramgr.pas +++ b/compiler/paramgr.pas @@ -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; diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 75e1dc2fc9..170e9d899a 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 92b2520b1c..476a897c9e 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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);