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

* basic llvm metadata support

Browse Source 
git-svn-id: branches/debug_eh@41978 -
This commit is contained in:
Jonas Maebe 2019-05-02 19:45:26 +00:00
parent 3a1fb45315
commit 3fa6838815
8 changed files with 319 additions and 26 deletions

1
.gitattributes vendored
View File

@ -338,6 +338,7 @@ compiler/jvm/tgcpu.pas svneol=native#text/plain
compiler/ldscript.pas svneol=native#text/plain
compiler/link.pas svneol=native#text/plain
compiler/llvm/aasmllvm.pas svneol=native#text/plain
compiler/llvm/aasmllvmmetadata.pas svneol=native#text/plain
compiler/llvm/agllvm.pas svneol=native#text/plain
compiler/llvm/cgllvm.pas svneol=native#text/plain
compiler/llvm/hlcgllvm.pas svneol=native#text/plain

4
compiler/aasmcnst.pas
View File

@ -52,7 +52,7 @@ type
{ a simple data element; the value is stored as a tai }
tai_simpletypedconst = class(tai_abstracttypedconst)
private
private
procedure setval(AValue: tai);
protected
fval: tai;
@ -90,7 +90,7 @@ type
public
constructor create(_adetyp: ttypedconstkind; _fdef: tdef);
function getenumerator: tadeenumerator;
procedure addvalue(val: tai_abstracttypedconst);
procedure addvalue(val: tai_abstracttypedconst); virtual;
function valuecount: longint;
procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
procedure replacevalueatpos(val: tai_abstracttypedconst; pos: longint);

9
compiler/aasmtai.pas
View File

@ -87,6 +87,9 @@ interface
ait_llvmins, { llvm instruction }
ait_llvmalias, { alias for a symbol }
ait_llvmdecl, { llvm symbol declaration (global/external variable, external procdef) }
ait_llvmmetadatanode, (* llvm metadata node: !id = !{type value, ...} *)
ait_llvmmetadatareftypedconst, { reference to metadata inside a metadata constant }
ait_llvmmetadatarefoperand, { llvm metadata referece: !metadataname !id }
{$endif}
{ SEH directives used in ARM,MIPS and x86_64 COFF targets }
ait_seh_directive,
@ -222,6 +225,9 @@ interface
'llvmins',
'llvmalias',
'llvmdecl',
'llvmmetadata',
'llvmmetadatareftc',
'llvmmetadatarefop',
{$endif}
'cfi',
'seh_directive'
@ -323,6 +329,9 @@ interface
{$endif JVM}
{$ifdef llvm}
ait_llvmdecl,
ait_llvmmetadatanode,
ait_llvmmetadatareftypedconst,
ait_llvmmetadatarefoperand,
{$endif llvm}
ait_seh_directive,
ait_cfi

187
compiler/llvm/aasmllvmmetadata.pas Normal file
View File

