{ Copyright (c) 2008 by Florian Klaempfl Member of the Free Pascal development team This unit implements the code generator for the Z80 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,symtype,symdef, cgbase,cgutils,cgobj, aasmbase,aasmcpu,aasmtai,aasmdata, parabase, cpubase,cpuinfo,node,cg64f32,rgcpu; type tregisterlist = array of tregister; { tcgz80 } tcgz80 = class(tcg) { true, if the next arithmetic operation should modify the flags } cgsetflags : boolean; procedure init_register_allocators;override; procedure done_register_allocators;override; procedure getcpuregisters(list:TAsmList;regs:tregisterlist); procedure ungetcpuregisters(list:TAsmList;regs:tregisterlist); function getaddressregister(list:TAsmList):TRegister;override; function GetOffsetReg(const r: TRegister;ofs : shortint): TRegister;override; function GetOffsetReg64(const r,rhi: TRegister;ofs : shortint): TRegister;override; procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override; procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);override; procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override; procedure a_load_reg_cgpara(list : TAsmList; size : tcgsize;r : tregister; const cgpara : tcgpara);override; procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);override; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; procedure a_call_reg(list : TAsmList;reg: tregister);override; 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; { 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; { 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_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; { Z80-specific unsigned comparison code generation jmp helper } procedure a_jmp_unsigned_cmp_3way(list : TAsmList;onbelow,onequal,onabove: tasmlabel); { Z80-specific signed comparison code generation jmp helper. Should follow a SUB instruction, and the A register must still contain the result. } procedure a_jmp_signed_cmp_3way(list : TAsmList;onless,onequal,ongreater: tasmlabel); procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override; procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override; procedure g_save_registers(list : TAsmList);override; procedure g_restore_registers(list : TAsmList);override; procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); function normalize_ref(list : TAsmList;ref : treference; const refopertypes:trefoperandtypes; out allocatedregs:tregisterlist) : treference; procedure adjust_normalized_ref(list: TAsmList;var ref: treference; value: longint); procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister); procedure a_adjust_sp(list: TAsmList; value: longint); protected procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister); procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister); procedure maybegetcpuregister(list : tasmlist; reg : tregister); end; tcg64fz80 = class(tcg64f32) 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;reg : tregister64);override; end; function GetByteLoc(const loc : tlocation;nr : byte) : tlocation; procedure create_codegen; const TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_LD,A_ADD,A_AND,A_NONE, A_NONE,A_NONE,A_NONE,A_NEG,A_CPL,A_OR, A_SRA,A_SLA,A_SRL,A_SUB,A_XOR,A_RLCA,A_RRCA); implementation uses globals,verbose,systems,cutils, fmodule, symconst,symsym,symtable, tgobj,rgobj, procinfo,cpupi, paramgr; function use_push(const cgpara:tcgpara):boolean; begin result:=(not paramanager.use_fixed_stack) and assigned(cgpara.location) and (cgpara.location^.loc=LOC_REFERENCE) and (cgpara.location^.reference.index=NR_STACK_POINTER_REG); end; procedure tcgz80.init_register_allocators; begin inherited init_register_allocators; rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE, [RS_A,RS_B,RS_C,RS_D,RS_E,RS_H,RS_L],first_int_imreg,[]); end; procedure tcgz80.done_register_allocators; begin rg[R_INTREGISTER].free; // rg[R_ADDRESSREGISTER].free; inherited done_register_allocators; end; procedure tcgz80.getcpuregisters(list: TAsmList; regs: tregisterlist); var r: tregister; begin for r in regs do getcpuregister(list,r); end; procedure tcgz80.ungetcpuregisters(list: TAsmList; regs: tregisterlist); var r: tregister; begin for r in regs do ungetcpuregister(list,r); end; function tcgz80.getaddressregister(list: TAsmList): TRegister; begin Result:=getintregister(list,OS_ADDR); end; function tcgz80.GetOffsetReg(const r: TRegister; ofs: shortint): TRegister; var i: Integer; begin result:=r; for i:=1 to ofs do result:=GetNextReg(result); end; function tcgz80.GetOffsetReg64(const r, rhi: TRegister; ofs: shortint): TRegister; var i: Integer; begin if ofs>=4 then begin result:=rhi; dec(ofs,4); end else result:=r; for i:=1 to ofs do result:=GetNextReg(result); end; procedure tcgz80.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara); procedure load_para_loc(r : TRegister;paraloc : PCGParaLocation); var ref : treference; begin paramanager.allocparaloc(list,paraloc); case paraloc^.loc of LOC_REGISTER,LOC_CREGISTER: a_load_reg_reg(list,paraloc^.size,paraloc^.size,r,paraloc^.register); LOC_REFERENCE,LOC_CREFERENCE: begin reference_reset_base(ref,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,2,[]); a_load_reg_ref(list,paraloc^.size,paraloc^.size,r,ref); end; else internalerror(2002071004); end; end; var i, i2 : longint; hp : PCGParaLocation; begin if use_push(cgpara) then begin case tcgsize2size[cgpara.Size] of 1: begin cgpara.check_simple_location; getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,r,NR_A); list.concat(taicpu.op_reg(A_PUSH,NR_AF)); list.concat(taicpu.op_reg(A_INC,NR_SP)); ungetcpuregister(list,NR_A); end; 2: begin cgpara.check_simple_location; getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,r,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(r),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); getcpuregister(list,NR_H); getcpuregister(list,NR_L); end; 4: begin cgpara.check_simple_location; getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(GetNextReg(r)),NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(GetNextReg(GetNextReg(r))),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); getcpuregister(list,NR_H); getcpuregister(list,NR_L); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,r,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(r),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); getcpuregister(list,NR_H); getcpuregister(list,NR_L); end; else internalerror(2020040801); end; { if tcgsize2size[cgpara.Size] > 2 then begin if tcgsize2size[cgpara.Size] <> 4 then internalerror(2013031101); if cgpara.location^.Next = nil then begin if tcgsize2size[cgpara.location^.size] <> 4 then internalerror(2013031101); end else begin if tcgsize2size[cgpara.location^.size] <> 2 then internalerror(2013031101); if tcgsize2size[cgpara.location^.Next^.size] <> 2 then internalerror(2013031101); if cgpara.location^.Next^.Next <> nil then internalerror(2013031101); end; if tcgsize2size[cgpara.size]>cgpara.alignment then pushsize:=cgpara.size else pushsize:=int_cgsize(cgpara.alignment); pushsize2 := int_cgsize(tcgsize2size[pushsize] - 2); list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize2],makeregsize(list,GetNextReg(r),pushsize2))); list.concat(taicpu.op_reg(A_PUSH,S_W,makeregsize(list,r,OS_16))); end else begin cgpara.check_simple_location; if tcgsize2size[cgpara.location^.size]>cgpara.alignment then pushsize:=cgpara.location^.size else pushsize:=int_cgsize(cgpara.alignment); list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],makeregsize(list,r,pushsize))); end;} end else begin if not(tcgsize2size[cgpara.Size] in [1..4]) then internalerror(2014011101); hp:=cgpara.location; i:=0; while i1) or (hp^.shiftval<>0) then internalerror(2015041101); a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register); inc(i,tcgsize2size[hp^.size]); hp:=hp^.Next; end; LOC_REFERENCE,LOC_CREFERENCE: begin reference_reset(ref,paraloc.alignment,[]); ref.base:=hp^.reference.index; ref.offset:=hp^.reference.offset; a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref); inc(i,tcgsize2size[hp^.size]); hp:=hp^.Next; end; else internalerror(2002071004); end; end; end; end; procedure tcgz80.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara); procedure pushdata(paraloc:pcgparalocation;ofs:tcgint); var pushsize : tcgsize; opsize : topsize; tmpreg : tregister; href,tmpref: treference; begin if not assigned(paraloc) then exit; if (paraloc^.loc<>LOC_REFERENCE) or (paraloc^.reference.index<>NR_STACK_POINTER_REG) or (tcgsize2size[paraloc^.size]>4) then internalerror(200501162); { Pushes are needed in reverse order, add the size of the current location to the offset where to load from. This prevents wrong calculations for the last location when the size is not a power of 2 } if assigned(paraloc^.next) then pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]); { Push the data starting at ofs } href:=r; inc(href.offset,ofs); {if tcgsize2size[paraloc^.size]>cgpara.alignment then} pushsize:=paraloc^.size {else pushsize:=int_cgsize(cgpara.alignment)}; {Writeln(pushsize);} case tcgsize2size[pushsize] of 1: begin tmpreg:=getintregister(list,OS_8); a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg); getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_A); list.concat(taicpu.op_reg(A_PUSH,NR_AF)); list.concat(taicpu.op_reg(A_INC,NR_SP)); ungetcpuregister(list,NR_A); end; 2: begin tmpreg:=getintregister(list,OS_16); a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); ungetcpuregister(list,NR_H); ungetcpuregister(list,NR_L); end; 4: begin tmpreg:=getintregister(list,OS_16); inc(href.offset,2); a_load_ref_reg(list,OS_16,OS_16,href,tmpreg); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); ungetcpuregister(list,NR_H); ungetcpuregister(list,NR_L); dec(href.offset,2); a_load_ref_reg(list,OS_16,OS_16,href,tmpreg); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H); list.concat(taicpu.op_reg(A_PUSH,NR_HL)); ungetcpuregister(list,NR_H); ungetcpuregister(list,NR_L); end; else internalerror(2020040803); end; //if tcgsize2size[paraloc^.size] 2 then // begin // tmpref := href; // Inc(tmpref.offset, 2); // list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[int_cgsize(tcgsize2size[pushsize]-2)],tmpref)); // end; // list.concat(taicpu.op_ref(A_PUSH,opsize,href)); // end; end; var tmpref, ref, href: treference; location: pcgparalocation; sizeleft: tcgint; len: tcgint; begin { cgpara.size=OS_NO requires a copy on the stack } if use_push(cgpara) then begin { Record copy? } if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then begin cgpara.check_simple_location; len:=align(cgpara.intsize,cgpara.alignment); g_stackpointer_alloc(list,len); reference_reset_base(href,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]); g_concatcopy(list,r,href,len); end else begin if tcgsize2size[cgpara.size]<>tcgsize2size[size] then internalerror(200501161); { We need to push the data in reverse order, therefor we use a recursive algorithm } pushdata(cgpara.location,0); end end else begin location := cgpara.location; tmpref := r; sizeleft := cgpara.intsize; while assigned(location) do begin paramanager.allocparaloc(list,location); case location^.loc of LOC_REGISTER,LOC_CREGISTER: a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register); LOC_REFERENCE: begin reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,cgpara.alignment,[]); { doubles in softemu mode have a strange order of registers and references } if location^.size=OS_32 then g_concatcopy(list,tmpref,ref,4) else begin g_concatcopy(list,tmpref,ref,sizeleft); if assigned(location^.next) then internalerror(2005010710); end; end; LOC_VOID: begin // nothing to do end; else internalerror(2002081103); end; inc(tmpref.offset,tcgsize2size[location^.size]); dec(sizeleft,tcgsize2size[location^.size]); location := location^.next; end; end; end; procedure tcgz80.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara); var tmpreg: tregister; begin tmpreg:=getaddressregister(list); a_loadaddr_ref_reg(list,r,tmpreg); a_load_reg_cgpara(list,OS_ADDR,tmpreg,paraloc); end; procedure tcgz80.a_call_name(list : TAsmList;const s : string; weak: boolean); var sym: TAsmSymbol; begin if weak then sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION) else sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION); list.concat(taicpu.op_sym(A_CALL,sym)); include(current_procinfo.flags,pi_do_call); end; procedure tcgz80.a_call_reg(list : TAsmList;reg: tregister); var l : TAsmLabel; ref : treference; begin { HACK: at this point all registers are allocated, due to the way the calling convention works, but we need to free some registers, in order for the following code to work, so we do it here } dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,reg,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(reg),NR_H); current_asmdata.getjumplabel(l); reference_reset(ref,0,[]); ref.symbol:=l; list.concat(taicpu.op_ref_reg(A_LD,ref,NR_HL)); ungetcpuregister(list,NR_H); ungetcpuregister(list,NR_L); { allocate them again, right before the actual call instruction } alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); list.concat(tai_const.Create_8bit($CD)); { $CD is the opcode of the call instruction } list.concat(tai_label.Create(l)); list.concat(tai_const.Create_16bit(0)); include(current_procinfo.flags,pi_do_call); end; procedure tcgz80.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); begin if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then internalerror(2012102403); a_op_const_reg_internal(list,Op,size,a,reg,NR_NO); end; procedure tcgz80.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); begin if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then internalerror(2012102401); a_op_reg_reg_internal(list,Op,size,src,NR_NO,dst,NR_NO); end; procedure tcgz80.a_op_reg_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister); var i : integer; procedure NextSrcDst; begin if i=5 then begin dst:=dsthi; src:=srchi; end else begin dst:=GetNextReg(dst); src:=GetNextReg(src); end; end; var tmpreg,tmpreg2: tregister; instr : taicpu; l1,l2 : tasmlabel; begin case op of OP_ADD: begin getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,dst,NR_A); list.concat(taicpu.op_reg_reg(A_ADD,NR_A,src)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then begin for i:=2 to tcgsize2size[size] do begin NextSrcDst; a_load_reg_reg(list,OS_8,OS_8,dst,NR_A); list.concat(taicpu.op_reg_reg(A_ADC,NR_A,src)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); end; end; ungetcpuregister(list,NR_A); end; OP_SUB: begin getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,dst,NR_A); list.concat(taicpu.op_reg_reg(A_SUB,NR_A,src)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then begin for i:=2 to tcgsize2size[size] do begin NextSrcDst; a_load_reg_reg(list,OS_8,OS_8,dst,NR_A); list.concat(taicpu.op_reg_reg(A_SBC,NR_A,src)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); end; end; ungetcpuregister(list,NR_A); end; OP_NEG: begin getcpuregister(list,NR_A); if tcgsize2size[size]>=2 then begin tmpreg:=GetNextReg(src); tmpreg2:=GetNextReg(dst); for i:=2 to tcgsize2size[size] do begin a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_A); list.concat(taicpu.op_none(A_CPL)); a_load_reg_reg(list,OS_8,OS_8,NR_A,tmpreg2); if i<>tcgsize2size[size] then begin if i=4 then begin tmpreg:=srchi; tmpreg2:=dsthi; end else begin tmpreg:=GetNextReg(tmpreg); tmpreg2:=GetNextReg(tmpreg2); end; end; end; end; a_load_reg_reg(list,OS_8,OS_8,src,NR_A); list.concat(taicpu.op_none(A_NEG)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); if tcgsize2size[size]>=2 then begin tmpreg2:=GetNextReg(dst); for i:=2 to tcgsize2size[size] do begin a_load_reg_reg(list,OS_8,OS_8,tmpreg2,NR_A); list.concat(taicpu.op_reg_const(A_SBC,NR_A,-1)); a_load_reg_reg(list,OS_8,OS_8,NR_A,tmpreg2); if i<>tcgsize2size[size] then begin if i=4 then begin tmpreg2:=dsthi; end else begin tmpreg2:=GetNextReg(tmpreg2); end; end; end; end; ungetcpuregister(list,NR_A); end; OP_NOT: begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[size] do begin if i<>1 then NextSrcDst; a_load_reg_reg(list,OS_8,OS_8,src,NR_A); list.concat(taicpu.op_none(A_CPL)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); end; ungetcpuregister(list,NR_A); end; OP_MUL,OP_IMUL: begin { special stuff, needs separate handling inside code generator } list.Concat(tai_comment.Create(strpnew('WARNING! not implemented: a_op_reg_reg_internal OP_MUL/OP_IMUL'))); {internalerror(2017032604);} end; OP_DIV,OP_IDIV: { special stuff, needs separate handling inside code generator } internalerror(2017032604); OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR: begin current_asmdata.getjumplabel(l1); current_asmdata.getjumplabel(l2); getcpuregister(list,NR_B); emit_mov(list,NR_B,src); list.concat(taicpu.op_reg(A_INC,NR_B)); list.concat(taicpu.op_reg(A_DEC,NR_B)); a_jmp_flags(list,F_E,l2); if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then case op of OP_ROL: begin list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))); list.concat(taicpu.op_reg(A_RLC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))); end; OP_ROR: begin list.concat(taicpu.op_reg(A_RLC,dst)); list.concat(taicpu.op_reg(A_RRC,dst)); end; else ; end; cg.a_label(list,l1); case op of OP_SHL: list.concat(taicpu.op_reg(A_SLA,dst)); OP_SHR: list.concat(taicpu.op_reg(A_SRL,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))); OP_SAR: list.concat(taicpu.op_reg(A_SRA,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))); OP_ROL: if size in [OS_8,OS_S8] then list.concat(taicpu.op_reg(A_RLC,dst)) else list.concat(taicpu.op_reg(A_RL,dst)); OP_ROR: if size in [OS_8,OS_S8] then list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))) else list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1))); else internalerror(2020040903); end; if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then begin for i:=2 to tcgsize2size[size] do begin case op of OP_ROR, OP_SHR, OP_SAR: list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-i))); OP_ROL, OP_SHL: list.concat(taicpu.op_reg(A_RL,GetOffsetReg64(dst,dsthi,i-1))); else internalerror(2020040904); end; end; end; instr:=taicpu.op_sym(A_DJNZ,l1); instr.is_jmp:=true; list.concat(instr); ungetcpuregister(list,NR_B); cg.a_label(list,l2); end; OP_AND,OP_OR,OP_XOR: begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[size] do begin if i<>1 then NextSrcDst; a_load_reg_reg(list,OS_8,OS_8,dst,NR_A); list.concat(taicpu.op_reg_reg(topcg2asmop[op],NR_A,src)); a_load_reg_reg(list,OS_8,OS_8,NR_A,dst); end; ungetcpuregister(list,NR_A); end; else internalerror(2011022004); end; end; procedure tcgz80.a_op_const_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister); var i : byte; procedure NextReg; begin if i=4 then reg:=reghi else reg:=GetNextReg(reg); end; var mask : qword; shift : byte; curvalue : byte; tmpop: TAsmOp; l1: TAsmLabel; instr: taicpu; tmpreg : tregister; tmpreg64 : tregister64; begin optimize_op_const(size,op,a); mask:=$ff; shift:=0; 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_AND: begin curvalue:=a and mask; for i:=1 to tcgsize2size[size] do begin case curvalue of 0: list.concat(taicpu.op_reg_const(A_LD,reg,0)); $ff: {nothing}; else begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_reg_const(A_AND,NR_A,curvalue)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; end; if i<>tcgsize2size[size] then begin NextReg; mask:=mask shl 8; inc(shift,8); curvalue:=(qword(a) and mask) shr shift; end; end; end; OP_OR: begin curvalue:=a and mask; for i:=1 to tcgsize2size[size] do begin case curvalue of 0: {nothing}; $ff: list.concat(taicpu.op_reg_const(A_LD,reg,$ff)); else begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_reg_const(A_OR,NR_A,curvalue)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; end; if i<>tcgsize2size[size] then begin NextReg; mask:=mask shl 8; inc(shift,8); curvalue:=(qword(a) and mask) shr shift; end; end; end; OP_XOR: begin curvalue:=a and mask; for i:=1 to tcgsize2size[size] do begin case curvalue of 0: {nothing}; $ff: begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_none(A_CPL)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; else begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_reg_const(A_XOR,NR_A,curvalue)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; end; if i<>tcgsize2size[size] then begin NextReg; mask:=mask shl 8; inc(shift,8); curvalue:=(qword(a) and mask) shr shift; end; end; end; OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR: begin if size in [OS_64,OS_S64] then a:=a and 63 else a:=a and 31; if a<>0 then begin if a>1 then begin current_asmdata.getjumplabel(l1); getcpuregister(list,NR_B); list.concat(taicpu.op_reg_const(A_LD,NR_B,a)); end; if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then case op of OP_ROL: begin list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))); list.concat(taicpu.op_reg(A_RLC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))); end; OP_ROR: begin list.concat(taicpu.op_reg(A_RLC,reg)); list.concat(taicpu.op_reg(A_RRC,reg)); end; else ; end; if a>1 then cg.a_label(list,l1); case op of OP_SHL: list.concat(taicpu.op_reg(A_SLA,reg)); OP_SHR: list.concat(taicpu.op_reg(A_SRL,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))); OP_SAR: list.concat(taicpu.op_reg(A_SRA,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))); OP_ROL: if size in [OS_8,OS_S8] then list.concat(taicpu.op_reg(A_RLC,reg)) else list.concat(taicpu.op_reg(A_RL,reg)); OP_ROR: if size in [OS_8,OS_S8] then list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))) else list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1))); else internalerror(2020040903); end; if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then begin for i:=2 to tcgsize2size[size] do begin case op of OP_ROR, OP_SHR, OP_SAR: list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-i))); OP_ROL, OP_SHL: list.concat(taicpu.op_reg(A_RL,GetOffsetReg64(reg,reghi,i-1))); else internalerror(2020040904); end; end; end; if a>1 then begin instr:=taicpu.op_sym(A_DJNZ,l1); instr.is_jmp:=true; list.concat(instr); ungetcpuregister(list,NR_B); end; end; end; OP_ADD: begin curvalue:=a and mask; tmpop:=A_NONE; for i:=1 to tcgsize2size[size] do begin if (tmpop=A_NONE) and (curvalue=1) and (i=tcgsize2size[size]) then tmpop:=A_INC else if (tmpop=A_NONE) and (curvalue<>0) then tmpop:=A_ADD else if tmpop=A_ADD then tmpop:=A_ADC; case tmpop of A_NONE: {nothing}; A_INC: list.concat(taicpu.op_reg(tmpop,reg)); A_ADD,A_ADC: begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_reg_const(tmpop,NR_A,curvalue)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; else internalerror(2020040901); end; if i<>tcgsize2size[size] then begin NextReg; mask:=mask shl 8; inc(shift,8); curvalue:=(qword(a) and mask) shr shift; end; end; end; OP_SUB: begin curvalue:=a and mask; tmpop:=A_NONE; for i:=1 to tcgsize2size[size] do begin if (tmpop=A_NONE) and (curvalue=1) and (i=tcgsize2size[size]) then tmpop:=A_DEC else if (tmpop=A_NONE) and (curvalue<>0) then tmpop:=A_SUB else if tmpop=A_SUB then tmpop:=A_SBC; case tmpop of A_NONE: {nothing}; A_DEC: list.concat(taicpu.op_reg(tmpop,reg)); A_SUB,A_SBC: begin getcpuregister(list,NR_A); emit_mov(list,NR_A,reg); list.concat(taicpu.op_reg_const(tmpop,NR_A,curvalue)); emit_mov(list,reg,NR_A); ungetcpuregister(list,NR_A); end; else internalerror(2020040902); end; if i<>tcgsize2size[size] then begin NextReg; mask:=mask shl 8; inc(shift,8); curvalue:=(qword(a) and mask) shr shift; end; end; end; else begin if size in [OS_64,OS_S64] then begin tmpreg64.reglo:=getintregister(list,OS_32); tmpreg64.reghi:=getintregister(list,OS_32); cg64.a_load64_const_reg(list,a,tmpreg64); cg64.a_op64_reg_reg(list,op,size,tmpreg64,joinreg64(reg,reghi)); end else begin {$if 0} { code not working yet } if (op=OP_SAR) and (a=31) and (size in [OS_32,OS_S32]) then begin tmpreg:=reg; for i:=1 to 4 do begin list.concat(taicpu.op_reg_reg(A_MOV,tmpreg,NR_R1)); tmpreg:=GetNextReg(tmpreg); end; end else {$endif} begin tmpreg:=getintregister(list,size); a_load_const_reg(list,size,a,tmpreg); a_op_reg_reg(list,op,size,tmpreg,reg); end; end; end; end; end; procedure tcgz80.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister); var mask : qword; shift : byte; i : byte; begin mask:=$ff; shift:=0; for i:=tcgsize2size[size] downto 1 do begin list.Concat(taicpu.op_reg_const(A_LD,reg,(qword(a) and mask) shr shift)); if i<>1 then begin mask:=mask shl 8; inc(shift,8); reg:=GetNextReg(reg); end; end; end; procedure tcgz80.a_load_const_ref(list: TAsmList; size: tcgsize; a: tcgint; const ref: treference); var mask : qword; shift : byte; href: treference; i: Integer; begin mask:=$ff; shift:=0; href:=ref; if (href.base=NR_NO) and (href.index<>NR_NO) then begin href.base:=href.index; href.index:=NR_NO; end; if is_ref_in_opertypes(href,[OT_REF_IX_d,OT_REF_IY_d]) or (is_ref_hl(href) and (size in [OS_8,OS_S8])) then begin for i:=tcgsize2size[size] downto 1 do begin list.Concat(taicpu.op_ref_const(A_LD,href,(qword(a) and mask) shr shift)); if i<>1 then begin mask:=mask shl 8; inc(shift,8); inc(href.offset); end; end; end else inherited; end; procedure tcgz80.maybegetcpuregister(list:tasmlist;reg : tregister); begin { allocate the register only, if a cpu register is passed } if getsupreg(reg)NR_NO) and (ref.scalefactor<=1) then begin ref.base:=ref.index; ref.index:=NR_NO; end; if is_ref_in_opertypes(ref,refopertypes) then begin Result:=ref; exit; end; { can we use the HL register? } if OT_REF_HL in refopertypes then begin SetLength(allocatedregs,2); allocatedregs[0]:=NR_H; allocatedregs[1]:=NR_L; getcpuregisters(list,allocatedregs); if assigned(ref.symbol) then begin reference_reset(tmpref,0,[]); tmpref.symbol:=ref.symbol; tmpref.offset:=ref.offset; tmpref.refaddr:=addr_full; list.concat(taicpu.op_reg_ref(A_LD,NR_HL,tmpref)); end else list.concat(taicpu.op_reg_const(A_LD,NR_HL,ref.offset)); if (ref.base=NR_IX) or (ref.base=NR_IY) then begin getcpuregister(list,NR_D); getcpuregister(list,NR_E); list.concat(taicpu.op_reg(A_PUSH,ref.base)); list.concat(taicpu.op_reg(A_POP,NR_DE)); list.concat(taicpu.op_reg_reg(A_ADD,NR_HL,NR_DE)); ungetcpuregister(list,NR_E); ungetcpuregister(list,NR_D); end else if ref.base<>NR_NO then begin getcpuregister(list,NR_A); emit_mov(list,NR_A,NR_L); list.concat(taicpu.op_reg_reg(A_ADD,NR_A,ref.base)); emit_mov(list,NR_L,NR_A); emit_mov(list,NR_A,NR_H); list.concat(taicpu.op_reg_reg(A_ADC,NR_A,GetNextReg(ref.base))); emit_mov(list,NR_H,NR_A); ungetcpuregister(list,NR_A); end; if ref.index<>NR_NO then begin if ref.scalefactor>1 then internalerror(2020042002); getcpuregister(list,NR_A); emit_mov(list,NR_A,NR_L); list.concat(taicpu.op_reg_reg(A_ADD,NR_A,ref.index)); emit_mov(list,NR_L,NR_A); emit_mov(list,NR_A,NR_H); list.concat(taicpu.op_reg_reg(A_ADC,NR_A,GetNextReg(ref.index))); emit_mov(list,NR_H,NR_A); ungetcpuregister(list,NR_A); end; reference_reset_base(result,NR_HL,0,ctempposinvalid,0,[]); end else internalerror(2020042001); end; procedure tcgz80.adjust_normalized_ref(list: TAsmList; var ref: treference; value: longint); var i: Integer; begin if is_ref_addr16(ref) then Inc(ref.offset,value) else if is_ref_hl(ref) then begin if value>0 then for i:=1 to value do list.concat(taicpu.op_reg(A_INC,NR_HL)) else for i:=-1 downto value do list.concat(taicpu.op_reg(A_DEC,NR_HL)); end else if is_ref_ix_d(ref) then begin if ((ref.offset+value)<=127) and ((ref.offset+value)>=-128) then inc(ref.offset,value) else begin { todo: IX is the frame pointer, we cannot change it, so we } { think of another mechanism to deal with this situation } internalerror(2020042101); //if value>0 then // for i:=1 to value do // list.concat(taicpu.op_reg(A_INC,NR_IX)) //else // for i:=-1 downto value do // list.concat(taicpu.op_reg(A_DEC,NR_IX)); end; end else if is_ref_iy_d(ref) then begin if ((ref.offset+value)<=127) and ((ref.offset+value)>=-128) then inc(ref.offset,value) else if value>0 then for i:=1 to value do list.concat(taicpu.op_reg(A_INC,NR_IY)) else for i:=-1 downto value do list.concat(taicpu.op_reg(A_DEC,NR_IY)); end; end; procedure tcgz80.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference); var href : treference; i : integer; regsused: tregisterlist; begin if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then internalerror(2011021307); if tcgsize2size[fromsize]>tcgsize2size[tosize] then internalerror(2020040802); href:=normalize_ref(list,Ref,[OT_REF_ADDR16,OT_REF_HL,OT_REF_IX_d,OT_REF_IY_d],regsused); if (tcgsize2size[fromsize]=tcgsize2size[tosize]) or (fromsize in [OS_8,OS_16,OS_32]) then begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[fromsize] do begin a_load_reg_reg(list,OS_8,OS_8,reg,NR_A); list.concat(taicpu.op_ref_reg(A_LD,href,NR_A)); if i<>tcgsize2size[fromsize] then reg:=GetNextReg(reg); if i<>tcgsize2size[tosize] then adjust_normalized_ref(list,href,1); end; for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin if i=(tcgsize2size[fromsize]+1) then list.concat(taicpu.op_reg_const(A_LD,NR_A,0)); list.concat(taicpu.op_ref_reg(A_LD,href,NR_A)); if i<>tcgsize2size[tosize] then begin adjust_normalized_ref(list,href,1); reg:=GetNextReg(reg); end; end; ungetcpuregister(list,NR_A); end else begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[fromsize] do begin a_load_reg_reg(list,OS_8,OS_8,reg,NR_A); list.concat(taicpu.op_ref_reg(A_LD,href,NR_A)); if i<>tcgsize2size[fromsize] then reg:=GetNextReg(reg); if i<>tcgsize2size[tosize] then adjust_normalized_ref(list,href,1); end; list.concat(taicpu.op_none(A_RLA)); list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A)); for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin list.concat(taicpu.op_ref_reg(A_LD,href,NR_A)); if i<>tcgsize2size[tosize] then begin adjust_normalized_ref(list,href,1); reg:=GetNextReg(reg); end; end; ungetcpuregister(list,NR_A); end; ungetcpuregisters(list,regsused); end; procedure tcgz80.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize; const Ref : treference;reg : tregister); var href : treference; i : integer; regsused: tregisterlist; begin if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then internalerror(2011021307); if tcgsize2size[fromsize]>=tcgsize2size[tosize] then fromsize:=tosize; href:=normalize_ref(list,Ref,[OT_REF_ADDR16,OT_REF_HL,OT_REF_IX_d,OT_REF_IY_d],regsused); if (tcgsize2size[tosize]=tcgsize2size[fromsize]) or (fromsize in [OS_8,OS_16,OS_32]) then begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[fromsize] do begin list.concat(taicpu.op_reg_ref(A_LD,NR_A,href)); a_load_reg_reg(list,OS_8,OS_8,NR_A,reg); if i<>tcgsize2size[fromsize] then adjust_normalized_ref(list,href,1); if i<>tcgsize2size[tosize] then reg:=GetNextReg(reg); end; ungetcpuregisters(list,regsused); ungetcpuregister(list,NR_A); for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin list.concat(taicpu.op_reg_const(A_LD,reg,0)); if i<>tcgsize2size[tosize] then reg:=GetNextReg(reg); end; end else begin getcpuregister(list,NR_A); for i:=1 to tcgsize2size[fromsize] do begin list.concat(taicpu.op_reg_ref(A_LD,NR_A,href)); a_load_reg_reg(list,OS_8,OS_8,NR_A,reg); if i<>tcgsize2size[fromsize] then adjust_normalized_ref(list,href,1); if i<>tcgsize2size[tosize] then reg:=GetNextReg(reg); end; ungetcpuregisters(list,regsused); list.concat(taicpu.op_none(A_RLA)); list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A)); for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin emit_mov(list,reg,NR_A); if i<>tcgsize2size[tosize] then reg:=GetNextReg(reg); end; ungetcpuregister(list,NR_A); end; end; procedure tcgz80.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister); var conv_done: boolean; tmpreg : tregister; i : integer; begin if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then internalerror(2011021310); if tcgsize2size[fromsize]>tcgsize2size[tosize] then fromsize:=tosize; if (tcgsize2size[tosize]=tcgsize2size[fromsize]) or (fromsize in [OS_8,OS_16,OS_32]) then begin if reg1<>reg2 then for i:=1 to tcgsize2size[fromsize] do begin emit_mov(list,reg2,reg1); if i<>tcgsize2size[fromsize] then reg1:=GetNextReg(reg1); if i<>tcgsize2size[tosize] then reg2:=GetNextReg(reg2); end else for i:=1 to tcgsize2size[fromsize] do if i<>tcgsize2size[tosize] then reg2:=GetNextReg(reg2); for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin list.Concat(taicpu.op_reg_const(A_LD,reg2,0)); if i<>tcgsize2size[tosize] then reg2:=GetNextReg(reg2); end end else begin if reg1<>reg2 then for i:=1 to tcgsize2size[fromsize]-1 do begin emit_mov(list,reg2,reg1); reg1:=GetNextReg(reg1); reg2:=GetNextReg(reg2); end else for i:=1 to tcgsize2size[fromsize]-1 do reg2:=GetNextReg(reg2); emit_mov(list,reg2,reg1); getcpuregister(list,NR_A); emit_mov(list,NR_A,reg2); reg2:=GetNextReg(reg2); list.concat(taicpu.op_none(A_RLA)); list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A)); for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do begin emit_mov(list,reg2,NR_A); if i<>tcgsize2size[tosize] then reg2:=GetNextReg(reg2); end; ungetcpuregister(list,NR_A); end; end; procedure tcgz80.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister); begin internalerror(2012010702); end; procedure tcgz80.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister); begin internalerror(2012010703); end; procedure tcgz80.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); begin internalerror(2012010704); end; { comparison operations } procedure tcgz80.a_cmp_const_reg_label(list : TAsmList;size : tcgsize; cmp_op : topcmp;a : tcgint;reg : tregister;l : tasmlabel); var swapped : boolean; tmpreg : tregister; i : byte; tmpl: TAsmLabel; begin if size in [OS_8,OS_S8]then begin if cmp_op in [OC_EQ,OC_NE,OC_B,OC_AE] then begin getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,reg,NR_A); list.concat(taicpu.op_reg_const(A_CP,NR_A,a)); case cmp_op of OC_EQ: a_jmp_flags(list,F_E,l); OC_NE: a_jmp_flags(list,F_NE,l); OC_B: a_jmp_flags(list,F_C,l); OC_AE: a_jmp_flags(list,F_NC,l); else internalerror(2020042206); end; ungetcpuregister(list,NR_A); end else if cmp_op in [OC_A,OC_BE] then begin getcpuregister(list,NR_A); a_load_const_reg(list,OS_8,a,NR_A); list.concat(taicpu.op_reg_reg(A_CP,NR_A,reg)); case cmp_op of OC_A: a_jmp_flags(list,F_C,l); OC_BE: a_jmp_flags(list,F_NC,l); else internalerror(2020042206); end; ungetcpuregister(list,NR_A); end else if cmp_op in [OC_LT,OC_GTE] then begin getcpuregister(list,NR_A); a_load_reg_reg(list,OS_8,OS_8,reg,NR_A); list.concat(taicpu.op_reg_const(A_SUB,NR_A,a)); current_asmdata.getjumplabel(tmpl); a_jmp_flags(list,F_PO,tmpl); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,tmpl); case cmp_op of OC_LT: a_jmp_flags(list,F_M,l); OC_GTE: a_jmp_flags(list,F_P,l); else internalerror(2020042206); end; ungetcpuregister(list,NR_A); end else if cmp_op in [OC_GT,OC_LTE] then begin getcpuregister(list,NR_A); a_load_const_reg(list,OS_8,a,NR_A); list.concat(taicpu.op_reg_reg(A_SUB,NR_A,reg)); current_asmdata.getjumplabel(tmpl); a_jmp_flags(list,F_PO,tmpl); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,tmpl); case cmp_op of OC_GT: a_jmp_flags(list,F_M,l); OC_LTE: a_jmp_flags(list,F_P,l); else internalerror(2020042206); end; ungetcpuregister(list,NR_A); end; end else if cmp_op in [OC_EQ,OC_NE] then begin if cmp_op=OC_EQ then current_asmdata.getjumplabel(tmpl); for i:=0 to tcgsize2size[size]-1 do begin a_load_reg_reg(list,OS_8,OS_8,GetOffsetReg(reg,i),NR_A); list.concat(taicpu.op_reg_const(A_CP,NR_A,Byte(a shr (8*i)))); case cmp_op of OC_EQ: if i<>(tcgsize2size[size]-1) then a_jmp_flags(list,F_NE,tmpl) else a_jmp_flags(list,F_E,l); OC_NE: a_jmp_flags(list,F_NE,l); else internalerror(2020042206); end; end; if cmp_op=OC_EQ then cg.a_label(current_asmdata.CurrAsmList,tmpl); end else if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE,OC_BE,OC_B,OC_AE,OC_A] then begin getcpuregister(list,NR_A); current_asmdata.getjumplabel(tmpl); for i:=tcgsize2size[size]-1 downto 0 do begin a_load_reg_reg(list,OS_8,OS_8,GetOffsetReg(reg,i),NR_A); list.concat(taicpu.op_reg_const(A_CP,NR_A,Byte(a shr (8*i)))); if (i=(tcgsize2size[size]-1)) and (cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE]) then case cmp_op of OC_GTE, OC_GT: a_jmp_signed_cmp_3way(list,tmpl,nil,l); OC_LT, OC_LTE: a_jmp_signed_cmp_3way(list,l,nil,tmpl); else internalerror(2020042206); end else if i<>0 then case cmp_op of OC_AE, OC_A, OC_GTE, OC_GT: a_jmp_unsigned_cmp_3way(list,tmpl,nil,l); OC_BE, OC_B, OC_LT, OC_LTE: a_jmp_unsigned_cmp_3way(list,l,nil,tmpl); else internalerror(2020042206); end else case cmp_op of OC_A, OC_GT: a_jmp_unsigned_cmp_3way(list,nil,nil,l); OC_B, OC_LT: a_jmp_unsigned_cmp_3way(list,l,nil,nil); OC_AE, OC_GTE: a_jmp_unsigned_cmp_3way(list,nil,l,l); OC_BE, OC_LTE: a_jmp_unsigned_cmp_3way(list,l,l,nil); else internalerror(2020042206); end; end; cg.a_label(current_asmdata.CurrAsmList,tmpl); ungetcpuregister(list,NR_A); end else internalerror(2020042205); end; procedure tcgz80.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize; cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); var swapped : boolean; tmpreg : tregister; i : byte; begin internalerror(2020042301); //swapped:=false; //{ swap parameters? } //case cmp_op of // OC_GT: // begin // swapped:=true; // cmp_op:=OC_LT; // end; // OC_LTE: // begin // swapped:=true; // cmp_op:=OC_GTE; // end; // OC_BE: // begin // swapped:=true; // cmp_op:=OC_AE; // end; // OC_A: // begin // swapped:=true; // cmp_op:=OC_B; // end; //end; //if swapped then // begin // tmpreg:=reg1; // reg1:=reg2; // reg2:=tmpreg; // end; //list.concat(taicpu.op_reg_reg(A_CP,reg2,reg1)); // //for i:=2 to tcgsize2size[size] do // begin // reg1:=GetNextReg(reg1); // reg2:=GetNextReg(reg2); // list.concat(taicpu.op_reg_reg(A_CPC,reg2,reg1)); // end; // //a_jmp_cond(list,cmp_op,l); end; procedure tcgz80.a_jmp_name(list : TAsmList;const s : string); var ai : taicpu; begin ai:=taicpu.op_sym(A_JP,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)); ai.is_jmp:=true; list.concat(ai); end; procedure tcgz80.a_jmp_always(list : TAsmList;l: tasmlabel); var ai : taicpu; begin ai:=taicpu.op_sym(A_JP,l); ai.is_jmp:=true; list.concat(ai); end; procedure tcgz80.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); var ai : taicpu; begin ai:=taicpu.op_cond_sym(A_JP,flags_to_cond(f),l); ai.is_jmp:=true; list.concat(ai); end; procedure tcgz80.a_jmp_unsigned_cmp_3way(list: TAsmList; onbelow, onequal, onabove: tasmlabel); var skiplabel: TAsmLabel; begin if (onbelow= nil) and (onequal= nil) and (onabove= nil) then {nothing} else if (onbelow= nil) and (onequal= nil) and (onabove<>nil) then begin current_asmdata.getjumplabel(skiplabel); a_jmp_flags(list,F_E,skiplabel); a_jmp_flags(list,F_NC,onabove); cg.a_label(list,skiplabel); end else if (onbelow= nil) and (onequal<>nil) and (onabove= nil) then a_jmp_flags(list,F_E,onequal) else if (onbelow= nil) and (onequal<>nil) and (onabove<>nil) then begin if onequal<>onabove then a_jmp_flags(list,F_E,onequal); a_jmp_flags(list,F_NC,onabove); end else if (onbelow<>nil) and (onequal= nil) and (onabove= nil) then a_jmp_flags(list,F_C,onbelow) else if (onbelow<>nil) and (onequal= nil) and (onabove<>nil) then begin if onbelow<>onabove then a_jmp_flags(list,F_C,onbelow); a_jmp_flags(list,F_NE,onabove); end else if (onbelow<>nil) and (onequal<>nil) and (onabove= nil) then begin a_jmp_flags(list,F_C,onbelow); a_jmp_flags(list,F_E,onequal); end else if (onbelow<>nil) and (onequal<>nil) and (onabove<>nil) then begin if (onbelow=onequal) and (onequal=onabove) then a_jmp_always(list,onbelow) else if onequal=onabove then begin a_jmp_flags(list,F_C,onbelow); a_jmp_always(list,onabove); end else if onbelow=onequal then begin a_jmp_flags(list,F_C,onbelow); a_jmp_flags(list,F_E,onequal); a_jmp_always(list,onabove); end else if onbelow=onabove then begin a_jmp_flags(list,F_E,onequal); a_jmp_always(list,onabove); end else begin { the generic case - all 3 are different labels } a_jmp_flags(list,F_C,onbelow); a_jmp_flags(list,F_E,onequal); a_jmp_always(list,onabove); end; end else begin { Shouldn't happen! All possible combinations are handled by the above code. } internalerror(2020042201); end; end; procedure tcgz80.a_jmp_signed_cmp_3way(list: TAsmList; onless, onequal, ongreater: tasmlabel); var l, skiplabel: TAsmLabel; begin if (onless= nil) and (onequal= nil) and (ongreater= nil) then {nothing} else if (onless= nil) and (onequal= nil) and (ongreater<>nil) then begin current_asmdata.getjumplabel(skiplabel); a_jmp_flags(list,F_E,skiplabel); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_P,ongreater); cg.a_label(list,skiplabel); end else if (onless= nil) and (onequal<>nil) and (ongreater= nil) then a_jmp_flags(list,F_E,onequal) else if (onless= nil) and (onequal<>nil) and (ongreater<>nil) then begin if onequal<>ongreater then a_jmp_flags(list,F_E,onequal); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_P,ongreater); end else if (onless<>nil) and (onequal= nil) and (ongreater= nil) then begin current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); end else if (onless<>nil) and (onequal= nil) and (ongreater<>nil) then begin if onless=ongreater then a_jmp_flags(list,F_NE,onless) else begin current_asmdata.getjumplabel(skiplabel); a_jmp_flags(list,F_E,skiplabel); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); a_jmp_always(list,ongreater); cg.a_label(list,skiplabel); end; end else if (onless<>nil) and (onequal<>nil) and (ongreater= nil) then begin a_jmp_flags(list,F_E,onequal); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); end else if (onless<>nil) and (onequal<>nil) and (ongreater<>nil) then begin if (onless=onequal) and (onequal=ongreater) then a_jmp_always(list,onless) else if onequal=ongreater then begin current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); a_jmp_always(list,ongreater); end else if onless=onequal then begin a_jmp_flags(list,F_E,onequal); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); a_jmp_always(list,ongreater); end else if onless=ongreater then begin a_jmp_flags(list,F_E,onequal); a_jmp_always(list,ongreater); end else begin { the generic case - all 3 are different labels } a_jmp_flags(list,F_E,onequal); current_asmdata.getjumplabel(l); a_jmp_flags(list,F_PO,l); current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80)); cg.a_label(current_asmdata.CurrAsmList,l); a_jmp_flags(list,F_M,onless); a_jmp_always(list,ongreater); end; end else begin { Shouldn't happen! All possible combinations are handled by the above code. } internalerror(2020042204); end; end; procedure tcgz80.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); var l : TAsmLabel; tmpflags : TResFlags; begin if f in [F_C,F_NC] then begin a_load_const_reg(list,size,0,reg); if f=F_NC then list.concat(taicpu.op_none(A_CCF)); list.concat(taicpu.op_reg(A_RL,reg)); end else begin current_asmdata.getjumplabel(l); a_load_const_reg(list,size,0,reg); tmpflags:=f; inverse_flags(tmpflags); a_jmp_flags(list,tmpflags,l); list.concat(taicpu.op_reg(A_INC,reg)); cg.a_label(list,l); end; end; procedure tcgz80.g_stackpointer_alloc(list: TAsmList; localsize: longint); begin if localsize>0 then begin list.Concat(taicpu.op_reg_const(A_LD,NR_HL,-localsize)); list.Concat(taicpu.op_reg_reg(A_ADD,NR_HL,NR_SP)); list.Concat(taicpu.op_reg_reg(A_LD,NR_SP,NR_HL)); end; end; procedure tcgz80.a_adjust_sp(list : TAsmList; value : longint); var i : integer; begin //case value of // 0: // ; // {-14..-1: // begin // if ((-value) mod 2)<>0 then // list.concat(taicpu.op_reg(A_PUSH,NR_R0)); // for i:=1 to (-value) div 2 do // list.concat(taicpu.op_const(A_RCALL,0)); // end; // 1..7: // begin // for i:=1 to value do // list.concat(taicpu.op_reg(A_POP,NR_R0)); // end;} // else // begin // list.concat(taicpu.op_reg_const(A_SUBI,NR_R28,lo(word(-value)))); // list.concat(taicpu.op_reg_const(A_SBCI,NR_R29,hi(word(-value)))); // // get SREG // list.concat(taicpu.op_reg_const(A_IN,NR_R0,NIO_SREG)); // // // block interrupts // list.concat(taicpu.op_none(A_CLI)); // // // write high SP // list.concat(taicpu.op_const_reg(A_OUT,NIO_SP_HI,NR_R29)); // // // release interrupts // list.concat(taicpu.op_const_reg(A_OUT,NIO_SREG,NR_R0)); // // // write low SP // list.concat(taicpu.op_const_reg(A_OUT,NIO_SP_LO,NR_R28)); // end; //end; end; procedure tcgz80.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); var regsize,stackmisalignment: longint; begin regsize:=0; stackmisalignment:=0; { save old framepointer } if not nostackframe then begin { return address } inc(stackmisalignment,2); list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil)); if current_procinfo.framepointer=NR_FRAME_POINTER_REG then begin { push } inc(stackmisalignment,2); include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG); list.concat(Taicpu.op_reg(A_PUSH,NR_FRAME_POINTER_REG)); { Return address and FP are both on stack } current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*2); current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*2)); if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then begin list.concat(Taicpu.op_reg_const(A_LD,NR_FRAME_POINTER_REG,0)); list.concat(Taicpu.op_reg_reg(A_ADD,NR_FRAME_POINTER_REG,NR_STACK_POINTER_REG)) end else begin internalerror(2020040301); (*push_regs; gen_load_frame_for_exceptfilter(list); { 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); end else begin CGmessage(cg_d_stackframe_omited); 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; g_stackpointer_alloc(list,localsize); if current_procinfo.framepointer=NR_STACK_POINTER_REG then current_asmdata.asmcfi.cfa_def_cfa_offset(list,regsize+localsize+sizeof(pint)); current_procinfo.final_localsize:=localsize; end end; end; procedure tcgz80.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); var regs : tcpuregisterset; reg : TSuperRegister; LocalSize : longint; begin { every byte counts for Z80, so if a subroutine is marked as non-returning, we do not generate any exit code, so we really trust the noreturn directive } if po_noreturn in current_procinfo.procdef.procoptions then exit; { remove stackframe } if not nostackframe then begin stacksize:=current_procinfo.calc_stackframe_size; if (target_info.stackalign>4) and ((stacksize <> 0) or (pi_do_call in current_procinfo.flags) or { can't detect if a call in this case -> use nostackframe } { if you (think you) know what you are doing } (po_assembler in current_procinfo.procdef.procoptions)) then stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint); if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then begin internalerror(2020040302); {if (stacksize<>0) then cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);} end else begin list.Concat(taicpu.op_reg_reg(A_LD,NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG)); list.Concat(taicpu.op_reg(A_POP,NR_FRAME_POINTER_REG)); end; list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil)); end; list.concat(taicpu.op_none(A_RET)); end; procedure tcgz80.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); var tmpref : treference; begin if assigned(ref.symbol) then begin reference_reset(tmpref,0,[]); tmpref.symbol:=ref.symbol; tmpref.offset:=ref.offset; tmpref.refaddr:=addr_lo8; list.concat(taicpu.op_reg_ref(A_LD,r,tmpref)); tmpref.refaddr:=addr_hi8; list.concat(taicpu.op_reg_ref(A_LD,GetNextReg(r),tmpref)); if (ref.base<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.base,r); if (ref.index<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r); end else if ref.base=NR_IX then begin list.concat(taicpu.op_reg(A_PUSH,NR_IX)); getcpuregister(list,NR_H); getcpuregister(list,NR_L); list.concat(taicpu.op_reg(A_POP,NR_HL)); emit_mov(list,r,NR_L); ungetcpuregister(list,NR_L); emit_mov(list,GetNextReg(r),NR_H); ungetcpuregister(list,NR_H); if (ref.index<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r); if ref.offset<>0 then a_op_const_reg(list,OP_ADD,OS_16,ref.offset,r); end else if (ref.base=NR_SP) or (ref.base=NR_BC) or (ref.base=NR_DE) then begin getcpuregister(list,NR_H); getcpuregister(list,NR_L); list.Concat(taicpu.op_reg_const(A_LD,NR_HL,ref.offset)); list.Concat(taicpu.op_reg_reg(A_ADD,NR_HL,ref.base)); emit_mov(list,r,NR_L); ungetcpuregister(list,NR_L); emit_mov(list,GetNextReg(r),NR_H); ungetcpuregister(list,NR_H); if (ref.index<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r); end else begin a_load_const_reg(list,OS_16,ref.offset,r); if (ref.base<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.base,r); if (ref.index<>NR_NO) then a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r); end; end; procedure tcgz80.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); var tmpreg,srcreg,dstreg: tregister; srcref,dstref : treference; i: Integer; begin if (len<=2) and is_ref_in_opertypes(source,[OT_REF_IX_d,OT_REF_IY_d,OT_REF_HL]) and is_ref_in_opertypes(dest,[OT_REF_IX_d,OT_REF_IY_d,OT_REF_HL]) then begin srcref:=source; dstref:=dest; tmpreg:=getintregister(list,OS_8); for i:=1 to len do begin list.concat(taicpu.op_reg_ref(A_LD,tmpreg,srcref)); list.concat(taicpu.op_ref_reg(A_LD,dstref,tmpreg)); if i<>len then begin adjust_normalized_ref(list,srcref,1); adjust_normalized_ref(list,dstref,1); end; end; end else begin srcreg:=getintregister(list,OS_16); a_loadaddr_ref_reg(list,source,srcreg); dstreg:=getintregister(list,OS_16); a_loadaddr_ref_reg(list,dest,dstreg); getcpuregister(list,NR_L); a_load_reg_reg(list,OS_8,OS_8,srcreg,NR_L); getcpuregister(list,NR_H); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(srcreg),NR_H); getcpuregister(list,NR_E); a_load_reg_reg(list,OS_8,OS_8,dstreg,NR_E); getcpuregister(list,NR_D); a_load_reg_reg(list,OS_8,OS_8,GetNextReg(dstreg),NR_D); getcpuregister(list,NR_B); getcpuregister(list,NR_C); list.concat(taicpu.op_reg_const(A_LD,NR_BC,len)); list.concat(taicpu.op_none(A_LDIR)); ungetcpuregister(list,NR_B); ungetcpuregister(list,NR_C); ungetcpuregister(list,NR_D); ungetcpuregister(list,NR_E); ungetcpuregister(list,NR_H); ungetcpuregister(list,NR_L); end; end; procedure tcgz80.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); var hl : tasmlabel; ai : taicpu; cond : TAsmCond; begin list.Concat(tai_comment.Create(strpnew('WARNING! not implemented: g_overflowCheck'))); //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_VC //else // cond:=C_CC; //ai:=Taicpu.Op_Sym(A_BRxx,hl); //ai.SetCondition(cond); //ai.is_jmp:=true; //list.concat(ai); // //a_call_name(list,'FPC_OVERFLOW',false); //a_label(list,hl); end; procedure tcgz80.g_save_registers(list: TAsmList); begin { this is done by the entry code } end; procedure tcgz80.g_restore_registers(list: TAsmList); begin { this is done by the exit code } end; procedure tcgz80.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); begin case cond of OC_EQ: a_jmp_unsigned_cmp_3way(list,nil,l,nil); OC_NE: a_jmp_unsigned_cmp_3way(list,l,nil,l); OC_A: a_jmp_unsigned_cmp_3way(list,nil,nil,l); OC_B: a_jmp_unsigned_cmp_3way(list,l,nil,nil); OC_AE: a_jmp_unsigned_cmp_3way(list,nil,l,l); OC_BE: a_jmp_unsigned_cmp_3way(list,l,l,nil); OC_GT: a_jmp_signed_cmp_3way(list,nil,nil,l); OC_LT: a_jmp_signed_cmp_3way(list,l,nil,nil); OC_GTE: a_jmp_signed_cmp_3way(list,nil,l,l); OC_LTE: a_jmp_signed_cmp_3way(list,l,l,nil); else internalerror(2011082501); end; end; procedure tcgz80.emit_mov(list: TAsmList;reg2: tregister; reg1: tregister); var instr: taicpu; begin instr:=taicpu.op_reg_reg(A_LD,reg2,reg1); 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; procedure tcg64fz80.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); begin if not(size in [OS_S64,OS_64]) then internalerror(2012102402); tcgz80(cg).a_op_reg_reg_internal(list,Op,size,regsrc.reglo,regsrc.reghi,regdst.reglo,regdst.reghi); end; procedure tcg64fz80.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64); begin tcgz80(cg).a_op_const_reg_internal(list,Op,size,value,reg.reglo,reg.reghi); end; function GetByteLoc(const loc : tlocation; nr : byte) : tlocation; var i : Integer; begin Result:=loc; Result.size:=OS_8; case loc.loc of LOC_REFERENCE,LOC_CREFERENCE: inc(Result.reference.offset,nr); LOC_REGISTER,LOC_CREGISTER: begin if nr>=4 then Result.register:=Result.register64.reghi; nr:=nr mod 4; for i:=1 to nr do Result.register:=GetNextReg(Result.register); end; LOC_CONSTANT: if loc.size in [OS_64,OS_S64] then Result.value:=(Result.value64 shr (nr*8)) and $ff else Result.value:=(Result.value shr (nr*8)) and $ff; else Internalerror(2019020902); end; end; procedure create_codegen; begin cg:=tcgz80.create; cg64:=tcg64fz80.create; end; end.