{ Copyright (c) 1998-2005 by Florian Klaempfl This unit implements the common parts of the code generator for the i386 and the x86-64. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } { This unit implements the common parts of the code generator for the i386 and the x86-64. } unit cgx86; {$i fpcdefs.inc} interface uses globtype, cgbase,cgutils,cgobj, aasmbase,aasmtai,aasmdata,aasmcpu, cpubase,cpuinfo,rgobj,rgx86,rgcpu, symconst,symtype,symdef; type tcgx86 = class(tcg) rgfpu : Trgx86fpu; procedure done_register_allocators;override; function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override; function getmmxregister(list:TAsmList):Tregister; function getmmregister(list:TAsmList;size:Tcgsize):Tregister;override; procedure getcpuregister(list:TAsmList;r:Tregister);override; procedure ungetcpuregister(list:TAsmList;r:Tregister);override; procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);override; procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);override; function uses_registers(rt:Tregistertype):boolean;override; procedure add_reg_instruction(instr:Tai;r:tregister);override; procedure dec_fpu_stack; procedure inc_fpu_stack; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; procedure a_call_name_near(list : TAsmList;const s : string; weak: boolean); procedure a_call_name_static(list : TAsmList;const s : string);override; procedure a_call_name_static_near(list : TAsmList;const s : string); procedure a_call_reg(list : TAsmList;reg : tregister);override; procedure a_call_ref(list : TAsmList;ref : treference);override; procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override; procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override; procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override; procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override; { move instructions } procedure a_load_const_reg(list : TAsmList; tosize: tcgsize; a : tcgint;reg : tregister);override; procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override; procedure a_load_reg_ref(list : TAsmList;fromsize,tosize: tcgsize; reg : tregister;const ref : treference);override; procedure a_load_ref_reg(list : TAsmList;fromsize,tosize: tcgsize;const ref : treference;reg : tregister);override; procedure a_load_reg_reg(list : TAsmList;fromsize,tosize: tcgsize;reg1,reg2 : tregister);override; procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; { bit scan instructions } procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; { fpu move instructions } procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; { vector register move instructions } 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; procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle);override; { comparison operations } procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override; procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel);override; procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; procedure a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override; procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); override; procedure a_jmp_name(list : TAsmList;const s : string);override; procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override; procedure g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref: TReference); override; procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; { entry/exit code helpers } procedure g_profilecode(list : TAsmList);override; procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; 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); protected procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); procedure check_register_size(size:tcgsize;reg:tregister); procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle); function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; private procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize); procedure floatload(list: TAsmList; t : tcgsize;const ref : treference); procedure floatstore(list: TAsmList; t : tcgsize;const ref : treference); procedure floatloadops(t : tcgsize;var op : tasmop;var s : topsize); procedure floatstoreops(t : tcgsize;var op : tasmop;var s : topsize); end; const {$if defined(x86_64)} TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_Q,S_XMM,S_B,S_W,S_L,S_Q,S_XMM, S_FS,S_FL,S_FX,S_IQ,S_FXX, S_NO,S_NO,S_NO,S_MD,S_XMM,S_YMM, S_NO,S_NO,S_NO,S_NO,S_XMM,S_YMM); {$elseif defined(i386)} TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_L,S_T,S_B,S_W,S_L,S_L,S_L, S_FS,S_FL,S_FX,S_IQ,S_FXX, S_NO,S_NO,S_NO,S_MD,S_XMM,S_YMM, S_NO,S_NO,S_NO,S_NO,S_XMM,S_YMM); {$elseif defined(i8086)} TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_W,S_W,S_T,S_B,S_W,S_W,S_W,S_W, S_FS,S_FL,S_FX,S_IQ,S_FXX, S_NO,S_NO,S_NO,S_MD,S_XMM,S_YMM, S_NO,S_NO,S_NO,S_NO,S_XMM,S_YMM); {$endif} {$ifndef NOTARGETWIN} winstackpagesize = 4096; {$endif NOTARGETWIN} function UseAVX: boolean; implementation uses globals,verbose,systems,cutils, defutil,paramgr,procinfo, tgobj,ncgutil, fmodule,symsym; function UseAVX: boolean; begin Result:=current_settings.fputype in [fpu_avx]; end; const TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_MOV,A_ADD,A_AND,A_DIV, A_IDIV,A_IMUL,A_MUL,A_NEG,A_NOT,A_OR, A_SAR,A_SHL,A_SHR,A_SUB,A_XOR,A_ROL,A_ROR); TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE, C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A); procedure Tcgx86.done_register_allocators; begin rg[R_INTREGISTER].free; rg[R_MMREGISTER].free; rg[R_MMXREGISTER].free; rgfpu.free; inherited done_register_allocators; end; function Tcgx86.getfpuregister(list:TAsmList;size:Tcgsize):Tregister; begin result:=rgfpu.getregisterfpu(list); end; function Tcgx86.getmmxregister(list:TAsmList):Tregister; begin if not assigned(rg[R_MMXREGISTER]) then internalerror(2003121214); result:=rg[R_MMXREGISTER].getregister(list,R_SUBNONE); end; function Tcgx86.getmmregister(list:TAsmList;size:Tcgsize):Tregister; begin if not assigned(rg[R_MMREGISTER]) then internalerror(2003121234); case size of OS_F64: result:=rg[R_MMREGISTER].getregister(list,R_SUBMMD); OS_F32: result:=rg[R_MMREGISTER].getregister(list,R_SUBMMS); OS_M64: result:=rg[R_MMREGISTER].getregister(list,R_SUBQ); OS_M128: result:=rg[R_MMREGISTER].getregister(list,R_SUBMMWHOLE); else internalerror(200506041); end; end; procedure Tcgx86.getcpuregister(list:TAsmList;r:Tregister); begin if getregtype(r)=R_FPUREGISTER then internalerror(2003121210) else inherited getcpuregister(list,r); end; procedure tcgx86.ungetcpuregister(list:TAsmList;r:Tregister); begin if getregtype(r)=R_FPUREGISTER then rgfpu.ungetregisterfpu(list,r) else inherited ungetcpuregister(list,r); end; procedure Tcgx86.alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); begin if rt<>R_FPUREGISTER then inherited alloccpuregisters(list,rt,r); end; procedure Tcgx86.dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); begin if rt<>R_FPUREGISTER then inherited dealloccpuregisters(list,rt,r); end; function Tcgx86.uses_registers(rt:Tregistertype):boolean; begin if rt=R_FPUREGISTER then result:=false else result:=inherited uses_registers(rt); end; procedure tcgx86.add_reg_instruction(instr:Tai;r:tregister); begin if getregtype(r)<>R_FPUREGISTER then inherited add_reg_instruction(instr,r); end; procedure tcgx86.dec_fpu_stack; begin if rgfpu.fpuvaroffset<=0 then internalerror(200604201); dec(rgfpu.fpuvaroffset); end; procedure tcgx86.inc_fpu_stack; begin if rgfpu.fpuvaroffset>=7 then internalerror(2012062901); inc(rgfpu.fpuvaroffset); end; {**************************************************************************** This is private property, keep out! :) ****************************************************************************} procedure tcgx86.sizes2load(s1,s2 : tcgsize; var op: tasmop; var s3: topsize); begin { ensure to have always valid sizes } if s1=OS_NO then s1:=s2; if s2=OS_NO then s2:=s1; case s2 of OS_8,OS_S8 : if S1 in [OS_8,OS_S8] then s3 := S_B else internalerror(200109221); OS_16,OS_S16: case s1 of OS_8,OS_S8: s3 := S_BW; OS_16,OS_S16: s3 := S_W; else internalerror(200109222); end; OS_32,OS_S32: case s1 of OS_8,OS_S8: s3 := S_BL; OS_16,OS_S16: s3 := S_WL; OS_32,OS_S32: s3 := S_L; else internalerror(200109223); end; {$ifdef x86_64} OS_64,OS_S64: case s1 of OS_8: s3 := S_BL; OS_S8: s3 := S_BQ; OS_16: s3 := S_WL; OS_S16: s3 := S_WQ; OS_32: s3 := S_L; OS_S32: s3 := S_LQ; OS_64,OS_S64: s3 := S_Q; else internalerror(200304302); end; {$endif x86_64} else internalerror(200109227); end; if s3 in [S_B,S_W,S_L,S_Q] then op := A_MOV else if s1 in [OS_8,OS_16,OS_32,OS_64] then op := A_MOVZX else {$ifdef x86_64} if s3 in [S_LQ] then op := A_MOVSXD else {$endif x86_64} op := A_MOVSX; end; procedure tcgx86.make_simple_ref(list:TAsmList;var ref: treference); var hreg : tregister; href : treference; {$ifndef x86_64} add_hreg: boolean; {$endif not x86_64} begin { make_simple_ref() may have already been called earlier, and in that case make sure we don't perform the PIC-simplifications twice } if (ref.refaddr in [addr_pic,addr_pic_no_got]) then exit; {$if defined(x86_64)} { Only 32bit is allowed } { Note that this isn't entirely correct: for RIP-relative targets/memory models, it is actually (offset+@symbol-RIP) that should fit into 32 bits. Since two last members aren't known until link time, ABIs place very pessimistic limits on offset values, e.g. SysV AMD64 allows +/-$1000000 (16 megabytes) } if ((ref.offsethigh(longint))) or { absolute address is not a common thing in x64, but nevertheless a possible one } ((ref.base=NR_NO) and (ref.index=NR_NO) and (ref.symbol=nil)) then begin { Load constant value to register } hreg:=GetAddressRegister(list); list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg)); ref.offset:=0; {if assigned(ref.symbol) then begin list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_Q,ref.symbol,0,hreg)); ref.symbol:=nil; end;} { Add register to reference } if ref.base=NR_NO then ref.base:=hreg else if ref.index=NR_NO then ref.index:=hreg else begin { don't use add, as the flags may contain a value } reference_reset_base(href,ref.base,0,8); href.index:=hreg; if ref.scalefactor<>0 then begin reference_reset_base(href,ref.base,0,8); href.index:=hreg; list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); ref.base:=hreg; end else begin reference_reset_base(href,ref.index,0,8); href.index:=hreg; list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.index,hreg)); ref.index:=hreg; end; end; end; if assigned(ref.symbol) then begin if cs_create_pic in current_settings.moduleswitches then begin { Local symbols must not be accessed via the GOT } if (ref.symbol.bind=AB_LOCAL) then begin { unfortunately, RIP-based addresses don't support an index } if (ref.base<>NR_NO) or (ref.index<>NR_NO) then begin reference_reset_symbol(href,ref.symbol,0,ref.alignment); hreg:=getaddressregister(list); href.refaddr:=addr_pic_no_got; href.base:=NR_RIP; list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); ref.symbol:=nil; end else begin ref.refaddr:=addr_pic_no_got; hreg:=NR_NO; ref.base:=NR_RIP; end; end else begin reference_reset_symbol(href,ref.symbol,0,ref.alignment); hreg:=getaddressregister(list); href.refaddr:=addr_pic; href.base:=NR_RIP; list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,hreg)); ref.symbol:=nil; end; if ref.base=NR_NO then ref.base:=hreg else if ref.index=NR_NO then begin ref.index:=hreg; ref.scalefactor:=1; end else begin { don't use add, as the flags may contain a value } reference_reset_base(href,ref.base,0,8); href.index:=hreg; list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); ref.base:=hreg; end; end else { Always use RIP relative symbol addressing for Windows and Darwin targets. } if (target_info.system in (systems_all_windows+[system_x86_64_darwin])) and (ref.base<>NR_RIP) then begin if (ref.refaddr=addr_no) and (ref.base=NR_NO) and (ref.index=NR_NO) then begin { Set RIP relative addressing for simple symbol references } ref.base:=NR_RIP; ref.refaddr:=addr_pic_no_got end else begin { Use temp register to load calculated 64-bit symbol address for complex references } reference_reset_symbol(href,ref.symbol,0,sizeof(pint)); href.base:=NR_RIP; href.refaddr:=addr_pic_no_got; hreg:=GetAddressRegister(list); list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); ref.symbol:=nil; if ref.base=NR_NO then ref.base:=hreg else if ref.index=NR_NO then begin ref.index:=hreg; ref.scalefactor:=0; end else begin { don't use add, as the flags may contain a value } reference_reset_base(href,ref.base,0,8); href.index:=hreg; list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); ref.base:=hreg; end; end; end; end; {$elseif defined(i386)} add_hreg:=false; if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then begin if assigned(ref.symbol) and not(assigned(ref.relsymbol)) and ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN]) or (cs_create_pic in current_settings.moduleswitches)) then begin if ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN] then begin hreg:=g_indirect_sym_load(list,ref.symbol.name,asmsym2indsymflags(ref.symbol)); ref.symbol:=nil; end else begin include(current_procinfo.flags,pi_needs_got); { make a copy of the got register, hreg can get modified } hreg:=cg.getaddressregister(list); a_load_reg_reg(list,OS_ADDR,OS_ADDR,current_procinfo.got,hreg); ref.relsymbol:=current_procinfo.CurrGOTLabel; end; add_hreg:=true end end else if (cs_create_pic in current_settings.moduleswitches) and assigned(ref.symbol) then begin reference_reset_symbol(href,ref.symbol,0,sizeof(pint)); href.base:=current_procinfo.got; href.refaddr:=addr_pic; include(current_procinfo.flags,pi_needs_got); hreg:=cg.getaddressregister(list); list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,hreg)); ref.symbol:=nil; add_hreg:=true; end; if add_hreg then begin if ref.base=NR_NO then ref.base:=hreg else if ref.index=NR_NO then begin ref.index:=hreg; ref.scalefactor:=1; end else begin { don't use add, as the flags may contain a value } reference_reset_base(href,ref.base,0,8); href.index:=hreg; list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); ref.base:=hreg; end; end; {$elseif defined(i8086)} { i8086 does not support stack relative addressing } if ref.base = NR_STACK_POINTER_REG then begin href:=ref; href.base:=getaddressregister(list); { let the register allocator find a suitable register for the reference } list.Concat(Taicpu.op_reg_reg(A_MOV, S_W, NR_SP, href.base)); ref:=href; end; { if there is a segment in an int register, move it to ES } if (ref.segment<>NR_NO) and (not is_segment_reg(ref.segment)) then begin list.concat(taicpu.op_reg(A_PUSH,S_W,ref.segment)); list.concat(taicpu.op_reg(A_POP,S_W,NR_ES)); ref.segment:=NR_ES; end; {$endif} end; procedure tcgx86.floatloadops(t : tcgsize;var op : tasmop;var s : topsize); begin case t of OS_F32 : begin op:=A_FLD; s:=S_FS; end; OS_F64 : begin op:=A_FLD; s:=S_FL; end; OS_F80 : begin op:=A_FLD; s:=S_FX; end; OS_C64 : begin op:=A_FILD; s:=S_IQ; end; else internalerror(200204043); end; end; procedure tcgx86.floatload(list: TAsmList; t : tcgsize;const ref : treference); var op : tasmop; s : topsize; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); floatloadops(t,op,s); list.concat(Taicpu.Op_ref(op,s,tmpref)); inc_fpu_stack; end; procedure tcgx86.floatstoreops(t : tcgsize;var op : tasmop;var s : topsize); begin case t of OS_F32 : begin op:=A_FSTP; s:=S_FS; end; OS_F64 : begin op:=A_FSTP; s:=S_FL; end; OS_F80 : begin op:=A_FSTP; s:=S_FX; end; OS_C64 : begin op:=A_FISTP; s:=S_IQ; end; else internalerror(200204042); end; end; procedure tcgx86.floatstore(list: TAsmList; t : tcgsize;const ref : treference); var op : tasmop; s : topsize; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); floatstoreops(t,op,s); list.concat(Taicpu.Op_ref(op,s,tmpref)); { storing non extended floats can cause a floating point overflow } if (t<>OS_F80) and (cs_fpu_fwait in current_settings.localswitches) then list.concat(Taicpu.Op_none(A_FWAIT,S_NO)); dec_fpu_stack; end; procedure tcgx86.check_register_size(size:tcgsize;reg:tregister); begin if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then internalerror(200306031); end; {**************************************************************************** Assembler code ****************************************************************************} procedure tcgx86.a_jmp_name(list : TAsmList;const s : string); var r: treference; begin if (target_info.system <> system_i386_darwin) then list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s))) else begin reference_reset_symbol(r,get_darwin_call_stub(s,false),0,sizeof(pint)); r.refaddr:=addr_full; list.concat(taicpu.op_ref(A_JMP,S_NO,r)); end; end; procedure tcgx86.a_jmp_always(list : TAsmList;l: tasmlabel); begin a_jmp_cond(list, OC_NONE, l); end; function tcgx86.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; var stubname: string; begin stubname := 'L'+s+'$stub'; result := current_asmdata.getasmsymbol(stubname); if assigned(result) then exit; if current_asmdata.asmlists[al_imports]=nil then current_asmdata.asmlists[al_imports]:=TAsmList.create; new_section(current_asmdata.asmlists[al_imports],sec_stub,'',0); result := current_asmdata.RefAsmSymbol(stubname); current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); { register as a weak symbol if necessary } if weak then current_asmdata.weakrefasmsymbol(s); current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); end; procedure tcgx86.a_call_name(list : TAsmList;const s : string; weak: boolean); begin a_call_name_near(list,s,weak); end; procedure tcgx86.a_call_name_near(list : TAsmList;const s : string; weak: boolean); var sym : tasmsymbol; r : treference; begin if (target_info.system <> system_i386_darwin) then begin if not(weak) then sym:=current_asmdata.RefAsmSymbol(s) else sym:=current_asmdata.WeakRefAsmSymbol(s); reference_reset_symbol(r,sym,0,sizeof(pint)); if (cs_create_pic in current_settings.moduleswitches) and { darwin's assembler doesn't want @PLT after call symbols } not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then begin {$ifdef i386} include(current_procinfo.flags,pi_needs_got); {$endif i386} r.refaddr:=addr_pic end else r.refaddr:=addr_full; end else begin reference_reset_symbol(r,get_darwin_call_stub(s,weak),0,sizeof(pint)); r.refaddr:=addr_full; end; list.concat(taicpu.op_ref(A_CALL,S_NO,r)); end; procedure tcgx86.a_call_name_static(list : TAsmList;const s : string); begin a_call_name_static_near(list,s); end; procedure tcgx86.a_call_name_static_near(list : TAsmList;const s : string); var sym : tasmsymbol; r : treference; begin sym:=current_asmdata.RefAsmSymbol(s); reference_reset_symbol(r,sym,0,sizeof(pint)); r.refaddr:=addr_full; list.concat(taicpu.op_ref(A_CALL,S_NO,r)); end; procedure tcgx86.a_call_reg(list : TAsmList;reg : tregister); begin list.concat(taicpu.op_reg(A_CALL,S_NO,reg)); end; procedure tcgx86.a_call_ref(list : TAsmList;ref : treference); begin list.concat(taicpu.op_ref(A_CALL,S_NO,ref)); end; {********************** load instructions ********************} procedure tcgx86.a_load_const_reg(list : TAsmList; tosize: TCGSize; a : tcgint; reg : TRegister); begin check_register_size(tosize,reg); { the optimizer will change it to "xor reg,reg" when loading zero, } { no need to do it here too (JM) } list.concat(taicpu.op_const_reg(A_MOV,TCGSize2OpSize[tosize],a,reg)) end; procedure tcgx86.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); {$ifdef x86_64} { x86_64 only supports signed 32 bits constants directly } if (tosize in [OS_S64,OS_64]) and ((ahigh(longint))) then begin a_load_const_ref(list,OS_32,longint(a and $ffffffff),tmpref); inc(tmpref.offset,4); a_load_const_ref(list,OS_32,longint(a shr 32),tmpref); end else {$endif x86_64} list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,tmpref)); end; procedure tcgx86.a_load_reg_ref(list : TAsmList; fromsize,tosize: TCGSize; reg : tregister;const ref : treference); var op: tasmop; s: topsize; tmpsize : tcgsize; tmpreg : tregister; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(fromsize,reg); sizes2load(fromsize,tosize,op,s); case s of {$ifdef x86_64} S_BQ,S_WQ,S_LQ, {$endif x86_64} S_BW,S_BL,S_WL : begin tmpreg:=getintregister(list,tosize); {$ifdef x86_64} { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit which clears the upper 64 bit too, so it could be that s is S_L while the reg is 64 bit (FK) } if s in [S_BL,S_WL,S_L] then begin tmpreg:=makeregsize(list,tmpreg,OS_32); tmpsize:=OS_32; end else {$endif x86_64} tmpsize:=tosize; list.concat(taicpu.op_reg_reg(op,s,reg,tmpreg)); a_load_reg_ref(list,tmpsize,tosize,tmpreg,tmpref); end; else list.concat(taicpu.op_reg_ref(op,s,reg,tmpref)); end; end; procedure tcgx86.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref: treference;reg : tregister); var op: tasmop; s: topsize; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(tosize,reg); sizes2load(fromsize,tosize,op,s); {$ifdef x86_64} { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit which clears the upper 64 bit too, so it could be that s is S_L while the reg is 64 bit (FK) } if s in [S_BL,S_WL,S_L] then reg:=makeregsize(list,reg,OS_32); {$endif x86_64} list.concat(taicpu.op_ref_reg(op,s,tmpref,reg)); end; procedure tcgx86.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister); var op: tasmop; s: topsize; instr:Taicpu; begin check_register_size(fromsize,reg1); check_register_size(tosize,reg2); if tcgsize2size[fromsize]>tcgsize2size[tosize] then begin reg1:=makeregsize(list,reg1,tosize); s:=tcgsize2opsize[tosize]; op:=A_MOV; end else sizes2load(fromsize,tosize,op,s); {$ifdef x86_64} { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit which clears the upper 64 bit too, so it could be that s is S_L while the reg is 64 bit (FK) } if s in [S_BL,S_WL,S_L] then reg2:=makeregsize(list,reg2,OS_32); {$endif x86_64} if (reg1<>reg2) then begin instr:=taicpu.op_reg_reg(op,s,reg1,reg2); { Notify the register allocator that we have written a move instruction so it can try to eliminate it. } if (reg1<>current_procinfo.framepointer) and (reg1<>NR_STACK_POINTER_REG) then add_move_instruction(instr); list.concat(instr); end; {$ifdef x86_64} { avoid merging of registers and killing the zero extensions (FK) } if (tosize in [OS_64,OS_S64]) and (s=S_L) then list.concat(taicpu.op_const_reg(A_AND,S_L,$ffffffff,reg2)); {$endif x86_64} end; procedure tcgx86.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); var tmpref : treference; begin with ref do begin if (base=NR_NO) and (index=NR_NO) then begin if assigned(ref.symbol) then begin if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or (cs_create_pic in current_settings.moduleswitches)) then begin if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or ((cs_create_pic in current_settings.moduleswitches) and (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then begin reference_reset_base(tmpref, g_indirect_sym_load(list,ref.symbol.name,asmsym2indsymflags(ref.symbol)), offset,sizeof(pint)); a_loadaddr_ref_reg(list,tmpref,r); end else begin include(current_procinfo.flags,pi_needs_got); reference_reset_base(tmpref,current_procinfo.got,offset,ref.alignment); tmpref.symbol:=symbol; tmpref.relsymbol:=current_procinfo.CurrGOTLabel; list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); end; end else if (cs_create_pic in current_settings.moduleswitches) {$ifdef x86_64} and not(ref.symbol.bind=AB_LOCAL) {$endif x86_64} then begin {$ifdef x86_64} reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment); tmpref.refaddr:=addr_pic; tmpref.base:=NR_RIP; list.concat(taicpu.op_ref_reg(A_MOV,S_Q,tmpref,r)); {$else x86_64} reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment); tmpref.refaddr:=addr_pic; tmpref.base:=current_procinfo.got; include(current_procinfo.flags,pi_needs_got); list.concat(taicpu.op_ref_reg(A_MOV,S_L,tmpref,r)); {$endif x86_64} if offset<>0 then a_op_const_reg(list,OP_ADD,OS_ADDR,offset,r); end {$ifdef x86_64} else if (target_info.system in (systems_all_windows+[system_x86_64_darwin])) or (cs_create_pic in current_settings.moduleswitches) then begin { Win64 and Darwin/x86_64 always require RIP-relative addressing } tmpref:=ref; tmpref.base:=NR_RIP; tmpref.refaddr:=addr_pic_no_got; list.concat(Taicpu.op_ref_reg(A_LEA,S_Q,tmpref,r)); end {$endif x86_64} else begin tmpref:=ref; tmpref.refaddr:=ADDR_FULL; list.concat(Taicpu.op_ref_reg(A_MOV,tcgsize2opsize[OS_ADDR],tmpref,r)); end end else a_load_const_reg(list,OS_ADDR,offset,r) end else if (base=NR_NO) and (index<>NR_NO) and (offset=0) and (scalefactor=0) and (symbol=nil) then a_load_reg_reg(list,OS_ADDR,OS_ADDR,index,r) else if (base<>NR_NO) and (index=NR_NO) and (offset=0) and (symbol=nil) then a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r) else begin tmpref:=ref; make_simple_ref(list,tmpref); list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); end; if segment<>NR_NO then begin if (tf_section_threadvars in target_info.flags) then begin { Convert thread local address to a process global addres as we cannot handle far pointers.} case target_info.system of system_i386_linux,system_i386_android: if segment=NR_GS then begin reference_reset_symbol(tmpref,current_asmdata.RefAsmSymbol('___fpc_threadvar_offset'),0,ref.alignment); tmpref.segment:=NR_GS; list.concat(Taicpu.op_ref_reg(A_ADD,tcgsize2opsize[OS_ADDR],tmpref,r)); end else cgmessage(cg_e_cant_use_far_pointer_there); else cgmessage(cg_e_cant_use_far_pointer_there); end; end else cgmessage(cg_e_cant_use_far_pointer_there); end; end; end; { all fpu load routines expect that R_ST[0-7] means an fpu regvar and } { R_ST means "the current value at the top of the fpu stack" (JM) } procedure tcgx86.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); var href: treference; op: tasmop; s: topsize; begin if (reg1<>NR_ST) then begin floatloadops(tosize,op,s); list.concat(taicpu.op_reg(op,s,rgfpu.correct_fpuregister(reg1,rgfpu.fpuvaroffset))); inc_fpu_stack; end; if (reg2<>NR_ST) then begin floatstoreops(tosize,op,s); list.concat(taicpu.op_reg(op,s,rgfpu.correct_fpuregister(reg2,rgfpu.fpuvaroffset))); dec_fpu_stack; end; { OS_F80 < OS_C64, but OS_C64 fits perfectly in OS_F80 } if (reg1=NR_ST) and (reg2=NR_ST) and (tosize<>OS_F80) and (tosizeNR_ST then a_loadfpu_reg_reg(list,fromsize,tosize,reg,NR_ST); floatstore(list,tosize,ref); end; function get_scalar_mm_op(fromsize,tosize : tcgsize) : tasmop; const convertop : array[OS_F32..OS_F128,OS_F32..OS_F128] of tasmop = ( (A_MOVSS,A_CVTSS2SD,A_NONE,A_NONE,A_NONE), (A_CVTSD2SS,A_MOVSD,A_NONE,A_NONE,A_NONE), (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE), (A_NONE,A_NONE,A_NONE,A_MOVQ,A_NONE), (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE)); begin { we can have OS_F32/OS_F64 (record in function result/LOC_MMREGISTER) to OS_32/OS_64 (record in memory/LOC_REFERENCE) } if (fromsize in [OS_F32,OS_F64]) and (tcgsize2size[fromsize]=tcgsize2size[tosize]) then case tosize of OS_32: tosize:=OS_F32; OS_64: tosize:=OS_F64; end; if (fromsize in [low(convertop)..high(convertop)]) and (tosize in [low(convertop)..high(convertop)]) then result:=convertop[fromsize,tosize] { we can have OS_M64 (record in function result/LOC_MMREGISTER) to OS_64 (record in memory/LOC_REFERENCE) } else if (tcgsize2size[fromsize]=tcgsize2size[tosize]) and (fromsize=OS_M64) then result:=A_MOVQ else internalerror(2010060104); if result=A_NONE then internalerror(200312205); end; procedure tcgx86.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); var instr : taicpu; begin if shuffle=nil then begin if fromsize=tosize then { needs correct size in case of spilling } case fromsize of OS_F32: instr:=taicpu.op_reg_reg(A_MOVAPS,S_NO,reg1,reg2); OS_F64: instr:=taicpu.op_reg_reg(A_MOVAPD,S_NO,reg1,reg2); OS_M64: instr:=taicpu.op_reg_reg(A_MOVQ,S_NO,reg1,reg2); else internalerror(2006091201); end else internalerror(200312202); add_move_instruction(instr); end else if shufflescalar(shuffle) then begin instr:=taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg1,reg2); case get_scalar_mm_op(fromsize,tosize) of A_MOVSS, A_MOVSD, A_MOVQ: add_move_instruction(instr); end; end else internalerror(200312201); list.concat(instr); end; procedure tcgx86.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); if shuffle=nil then begin if fromsize=OS_M64 then list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,tmpref,reg)) else {$ifdef x86_64} { x86-64 has always properly aligned data } list.concat(taicpu.op_ref_reg(A_MOVDQA,S_NO,tmpref,reg)); {$else x86_64} list.concat(taicpu.op_ref_reg(A_MOVDQU,S_NO,tmpref,reg)); {$endif x86_64} end else if shufflescalar(shuffle) then list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,tmpref,reg)) else internalerror(200312252); end; procedure tcgx86.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); var hreg : tregister; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); if shuffle=nil then begin if fromsize=OS_M64 then list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,tmpref)) else {$ifdef x86_64} { x86-64 has always properly aligned data } list.concat(taicpu.op_reg_ref(A_MOVDQA,S_NO,reg,tmpref)) {$else x86_64} list.concat(taicpu.op_reg_ref(A_MOVDQU,S_NO,reg,tmpref)) {$endif x86_64} end else if shufflescalar(shuffle) then begin if tcgsize2size[tosize]<>tcgsize2size[fromsize] then begin hreg:=getmmregister(list,tosize); list.concat(taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg,hreg)); list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,tmpref)); end else list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,tmpref)); end else internalerror(200312252); end; procedure tcgx86.a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); var l : tlocation; begin l.loc:=LOC_REFERENCE; l.reference:=ref; l.size:=size; opmm_loc_reg(list,op,size,l,reg,shuffle); end; procedure tcgx86.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); var l : tlocation; begin l.loc:=LOC_MMREGISTER; l.register:=src; l.size:=size; opmm_loc_reg(list,op,size,l,dst,shuffle); end; procedure tcgx86.opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle); const opmm2asmop : array[0..1,OS_F32..OS_F64,topcg] of tasmop = ( ( { scalar } ( { OS_F32 } A_NOP,A_NOP,A_ADDSS,A_NOP,A_DIVSS,A_NOP,A_NOP,A_MULSS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSS,A_NOP,A_NOP,A_NOP ), ( { OS_F64 } A_NOP,A_NOP,A_ADDSD,A_NOP,A_DIVSD,A_NOP,A_NOP,A_MULSD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSD,A_NOP,A_NOP,A_NOP ) ), ( { vectorized/packed } { because the logical packed single instructions have shorter op codes, we use always these } ( { OS_F32 } A_NOP,A_NOP,A_ADDPS,A_NOP,A_DIVPS,A_NOP,A_NOP,A_MULPS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPS,A_XORPS,A_NOP,A_NOP ), ( { OS_F64 } A_NOP,A_NOP,A_ADDPD,A_NOP,A_DIVPD,A_NOP,A_NOP,A_MULPD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPD,A_XORPD,A_NOP,A_NOP ) ) ); var resultreg : tregister; asmop : tasmop; begin { this is an internally used procedure so the parameters have some constrains } if loc.size<>size then internalerror(200312213); resultreg:=dst; { deshuffle } //!!! if (shuffle<>nil) and not(shufflescalar(shuffle)) then begin internalerror(2010060101); end else if (shuffle=nil) then asmop:=opmm2asmop[1,size,op] else if shufflescalar(shuffle) then begin asmop:=opmm2asmop[0,size,op]; { no scalar operation available? } if asmop=A_NOP then begin { do vectorized and shuffle finally } internalerror(2010060102); end; end else internalerror(200312211); if asmop=A_NOP then internalerror(200312216); case loc.loc of LOC_CREFERENCE,LOC_REFERENCE: begin make_simple_ref(current_asmdata.CurrAsmList,loc.reference); list.concat(taicpu.op_ref_reg(asmop,S_NO,loc.reference,resultreg)); end; LOC_CMMREGISTER,LOC_MMREGISTER: list.concat(taicpu.op_reg_reg(asmop,S_NO,loc.register,resultreg)); else internalerror(200312214); end; { shuffle } if resultreg<>dst then begin internalerror(200312212); end; end; procedure tcgx86.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); var opcode : tasmop; power : longint; {$ifdef x86_64} tmpreg : tregister; {$endif x86_64} begin optimize_op_const(op, a); {$ifdef x86_64} { x86_64 only supports signed 32 bits constants directly } if not(op in [OP_NONE,OP_MOVE]) and (size in [OS_S64,OS_64]) and ((ahigh(longint))) then begin tmpreg:=getintregister(list,size); a_load_const_reg(list,size,a,tmpreg); a_op_reg_reg(list,op,size,tmpreg,reg); exit; end; {$endif x86_64} check_register_size(size,reg); case op of OP_NONE : begin { Opcode is optimized away } end; OP_MOVE : begin { Optimized, replaced with a simple load } a_load_const_reg(list,size,a,reg); end; OP_DIV, OP_IDIV: begin if ispowerof2(int64(a),power) then begin case op of OP_DIV: opcode := A_SHR; OP_IDIV: opcode := A_SAR; end; list.concat(taicpu.op_const_reg(opcode,TCgSize2OpSize[size],power,reg)); exit; end; { the rest should be handled specifically in the code } { generator because of the silly register usage restraints } internalerror(200109224); end; OP_MUL,OP_IMUL: begin if not(cs_check_overflow in current_settings.localswitches) and ispowerof2(int64(a),power) then begin list.concat(taicpu.op_const_reg(A_SHL,TCgSize2OpSize[size],power,reg)); exit; end; if op = OP_IMUL then list.concat(taicpu.op_const_reg(A_IMUL,TCgSize2OpSize[size],a,reg)) else { OP_MUL should be handled specifically in the code } { generator because of the silly register usage restraints } internalerror(200109225); end; OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: if not(cs_check_overflow in current_settings.localswitches) and (a = 1) and (op in [OP_ADD,OP_SUB]) then if op = OP_ADD then list.concat(taicpu.op_reg(A_INC,TCgSize2OpSize[size],reg)) else list.concat(taicpu.op_reg(A_DEC,TCgSize2OpSize[size],reg)) else if (a = 0) then if (op <> OP_AND) then exit else list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],0,reg)) else if (aword(a) = high(aword)) and (op in [OP_AND,OP_OR,OP_XOR]) then begin case op of OP_AND: exit; OP_OR: list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],aint(high(aword)),reg)); OP_XOR: list.concat(taicpu.op_reg(A_NOT,TCgSize2OpSize[size],reg)); end end else list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],aint(a),reg)); OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR: begin {$if defined(x86_64)} if (a and 63) <> 0 Then list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 63,reg)); if (a shr 6) <> 0 Then internalerror(200609073); {$elseif defined(i386)} if (a and 31) <> 0 Then list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,reg)); if (a shr 5) <> 0 Then internalerror(200609071); {$elseif defined(i8086)} if (a shr 5) <> 0 Then internalerror(2013043002); a := a and 31; if a <> 0 Then begin if (current_settings.cputype < cpu_186) and (a <> 1) then begin getcpuregister(list,NR_CL); a_load_const_reg(list,OS_8,a,NR_CL); list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],NR_CL,reg)); ungetcpuregister(list,NR_CL); end else list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a,reg)); end; {$endif} end else internalerror(200609072); end; end; procedure tcgx86.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); var opcode: tasmop; power: longint; {$ifdef x86_64} tmpreg : tregister; {$endif x86_64} tmpref : treference; begin optimize_op_const(op, a); tmpref:=ref; make_simple_ref(list,tmpref); {$ifdef x86_64} { x86_64 only supports signed 32 bits constants directly } if not(op in [OP_NONE,OP_MOVE]) and (size in [OS_S64,OS_64]) and ((ahigh(longint))) then begin tmpreg:=getintregister(list,size); a_load_const_reg(list,size,a,tmpreg); a_op_reg_ref(list,op,size,tmpreg,tmpref); exit; end; {$endif x86_64} Case Op of OP_NONE : begin { Opcode is optimized away } end; OP_MOVE : begin { Optimized, replaced with a simple load } a_load_const_ref(list,size,a,ref); end; OP_DIV, OP_IDIV: Begin if ispowerof2(int64(a),power) then begin case op of OP_DIV: opcode := A_SHR; OP_IDIV: opcode := A_SAR; end; list.concat(taicpu.op_const_ref(opcode, TCgSize2OpSize[size],power,tmpref)); exit; end; { the rest should be handled specifically in the code } { generator because of the silly register usage restraints } internalerror(200109231); End; OP_MUL,OP_IMUL: begin if not(cs_check_overflow in current_settings.localswitches) and ispowerof2(int64(a),power) then begin list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size], power,tmpref)); exit; end; { can't multiply a memory location directly with a constant } if op = OP_IMUL then inherited a_op_const_ref(list,op,size,a,tmpref) else { OP_MUL should be handled specifically in the code } { generator because of the silly register usage restraints } internalerror(200109232); end; OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: if not(cs_check_overflow in current_settings.localswitches) and (a = 1) and (op in [OP_ADD,OP_SUB]) then if op = OP_ADD then list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],tmpref)) else list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],tmpref)) else if (a = 0) then if (op <> OP_AND) then exit else a_load_const_ref(list,size,0,tmpref) else if (aword(a) = high(aword)) and (op in [OP_AND,OP_OR,OP_XOR]) then begin case op of OP_AND: exit; OP_OR: list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),tmpref)); OP_XOR: list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],tmpref)); end end else list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op], TCgSize2OpSize[size],a,tmpref)); OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR: begin if (a and 31) <> 0 then list.concat(taicpu.op_const_ref( TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,tmpref)); if (a shr 5) <> 0 Then internalerror(68991); end else internalerror(68992); end; end; procedure tcgx86.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); const {$if defined(cpu64bitalu) or defined(cpu32bitalu)} REGCX=NR_ECX; REGCX_Size = OS_32; {$elseif defined(cpu16bitalu)} REGCX=NR_CX; REGCX_Size = OS_16; {$endif} var dstsize: topsize; instr:Taicpu; begin check_register_size(size,src); check_register_size(size,dst); dstsize := tcgsize2opsize[size]; case op of OP_NEG,OP_NOT: begin if src<>dst then a_load_reg_reg(list,size,size,src,dst); list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst)); end; OP_MUL,OP_DIV,OP_IDIV: { special stuff, needs separate handling inside code } { generator } internalerror(200109233); OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR: begin { Use ecx to load the value, that allows better coalescing } getcpuregister(list,REGCX); a_load_reg_reg(list,size,REGCX_Size,src,REGCX); list.concat(taicpu.op_reg_reg(Topcg2asmop[op],tcgsize2opsize[size],NR_CL,dst)); ungetcpuregister(list,REGCX); end; else begin if reg2opsize(src) <> dstsize then internalerror(200109226); instr:=taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,src,dst); list.concat(instr); end; end; end; procedure tcgx86.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(size,reg); case op of OP_NEG,OP_NOT,OP_IMUL: begin inherited a_op_ref_reg(list,op,size,tmpref,reg); end; OP_MUL,OP_DIV,OP_IDIV: { special stuff, needs separate handling inside code } { generator } internalerror(200109239); else begin reg := makeregsize(list,reg,size); list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref,reg)); end; end; end; procedure tcgx86.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(size,reg); case op of OP_NEG,OP_NOT: begin if reg<>NR_NO then internalerror(200109237); list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref)); end; OP_IMUL: begin { this one needs a load/imul/store, which is the default } inherited a_op_ref_reg(list,op,size,tmpref,reg); end; OP_MUL,OP_DIV,OP_IDIV: { special stuff, needs separate handling inside code } { generator } internalerror(200109238); else begin list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,tmpref)); end; end; end; procedure tcgx86.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); var opsize: topsize; l : TAsmLabel; begin opsize:=tcgsize2opsize[size]; if not reverse then list.concat(taicpu.op_reg_reg(A_BSF,opsize,src,dst)) else list.concat(taicpu.op_reg_reg(A_BSR,opsize,src,dst)); current_asmdata.getjumplabel(l); a_jmp_cond(list,OC_NE,l); list.concat(taicpu.op_const_reg(A_MOV,opsize,$ff,dst)); a_label(list,l); end; {*************** compare instructructions ****************} procedure tcgx86.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel); {$ifdef x86_64} var tmpreg : tregister; {$endif x86_64} begin {$ifdef x86_64} { x86_64 only supports signed 32 bits constants directly } if (size in [OS_S64,OS_64]) and ((ahigh(longint))) then begin tmpreg:=getintregister(list,size); a_load_const_reg(list,size,a,tmpreg); a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); exit; end; {$endif x86_64} if (a = 0) then list.concat(taicpu.op_reg_reg(A_TEST,tcgsize2opsize[size],reg,reg)) else list.concat(taicpu.op_const_reg(A_CMP,tcgsize2opsize[size],a,reg)); a_jmp_cond(list,cmp_op,l); end; procedure tcgx86.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); var {$ifdef x86_64} tmpreg : tregister; {$endif x86_64} tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); {$ifdef x86_64} { x86_64 only supports signed 32 bits constants directly } if (size in [OS_S64,OS_64]) and ((ahigh(longint))) then begin tmpreg:=getintregister(list,size); a_load_const_reg(list,size,a,tmpreg); a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,tmpref,l); exit; end; {$endif x86_64} list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,tmpref)); a_jmp_cond(list,cmp_op,l); end; procedure tcgx86.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg1,reg2 : tregister;l : tasmlabel); begin check_register_size(size,reg1); check_register_size(size,reg2); list.concat(taicpu.op_reg_reg(A_CMP,TCgSize2OpSize[size],reg1,reg2)); a_jmp_cond(list,cmp_op,l); end; procedure tcgx86.a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(size,reg); list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],tmpref,reg)); a_jmp_cond(list,cmp_op,l); end; procedure tcgx86.a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;const ref: treference; l : tasmlabel); var tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); check_register_size(size,reg); list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,tmpref)); a_jmp_cond(list,cmp_op,l); end; procedure tcgx86.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); var ai : taicpu; begin if cond=OC_None then ai := Taicpu.Op_sym(A_JMP,S_NO,l) else begin ai:=Taicpu.Op_sym(A_Jcc,S_NO,l); ai.SetCondition(TOpCmp2AsmCond[cond]); end; ai.is_jmp:=true; list.concat(ai); end; procedure tcgx86.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); var ai : taicpu; begin ai := Taicpu.op_sym(A_Jcc,S_NO,l); ai.SetCondition(flags_to_cond(f)); ai.is_jmp := true; list.concat(ai); end; procedure tcgx86.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); var ai : taicpu; hreg : tregister; begin hreg:=makeregsize(list,reg,OS_8); ai:=Taicpu.op_reg(A_SETcc,S_B,hreg); ai.setcondition(flags_to_cond(f)); list.concat(ai); if reg<>hreg then a_load_reg_reg(list,OS_8,size,hreg,reg); end; procedure tcgx86.g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref: TReference); var ai : taicpu; tmpref : treference; begin tmpref:=ref; make_simple_ref(list,tmpref); if not(size in [OS_8,OS_S8]) then a_load_const_ref(list,size,0,tmpref); ai:=Taicpu.op_ref(A_SETcc,S_B,tmpref); ai.setcondition(flags_to_cond(f)); list.concat(ai); {$ifndef cpu64bitalu} if size in [OS_S64,OS_64] then begin inc(tmpref.offset,4); a_load_const_ref(list,OS_32,0,tmpref); end; {$endif cpu64bitalu} end; { ************* concatcopy ************ } procedure Tcgx86.g_concatcopy(list:TAsmList;const source,dest:Treference;len:tcgint); const {$if defined(cpu64bitalu)} REGCX=NR_RCX; REGSI=NR_RSI; REGDI=NR_RDI; copy_len_sizes = [1, 2, 4, 8]; push_segment_size = S_L; {$elseif defined(cpu32bitalu)} REGCX=NR_ECX; REGSI=NR_ESI; REGDI=NR_EDI; copy_len_sizes = [1, 2, 4]; push_segment_size = S_L; {$elseif defined(cpu16bitalu)} REGCX=NR_CX; REGSI=NR_SI; REGDI=NR_DI; copy_len_sizes = [1, 2]; push_segment_size = S_W; {$endif} type copymode=(copy_move,copy_mmx,copy_string); var srcref,dstref:Treference; r,r0,r1,r2,r3:Tregister; helpsize:tcgint; copysize:byte; cgsize:Tcgsize; cm:copymode; begin cm:=copy_move; helpsize:=3*sizeof(aword); if cs_opt_size in current_settings.optimizerswitches then helpsize:=2*sizeof(aword); if (cs_mmx in current_settings.localswitches) and not(pi_uses_fpu in current_procinfo.flags) and ((len=8) or (len=16) or (len=24) or (len=32)) then cm:=copy_mmx; if (len>helpsize) then cm:=copy_string; if (cs_opt_size in current_settings.optimizerswitches) and not((len<=16) and (cm=copy_mmx)) and not(len in copy_len_sizes) then cm:=copy_string; if (source.segment<>NR_NO) or (dest.segment<>NR_NO) then cm:=copy_string; case cm of copy_move: begin dstref:=dest; srcref:=source; copysize:=sizeof(aint); cgsize:=int_cgsize(copysize); while len<>0 do begin if len<2 then begin copysize:=1; cgsize:=OS_8; end else if len<4 then begin copysize:=2; cgsize:=OS_16; end {$if defined(cpu32bitalu) or defined(cpu64bitalu)} else if len<8 then begin copysize:=4; cgsize:=OS_32; end {$endif cpu32bitalu or cpu64bitalu} {$ifdef cpu64bitalu} else if len<16 then begin copysize:=8; cgsize:=OS_64; end {$endif} ; dec(len,copysize); r:=getintregister(list,cgsize); a_load_ref_reg(list,cgsize,cgsize,srcref,r); a_load_reg_ref(list,cgsize,cgsize,r,dstref); inc(srcref.offset,copysize); inc(dstref.offset,copysize); end; end; copy_mmx: begin dstref:=dest; srcref:=source; r0:=getmmxregister(list); a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r0,nil); if len>=16 then begin inc(srcref.offset,8); r1:=getmmxregister(list); a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r1,nil); end; if len>=24 then begin inc(srcref.offset,8); r2:=getmmxregister(list); a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r2,nil); end; if len>=32 then begin inc(srcref.offset,8); r3:=getmmxregister(list); a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r3,nil); end; a_loadmm_reg_ref(list,OS_M64,OS_M64,r0,dstref,nil); if len>=16 then begin inc(dstref.offset,8); a_loadmm_reg_ref(list,OS_M64,OS_M64,r1,dstref,nil); end; if len>=24 then begin inc(dstref.offset,8); a_loadmm_reg_ref(list,OS_M64,OS_M64,r2,dstref,nil); end; if len>=32 then begin inc(dstref.offset,8); a_loadmm_reg_ref(list,OS_M64,OS_M64,r3,dstref,nil); end; end else {copy_string, should be a good fallback in case of unhandled} begin getcpuregister(list,REGDI); if (dest.segment=NR_NO) then begin a_loadaddr_ref_reg(list,dest,REGDI); {$ifdef volatile_es} list.concat(taicpu.op_reg(A_PUSH,push_segment_size,NR_DS)); list.concat(taicpu.op_reg(A_POP,push_segment_size,NR_ES)); {$endif volatile_es} end else begin dstref:=dest; dstref.segment:=NR_NO; a_loadaddr_ref_reg(list,dstref,REGDI); {$ifndef volatile_es} list.concat(taicpu.op_reg(A_PUSH,push_segment_size,NR_ES)); {$endif not volatile_es} list.concat(taicpu.op_reg(A_PUSH,push_segment_size,dest.segment)); list.concat(taicpu.op_reg(A_POP,push_segment_size,NR_ES)); end; getcpuregister(list,REGSI); if (source.segment=NR_NO) then a_loadaddr_ref_reg(list,source,REGSI) else begin srcref:=source; srcref.segment:=NR_NO; a_loadaddr_ref_reg(list,srcref,REGSI); list.concat(taicpu.op_reg(A_PUSH,S_L,NR_DS)); list.concat(taicpu.op_reg(A_PUSH,S_L,source.segment)); list.concat(taicpu.op_reg(A_POP,S_L,NR_DS)); end; getcpuregister(list,REGCX); {$if defined(i8086) or defined(i386)} list.concat(Taicpu.op_none(A_CLD,S_NO)); {$endif i8086 or i386} if (cs_opt_size in current_settings.optimizerswitches) and (len>sizeof(aint)+(sizeof(aint) div 2)) then begin a_load_const_reg(list,OS_INT,len,REGCX); list.concat(Taicpu.op_none(A_REP,S_NO)); list.concat(Taicpu.op_none(A_MOVSB,S_NO)); end else begin helpsize:=len div sizeof(aint); len:=len mod sizeof(aint); if helpsize>1 then begin a_load_const_reg(list,OS_INT,helpsize,REGCX); list.concat(Taicpu.op_none(A_REP,S_NO)); end; if helpsize>0 then begin {$if defined(cpu64bitalu)} list.concat(Taicpu.op_none(A_MOVSQ,S_NO)) {$elseif defined(cpu32bitalu)} list.concat(Taicpu.op_none(A_MOVSD,S_NO)); {$elseif defined(cpu16bitalu)} list.concat(Taicpu.op_none(A_MOVSW,S_NO)); {$endif} end; if len>=4 then begin dec(len,4); list.concat(Taicpu.op_none(A_MOVSD,S_NO)); end; if len>=2 then begin dec(len,2); list.concat(Taicpu.op_none(A_MOVSW,S_NO)); end; if len=1 then list.concat(Taicpu.op_none(A_MOVSB,S_NO)); end; ungetcpuregister(list,REGCX); ungetcpuregister(list,REGSI); ungetcpuregister(list,REGDI); if (source.segment<>NR_NO) then list.concat(taicpu.op_reg(A_POP,push_segment_size,NR_DS)); {$ifndef volatile_es} if (dest.segment<>NR_NO) then list.concat(taicpu.op_reg(A_POP,push_segment_size,NR_ES)); {$endif not volatile_es} end; end; end; {**************************************************************************** Entry/Exit Code Helpers ****************************************************************************} procedure tcgx86.g_profilecode(list : TAsmList); var pl : tasmlabel; mcountprefix : String[4]; begin case target_info.system of {$ifndef NOTARGETWIN} system_i386_win32, {$endif} system_i386_freebsd, system_i386_netbsd, // system_i386_openbsd, system_i386_wdosx : begin Case target_info.system Of system_i386_freebsd : mcountprefix:='.'; system_i386_netbsd : mcountprefix:='__'; // system_i386_openbsd : mcountprefix:='.'; else mcountPrefix:=''; end; current_asmdata.getaddrlabel(pl); new_section(list,sec_data,lower(current_procinfo.procdef.mangledname),sizeof(pint)); list.concat(Tai_label.Create(pl)); list.concat(Tai_const.Create_32bit(0)); new_section(list,sec_code,lower(current_procinfo.procdef.mangledname),0); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX)); list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,NR_EDX)); a_call_name(list,target_info.Cprefix+mcountprefix+'mcount',false); list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX)); end; system_i386_linux: a_call_name(list,target_info.Cprefix+'mcount',false); system_i386_go32v2,system_i386_watcom: begin a_call_name(list,'MCOUNT',false); end; system_x86_64_linux, system_x86_64_darwin: begin a_call_name(list,'mcount',false); end; end; end; procedure tcgx86.g_stackpointer_alloc(list : TAsmList;localsize : longint); {$ifdef x86} {$ifndef NOTARGETWIN} var href : treference; i : integer; again : tasmlabel; {$endif NOTARGETWIN} {$endif x86} begin if localsize>0 then begin {$ifdef i386} {$ifndef NOTARGETWIN} { windows guards only a few pages for stack growing, so we have to access every page first } if (target_info.system in [system_i386_win32,system_i386_wince]) and (localsize>=winstackpagesize) then begin if localsize div winstackpagesize<=5 then begin list.concat(Taicpu.Op_const_reg(A_SUB,S_L,localsize-4,NR_ESP)); for i:=1 to localsize div winstackpagesize do begin reference_reset_base(href,NR_ESP,localsize-i*winstackpagesize,4); list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); end; list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EAX)); end else begin current_asmdata.getjumplabel(again); getcpuregister(list,NR_EDI); list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EDI)); list.concat(Taicpu.op_const_reg(A_MOV,S_L,localsize div winstackpagesize,NR_EDI)); a_label(list,again); list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,NR_ESP)); list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EAX)); list.concat(Taicpu.op_reg(A_DEC,S_L,NR_EDI)); a_jmp_cond(list,OC_NE,again); list.concat(Taicpu.op_const_reg(A_SUB,S_L,localsize mod winstackpagesize - 4,NR_ESP)); reference_reset_base(href,NR_ESP,localsize-4,4); list.concat(Taicpu.op_ref_reg(A_MOV,S_L,href,NR_EDI)); ungetcpuregister(list,NR_EDI); end end else {$endif NOTARGETWIN} {$endif i386} {$ifdef x86_64} {$ifndef NOTARGETWIN} { windows guards only a few pages for stack growing, so we have to access every page first } if (target_info.system=system_x86_64_win64) and (localsize>=winstackpagesize) then begin if localsize div winstackpagesize<=5 then begin list.concat(Taicpu.Op_const_reg(A_SUB,S_Q,localsize,NR_RSP)); for i:=1 to localsize div winstackpagesize do begin reference_reset_base(href,NR_RSP,localsize-i*winstackpagesize+4,4); list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); end; reference_reset_base(href,NR_RSP,0,4); list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); end else begin current_asmdata.getjumplabel(again); getcpuregister(list,NR_R10); list.concat(Taicpu.op_const_reg(A_MOV,S_Q,localsize div winstackpagesize,NR_R10)); a_label(list,again); list.concat(Taicpu.op_const_reg(A_SUB,S_Q,winstackpagesize,NR_RSP)); reference_reset_base(href,NR_RSP,0,4); list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); list.concat(Taicpu.op_reg(A_DEC,S_Q,NR_R10)); a_jmp_cond(list,OC_NE,again); list.concat(Taicpu.op_const_reg(A_SUB,S_Q,localsize mod winstackpagesize,NR_RSP)); ungetcpuregister(list,NR_R10); end end else {$endif NOTARGETWIN} {$endif x86_64} list.concat(Taicpu.Op_const_reg(A_SUB,tcgsize2opsize[OS_ADDR],localsize,NR_STACK_POINTER_REG)); end; end; procedure tcgx86.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); var stackmisalignment: longint; para: tparavarsym; {$ifdef i8086} dgroup: treference; {$endif i8086} begin {$ifdef i8086} { interrupt support for i8086 } if po_interrupt in current_procinfo.procdef.procoptions then begin list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_AX)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_BX)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_CX)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_DX)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_SI)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_DI)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_DS)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_ES)); reference_reset(dgroup,0); dgroup.refaddr:=addr_dgroup; list.concat(Taicpu.Op_ref_reg(A_MOV,S_W,dgroup,NR_AX)); list.concat(Taicpu.Op_reg_reg(A_MOV,S_W,NR_AX,NR_DS)); end; {$endif i8086} {$ifdef i386} { interrupt support for i386 } if (po_interrupt in current_procinfo.procdef.procoptions) and { this messes up stack alignment } not(target_info.system in [system_i386_darwin,system_i386_iphonesim,system_i386_android]) then begin { .... also the segment registers } list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_GS)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_FS)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_ES)); list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_DS)); { save the registers of an interrupt procedure } list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDI)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_ESI)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_ECX)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EBX)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EAX)); end; {$endif i386} { save old framepointer } if not nostackframe then begin { return address } stackmisalignment := sizeof(pint); list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil)); if current_procinfo.framepointer=NR_STACK_POINTER_REG then CGmessage(cg_d_stackframe_omited) else begin { push } inc(stackmisalignment,sizeof(pint)); include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG); list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG)); if (target_info.system=system_x86_64_win64) then begin list.concat(cai_seh_directive.create_reg(ash_pushreg,NR_FRAME_POINTER_REG)); include(current_procinfo.flags,pi_has_unwind_info); end; { Return address and FP are both on stack } current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint)); current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint))); if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG)) else begin { load framepointer from hidden $parentfp parameter } para:=tparavarsym(current_procinfo.procdef.paras[0]); if not (vo_is_parentfp in para.varoptions) then InternalError(201201142); if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or (para.paraloc[calleeside].location^.next<>nil) then InternalError(201201143); list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR], para.paraloc[calleeside].location^.register,NR_FRAME_POINTER_REG)); { Need only as much stack space as necessary to do the calls. Exception filters don't have own local vars, and temps are 'mapped' to the parent procedure. maxpushedparasize is already aligned at least on x86_64. } localsize:=current_procinfo.maxpushedparasize; end; current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG); { TODO: current framepointer handling is not compatible with Win64 at all: Win64 expects FP to point to the top or into the middle of local area. In FPC it points to the bottom, making it impossible to generate UWOP_SET_FPREG unwind code if local area is > 240 bytes. So for now pretend we never have a framepointer. } end; { allocate stackframe space } if (localsize<>0) or ((target_info.stackalign>sizeof(pint)) and (stackmisalignment <> 0) and ((pi_do_call in current_procinfo.flags) or (po_assembler in current_procinfo.procdef.procoptions))) then begin if target_info.stackalign>sizeof(pint) then localsize := align(localsize+stackmisalignment,target_info.stackalign)-stackmisalignment; cg.g_stackpointer_alloc(list,localsize); if current_procinfo.framepointer=NR_STACK_POINTER_REG then current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint)); current_procinfo.final_localsize:=localsize; if (target_info.system=system_x86_64_win64) then begin if localsize<>0 then list.concat(cai_seh_directive.create_offset(ash_stackalloc,localsize)); include(current_procinfo.flags,pi_has_unwind_info); end; end; end; end; { produces if necessary overflowcode } procedure tcgx86.g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef); var hl : tasmlabel; ai : taicpu; cond : TAsmCond; begin if not(cs_check_overflow in current_settings.localswitches) then exit; current_asmdata.getjumplabel(hl); if not ((def.typ=pointerdef) or ((def.typ=orddef) and (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, pasbool8,pasbool16,pasbool32,pasbool64]))) then cond:=C_NO else cond:=C_NB; ai:=Taicpu.Op_Sym(A_Jcc,S_NO,hl); ai.SetCondition(cond); ai.is_jmp:=true; list.concat(ai); a_call_name(list,'FPC_OVERFLOW',false); 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.