agllvm: support for writing specialised metadata nodes

compiler/llvm/agllvm.pas

@@ -33,6 +33,14 @@ interface
       aasmllvm, aasmllvmmetadata;
 
     type
+      tmetadatakind = (
+        mk_none,
+        mk_normal,
+        mk_specialised,
+        mk_specialised_bool,
+        mk_specialised_enum
+      );
+
       TLLVMInstrWriter = class;
 
       TLLVMModuleInlineAssemblyDecorator = class(IExternalAssemblerOutputFileDecorator)
@@ -60,8 +68,8 @@ interface
         procedure WriteLlvmInstruction(hp: tai);
         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, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
+        procedure WriteOrdConst(hp: tai_const; inmetadatakind: tmetadatakind);
+        procedure WriteTai(const replaceforbidden: boolean; const do_line: boolean; inmetadatakind: tmetadatakind; 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;
@@ -93,6 +101,7 @@ interface
       TLLVMInstrWriter = class
         constructor create(_owner: TLLVMAssember);
         procedure WriteInstruction(hp : tai);
+        procedure WriterInstructionMetadata(sep: TSymStr; metatai: tai);
        protected
         owner: TLLVMAssember;
 
@@ -322,11 +331,12 @@ implementation
 
    procedure TLLVMInstrWriter.writeparas(const paras: tfplist);
      var
+       hp: tai;
+       para: pllvmcallpara;
        i: longint;
        tmpinline: cardinal;
-       para: pllvmcallpara;
+       metadatakind: tmetadatakind;
        tmpasmblock: boolean;
-       hp: tai;
      begin
        tmpinline:=1;
        tmpasmblock:=false;
@@ -372,7 +382,11 @@ implementation
                  tmpinline:=1;
                  tmpasmblock:=false;
                  hp:=para^.ai;
-                 owner.WriteTai(false,false,para^.def=llvm_metadatatype,tmpinline,tmpasmblock,hp);
+                 if para^.def<>llvm_metadatatype then
+                   metadatakind:=mk_none
+                 else
+                   metadatakind:=mk_normal;
+                 owner.WriteTai(false,false,metadatakind,tmpinline,tmpasmblock,hp);
                end;
              { empty records }
              top_undef:
@@ -513,7 +527,7 @@ implementation
      begin
        tmpinline:=1;
        tmpasmblock:=false;
-       owner.WriteTai(false,false,false,tmpinline,tmpasmblock,ai);
+       owner.WriteTai(false,false,mk_none,tmpinline,tmpasmblock,ai);
      end;
 
 
@@ -538,7 +552,6 @@ implementation
 
   procedure TLLVMInstrWriter.WriteInstruction(hp: tai);
     var
-      metatai: tai;
       op: tllvmop;
       tmpstr,
       sep: TSymStr;
@@ -763,7 +776,15 @@ implementation
         end;
       if op=la_alloca then
         owner.writer.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
-      metatai:=taillvm(hp).metadata;
+      WriterInstructionMetadata(', ',taillvm(hp).metadata);
+      if nested then
+        owner.writer.AsmWrite(')')
+      else if owner.fdecllevel=0 then
+        owner.writer.AsmLn;
+    end;
+
+  procedure TLLVMInstrWriter.WriterInstructionMetadata(sep: TSymStr; metatai: tai);
+    begin
       while assigned(metatai) do
         begin
           owner.writer.AsmWrite(sep);
@@ -771,10 +792,6 @@ implementation
           writetaioper(metatai);
           metatai:=tai(metatai.next);
         end;
-      if nested then
-        owner.writer.AsmWrite(')')
-      else if owner.fdecllevel=0 then
-        owner.writer.AsmLn;
     end;
 
 
@@ -840,7 +857,7 @@ implementation
               WriteSourceLine(hp as tailineinfo);
           end;
 
-         WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
+         WriteTai(replaceforbidden,do_line,mk_none,InlineLevel,asmblock,hp);
          hp:=tai(hp.next);
        end;
     end;
@@ -913,7 +930,7 @@ implementation
       end;
 
 
-    procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
+    procedure TLLVMAssember.WriteOrdConst(hp: tai_const; inmetadatakind: tmetadatakind);
       var
         consttyp: taiconst_type;
       begin
@@ -957,7 +974,15 @@ implementation
                     else
                       writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
                 end
-              else if hp.value=0 then
+              else if inmetadatakind=mk_specialised_bool then
+                begin
+                  if hp.value=0 then
+                    writer.AsmWrite('false')
+                  else
+                    writer.AsmWrite('true')
+                end
+              else if (hp.value=0) and
+                      (inmetadatakind=mk_none) then
                 writer.AsmWrite('zeroinitializer')
               else
                 writer.AsmWrite(tostr(hp.value));
@@ -973,7 +998,7 @@ implementation
       end;
 
 
-    procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
+    procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; inmetadatakind: tmetadatakind; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
 
       procedure WriteLinkageVibilityFlags(bind: TAsmSymBind; is_definition: boolean);
         begin
@@ -1034,15 +1059,14 @@ implementation
             writer.AsmWrite(' strictfp');
         end;
 
-
-      procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
+      procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadatakind: tmetadatakind);
         var
           p: tai_abstracttypedconst;
           pval: tai;
           defstr: TSymStr;
