paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 11:19:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved g_external_wrapper() to the hlcg, and also g_intf_wrapper() because

Browse Source 
for some platforms it depends on that routine

git-svn-id: branches/hlcgllvm@28492 -
This commit is contained in:
Jonas Maebe 2014-08-19 20:22:54 +00:00
parent 33c277b3a7
commit b745dcc64c
27 changed files with 1205 additions and 1157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
compiler/arm/cgcpu.pas
View File

@ -92,8 +92,6 @@ unit cgcpu;
procedure fixref(list : TAsmList;var ref : treference);
function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; virtual;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
@ -3143,169 +3141,6 @@ unit cgcpu;
end;
procedure tbasecgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure loadvmttor12;
var
tmpref,
href : treference;
extrareg : boolean;
l : TAsmLabel;
begin
reference_reset_base(href,NR_R0,0,sizeof(pint));
if GenerateThumbCode then
begin
if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
end
else
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
href.offset:=0;
href.index:=NR_R1;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
end;
end
else
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
end;
procedure op_onr12methodaddr;
var
tmpref,
href : treference;
l : TAsmLabel;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
if GenerateThumbCode then
begin
reference_reset_base(href,NR_R0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
end
else
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
href.offset:=0;
href.index:=NR_R1;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
end;
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end
else
begin
reference_reset_base(href,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end;
end;
var
make_global : boolean;
tmpref : treference;
l : TAsmLabel;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ the wrapper might need aktlocaldata for the additional data to
load the constant }
current_procinfo:=cprocinfo.create(nil);
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
loadvmttor12;
op_onr12methodaddr;
end
{ case 0 }
else if GenerateThumbCode then
begin
{ bl cannot be used here because it destroys lr }
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(procdef.mangledname)));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end
else
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
list.concatlist(current_procinfo.aktlocaldata);
current_procinfo.Free;
current_procinfo:=nil;
list.concat(Tai_symbol_end.Createname(labelname));
end;
procedure tbasecgarm.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
const
overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NEG];

184
compiler/arm/hlcgcpu.pas
View File

@ -28,20 +28,196 @@ unit hlcgcpu;
interface
uses
aasmdata,
symdef,
hlcg2ll;
type
thlcgcpu = class(thlcg2ll)
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
end;
procedure create_hlcodegen;
implementation
uses
hlcgobj, hlcg2ll,
cgcpu;
globtype,verbose,
procinfo,fmodule,
symconst,
aasmbase,aasmtai,aasmcpu,
hlcgobj,
cgbase, cgutils, cpubase, cgobj, cgcpu;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure loadvmttor12;
var
tmpref,
href : treference;
extrareg : boolean;
l : TAsmLabel;
begin
reference_reset_base(href,voidpointertype,NR_R0,0,sizeof(pint));
if GenerateThumbCode then
begin
if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
end
else
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
href.offset:=0;
href.index:=NR_R1;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
end;
end
else
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
end;
procedure op_onr12methodaddr;
var
tmpref,
href : treference;
l : TAsmLabel;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
if GenerateThumbCode then
begin
reference_reset_base(href,voidpointertype,NR_R0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
end
else
begin
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
href.offset:=0;
href.index:=NR_R1;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
end;
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end
else
begin
reference_reset_base(href,voidpointertype,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end;
end;
var
make_global : boolean;
tmpref : treference;
l : TAsmLabel;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ the wrapper might need aktlocaldata for the additional data to
load the constant }
current_procinfo:=cprocinfo.create(nil);
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
loadvmttor12;
op_onr12methodaddr;
end
{ case 0 }
else if GenerateThumbCode then
begin
{ bl cannot be used here because it destroys lr }
list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
{ create consts entry }
reference_reset(tmpref,4);
current_asmdata.getjumplabel(l);
current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
cg.a_label(current_procinfo.aktlocaldata,l);
tmpref.symboldata:=current_procinfo.aktlocaldata.last;
current_procinfo.aktlocaldata.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(procdef.mangledname)));
tmpref.symbol:=l;
tmpref.base:=NR_PC;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
end
else
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
list.concatlist(current_procinfo.aktlocaldata);
current_procinfo.Free;
current_procinfo:=nil;
list.concat(Tai_symbol_end.Createname(labelname));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcg2ll.create;
hlcg:=thlcgcpu.create;
create_codegen;
end;
begin
chlcgobj:=thlcg2ll;
chlcgobj:=thlcgcpu;
end.

7
compiler/avr/cgcpu.pas
View File

@ -98,7 +98,6 @@ unit cgcpu;
function normalize_ref(list : TAsmList;ref : treference;
tmpreg : tregister) : treference;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
procedure a_adjust_sp(list: TAsmList; value: longint);
@ -1875,12 +1874,6 @@ unit cgcpu;
end;
procedure tcgavr.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
begin
//internalerror(2011021324);
end;
procedure tcgavr.emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
var
instr: taicpu;

22
compiler/avr/hlcgcpu.pas
View File

@ -28,20 +28,36 @@ unit hlcgcpu;
interface
uses
aasmdata,
symdef,
hlcg2ll;
type
thlcgcpu = class(thlcg2ll)
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
end;
procedure create_hlcodegen;
implementation
uses
hlcgobj, hlcg2ll,
hlcgobj,
cgcpu;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
begin
//internalerror(2011021324);
end;
procedure create_hlcodegen;
begin
hlcg:=thlcg2ll.create;
hlcg:=thlcgcpu.create;
create_codegen;
end;
begin
chlcgobj:=thlcg2ll;
chlcgobj:=thlcgcpu;
end.

7
compiler/cghlcpu.pas
View File

@ -45,7 +45,6 @@ uses
procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); override;
procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean); override;
procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
{$ifdef cpuflags}
procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
@ -186,12 +185,6 @@ implementation
end;
{$endif}
procedure thlbasecgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
begin
internalerror(2012042820);
end;
procedure thlbasecgcpu.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
begin
internalerror(2012042820);

13
compiler/cgobj.pas
View File

