+ support for specifying ms_abi_default, ms_abi_cdelc, sysv_abi_default, and

    sysv_abi_cdecl calling conventions on x86-64 to force using the SYSV/
    Microsoft ABI on platforms that don't use it by default (mainly to ease
    porting pure assembler routines)

git-svn-id: trunk@35425 -

.gitattributes

@@ -13188,6 +13188,7 @@ tests/test/twrstr6.pp svneol=native#text/plain
 tests/test/twrstr7.pp svneol=native#text/plain
 tests/test/twrstr8.pp svneol=native#text/plain
 tests/test/twrstr9.pp svneol=native#text/plain
+tests/test/tx64ccnv.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
 tests/test/uchlp12.pp svneol=native#text/pascal
 tests/test/uchlp18.pp svneol=native#text/pascal

compiler/globals.pas

@@ -1078,7 +1078,7 @@ implementation
 
     function SetAktProcCall(const s:string; var a:tproccalloption):boolean;
       const
-        DefProcCallName : array[tproccalloption] of string[12] = ('',
+        DefProcCallName : array[tproccalloption] of string[16] = ('',
          'CDECL',
          'CPPDECL',
          'FAR16',
@@ -1092,7 +1092,11 @@ implementation
          'SOFTFLOAT',
          'MWPASCAL',
          'INTERRUPT',
-         'HARDFLOAT'
+         'HARDFLOAT',
+         'SYSV_ABI_DEFAULT',
+         'SYSV_ABI_CDECL',
+         'MS_ABI_DEFAULT',
+         'MS_ABI_CDECL'
         );
       var
         t  : tproccalloption;

compiler/globtype.pas

@@ -532,12 +532,18 @@ interface
          pocall_interrupt,
          { Directive for arm: pass floating point values in (v)float registers
            regardless of the actual calling conventions }
-         pocall_hardfloat
+         pocall_hardfloat,
+         { for x86-64: force sysv ABI (Pascal resp. C) }
+         pocall_sysv_abi_default,
+         pocall_sysv_abi_cdecl,
+         { for x86-64: forces Microsoft ABI (Pascal resp. C) }
+         pocall_ms_abi_default,
+         pocall_ms_abi_cdecl
        );
        tproccalloptions = set of tproccalloption;
 
      const
-       proccalloptionStr : array[tproccalloption] of string[14]=('',
+       proccalloptionStr : array[tproccalloption] of string[16]=('',
            'CDecl',
            'CPPDecl',
            'Far16',
@@ -551,7 +557,11 @@ interface
            'SoftFloat',
            'MWPascal',
            'Interrupt',
-           'HardFloat'
+           'HardFloat',
+           'SysV_ABI_Default',
+           'MS_ABI_CDecl',
+           'MS_ABI_Default',
+           'MS_ABI_CDecl'
          );
 
        { Default calling convention }

compiler/ncgrtti.pas

@@ -332,7 +332,11 @@ implementation
          { pocall_softfloat  } 10,
          { pocall_mwpascal   } 11,
          { pocall_interrupt  } 12,
-         { pocall_hardfloat  } 13
+         { pocall_hardfloat  } 13,
+         { pocall_sysv_abi_default } 14,
+         { pocall_sysv_abi_cdecl }   15,
+         { pocall_ms_abi_default }   16,
+         { pocall_ms_abi_cdecl }     17
         );
       begin
         tcb.emit_ord_const(ProcCallOptionToCallConv[def.proccalloption],u8inttype);

compiler/options.pas

@@ -4167,8 +4167,8 @@ begin
   option.free;
   Option:=nil;
 
-  clearstack_pocalls := [pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal];
-  cdecl_pocalls := [pocall_cdecl, pocall_cppdecl, pocall_mwpascal];
+  clearstack_pocalls := [pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal,pocall_sysv_abi_cdecl,pocall_ms_abi_cdecl];
+  cdecl_pocalls := [pocall_cdecl, pocall_cppdecl, pocall_mwpascal, pocall_sysv_abi_cdecl, pocall_ms_abi_cdecl];
   if (tf_safecall_clearstack in target_info.flags) then
     begin
       include (cdecl_pocalls, pocall_safecall);

compiler/pdecsub.pas

@@ -2328,7 +2328,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=46;
+  num_proc_directives=50;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2501,7 +2501,7 @@ const
       pocall   : pocall_oldfpccall;
       pooption : [po_interrupt];
       mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,pocall_mwpascal,