-          first, gotstring: boolean;
+          first, gotstring, isspecialised: boolean;
         begin
-          if hp.def<>llvm_metadatatype then
+          if (hp.def<>llvm_metadatatype) and (metadatakind<mk_specialised) then
             begin
               defstr:=llvmencodetypename(hp.def)
             end
@@ -1054,7 +1078,7 @@ implementation
           case hp.adetyp of
             tck_record:
               begin
-                if not(metadata) then
+                if metadatakind=mk_none then
                   begin
                     writer.AsmWrite(defstr);
                     if not(df_llvm_no_struct_packing in hp.def.defoptions) then
@@ -1073,9 +1097,9 @@ implementation
                       writer.AsmWrite(', ')
                     else
                       first:=false;
-                    WriteTypedConstData(p,metadata);
+                    WriteTypedConstData(p,metadatakind);
                   end;
-                if not(metadata) then
+                if metadatakind=mk_none then
                   begin
                     if not(df_llvm_no_struct_packing in hp.def.defoptions) then
                       writer.AsmWrite(' }>')
@@ -1089,7 +1113,7 @@ implementation
               end;
             tck_array:
               begin
-                if not(metadata) then
+                if metadatakind=mk_none then
                   begin
                     writer.AsmWrite(defstr);
                   end;
@@ -1103,13 +1127,14 @@ implementation
                       begin
                         writer.AsmWrite(' ');
                         if (tai_abstracttypedconst(p).adetyp=tck_simple) and
+                           assigned(tai_simpletypedconst(p).val) and
                            (tai_simpletypedconst(p).val.typ=ait_string) then
                           begin
                             gotstring:=true;
                           end
                         else
                           begin
-                            if not metadata then
+                            if metadatakind=mk_none then
                               begin
                                 writer.AsmWrite('[');
                               end
@@ -1122,15 +1147,26 @@ implementation
                       end;
                     { cannot concat strings and other things }
                     if gotstring and
-                       not metadata and
+                       (metadatakind=mk_none) and
                        ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
                         (tai_simpletypedconst(p).val.typ<>ait_string)) then
                       internalerror(2014062701);
-                    WriteTypedConstData(p,metadata);
+                    WriteTypedConstData(p,metadatakind);
                   end;
                 if not gotstring then
                   begin
-                    if not metadata then
+                    if first then
+                      begin
+                        if metadatakind=mk_none then
+                          begin
+                            writer.AsmWrite(' [');
+                          end
+                        else
+                          begin
+                            writer.AsmWrite(' !{');
+                          end;
+                      end;
+                    if metadatakind=mk_none then
                       begin
                         writer.AsmWrite(']');
                       end
@@ -1143,17 +1179,103 @@ implementation
             tck_simple:
               begin
                 pval:=tai_simpletypedconst(hp).val;
+                if not assigned(pval) then
+                  begin
+                    if metadatakind>=mk_normal then
+                      writer.asmWrite('null')
+                    else
+                      internalerror(2022041301);
+                    exit;
+                  end;
                 if (pval.typ<>ait_string) and
                    (defstr<>'') then
                   begin
                     writer.AsmWrite(defstr);
                     writer.AsmWrite(' ');
                   end;
-                WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
+                WriteTai(replaceforbidden,do_line,metadatakind,InlineLevel,asmblock,pval);
               end;
           end;
         end;
 