@ -417,15 +417,8 @@ unit cgobj;
}
procedure g_restore_registers(list:TAsmList);virtual;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);virtual;
{ generate a stub which only purpose is to pass control the given external method,
setting up any additional environment before doing so (if required).
The default implementation issues a jump instruction to the external name. }
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
{ initialize the pic/got register }
procedure g_maybe_got_init(list: TAsmList); virtual;
{ allocallcpuregisters, a_call_name, deallocallcpuregisters sequence }
@ -2368,12 +2361,6 @@ implementation
end;
procedure tcg.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
begin
a_jmp_name(list,externalname);
end;
procedure tcg.a_call_name_static(list : TAsmList;const s : string);
begin
a_call_name(list,s,false);

2
compiler/expunix.pas
View File

@ -167,7 +167,7 @@ begin
{$endif x86}
end
else
cg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,pd.mangledname);
hlcg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
exportedsymnames.insert(hp2.name^);

12
compiler/hlcg2ll.pas
View File

@ -296,15 +296,8 @@ unit hlcg2ll;
}
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override;
{ generate a stub which only purpose is to pass control the given external method,
setting up any additional environment before doing so (if required).
The default implementation issues a jump instruction to the external name. }
// procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); override;
{ Generate code to exit an unwind-protected region. The default implementation
produces a simple jump to destination label. }
procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
@ -989,11 +982,6 @@ implementation
cg.g_proc_exit(list,parasize,nostackframe);
end;
procedure thlcg2ll.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
begin
cg.g_intf_wrapper(list,procdef,labelname,ioffset);
end;
procedure thlcg2ll.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
begin
cg.g_adjust_self_value(list,procdef,ioffset);

7
compiler/hlcgobj.pas
View File

@ -517,7 +517,7 @@ unit hlcgobj;
setting up any additional environment before doing so (if required).
The default implementation issues a jump instruction to the external name. }
// procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
protected
procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
@ -3720,6 +3720,11 @@ implementation
begin
end;
procedure thlcgobj.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
begin
cg.a_jmp_name(list,externalname);
end;
procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
begin
case regtyp of

178
compiler/i386/cgcpu.pas
View File

@ -48,7 +48,6 @@ unit cgcpu;
procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_maybe_got_init(list: TAsmList); override;
end;
@ -582,183 +581,6 @@ unit cgcpu;
end;
procedure tcg386.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
{
possible calling conventions:
default stdcall cdecl pascal register
default(0): OK OK OK OK OK
virtual(1): OK OK OK OK OK(2 or 1)
(0):
set self parameter to correct value
jmp mangledname
(1): The wrapper code use %ecx to reach the virtual method address
set self to correct value
move self,%eax
mov 0(%eax),%ecx ; load vmt
jmp vmtoffs(%ecx) ; method offs
(2): Virtual use values pushed on stack to reach the method address
so the following code be generated:
set self to correct value
push %ebx ; allocate space for function address
push %eax
mov self,%eax
mov 0(%eax),%eax ; load vmt
mov vmtoffs(%eax),eax ; method offs
mov %eax,4(%esp)
pop %eax
ret 0; jmp the address
}
{ returns whether ECX is used (either as a parameter or is nonvolatile and shouldn't be changed) }
function is_ecx_used: boolean;
var
i: Integer;
hp: tparavarsym;
paraloc: PCGParaLocation;
begin
if not (RS_ECX in paramanager.get_volatile_registers_int(procdef.proccalloption)) then
exit(true);
for i:=0 to procdef.paras.count-1 do
begin
hp:=tparavarsym(procdef.paras[i]);
procdef.init_paraloc_info(calleeside);
paraloc:=hp.paraloc[calleeside].Location;
while paraloc<>nil do
begin
if (paraloc^.Loc=LOC_REGISTER) and (getsupreg(paraloc^.register)=RS_ECX) then
exit(true);
paraloc:=paraloc^.Next;
end;
end;
Result:=false;
end;
procedure getselftoeax(offs: longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ mov offset(%esp),%eax }
if (procdef.proccalloption<>pocall_register) then
begin
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=2*sizeof(aint)
else
selfoffsetfromsp:=sizeof(aint);
reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs,4);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
end;
end;
procedure loadvmtto(reg: tregister);
var
href : treference;
begin
{ mov 0(%eax),%reg ; load vmt}
reference_reset_base(href,NR_EAX,0,4);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
end;
procedure op_onregmethodaddr(op: TAsmOp; reg: tregister);
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%reg) ; method offs }
reference_reset_base(href,reg,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
list.concat(taicpu.op_ref(op,S_L,href));
end;
procedure loadmethodoffstoeax;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ mov vmtoffs(%eax),%eax ; method offs }
reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
end;
var
lab : tasmsymbol;
make_global : boolean;
href : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.proccalloption=pocall_register) and is_ecx_used then
begin
{ case 2 }
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
getselftoeax(8);
loadvmtto(NR_EAX);
loadmethodoffstoeax;
{ mov %eax,4(%esp) }
reference_reset_base(href,NR_ESP,4,4);
list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href));
{ pop %eax }
list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX));
{ ret ; jump to the address }
list.concat(taicpu.op_none(A_RET,S_L));
end
else
begin
{ case 1 }
getselftoeax(0);
loadvmtto(NR_ECX);
op_onregmethodaddr(A_JMP,NR_ECX);
end;
end
{ case 0 }
else
begin
if (target_info.system <> system_i386_darwin) then
begin
lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
end
else
list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname,false)))
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
{ ************* 64bit operations ************ }
procedure tcg64f386.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);

183
compiler/i386/hlcgcpu.pas
View File

