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

llvm: support for opaque pointers

Browse Source 
Will be the default starting with LLVM 15, and required with LLVM 16.
Tested with LLVM 14 and '-mllvm -opaque-pointers'. See
https://releases.llvm.org/14.0.0/docs/OpaquePointers.html for more
information.
This commit is contained in:
Jonas Maebe 2022-06-12 11:24:38 +02:00
parent 71c58c7b3d
commit 25999ad8ff
7 changed files with 160 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compiler/llvm/agllvm.pas
View File

@ -360,7 +360,7 @@ implementation
if lcp_sret in para^.flags then if lcp_sret in para^.flags then
owner.writer.AsmWrite(llvmparatypeattr(' sret',para^.def,true)); owner.writer.AsmWrite(llvmparatypeattr(' sret',para^.def,true));
if asmblock and if asmblock and
(llvmflag_opaque_ptr_transition in llvmversion_properties[current_settings.llvmversion]) and (([llvmflag_opaque_ptr_transition,llvmflag_opaque_ptr]*llvmversion_properties[current_settings.llvmversion])<>[]) and
(para^.def.typ=pointerdef) then (para^.def.typ=pointerdef) then
owner.writer.AsmWrite(llvmparatypeattr(' elementtype',para^.def,true)); owner.writer.AsmWrite(llvmparatypeattr(' elementtype',para^.def,true));
{ For byval, this means "alignment on the stack" and of the passed source data. { For byval, this means "alignment on the stack" and of the passed source data.
@ -628,20 +628,7 @@ implementation
owner.writer.AsmWrite(' (') owner.writer.AsmWrite(' (')
else else
owner.writer.AsmWrite(' '); owner.writer.AsmWrite(' ');
{ can't just dereference the type, because it may be an tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0),op=la_getelementptr);
implicit pointer type such as a class -> resort to string
manipulation... Not very clean :( }
tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0));
if op=la_getelementptr then
begin
if tmpstr[length(tmpstr)]<>'*' then
begin
writeln(tmpstr);
internalerror(2016071101);
end
else
setlength(tmpstr,length(tmpstr)-1);
end;
owner.writer.AsmWrite(tmpstr); owner.writer.AsmWrite(tmpstr);
owner.writer.AsmWrite(','); owner.writer.AsmWrite(',');
end; end;
@ -672,15 +659,8 @@ implementation
owner.writer.AsmWrite(tmpstr); owner.writer.AsmWrite(tmpstr);
end; end;
opdone:=true; opdone:=true;
tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def); owner.writer.AsmWrite(' ');
if tmpstr[length(tmpstr)]<>'*' then owner.writer.AsmWrite(llvmencodetypename(taillvm(hp).oper[taillvm.callpdopernr]^.def,true));
begin
writeln(tmpstr);
internalerror(2016071102);
end
else
setlength(tmpstr,length(tmpstr)-1);
owner.writer.AsmWrite(tmpstr);
opstart:=4; opstart:=4;
end; end;
la_blockaddress: la_blockaddress:
@ -1401,11 +1381,19 @@ implementation
WriteFunctionFlags(tprocdef(taillvmdecl(hp).def)); WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
if assigned(tprocdef(taillvmdecl(hp).def).personality) then if assigned(tprocdef(taillvmdecl(hp).def).personality) then
begin begin
writer.AsmWrite(' personality i8* bitcast ('); if not(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar)); begin
writer.AsmWrite('* '); writer.AsmWrite(' personality i8* bitcast (');
writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname)); writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
writer.AsmWrite(' to i8*)'); writer.AsmWrite('* ');
writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
writer.AsmWrite(' to i8*)');
end
else
begin
writer.AsmWrite(' personality ptr ');
writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
end;
end; end;
InstrWriter.WriterInstructionMetadata(' ', taillvmdecl(hp).metadata); InstrWriter.WriterInstructionMetadata(' ', taillvmdecl(hp).metadata);
writer.AsmWriteln(' {'); writer.AsmWriteln(' {');

13
compiler/llvm/hlcgllvm.pas
View File