@ -0,0 +1,187 @@
{
Copyright (c) 2019 by Jonas Maebe,
member of the Free Pascal Compiler development team
Support for LLVM metadata
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 aasmllvmmetadata;
{$i fpcdefs.inc}
interface
uses
aasmtai, aasmcnst,
symtype;
type
tspecialisedmetadatanodekind = (
smeta_DIFile,
smeta_DIBasicType,
smeta_DISubroutineType,
smeta_DIDerivedType,
smeta_DICompositeType,
smeta_DISubrange,
smeta_DIEnumerator,
smeta_DITemplateTypeParameter,
smeta_DITemplateValueParameter,
smeta_DINamespace,
smeta_DIGlobalVariable,
smeta_DISubprogram,
smeta_DILexicalBlock,
smeta_DILexicalBlockFile,
smeta_DILocation,
smeta_DILocalVariable,
smeta_DIExpression,
smeta_DIObjCProperty,
smeta_DIImportedEntity,
smeta_DIMacro,
smeta_DIMacroFile
);
tai_llvmbasemetadatanode = class abstract(tai_aggregatetypedconst)
strict protected
function getname: ansistring; virtual; abstract;
public
procedure addvalue(val: tai_abstracttypedconst); override;
property name: ansistring read getname;
constructor create; reintroduce;
end;
(* !0 = !{ type1 value1, ... } *)
tai_llvmunnamedmetadatanode = class(tai_llvmbasemetadatanode)
strict private class var
snextid: cardinal;
class function getnextid: cardinal;
strict protected
fnameval: cardinal;
public
constructor create; reintroduce;
function getname: ansistring; override;
end;
(* !name = !{ type1 value1, ... } *)
tai_llvmnamedmetadatanode = class(tai_llvmbasemetadatanode)
strict protected
fname: ansistring;
function getname: ansistring; override;
public
constructor create(const aName: ansistring);
end;
tai_llvmmetadatareftypedconst = class(tai_simple)
strict private
fval: tai_llvmbasemetadatanode;
public
constructor create(_val: tai_llvmbasemetadatanode);
property val: tai_llvmbasemetadatanode read fval;
end;
{ @g1 = global i32 0, *!id !value.name* }
tai_llvmmetadatareferenceoperand = class(tai_simple)
strict private
fid: ansistring;
fvalue: tai_llvmbasemetadatanode;
public
constructor create(const anID: ansistring; aValue: tai_llvmbasemetadatanode);
property id: ansistring read fid;
property value: tai_llvmbasemetadatanode read fvalue;
end;
{ !name = !kindname(field1: value1, ...) }
tai_llvmspecialisedmetadatanode = class(tai_llvmunnamedmetadatanode)
{ identifies name and fieldnames }
kind: tspecialisedmetadatanodekind;
end;
function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
implementation
uses
symdef;
function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
begin
result:=tai_simpletypedconst.create(llvm_metadatatype, tai_llvmmetadatareftypedconst.create(metadata));
end;
procedure tai_llvmbasemetadatanode.addvalue(val: tai_abstracttypedconst);
begin
{ bypass string merging attempts, as we add tai_strings directly here }
fvalues.add(val);
end;
constructor tai_llvmbasemetadatanode.create;
begin
inherited create(tck_array, llvm_metadatatype);
typ:=ait_llvmmetadatanode;
end;
class function tai_llvmunnamedmetadatanode.getnextid: cardinal;
begin
result:=snextid;
inc(snextid);
end;
function tai_llvmunnamedmetadatanode.getname: ansistring;
begin
str(fnameval,result);
end;
constructor tai_llvmunnamedmetadatanode.create;
begin
inherited;
fnameval:=getnextid;
end;
function tai_llvmnamedmetadatanode.getname: ansistring;
begin
result:=fname;
end;
constructor tai_llvmnamedmetadatanode.create(const aName: ansistring);
begin
inherited create;
fname:=aName;
end;
constructor tai_llvmmetadatareftypedconst.create(_val: tai_llvmbasemetadatanode);
begin
inherited create(ait_llvmmetadatareftypedconst);
fval:=_val;
end;
constructor tai_llvmmetadatareferenceoperand.create(const anID: ansistring; aValue: tai_llvmbasemetadatanode);
begin
inherited create(ait_llvmmetadatarefoperand);
fid:=anID;
fvalue:=aValue;
end;
end.

127
compiler/llvm/agllvm.pas
View File

@ -30,7 +30,7 @@ interface
globtype,globals,systems,
aasmbase,aasmtai,aasmdata,
assemble,
aasmllvm;
aasmllvm, aasmllvmmetadata;
type
TLLVMInstrWriter = class;
@ -61,7 +61,7 @@ interface
procedure WriteDirectiveName(dir: TAsmDirective); virtual;
procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
procedure WriteOrdConst(hp: tai_const);
procedure WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
procedure WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
public
constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
procedure WriteTree(p:TAsmList);override;
@ -376,7 +376,7 @@ implementation
hp:=para^.ai;
owner.writer.AsmWrite(fstr);
fstr:='';
owner.WriteTai(false,false,tmpinline,tmpasmblock,hp);
owner.WriteTai(false,false,para^.def=llvm_metadatatype,tmpinline,tmpasmblock,hp);
end;
{ empty records }
top_undef:
@ -436,7 +436,6 @@ implementation
function TLLVMInstrWriter.getopstr(const o:toper; refwithalign: boolean) : TSymStr;
var
hs : ansistring;
hp: tai;
tmpinline: cardinal;
tmpasmblock: boolean;
@ -499,7 +498,7 @@ implementation
hp:=o.ai;
owner.writer.AsmWrite(fstr);
fstr:='';
owner.WriteTai(false,false,tmpinline,tmpasmblock,hp);
owner.WriteTai(false,false,false,tmpinline,tmpasmblock,hp);
end;
result:='';
end;
@ -838,7 +837,7 @@ implementation
WriteSourceLine(hp as tailineinfo);
end;
WriteTai(replaceforbidden, do_line, InlineLevel, asmblock, hp);
WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
hp:=tai(hp.next);
end;
end;
@ -971,7 +970,7 @@ implementation
end;
procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
begin
@ -1021,20 +1020,34 @@ implementation
end;
procedure WriteTypedConstData(hp: tai_abstracttypedconst);
procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
var
p: tai_abstracttypedconst;
pval: tai;
defstr: TSymStr;
first, gotstring: boolean;
begin
defstr:=llvmencodetypename(hp.def);
if hp.def<>llvm_metadatatype then
begin
defstr:=llvmencodetypename(hp.def)
end
else
begin
defstr:=''
end;
{ write the struct, array or simple type }
case hp.adetyp of
tck_record:
begin
writer.AsmWrite(defstr);
writer.AsmWrite(' <{');
if not(metadata) then
begin
writer.AsmWrite(defstr);
writer.AsmWrite(' <{');
end
else
begin
writer.AsmWrite(' !{');
end;
first:=true;
for p in tai_aggregatetypedconst(hp) do
begin
@ -1042,19 +1055,29 @@ implementation
writer.AsmWrite(', ')
else
first:=false;
WriteTypedConstData(p);
WriteTypedConstData(p,metadata);
end;
if not(metadata) then
begin
writer.AsmWrite('}>');
end
else
begin
writer.AsmWrite('}');
end;
writer.AsmWrite('}>');
end;
tck_array:
begin
writer.AsmWrite(defstr);
if not(metadata) then
begin
writer.AsmWrite(defstr);
end;
first:=true;
gotstring:=false;
for p in tai_aggregatetypedconst(hp) do
begin
if not first then
writer.AsmWrite(',')
writer.AsmWrite(', ')
else
begin
writer.AsmWrite(' ');
@ -1065,33 +1088,65 @@ implementation
end
else
begin
writer.AsmWrite('[');
if not metadata then
begin
writer.AsmWrite('[');
end
else
begin
writer.AsmWrite('!{');
end;
end;
first:=false;
end;
{ cannot concat strings and other things }
if gotstring and
not metadata and
((tai_abstracttypedconst(p).adetyp<>tck_simple) or
(tai_simpletypedconst(p).val.typ<>ait_string)) then
internalerror(2014062701);
WriteTypedConstData(p);
WriteTypedConstData(p,metadata);
end;
if not gotstring then
writer.AsmWrite(']');
begin
if not metadata then
begin
writer.AsmWrite(']');
end
else
begin
writer.AsmWrite('}');
end;
end;
end;
tck_simple:
begin
pval:=tai_simpletypedconst(hp).val;
if pval.typ<>ait_string then
if (pval.typ<>ait_string) and
(defstr<>'') then
begin
writer.AsmWrite(defstr);
writer.AsmWrite(' ');
end;
WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,pval);
WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
end;
end;
end;
procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
begin
{ must only appear at the top level }
if fdecllevel<>0 then
internalerror(2019050111);
writer.AsmWrite('!');
writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
writer.AsmWrite(' =');
inc(fdecllevel);
WriteTypedConstData(hp,true);
writer.AsmLn;
dec(fdecllevel);
end;
var
hp2: tai;
s: string;
@ -1162,7 +1217,10 @@ implementation
begin
if fdecllevel=0 then
internalerror(2016120201);
writer.AsmWrite('c"');
if not inmetadata then
writer.AsmWrite('c"')
else
writer.AsmWrite('!"');
for i:=1 to tai_string(hp).len do
begin
ch:=tai_string(hp).str[i-1];
@ -1278,7 +1336,7 @@ implementation
hp2:=tai(taillvmdecl(hp).initdata.first);
while assigned(hp2) do
begin
WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,hp2);
WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
hp2:=tai(hp2.next);
end;
dec(fdecllevel);
@ -1328,6 +1386,28 @@ implementation
writer.AsmWrite('* ');
writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
end;
ait_llvmmetadatanode:
begin
WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
end;
ait_llvmmetadatareftypedconst:
begin
{ must only appear as an element in a typed const }
if fdecllevel=0 then
internalerror(2019050110);
writer.AsmWrite('!');
writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
end;
ait_llvmmetadatarefoperand:
begin
{ must only appear as an operand }
if fdecllevel=0 then
internalerror(2019050110);
writer.AsmWrite('!');
writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
writer.AsmWrite(' !');
writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
end;
ait_symbolpair:
begin
{ should be emitted as part of the symbol def }
@ -1411,7 +1491,7 @@ implementation
end;
ait_typedconst:
begin
WriteTypedConstData(tai_abstracttypedconst(hp));
WriteTypedConstData(tai_abstracttypedconst(hp),false);
end
else
internalerror(2019012010);
@ -1435,7 +1515,6 @@ implementation
procedure TLLVMAssember.WriteAsmList;
var
hal : tasmlisttype;
i: longint;
a: TExternalAssembler;
decorator: TLLVMModuleInlineAssemblyDecorator;
begin