@ -47,6 +47,8 @@ interface
procedure g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference); override;
procedure g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister); override;
procedure g_exception_reason_discard(list: TAsmList; size: tdef; href: treference); override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
end;
procedure create_hlcodegen;
@ -55,8 +57,10 @@ implementation
uses
verbose,
fmodule,systems,
aasmbase,aasmtai,
paramgr,
defutil,
symconst,symsym,defutil,
cpubase,aasmcpu,tgobj,cgobj,cgx86,cgcpu;
{ thlcgcpu }
@ -236,6 +240,183 @@ implementation
end;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
{
possible calling conventions:
default stdcall cdecl pascal register
default(0): OK OK OK OK OK
virtual(1): OK OK OK OK OK(2 or 1)
(0):
set self parameter to correct value
jmp mangledname
(1): The wrapper code use %ecx to reach the virtual method address
set self to correct value
move self,%eax
mov 0(%eax),%ecx ; load vmt
jmp vmtoffs(%ecx) ; method offs
(2): Virtual use values pushed on stack to reach the method address
so the following code be generated:
set self to correct value
push %ebx ; allocate space for function address
push %eax
mov self,%eax
mov 0(%eax),%eax ; load vmt
mov vmtoffs(%eax),eax ; method offs
mov %eax,4(%esp)
pop %eax
ret 0; jmp the address
}
{ returns whether ECX is used (either as a parameter or is nonvolatile and shouldn't be changed) }
function is_ecx_used: boolean;
var
i: Integer;
hp: tparavarsym;
paraloc: PCGParaLocation;
begin
if not (RS_ECX in paramanager.get_volatile_registers_int(procdef.proccalloption)) then
exit(true);
for i:=0 to procdef.paras.count-1 do
begin
hp:=tparavarsym(procdef.paras[i]);
procdef.init_paraloc_info(calleeside);
paraloc:=hp.paraloc[calleeside].Location;
while paraloc<>nil do
begin
if (paraloc^.Loc=LOC_REGISTER) and (getsupreg(paraloc^.register)=RS_ECX) then
exit(true);
paraloc:=paraloc^.Next;
end;
end;
Result:=false;
end;
procedure getselftoeax(offs: longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ mov offset(%esp),%eax }
if (procdef.proccalloption<>pocall_register) then
begin
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=2*sizeof(aint)
else
selfoffsetfromsp:=sizeof(aint);
reference_reset_base(href,voidstackpointertype,NR_ESP,selfoffsetfromsp+offs,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
end;
end;
procedure loadvmtto(reg: tregister);
var
href : treference;
begin
{ mov 0(%eax),%reg ; load vmt}
reference_reset_base(href,voidpointertype,NR_EAX,0,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
end;
procedure op_onregmethodaddr(op: TAsmOp; reg: tregister);
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%reg) ; method offs }
reference_reset_base(href,voidpointertype,reg,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
list.concat(taicpu.op_ref(op,S_L,href));
end;
procedure loadmethodoffstoeax;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ mov vmtoffs(%eax),%eax ; method offs }
reference_reset_base(href,voidpointertype,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
end;
var
lab : tasmsymbol;
make_global : boolean;
href : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.proccalloption=pocall_register) and is_ecx_used then
begin
{ case 2 }
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
getselftoeax(8);
loadvmtto(NR_EAX);
loadmethodoffstoeax;
{ mov %eax,4(%esp) }
reference_reset_base(href,voidstackpointertype,NR_ESP,4,4);
list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href));
{ pop %eax }
list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX));
{ ret ; jump to the address }
list.concat(taicpu.op_none(A_RET,S_L));
end
else
begin
{ case 1 }
getselftoeax(0);
loadvmtto(NR_ECX);
op_onregmethodaddr(A_JMP,NR_ECX);
end;
end
{ case 0 }
else
begin
if (target_info.system <> system_i386_darwin) then
begin
lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
end
else
list.concat(taicpu.op_sym(A_JMP,S_NO,tcgx86(cg).get_darwin_call_stub(procdef.mangledname,false)))
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcgcpu.create;

203
compiler/i8086/cgcpu.pas
View File

@ -92,7 +92,6 @@ unit cgcpu;
procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure get_32bit_ops(op: TOpCG; out op1,op2: TAsmOp);
@ -2116,208 +2115,6 @@ unit cgcpu;
end;
procedure tcg8086.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
{
possible calling conventions:
default stdcall cdecl pascal register
default(0): OK OK OK OK OK
virtual(1): OK OK OK OK OK(2)
(0):
set self parameter to correct value
jmp mangledname
(1): The wrapper code use %eax to reach the virtual method address
set self to correct value
move self,%bx
mov 0(%bx),%bx ; load vmt
jmp vmtoffs(%bx) ; method offs
(2): Virtual use values pushed on stack to reach the method address
so the following code be generated:
set self to correct value
push %bx ; allocate space for function address
push %bx
push %di
mov self,%bx
mov 0(%bx),%bx ; load vmt
mov vmtoffs(%bx),bx ; method offs
mov %sp,%di
mov %bx,4(%di)
pop %di
pop %bx
ret 0; jmp the address
}
procedure getselftobx(offs: longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ "mov offset(%sp),%bx" }
if (procdef.proccalloption<>pocall_register) then
begin
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=2*sizeof(aint)
else
selfoffsetfromsp:=sizeof(aint);
if current_settings.x86memorymodel in x86_far_code_models then
inc(selfoffsetfromsp,2);
list.concat(taicpu.op_reg_reg(A_mov,S_W,NR_SP,NR_DI));
reference_reset_base(href,NR_DI,selfoffsetfromsp+offs+2,2);
if not segment_regs_equal(NR_SS,NR_DS) then
href.segment:=NR_SS;
if current_settings.x86memorymodel in x86_near_data_models then
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX)
else
list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
end
else
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_BX,NR_BX);
end;
procedure loadvmttobx;
var
href : treference;
begin
{ mov 0(%bx),%bx ; load vmt}
if current_settings.x86memorymodel in x86_near_data_models then
begin
reference_reset_base(href,NR_BX,0,2);
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
end
else
begin
reference_reset_base(href,NR_BX,0,2);
href.segment:=NR_ES;
list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
end;
end;
procedure loadmethodoffstobx;
var
href : treference;
srcseg: TRegister;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
if current_settings.x86memorymodel in x86_far_data_models then
srcseg:=NR_ES
else
srcseg:=NR_NO;
if current_settings.x86memorymodel in x86_far_code_models then
begin
{ mov vmtseg(%bx),%si ; method seg }
reference_reset_base(href,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)+2,2);
href.segment:=srcseg;
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_SI);
end;
{ mov vmtoffs(%bx),%bx ; method offs }
reference_reset_base(href,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),2);
href.segment:=srcseg;
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
end;
var
lab : tasmsymbol;
make_global : boolean;
href : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
{ case 1 & case 2 }
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX)); { allocate space for address}
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_SI));
if current_settings.x86memorymodel in x86_far_code_models then
getselftobx(10)
else
getselftobx(6);
loadvmttobx;
loadmethodoffstobx;
{ set target address
"mov %bx,4(%sp)" }
if current_settings.x86memorymodel in x86_far_code_models then
reference_reset_base(href,NR_DI,6,2)
else
reference_reset_base(href,NR_DI,4,2);
if not segment_regs_equal(NR_DS,NR_SS) then
href.segment:=NR_SS;
list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_SP,NR_DI));
list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_BX,href));
if current_settings.x86memorymodel in x86_far_code_models then
begin
inc(href.offset,2);
list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_SI,href));
end;
{ load ax? }
if procdef.proccalloption=pocall_register then
list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_BX,NR_AX));
{ restore register
pop %di,bx }
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_POP,S_W,NR_SI));
list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
list.concat(taicpu.op_reg(A_POP,S_W,NR_BX));
{ ret ; jump to the address }
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_none(A_RETF,S_W))
else
list.concat(taicpu.op_none(A_RET,S_W));
end
{ case 0 }
else
begin
lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_sym(A_JMP,S_FAR,lab))
else
list.concat(taicpu.op_sym(A_JMP,S_NO,lab));
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
{ ************* 64bit operations ************ }
procedure tcg64f8086.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);

