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

* add support for custom calling conventions to LLVM function declarations

Browse Source 
git-svn-id: branches/debug_eh@41211 -
This commit is contained in:
Jonas Maebe 2019-02-03 21:09:58 +00:00
parent 9d07e4948f
commit 8eb07ed7b1
6 changed files with 122 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/aasmtai.pas
View File

@ -265,6 +265,7 @@ interface
,top_cond
,top_para
,top_asmlist
,top_callingconvention
{$endif llvm}
{$if defined(riscv32) or defined(riscv64)}
,top_fenceflags
@ -470,6 +471,7 @@ interface
top_fpcond : (fpcond: tllvmfpcmp);
top_para : (paras: tfplist);
top_asmlist : (asmlist: tasmlist);
top_callingconvention: (callingconvention: tproccalloption);
{$endif llvm}
{$if defined(riscv32) or defined(riscv64)}
top_fenceflags : (fenceflags : TFenceFlags);

63
compiler/llvm/aasmllvm.pas
View File

@ -141,6 +141,7 @@ interface
procedure loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
procedure loadparas(opidx: longint; _paras: tfplist);
procedure loadasmlist(opidx: longint; _asmlist: tasmlist);
procedure loadcallingconvention(opidx: longint; calloption: tproccalloption);
procedure landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
@ -489,6 +490,18 @@ uses
end;
procedure taillvm.loadcallingconvention(opidx: longint; calloption: tproccalloption);
begin
allocate_oper(opidx+1);
with oper[opidx]^ do
begin
clearop(opidx);
callingconvention:=calloption;
typ:=top_callingconvention;
end;
end;
procedure taillvm.landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
var
lastclause,
@ -590,10 +603,10 @@ uses
begin
case opnr of
1: result:=oper[0]^.def;
3:
4:
begin
if oper[3]^.typ=top_reg then
result:=oper[2]^.def
if oper[4]^.typ=top_reg then
result:=oper[3]^.def
else
internalerror(2015112001)
end
@ -1117,7 +1130,7 @@ uses
constructor taillvm.call_size_name_paras(callpd: tdef; dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
begin
create_llvm(la_call);
ops:=5;
ops:=6;
{ we need this in case the call symbol is an alias for a symbol with a
different def in the same module (via "external"), because then we
have to insert a type conversion later from the alias def to the
@ -1125,49 +1138,53 @@ uses
is generated, because the alias declaration may occur anywhere }
loaddef(0,retsize);
loadreg(1,dst);
loaddef(2,callpd);
loadsymbol(3,name,0);
loadparas(4,paras);
loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
loaddef(3,callpd);
loadsymbol(4,name,0);
loadparas(5,paras);
end;
constructor taillvm.call_size_reg_paras(callpd: tdef; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist);
begin
create_llvm(la_call);
ops:=5;
ops:=6;
loaddef(0,retsize);
loadreg(1,dst);
loaddef(2,callpd);
loadreg(3,reg);
loadparas(4,paras);
loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
loaddef(3,callpd);
loadreg(4,reg);
loadparas(5,paras);
end;
constructor taillvm.invoke_size_name_paras_retlab_exceptlab(callpd: tdef; dst: tregister; retsize: tdef; name: tasmsymbol; paras: tfplist; retlab, exceptlab: TAsmLabel);
begin
create_llvm(la_invoke);
ops:=7;
ops:=8;
loaddef(0,retsize);
loadreg(1,dst);
loaddef(2,callpd);
loadsymbol(3,name,0);
loadparas(4,paras);
loadsymbol(5,retlab,0);
loadsymbol(6,exceptlab,0);
loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
loaddef(3,callpd);
loadsymbol(4,name,0);
loadparas(5,paras);
loadsymbol(6,retlab,0);
loadsymbol(7,exceptlab,0);
end;
constructor taillvm.invoke_size_reg_paras_retlab_exceptlab(callpd: tdef; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist; retlab, exceptlab: TAsmLabel);
begin
create_llvm(la_invoke);
ops:=7;
ops:=8;
loaddef(0,retsize);
loadreg(1,dst);
loaddef(2,callpd);
loadreg(3,reg);
loadparas(4,paras);
loadsymbol(5,retlab,0);
loadsymbol(6,exceptlab,0);
loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
loaddef(3,callpd);
loadreg(4,reg);
loadparas(5,paras);
loadsymbol(6,retlab,0);
loadsymbol(7,exceptlab,0);
end;

21
compiler/llvm/agllvm.pas
View File

@ -496,7 +496,9 @@ implementation
end;
{$endif cpuextended}
top_undef:
result:='undef'
result:='undef';
top_callingconvention:
result:=llvm_callingconvention_name(o.callingconvention);
else
internalerror(2013060227);
end;
@ -629,8 +631,15 @@ implementation
if llvmflag_call_no_ptr in llvmversion_properties[current_settings.llvmversion] then
begin
owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
if tmpstr<>'' then
begin
owner.writer.AsmWrite(' "');
owner.writer.AsmWrite(tmpstr);
owner.writer.AsmWrite('"');
end;
opdone:=true;
tmpstr:=llvmencodetypename(taillvm(hp).oper[2]^.def);
tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
if tmpstr[length(tmpstr)]<>'*' then
begin
writeln(tmpstr);
@ -639,7 +648,7 @@ implementation
else
setlength(tmpstr,length(tmpstr)-1);
owner.writer.AsmWrite(tmpstr);
opstart:=3;
opstart:=4;
end;
end;
la_blockaddress:
@ -733,8 +742,8 @@ implementation
{ special invoke interjections: "to label X unwind label Y" }
if (op=la_invoke) then
case i of
5: owner.writer.AsmWrite('to ');
6: owner.writer.AsmWrite('unwind ');
6: owner.writer.AsmWrite('to ');
7: owner.writer.AsmWrite('unwind ');
end;
owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
@ -1391,7 +1400,7 @@ implementation
WriteTypedConstData(tai_abstracttypedconst(hp));
end
else
internalerror(2006012201);
internalerror(2019012001);
end;
end;

52
compiler/llvm/llvmbase.pas
View File

@ -99,11 +99,13 @@ interface
llvmop2strtable=array[tllvmop] of string[14];
const
{ = max(cpubase.max_operands,7) }
max_operands = ((-ord(cpubase.max_operands<=7)) and 7) or ((-ord(cpubase.max_operands>7)) and cpubase.max_operands);
{ = max(cpubase.max_operands,8) }
max_operands = ((-ord(cpubase.max_operands<=8)) and 15) or ((-ord(cpubase.max_operands>8)) and cpubase.max_operands);
function llvm_target_name: ansistring;
function llvm_callingconvention_name(c: tproccalloption): ansistring;
implementation
uses
@ -199,4 +201,50 @@ implementation
{$endif}
end;
function llvm_callingconvention_name(c: tproccalloption): ansistring;
begin
// TODO (unsupported by LLVM at this time):
// * pocall_pascal
// * pocall_oldfpccall
// * pocall_syscall
// * pocall_far16
// * possibly pocall_softfloat
case c of
{ to prevent errors if none of the defines below is active }
pocall_none:
result:='';
{$ifdef i386}
pocall_register:
result:='x86_borlandregcallcc';
pocall_stdcall:
result:='x86_stdcallcc';
{$endif i386}
{$ifdef x86}
pocall_interrupt:
result:='x86_intrcc';
pocall_sysv_abi_default,
pocall_sysv_abi_cdecl:
result:='x86_64_sysvcc';
pocall_ms_abi_default,
pocall_ms_abi_cdecl:
result:='win64cc';
pocall_vectorcall:
result:='x86_vectorcallcc';
pocall_internproc:
result:=llvm_callingconvention_name(pocall_default);
{$endif x86}
{$ifdef avr}
pocall_interrupt:
result:='avr_intrcc';
{$endif avr}
{$if defined(arm) and not defined(FPC_ARMHF)}
pocall_hardfloat:
result:='arm_aapcs_vfpcc';
{$endif arm and not FPC_ARMHF}
else
result:='';
end;
end;
end.

7
compiler/llvm/llvmdef.pas
View File

@ -791,6 +791,7 @@ implementation
procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
var
callingconv: ansistring;
usedef: tdef;
paranr: longint;
hp: tparavarsym;
@ -798,6 +799,12 @@ implementation
useside: tcallercallee;
first: boolean;
begin
if not(pddecltype in [lpd_alias,lpd_procvar]) then
begin
callingconv:=llvm_callingconvention_name(def.proccalloption);
if callingconv<>'' then
encodedstr:=encodedstr+' "'+callingconv+'"';
end;
{ when writing a definition, we have to write the parameter names, and
those are only available on the callee side. In all other cases,
we are at the callerside }

16
compiler/llvm/llvmtype.pas
View File

@ -240,9 +240,9 @@ implementation
assigned(p.oper[opidx]^.ref^.symbol) and
(p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
begin
if (opidx=3) and
if (opidx=4) and
(p.llvmopcode in [la_call,la_invoke]) then
record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef,false)
record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef,false)
{ not a named register }
else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
@ -320,13 +320,13 @@ implementation
la_call,
la_invoke:
begin
if p.oper[3]^.typ=top_ref then
if p.oper[4]^.typ=top_ref then
begin
maybe_insert_extern_sym_decl(toplevellist,p.oper[3]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef);
symdef:=get_asmsym_def(p.oper[3]^.ref^.symbol);
maybe_insert_extern_sym_decl(toplevellist,p.oper[4]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef);
symdef:=get_asmsym_def(p.oper[4]^.ref^.symbol);
{ the type used in the call is different from the type used to
declare the symbol -> insert a typecast }
if not equal_llvm_defs(symdef,p.oper[2]^.def) then
if not equal_llvm_defs(symdef,p.oper[3]^.def) then
begin
if symdef.typ=procdef then
{ ugly, but can't use getcopyas(procvardef) due to the
@ -335,8 +335,8 @@ implementation
symtable) and "pointer to procedure" results in the
correct llvm type }
symdef:=cpointerdef.getreusable(tprocdef(symdef));
cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[2]^.def);
p.loadtai(3,cnv);
cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[4]^.ref^.symbol,p.oper[3]^.def);
p.loadtai(4,cnv);
end;
end;
for i:=0 to p.ops-1 do