-                       pocall_pascal,pocall_far16,pocall_oldfpccall];
+                       pocall_pascal,pocall_far16,pocall_oldfpccall,pocall_sysv_abi_cdecl,pocall_ms_abi_cdecl];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_external,po_inline,po_exports]
     ),(
@@ -2727,7 +2727,7 @@ const
       handler  : @pd_winapi;
       pocall   : pocall_none;
       pooption : [];
-      mutexclpocall : [pocall_stdcall,pocall_cdecl];
+      mutexclpocall : [pocall_stdcall,pocall_cdecl,pocall_mwpascal,pocall_sysv_abi_cdecl,pocall_ms_abi_cdecl];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_external]
     ),(
@@ -2759,6 +2759,42 @@ const
       { it's available with po_external because the libgcc floating point routines on the arm
         uses this calling convention }
       mutexclpo     : []
+    ),(
+      idtok:_SYSV_ABI_DEFAULT;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : nil;
+      pocall   : pocall_sysv_abi_default;
+      pooption : [];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt]
+    ),(
+      idtok:_SYSV_ABI_CDECL;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : nil;
+      pocall   : pocall_sysv_abi_cdecl;
+      pooption : [];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt]
+    ),(
+      idtok:_MS_ABI_DEFAULT;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : nil;
+      pocall   : pocall_ms_abi_default;
+      pooption : [];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt]
+    ),(
+      idtok:_MS_ABI_CDECL;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : nil;
+      pocall   : pocall_ms_abi_cdecl;
+      pooption : [];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt]
     )
    );
 
@@ -2995,7 +3031,9 @@ const
           begin
             { Default names when importing variables }
             case pd.proccalloption of
-              pocall_cdecl :
+              pocall_cdecl,
+              pocall_sysv_abi_cdecl,
+              pocall_ms_abi_cdecl:
                 begin
                   if assigned(pd.struct) then
                     result:=target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname
@@ -3068,7 +3106,9 @@ const
            not(po_has_public_name in pd.procoptions) then
           begin
             case pd.proccalloption of
-              pocall_cdecl :
+              pocall_cdecl,
+              pocall_sysv_abi_cdecl,
+              pocall_ms_abi_cdecl:
                 begin
                   if assigned(pd.struct) then
                    pd.aliasnames.insert(target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname)
@@ -3121,7 +3161,9 @@ const
             { handle proccall specific settings }
             case pd.proccalloption of
               pocall_cdecl,
-              pocall_cppdecl :
+              pocall_cppdecl,
+              pocall_sysv_abi_cdecl,
+              pocall_ms_abi_cdecl:
                 begin
                   { check C cdecl para types }
                   check_c_para(pd);

compiler/tokens.pas

@@ -289,6 +289,7 @@ type
     _COMPILERPROC,
     _EXPERIMENTAL,
     _FINALIZATION,
+    _MS_ABI_CDECL,
     _NOSTACKFRAME,
     _OBJCCATEGORY,
     _OBJCPROTOCOL,
@@ -297,8 +298,11 @@ type
     _UNIMPLEMENTED,
     _IMPLEMENTATION,
     _INITIALIZATION,
+    _MS_ABI_DEFAULT,
     _RESOURCESTRING,
+    _SYSV_ABI_CDECL,
     _LESSTHANOREQUAL,
+    _SYSV_ABI_DEFAULT,
     _GREATERTHANOREQUAL
   );
 
@@ -614,6 +618,7 @@ const
       (str:'COMPILERPROC'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'EXPERIMENTAL'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'FINALIZATION'  ;special:false;keyword:[m_initfinal];op:NOTOKEN),
+      (str:'MS_ABI_CDECL'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'NOSTACKFRAME'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'OBJCCATEGORY'  ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C category }
       (str:'OBJCPROTOCOL'  ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C protocol }