205
compiler/i8086/hlcgcpu.pas
View File

@ -82,6 +82,8 @@ interface
procedure g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister); override;
procedure g_exception_reason_discard(list: TAsmList; size: tdef; href: treference); override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
end;
@ -92,6 +94,7 @@ implementation
uses
verbose,
paramgr,
aasmbase,aasmtai,
cpubase,cpuinfo,tgobj,cgobj,cgx86,cgcpu,
defutil,
symconst,symcpu,
@ -436,6 +439,208 @@ implementation
end;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
{
possible calling conventions:
default stdcall cdecl pascal register
default(0): OK OK OK OK OK
virtual(1): OK OK OK OK OK(2)
(0):
set self parameter to correct value
jmp mangledname
(1): The wrapper code use %eax to reach the virtual method address
set self to correct value
move self,%bx
mov 0(%bx),%bx ; load vmt
jmp vmtoffs(%bx) ; method offs
(2): Virtual use values pushed on stack to reach the method address
so the following code be generated:
set self to correct value
push %bx ; allocate space for function address
push %bx
push %di
mov self,%bx
mov 0(%bx),%bx ; load vmt
mov vmtoffs(%bx),bx ; method offs
mov %sp,%di
mov %bx,4(%di)
pop %di
pop %bx
ret 0; jmp the address
}
procedure getselftobx(offs: longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ "mov offset(%sp),%bx" }
if (procdef.proccalloption<>pocall_register) then
begin
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=2*sizeof(aint)
else
selfoffsetfromsp:=sizeof(aint);
if current_settings.x86memorymodel in x86_far_code_models then
inc(selfoffsetfromsp,2);
list.concat(taicpu.op_reg_reg(A_mov,S_W,NR_SP,NR_DI));
reference_reset_base(href,voidpointertype,NR_DI,selfoffsetfromsp+offs+2,2);
if not segment_regs_equal(NR_SS,NR_DS) then
href.segment:=NR_SS;
if current_settings.x86memorymodel in x86_near_data_models then
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX)
else
list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
end
else
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_BX,NR_BX);
end;
procedure loadvmttobx;
var
href : treference;
begin
{ mov 0(%bx),%bx ; load vmt}
if current_settings.x86memorymodel in x86_near_data_models then
begin
reference_reset_base(href,voidpointertype,NR_BX,0,2);
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
end
else
begin
reference_reset_base(href,voidpointertype,NR_BX,0,2);
href.segment:=NR_ES;
list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
end;
end;
procedure loadmethodoffstobx;
var
href : treference;
srcseg: TRegister;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
if current_settings.x86memorymodel in x86_far_data_models then
srcseg:=NR_ES
else
srcseg:=NR_NO;
if current_settings.x86memorymodel in x86_far_code_models then
begin
{ mov vmtseg(%bx),%si ; method seg }
reference_reset_base(href,voidpointertype,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)+2,2);
href.segment:=srcseg;
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_SI);
end;
{ mov vmtoffs(%bx),%bx ; method offs }
reference_reset_base(href,voidpointertype,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),2);
href.segment:=srcseg;
cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
end;
var
lab : tasmsymbol;
make_global : boolean;
href : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
{ case 1 & case 2 }
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX)); { allocate space for address}
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_PUSH,S_W,NR_SI));
if current_settings.x86memorymodel in x86_far_code_models then
getselftobx(10)
else
getselftobx(6);
loadvmttobx;
loadmethodoffstobx;
{ set target address
"mov %bx,4(%sp)" }
if current_settings.x86memorymodel in x86_far_code_models then
reference_reset_base(href,voidpointertype,NR_DI,6,2)
else
reference_reset_base(href,voidpointertype,NR_DI,4,2);
if not segment_regs_equal(NR_DS,NR_SS) then
href.segment:=NR_SS;
list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_SP,NR_DI));
list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_BX,href));
if current_settings.x86memorymodel in x86_far_code_models then
begin
inc(href.offset,2);
list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_SI,href));
end;
{ load ax? }
if procdef.proccalloption=pocall_register then
list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_BX,NR_AX));
{ restore register
pop %di,bx }
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_reg(A_POP,S_W,NR_SI));
list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
list.concat(taicpu.op_reg(A_POP,S_W,NR_BX));
{ ret ; jump to the address }
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_none(A_RETF,S_W))
else
list.concat(taicpu.op_none(A_RET,S_W));
end
{ case 0 }
else
begin
lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
if current_settings.x86memorymodel in x86_far_code_models then
list.concat(taicpu.op_sym(A_JMP,S_FAR,lab))
else
list.concat(taicpu.op_sym(A_JMP,S_NO,lab));
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure thlcgcpu.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
var
r,tmpref: treference;

82
compiler/m68k/cgcpu.pas
View File

@ -84,7 +84,6 @@ unit cgcpu;
procedure g_restore_registers(list:TAsmList);override;
procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
{ # Sign or zero extend the register to a full 32-bit value.
The new value is left in the same register.
@ -1991,87 +1990,6 @@ unit cgcpu;
end;
procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure getselftoa0(offs:longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ move.l offset(%sp),%a0 }
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=sizeof(aint)
else
selfoffsetfromsp:=0;
reference_reset_base(href,NR_SP,selfoffsetfromsp+offs,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure loadvmttoa0;
var
href : treference;
begin
{ move.l (%a0),%a0 ; load vmt}
reference_reset_base(href,NR_A0,0,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure op_ona0methodaddr;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(2013100701);
reference_reset_base(href,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_A0));
reference_reset_base(href,NR_A0,0,4);
list.concat(taicpu.op_ref(A_JMP,S_NO,href));
end;
var
make_global : boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
getselftoa0(4);
loadvmttoa0;
op_ona0methodaddr;
end
{ case 0 }
else
list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(procdef.mangledname)));
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint);
begin
list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG));

