{ Copyright (c) 1999-2008 by Mazen Neifer and Florian Klaempfl Contains the assembler object 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 aasmcpu; {$i fpcdefs.inc} interface uses cclasses, globtype,globals,verbose, aasmbase,aasmtai,aasmdata,aasmsym, cgbase,cgutils,cpubase,cpuinfo, ogbase; const { "mov reg,reg" source operand number } O_MOV_SOURCE = 1; { "mov reg,reg" source operand number } O_MOV_DEST = 0; instabentries = {$i z80nop.inc} maxinfolen = 18; type { Operand types } toperandtype=( OT_NONE, OT_IMM3, { 3-bit immediate value (bit number: [0..7]) } OT_IMM8, { 8-bit immediate value } OT_IMM16, { 16-bit immediate value } OT_IMM_VAL0, { the immediate value 0 } OT_IMM_VAL1, { the immediate value 1 } OT_IMM_VAL2, { the immediate value 2 } OT_IMM_RST, { immediate value in [$00,$08,$10,$18,$20,$28,$30,$38] } OT_IMM_PORT, { 8-bit immediate port number for the IN and OUT instructions } OT_REG8, { 8-bit register: A/B/C/D/E/H/L } OT_REG8_A, { register A } OT_REG8_I, { register I } OT_REG8_R, { register R } OT_REG8_C_PORT, { implied parameter of the IN and OUT instructions } OT_REG16_IX, { register IX } OT_REG16_IY, { register IY } OT_REG16_SP, { register SP } OT_REG16_BC_DE_HL_SP, { 16-bit register pair: BC/DE/HL/SP } OT_REG16_BC_DE_HL_AF, { 16-bit register pair: BC/DE/HL/AF } OT_REG16_BC_DE_IX_SP, { 16-bit register pair: BC/DE/IX/SP } OT_REG16_BC_DE_IY_SP, { 16-bit register pair: BC/DE/IY/SP } OT_REG16_DE, { 16-bit register pair DE } OT_REG16_HL, { 16-bit register pair HL } OT_REG16_AF, { 16-bit register pair AF } OT_REG16_AF_, { alternate register set, 16-bit register pair AF' } OT_RELJMP8, { 8-bit relative jump offset } OT_COND, { condition: NZ/Z/NC/C/PO/PE/P/M } OT_COND_C, { condition C } OT_COND_NC, { condition NC } OT_COND_Z, { condition Z } OT_COND_NZ, { condition NZ } OT_REF_ADDR16, { memory contents at address (nn = 16-bit immediate address) } OT_REF_BC, { memory contents at address in register BC } OT_REF_DE, { memory contents at address in register DE } OT_REF_HL, { memory contents at address in register HL } OT_REF_SP, { memory contents at address in register SP } OT_REF_IX, { memory contents at address in register IX } OT_REF_IY, { memory contents at address in register IY } OT_REF_IX_d, { memory contents at address in register IX+d, d is in [-128..127] } OT_REF_IY_d); { memory contents at address in register IY+d, d is in [-128..127] } timmoperandtype = OT_IMM3..OT_IMM_PORT; tregoperandtype = OT_REG8..OT_REG16_AF_; treg8operandtype = OT_REG8..OT_REG8_C_PORT; treg16operandtype = OT_REG16_IX..OT_REG16_AF_; tcondoperandtype = OT_COND..OT_COND_NZ; trefoperandtype = OT_REF_ADDR16..OT_REF_IY_d; trefoperandtypes = set of trefoperandtype; tinsentry = record opcode : tasmop; ops : byte; optypes : array[0..max_operands-1] of toperandtype; code : array[0..maxinfolen] of char; flags : longint; end; pinsentry=^tinsentry; { taicpu } taicpu = class(tai_cpu_abstract_sym) private { next fields are filled in pass1, so pass2 is faster } insentry : PInsEntry; inssize : shortint; function Matches(p:PInsEntry):boolean; function FindInsentry(objdata:TObjData):boolean; public constructor op_none(op : tasmop); constructor op_reg(op : tasmop;_op1 : tregister); constructor op_const(op : tasmop;_op1 : LongInt); constructor op_ref(op : tasmop;const _op1 : treference); constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister); constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference); constructor op_reg_const(op:tasmop; _op1: tregister; _op2: LongInt); constructor op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); constructor op_ref_reg(op : tasmop;const _op1 : treference;_op2 : tregister); constructor op_ref_const(op:tasmop; _op1: treference; _op2: LongInt); { this is for Jmp instructions } constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); constructor op_sym(op : tasmop;_op1 : tasmsymbol); constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); procedure loadbool(opidx:longint;_b:boolean); { register allocation } function is_same_reg_move(regtype: Tregistertype):boolean; override; { register spilling code } function spilling_get_operation_type(opnr: longint): topertype;override; function CheckIfValid:boolean; function GetString:string; end; tai_align = class(tai_align_abstract) { nothing to add } end; procedure InitAsm; procedure DoneAsm; function spilling_create_load(const ref:treference;r:tregister):Taicpu; function spilling_create_store(r:tregister; const ref:treference):Taicpu; function is_ref_addr16(const ref:treference): Boolean; function is_ref_bc(const ref:treference): Boolean; function is_ref_de(const ref:treference): Boolean; function is_ref_hl(const ref:treference): Boolean; function is_ref_sp(const ref:treference): Boolean; function is_ref_ix(const ref:treference): Boolean; function is_ref_iy(const ref:treference): Boolean; function is_ref_ix_d(const ref:treference): Boolean; function is_ref_iy_d(const ref:treference): Boolean; function is_ref_opertype(const ref:treference;opertype:toperandtype): Boolean; function is_ref_in_opertypes(const ref:treference;const refopertypes:trefoperandtypes): Boolean; implementation {**************************************************************************** Instruction table *****************************************************************************} type TInsTabCache=array[TasmOp] of longint; PInsTabCache=^TInsTabCache; const InsTab:array[0..instabentries-1] of TInsEntry={$i z80tab.inc} var InsTabCache : PInsTabCache; {***************************************************************************** taicpu Constructors *****************************************************************************} procedure taicpu.loadbool(opidx:longint;_b:boolean); begin if opidx>=ops then ops:=opidx+1; with oper[opidx]^ do begin if typ=top_ref then dispose(ref); b:=_b; typ:=top_bool; end; end; function taicpu.Matches(p: PInsEntry): boolean; function OperandsMatch(const oper: toper; const ot: toperandtype): boolean; begin case ot of OT_IMM3: result:=(oper.typ=top_const) and (oper.val>=0) and (oper.val<=7); OT_IMM8: { todo: lo8, hi8 addresses } result:=(oper.typ=top_const) and (oper.val>=0) and (oper.val<=255); OT_IMM16: { todo: addresses } result:=(oper.typ=top_const) and (oper.val>=0) and (oper.val<=65535); OT_IMM_VAL0: result:=(oper.typ=top_const) and (oper.val=0); OT_IMM_VAL1: result:=(oper.typ=top_const) and (oper.val=1); OT_IMM_VAL2: result:=(oper.typ=top_const) and (oper.val=2); OT_IMM_RST: result:=(oper.typ=top_const) and ((oper.val=$00) or (oper.val=$08) or (oper.val=$10) or (oper.val=$18) or (oper.val=$20) or (oper.val=$28) or (oper.val=$30) or (oper.val=$38)); {todo: OT_IMM_PORT} OT_REG8: result:=(oper.typ=top_reg) and ((oper.reg=NR_A) or (oper.reg=NR_B) or (oper.reg=NR_C) or (oper.reg=NR_D) or (oper.reg=NR_E) or (oper.reg=NR_H) or (oper.reg=NR_L)); OT_REG8_A: result:=(oper.typ=top_reg) and (oper.reg=NR_A); OT_REG8_I: result:=(oper.typ=top_reg) and (oper.reg=NR_I); OT_REG8_R: result:=(oper.typ=top_reg) and (oper.reg=NR_R); {todo: OT_REG8_C_PORT} OT_REG16_IX: result:=(oper.typ=top_reg) and (oper.reg=NR_IX); OT_REG16_IY: result:=(oper.typ=top_reg) and (oper.reg=NR_IY); OT_REG16_SP: result:=(oper.typ=top_reg) and (oper.reg=NR_SP); OT_REG16_BC_DE_HL_SP: result:=(oper.typ=top_reg) and ((oper.reg=NR_BC) or (oper.reg=NR_DE) or (oper.reg=NR_HL) or (oper.reg=NR_SP)); OT_REG16_BC_DE_HL_AF: result:=(oper.typ=top_reg) and ((oper.reg=NR_BC) or (oper.reg=NR_DE) or (oper.reg=NR_HL) or (oper.reg=NR_AF)); OT_REG16_BC_DE_IX_SP: result:=(oper.typ=top_reg) and ((oper.reg=NR_BC) or (oper.reg=NR_DE) or (oper.reg=NR_IX) or (oper.reg=NR_SP)); OT_REG16_BC_DE_IY_SP: result:=(oper.typ=top_reg) and ((oper.reg=NR_BC) or (oper.reg=NR_DE) or (oper.reg=NR_IY) or (oper.reg=NR_SP)); OT_REG16_DE: result:=(oper.typ=top_reg) and (oper.reg=NR_DE); OT_REG16_HL: result:=(oper.typ=top_reg) and (oper.reg=NR_HL); OT_REG16_AF: result:=(oper.typ=top_reg) and (oper.reg=NR_AF); OT_REG16_AF_: result:=(oper.typ=top_reg) and (oper.reg=NR_AF_); {todo: OT_RELJMP8} OT_REF_ADDR16, OT_REF_BC, OT_REF_DE, OT_REF_HL, OT_REF_SP, OT_REF_IX, OT_REF_IY, OT_REF_IX_d, OT_REF_IY_d: result:=(oper.typ=top_ref) and is_ref_opertype(oper.ref^,ot); else internalerror(2020042901); end; end; var i: Integer; begin result:=false; { Check the opcode } if p^.opcode<>opcode then exit; { The opcode doesn't support conditions, but we have a condition? That's an invalid instruction, don't match it against anything. } if (condition<>C_NONE) and not (opcode in cond_instructions) then exit; { if our opcode supports a condition, but our operation doesn't have one, and we're matching it with an instruction entry 'p' that has a condition, then it doesn't match } if (opcode in cond_instructions) and (condition=C_None) and (p^.ops>0) and (p^.optypes[0] in [OT_COND..OT_COND_NZ]) then exit; { instruction has a condition? } if (opcode in cond_instructions) and (condition<>C_None) then begin { Check the operand count } if p^.ops<>(ops+1) then exit; { Check the condition } case p^.optypes[0] of OT_COND: { any condition accepted }; OT_COND_C: if condition<>C_C then exit; OT_COND_NC: if condition<>C_NC then exit; OT_COND_Z: if condition<>C_Z then exit; OT_COND_NZ: if condition<>C_NZ then exit; else { no condition in 'p'? Then it's not a match! } exit; end; { Check the operands } for i:=1 to p^.ops-1 do if not OperandsMatch(oper[i-1]^,p^.optypes[i]) then exit; end else { no condition } begin { Check the operand count } if p^.ops<>ops then exit; { Check the operands } for i:=0 to p^.ops-1 do if not OperandsMatch(oper[i]^,p^.optypes[i]) then exit; end; result:=true; end; function taicpu.FindInsentry(objdata: TObjData): boolean; var i : longint; begin result:=false; { Things which may only be done once, not when a second pass is done to optimize } if (Insentry=nil) {or (IF_PASS2 in InsEntry^.flags)} then begin { set the file postion } current_filepos:=fileinfo; end else begin { we've already an insentry so it's valid } result:=true; exit; end; { Lookup opcode in the table } InsSize:=-1; i:=instabcache^[opcode]; if i=-1 then begin Message1(asmw_e_opcode_not_in_table,std_op2str[opcode]); exit; end; insentry:=@instab[i]; while (insentry^.opcode=opcode) do begin if matches(insentry) then begin result:=true; exit; end; inc(insentry); end; Message1(asmw_e_invalid_opcode_and_operands,GetString); { No instruction found, set insentry to nil and inssize to -1 } insentry:=nil; inssize:=-1; end; constructor taicpu.op_none(op : tasmop); begin inherited create(op); end; constructor taicpu.op_reg(op : tasmop;_op1 : tregister); begin inherited create(op); ops:=1; loadreg(0,_op1); end; constructor taicpu.op_ref(op : tasmop;const _op1 : treference); begin inherited create(op); ops:=1; loadref(0,_op1); end; constructor taicpu.op_const(op : tasmop;_op1 : LongInt); begin inherited create(op); ops:=1; loadconst(0,_op1); end; constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister); begin inherited create(op); ops:=2; loadreg(0,_op1); loadreg(1,_op2); end; constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: LongInt); begin inherited create(op); ops:=2; loadreg(0,_op1); loadconst(1,_op2); end; constructor taicpu.op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); begin inherited create(op); ops:=2; loadconst(0,_op1); loadreg(1,_op2); end; constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference); begin inherited create(op); ops:=2; loadreg(0,_op1); loadref(1,_op2); end; constructor taicpu.op_ref_reg(op : tasmop;const _op1 : treference;_op2 : tregister); begin inherited create(op); ops:=2; loadref(0,_op1); loadreg(1,_op2); end; constructor taicpu.op_ref_const(op: tasmop; _op1: treference; _op2: LongInt); begin inherited create(op); ops:=2; loadref(0,_op1); loadconst(1,_op2); end; constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); begin inherited create(op); is_jmp:=op in jmp_instructions; condition:=cond; ops:=1; loadsymbol(0,_op1,0); end; constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol); begin inherited create(op); is_jmp:=op in jmp_instructions; ops:=1; loadsymbol(0,_op1,0); end; constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); begin inherited create(op); ops:=1; loadsymbol(0,_op1,_op1ofs); end; function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; begin result:=( ((opcode in [A_LD]) and (regtype = R_INTREGISTER)) ) and (ops=2) and (oper[0]^.typ=top_reg) and (oper[1]^.typ=top_reg) and (oper[0]^.reg=oper[1]^.reg); end; function taicpu.spilling_get_operation_type(opnr: longint): topertype; begin result:=operand_read; case opcode of A_LD, A_POP: if opnr=0 then result:=operand_write; A_PUSH, A_BIT, A_CP, A_DJNZ, A_JR, A_JP, A_CALL, A_RET, A_RETI, A_RETN, A_RST, A_IM: ; A_SET, A_RES: if opnr=1 then result:=operand_readwrite; A_EX: result:=operand_readwrite; else begin if opnr=0 then result:=operand_readwrite; end; end; end; function taicpu.CheckIfValid: boolean; begin result:=FindInsEntry(nil); end; function taicpu.GetString: string; var //i : longint; s : string; //regnr: string; //addsize : boolean; begin s:='['+std_op2str[opcode]; //for i:=0 to ops-1 do // begin // with oper[i]^ do // begin // if i=0 then // s:=s+' ' // else // s:=s+','; // { type } // addsize:=false; // // regnr := ''; // if getregtype(reg) = R_MMREGISTER then // str(getsupreg(reg),regnr); // // if (ot and OT_XMMREG)=OT_XMMREG then // s:=s+'xmmreg' + regnr // else // if (ot and OT_YMMREG)=OT_YMMREG then // s:=s+'ymmreg' + regnr // else // if (ot and OT_ZMMREG)=OT_ZMMREG then // s:=s+'zmmreg' + regnr // // else // if (ot and OT_REG_EXTRA_MASK)=OT_MMXREG then // s:=s+'mmxreg' // else // if (ot and OT_REG_EXTRA_MASK)=OT_FPUREG then // s:=s+'fpureg' // else // if (ot and OT_REGISTER)=OT_REGISTER then // begin // s:=s+'reg'; // addsize:=true; // end // else // if (ot and OT_IMMEDIATE)=OT_IMMEDIATE then // begin // s:=s+'imm'; // addsize:=true; // end // else // if (ot and OT_MEMORY)=OT_MEMORY then // begin // s:=s+'mem'; // addsize:=true; // end // else // s:=s+'???'; // { size } // if addsize then // begin // if (ot and OT_BITS8)<>0 then // s:=s+'8' // else // if (ot and OT_BITS16)<>0 then // s:=s+'16' // else // if (ot and OT_BITS32)<>0 then // s:=s+'32' // else // if (ot and OT_BITS64)<>0 then // s:=s+'64' // else // if (ot and OT_BITS128)<>0 then // s:=s+'128' // else // if (ot and OT_BITS256)<>0 then // s:=s+'256' // else // if (ot and OT_BITS512)<>0 then // s:=s+'512' // else // s:=s+'??'; // { signed } // if (ot and OT_SIGNED)<>0 then // s:=s+'s'; // end; // // if vopext <> 0 then // begin // str(vopext and $07, regnr); // if vopext and OTVE_VECTOR_WRITEMASK = OTVE_VECTOR_WRITEMASK then // s := s + ' {k' + regnr + '}'; // // if vopext and OTVE_VECTOR_ZERO = OTVE_VECTOR_ZERO then // s := s + ' {z}'; // // if vopext and OTVE_VECTOR_SAE = OTVE_VECTOR_SAE then // s := s + ' {sae}'; // // // if vopext and OTVE_VECTOR_BCST = OTVE_VECTOR_BCST then // case vopext and OTVE_VECTOR_BCST_MASK of // OTVE_VECTOR_BCST2: s := s + ' {1to2}'; // OTVE_VECTOR_BCST4: s := s + ' {1to4}'; // OTVE_VECTOR_BCST8: s := s + ' {1to8}'; // OTVE_VECTOR_BCST16: s := s + ' {1to16}'; // end; // // if vopext and OTVE_VECTOR_ER = OTVE_VECTOR_ER then // case vopext and OTVE_VECTOR_ER_MASK of // OTVE_VECTOR_RNSAE: s := s + ' {rn-sae}'; // OTVE_VECTOR_RDSAE: s := s + ' {rd-sae}'; // OTVE_VECTOR_RUSAE: s := s + ' {ru-sae}'; // OTVE_VECTOR_RZSAE: s := s + ' {rz-sae}'; // end; // // end; // end; // end; GetString:=s+']'; end; function spilling_create_load(const ref:treference;r:tregister):Taicpu; begin case getregtype(r) of R_INTREGISTER : result:=taicpu.op_reg_ref(A_LD,r,ref) else internalerror(200401041); end; end; function spilling_create_store(r:tregister; const ref:treference):Taicpu; begin case getregtype(r) of R_INTREGISTER : result:=taicpu.op_ref_reg(A_LD,ref,r); else internalerror(200401041); end; end; function is_ref_addr16(const ref: treference): Boolean; begin result:=(ref.base=NR_NO) and (ref.index=NR_NO); end; function is_ref_bc(const ref: treference): Boolean; begin result:=(((ref.base=NR_BC) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_BC))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_de(const ref: treference): Boolean; begin result:=(((ref.base=NR_DE) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_DE))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_hl(const ref: treference): Boolean; begin result:=(((ref.base=NR_HL) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_HL))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_sp(const ref: treference): Boolean; begin result:=(((ref.base=NR_SP) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_SP))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_ix(const ref: treference): Boolean; begin result:=(((ref.base=NR_IX) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_IX))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_iy(const ref: treference): Boolean; begin result:=(((ref.base=NR_IY) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_IY))) and (ref.offset=0) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_ix_d(const ref: treference): Boolean; begin result:=(((ref.base=NR_IX) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_IX))) and (ref.offset>=-128) and (ref.offset<=127) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_iy_d(const ref: treference): Boolean; begin result:=(((ref.base=NR_IY) and (ref.index=NR_NO)) or ((ref.base=NR_NO) and (ref.index=NR_IY))) and (ref.offset>=-128) and (ref.offset<=127) and (ref.scalefactor<=1) and (ref.symbol=nil) and (ref.relsymbol=nil); end; function is_ref_opertype(const ref: treference; opertype: toperandtype): Boolean; begin case opertype of OT_REF_ADDR16: result:=is_ref_addr16(ref); OT_REF_BC: result:=is_ref_bc(ref); OT_REF_DE: result:=is_ref_de(ref); OT_REF_HL: result:=is_ref_hl(ref); OT_REF_SP: result:=is_ref_sp(ref); OT_REF_IX: result:=is_ref_ix(ref); OT_REF_IY: result:=is_ref_iy(ref); OT_REF_IX_d: result:=is_ref_ix_d(ref); OT_REF_IY_d: result:=is_ref_iy_d(ref); else internalerror(2020041801); end; end; function is_ref_in_opertypes(const ref: treference; const refopertypes: trefoperandtypes): Boolean; var ot: trefoperandtype; begin result:=true; for ot:=low(trefoperandtypes) to high(trefoperandtypes) do if (ot in refopertypes) and is_ref_opertype(ref,ot) then exit; result:=false; end; {**************************************************************************** Instruction table *****************************************************************************} procedure BuildInsTabCache; var i : longint; begin new(instabcache); FillChar(instabcache^,sizeof(tinstabcache),$ff); i:=0; while (i