@ -1610,7 +1610,8 @@ implementation
hreg: tregister; hreg: tregister;
begin begin
{ will insert a bitcast if necessary } { will insert a bitcast if necessary }
if fromdef<>todef then if (fromdef<>todef) and
not(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
begin begin
hreg:=getregisterfordef(list,todef); hreg:=getregisterfordef(list,todef);
a_load_reg_reg(list,fromdef,todef,reg,hreg); a_load_reg_reg(list,fromdef,todef,reg,hreg);
@ -1623,6 +1624,16 @@ implementation
var var
hreg: tregister; hreg: tregister;
begin begin
{ the reason for the array exception is that we sometimes generate
getelementptr array_element_ty, arrayref, 0, 0
to get a pointer to the first element of the array. That expression is
not valid if arrayref does not point to an array. Clang does the same.
}
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
(((fromdef.typ=pointerdef) and (tpointerdef(fromdef).pointeddef.typ=arraydef)) <>
((todef.typ=pointerdef) and (tpointerdef(todef).pointeddef.typ=arraydef))
) then
exit;
hreg:=getaddressregister(list,todef); hreg:=getaddressregister(list,todef);
a_loadaddr_ref_reg_intern(list,fromdef,todef,ref,hreg,false); a_loadaddr_ref_reg_intern(list,fromdef,todef,ref,hreg,false);
reference_reset_base(ref,todef,hreg,0,ref.temppos,ref.alignment,ref.volatility); reference_reset_base(ref,todef,hreg,0,ref.temppos,ref.alignment,ref.volatility);

131
compiler/llvm/llvmdef.pas
View File

@ -57,7 +57,7 @@ interface
function llvmencodetypedecl(def: tdef): TSymStr; function llvmencodetypedecl(def: tdef): TSymStr;
{ same as above, but use a type name if possible (for any use) } { same as above, but use a type name if possible (for any use) }
function llvmencodetypename(def: tdef): TSymStr; function llvmencodetypename(def: tdef; pointedtype: boolean = false): TSymStr;
{ encode a procdef/procvardef into the internal format used by LLVM } { encode a procdef/procvardef into the internal format used by LLVM }
function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr; function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr;
@ -354,11 +354,34 @@ implementation
procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward; procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward;
type type
tllvmencodeflag = (lef_inaggregate, lef_noimplicitderef, lef_typedecl); tllvmencodeflag = (lef_inaggregate, lef_noimplicitderef, lef_typedecl, lef_removeouterpointer);
tllvmencodeflags = set of tllvmencodeflag; tllvmencodeflags = set of tllvmencodeflag;
procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr); procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr);
var
def_is_address: boolean;
begin begin
def_is_address:=false;
if ((lef_removeouterpointer in flags) or
(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion])) and
is_address(def) and
(def<>llvm_metadatatype) then
def_is_address:=true
else if lef_removeouterpointer in flags then
internalerror(2022060813);
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
not(lef_removeouterpointer in flags) and
def_is_address then
begin
if not(([lef_typedecl,lef_noimplicitderef]*flags<>[]) and
is_implicit_pointer_object_type(def)) and
not((def.typ=procdef) and
not(lef_typedecl in flags)) then
begin
encodedstr:=encodedstr+'ptr';
exit;
end;
end;
case def.typ of case def.typ of
stringdef : stringdef :
begin begin
@ -367,15 +390,23 @@ implementation
st_unicodestring: st_unicodestring:
{ the variable does not point to the header, but to a { the variable does not point to the header, but to a
null-terminated string/array with undefined bounds } null-terminated string/array with undefined bounds }
encodedstr:=encodedstr+'i16*'; if not(lef_removeouterpointer in flags) then
st_ansistring: encodedstr:=encodedstr+'i16*'
encodedstr:=encodedstr+'i8*';
st_shortstring:
{ length byte followed by string bytes }
if tstringdef(def).len>0 then
encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+' x i8]'
else else
encodedstr:=encodedstr+'[0 x i8]'; encodedstr:=encodedstr+'i16';
st_ansistring:
if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'i8*'
else
encodedstr:=encodedstr+'i8';
st_shortstring:
begin
{ length byte followed by string bytes }
if tstringdef(def).len>0 then
encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+' x i8]'
else
encodedstr:=encodedstr+'[0 x i8]';
end
else else
internalerror(2013100201); internalerror(2013100201);
end; end;
@ -402,11 +433,17 @@ implementation
pointerdef : pointerdef :
begin begin
if is_voidpointer(def) then if is_voidpointer(def) then
encodedstr:=encodedstr+'i8*' begin
if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'i8*'
else
encodedstr:=encodedstr+'i8';
end
else else
begin begin
llvmaddencodedtype_intern(tpointerdef(def).pointeddef,[],encodedstr); llvmaddencodedtype_intern(tpointerdef(def).pointeddef,[],encodedstr);
encodedstr:=encodedstr+'*'; if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'*';
end; end;
end; end;
floatdef : floatdef :
@ -478,13 +515,16 @@ implementation
begin begin
if is_class(tclassrefdef(def).pointeddef) then if is_class(tclassrefdef(def).pointeddef) then
begin begin
llvmaddencodedtype_intern(tobjectdef(tclassrefdef(def).pointeddef).vmt_def,flags,encodedstr); llvmaddencodedtype_intern(tobjectdef(tclassrefdef(def).pointeddef).vmt_def,flags-[lef_removeouterpointer],encodedstr);
encodedstr:=encodedstr+'*'; if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'*';
end end
else if is_objcclass(tclassrefdef(def).pointeddef) then else if is_objcclass(tclassrefdef(def).pointeddef) then
llvmaddencodedtype_intern(objc_idtype,flags,encodedstr) llvmaddencodedtype_intern(objc_idtype,flags-[lef_removeouterpointer],encodedstr)
else else if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'i8*' encodedstr:=encodedstr+'i8*'
else
encodedstr:=encodedstr+'i8'
end; end;
setdef : setdef :
begin begin
@ -525,7 +565,8 @@ implementation
else if is_dynamic_array(def) then else if is_dynamic_array(def) then
begin begin
llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr); llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr);
encodedstr:=encodedstr+'*'; if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'*';
end end
else if is_packed_array(def) and else if is_packed_array(def) and
(tarraydef(def).elementdef.typ in [enumdef,orddef]) then (tarraydef(def).elementdef.typ in [enumdef,orddef]) then
@ -553,8 +594,11 @@ implementation
tprocvardef(def).is_addressonly then tprocvardef(def).is_addressonly then
begin begin
llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr); llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
if def.typ=procvardef then if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'*'; begin
if def.typ=procvardef then
encodedstr:=encodedstr+'*'
end
end end
else if not(lef_typedecl in flags) then else if not(lef_typedecl in flags) then
begin begin
@ -562,7 +606,8 @@ implementation
via a pointer } via a pointer }
encodedstr:=encodedstr+llvmtypeidentifier(def); encodedstr:=encodedstr+llvmtypeidentifier(def);
{ blocks are implicit pointers } { blocks are implicit pointers }
if is_block(def) then if not(lef_removeouterpointer in flags) and
is_block(def) then
encodedstr:=encodedstr+'*' encodedstr:=encodedstr+'*'
end end
else if is_block(def) then else if is_block(def) then
@ -590,7 +635,7 @@ implementation
encodedstr:=encodedstr+llvmtypeidentifier(def) encodedstr:=encodedstr+llvmtypeidentifier(def)
else else
llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr); llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr);
if ([lef_typedecl,lef_noimplicitderef]*flags=[]) and if ([lef_typedecl,lef_noimplicitderef,lef_removeouterpointer]*flags=[]) and
is_implicit_pointer_object_type(def) then is_implicit_pointer_object_type(def) then
encodedstr:=encodedstr+'*' encodedstr:=encodedstr+'*'
end; end;
@ -599,16 +644,28 @@ implementation
odt_dispinterface: odt_dispinterface:
begin begin
{ type is a pointer to a pointer to the vmt } { type is a pointer to a pointer to the vmt }
llvmaddencodedtype_intern(tobjectdef(def).vmt_def,flags,encodedstr); if ([lef_typedecl,lef_noimplicitderef]*flags=[]) and
if ([lef_typedecl,lef_noimplicitderef]*flags=[]) then (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
encodedstr:=encodedstr+'**'; encodedstr:=encodedstr+'ptr'
else
begin
llvmaddencodedtype_intern(tobjectdef(def).vmt_def,flags,encodedstr);
if ([lef_typedecl,lef_noimplicitderef]*flags=[]) then
if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'**'
else
encodedstr:=encodedstr+'*'
end;
end; end;
odt_interfacecom_function, odt_interfacecom_function,
odt_interfacecom_property, odt_interfacecom_property,
odt_objcprotocol: odt_objcprotocol:
begin begin
{ opaque for now } { opaque for now }
encodedstr:=encodedstr+'i8*' if not(lef_removeouterpointer in flags) then
encodedstr:=encodedstr+'i8*'
else
encodedstr:=encodedstr+'i8'
end; end;
odt_helper: odt_helper:
llvmaddencodedtype_intern(tobjectdef(def).extendeddef,flags,encodedstr); llvmaddencodedtype_intern(tobjectdef(def).extendeddef,flags,encodedstr);
@ -630,10 +687,16 @@ implementation
end; end;
function llvmencodetypename(def: tdef): TSymStr; function llvmencodetypename(def: tdef; pointedtype: boolean = false): TSymStr;
var
flags: tllvmencodeflags;
begin begin
result:=''; result:='';
llvmaddencodedtype_intern(def,[],result); if not pointedtype then
flags:=[]
else
flags:=[lef_removeouterpointer];
llvmaddencodedtype_intern(def,flags,result);
end; end;
@ -747,7 +810,14 @@ implementation
{ implicit zero/sign extension for ABI compliance? } { implicit zero/sign extension for ABI compliance? }
if not first then if not first then
encodedstr:=encodedstr+', '; encodedstr:=encodedstr+', ';
llvmaddencodedtype_intern(usedef,[],encodedstr); if (hp.vardef=llvm_metadatatype) or
not((llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
((vo_is_funcret in hp.varoptions) or
paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) or
llvmbyvalparaloc(paraloc))) then
llvmaddencodedtype_intern(usedef,[],encodedstr)
else
encodedstr:=encodedstr+'ptr';
{ in case signextstr<>'', there should be only one paraloc -> no need { in case signextstr<>'', there should be only one paraloc -> no need
to clear (reason: it means that the paraloc is larger than the to clear (reason: it means that the paraloc is larger than the
original parameter) } original parameter) }
@ -756,7 +826,7 @@ implementation
{ sret: hidden pointer for structured function result } { sret: hidden pointer for structured function result }
if vo_is_funcret in hp.varoptions then if vo_is_funcret in hp.varoptions then
begin begin
{ "sret" is only valid for the firstparameter, while in FPC this { "sret" is only valid for the first parameter, while in FPC this
can sometimes be second one (self comes before). In general, can sometimes be second one (self comes before). In general,
this is not a problem: we can just leave out sret, which means this is not a problem: we can just leave out sret, which means
the result will be a bit less well optimised), but it is for the result will be a bit less well optimised), but it is for
@ -783,7 +853,8 @@ implementation
else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and
llvmbyvalparaloc(paraloc) then llvmbyvalparaloc(paraloc) then
begin begin
encodedstr:=encodedstr+'*'; if not (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
encodedstr:=encodedstr+'*';
if withattributes then if withattributes then
begin begin
encodedstr:=encodedstr+llvmparatypeattr(' byval',hp.vardef,false); encodedstr:=encodedstr+llvmparatypeattr(' byval',hp.vardef,false);

3
compiler/llvm/llvminfo.pas
View File

@ -66,7 +66,8 @@ type
llvmflag_NoDISPFlags, { no DI sub program flags, but separate fields } llvmflag_NoDISPFlags, { no DI sub program flags, but separate fields }
llvmflag_NoDISPFlagMainSubprogram, { MainSubprogram still in DIFlags instead of DISPFlags } llvmflag_NoDISPFlagMainSubprogram, { MainSubprogram still in DIFlags instead of DISPFlags }
llvmflag_para_attr_type, { parameter attributes such as noalias and byval need to repeat the type } llvmflag_para_attr_type, { parameter attributes such as noalias and byval need to repeat the type }
llvmflag_opaque_ptr_transition { initial opaque pointer introduction, needs to some elementtype attributes } llvmflag_opaque_ptr_transition, { initial opaque pointer introduction, needs to some elementtype attributes }
llvmflag_opaque_ptr { only opaque pointers }
); );
tllvmversionflags = set of tllvmversionflag; tllvmversionflags = set of tllvmversionflag;