104
compiler/m68k/hlcgcpu.pas
View File

@ -28,20 +28,116 @@ unit hlcgcpu;
interface
uses
aasmdata,
symdef,
hlcg2ll;
type
thlcgcpu = class(thlcg2ll)
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
end;
procedure create_hlcodegen;
implementation
uses
hlcgobj, hlcg2ll,
cgcpu;
globtype,verbose,
fmodule,
aasmbase,aasmtai,aasmcpu,
symconst,
hlcgobj,
cgbase, cgutils, cgobj, cpubase, cgcpu;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure getselftoa0(offs:longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ move.l offset(%sp),%a0 }
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=sizeof(aint)
else
selfoffsetfromsp:=0;
reference_reset_base(href, voidstackpointertype, NR_SP,selfoffsetfromsp+offs,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure loadvmttoa0;
var
href : treference;
begin
{ move.l (%a0),%a0 ; load vmt}
reference_reset_base(href, voidpointertype, NR_A0,0,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure op_ona0methodaddr;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(2013100701);
reference_reset_base(href,voidpointertype,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_A0));
reference_reset_base(href,voidpointertype,NR_A0,0,4);
list.concat(taicpu.op_ref(A_JMP,S_NO,href));
end;
var
make_global : boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
getselftoa0(4);
loadvmttoa0;
op_ona0methodaddr;
end
{ case 0 }
else
list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(procdef.mangledname)));
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcg2ll.create;
hlcg:=thlcgcpu.create;
create_codegen;
end;
begin
chlcgobj:=thlcg2ll;
chlcgobj:=thlcgcpu;
end.

129
compiler/mips/cgcpu.pas
View File

@ -85,8 +85,6 @@ type
procedure g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); override;
procedure g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); override;
procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
procedure g_profilecode(list: TAsmList);override;
end;
@ -1612,133 +1610,6 @@ begin
end;
procedure TCGMIPS.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global: boolean;
hsym: tsym;
href: treference;
paraloc: Pcgparalocation;
IsVirtual: boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions * [po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck] <> []) then
Internalerror(200006138);
if procdef.owner.symtabletype <> objectsymtable then
Internalerror(200109191);
make_global := False;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype = globalsymtable) then
make_global := True;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
else
List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
IsVirtual:=(po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct);
if (cs_create_pic in current_settings.moduleswitches) and
(not IsVirtual) then
begin
list.concat(Taicpu.op_none(A_P_SET_NOREORDER));
list.concat(Taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
list.concat(Taicpu.op_none(A_P_SET_REORDER));
end;
{ set param1 interface to self }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2010103101);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
if assigned(paraloc^.next) then
InternalError(2013020101);
case paraloc^.loc of
LOC_REGISTER:
begin
if ((ioffset>=simm16lo) and (ioffset<=simm16hi)) then
a_op_const_reg(list,OP_SUB, paraloc^.size,ioffset,paraloc^.register)
else
begin
a_load_const_reg(list, paraloc^.size, ioffset, NR_R1);
a_op_reg_reg(list, OP_SUB, paraloc^.size, NR_R1, paraloc^.register);
end;
end;
else
internalerror(2010103102);
end;
if IsVirtual then
begin
{ load VMT pointer }
reference_reset_base(href,paraloc^.register,0,sizeof(aint));
list.concat(taicpu.op_reg_ref(A_LW,NR_VMT,href));
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ TODO: case of large VMT is not handled }
{ We have no reason not to use $t9 even in non-PIC mode. }
reference_reset_base(href, NR_VMT, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint));
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR, NR_PIC_FUNC));
end
else if not (cs_create_pic in current_settings.moduleswitches) then
list.concat(taicpu.op_sym(A_J,current_asmdata.RefAsmSymbol(procdef.mangledname)))
else
begin
{ GAS does not expand "J symbol" into PIC sequence }
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
href.base:=NR_GP;
href.refaddr:=addr_pic_call16;
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
end;
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure TCGMIPS.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
var
href: treference;
begin
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(externalname),0,sizeof(aint));
{ Always do indirect jump using $t9, it won't harm in non-PIC mode }
if (cs_create_pic in current_settings.moduleswitches) then
begin
list.concat(taicpu.op_none(A_P_SET_NOREORDER));
list.concat(taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
href.base:=NR_GP;
href.refaddr:=addr_pic_call16;
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
{ Delay slot }
list.Concat(taicpu.op_none(A_NOP));
list.Concat(taicpu.op_none(A_P_SET_REORDER));
end
else
begin
href.refaddr:=addr_high;
list.concat(taicpu.op_reg_ref(A_LUI,NR_PIC_FUNC,href));
href.refaddr:=addr_low;
list.concat(taicpu.op_reg_ref(A_ADDIU,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
{ Delay slot }
list.Concat(taicpu.op_none(A_NOP));
end;
end;
procedure TCGMIPS.g_profilecode(list:TAsmList);
var
href: treference;

141
compiler/mips/hlcgcpu.pas
View File

@ -32,7 +32,7 @@ uses
globtype,
aasmbase, aasmdata,
cgbase, cgutils,
symconst,symtype,symdef,
symtype,symdef,
parabase, hlcgobj, hlcg2ll;
type
@ -41,6 +41,9 @@ uses
procedure a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);override;
protected
procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
public
procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
end;
procedure create_hlcodegen;
@ -48,12 +51,11 @@ uses
implementation
uses
verbose,
aasmtai,
aasmcpu,
verbose,globals,
fmodule,
aasmtai,aasmcpu,
cutils,
globals,
defutil,
symconst,symsym,defutil,
cgobj,
cpubase,
cpuinfo,
@ -146,6 +148,133 @@ implementation
end;
procedure thlcgmips.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
var
href: treference;
begin
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(externalname),0,sizeof(aint));
{ Always do indirect jump using $t9, it won't harm in non-PIC mode }
if (cs_create_pic in current_settings.moduleswitches) then
begin
list.concat(taicpu.op_none(A_P_SET_NOREORDER));
list.concat(taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
href.base:=NR_GP;
href.refaddr:=addr_pic_call16;
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
{ Delay slot }
list.Concat(taicpu.op_none(A_NOP));
list.Concat(taicpu.op_none(A_P_SET_REORDER));
end
else
begin
href.refaddr:=addr_high;
list.concat(taicpu.op_reg_ref(A_LUI,NR_PIC_FUNC,href));
href.refaddr:=addr_low;
list.concat(taicpu.op_reg_ref(A_ADDIU,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
{ Delay slot }
list.Concat(taicpu.op_none(A_NOP));
end;
end;
procedure thlcgmips.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global: boolean;
hsym: tsym;
href: treference;
paraloc: Pcgparalocation;
IsVirtual: boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions * [po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck] <> []) then
Internalerror(200006138);
if procdef.owner.symtabletype <> objectsymtable then
Internalerror(200109191);
make_global := False;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype = globalsymtable) then
make_global := True;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
else
List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
IsVirtual:=(po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct);
if (cs_create_pic in current_settings.moduleswitches) and
(not IsVirtual) then
begin
list.concat(Taicpu.op_none(A_P_SET_NOREORDER));
list.concat(Taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
list.concat(Taicpu.op_none(A_P_SET_REORDER));
end;
{ set param1 interface to self }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2010103101);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
if assigned(paraloc^.next) then
InternalError(2013020101);
case paraloc^.loc of
LOC_REGISTER:
begin
if ((ioffset>=simm16lo) and (ioffset<=simm16hi)) then
cg.a_op_const_reg(list,OP_SUB, paraloc^.size,ioffset,paraloc^.register)
else
begin
cg.a_load_const_reg(list, paraloc^.size, ioffset, NR_R1);
cg.a_op_reg_reg(list, OP_SUB, paraloc^.size, NR_R1, paraloc^.register);
end;
end;
else
internalerror(2010103102);
end;
if IsVirtual then
begin
{ load VMT pointer }
reference_reset_base(href,voidpointertype,paraloc^.register,0,sizeof(aint));
list.concat(taicpu.op_reg_ref(A_LW,NR_VMT,href));
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ TODO: case of large VMT is not handled }
{ We have no reason not to use $t9 even in non-PIC mode. }
reference_reset_base(href, voidpointertype, NR_VMT, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint));
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR, NR_PIC_FUNC));
end
else if not (cs_create_pic in current_settings.moduleswitches) then
list.concat(taicpu.op_sym(A_J,current_asmdata.RefAsmSymbol(procdef.mangledname)))
else
begin
{ GAS does not expand "J symbol" into PIC sequence }
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
href.base:=NR_GP;
href.refaddr:=addr_pic_call16;
list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
end;
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcgmips.create;