+      procedure WriteString(hp: tai_string);
+        var
+          i: longint;
+          s: string;
+          ch: ansichar;
+          endQuotes: boolean;
+        begin
+          if fdecllevel=0 then
+            internalerror(2016120201);
+          endQuotes:=true;
+          case inmetadatakind of
+            mk_none:
+              writer.AsmWrite('c"');
+            mk_normal:
+              writer.AsmWrite('!"');
+            mk_specialised:
+              writer.AsmWrite('"');
+            mk_specialised_bool:
+              internalerror(2022041201);
+            mk_specialised_enum:
+              endQuotes:=false;
+          end;
+          for i:=1 to tai_string(hp).len do
+           begin
+             ch:=tai_string(hp).str[i-1];
+             case ch of
+                       #0, {This can't be done by range, because a bug in FPC}
+                  #1..#31,
+               #128..#255,
+                      '"',
+                      '\' : s:='\'+hexStr(ord(ch),2);
+             else
+               s:=ch;
+             end;
+             writer.AsmWrite(s);
+           end;
+          if endQuotes then
+            writer.AsmWrite('"');
+        end;
+
+      procedure WriteSpecialisedMetadataNode(hp: tai_llvmspecialisedmetadatanode);
+        var
+          element: tai_abstracttypedconst;
+          specialised_element: tllvmspecialisedmetaitem;
+          s: shortstring;
+          metadatakind: tmetadatakind;
+          first: boolean;
+        begin
+          if hp.IsDistinct then
+            writer.AsmWrite(' distinct !')
+          else
+            writer.AsmWrite(' !');
+          str(hp.kind,s);
+          writer.AsmWrite(s);
+          writer.AsmWrite('(');
+          first:=true;
+          for element in hp do
+            begin
+              if not first then
+                writer.AsmWrite(', ')
+              else
+                first:=false;
+              specialised_element:=tllvmspecialisedmetaitem(element);
+              writer.AsmWrite(specialised_element.itemname);
+              writer.AsmWrite(': ');
+              case specialised_element.itemkind of
+                lsmik_boolean:
+                  metadatakind:=mk_specialised_bool;
+                lsmik_enum:
+                  metadatakind:=mk_specialised_enum;
+                else
+                  metadatakind:=mk_specialised;
+              end;
+              WriteTypedConstData(specialised_element,metadatakind);
+            end;
+            writer.AsmWrite(')');
+        end;
+
       procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
         begin
           { must only appear at the top level }
@@ -1163,17 +1285,18 @@ implementation
           writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
           writer.AsmWrite(' =');
           inc(fdecllevel);
-          WriteTypedConstData(hp,true);
+          if hp.isspecialised then
+            WriteSpecialisedMetadataNode(tai_llvmspecialisedmetadatanode(hp))
+          else
+            WriteTypedConstData(hp,mk_normal);
           writer.AsmLn;
           dec(fdecllevel);
         end;
 
       var
         hp2: tai;
-        s: string;
         sstr: TSymStr;
         i: longint;
-        ch: ansichar;
       begin
         case hp.typ of
           ait_align,
@@ -1192,7 +1315,7 @@ implementation
 
           ait_const:
             begin
-              WriteOrdConst(tai_const(hp));
+              WriteOrdConst(tai_const(hp),inmetadatakind);
             end;
 
           ait_realconst :
@@ -1202,27 +1325,7 @@ implementation
 
           ait_string :
             begin
-              if fdecllevel=0 then
-                internalerror(2016120201);
-              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];
-                 case ch of
-                           #0, {This can't be done by range, because a bug in FPC}
-                      #1..#31,
-                   #128..#255,
-                          '"',
-                          '\' : s:='\'+hexStr(ord(ch),2);
-                 else
-                   s:=ch;
-                 end;
-                 writer.AsmWrite(s);
-               end;
-              writer.AsmWrite('"');
+              WriteString(tai_string(hp));
             end;
 
           ait_label :
@@ -1285,6 +1388,7 @@ implementation
                           writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
                           writer.AsmWrite(' to i8*)');
                         end;
+                      InstrWriter.WriterInstructionMetadata(' ', taillvmdecl(hp).metadata);
                       writer.AsmWriteln(' {');
                     end;
                 end
@@ -1323,7 +1427,7 @@ implementation
                       hp2:=tai(taillvmdecl(hp).initdata.first);
                       while assigned(hp2) do
                         begin
-                          WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
+                          WriteTai(replaceforbidden,do_line,inmetadatakind,InlineLevel,asmblock,hp2);
                           hp2:=tai(hp2.next);
                         end;
                       dec(fdecllevel);
@@ -1351,10 +1455,10 @@ implementation
                     begin
                       { alignment }
                       writer.AsmWrite(', align ');
-                      writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
-                    end
-                  else
-                    writer.AsmLn;
+                      writer.AsmWrite(tostr(taillvmdecl(hp).alignment));
+                    end;
+                  InstrWriter.WriterInstructionMetadata(' ',taillvmdecl(hp).metadata);
+                  writer.AsmLn;
                 end;
             end;
           ait_llvmalias:
@@ -1386,13 +1490,13 @@ implementation
             end;
           ait_llvmmetadatarefoperand:
             begin
-              { must only appear as an operand }
-              if fdecllevel=0 then
-                internalerror(2019050101);
+              inc(fdecllevel);
               writer.AsmWrite('!');
               writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
-              writer.AsmWrite(' !');
-              writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
+              writer.AsmWrite(' ');
+              hp2:=tai_llvmmetadatareferenceoperand(hp).value;
+              WriteTai(replaceforbidden,do_line,mk_normal,inlinelevel,asmblock,hp2);
+              dec(fdecllevel);
             end;
           ait_symbolpair:
             begin
@@ -1467,7 +1571,7 @@ implementation
             end;
           ait_typedconst:
             begin
-              WriteTypedConstData(tai_abstracttypedconst(hp),false);
+              WriteTypedConstData(tai_abstracttypedconst(hp),inmetadatakind);
             end
           else
             if not WriteComments(hp) then