3
compiler/llvm/llvmtype.pas
View File

@ -191,6 +191,9 @@ implementation
if def.stab_number<>0 then
exit;
def.stab_number:=1;
{ this is an internal llvm type }
if def=llvm_metadatatype then
exit;
if def.dbg_state=dbg_state_unused then
begin
def.dbg_state:=dbg_state_used;

8
compiler/psystem.pas
View File

@ -619,6 +619,11 @@ implementation
addfield(hrecst,cfieldvarsym.create('$parentfp',vs_value,parentfpvoidpointertype,[],true));
nestedprocpointertype:=crecorddef.create('',hrecst);
addtype('$nestedprocpointer',nestedprocpointertype);
{$ifdef llvm}
llvm_metadatatype:=cpointerdef.create(voidtype);
{ if this gets renamed, also adjust agllvm so it still writes the identifier of this type as "metadata" }
addtype('$metadata',llvm_metadatatype);
{$endif}
symtablestack.pop(systemunit);
end;
@ -734,6 +739,9 @@ implementation
end;
loadtype('methodpointer',methodpointertype);
loadtype('nestedprocpointer',nestedprocpointertype);
{$ifdef llvm}
loadtype('metadata',llvm_metadatatype);
{$endif}
loadtype('HRESULT',hresultdef);
loadtype('TTYPEKIND',typekindtype);
set_default_int_types;

6
compiler/symdef.pas
View File

@ -1150,6 +1150,12 @@ interface
objc_fastenumeration : tobjectdef;
objc_fastenumerationstate : trecorddef;
{$ifdef llvm}
{ llvm types }
{ a unique def to identify any kind of metadata }
llvm_metadatatype : tdef;
{$endif llvm}
{ Java base types }
{ java.lang.Object }
java_jlobject : tobjectdef;