mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 13:19:34 +01:00
huge syscall support refactor for Amiga-likes. removed large chunks of ancient duplicated code, and in general tried to make the entire thing more maintainable and cleaner. also added support for AROS EAXBase syscall convention
git-svn-id: trunk@34416 -
This commit is contained in:
Károly Balogh
parent
a0713632a9
commit
464ecab542
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -705,6 +705,7 @@ compiler/symsym.pas svneol=native#text/plain
|
||||
compiler/symtable.pas svneol=native#text/plain
|
||||
compiler/symtype.pas svneol=native#text/plain
|
||||
compiler/symutil.pas svneol=native#text/plain
|
||||
compiler/syscinfo.pas svneol=native#text/plain
|
||||
compiler/systems.inc svneol=native#text/plain
|
||||
compiler/systems.pas svneol=native#text/plain
|
||||
compiler/systems/i_aix.pas svneol=native#text/plain
|
||||
|
||||
@ -368,11 +368,6 @@ interface
|
||||
palmos_applicationid : string[4] = 'FPCA';
|
||||
{$endif defined(m68k) or defined(arm)}
|
||||
|
||||
{$ifdef powerpc}
|
||||
{ default calling convention used on MorphOS }
|
||||
syscall_convention : string = 'LEGACY';
|
||||
{$endif powerpc}
|
||||
|
||||
{ default name of the C-style "main" procedure of the library/program }
|
||||
{ (this will be prefixed with the target_info.cprefix) }
|
||||
defaultmainaliasname = 'main';
|
||||
|
||||
@ -44,6 +44,7 @@ unit cpupara;
|
||||
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;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; forcetempdef: tdef): TCGPara;override;
|
||||
function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
|
||||
private
|
||||
procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
|
||||
procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint);
|
||||
@ -53,7 +54,7 @@ unit cpupara;
|
||||
implementation
|
||||
|
||||
uses
|
||||
cutils,
|
||||
cutils,sysutils,
|
||||
systems,verbose,
|
||||
symtable,
|
||||
defutil;
|
||||
@ -286,6 +287,32 @@ unit cpupara;
|
||||
end;
|
||||
|
||||
|
||||
function tcpuparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
|
||||
var
|
||||
paraloc : pcgparalocation;
|
||||
begin
|
||||
result:=false;
|
||||
case target_info.system of
|
||||
system_i386_aros:
|
||||
begin
|
||||
p.paraloc[callerside].alignment:=4;
|
||||
paraloc:=p.paraloc[callerside].add_location;
|
||||
paraloc^.loc:=LOC_REGISTER;
|
||||
paraloc^.size:=def_cgsize(p.vardef);
|
||||
paraloc^.def:=p.vardef;
|
||||
paraloc^.register:=std_regnum_search(lowercase(s));
|
||||
if paraloc^.register = NR_NO then
|
||||
exit;
|
||||
|
||||
{ copy to callee side }
|
||||
p.paraloc[calleeside].add_location^:=paraloc^;
|
||||
end;
|
||||
else
|
||||
internalerror(2016090103);
|
||||
end;
|
||||
result:=true;
|
||||
end;
|
||||
|
||||
function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
|
||||
var
|
||||
retcgsize : tcgsize;
|
||||
@ -417,6 +444,19 @@ unit cpupara;
|
||||
begin
|
||||
hp:=tparavarsym(paras[i]);
|
||||
paradef:=hp.vardef;
|
||||
|
||||
{ syscall for AROS can have already a paraloc set }
|
||||
if (vo_has_explicit_paraloc in hp.varoptions) then
|
||||
begin
|
||||
if not(vo_is_syscall_lib in hp.varoptions) then
|
||||
internalerror(2016090105);
|
||||
if p.proccalloption in pushleftright_pocalls then
|
||||
dec(i)
|
||||
else
|
||||
inc(i);
|
||||
continue;
|
||||
end;
|
||||
|
||||
pushaddr:=push_addr_param(hp.varspez,paradef,p.proccalloption);
|
||||
if pushaddr then
|
||||
begin
|
||||
|
||||
@ -50,7 +50,8 @@ implementation
|
||||
cpubase,paramgr,
|
||||
aasmtai,aasmdata,aasmcpu,
|
||||
nbas,nmem,nld,ncnv,
|
||||
symdef,symsym,symcpu,
|
||||
parabase,
|
||||
symdef,symsym,symcpu,symconst,
|
||||
cga,cgobj,cpuinfo;
|
||||
|
||||
|
||||
@ -62,31 +63,43 @@ implementation
|
||||
procedure ti386callnode.do_syscall;
|
||||
var
|
||||
tmpref: treference;
|
||||
libparaloc: pcgparalocation;
|
||||
begin
|
||||
case target_info.system of
|
||||
system_i386_aros:
|
||||
begin
|
||||
// one syscall convention for AROS
|
||||
current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall')));
|
||||
reference_reset(tmpref,sizeof(pint));
|
||||
{ re-read the libbase pushed first on the stack, instead of just trusting the
|
||||
mangledname will work. this is important for example for threadvar libbases.
|
||||
and this way they also don't need to be resolved twice then. (KB) }
|
||||
tmpref.base:=NR_ESP;
|
||||
tmpref.offset:=pushedparasize-sizeof(pint);
|
||||
cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
|
||||
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
|
||||
reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
|
||||
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
|
||||
cg.a_call_reg(current_asmdata.CurrAsmList,NR_EAX);
|
||||
cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
|
||||
if (po_syscall_stackbase in tprocdef(procdefinition).procoptions) then
|
||||
begin
|
||||
current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall - StackBase')));
|
||||
{ re-read the libbase pushed first on the stack, instead of just trusting the
|
||||
mangledname will work. this is important for example for threadvar libbases.
|
||||
and this way they also don't need to be resolved twice then. (KB) }
|
||||
libparaloc:=paralocs[procdefinition.paras.count-1]^.location;
|
||||
if libparaloc^.loc <> LOC_REFERENCE then
|
||||
internalerror(2016090203);
|
||||
reference_reset_base(tmpref,libparaloc^.reference.index,libparaloc^.reference.offset,sizeof(pint));
|
||||
cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
|
||||
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,NR_EAX);
|
||||
reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,tmpref));
|
||||
cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
|
||||
exit;
|
||||
end;
|
||||
if (po_syscall_eaxbase in tprocdef(procdefinition).procoptions) then
|
||||
begin
|
||||
current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall - EAXBase')));
|
||||
{ libbase must be in EAX already, so just piggyback that, and dereference it }
|
||||
reference_reset_base(tmpref,NR_EAX,-tprocdef(procdefinition).extnumber,sizeof(pint));
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,tmpref));
|
||||
exit;
|
||||
end;
|
||||
internalerror(2016090104);
|
||||
end;
|
||||
else
|
||||
internalerror(2014081801);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386callnode.gen_syscall_para(para: tcallparanode);
|
||||
begin
|
||||
{ lib parameter has no special type but proccalloptions must be a syscall }
|
||||
|
||||
@ -139,7 +139,7 @@ general_e_exception_raised=01026_E_Compilation raised exception internally
|
||||
#
|
||||
# Scanner
|
||||
#
|
||||
# 02099 is the last used one
|
||||
# 02101 is the last used one
|
||||
#
|
||||
% \section{Scanner messages.}
|
||||
% This section lists the messages that the scanner emits. The scanner takes
|
||||
@ -413,6 +413,11 @@ scan_e_illegal_hugepointernormalization=02098_E_Illegal argument for HUGEPOINTER
|
||||
scan_e_illegal_asmcpu_specifier=02099_E_Illegal assembler CPU instruction set specified "$1"
|
||||
% When you specify an assembler CPU with the \var{\{\$ASMCPU xxx\}} directive,
|
||||
% the compiler didn't recognize the CPU you specified.
|
||||
scan_w_syscall_convention_not_useable_on_target=02100_W_Specified syscall convention is not useable on this target
|
||||
% The specified syscall convention using the \var{\{\$SYSCALL xxx\}} directive,
|
||||
% is not useable on the current target system.
|
||||
scan_w_syscall_convention_invalid=02101_W_Invalid syscall convention specified
|
||||
% The compiler did not recognize the syscall convention specified by the \var{\{\$SYSCALL xxx\}} directive.
|
||||
% \end{description}
|
||||
#
|
||||
# Parser
|
||||
|
||||
@ -122,6 +122,8 @@ const
|
||||
scan_w_heapmax_lessthan_heapmin=02097;
|
||||
scan_e_illegal_hugepointernormalization=02098;
|
||||
scan_e_illegal_asmcpu_specifier=02099;
|
||||
scan_w_syscall_convention_not_useable_on_target=02100;
|
||||
scan_w_syscall_convention_invalid=02101;
|
||||
parser_e_syntax_error=03000;
|
||||
parser_e_dont_nest_interrupt=03004;
|
||||
parser_w_proc_directive_ignored=03005;
|
||||
@ -1059,9 +1061,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 78269;
|
||||
MsgTxtSize = 78381;
|
||||
|
||||
MsgIdxMax : array[1..20] of longint=(
|
||||
27,100,347,124,96,58,130,33,208,65,
|
||||
27,102,347,124,96,58,130,33,208,65,
|
||||
58,20,30,1,1,1,1,1,1,1
|
||||
);
|
||||
|
||||
1573
compiler/msgtxt.inc
1573
compiler/msgtxt.inc
File diff suppressed because it is too large
Load Diff
@ -115,6 +115,7 @@ implementation
|
||||
objcutil,
|
||||
{ parser }
|
||||
scanner,
|
||||
syscinfo,
|
||||
pbase,pexpr,ptype,pdecl,pparautl,pgenutil
|
||||
{$ifdef jvm}
|
||||
,pjvm
|
||||
@ -2044,209 +2045,113 @@ end;
|
||||
|
||||
|
||||
procedure pd_syscall(pd:tabstractprocdef);
|
||||
|
||||
procedure include_po_syscall;
|
||||
var
|
||||
syscall: psyscallinfo;
|
||||
begin
|
||||
case target_info.system of
|
||||
system_m68k_amiga,
|
||||
system_powerpc_amiga:
|
||||
include(pd.procoptions,get_default_syscall);
|
||||
system_powerpc_morphos,
|
||||
system_i386_aros,
|
||||
system_x86_64_aros:
|
||||
begin
|
||||
syscall:=get_syscall_by_token(idtoken);
|
||||
if assigned(syscall) then
|
||||
begin
|
||||
if target_info.system in syscall^.validon then
|
||||
begin
|
||||
consume(idtoken);
|
||||
include(pd.procoptions,syscall^.procoption);
|
||||
end
|
||||
end
|
||||
else
|
||||
include(pd.procoptions,get_default_syscall);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function po_syscall_to_varoptions: tvaroptions;
|
||||
begin
|
||||
result:=[vo_is_syscall_lib,vo_is_hidden_para];
|
||||
if ([po_syscall_legacy,po_syscall_r12base,po_syscall_sysv,po_syscall_eaxbase] * tprocdef(pd).procoptions) <> [] then
|
||||
include(result,vo_has_explicit_paraloc);
|
||||
end;
|
||||
|
||||
function po_syscall_to_regname: string;
|
||||
begin
|
||||
if po_syscall_legacy in tprocdef(pd).procoptions then
|
||||
result:='A6'
|
||||
else if po_syscall_r12base in tprocdef(pd).procoptions then
|
||||
result:='R12'
|
||||
{ let sysv store the libbase in r12 as well, because we will
|
||||
need the libbase anyway during the call generation }
|
||||
else if po_syscall_sysv in tprocdef(pd).procoptions then
|
||||
result:='R12'
|
||||
else if po_syscall_eaxbase in tprocdef(pd).procoptions then
|
||||
begin
|
||||
if target_info.system = system_i386_aros then
|
||||
result:='EAX'
|
||||
else if target_info.system = system_x86_64_aros then
|
||||
result:='RAX'
|
||||
else
|
||||
internalerror(2016090201);
|
||||
end
|
||||
else
|
||||
internalerror(2016090101);
|
||||
end;
|
||||
|
||||
{$if defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
|
||||
const
|
||||
syscall_paranr: array[boolean] of aint =
|
||||
( paranr_syscall_lib_last, paranr_syscall_lib_first );
|
||||
var
|
||||
vs : tparavarsym;
|
||||
sym : tsym;
|
||||
symtable : TSymtable;
|
||||
v: Tconstexprint;
|
||||
vo: tvaroptions;
|
||||
paranr: aint;
|
||||
{$endif defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
|
||||
begin
|
||||
if (pd.typ<>procdef) and (target_info.system <> system_powerpc_amiga) then
|
||||
internalerror(2003042614);
|
||||
tprocdef(pd).forwarddef:=false;
|
||||
{$ifdef m68k}
|
||||
if target_info.system in [system_m68k_amiga] then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_legacy);
|
||||
{$if defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
|
||||
include_po_syscall;
|
||||
|
||||
if consume_sym(sym,symtable) then
|
||||
begin
|
||||
if (sym.typ=staticvarsym) and
|
||||
(
|
||||
(tabstractvarsym(sym).vardef.typ=pointerdef) or
|
||||
is_32bitint(tabstractvarsym(sym).vardef)
|
||||
) then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_has_libsym);
|
||||
tcpuprocdef(pd).libsym:=sym;
|
||||
if po_syscall_legacy in tprocdef(pd).procoptions then
|
||||
begin
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
|
||||
paramanager.parseparaloc(vs,'A6');
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
end
|
||||
else
|
||||
Message(parser_e_32bitint_or_pointer_variable_expected);
|
||||
end;
|
||||
paramanager.create_funcretloc_info(pd,calleeside);
|
||||
paramanager.create_funcretloc_info(pd,callerside);
|
||||
if consume_sym(sym,symtable) then
|
||||
if (sym.typ=staticvarsym) and
|
||||
((tabstractvarsym(sym).vardef.typ=pointerdef) or
|
||||
is_32bitint(tabstractvarsym(sym).vardef)) then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_has_libsym);
|
||||
tcpuprocdef(pd).libsym:=sym;
|
||||
|
||||
v:=get_intconst;
|
||||
if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
|
||||
message3(type_e_range_check_error_bounds,tostr(v),tostr(low(Tprocdef(pd).extnumber)),tostr(high(Tprocdef(pd).extnumber)))
|
||||
else
|
||||
Tprocdef(pd).extnumber:=v.uvalue;
|
||||
end;
|
||||
{$endif m68k}
|
||||
{$ifdef powerpc}
|
||||
if target_info.system = system_powerpc_amiga then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_basesysv);
|
||||
vo:=po_syscall_to_varoptions;
|
||||
paranr:=syscall_paranr[po_syscall_basesysv in tprocdef(pd).procoptions];
|
||||
vs:=cparavarsym.create('$syscalllib',paranr,vs_value,tabstractvarsym(sym).vardef,vo);
|
||||
if vo_has_explicit_paraloc in vo then
|
||||
paramanager.parseparaloc(vs,po_syscall_to_regname);
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else
|
||||
Message(parser_e_32bitint_or_pointer_variable_expected);
|
||||
|
||||
if consume_sym(sym,symtable) then
|
||||
begin
|
||||
if (sym.typ=staticvarsym) and
|
||||
(
|
||||
(tabstractvarsym(sym).vardef.typ=pointerdef) or
|
||||
is_32bitint(tabstractvarsym(sym).vardef)
|
||||
) then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_has_libsym);
|
||||
tcpuprocdef(pd).libsym:=sym;
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else
|
||||
Message(parser_e_32bitint_or_pointer_variable_expected);
|
||||
end;
|
||||
paramanager.create_funcretloc_info(pd,calleeside);
|
||||
paramanager.create_funcretloc_info(pd,callerside);
|
||||
|
||||
paramanager.create_funcretloc_info(pd,calleeside);
|
||||
paramanager.create_funcretloc_info(pd,callerside);
|
||||
|
||||
v:=get_intconst;
|
||||
if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
|
||||
message(parser_e_range_check_error)
|
||||
else
|
||||
Tprocdef(pd).extnumber:=v.uvalue;
|
||||
end else
|
||||
|
||||
if target_info.system = system_powerpc_morphos then
|
||||
begin
|
||||
if idtoken=_LEGACY then
|
||||
begin
|
||||
consume(_LEGACY);
|
||||
include(pd.procoptions,po_syscall_legacy);
|
||||
end
|
||||
else if idtoken=_SYSV then
|
||||
begin
|
||||
consume(_SYSV);
|
||||
include(pd.procoptions,po_syscall_sysv);
|
||||
end
|
||||
else if idtoken=_BASESYSV then
|
||||
begin
|
||||
consume(_BASESYSV);
|
||||
include(pd.procoptions,po_syscall_basesysv);
|
||||
end
|
||||
else if idtoken=_SYSVBASE then
|
||||
begin
|
||||
consume(_SYSVBASE);
|
||||
include(pd.procoptions,po_syscall_sysvbase);
|
||||
end
|
||||
else if idtoken=_R12BASE then
|
||||
begin
|
||||
consume(_R12BASE);
|
||||
include(pd.procoptions,po_syscall_r12base);
|
||||
end
|
||||
else
|
||||
if syscall_convention='LEGACY' then
|
||||
include(pd.procoptions,po_syscall_legacy)
|
||||
else if syscall_convention='SYSV' then
|
||||
include(pd.procoptions,po_syscall_sysv)
|
||||
else if syscall_convention='BASESYSV' then
|
||||
include(pd.procoptions,po_syscall_basesysv)
|
||||
else if syscall_convention='SYSVBASE' then
|
||||
include(pd.procoptions,po_syscall_sysvbase)
|
||||
else if syscall_convention='R12BASE' then
|
||||
include(pd.procoptions,po_syscall_r12base)
|
||||
else
|
||||
internalerror(2005010404);
|
||||
|
||||
if consume_sym(sym,symtable) then
|
||||
begin
|
||||
if (sym.typ=staticvarsym) and
|
||||
(
|
||||
(tabstractvarsym(sym).vardef.typ=pointerdef) or
|
||||
is_32bitint(tabstractvarsym(sym).vardef)
|
||||
) then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_has_libsym);
|
||||
tcpuprocdef(pd).libsym:=sym;
|
||||
if po_syscall_legacy in tprocdef(pd).procoptions then
|
||||
begin
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
|
||||
paramanager.parseparaloc(vs,'A6');
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else if po_syscall_sysv in tprocdef(pd).procoptions then
|
||||
begin
|
||||
{ Nothing to be done for sysv here for now, but this might change }
|
||||
end
|
||||
else if po_syscall_basesysv in tprocdef(pd).procoptions then
|
||||
begin
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else if po_syscall_sysvbase in tprocdef(pd).procoptions then
|
||||
begin
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_sysvbase,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else if po_syscall_r12base in tprocdef(pd).procoptions then
|
||||
begin
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_r12base,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
|
||||
paramanager.parseparaloc(vs,'R12');
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else
|
||||
internalerror(2005010501);
|
||||
end
|
||||
else
|
||||
Message(parser_e_32bitint_or_pointer_variable_expected);
|
||||
end;
|
||||
paramanager.create_funcretloc_info(pd,calleeside);
|
||||
paramanager.create_funcretloc_info(pd,callerside);
|
||||
|
||||
v:=get_intconst;
|
||||
if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
|
||||
message(parser_e_range_check_error)
|
||||
else
|
||||
Tprocdef(pd).extnumber:=v.uvalue;
|
||||
end;
|
||||
{$endif powerpc}
|
||||
{$if defined(i386) or defined(x86_64)}
|
||||
if target_info.system in [system_i386_aros,system_x86_64_aros] then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_sysvbase);
|
||||
|
||||
if consume_sym(sym,symtable) then
|
||||
begin
|
||||
if (sym.typ=staticvarsym) and
|
||||
(
|
||||
(tabstractvarsym(sym).vardef.typ=pointerdef) or
|
||||
is_32bitint(tabstractvarsym(sym).vardef)
|
||||
) then
|
||||
begin
|
||||
include(pd.procoptions,po_syscall_has_libsym);
|
||||
tcpuprocdef(pd).libsym:=sym;
|
||||
vs:=cparavarsym.create('$syscalllib',paranr_syscall_sysvbase,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]);
|
||||
pd.parast.insert(vs);
|
||||
end
|
||||
else
|
||||
Message(parser_e_32bitint_or_pointer_variable_expected);
|
||||
end;
|
||||
|
||||
paramanager.create_funcretloc_info(pd,calleeside);
|
||||
paramanager.create_funcretloc_info(pd,callerside);
|
||||
|
||||
v:=get_intconst;
|
||||
if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
|
||||
message(parser_e_range_check_error)
|
||||
else
|
||||
Tprocdef(pd).extnumber:=v.uvalue * sizeof(pint);
|
||||
end;
|
||||
{$endif}
|
||||
v:=get_intconst;
|
||||
if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then
|
||||
message3(type_e_range_check_error_bounds,tostr(v),tostr(low(Tprocdef(pd).extnumber)),tostr(high(Tprocdef(pd).extnumber)))
|
||||
else
|
||||
if target_info.system in [system_i386_aros,system_x86_64_aros] then
|
||||
Tprocdef(pd).extnumber:=v.uvalue * sizeof(pint)
|
||||
else
|
||||
Tprocdef(pd).extnumber:=v.uvalue;
|
||||
{$endif defined(powerpc) or defined(m68k) or defined(i386) or defined(x86_64)}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -1395,7 +1395,7 @@ implementation
|
||||
end;
|
||||
|
||||
{ Check for EXTERNAL etc directives before a semicolon }
|
||||
if (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) then
|
||||
if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL) then
|
||||
begin
|
||||
read_public_and_external_sc(sc);
|
||||
allowdefaultvalue:=false;
|
||||
@ -1456,7 +1456,7 @@ implementation
|
||||
{ Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
|
||||
if (
|
||||
(
|
||||
(idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
|
||||
((idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL)) and
|
||||
(m_cvar_support in current_settings.modeswitches)
|
||||
) or
|
||||
(
|
||||
|
||||
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion = 185;
|
||||
CurrentPPUVersion = 186;
|
||||
|
||||
{ unit flags }
|
||||
uf_init = $000001; { unit has initialization section }
|
||||
|
||||
@ -92,7 +92,7 @@ implementation
|
||||
(
|
||||
(
|
||||
(token = _ID) and
|
||||
(idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
|
||||
((idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) or (idtoken = _WEAKEXTERNAL)) and
|
||||
(m_cvar_support in current_settings.modeswitches)
|
||||
) or
|
||||
(
|
||||
|
||||
@ -58,6 +58,7 @@ unit scandir;
|
||||
fmodule,
|
||||
defutil,
|
||||
dirparse,link,
|
||||
syscinfo,
|
||||
symconst,symtable,symbase,symtype,symsym,
|
||||
rabase;
|
||||
|
||||
@ -1299,27 +1300,25 @@ unit scandir;
|
||||
// different places. Skip it for now.
|
||||
end;
|
||||
|
||||
{$ifdef powerpc}
|
||||
procedure dir_syscall;
|
||||
var
|
||||
sctype : string;
|
||||
syscall : psyscallinfo;
|
||||
begin
|
||||
{ not needed on amiga/m68k for now, because there's only one }
|
||||
{ syscall convention (legacy) (KB) }
|
||||
{ not needed on amiga/powerpc because there's only one }
|
||||
{ syscall convention (sysv) (KB) }
|
||||
if not (target_info.system in [system_powerpc_morphos]) then
|
||||
comment (V_Warning,'Syscall directive is useless on this target.');
|
||||
current_scanner.skipspace;
|
||||
|
||||
sctype:=current_scanner.readid;
|
||||
if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or
|
||||
(sctype='BASESYSV') or (sctype='R12BASE') then
|
||||
syscall_convention:=sctype
|
||||
else
|
||||
comment (V_Warning,'Invalid Syscall directive ignored.');
|
||||
|
||||
syscall:=get_syscall_by_name(sctype);
|
||||
if assigned(syscall) then
|
||||
begin
|
||||
if not (target_info.system in syscall^.validon) then
|
||||
Message(scan_w_syscall_convention_not_useable_on_target)
|
||||
else
|
||||
set_default_syscall(syscall^.procoption);
|
||||
exit;
|
||||
end;
|
||||
Message(scan_w_syscall_convention_invalid);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure dir_targetswitch;
|
||||
var
|
||||
@ -1861,9 +1860,7 @@ unit scandir;
|
||||
AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
|
||||
AddDirective('STOP',directive_all, @dir_stop);
|
||||
AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks);
|
||||
{$ifdef powerpc}
|
||||
AddDirective('SYSCALL',directive_all, @dir_syscall);
|
||||
{$endif powerpc}
|
||||
AddDirective('TARGETSWITCH',directive_all, @dir_targetswitch);
|
||||
AddDirective('THREADNAME',directive_all, @dir_threadname);
|
||||
AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);
|
||||
|
||||
@ -134,11 +134,11 @@ const
|
||||
after the hidden result parameter }
|
||||
paranr_objc_self = 5;
|
||||
paranr_objc_cmd = 6;
|
||||
{ Required to support variations of syscalls on MorphOS }
|
||||
paranr_syscall_basesysv = 9;
|
||||
paranr_syscall_sysvbase = high(word)-5;
|
||||
paranr_syscall_r12base = high(word)-4;
|
||||
paranr_syscall_legacy = high(word)-3;
|
||||
|
||||
{ Required to support variations of syscalls on Amiga-likes }
|
||||
paranr_syscall_lib_first = 9; { for basesysv on MorphOS/ppc and AmigaOS4/ppc }
|
||||
paranr_syscall_lib_last = high(word)-3; { everything else }
|
||||
|
||||
paranr_result_leftright = high(word)-2;
|
||||
paranr_parentfp_delphi_cc = high(word)-1;
|
||||
|
||||
@ -338,13 +338,16 @@ type
|
||||
po_has_public_name,
|
||||
po_forward,
|
||||
po_global,
|
||||
{ The different kind of syscalls on MorphOS }
|
||||
{ The different kind of syscalls on AmigaOS and MorphOS, m68k and PPC }
|
||||
po_syscall_legacy,
|
||||
po_syscall_sysv,
|
||||
po_syscall_basesysv,
|
||||
po_syscall_sysvbase,
|
||||
po_syscall_r12base,
|
||||
{ Used to record the fact that a symbol is asociated to this syscall }
|
||||
{ The different kind of syscalls on AROS, i386/x86_64 }
|
||||
po_syscall_stackbase,
|
||||
po_syscall_eaxbase,
|
||||
{ Used to record the fact that a symbol is associated to this syscall }
|
||||
po_syscall_has_libsym,
|
||||
{ Procedure can be inlined }
|
||||
po_inline,
|
||||
|
||||
131
compiler/syscinfo.pas
Normal file
131
compiler/syscinfo.pas
Normal file
@ -0,0 +1,131 @@
|
||||
{
|
||||
Copyright (c) 2016 by Karoly Balogh
|
||||
|
||||
Contains information on syscalls
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit syscinfo;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
globtype, systems, tokens, symconst;
|
||||
|
||||
type
|
||||
tsyscallinfo = record
|
||||
token: ttoken;
|
||||
procoption: tprocoption;
|
||||
validon: set of tsystem;
|
||||
end;
|
||||
psyscallinfo = ^tsyscallinfo;
|
||||
|
||||
const
|
||||
syscall_conventions: array[1..7] of tsyscallinfo = (
|
||||
( token: _LEGACY; procoption: po_syscall_legacy; validon: [system_powerpc_morphos,system_m68k_amiga] ),
|
||||
( token: _SYSV; procoption: po_syscall_sysv; validon: [system_powerpc_morphos] ),
|
||||
( token: _SYSVBASE; procoption: po_syscall_sysvbase; validon: [system_powerpc_morphos] ),
|
||||
( token: _BASESYSV; procoption: po_syscall_basesysv; validon: [system_powerpc_morphos,system_powerpc_amiga] ),
|
||||
( token: _R12BASE; procoption: po_syscall_r12base; validon: [system_powerpc_morphos] ),
|
||||
( token: _STACKBASE; procoption: po_syscall_stackbase; validon: [system_i386_aros,system_x86_64_aros] ),
|
||||
( token: _EAXBASE; procoption: po_syscall_eaxbase; validon: [system_i386_aros,system_x86_64_aros] ));
|
||||
|
||||
|
||||
function get_syscall_by_token(const token: ttoken): psyscallinfo;
|
||||
function get_syscall_by_name(const name: string): psyscallinfo;
|
||||
function get_default_syscall: tprocoption;
|
||||
procedure set_default_syscall(sc: tprocoption);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
verbose;
|
||||
|
||||
const
|
||||
syscall_conventions_po = [ po_syscall_legacy, po_syscall_sysv, po_syscall_sysvbase, po_syscall_basesysv,
|
||||
po_syscall_r12base, po_syscall_stackbase, po_syscall_eaxbase ];
|
||||
|
||||
type
|
||||
tsyscalldefaultinfo = record
|
||||
system: tsystem;
|
||||
procoption: tprocoption;
|
||||
end;
|
||||
|
||||
const
|
||||
default_syscall_conventions: array[0..4] of tsyscalldefaultinfo = (
|
||||
( system: system_m68k_amiga; procoption: po_syscall_legacy ),
|
||||
( system: system_powerpc_amiga; procoption: po_syscall_basesysv ),
|
||||
( system: system_powerpc_morphos; procoption: po_syscall_legacy ),
|
||||
( system: system_i386_aros; procoption: po_syscall_stackbase ),
|
||||
( system: system_x86_64_aros; procoption: po_syscall_stackbase ));
|
||||
|
||||
var
|
||||
default_syscall_convention: tprocoption = po_none;
|
||||
|
||||
function get_syscall_by_token(const token: ttoken): psyscallinfo;
|
||||
var
|
||||
i: aint;
|
||||
begin
|
||||
result:=nil;
|
||||
for i:=low(syscall_conventions) to high(syscall_conventions) do
|
||||
if syscall_conventions[i].token = token then
|
||||
begin
|
||||
result:=@syscall_conventions[i];
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function get_syscall_by_name(const name: string): psyscallinfo;
|
||||
var
|
||||
i: aint;
|
||||
begin
|
||||
result:=nil;
|
||||
for i:=low(syscall_conventions) to high(syscall_conventions) do
|
||||
if arraytokeninfo[syscall_conventions[i].token].str = name then
|
||||
begin
|
||||
result:=@syscall_conventions[i];
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function get_default_syscall: tprocoption;
|
||||
var
|
||||
i: aint;
|
||||
begin
|
||||
if not (default_syscall_convention in syscall_conventions_po) then
|
||||
begin
|
||||
for i:=low(default_syscall_conventions) to high(default_syscall_conventions) do
|
||||
if default_syscall_conventions[i].system = target_info.system then
|
||||
default_syscall_convention:=default_syscall_conventions[i].procoption;
|
||||
if not (default_syscall_convention in syscall_conventions_po) then
|
||||
internalerror(2016090302);
|
||||
end;
|
||||
|
||||
result:=default_syscall_convention;
|
||||
end;
|
||||
|
||||
procedure set_default_syscall(sc: tprocoption);
|
||||
begin
|
||||
if not (sc in syscall_conventions_po) then
|
||||
internalerror(2016090301);
|
||||
|
||||
default_syscall_convention:=sc;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -192,6 +192,7 @@ type
|
||||
_CPPDECL,
|
||||
_DEFAULT,
|
||||
_DYNAMIC,
|
||||
_EAXBASE,
|
||||
_EXPORTS,
|
||||
_FINALLY,
|
||||
_FORWARD,
|
||||
@ -261,6 +262,7 @@ type
|
||||
_PUBLISHED,
|
||||
_REFERENCE,
|
||||
_SOFTFLOAT,
|
||||
_STACKBASE,
|
||||
_THREADVAR,
|
||||
_WRITEONLY,
|
||||
_BITWISEAND,
|
||||
@ -513,6 +515,7 @@ const
|
||||
(str:'CPPDECL' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'DEFAULT' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'DYNAMIC' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'EAXBASE' ;special:false;keyword:[m_none];op:NOTOKEN), { Syscall variation on AROS }
|
||||
(str:'EXPORTS' ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
|
||||
(str:'FINALLY' ;special:false;keyword:[m_except];op:NOTOKEN),
|
||||
(str:'FORWARD' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
@ -582,6 +585,7 @@ const
|
||||
(str:'PUBLISHED' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'REFERENCE' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'SOFTFLOAT' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'STACKBASE' ;special:false;keyword:[m_none];op:NOTOKEN), { Syscall variation on AROS }
|
||||
(str:'THREADVAR' ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
|
||||
(str:'WRITEONLY' ;special:false;keyword:[m_none];op:NOTOKEN),
|
||||
(str:'BITWISEAND' ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
|
||||
|
||||
@ -1935,6 +1935,8 @@ const
|
||||
(mask:po_syscall_basesysv;str:'SyscallBaseSysV'),
|
||||
(mask:po_syscall_sysvbase;str:'SyscallSysVBase'),
|
||||
(mask:po_syscall_r12base; str:'SyscallR12Base'),
|
||||
(mask:po_syscall_stackbase;str:'SyscallStackBase'),
|
||||
(mask:po_syscall_eaxbase; str:'SyscallEAXBase'),
|
||||
(mask:po_syscall_has_libsym; str:'Has LibSym'),
|
||||
(mask:po_inline; str:'Inline'),
|
||||
(mask:po_compilerproc; str:'CompilerProc'),
|
||||
|
||||
Loading…
Reference in New Issue
Block a user