diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas index a41aef9a0b..5410ae28ca 100644 --- a/compiler/arm/cgcpu.pas +++ b/compiler/arm/cgcpu.pas @@ -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]; diff --git a/compiler/arm/hlcgcpu.pas b/compiler/arm/hlcgcpu.pas index c7e79f1ffc..11e81bbf58 100644 --- a/compiler/arm/hlcgcpu.pas +++ b/compiler/arm/hlcgcpu.pas @@ -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. diff --git a/compiler/avr/cgcpu.pas b/compiler/avr/cgcpu.pas index 7e0fe18a09..f793e7ec50 100644 --- a/compiler/avr/cgcpu.pas +++ b/compiler/avr/cgcpu.pas @@ -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; diff --git a/compiler/avr/hlcgcpu.pas b/compiler/avr/hlcgcpu.pas index c7e79f1ffc..e69388e2a8 100644 --- a/compiler/avr/hlcgcpu.pas +++ b/compiler/avr/hlcgcpu.pas @@ -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. diff --git a/compiler/cghlcpu.pas b/compiler/cghlcpu.pas index 1075eee27d..291ceed705 100644 --- a/compiler/cghlcpu.pas +++ b/compiler/cghlcpu.pas @@ -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); diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 2722dce580..b4b1d12914 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -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); diff --git a/compiler/expunix.pas b/compiler/expunix.pas index 06e95c7b7d..9b874d7489 100644 --- a/compiler/expunix.pas +++ b/compiler/expunix.pas @@ -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^); diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas index f72c3d8b24..32ac53b246 100644 --- a/compiler/hlcg2ll.pas +++ b/compiler/hlcg2ll.pas @@ -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); diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index 8c58963206..178dc8b72a 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -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 diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas index 272f8427b4..ba27f5c559 100644 --- a/compiler/i386/cgcpu.pas +++ b/compiler/i386/cgcpu.pas @@ -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); diff --git a/compiler/i386/hlcgcpu.pas b/compiler/i386/hlcgcpu.pas index 6d702741e5..15d495dd8b 100644 --- a/compiler/i386/hlcgcpu.pas +++ b/compiler/i386/hlcgcpu.pas @@ -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; diff --git a/compiler/i8086/cgcpu.pas b/compiler/i8086/cgcpu.pas index 3c588cf291..fbde0e304b 100644 --- a/compiler/i8086/cgcpu.pas +++ b/compiler/i8086/cgcpu.pas @@ -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); diff --git a/compiler/i8086/hlcgcpu.pas b/compiler/i8086/hlcgcpu.pas index d4d803ed80..fa29c382a1 100644 --- a/compiler/i8086/hlcgcpu.pas +++ b/compiler/i8086/hlcgcpu.pas @@ -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; diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 1edd342d3d..fd68eda64c 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -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)); diff --git a/compiler/m68k/hlcgcpu.pas b/compiler/m68k/hlcgcpu.pas index c7e79f1ffc..5a6f60b6e1 100644 --- a/compiler/m68k/hlcgcpu.pas +++ b/compiler/m68k/hlcgcpu.pas @@ -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. diff --git a/compiler/mips/cgcpu.pas b/compiler/mips/cgcpu.pas index 8bf8d47db3..9cfee050f5 100644 --- a/compiler/mips/cgcpu.pas +++ b/compiler/mips/cgcpu.pas @@ -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; diff --git a/compiler/mips/hlcgcpu.pas b/compiler/mips/hlcgcpu.pas index 44adae6ed3..0f680021a7 100644 --- a/compiler/mips/hlcgcpu.pas +++ b/compiler/mips/hlcgcpu.pas @@ -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; diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 329c656dbf..692ca622da 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -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; diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas index 792bc7f2fb..f4d408b910 100644 --- a/compiler/ncgvmt.pas +++ b/compiler/ncgvmt.pas @@ -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; diff --git a/compiler/ppcgen/cgppc.pas b/compiler/ppcgen/cgppc.pas index 5a5c11be3c..e357ab6f40 100644 --- a/compiler/ppcgen/cgppc.pas +++ b/compiler/ppcgen/cgppc.pas @@ -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 - 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; diff --git a/compiler/ppcgen/hlcgppc.pas b/compiler/ppcgen/hlcgppc.pas index 872ac64902..cbac5c4dc0 100644 --- a/compiler/ppcgen/hlcgppc.pas +++ b/compiler/ppcgen/hlcgppc.pas @@ -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 + 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. diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index ba3ac18a6d..740605b104 100644 --- a/compiler/sparc/cgcpu.pas +++ b/compiler/sparc/cgcpu.pas @@ -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 ****************************************************************************} diff --git a/compiler/sparc/hlcgcpu.pas b/compiler/sparc/hlcgcpu.pas index c7e79f1ffc..bbe645c01d 100644 --- a/compiler/sparc/hlcgcpu.pas +++ b/compiler/sparc/hlcgcpu.pas @@ -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. diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index f36e9cf3ac..e277ccabd0 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -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. diff --git a/compiler/x86/hlcgx86.pas b/compiler/x86/hlcgx86.pas index 93608ad354..7d682c6d5b 100644 --- a/compiler/x86/hlcgx86.pas +++ b/compiler/x86/hlcgx86.pas @@ -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. diff --git a/compiler/x86_64/cgcpu.pas b/compiler/x86_64/cgcpu.pas index 3f1dce9a6b..770a7efe0f 100644 --- a/compiler/x86_64/cgcpu.pas +++ b/compiler/x86_64/cgcpu.pas @@ -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; diff --git a/compiler/x86_64/hlcgcpu.pas b/compiler/x86_64/hlcgcpu.pas index 67fc22aa98..ccfd6ca2f7 100644 --- a/compiler/x86_64/hlcgcpu.pas +++ b/compiler/x86_64/hlcgcpu.pas @@ -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.