* basic llvm metadata support

git-svn-id: branches/debug_eh@41978 -

.gitattributes

@@ -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

compiler/aasmcnst.pas

@@ -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);

compiler/aasmtai.pas

@@ -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

compiler/llvm/aasmllvmmetadata.pas

@@ -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.
+

compiler/llvm/agllvm.pas

@@ -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);
+                if not(metadata) then
-                writer.AsmWrite(' <{');
+                  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

compiler/llvm/llvmtype.pas

@@ -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;

compiler/psystem.pas

@@ -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;

compiler/symdef.pas

@@ -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;