12
compiler/llvm/llvmtype.pas
View File

@ -103,12 +103,12 @@ interface
implementation implementation
uses uses
sysutils,cutils,cfileutl,constexp, cutils,cfileutl,constexp,
version,globals,verbose,systems, version,globals,verbose,systems,
cpubase,cgbase,paramgr, cpubase,cgbase,paramgr,
fmodule,nobj, fmodule,nobj,
defutil,defcmp,symconst,symtable, defutil,defcmp,symconst,symtable,
llvmbase,llvmdef llvminfo,llvmbase,llvmdef
; ;
{**************************************************************************** {****************************************************************************
@ -136,6 +136,14 @@ implementation
begin begin
if def1=def2 then if def1=def2 then
exit(true); exit(true);
{ this function is only used to the pointees of pointer types, to know
whether the pointer types are equal. With opaque pointers, all
pointers are represented by "ptr" and hence by definition equal,
regardless of what they point to (there is one exception related to
arrays, but that is already handled during code generation in
thlcgllvm.g_ptrtypecast_ref) }
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
exit(true);
def1str:=llvmencodetypename(def1); def1str:=llvmencodetypename(def1);
def2str:=llvmencodetypename(def2); def2str:=llvmencodetypename(def2);
{ normalise both type representations in case one is a procdef { normalise both type representations in case one is a procdef

13
compiler/llvm/nllvmcnv.pas
View File

@ -77,6 +77,14 @@ uses
class function tllvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean; class function tllvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean;
begin begin
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
is_address(fromdef) and
is_address(todef) then
begin
result:=false;
exit;
end;
result:= result:=
(fromdef<>todef) and (fromdef<>todef) and
{ two procdefs that are structurally the same but semantically different { two procdefs that are structurally the same but semantically different
@ -302,7 +310,10 @@ procedure tllvmtypeconvnode.second_nothing;
begin begin
{ insert LLVM-level type conversions for same-sized entities that are { insert LLVM-level type conversions for same-sized entities that are
nevertheless different types } nevertheless different types }
if left.resultdef<>resultdef then if (left.resultdef<>resultdef) and
(not(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) or
not(is_address(left.resultdef) and
is_address(resultdef))) then
begin begin
{ handle sometype(voidptr^) and "absolute" } { handle sometype(voidptr^) and "absolute" }
if not is_void(left.resultdef) and if not is_void(left.resultdef) and

8
compiler/llvm/nllvmtcon.pas
View File

@ -129,10 +129,10 @@ interface
implementation implementation
uses uses
verbose,systems,fmodule, verbose,systems,fmodule,globals,
aasmdata, aasmdata,
procinfo, procinfo,
cpubase,cpuinfo,llvmbase, cpubase,cpuinfo,llvmbase,llvminfo,
symtable,llvmdef,defutil,defcmp, symtable,llvmdef,defutil,defcmp,
ngenutil; ngenutil;
@ -751,6 +751,10 @@ implementation
secondop: tllvmop; secondop: tllvmop;
begin begin
inherited; inherited;
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
is_address(fromdef) and
is_address(todef) then
exit;
{ special case: procdef -> procvardef/pointerdef: must take address of { special case: procdef -> procvardef/pointerdef: must take address of
the procdef } the procdef }
if (fromdef.typ=procdef) and if (fromdef.typ=procdef) and