* add support for custom calling conventions to LLVM function declarations

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

compiler/aasmtai.pas

@@ -265,6 +265,7 @@ interface
        ,top_cond
        ,top_para
        ,top_asmlist
+       ,top_callingconvention
 {$endif llvm}
 {$if defined(riscv32) or defined(riscv64)}
        ,top_fenceflags
@@ -470,6 +471,7 @@ interface
             top_fpcond : (fpcond: tllvmfpcmp);
             top_para   : (paras: tfplist);
             top_asmlist : (asmlist: tasmlist);
+            top_callingconvention: (callingconvention: tproccalloption);
         {$endif llvm}
         {$if defined(riscv32) or defined(riscv64)}
             top_fenceflags : (fenceflags : TFenceFlags);

compiler/llvm/aasmllvm.pas

@@ -141,6 +141,7 @@ interface
         procedure loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
         procedure loadparas(opidx: longint; _paras: tfplist);
         procedure loadasmlist(opidx: longint; _asmlist: tasmlist);
+        procedure loadcallingconvention(opidx: longint; calloption: tproccalloption);
 
         procedure landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
 
@@ -489,6 +490,18 @@ uses
       end;
 
 
+    procedure taillvm.loadcallingconvention(opidx: longint; calloption: tproccalloption);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           clearop(opidx);
+           callingconvention:=calloption;
+           typ:=top_callingconvention;
+         end;
+      end;
+
+
     procedure taillvm.landingpad_add_clause(op: tllvmop; def: tdef; kind: TAsmSymbol);
       var
         lastclause,
@@ -590,10 +603,10 @@ uses
             begin
               case opnr of
                 1: result:=oper[0]^.def;
-                3:
+                4:
                   begin
-                    if oper[3]^.typ=top_reg then
+                    if oper[4]^.typ=top_reg then
-                      result:=oper[2]^.def
+                      result:=oper[3]^.def
                     else
                       internalerror(2015112001)
                   end
