+ support for LLVM metadata constant string parameters

   o they are implemented as a new metadata register class, whereby the
     subregister indicates the metadata type (currently always a string)
     and the superregister is an index in the metadata array (which
     contains the strings). LLVM metadata can only be passed as parameters
     to intrinsics in bitcode, so moves of metadata into other registers
     triggers internal errors and when moving them into parameters, we
     replace the parameter's register with the metadata register (and look
     up the corresponding string when writing out the bitcode)

git-svn-id: trunk@43816 -

compiler/aarch64/aasmcpu.pas

@@ -552,7 +552,7 @@ implementation
       const
         { invalid sizes for aarch64 are 0 }
         subreg2bytesize: array[TSubRegister] of byte =
-          (0,0,0,0,4,8,0,0,0,4,8,0,0,0,0,0,0,0,0,0,0,0,0,8,16);
+          (0,0,0,0,4,8,0,0,0,4,8,0,0,0,0,0,0,0,0,0,0,0,0,8,16,0);
       var
         scalefactor: byte;
       begin

compiler/cgbase.pas

@@ -211,7 +211,9 @@ interface
         R_SPECIALREGISTER, { = 5 }
         R_ADDRESSREGISTER, { = 6 }
         { used on llvm, every temp gets its own "base register" }
-        R_TEMPREGISTER     { = 7 }
+        R_TEMPREGISTER,    { = 7 }
+        { used on llvm for tracking metadata (every unique metadata has its own base register) }
+        R_METADATAREGISTER { = 8 }
       );
 
       { Sub registers }
@@ -242,8 +244,10 @@ interface
         R_SUBFLAGOVERFLOW,  { = 20; Overflow flag }
         R_SUBFLAGINTERRUPT, { = 21; Interrupt enable flag }
         R_SUBFLAGDIRECTION, { = 22; Direction flag }
-        R_SUBMM8B,  { = 23; for part of v regs on aarch64 }
-        R_SUBMM16B  { = 24; for part of v regs on aarch64 }
+        R_SUBMM8B,          { = 23; for part of v regs on aarch64 }
+        R_SUBMM16B,         { = 24; for part of v regs on aarch64 }
+        { subregisters for the metadata register (llvm) }
+        R_SUBMETASTRING     { = 25 }
       );
       TSubRegisterSet = set of TSubRegister;
 

compiler/fmodule.pas