@@ -622,8 +627,11 @@ const
       (str:'UNIMPLEMENTED' ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'IMPLEMENTATION';special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
       (str:'INITIALIZATION';special:false;keyword:[m_initfinal];op:NOTOKEN),
+      (str:'MS_ABI_DEFAULT';special:false;keyword:[m_none];op:NOTOKEN),
       (str:'RESOURCESTRING';special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
+      (str:'SYSV_ABI_CDECL';special:false;keyword:[m_none];op:NOTOKEN),
       (str:'LESSTHANOREQUAL';special:false;keyword:[m_none];op:NOTOKEN),    { delphi operator name }
+      (str:'SYSV_ABI_DEFAULT';special:false;keyword:[m_none];op:NOTOKEN),
       (str:'GREATERTHANOREQUAL';special:false;keyword:[m_none];op:NOTOKEN)  { delphi operator name }
   );
 

compiler/x86_64/cgcpu.pas

@@ -47,6 +47,8 @@ unit cgcpu;
 
         procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize;intreg, mmreg: tregister; shuffle: pmmshuffle); override;
         procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize;mmreg, intreg: tregister;shuffle : pmmshuffle); override;
+
+        function use_ms_abi: boolean;
       private
         function use_push: boolean;
         function saved_xmm_reg_size: longint;
@@ -72,12 +74,14 @@ unit cgcpu;
           RS_XMM8,RS_XMM9,RS_XMM10,RS_XMM11,RS_XMM12,RS_XMM13,RS_XMM14,RS_XMM15);
       var
         i : longint;
+        ms_abi: boolean;
       begin
         inherited init_register_allocators;
 
-        if (length(saved_standard_registers)<>saved_regs_length[target_info.system=system_x86_64_win64]) then
+        ms_abi:=use_ms_abi;
+        if (length(saved_standard_registers)<>saved_regs_length[ms_abi]) then
           begin
-            if target_info.system=system_x86_64_win64 then
+            if ms_abi then
               begin
                 SetLength(saved_standard_registers,Length(win64_saved_std_regs));
                 SetLength(saved_mm_registers,Length(win64_saved_xmm_regs));
@@ -97,7 +101,7 @@ unit cgcpu;
                   saved_standard_registers[i]:=others_saved_std_regs[i];
               end;
           end;
