{ Copyright (c) 1998-2002 by Florian Klaempfl This unit implements the code generator for the SPARC 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. **************************************************************************** } unit cgcpu; {$i fpcdefs.inc} interface uses globtype,parabase, cgbase,cgutils,cgobj,cg64f32, aasmbase,aasmtai,aasmdata,aasmcpu, cpubase,cpuinfo, node,symconst,SymType,symdef, rgcpu; type TCgSparc=class(tcg) protected function IsSimpleRef(const ref:treference):boolean; public procedure init_register_allocators;override; procedure done_register_allocators;override; function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override; { sparc special, needed by cg64 } procedure make_simple_ref(list:TAsmList;var ref: treference); procedure make_simple_ref_sparc(list:TAsmList;var ref: treference;loadaddr : boolean;addrreg : tregister); procedure handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference); procedure handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister); { parameter } procedure a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara);override; procedure a_load_ref_cgpara(list:TAsmList;sz:tcgsize;const r:TReference;const paraloc:TCGPara);override; procedure a_loadaddr_ref_cgpara(list:TAsmList;const r:TReference;const paraloc:TCGPara);override; procedure a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override; procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override; procedure a_call_name(list:TAsmList;const s:string; weak: boolean);override; procedure a_call_reg(list:TAsmList;Reg:TRegister);override; { General purpose instructions } procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); procedure a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister);override; procedure a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister);override; procedure a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister);override; procedure a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override; procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override; procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override; { move instructions } procedure a_load_const_reg(list:TAsmList;size:tcgsize;a:tcgint;reg:tregister);override; procedure a_load_const_ref(list:TAsmList;size: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; { 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; { 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_reg_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);override; procedure a_jmp_always(List:TAsmList;l:TAsmLabel);override; procedure a_jmp_name(list : TAsmList;const s : string);override; procedure a_jmp_cond(list:TAsmList;cond:TOpCmp;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_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef);override; procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);override; procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; procedure g_maybe_got_init(list: TAsmList); override; procedure g_restore_registers(list:TAsmList);override; procedure g_save_registers(list : TAsmList);override; procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; 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_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override; { Transform unsupported methods into Internal errors } procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; private g1_used : boolean; use_unlimited_pic_mode : boolean; end; TCg64Sparc=class(tcg64f32) private procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean); public procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override; procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override; procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override; procedure a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64);override; procedure a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64);override; procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override; procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override; procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; end; procedure create_codegen; const TOpCG2AsmOp : array[topcg] of TAsmOp=( A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_SMUL,A_UMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SLL,A_SRL,A_SUB,A_XOR,A_NONE,A_NONE ); TOpCG2AsmOpWithFlags : array[topcg] of TAsmOp=( A_NONE,A_MOV,A_ADDcc,A_ANDcc,A_UDIVcc,A_SDIVcc,A_SMULcc,A_UMULcc,A_NEG,A_NOT,A_ORcc,A_SRA,A_SLL,A_SRL,A_SUBcc,A_XORcc,A_NONE,A_NONE ); 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 ); implementation uses globals,verbose,systems,cutils, paramgr,fmodule, symtable, tgobj, procinfo,cpupi; function TCgSparc.IsSimpleRef(const ref:treference):boolean; begin if (ref.base=NR_NO) and (ref.index<>NR_NO) then InternalError(2002100804); result :=not(assigned(ref.symbol))and (((ref.index = NR_NO) and (ref.offset >= simm13lo) and (ref.offset <= simm13hi)) or ((ref.index <> NR_NO) and (ref.offset = 0))); end; procedure tcgsparc.make_simple_ref(list:TAsmList;var ref: treference); begin make_simple_ref_sparc(list,ref,false,NR_NO); end; procedure tcgsparc.make_simple_ref_sparc(list:TAsmList;var ref: treference;loadaddr : boolean;addrreg : tregister); var tmpreg,tmpreg2 : tregister; tmpref : treference; need_add_got,need_got_load : boolean; begin if loadaddr then tmpreg:=addrreg else tmpreg:=NR_NO; need_add_got:=false; need_got_load:=false; { Be sure to have a base register } if (ref.base=NR_NO) then begin ref.base:=ref.index; ref.index:=NR_NO; end; if (cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags) and use_unlimited_pic_mode and assigned(ref.symbol) then begin if not(pi_needs_got in current_procinfo.flags) then begin {$ifdef CHECK_PIC} internalerror(200501161); {$endif CHECK_PIC} include(current_procinfo.flags,pi_needs_got); end; if current_procinfo.got=NR_NO then current_procinfo.got:=NR_L7; need_got_load:=true; need_add_got:=true; end; if (cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags) and not use_unlimited_pic_mode and assigned(ref.symbol) then begin if tmpreg=NR_NO then tmpreg:=GetIntRegister(list,OS_INT); reference_reset(tmpref,ref.alignment); tmpref.symbol:=ref.symbol; tmpref.refaddr:=addr_pic; if not(pi_needs_got in current_procinfo.flags) then begin {$ifdef CHECK_PIC} internalerror(200501161); {$endif CHECK_PIC} include(current_procinfo.flags,pi_needs_got); end; if current_procinfo.got=NR_NO then current_procinfo.got:=NR_L7; tmpref.index:=current_procinfo.got; list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg)); ref.symbol:=nil; if (ref.index<>NR_NO) then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg)); ref.index:=tmpreg; end else begin if ref.base<>NR_NO then ref.index:=tmpreg else ref.base:=tmpreg; end; end; { When need to use SETHI, do it first } if assigned(ref.symbol) or (ref.offsetsimm13hi) then begin if tmpreg=NR_NO then tmpreg:=GetIntRegister(list,OS_INT); reference_reset(tmpref,ref.alignment); tmpref.symbol:=ref.symbol; if not need_got_load then tmpref.offset:=ref.offset; tmpref.refaddr:=addr_high; list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,tmpreg)); if (ref.offset=0) and (ref.index=NR_NO) and (ref.base=NR_NO) and not need_add_got then begin ref.refaddr:=addr_low; end else begin { Load the low part is left } tmpref.refaddr:=addr_low; list.concat(taicpu.op_reg_ref_reg(A_OR,tmpreg,tmpref,tmpreg)); if not need_got_load then ref.offset:=0; { symbol is loaded } ref.symbol:=nil; end; if need_add_got then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,current_procinfo.got,tmpreg)); need_add_got:=false; end; if need_got_load then begin tmpref.refaddr:=addr_no; tmpref.base:=tmpreg; tmpref.symbol:=nil; list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg)); need_got_load:=false; if (ref.offsetsimm13hi) then begin tmpref.symbol:=nil; tmpref.offset:=ref.offset; tmpref.base:=tmpreg; tmpref.refaddr := addr_high; tmpreg2:=GetIntRegister(list,OS_INT); a_load_const_reg(list,OS_INT,ref.offset,tmpreg2); list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg2,tmpreg)); ref.offset:=0; end; end; if (ref.index<>NR_NO) then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg)); ref.index:=tmpreg; end else begin if ref.base<>NR_NO then ref.index:=tmpreg else ref.base:=tmpreg; end; end; if need_add_got then begin if tmpreg=NR_NO then tmpreg:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,current_procinfo.got,tmpreg)); ref.base:=tmpreg; ref.index:=NR_NO; end; if need_got_load then begin if tmpreg=NR_NO then tmpreg:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_ref_reg(A_LD,ref,tmpreg)); ref.base:=tmpreg; ref.index:=NR_NO; end; if (ref.base<>NR_NO) or loadaddr then begin if loadaddr then begin if ref.index<>NR_NO then list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg)); ref.base:=tmpreg; ref.index:=NR_NO; if ref.offset<>0 then list.concat(taicpu.op_reg_const_reg(A_ADD,ref.base,ref.offset,tmpreg)); end else if (ref.index<>NR_NO) and ((ref.offset<>0) or assigned(ref.symbol)) then begin if tmpreg=NR_NO then tmpreg:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg)); ref.base:=tmpreg; ref.index:=NR_NO; end; end; end; procedure tcgsparc.handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference); begin make_simple_ref(list,ref); if isstore then list.concat(taicpu.op_reg_ref(op,reg,ref)) else list.concat(taicpu.op_ref_reg(op,ref,reg)); end; procedure tcgsparc.handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister); var tmpreg : tregister; begin if (asimm13hi) then begin if g1_used then tmpreg:=GetIntRegister(list,OS_INT) else begin tmpreg:=NR_G1; g1_used:=true; end; a_load_const_reg(list,OS_INT,a,tmpreg); list.concat(taicpu.op_reg_reg_reg(op,src,tmpreg,dst)); if tmpreg=NR_G1 then g1_used:=false; end else list.concat(taicpu.op_reg_const_reg(op,src,a,dst)); end; {**************************************************************************** Assembler code ****************************************************************************} procedure Tcgsparc.init_register_allocators; begin inherited init_register_allocators; if (cs_create_pic in current_settings.moduleswitches) and assigned(current_procinfo) and (pi_needs_got in current_procinfo.flags) then begin current_procinfo.got:=NR_L7; rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD, [RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5, RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6], first_int_imreg,[]); end else rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD, [RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5, RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6,RS_L7], first_int_imreg,[]); rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBFS, [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7, RS_F8,RS_F9,RS_F10,RS_F11,RS_F12,RS_F13,RS_F14,RS_F15, RS_F16,RS_F17,RS_F18,RS_F19,RS_F20,RS_F21,RS_F22,RS_F23, RS_F24,RS_F25,RS_F26,RS_F27,RS_F28,RS_F29,RS_F30,RS_F31], first_fpu_imreg,[]); { needs at least one element for rgobj not to crash } rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE, [RS_L0],first_mm_imreg,[]); end; procedure Tcgsparc.done_register_allocators; begin rg[R_INTREGISTER].free; rg[R_FPUREGISTER].free; rg[R_MMREGISTER].free; inherited done_register_allocators; end; function tcgsparc.getfpuregister(list:TAsmList;size:Tcgsize):Tregister; begin if size=OS_F64 then result:=rg[R_FPUREGISTER].getregister(list,R_SUBFD) else result:=rg[R_FPUREGISTER].getregister(list,R_SUBFS); end; procedure TCgSparc.a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara); var Ref:TReference; begin paraloc.check_simple_location; paramanager.alloccgpara(list,paraloc); case paraloc.location^.loc of LOC_REGISTER,LOC_CREGISTER: a_load_const_reg(list,size,a,paraloc.location^.register); LOC_REFERENCE: begin { Code conventions need the parameters being allocated in %o6+92 } with paraloc.location^.Reference do begin if (Index=NR_SP) and (Offset=simm13lo) and (a<=simm13hi) then list.concat(taicpu.op_const_reg(A_MOV,a,reg)) else begin list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg)); list.concat(taicpu.op_reg_const_reg(A_OR,reg,aint(a) and aint($3ff),reg)); end; end; procedure TCgSparc.a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : TReference); begin if a=0 then a_load_reg_ref(list,size,size,NR_G0,ref) else inherited a_load_const_ref(list,size,a,ref); end; procedure TCgSparc.a_load_reg_ref(list:TAsmList;FromSize,ToSize:TCGSize;reg:tregister;const Ref:TReference); var op : tasmop; begin if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then fromsize := tosize; if (ref.alignment<>0) and (ref.alignment= TCGSize2Size[tosize]) then fromsize := tosize; if (ref.alignment<>0) and (ref.alignment tcgsize2size[tosize]) or ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and (fromsize <> tosize)) or { needs to mask out the sign in the top 16 bits } ((fromsize = OS_S8) and (tosize = OS_16)) then case tosize of OS_8 : a_op_const_reg_reg(list,OP_AND,tosize,$ff,reg1,reg2); OS_16 : begin list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2)); list.concat(taicpu.op_reg_const_reg(A_SRL,reg2,16,reg2)); end; OS_32, OS_S32 : begin instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2); list.Concat(instr); { Notify the register allocator that we have written a move instruction so it can try to eliminate it. } add_move_instruction(instr); end; OS_S8 : begin list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,24,reg2)); list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,24,reg2)); end; OS_S16 : begin list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2)); list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,16,reg2)); end; else internalerror(2002090901); end else begin instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2); list.Concat(instr); { Notify the register allocator that we have written a move instruction so it can try to eliminate it. } add_move_instruction(instr); end; end; procedure TCgSparc.a_loadaddr_ref_reg(list : TAsmList;const ref : TReference;r : tregister); var tmpref,href : treference; hreg,tmpreg,hreg2 : tregister; need_got,need_got_load : boolean; begin href:=ref; {$ifdef TEST_SIMPLE_SPARC} make_simple_ref_sparc(list,href,true,r); {$else} need_got:=false; need_got_load:=false; if (href.base=NR_NO) and (href.index<>NR_NO) then internalerror(200306171); if (cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags) and use_unlimited_pic_mode and assigned(ref.symbol) then begin if not(pi_needs_got in current_procinfo.flags) then begin {$ifdef CHECK_PIC} internalerror(200501161); {$endif CHECK_PIC} include(current_procinfo.flags,pi_needs_got); end; if current_procinfo.got=NR_NO then current_procinfo.got:=NR_L7; need_got_load:=true; need_got:=true; end; if (cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags) and not use_unlimited_pic_mode and assigned(href.symbol) then begin tmpreg:=GetIntRegister(list,OS_ADDR); reference_reset(tmpref,href.alignment); tmpref.symbol:=href.symbol; tmpref.refaddr:=addr_pic; if not(pi_needs_got in current_procinfo.flags) then begin {$ifdef CHECK_PIC} internalerror(200501161); {$endif CHECK_PIC} include(current_procinfo.flags,pi_needs_got); end; if current_procinfo.got=NR_NO then current_procinfo.got:=NR_L7; tmpref.base:=current_procinfo.got; list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg)); href.symbol:=nil; if (href.index<>NR_NO) then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,href.index,tmpreg)); href.index:=tmpreg; end else begin if href.base<>NR_NO then href.index:=tmpreg else href.base:=tmpreg; end; end; { At least big offset (need SETHI), maybe base and maybe index } if assigned(href.symbol) or (href.offsetsimm13hi) then begin hreg:=GetAddressRegister(list); reference_reset(tmpref,href.alignment); tmpref.symbol := href.symbol; if not need_got_load then tmpref.offset := href.offset; tmpref.refaddr := addr_high; list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,hreg)); { Only the low part is left } tmpref.refaddr:=addr_low; list.concat(taicpu.op_reg_ref_reg(A_OR,hreg,tmpref,hreg)); if need_got then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,current_procinfo.got,hreg)); need_got:=false; end; if need_got_load then begin tmpref.symbol:=nil; tmpref.base:=hreg; tmpref.refaddr:=addr_no; list.concat(taicpu.op_ref_reg(A_LD,tmpref,hreg)); need_got_load:=false; if (href.offsetsimm13hi) then begin tmpref.symbol:=nil; tmpref.offset:=href.offset; tmpref.refaddr := addr_high; hreg2:=GetIntRegister(list,OS_INT); a_load_const_reg(list,OS_INT,href.offset,hreg2); { Only the low part is left } list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,hreg2,hreg)); end else if (href.offset<>0) then begin list.concat(taicpu.op_reg_const_reg(A_ADD,hreg,href.offset,hreg)); end; end; if href.base<>NR_NO then begin if href.index<>NR_NO then begin list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,hreg)); list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r)); end else list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,r)); end else begin if hreg<>r then a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,r); end; end else { At least small offset, maybe base and maybe index } if href.offset<>0 then begin if href.base<>NR_NO then begin if href.index<>NR_NO then begin hreg:=GetAddressRegister(list); list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,hreg)); list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r)); end else list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,r)); end else list.concat(taicpu.op_const_reg(A_MOV,href.offset,r)); end else { Both base and index } if href.index<>NR_NO then list.concat(taicpu.op_reg_reg_reg(A_ADD,href.base,href.index,r)) else { Only base } if href.base<>NR_NO then a_load_reg_reg(list,OS_ADDR,OS_ADDR,href.base,r) else { only offset, can be generated by absolute } a_load_const_reg(list,OS_ADDR,href.offset,r); if need_got then list.concat(taicpu.op_reg_reg_reg(A_ADD,r,current_procinfo.got,r)); if need_got_load then list.concat(taicpu.op_reg_reg(A_LD,r,r)); {$endif} end; procedure TCgSparc.a_loadfpu_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1, reg2:tregister); const FpuMovInstr : Array[OS_F32..OS_F64,OS_F32..OS_F64] of TAsmOp = ((A_FMOVS,A_FSTOD),(A_FDTOS,A_FMOVD)); var op: TAsmOp; instr : taicpu; begin op:=fpumovinstr[fromsize,tosize]; instr:=taicpu.op_reg_reg(op,reg1,reg2); list.Concat(instr); { Notify the register allocator that we have written a move instruction so it can try to eliminate it. } if (op = A_FMOVS) or (op = A_FMOVD) then add_move_instruction(instr); end; procedure TCgSparc.a_loadfpu_ref_reg(list:TAsmList;fromsize,tosize:tcgsize;const ref:TReference;reg:tregister); const FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp = (A_LDF,A_LDDF); var tmpreg: tregister; begin tmpreg:=NR_NO; if (fromsize<>tosize) then begin tmpreg:=reg; reg:=getfpuregister(list,fromsize); end; handle_load_store(list,false,fpuloadinstr[fromsize],reg,ref); if (fromsize<>tosize) then a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg); end; procedure TCgSparc.a_loadfpu_reg_ref(list:TAsmList;fromsize,tosize:tcgsize;reg:tregister;const ref:TReference); const FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp = (A_STF,A_STDF); var tmpreg: tregister; begin if (fromsize<>tosize) then begin tmpreg:=getfpuregister(list,tosize); a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg); reg:=tmpreg; end; handle_load_store(list,true,fpuloadinstr[tosize],reg,ref); end; procedure tcgsparc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); const overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG]; begin if (op in overflowops) and (size in [OS_8,OS_S8,OS_16,OS_S16]) then a_load_reg_reg(list,OS_32,size,dst,dst); end; procedure TCgSparc.a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister); begin optimize_op_const(op,a); case op of OP_NONE: exit; OP_MOVE: a_load_const_reg(list,size,a,reg); OP_NEG,OP_NOT: internalerror(200306011); else a_op_const_reg_reg(list,op,size,a,reg,reg); end; end; procedure TCgSparc.a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister); var a : aint; begin Case Op of OP_NEG : list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],src,dst)); OP_NOT : begin case size of OS_8 : a:=aint($ffffff00); OS_16 : a:=aint($ffff0000); else a:=0; end; handle_reg_const_reg(list,A_XNOR,src,a,dst); end; else list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst)); end; maybeadjustresult(list,op,size,dst); end; procedure TCgSparc.a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister); var l: TLocation; begin a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,l); end; procedure TCgSparc.a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister); begin list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst)); maybeadjustresult(list,op,size,dst); end; procedure tcgsparc.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); var tmpreg1,tmpreg2 : tregister; begin ovloc.loc:=LOC_VOID; optimize_op_const(op,a); case op of OP_NONE: begin a_load_reg_reg(list,size,size,src,dst); exit; end; OP_MOVE: begin a_load_const_reg(list,size,a,dst); exit; end; end; if setflags then begin handle_reg_const_reg(list,TOpCG2AsmOpWithFlags[op],src,a,dst); case op of OP_MUL: begin tmpreg1:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1)); ovloc.loc:=LOC_FLAGS; ovloc.resflags:=F_NE; end; OP_IMUL: begin tmpreg1:=GetIntRegister(list,OS_INT); tmpreg2:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); list.concat(taicpu.op_reg_const_reg(A_SRA,dst,31,tmpreg2)); list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2)); ovloc.loc:=LOC_FLAGS; ovloc.resflags:=F_NE; end; end; end else handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst); maybeadjustresult(list,op,size,dst); end; procedure tcgsparc.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); var tmpreg1,tmpreg2 : tregister; begin ovloc.loc:=LOC_VOID; if setflags then begin list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpWithFlags[op],src2,src1,dst)); case op of OP_MUL: begin tmpreg1:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1)); ovloc.loc:=LOC_FLAGS; ovloc.resflags:=F_NE; end; OP_IMUL: begin tmpreg1:=GetIntRegister(list,OS_INT); tmpreg2:=GetIntRegister(list,OS_INT); list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2)); list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2)); ovloc.loc:=LOC_FLAGS; ovloc.resflags:=F_NE; end; end; end else list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst)); maybeadjustresult(list,op,size,dst); end; {*************** compare instructructions ****************} procedure TCgSparc.a_cmp_const_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;a:tcgint;reg:tregister;l:tasmlabel); begin if (a=0) then list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg,NR_G0,NR_G0)) else handle_reg_const_reg(list,A_SUBcc,reg,a,NR_G0); a_jmp_cond(list,cmp_op,l); end; procedure TCgSparc.a_cmp_reg_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel); begin list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg2,reg1,NR_G0)); a_jmp_cond(list,cmp_op,l); end; procedure TCgSparc.a_jmp_always(List:TAsmList;l:TAsmLabel); begin List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(l.name))); { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end; procedure tcgsparc.a_jmp_name(list : TAsmList;const s : string); begin List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(s))); { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end; procedure TCgSparc.a_jmp_cond(list:TAsmList;cond:TOpCmp;l:TAsmLabel); var ai:TAiCpu; begin ai:=TAiCpu.Op_sym(A_Bxx,l); ai.SetCondition(TOpCmp2AsmCond[cond]); list.Concat(ai); { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end; procedure TCgSparc.a_jmp_flags(list:TAsmList;const f:TResFlags;l:tasmlabel); var ai : taicpu; op : tasmop; begin if f in [F_FE,F_FNE,F_FG,F_FL,F_FGE,F_FLE] then op:=A_FBxx else op:=A_Bxx; ai := Taicpu.op_sym(op,l); ai.SetCondition(flags_to_cond(f)); list.Concat(ai); { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end; procedure TCgSparc.g_flags2reg(list:TAsmList;Size:TCgSize;const f:tresflags;reg:TRegister); var hl : tasmlabel; begin current_asmdata.getjumplabel(hl); a_load_const_reg(list,size,1,reg); a_jmp_flags(list,f,hl); a_load_const_reg(list,size,0,reg); a_label(list,hl); end; procedure tcgsparc.g_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef); var l : tlocation; begin l.loc:=LOC_VOID; g_overflowCheck_loc(list,loc,def,l); end; procedure TCgSparc.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation); var hl : tasmlabel; ai:TAiCpu; hflags : tresflags; begin if not(cs_check_overflow in current_settings.localswitches) then exit; current_asmdata.getjumplabel(hl); case ovloc.loc of LOC_VOID: begin if not((def.typ=pointerdef) or ((def.typ=orddef) and (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, pasbool8,pasbool16,pasbool32,pasbool64]))) then begin ai:=TAiCpu.Op_sym(A_Bxx,hl); ai.SetCondition(C_NO); list.Concat(ai); { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end else a_jmp_cond(list,OC_AE,hl); end; LOC_FLAGS: begin hflags:=ovloc.resflags; inverse_flags(hflags); cg.a_jmp_flags(list,hflags,hl); end; else internalerror(200409281); end; a_call_name(list,'FPC_OVERFLOW',false); a_label(list,hl); end; { *********** entry/exit code and address loading ************ } procedure TCgSparc.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); begin if nostackframe then exit; { Althogh the SPARC architecture require only word alignment, software convention and the operating system require every stack frame to be double word aligned } LocalSize:=align(LocalSize,8); { Execute the SAVE instruction to get a new register window and create a new stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state before execution of the SAVE instrucion so it is the caller %i6, when the %i6 after execution of that instruction is the called function stack pointer} { constant can be 13 bit signed, since it's negative, size can be max. 4096 } if LocalSize>4096 then begin a_load_const_reg(list,OS_ADDR,-LocalSize,NR_G1); g1_used:=true; list.concat(Taicpu.Op_reg_reg_reg(A_SAVE,NR_STACK_POINTER_REG,NR_G1,NR_STACK_POINTER_REG)); g1_used:=false; end else list.concat(Taicpu.Op_reg_const_reg(A_SAVE,NR_STACK_POINTER_REG,-LocalSize,NR_STACK_POINTER_REG)); end; procedure TCgSparc.g_maybe_got_init(list : TAsmList); var ref : treference; hl : tasmlabel; begin if (cs_create_pic in current_settings.moduleswitches) and (pi_needs_got in current_procinfo.flags) then begin current_procinfo.got:=NR_L7; current_asmdata.getjumplabel(hl); list.concat(taicpu.op_sym(A_CALL,hl)); { ABI recommends the following sequence: 1: call 2f sethi %hi(_GLOBAL_OFFSET_TABLE_+(.-1b)), %l7 2: or %l7, %lo(_GLOBAL_OFFSET_TABLE_+(.-1b)), %l7 add %l7, %o7, %l7 } reference_reset_symbol(ref,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),4,sizeof(pint)); ref.refaddr:=addr_high; list.concat(taicpu.op_ref_reg(A_SETHI,ref,NR_L7)); cg.a_label(list,hl); ref.refaddr:=addr_low; ref.offset:=8; list.concat(Taicpu.Op_reg_ref_reg(A_OR,NR_L7,ref,NR_L7)); list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_L7,NR_O7,NR_L7)); end; end; procedure TCgSparc.g_restore_registers(list:TAsmList); begin { The sparc port uses the sparc standard calling convetions so this function has no used } end; procedure TCgSparc.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); var hr : treference; begin if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then begin reference_reset(hr,sizeof(pint)); hr.offset:=12; hr.refaddr:=addr_full; if nostackframe then begin hr.base:=NR_O7; list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0)); list.concat(Taicpu.op_none(A_NOP)) end else begin { We use trivial restore in the delay slot of the JMPL instruction, as we already set result onto %i0 } hr.base:=NR_I7; list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0)); list.concat(Taicpu.op_none(A_RESTORE)); end; end else begin if nostackframe then begin { Here we need to use RETL instead of RET so it uses %o7 } list.concat(Taicpu.op_none(A_RETL)); list.concat(Taicpu.op_none(A_NOP)) end else begin { We use trivial restore in the delay slot of the JMPL instruction, as we already set result onto %i0 } list.concat(Taicpu.op_none(A_RET)); list.concat(Taicpu.op_none(A_RESTORE)); end; end; end; procedure TCgSparc.g_save_registers(list : TAsmList); begin { The sparc port uses the sparc standard calling convetions so this function has no used } end; { ************* concatcopy ************ } procedure tcgsparc.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); var paraloc1,paraloc2,paraloc3 : TCGPara; pd : tprocdef; begin pd:=search_system_proc('MOVE'); paraloc1.init; paraloc2.init; paraloc3.init; paramanager.getintparaloc(pd,1,paraloc1); paramanager.getintparaloc(pd,2,paraloc2); paramanager.getintparaloc(pd,3,paraloc3); a_load_const_cgpara(list,OS_SINT,len,paraloc3); a_loadaddr_ref_cgpara(list,dest,paraloc2); a_loadaddr_ref_cgpara(list,source,paraloc1); paramanager.freecgpara(list,paraloc3); paramanager.freecgpara(list,paraloc2); paramanager.freecgpara(list,paraloc1); alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_MOVE',false); dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc3.done; paraloc2.done; paraloc1.done; end; procedure TCgSparc.g_concatcopy(list:TAsmList;const source,dest:treference;len:tcgint); var tmpreg1, hreg, countreg: TRegister; src, dst: TReference; lab: tasmlabel; count, count2: aint; function reference_is_reusable(const ref: treference): boolean; begin result:=(ref.base<>NR_NO) and (ref.index=NR_NO) and (ref.symbol=nil) and (ref.offset>=simm13lo) and (ref.offset+len<=simm13hi); end; begin if len>high(longint) then internalerror(2002072704); { anybody wants to determine a good value here :)? } if len>100 then g_concatcopy_move(list,source,dest,len) else begin count:=len div 4; if (count<=4) and reference_is_reusable(source) then src:=source else begin reference_reset_base(src,getintregister(list,OS_ADDR),0,sizeof(aint)); a_loadaddr_ref_reg(list,source,src.base); end; if (count<=4) and reference_is_reusable(dest) then dst:=dest else begin reference_reset_base(dst,getintregister(list,OS_ADDR),0,sizeof(aint)); a_loadaddr_ref_reg(list,dest,dst.base); end; { generate a loop } if count>4 then begin countreg:=GetIntRegister(list,OS_INT); tmpreg1:=GetIntRegister(list,OS_INT); a_load_const_reg(list,OS_INT,count,countreg); current_asmdata.getjumplabel(lab); a_label(list, lab); list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst)); list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,4,src.base)); list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,4,dst.base)); list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg)); a_jmp_cond(list,OC_NE,lab); len := len mod 4; end; { unrolled loop } count:=len div 4; if count>0 then begin tmpreg1:=GetIntRegister(list,OS_INT); for count2 := 1 to count do begin list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst)); inc(src.offset,4); inc(dst.offset,4); end; len := len mod 4; end; if (len and 4) <> 0 then begin hreg:=GetIntRegister(list,OS_INT); a_load_ref_reg(list,OS_32,OS_32,src,hreg); a_load_reg_ref(list,OS_32,OS_32,hreg,dst); inc(src.offset,4); inc(dst.offset,4); end; { copy the leftovers } if (len and 2) <> 0 then begin hreg:=GetIntRegister(list,OS_INT); a_load_ref_reg(list,OS_16,OS_16,src,hreg); a_load_reg_ref(list,OS_16,OS_16,hreg,dst); inc(src.offset,2); inc(dst.offset,2); end; if (len and 1) <> 0 then begin hreg:=GetIntRegister(list,OS_INT); a_load_ref_reg(list,OS_8,OS_8,src,hreg); a_load_reg_ref(list,OS_8,OS_8,hreg,dst); end; end; end; procedure tcgsparc.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint); var src, dst: TReference; tmpreg1, countreg: TRegister; i : aint; lab: tasmlabel; begin if len>31 then g_concatcopy_move(list,source,dest,len) else begin reference_reset(src,source.alignment); reference_reset(dst,dest.alignment); { load the address of source into src.base } src.base:=GetAddressRegister(list); a_loadaddr_ref_reg(list,source,src.base); { load the address of dest into dst.base } dst.base:=GetAddressRegister(list); a_loadaddr_ref_reg(list,dest,dst.base); { generate a loop } if len>4 then begin countreg:=GetIntRegister(list,OS_INT); tmpreg1:=GetIntRegister(list,OS_INT); a_load_const_reg(list,OS_INT,len,countreg); current_asmdata.getjumplabel(lab); a_label(list, lab); list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst)); list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,1,src.base)); list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,1,dst.base)); list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg)); a_jmp_cond(list,OC_NE,lab); end else begin { unrolled loop } tmpreg1:=GetIntRegister(list,OS_INT); for i:=1 to len do begin list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst)); inc(src.offset); inc(dst.offset); end; end; end; end; procedure tcgsparc.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); var 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.extnumber=$ffff) then Internalerror(200006139); { mov 0(%rdi),%rax ; load vmt} reference_reset_base(href,NR_O0,0,sizeof(pint)); cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1); g1_used:=true; { 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)); g1_used:=false; { Delay slot } list.Concat(TAiCpu.Op_none(A_NOP)); end else begin { Emit a branch, which is PIC-safe, but limited to 8 MByte range on SPARC. Since interface wrappers are always located in the same unit with their target methods, this limit applies (roughly) to code size of single unit, not to entire program. It looks like a reasonable tradeoff. If distance limit is ever exceeded, consider changing high-level compiler logic to emit wrappers near target methods, not at the end of unit. } a_jmp_name(list,procdef.mangledname); end; 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; procedure tcgsparc.g_stackpointer_alloc(list : TAsmList;localsize : longint); begin Comment(V_Error,'tcgsparc.g_stackpointer_alloc method not implemented'); end; procedure tcgsparc.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); begin Comment(V_Error,'tcgsparc.a_bit_scan_reg_reg method not implemented'); end; {**************************************************************************** TCG64Sparc ****************************************************************************} procedure tcg64sparc.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); var tmpref: treference; begin { Override this function to prevent loading the reference twice } tmpref:=ref; cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref); inc(tmpref.offset,4); cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref); end; procedure tcg64sparc.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); var tmpref: treference; begin { Override this function to prevent loading the reference twice } tmpref:=ref; cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi); inc(tmpref.offset,4); cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo); end; procedure tcg64sparc.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); var hreg64 : tregister64; begin { Override this function to prevent loading the reference twice. Use here some extra registers, but those are optimized away by the RA } hreg64.reglo:=cg.GetIntRegister(list,OS_32); hreg64.reghi:=cg.GetIntRegister(list,OS_32); a_load64_ref_reg(list,r,hreg64); a_load64_reg_cgpara(list,hreg64,paraloc); end; procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean); begin case op of OP_ADD : begin op1:=A_ADDCC; if checkoverflow then op2:=A_ADDXCC else op2:=A_ADDX; end; OP_SUB : begin op1:=A_SUBCC; if checkoverflow then op2:=A_SUBXCC else op2:=A_SUBX; end; OP_XOR : begin op1:=A_XOR; op2:=A_XOR; end; OP_OR : begin op1:=A_OR; op2:=A_OR; end; OP_AND : begin op1:=A_AND; op2:=A_AND; end; else internalerror(200203241); end; end; procedure TCg64Sparc.a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64); var op1,op2 : TAsmOp; begin case op of OP_NEG : begin { Use the simple code: y=0-z } list.concat(taicpu.op_reg_reg_reg(A_SUBcc,NR_G0,regsrc.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,regsrc.reghi,regdst.reghi)); exit; end; OP_NOT : begin list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reglo,NR_G0,regdst.reglo)); list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reghi,NR_G0,regdst.reghi)); exit; end; end; get_64bit_ops(op,op1,op2,false); list.concat(taicpu.op_reg_reg_reg(op1,regdst.reglo,regsrc.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg_reg(op2,regdst.reghi,regsrc.reghi,regdst.reghi)); end; procedure TCg64Sparc.a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64); var op1,op2:TAsmOp; begin case op of OP_NEG, OP_NOT : internalerror(200306017); end; get_64bit_ops(op,op1,op2,false); tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,tcgint(lo(value)),regdst.reglo); tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,tcgint(hi(value)),regdst.reghi); end; procedure tcg64sparc.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64); var l : tlocation; begin a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,l); end; procedure tcg64sparc.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64); var l : tlocation; begin a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,l); end; procedure tcg64sparc.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation); var op1,op2:TAsmOp; begin case op of OP_NEG, OP_NOT : internalerror(200306017); end; get_64bit_ops(op,op1,op2,setflags); tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,tcgint(lo(value)),regdst.reglo); tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,tcgint(hi(value)),regdst.reghi); end; procedure tcg64sparc.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation); var op1,op2:TAsmOp; begin case op of OP_NEG, OP_NOT : internalerror(200306017); end; get_64bit_ops(op,op1,op2,setflags); list.concat(taicpu.op_reg_reg_reg(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi)); end; procedure create_codegen; begin cg:=TCgSparc.Create; if target_info.system=system_sparc_linux then TCgSparc(cg).use_unlimited_pic_mode:=true else TCgSparc(cg).use_unlimited_pic_mode:=false; cg64:=TCg64Sparc.Create; end; end.