@@ -1117,7 +1130,7 @@ uses
     constructor taillvm.call_size_name_paras(callpd: tdef; dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
       begin
         create_llvm(la_call);
-        ops:=5;
+        ops:=6;
         { we need this in case the call symbol is an alias for a symbol with a
           different def in the same module (via "external"), because then we
           have to insert a type conversion later from the alias def to the
@@ -1125,49 +1138,53 @@ uses
           is generated, because the alias declaration may occur anywhere }
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
+        loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
-        loadsymbol(3,name,0);
+        loaddef(3,callpd);
-        loadparas(4,paras);
+        loadsymbol(4,name,0);
+        loadparas(5,paras);
       end;
 
 
     constructor taillvm.call_size_reg_paras(callpd: tdef; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist);
       begin
         create_llvm(la_call);
-        ops:=5;
+        ops:=6;
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
+        loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
-        loadreg(3,reg);
+        loaddef(3,callpd);
-        loadparas(4,paras);
+        loadreg(4,reg);
+        loadparas(5,paras);
       end;
 
 
     constructor taillvm.invoke_size_name_paras_retlab_exceptlab(callpd: tdef; dst: tregister; retsize: tdef; name: tasmsymbol; paras: tfplist; retlab, exceptlab: TAsmLabel);
       begin
         create_llvm(la_invoke);
-        ops:=7;
+        ops:=8;
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
+        loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
-        loadsymbol(3,name,0);
+        loaddef(3,callpd);
-        loadparas(4,paras);
+        loadsymbol(4,name,0);
-        loadsymbol(5,retlab,0);
+        loadparas(5,paras);
-        loadsymbol(6,exceptlab,0);
+        loadsymbol(6,retlab,0);
+        loadsymbol(7,exceptlab,0);
       end;
 
 
     constructor taillvm.invoke_size_reg_paras_retlab_exceptlab(callpd: tdef; dst: tregister; retsize: tdef; reg: tregister; paras: tfplist; retlab, exceptlab: TAsmLabel);
       begin
         create_llvm(la_invoke);
-        ops:=7;
+        ops:=8;
         loaddef(0,retsize);
         loadreg(1,dst);
-        loaddef(2,callpd);
+        loadcallingconvention(2,tabstractprocdef(callpd).proccalloption);
-        loadreg(3,reg);
+        loaddef(3,callpd);
-        loadparas(4,paras);
+        loadreg(4,reg);
-        loadsymbol(5,retlab,0);
+        loadparas(5,paras);
-        loadsymbol(6,exceptlab,0);
+        loadsymbol(6,retlab,0);
+        loadsymbol(7,exceptlab,0);
       end;
 
 

compiler/llvm/agllvm.pas

@@ -496,7 +496,9 @@ implementation
            end;
 {$endif cpuextended}
          top_undef:
-           result:='undef'
+           result:='undef';
+         top_callingconvention:
+           result:=llvm_callingconvention_name(o.callingconvention);
          else
            internalerror(2013060227);
        end;
@@ -629,8 +631,15 @@ implementation
             if llvmflag_call_no_ptr in llvmversion_properties[current_settings.llvmversion] then
               begin
                 owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
+                tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
+                if tmpstr<>'' then
+                  begin
+                    owner.writer.AsmWrite(' "');
+                    owner.writer.AsmWrite(tmpstr);
+                    owner.writer.AsmWrite('"');
+                  end;
                 opdone:=true;
-                tmpstr:=llvmencodetypename(taillvm(hp).oper[2]^.def);
+                tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
                 if tmpstr[length(tmpstr)]<>'*' then
                   begin
                     writeln(tmpstr);
@@ -639,7 +648,7 @@ implementation
                 else
                   setlength(tmpstr,length(tmpstr)-1);
                 owner.writer.AsmWrite(tmpstr);
-                opstart:=3;
+                opstart:=4;
               end;
           end;
         la_blockaddress:
@@ -733,8 +742,8 @@ implementation
                    { special invoke interjections: "to label X unwind label Y" }
                    if (op=la_invoke) then
                      case i of
-                       5: owner.writer.AsmWrite('to ');
+                       6: owner.writer.AsmWrite('to ');
-                       6: owner.writer.AsmWrite('unwind ');
+                       7: owner.writer.AsmWrite('unwind ');
                      end;
 
                    owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
@@ -1391,7 +1400,7 @@ implementation
                WriteTypedConstData(tai_abstracttypedconst(hp));
              end
           else
-            internalerror(2006012201);
+            internalerror(2019012001);
         end;
       end;
 

compiler/llvm/llvmbase.pas

@@ -99,11 +99,13 @@ interface
     llvmop2strtable=array[tllvmop] of string[14];
 
   const
-    { = max(cpubase.max_operands,7) }
+    { = max(cpubase.max_operands,8) }
-    max_operands = ((-ord(cpubase.max_operands<=7)) and 7) or ((-ord(cpubase.max_operands>7)) and cpubase.max_operands);
+    max_operands = ((-ord(cpubase.max_operands<=8)) and 15) or ((-ord(cpubase.max_operands>8)) and cpubase.max_operands);
 
   function llvm_target_name: ansistring;
 
+  function llvm_callingconvention_name(c: tproccalloption): ansistring;
+
 implementation
 
   uses
@@ -199,4 +201,50 @@ implementation
 {$endif}
     end;
 
+
+  function llvm_callingconvention_name(c: tproccalloption): ansistring;
+    begin
+      // TODO (unsupported by LLVM at this time):
+      //   * pocall_pascal
+      //   * pocall_oldfpccall
+      //   * pocall_syscall
+      //   * pocall_far16
+      //   * possibly pocall_softfloat
+      case c of
+        { to prevent errors if none of the defines below is active }
+        pocall_none:
+          result:='';
+{$ifdef i386}
+        pocall_register:
+          result:='x86_borlandregcallcc';
+        pocall_stdcall:
+          result:='x86_stdcallcc';
+{$endif i386}
+{$ifdef x86}
+        pocall_interrupt:
+          result:='x86_intrcc';
+        pocall_sysv_abi_default,
+        pocall_sysv_abi_cdecl:
+          result:='x86_64_sysvcc';
+        pocall_ms_abi_default,
+        pocall_ms_abi_cdecl:
+          result:='win64cc';
+        pocall_vectorcall:
+          result:='x86_vectorcallcc';
+        pocall_internproc:
+          result:=llvm_callingconvention_name(pocall_default);
+{$endif x86}
+{$ifdef avr}
+        pocall_interrupt:
+          result:='avr_intrcc';
+{$endif avr}
+{$if defined(arm) and not defined(FPC_ARMHF)}
+        pocall_hardfloat:
+          result:='arm_aapcs_vfpcc';
+{$endif arm and not FPC_ARMHF}
+        else
+          result:='';
+      end;
+    end;
+
 end.

compiler/llvm/llvmdef.pas

@@ -791,6 +791,7 @@ implementation
 
     procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
       var
+        callingconv: ansistring;
         usedef: tdef;
         paranr: longint;
         hp: tparavarsym;
@@ -798,6 +799,12 @@ implementation
         useside: tcallercallee;
         first: boolean;
       begin
+        if not(pddecltype in [lpd_alias,lpd_procvar]) then
+          begin
+            callingconv:=llvm_callingconvention_name(def.proccalloption);
+            if callingconv<>'' then
+              encodedstr:=encodedstr+' "'+callingconv+'"';
+          end;
         { when writing a definition, we have to write the parameter names, and
           those are only available on the callee side. In all other cases,
           we are at the callerside }

compiler/llvm/llvmtype.pas

@@ -240,9 +240,9 @@ implementation
                    assigned(p.oper[opidx]^.ref^.symbol) and
                    (p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
                   begin
-                    if (opidx=3) and
+                    if (opidx=4) and
                        (p.llvmopcode in [la_call,la_invoke]) then
-                      record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef,false)
+                      record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef,false)
                     { not a named register }
                     else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
                       record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
@@ -320,13 +320,13 @@ implementation
           la_call,
           la_invoke:
             begin
-              if p.oper[3]^.typ=top_ref then
+              if p.oper[4]^.typ=top_ref then
                 begin
-                  maybe_insert_extern_sym_decl(toplevellist,p.oper[3]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef);
+                  maybe_insert_extern_sym_decl(toplevellist,p.oper[4]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef);
-                  symdef:=get_asmsym_def(p.oper[3]^.ref^.symbol);
+                  symdef:=get_asmsym_def(p.oper[4]^.ref^.symbol);
                   { the type used in the call is different from the type used to
                     declare the symbol -> insert a typecast }
-                  if not equal_llvm_defs(symdef,p.oper[2]^.def) then
+                  if not equal_llvm_defs(symdef,p.oper[3]^.def) then
                     begin
                       if symdef.typ=procdef then
                         { ugly, but can't use getcopyas(procvardef) due to the
@@ -335,8 +335,8 @@ implementation
                           symtable) and "pointer to procedure" results in the
                           correct llvm type }
                         symdef:=cpointerdef.getreusable(tprocdef(symdef));
-                      cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[2]^.def);
+                      cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[4]^.ref^.symbol,p.oper[3]^.def);
-                      p.loadtai(3,cnv);
+                      p.loadtai(4,cnv);
                     end;
                 end;
               for i:=0 to p.ops-1 do