2
compiler/ncgutil.pas
View File

@ -1484,7 +1484,7 @@ implementation
else
list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
cg.g_external_wrapper(list,pd,externalname);
hlcg.g_external_wrapper(list,pd,externalname);
destroy_hlcodegen;
end;

4
compiler/ncgvmt.pas
View File

@ -753,7 +753,7 @@ implementation
sym:=current_asmdata.DefineAsmSymbol(pd.mangledname,AB_LOCAL,AT_FUNCTION);
list.concat(Tai_symbol.Create(sym,0));
end;
cg.g_external_wrapper(list,pd,'FPC_ABSTRACTERROR');
hlcg.g_external_wrapper(list,pd,'FPC_ABSTRACTERROR');
list.concat(Tai_symbol_end.Create(sym));
end;
@ -963,7 +963,7 @@ implementation
{ create wrapper code }
new_section(list,sec_code,tmps,target_info.alignment.procalign);
hlcg.init_register_allocators;
cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
hlcg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
hlcg.done_register_allocators;
end;
end;

160
compiler/ppcgen/cgppc.pas
View File

@ -58,17 +58,20 @@ unit cgppc;
procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_maybe_got_init(list: TAsmList); override;
procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
{ returns true if the offset of the given reference can not be }
{ represented by a 16 bit immediate as required by some PowerPC }
{ instructions }
function hasLargeOffset(const ref : TReference) : Boolean; inline;
function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
protected
function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister; override;
function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
{ Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). }
{ Returns true if the reference contained a base, index and an }
@ -84,11 +87,6 @@ unit cgppc;
procedure a_jmp(list: TAsmList; op: tasmop;
c: tasmcondflag; crval: longint; l: tasmlabel);
{ returns true if the offset of the given reference can not be }
{ represented by a 16 bit immediate as required by some PowerPC }
{ instructions }
function hasLargeOffset(const ref : TReference) : Boolean; inline;
function save_lr_in_prologue: boolean;
function load_got_symbol(list : TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
@ -685,101 +683,7 @@ unit cgppc;
procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure loadvmttor11;
var
href : treference;
begin
reference_reset_base(href,NR_R3,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
end;
procedure op_onr11methodaddr;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
if hasLargeOffset(href) then
begin
{$ifdef cpu64}
if (longint(href.offset) <> href.offset) then
{ add support for offsets > 32 bit }
internalerror(200510201);
{$endif cpu64}
list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
href.offset := smallint(href.offset and $ffff);
end;
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
begin
reference_reset_base(href, NR_R11, 0, sizeof(pint));
a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
end;
list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
list.concat(taicpu.op_none(A_BCTR));
if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
list.concat(taicpu.op_none(A_NOP));
end;
var
make_global : boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
loadvmttor11;
op_onr11methodaddr;
end
{ case 0 }
else
case target_info.system of
system_powerpc_darwin,
system_powerpc64_darwin:
list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
system_powerpc64_linux,
system_powerpc_aix,
system_powerpc64_aix:
{$note ts:todo add GOT change?? - think not needed :) }
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
else
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
var
l: tasmsymbol;
ref: treference;
@ -944,56 +848,6 @@ unit cgppc;
end;
procedure tcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
var
href : treference;
begin
if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
inherited;
exit;
end;
{ for ppc64/linux and aix emit correct code which sets up a stack frame
and then calls the external method normally to ensure that the GOT/TOC
will be loaded correctly if required.
The resulting code sequence looks as follows:
mflr r0
stw/d r0, 16(r1)
stw/du r1, -112(r1)
bl <external_method>
nop
addi r1, r1, 112
lwz/d r0, 16(r1)
mtlr r0
blr
}
list.concat(taicpu.op_reg(A_MFLR, NR_R0));
if target_info.abi=abi_powerpc_sysv then
reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
else
reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
a_call_name(list,externalname,false);
list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
if target_info.abi=abi_powerpc_sysv then
reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
else
reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg(A_MTLR, NR_R0));
list.concat(taicpu.op_none(A_BLR));
end;
procedure tcgppcgen.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
var
testbit: byte;