@@ -153,6 +153,7 @@ interface
         llvmcompilerusedsyms : TFPObjectList; { a list of asmsymbols and their defs that need to be added to llvm.compiler.used (so they're not removed by llvm optimisation passes) }
         llvminitprocs,
         llvmfiniprocs : TFPList;
+        llvmmetadatastrings: TFPHashList; { metadata strings (mapping string -> superregister) }
 {$endif llvm}
         ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
@@ -605,6 +606,7 @@ implementation
         llvmcompilerusedsyms:=TFPObjectList.Create(true);
         llvminitprocs:=TFPList.Create;
         llvmfiniprocs:=TFPList.Create;
+        llvmmetadatastrings:=TFPHashList.Create;
 {$endif llvm}
         ansistrdef:=nil;
         wpoinfo:=nil;
@@ -738,6 +740,7 @@ implementation
         llvmcompilerusedsyms.free;
         llvminitprocs.free;
         llvmfiniprocs.free;
+        llvmmetadatastrings.free;
 {$endif llvm}
         ansistrdef:=nil;
         wpoinfo.free;
@@ -816,6 +819,8 @@ implementation
         llvminitprocs:=TFPList.Create;
         llvmfiniprocs.free;
         llvmfiniprocs:=TFPList.Create;
+        llvmmetadatastrings.free;
+        llvmmetadatastrings:=TFPHashList.Create;
 {$endif llvm}
         wpoinfo.free;
         wpoinfo:=nil;

compiler/llvm/aasmllvmmetadata.pas

@@ -27,7 +27,9 @@ unit aasmllvmmetadata;
 interface
 
   uses
-    aasmtai, aasmcnst,
+    globtype,cclasses,
+    cgbase,
+    aasmtai,aasmcnst,
     symtype;
 
   type
@@ -55,6 +57,10 @@ interface
       smeta_DIMacroFile
     );
 
+//   represented by a tai_simpletypedconst() with inside a metadata struct,
+//   or as a metadata register (for parameters)
+//    tai_llvmmetadatastring = class
+
     tai_llvmbasemetadatanode = class abstract(tai_aggregatetypedconst)
      strict protected
       function getname: ansistring; virtual; abstract;
@@ -67,10 +73,10 @@ interface
     (* !0 = !{ type1 value1, ... } *)
     tai_llvmunnamedmetadatanode = class(tai_llvmbasemetadatanode)
      strict private class var
-      snextid: cardinal;
-      class function getnextid: cardinal;
+      snextid: TSuperRegister;
+      class function getnextid: TSuperRegister;
      strict protected
-      fnameval: cardinal;
+      fnameval: TSuperRegister;
      public
       constructor create; reintroduce;
       function getname: ansistring; override;
@@ -104,17 +110,31 @@ interface
       property value: tai_llvmbasemetadatanode read fvalue;
     end;
 
-      { !name = !kindname(field1: value1, ...) }
+    { !name = !kindname(field1: value1, ...) }
     tai_llvmspecialisedmetadatanode = class(tai_llvmunnamedmetadatanode)
       { identifies name and fieldnames }
       kind: tspecialisedmetadatanodekind;
     end;
 
+    tllvmmetadata = class
+     strict private
+       class function addstring(const s: TSymstr): TSuperRegister;
+       class function regtostring(reg: TRegister): TSymStr;
+     public
+
+      class function getstringreg(const s: TSymstr): TRegister;
+      class function getpcharreg(p: pchar; len: longint): TRegister;
+      class function getregstring(reg: TRegister): TSymStr;
+    end;
+
     function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
 
+
 implementation
 
   uses
+    verbose,
+    fmodule,
     symdef;
 
   function llvm_getmetadatareftypedconst(metadata: tai_llvmbasemetadatanode): tai_simpletypedconst;
@@ -135,7 +155,7 @@ implementation
     end;
 
 
-  class function tai_llvmunnamedmetadatanode.getnextid: cardinal;
+  class function tai_llvmunnamedmetadatanode.getnextid: TSuperRegister;
     begin
       result:=snextid;
       inc(snextid);
@@ -183,5 +203,63 @@ implementation
     end;
 
 
+/////////////////////////////////////////////////
+
+  class function tllvmmetadata.addstring(const s: TSymStr): TSuperRegister;
+    var
+      index: longint;
+    begin
+      index:=current_module.llvmmetadatastrings.Add(s,nil);
+      if index>high(result) then
+        internalerror(2019122806);
+      result:=index;
+    end;
+
+
+  class function tllvmmetadata.regtostring(reg: TRegister): TSymStr;
+    begin
+      if getregtype(reg)<>R_METADATAREGISTER then
+        internalerror(2019122807);
+      if getsubreg(reg)<>R_SUBMETASTRING then
+        internalerror(2019122808);
+      result:=current_module.llvmmetadatastrings.NameOfIndex(getsupreg(reg));
+    end;
+
+
+  class function tllvmmetadata.getstringreg(const s: TSymstr): TRegister;
+    var
+      supreg: TSuperRegister;
+      index: longint;
+    begin
+      index:=current_module.llvmmetadatastrings.FindIndexOf(s);
+      if index<>-1 then
+        supreg:=index
+      else
+        supreg:=addstring(s);
+      result:=newreg(R_METADATAREGISTER,supreg,R_SUBMETASTRING);
+    end;
+
+
+  class function tllvmmetadata.getpcharreg(p: pchar; len: longint): TRegister;
+    var
+      str: TSymStr;
+    begin
+      if len>0 then
+        begin
+          setlength(str,len);
+          move(p[0],str[1],len);
+          result:=getstringreg(str);
+        end
+      else
+        result:=getstringreg('');
+    end;
+
+
+  class function tllvmmetadata.getregstring(reg: TRegister): TSymStr;
+    begin
+      result:=regtostring(reg);
+    end;
+
+
 end.
 

compiler/llvm/agllvm.pas

@@ -272,11 +272,16 @@ implementation
 
     function getregisterstring(reg: tregister): ansistring;
       begin
-        if getregtype(reg)=R_TEMPREGISTER then
-          result:='%tmp.'
+        if getregtype(reg)=R_METADATAREGISTER then
+          result:='!"'+tllvmmetadata.getregstring(reg)+'"'
         else
-          result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
-        result:=result+tostr(getsupreg(reg));
+          begin
+            if getregtype(reg)=R_TEMPREGISTER then
+              result:='%tmp.'
+            else
+              result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
+            result:=result+tostr(getsupreg(reg));
+          end;
       end;
 
 

compiler/llvm/hlcgllvm.pas

@@ -39,6 +39,7 @@ uses
     thlcgllvm = class(thlcgobj)
       constructor create;
 
+      procedure a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara); override;
       procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
       procedure a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara); override;
      protected
