paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for specifying ms_abi_default, ms_abi_cdelc, sysv_abi_default, and

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2017-02-11 19:57:12 +00:00
parent 4d9617da97
commit 265c8e7bbc
14 changed files with 259 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

8
compiler/globals.pas
View File

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

16
compiler/globtype.pas
View File

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

6
compiler/ncgrtti.pas
View File

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

4
compiler/options.pas
View File

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

54
compiler/pdecsub.pas
View File

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

8
compiler/tokens.pas
View File

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

19
compiler/x86_64/cgcpu.pas
View File

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

6
compiler/x86_64/cpuinfo.pas
View File

@ -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] = ('',

77
compiler/x86_64/cpupara.pas
View File

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

13
compiler/x86_64/cpupi.pas
View File

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

4
compiler/x86_64/hlcgcpu.pas
View File

@ -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),[]);

5
compiler/x86_64/nx64cal.pas
View File

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

98
tests/test/tx64ccnv.pp Normal file
View File

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