155
compiler/ppcgen/hlcgppc.pas
View File

@ -29,20 +29,27 @@ interface
uses
aasmdata,
symtype,
symtype,symdef,
cgbase,cgutils,hlcgobj,hlcg2ll;
type
thlcgppcgen = class(thlcg2ll)
protected
procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
public
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
end;
implementation
uses
verbose,
systems,fmodule,
symconst,
aasmbase,aasmtai,aasmcpu,
cpubase,globtype,
symdef,defutil;
defutil,cgobj,cgppc;
{ thlcgppc }
@ -80,5 +87,149 @@ implementation
a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
end;
procedure thlcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
procedure loadvmttor11;
var
href : treference;
begin
reference_reset_base(href,voidpointertype,NR_R3,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
end;
procedure op_onr11methodaddr;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%eax) ; method offs }
reference_reset_base(href,voidpointertype,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
if tcgppcgen(cg).hasLargeOffset(href) then
begin
{$ifdef cpu64}
if (longint(href.offset) <> href.offset) then
{ add support for offsets > 32 bit }
internalerror(200510201);
{$endif cpu64}
list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
href.offset := smallint(href.offset and $ffff);
end;
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
begin
reference_reset_base(href, voidpointertype, NR_R11, 0, sizeof(pint));
cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
end;
list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
list.concat(taicpu.op_none(A_BCTR));
if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
list.concat(taicpu.op_none(A_NOP));
end;
var
make_global : boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
loadvmttor11;
op_onr11methodaddr;
end
{ case 0 }
else
case target_info.system of
system_powerpc_darwin,
system_powerpc64_darwin:
list.concat(taicpu.op_sym(A_B,tcgppcgen(cg).get_darwin_call_stub(procdef.mangledname,false)));
system_powerpc64_linux,
system_powerpc_aix,
system_powerpc64_aix:
{$note ts:todo add GOT change?? - think not needed :) }
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
else
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure thlcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
var
href : treference;
begin
if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
inherited;
exit;
end;
{ for ppc64/linux and aix emit correct code which sets up a stack frame
and then calls the external method normally to ensure that the GOT/TOC
will be loaded correctly if required.
The resulting code sequence looks as follows:
mflr r0
stw/d r0, 16(r1)
stw/du r1, -112(r1)
bl <external_method>
nop
addi r1, r1, 112
lwz/d r0, 16(r1)
mtlr r0
blr
}
list.concat(taicpu.op_reg(A_MFLR, NR_R0));
if target_info.abi=abi_powerpc_sysv then
reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
else
reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
cg.a_call_name(list,externalname,false);
list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
if target_info.abi=abi_powerpc_sysv then
reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
else
reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
list.concat(taicpu.op_reg(A_MTLR, NR_R0));
list.concat(taicpu.op_none(A_BLR));
end;
end.

83
compiler/sparc/cgcpu.pas
View File

@ -88,8 +88,6 @@ interface
procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);override;
procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
private
use_unlimited_pic_mode : boolean;
end;
@ -1278,87 +1276,6 @@ implementation
end;
procedure tcgsparc.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global : boolean;
href : treference;
hsym : tsym;
paraloc : pcgparalocation;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2010103101);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
if assigned(paraloc^.next) then
InternalError(2013020101);
case paraloc^.loc of
LOC_REGISTER:
begin
if ((ioffset>=simm13lo) and (ioffset<=simm13hi)) then
a_op_const_reg(list,OP_SUB,paraloc^.size,ioffset,paraloc^.register)
else
begin
a_load_const_reg(list,paraloc^.size,ioffset,NR_G1);
a_op_reg_reg(list,OP_SUB,paraloc^.size,NR_G1,paraloc^.register);
end;
end;
else
internalerror(2010103102);
end;
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ mov 0(%rdi),%rax ; load vmt}
reference_reset_base(href,paraloc^.register,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
{ jmp *vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
list.concat(taicpu.op_reg(A_JMP,NR_G1));
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
g_external_wrapper(list,procdef,procdef.mangledname);
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure tcgsparc.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
begin
{ CALL overwrites %o7 with its own address, we use delay slot to restore it. }
list.concat(taicpu.op_reg_reg(A_MOV,NR_O7,NR_G1));
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(externalname)));
list.concat(taicpu.op_reg_reg(A_MOV,NR_G1,NR_O7));
end;
{****************************************************************************
TCG64Sparc
****************************************************************************}

104
compiler/sparc/hlcgcpu.pas
View File

@ -28,20 +28,116 @@ unit hlcgcpu;
interface
uses
aasmdata,
symdef,
hlcg2ll;
type
thlcgcpu = class(thlcg2ll)
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
end;
procedure create_hlcodegen;
implementation
uses
hlcgobj, hlcg2ll,
cgcpu;
verbose,globtype,fmodule,
aasmbase,aasmtai,aasmcpu,
parabase,
symconst,symtype,symsym,
cgbase,cgutils,cgobj,hlcgobj,cpubase,cgcpu;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global : boolean;
href : treference;
hsym : tsym;
paraloc : pcgparalocation;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2010103101);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
if assigned(paraloc^.next) then
InternalError(2013020101);
case paraloc^.loc of
LOC_REGISTER:
begin
if ((ioffset>=simm13lo) and (ioffset<=simm13hi)) then
cg.a_op_const_reg(list,OP_SUB,paraloc^.size,ioffset,paraloc^.register)
else
begin
cg.a_load_const_reg(list,paraloc^.size,ioffset,NR_G1);
cg.a_op_reg_reg(list,OP_SUB,paraloc^.size,NR_G1,paraloc^.register);
end;
end;
else
internalerror(2010103102);
end;
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ mov 0(%rdi),%rax ; load vmt}
reference_reset_base(href,voidpointertype,paraloc^.register,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
{ jmp *vmtoffs(%eax) ; method offs }
reference_reset_base(href,voidpointertype,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
list.concat(taicpu.op_reg(A_JMP,NR_G1));
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
g_external_wrapper(list,procdef,procdef.mangledname);
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure thlcgcpu.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
begin
{ CALL overwrites %o7 with its own address, we use delay slot to restore it. }
list.concat(taicpu.op_reg_reg(A_MOV,NR_O7,NR_G1));
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(externalname)));
list.concat(taicpu.op_reg_reg(A_MOV,NR_G1,NR_O7));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcg2ll.create;
hlcg:=thlcgcpu.create;
create_codegen;
end;
begin
chlcgobj:=thlcg2ll;
chlcgobj:=thlcgcpu;
end.