-        if target_info.system=system_x86_64_win64 then
+        if ms_abi then
           begin
             if (cs_userbp in current_settings.optimizerswitches) and assigned(current_procinfo) and (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
               begin
@@ -507,6 +511,15 @@ unit cgcpu;
       end;
 
 
+    function tcgx86_64.use_ms_abi: boolean;
+      begin
+        if assigned(current_procinfo) then
+          use_ms_abi:=x86_64_use_ms_abi(current_procinfo.procdef.proccalloption)
+        else
+          use_ms_abi:=target_info.system=system_x86_64_win64;
+      end;
+
+
     procedure create_codegen;
       begin
         cg:=tcgx86_64.create;

compiler/x86_64/cpuinfo.pas

@@ -106,7 +106,11 @@ Const
      pocall_stdcall,
      pocall_cdecl,
      pocall_cppdecl,
-     pocall_mwpascal
+     pocall_mwpascal,
+     pocall_sysv_abi_default,
+     pocall_sysv_abi_cdecl,
+     pocall_ms_abi_default,
+     pocall_ms_abi_cdecl
    ];
 
    cputypestr : array[tcputype] of string[10] = ('',

compiler/x86_64/cpupara.pas

@@ -55,7 +55,8 @@ unit cpupara;
        cutils,verbose,
        systems,
        defutil,
-       symtable;
+       symtable,
+       cpupi;
 
     const
       paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
@@ -292,15 +293,15 @@ unit cpupara;
       end;
 
 
-    function classify_argument(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; forward;
+    function classify_argument(calloption: tproccalloption; def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; forward;
 
-    function init_aggregate_classification(def: tdef; varspez: tvarspez; byte_offset: aint; out words: longint; out classes: tx64paraclasses): longint;
+    function init_aggregate_classification(calloption: tproccalloption; def: tdef; varspez: tvarspez; byte_offset: aint; out words: longint; out classes: tx64paraclasses): longint;
       var
         i: longint;
       begin
         words:=0;
         { win64 follows a different convention here }
-        if (target_info.system=system_x86_64_win64) then
+        if x86_64_use_ms_abi(calloption) then
           begin
             if aggregate_in_registers_win64(varspez,def.size) then
               begin
@@ -341,14 +342,14 @@ unit cpupara;
       end;
 
 
-    function classify_aggregate_element(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; new_byte_offset: aint): longint;
+    function classify_aggregate_element(calloption: tproccalloption; def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; new_byte_offset: aint): longint;
       var
         subclasses: tx64paraclasses;
         i,
         pos: longint;
       begin
         fillchar(subclasses,sizeof(subclasses),0);
-        result:=classify_argument(def,varspez,real_size,subclasses,new_byte_offset mod 8);
+        result:=classify_argument(calloption,def,varspez,real_size,subclasses,new_byte_offset mod 8);
         if (result=0) then
           exit;
         pos:=new_byte_offset div 8;
@@ -466,7 +467,7 @@ unit cpupara;
       end;
 
 
-    function classify_record(def: tdef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint;
+    function classify_record(calloption: tproccalloption; def: tdef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint;
       var
         vs: tfieldvarsym;
         size,
@@ -476,7 +477,7 @@ unit cpupara;
         num: longint;
         checkalignment: boolean;
       begin
-        result:=init_aggregate_classification(def,varspez,byte_offset,words,classes);
+        result:=init_aggregate_classification(calloption,def,varspez,byte_offset,words,classes);
         if (words=0) then
           exit;
 
@@ -517,7 +518,7 @@ unit cpupara;
                 result:=0;
                 exit;
               end;
-            num:=classify_aggregate_element(vs.vardef,varspez,size,classes,new_byte_offset);
+            num:=classify_aggregate_element(calloption,vs.vardef,varspez,size,classes,new_byte_offset);
             if (num=0) then
               exit(0);
           end;
@@ -526,7 +527,7 @@ unit cpupara;
       end;
 
 
-    function classify_normal_array(def: tarraydef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint;
+    function classify_normal_array(calloption: tproccalloption; def: tarraydef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint;
       var
         i, elecount: aword;
         size,
@@ -539,7 +540,7 @@ unit cpupara;
       begin
         size:=0;
         bitoffset:=0;
-        result:=init_aggregate_classification(def,varspez,byte_offset,words,classes);
+        result:=init_aggregate_classification(calloption,def,varspez,byte_offset,words,classes);
 
         if (words=0) then
           exit;
@@ -581,7 +582,7 @@ unit cpupara;
               { bit offset of next element }
               inc(bitoffset,elesize);
             end;
-          num:=classify_aggregate_element(def.elementdef,varspez,size,classes,new_byte_offset);
+          num:=classify_aggregate_element(calloption,def.elementdef,varspez,size,classes,new_byte_offset);
           if (num=0) then
             exit(0);
           inc(i);
@@ -591,7 +592,7 @@ unit cpupara;
       end;
 
 
-    function classify_argument(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint;
+    function classify_argument(calloption: tproccalloption; def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint;
       begin
         case def.typ of
           orddef,
@@ -650,7 +651,7 @@ unit cpupara;
               end;
             end;
           recorddef:
-            result:=classify_record(def,varspez,classes,byte_offset);
+            result:=classify_record(calloption,def,varspez,classes,byte_offset);
           objectdef:
             begin
               if is_object(def) then
@@ -685,7 +686,7 @@ unit cpupara;
                 result:=0
               else
               { normal array }
-                result:=classify_normal_array(tarraydef(def),varspez,classes,byte_offset);
+                result:=classify_normal_array(calloption,tarraydef(def),varspez,classes,byte_offset);
             end;
           { the file record is definitely too big }
           filedef:
@@ -696,7 +697,7 @@ unit cpupara;
                 begin
                   { treat as TMethod record }
                   def:=search_system_type('TMETHOD').typedef;
-                  result:=classify_argument(def,varspez,def.size,classes,byte_offset);
+                  result:=classify_argument(calloption,def,varspez,def.size,classes,byte_offset);
                 end
               else
                 { pointer }
@@ -706,7 +707,7 @@ unit cpupara;
             begin
               { same as tvardata record }
               def:=search_system_type('TVARDATA').typedef;
-              result:=classify_argument(def,varspez,def.size,classes,byte_offset);
+              result:=classify_argument(calloption,def,varspez,def.size,classes,byte_offset);
             end;
           undefineddef:
             { show shall we know?
@@ -723,7 +724,7 @@ unit cpupara;
       end;
 
 
-    procedure getvalueparaloc(varspez:tvarspez;def:tdef;var loc1,loc2:tx64paraclass);
+    procedure getvalueparaloc(calloption: tproccalloption;varspez:tvarspez;def:tdef;var loc1,loc2:tx64paraclass);
       var
         size: aint;
         i: longint;
@@ -745,7 +746,7 @@ unit cpupara;
           size:=-1
         else
           size:=def.size;
-        numclasses:=classify_argument(def,varspez,size,classes,0);
+        numclasses:=classify_argument(calloption,def,varspez,size,classes,0);
         case numclasses of
           0:
            begin
@@ -784,7 +785,7 @@ unit cpupara;
           { make sure we handle 'procedure of object' correctly }
           procvardef:
             begin
-              numclasses:=classify_argument(def,vs_value,def.size,classes,0);
+              numclasses:=classify_argument(pd.proccalloption,def,vs_value,def.size,classes,0);
               result:=(numclasses=0);
             end;
           else
@@ -840,7 +841,7 @@ unit cpupara;
                  (varspez=vs_const) then
                 result:=true
               { Win ABI depends on size to pass it in a register or not }
-              else if (target_info.system=system_x86_64_win64) then
+              else if x86_64_use_ms_abi(calloption) then
                 result:=not aggregate_in_registers_win64(varspez,def.size)
               { pass constant parameters that would be passed via memory by
                 reference for non-cdecl/cppdecl, and make sure that the tmethod
@@ -849,7 +850,7 @@ unit cpupara;
                        not(calloption in cdecl_pocalls)) or
                       (def.size=16) then
                 begin
-                  numclasses:=classify_argument(def,vs_value,def.size,classes,0);
+                  numclasses:=classify_argument(calloption,def,vs_value,def.size,classes,0);
                   result:=numclasses=0;
                 end
               else
@@ -886,7 +887,7 @@ unit cpupara;
           procvardef,
           setdef :
             begin
-              numclasses:=classify_argument(def,vs_value,def.size,classes,0);
+              numclasses:=classify_argument(calloption,def,vs_value,def.size,classes,0);
               result:=numclasses=0;
             end;
         end;
@@ -895,7 +896,7 @@ unit cpupara;
 
     function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
-        if target_info.system=system_x86_64_win64 then
+        if x86_64_use_ms_abi(calloption) then
           result:=[RS_RAX,RS_RCX,RS_RDX,RS_R8,RS_R9,RS_R10,RS_R11]
         else
           result:=[RS_RAX,RS_RCX,RS_RDX,RS_RSI,RS_RDI,RS_R8,RS_R9,RS_R10,RS_R11];
@@ -904,7 +905,7 @@ unit cpupara;
 
     function tcpuparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
       begin
-        if target_info.system=system_x86_64_win64 then
+        if x86_64_use_ms_abi(calloption) then
           result:=[RS_XMM0..RS_XMM5]
         else
           result:=[RS_XMM0..RS_XMM15];
@@ -972,7 +973,7 @@ unit cpupara;
          { Return in register }
           begin
             fillchar(classes,sizeof(classes),0);
-            numclasses:=classify_argument(result.def,vs_value,result.def.size,classes,0);
+            numclasses:=classify_argument(p.proccalloption,result.def,vs_value,result.def.size,classes,0);
             { this would mean a memory return }
             if (numclasses=0) then
               internalerror(2010021502);
@@ -1083,8 +1084,10 @@ unit cpupara;
         i,
         varalign,
         paraalign  : longint;
+        use_ms_abi : boolean;
       begin
         paraalign:=get_para_align(p.proccalloption);
+        use_ms_abi:=x86_64_use_ms_abi(p.proccalloption);
         { Register parameters are assigned from left to right }
         for i:=0 to paras.count-1 do
           begin
@@ -1092,7 +1095,7 @@ unit cpupara;
             paradef:=hp.vardef;
             { on win64, if a record has only one field and that field is a
               single or double, it has to be handled like a single/double }
-            if (target_info.system=system_x86_64_win64) and
+            if use_ms_abi and
                ((paradef.typ=recorddef) {or
                is_object(paradef)}) and
                tabstractrecordsymtable(tabstractrecorddef(paradef).symtable).has_single_field(fdef) and
@@ -1112,14 +1115,14 @@ unit cpupara;
               end
             else
               begin
-                getvalueparaloc(hp.varspez,paradef,loc[1],loc[2]);
+                getvalueparaloc(p.proccalloption,hp.varspez,paradef,loc[1],loc[2]);
                 paralen:=push_size(hp.varspez,paradef,p.proccalloption);
                 paracgsize:=def_cgsize(paradef);
               end;
 
             { cheat for now, we should copy the value to an mm reg as well (FK) }
             if varargsparas and
-               (target_info.system = system_x86_64_win64) and
+               use_ms_abi and
                (paradef.typ = floatdef) then
               begin
                 loc[2].typ:=X86_64_NO_CLASS;
@@ -1160,10 +1163,10 @@ unit cpupara;
                       inc(needmmloc);
                   end;
                 { the "-1" is because we can also use the current register }
-                if ((target_info.system=system_x86_64_win64) and
+                if (use_ms_abi and
                     ((intparareg+needintloc-1 > high(paraintsupregs_winx64)) or
                      (mmparareg+needmmloc-1 > high(parammsupregs_winx64)))) or
-                   ((target_info.system<>system_x86_64_win64) and
+                   (not use_ms_abi and
                     ((intparareg+needintloc-1 > high(paraintsupregs)) or
                      (mmparareg+needmmloc-1 > high(parammsupregs)))) then
                   begin
@@ -1217,13 +1220,13 @@ unit cpupara;
                             end;
 
                           { winx64 uses different registers }
-                          if target_info.system=system_x86_64_win64 then
+                          if use_ms_abi then
                             paraloc^.register:=newreg(R_INTREGISTER,paraintsupregs_winx64[intparareg],subreg)
                           else
                             paraloc^.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg);
 
                           { matching mm register must be skipped }
-                          if target_info.system=system_x86_64_win64 then
+                          if use_ms_abi then
                             inc(mmparareg);
 
                           inc(intparareg);
@@ -1257,13 +1260,13 @@ unit cpupara;
                           end;
 
                           { winx64 uses different registers }
-                          if target_info.system=system_x86_64_win64 then
+                          if use_ms_abi then
                             paraloc^.register:=newreg(R_MMREGISTER,parammsupregs_winx64[mmparareg],subreg)
                           else
                             paraloc^.register:=newreg(R_MMREGISTER,parammsupregs[mmparareg],subreg);
 
                           { matching int register must be skipped }
-                          if target_info.system=system_x86_64_win64 then
+                          if use_ms_abi then
                             inc(intparareg);
 
                           inc(mmparareg);
@@ -1340,7 +1343,7 @@ unit cpupara;
       begin
         intparareg:=0;
         mmparareg:=0;
-        if target_info.system=system_x86_64_win64 then
+        if x86_64_use_ms_abi(p.proccalloption) then
           parasize:=4*8
         else
           parasize:=0;
@@ -1361,7 +1364,7 @@ unit cpupara;
       begin
         intparareg:=0;
         mmparareg:=0;
-        if target_info.system=system_x86_64_win64 then
+        if x86_64_use_ms_abi(p.proccalloption) then
           parasize:=4*8
         else
           parasize:=0;

compiler/x86_64/cpupi.pas

@@ -28,6 +28,7 @@ unit cpupi;
 interface
 
     uses
+       globtype,
        psub,procinfo,aasmbase,aasmdata;
 
     type
@@ -46,12 +47,12 @@ interface
          destructor destroy;override;
        end;
 
+    function x86_64_use_ms_abi(proccall: tproccalloption): boolean;
 
 implementation
 
     uses
       systems,
-      globtype,
       globals,
       cutils,
       symconst,
@@ -166,6 +167,16 @@ implementation
         inherited destroy;
       end;
 
+
+    function x86_64_use_ms_abi(proccall: tproccalloption): boolean;
+      begin
+        result:=
+           ((target_info.system=system_x86_64_win64) and
+            not(proccall in [pocall_sysv_abi_default,pocall_sysv_abi_cdecl])) or
+           (proccall in [pocall_ms_abi_default,pocall_ms_abi_cdecl]);
+      end;
+
+
 begin
    cprocinfo:=tcpuprocinfo;
 end.

compiler/x86_64/hlcgcpu.pas

@@ -48,7 +48,7 @@ implementation
     aasmbase,aasmtai,aasmcpu,
     symconst,
     hlcgobj,
-    cgbase,cgutils,cgobj,cpubase,cgcpu;
+    cgbase,cgutils,cgobj,cpubase,cgcpu,cpupi;
 
   procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
     var
@@ -86,7 +86,7 @@ implementation
             Internalerror(200006139);
           { load vmt from first paramter }
           { win64 uses a different abi }
-          if target_info.system=system_x86_64_win64 then
+          if x86_64_use_ms_abi(procdef.proccalloption) then
             reference_reset_base(href,voidpointertype,NR_RCX,0,sizeof(pint),[])
           else
             reference_reset_base(href,voidpointertype,NR_RDI,0,sizeof(pint),[]);

compiler/x86_64/nx64cal.pas

@@ -47,7 +47,8 @@ implementation
       systems,verbose,cutils,
       cpubase,cgbase,cgutils,cgobj,
       symconst, symsym,symcpu,nld,
-      aasmbase,aasmtai,aasmdata,aasmcpu;
+      aasmbase,aasmtai,aasmdata,aasmcpu,
+      cpupi;
 
     procedure tx8664callnode.do_syscall;
       var
@@ -87,7 +88,7 @@ implementation
         mmregs : aint;
       begin
         { x86_64 requires %al to contain the no. SSE regs passed }
-        if (cnf_uses_varargs in callnodeflags) and (target_info.system<>system_x86_64_win64) then
+        if (cnf_uses_varargs in callnodeflags) and not x86_64_use_ms_abi(procdefinition.proccalloption) then
           begin
             if assigned(varargsparas) then
               mmregs:=varargsparas.mmregsused

tests/test/tx64ccnv.pp

@@ -0,0 +1,98 @@
+{ %cpu=x86_64 }
+
+function proc_msabidefault(para1,para2,para3,para4: qword): boolean; ms_abi_default;
+assembler;
+asm
+  cmpq $1, %rcx
+  jne .Lerror
+  cmpq $2, %rdx
+  jne .Lerror
+  cmpq $3, %r8
+  jne .Lerror
+  cmpq $4, %r9
+  jne .Lerror
+  movq $1,%rax
+  jmp .Lok
+.Lerror:
+  movq $0,%rax
+.Lok:
+end;
+
+function proc_msabicdecl(para1,para2,para3,para4: qword): boolean; ms_abi_cdecl;
+assembler;
+asm
+  cmpq $1, %rcx
+  jne .Lerror
+  cmpq $2, %rdx
+  jne .Lerror
+  cmpq $3, %r8
+  jne .Lerror
+  cmpq $4, %r9
+  jne .Lerror
+  movq $1,%rax
+  jmp .Lok
+.Lerror:
+  movq $0,%rax
+.Lok:
+end;
+
+
+function proc_sysvabidefault(para1,para2,para3,para4,para5,para6: qword): boolean; sysv_abi_default;
+assembler;
+asm
+  cmpq $1, %rdi
+  jne .Lerror
+  cmpq $2, %rsi
+  jne .Lerror
+  cmpq $3, %rdx
+  jne .Lerror
+  cmpq $4, %rcx
+  jne .Lerror
+  cmpq $5, %r8
+  jne .Lerror
+  cmpq $6, %r9
+  jne .Lerror
+  movq $1,%rax
+  jmp .Lok
+.Lerror:
+  movq $0,%rax
+.Lok:
+end;
+
+
+function proc_sysvabicdecl_extern(para1,para2,para3,para4,para5,para6: qword): boolean; sysv_abi_cdecl; varargs; external name '_FPC_PROCC_SYSVABICDECL';
+
+function proc_sysvabicdecl(para1,para2,para3,para4,para5,para6: qword): boolean; sysv_abi_cdecl; [public, alias: '_FPC_PROCC_SYSVABICDECL'];
+assembler;
+asm
+  cmpb $0, %al
+  jne .Lerror
+  cmpq $1, %rdi
+  jne .Lerror
+  cmpq $2, %rsi
+  jne .Lerror
+  cmpq $3, %rdx
+  jne .Lerror
+  cmpq $4, %rcx
+  jne .Lerror
+  cmpq $5, %r8
+  jne .Lerror
+  cmpq $6, %r9
+  jne .Lerror
+  movq $1,%rax
+  jmp .Lok
+.Lerror:
+  movq $0,%rax
+.Lok:
+end;
+
+begin
+  if not proc_msabidefault(1,2,3,4) then
+    halt(1);
+  if not proc_msabicdecl(1,2,3,4) then
+    halt(2);
+  if not proc_sysvabidefault(1,2,3,4,5,6) then
+    halt(3);
+  if not proc_sysvabicdecl_extern(1,2,3,4,5,6) then
+    halt(4);
+end.