@@ -189,6 +190,18 @@ implementation
     end;
 
 
+  procedure thlcgllvm.a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara);
+    begin
+      if size<>llvm_metadatatype then
+        begin
+          inherited;
+          exit;
+        end;
+      { overwrite with the reference to the metadata (stored in the register's supreg) }
+      cgpara.location^.register:=r;
+    end;
+
+
   procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
     var
       tmpref, initialref, ref: treference;
@@ -610,6 +623,8 @@ implementation
     var
       fromsize: tdef;
     begin
+      if tosize=llvm_metadatatype then
+        internalerror(2019122804);
       if tosize.size<=ptrsinttype.size then
         fromsize:=ptrsinttype
       else
@@ -655,6 +670,9 @@ implementation
       hreg2: tregister;
       tmpsize: tdef;
     begin
+      if (fromsize=llvm_metadatatype) or
+         (tosize=llvm_metadatatype) then
+        internalerror(2019122802);
       sref:=make_simple_ref(list,ref,tosize);
       hreg:=register;
       (* typecast the pointer to the value instead of the value itself if
@@ -724,6 +742,9 @@ implementation
       tmpreg: tregister;
       tmpintdef: tdef;
     begin
+      if (fromsize=llvm_metadatatype) or
+         (tosize=llvm_metadatatype) then
+        internalerror(2019122801);
       op:=llvmconvop(fromsize,tosize,true);
       { converting from pointer to something else and vice versa is only
         possible via an intermediate pass to integer. Same for "something else"
@@ -858,6 +879,9 @@ implementation
       sref: treference;
       hreg: tregister;
     begin
+      if (fromsize=llvm_metadatatype) or
+         (tosize=llvm_metadatatype) then
+        internalerror(2019122803);
       sref:=make_simple_ref(list,ref,fromsize);
       { "named register"? }
       if sref.refaddr=addr_full then

compiler/llvm/llvmdef.pas

@@ -359,7 +359,9 @@ implementation
             end;
           pointerdef :
             begin
-              if is_voidpointer(def) then
+              if def=llvm_metadatatype then
+                encodedstr:=encodedstr+'metadata'
+              else if is_voidpointer(def) then
                 encodedstr:=encodedstr+'i8*'
               else
                 begin

compiler/llvm/llvmpara.pas

@@ -127,6 +127,12 @@ unit llvmpara;
               if not(paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER]) then
                 internalerror(2019011902);
               reducetosingleregparaloc(paraloc,hp.paraloc[side].def,paraloc^.register);
+            end
+          else if paraloc^.def=llvm_metadatatype then
+            begin
+              paraloc^.Loc:=LOC_REGISTER;
+              // will be overwritten with a "register" whose superregister is an index in the LLVM metadata table
+              paraloc^.register:=NR_INVALID;
             end;
         end;
     end;

compiler/llvm/nllvmcon.pas

@@ -37,6 +37,9 @@ interface
        end;
 
        tllvmstringconstnode = class(tcgstringconstnode)
+          constructor createpchar(s: pchar; l: longint; def: tdef); override;
+          function pass_typecheck: tnode; override;
+          function pass_1: tnode; override;
           procedure pass_generate_code; override;
        protected
           procedure load_dynstring(const strpointerdef: tdef; const elementdef: tdef; const winlikewidestring: boolean); override;
@@ -47,20 +50,63 @@ implementation
     uses
       globtype,globals,verbose,cutils,
       symbase,symtable,symconst,symdef,symsym,defutil,
-      aasmdata,aasmcnst,
+      aasmbase,aasmdata,aasmcnst,
       ncon,
-      llvmbase,aasmllvm,hlcgobj,
-      cgbase,cgutils;
+      llvmbase,aasmllvm,aasmllvmmetadata,hlcgobj,
+      cgbase,cgutils,
+      cpubase;
 
 {*****************************************************************************
                            tllvmstringconstnode
 *****************************************************************************}
 
+    constructor tllvmstringconstnode.createpchar(s: pchar; l: longint; def: tdef);
+      begin
+        inherited;
+        if def=llvm_metadatatype then
+          begin
+            { astringdef is only used if the constant type is ansitring }
+            cst_type:=cst_ansistring;
+            astringdef:=def;
+          end;
+      end;
+
+
+    function tllvmstringconstnode.pass_typecheck: tnode;
+      begin
+        if astringdef<>llvm_metadatatype then
+          begin
+            result:=inherited;
+            exit;
+          end;
+        resultdef:=llvm_metadatatype;
+        result:=nil;
+      end;
+
+
+    function tllvmstringconstnode.pass_1: tnode;
+      begin
+        if astringdef<>llvm_metadatatype then
+          begin
+            result:=inherited;
+            exit;
+          end;
+        expectloc:=LOC_CREGISTER;
+        result:=nil;
+      end;
+
+
     procedure tllvmstringconstnode.pass_generate_code;
       var
         datadef, resptrdef: tdef;
         hreg: tregister;
       begin
+        if astringdef=llvm_metadatatype then
+          begin
+            location_reset(location,LOC_CREGISTER,OS_ADDR);
+            location.register:=tllvmmetadata.getpcharreg(value_str,len);
+            exit;
+          end;
         inherited pass_generate_code;
         if cst_type in [cst_conststring,cst_shortstring] then
           begin

compiler/psystem.pas

@@ -543,6 +543,10 @@ implementation
         addtype('$qwordbool',bool64type);
 {$ifdef llvm}
         addtype('$llvmbool1',llvmbool1type);
+        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);
+        addtype('LLVMMetadata',llvm_metadatatype);
 {$endif llvm}
         addtype('$char_pointer',charpointertype);
         addtype('$widechar_pointer',widecharpointertype);
@@ -620,11 +624,6 @@ implementation
         addfield(hrecst,cfieldvarsym.create('$parentfp',vs_value,parentfpvoidpointertype,[]));
         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;
 
@@ -725,6 +724,7 @@ implementation
 {$endif x86}
 {$ifdef llvm}
         loadtype('llvmbool1',llvmbool1type);
+        loadtype('metadata',llvm_metadatatype);
 {$endif llvm}
         loadtype('file',cfiletype);
         if not(target_info.system in systems_managed_vm) then
@@ -740,9 +740,6 @@ 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/x86/aasmcpu.pas

@@ -2474,9 +2474,9 @@ implementation
           (0, 1, 2, 3, 6, 7, 5, 4);
         maxsupreg: array[tregistertype] of tsuperregister=
 {$ifdef x86_64}
-          (0, 16, 9, 8, 32, 32, 8, 0);
+          (0, 16, 9, 8, 32, 32, 8, 0, 0);
 {$else x86_64}
-          (0,  8, 9, 8,  8, 32, 8, 0);
+          (0,  8, 9, 8,  8, 32, 8, 0, 0);
 {$endif x86_64}
       var
         rs: tsuperregister;

compiler/x86/cpubase.pas

@@ -481,7 +481,7 @@ implementation
 
     function reg_cgsize(const reg: tregister): tcgsize;
       const subreg2cgsize:array[Tsubregister] of Tcgsize =
-            (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_F32,OS_F64,OS_NO,OS_M128,OS_M256,OS_M512,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO);
+            (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_F32,OS_F64,OS_NO,OS_M128,OS_M256,OS_M512,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO);
       begin
         case getregtype(reg) of
           R_INTREGISTER :
@@ -517,7 +517,7 @@ implementation
     function reg2opsize(r:Tregister):topsize;
       const
         subreg2opsize : array[tsubregister] of topsize =
-          (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
+          (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
       begin
         reg2opsize:=S_L;
         case getregtype(r) of