30
compiler/x86/cgx86.pas
View File

@ -125,9 +125,9 @@ unit cgx86;
procedure g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef);override;
procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
procedure make_simple_ref(list:TAsmList;var ref: treference);
function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
protected
procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
procedure check_register_size(size:tcgsize;reg:tregister);
@ -135,7 +135,6 @@ unit cgx86;
procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
procedure opmm_loc_reg_reg(list : TAsmList;Op : TOpCG;size : tcgsize;loc : tlocation;src,dst : tregister;shuffle : pmmshuffle);
function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
procedure floatload(list: TAsmList; t : tcgsize;const ref : treference);
@ -3025,29 +3024,4 @@ unit cgx86;
a_label(list,hl);
end;
procedure tcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
var
ref : treference;
sym : tasmsymbol;
begin
if (target_info.system = system_i386_darwin) then
begin
{ a_jmp_name jumps to a stub which is always pic-safe on darwin }
inherited g_external_wrapper(list,procdef,externalname);
exit;
end;
sym:=current_asmdata.RefAsmSymbol(externalname);
reference_reset_symbol(ref,sym,0,sizeof(pint));
{ create pic'ed? }
if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols }
not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then
ref.refaddr:=addr_pic
else
ref.refaddr:=addr_full;
list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
end;
end.

32
compiler/x86/hlcgx86.pas
View File

@ -41,12 +41,16 @@ interface
thlcgx86 = class(thlcg2ll)
protected
procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
public
procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
end;
implementation
uses
cgbase,
globtype,globals,systems,
aasmbase,
cgbase,cgutils,
cpubase,aasmcpu;
{ thlcgx86 }
@ -59,4 +63,30 @@ implementation
list.concat(taicpu.op_none(A_FLDZ));
end;
procedure thlcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
var
ref : treference;
sym : tasmsymbol;
begin
if (target_info.system = system_i386_darwin) then
begin
{ a_jmp_name jumps to a stub which is always pic-safe on darwin }
inherited g_external_wrapper(list,procdef,externalname);
exit;
end;
sym:=current_asmdata.RefAsmSymbol(externalname);
reference_reset_symbol(ref,sym,0,sizeof(pint));
{ create pic'ed? }
if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols }
not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then
ref.refaddr:=addr_pic
else
ref.refaddr:=addr_full;
list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
end;
end.

63
compiler/x86_64/cgcpu.pas
View File

@ -38,7 +38,6 @@ unit cgcpu;
procedure g_proc_entry(list : TAsmList;localsize:longint; nostackframe:boolean);override;
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
procedure g_save_registers(list: TAsmList);override;
procedure g_restore_registers(list: TAsmList);override;
@ -402,68 +401,6 @@ unit cgcpu;
end;
procedure tcgx86_64.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global : boolean;
href : treference;
sym : tasmsymbol;
r : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ load vmt from first paramter }
{ win64 uses a different abi }
if target_info.system=system_x86_64_win64 then
reference_reset_base(href,NR_RCX,0,sizeof(pint))
else
reference_reset_base(href,NR_RDI,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
{ jmp *vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
list.concat(taicpu.op_ref(A_JMP,S_Q,href));
end
else
begin
sym:=current_asmdata.RefAsmSymbol(procdef.mangledname);
reference_reset_symbol(r,sym,0,sizeof(pint));
if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols }
(target_info.system<>system_x86_64_darwin) then
r.refaddr:=addr_pic
else
r.refaddr:=addr_full;
list.concat(taicpu.op_ref(A_JMP,S_NO,r));
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure tcgx86_64.g_local_unwind(list: TAsmList; l: TAsmLabel);
var
para1,para2: tcgpara;

85
compiler/x86_64/hlcgcpu.pas
View File

@ -28,20 +28,97 @@ unit hlcgcpu;
interface
uses
aasmdata,
symdef,
hlcgx86;
type
thlcgcpu = class(thlcgx86)
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
end;
procedure create_hlcodegen;
implementation
uses
hlcgobj, hlcgx86,
cgcpu;
globtype,globals,verbose,
fmodule,systems,
aasmbase,aasmtai,aasmcpu,
symconst,
hlcgobj,
cgbase,cgutils,cgobj,cpubase,cgcpu;
procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global : boolean;
href : treference;
sym : tasmsymbol;
r : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ load vmt from first paramter }
{ win64 uses a different abi }
if target_info.system=system_x86_64_win64 then
reference_reset_base(href,voidpointertype,NR_RCX,0,sizeof(pint))
else
reference_reset_base(href,voidpointertype,NR_RDI,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
{ jmp *vmtoffs(%eax) ; method offs }
reference_reset_base(href,voidpointertype,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
list.concat(taicpu.op_ref(A_JMP,S_Q,href));
end
else
begin
sym:=current_asmdata.RefAsmSymbol(procdef.mangledname);
reference_reset_symbol(r,sym,0,sizeof(pint));
if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols }
(target_info.system<>system_x86_64_darwin) then
r.refaddr:=addr_pic
else
r.refaddr:=addr_full;
list.concat(taicpu.op_ref(A_JMP,S_NO,r));
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure create_hlcodegen;
begin
hlcg:=thlcgx86.create;
hlcg:=thlcgcpu.create;
create_codegen;
end;
begin
chlcgobj:=thlcgx86;
chlcgobj:=thlcgcpu;
end.