{ $Id$ Copyright (c) 1998-2002 by the FPC team This unit implements the code generator for the 680x0 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 cginfo,cgbase,cgobj, aasmbase,aasmtai,aasmcpu, cpubase,cpuinfo,cpupara, node,symconst,cg64f32; type tcg68k = class(tcg) procedure a_call_name(list : taasmoutput;const s : string);override; procedure a_call_ref(list : taasmoutput;const ref : treference);override; procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override; procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override; procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override; procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override; procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override; procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override; procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override; procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override; procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); override; procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); override; procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); override; procedure a_parammm_reg(list: taasmoutput; reg: tregister); override; procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override; procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override; procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : tasmlabel);override; procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override; procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override; procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);override; { generates overflow checking code for a node } procedure g_overflowcheck(list: taasmoutput; const p: tnode); override; procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); override; procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override; procedure g_restore_frame_pointer(list : taasmoutput);override; procedure g_return_from_proc(list : taasmoutput;parasize : aword);override; procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override; procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override; procedure g_save_all_registers(list : taasmoutput);override; procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override; protected function fixref(list: taasmoutput; var ref: treference): boolean; private { # Sign or zero extend the register to a full 32-bit value. The new value is left in the same register. } procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); end; tcg64f68k = class(tcg64f32) procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override; procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override; end; { This function returns true if the reference+offset is valid. Otherwise extra code must be generated to solve the reference. On the m68k, this verifies that the reference is valid (e.g : if index register is used, then the max displacement is 256 bytes, if only base is used, then max displacement is 32K } function isvalidrefoffset(const ref: treference): boolean; const TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_L,S_B,S_W,S_L,S_L, S_FS,S_FD,S_FX,S_NO, S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO); Implementation uses globtype,globals,verbose,systems,cutils, symdef,symsym,defbase,paramgr, rgobj,tgobj,rgcpu; const { opcode table lookup } topcg2tasmop: Array[topcg] of tasmop = ( A_NONE, A_ADD, A_AND, A_DIVU, A_DIVS, A_MULS, A_MULU, A_NEG, A_NOT, A_OR, A_ASR, A_LSL, A_LSR, A_SUB, A_EOR ); TOpCmp2AsmCond: Array[topcmp] of TAsmCond = ( C_NONE, C_EQ, C_GT, C_LT, C_GE, C_LE, C_NE, C_LS, C_CS, C_CC, C_HI ); function isvalidrefoffset(const ref: treference): boolean; begin isvalidrefoffset := true; if ref.index <> R_NO then begin if ref.base <> R_NO then internalerror(20020814); if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then isvalidrefoffset := false end else begin if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then isvalidrefoffset := false; end; end; {****************************************************************************} { TCG68K } {****************************************************************************} function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean; var tmpreg: tregister; begin result := false; if (ref.base <> R_NO) then begin if (ref.index <> R_NO) and assigned(ref.symbol) then internalerror(20020814); { base + reg } if ref.index <> R_NO then begin { base + reg + offset } if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then begin list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base)); fixref := true; ref.offset := 0; exit; end; end else { base + offset } if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then begin list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base)); fixref := true; ref.offset := 0; exit; end; end; end; procedure tcg68k.a_call_name(list : taasmoutput;const s : string); begin list.concat(taicpu.op_sym(A_JSR,S_NO,objectlibrary.newasmsymbol(s))); end; procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference); var href : treference; begin href := ref; fixref(list,href); list.concat(taicpu.op_ref(A_JSR,S_NO,href)); end; procedure tcg68k.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister); begin if (rg.isaddressregister(register)) then begin list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) end else if a = 0 then list.concat(taicpu.op_reg(A_CLR,S_L,register)) else begin if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register)) else list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) end; end; procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference); var href : treference; begin href := ref; fixref(list,href); { move to destination reference } list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,href)); end; procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); begin { move to destination register } list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)); { zero/sign extend register to 32-bit } sign_extend(list, size, reg2); end; procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister); var href : treference; begin href := ref; fixref(list,href); list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register)); { extend the value in the register } sign_extend(list, size, register); end; procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); var href : treference; begin if (not rg.isaddressregister(r)) then begin internalerror(2002072901); end; href:=ref; fixref(list, href); list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r)); end; procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); begin { in emulation mode, only 32-bit single is supported } if cs_fp_emulation in aktmoduleswitches then list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)) else list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2)); end; procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); var opsize : topsize; href : treference; begin opsize := tcgsize2opsize[size]; { extended is not supported, since it is not available on Coldfire } if opsize = S_FX then internalerror(20020729); fixref(list,href); { in emulation mode, only 32-bit single is supported } if cs_fp_emulation in aktmoduleswitches then list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg)) else list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg)); end; procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); var opsize : topsize; begin opsize := tcgsize2opsize[size]; { extended is not supported, since it is not available on Coldfire } if opsize = S_FX then internalerror(20020729); { in emulation mode, only 32-bit single is supported } if cs_fp_emulation in aktmoduleswitches then list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref)) else list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref)); end; procedure tcg68k.a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); begin internalerror(20020729); end; procedure tcg68k.a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); begin internalerror(20020729); end; procedure tcg68k.a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); begin internalerror(20020729); end; procedure tcg68k.a_parammm_reg(list: taasmoutput; reg: tregister); begin internalerror(20020729); end; procedure tcg68k.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); var scratch_reg : tregister; scratch_reg2: tregister; opcode : tasmop; begin { need to emit opcode? } if optimize_op_const_reg(list, op, a, reg) then exit; opcode := topcg2tasmop[op]; case op of OP_ADD : Begin if (a >= 1) and (a <= 8) then list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg)) else begin { all others, including coldfire } list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg)); end; end; OP_AND, OP_OR: Begin list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,a, reg)); end; OP_DIV : Begin internalerror(20020816); end; OP_IDIV : Begin internalerror(20020816); end; OP_IMUL : Begin if aktoptprocessor = MC68000 then begin rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D1); list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, R_D0)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, R_D1)); cg.a_call_name(list,'FPC_MUL_LONGINT'); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg)); rg.ungetregisterint(list,R_D0); rg.ungetregisterint(list,R_D1); end else begin if (rg.isaddressregister(reg)) then begin scratch_reg := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); cg.free_scratch_reg(list,scratch_reg); end else list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg)); end; end; OP_MUL : Begin if aktoptprocessor = MC68000 then begin rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D1); list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, R_D0)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, R_D1)); cg.a_call_name(list,'FPC_MUL_CARDINAL'); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg)); rg.ungetregisterint(list,R_D0); rg.ungetregisterint(list,R_D1); end else begin if (rg.isaddressregister(reg)) then begin scratch_reg := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); cg.free_scratch_reg(list,scratch_reg); end else list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg)); end; end; OP_SAR, OP_SHL, OP_SHR : Begin if (a >= 1) and (a <= 8) then begin { now allowed to shift an address register } if (rg.isaddressregister(reg)) then begin scratch_reg := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); cg.free_scratch_reg(list,scratch_reg); end else list.concat(taicpu.op_const_reg(opcode,S_L,a, reg)); end else begin { we must load the data into a register ... :() } scratch_reg := cg.get_scratch_reg_int(list); list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg)); { again... since shifting with address register is not allowed } if (rg.isaddressregister(reg)) then begin scratch_reg2 := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2)); list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg)); cg.free_scratch_reg(list,scratch_reg2); end else list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg)); cg.free_scratch_reg(list,scratch_reg); end; end; OP_SUB : Begin if (a >= 1) and (a <= 8) then list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg)) else begin { all others, including coldfire } list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg)); end; end; OP_XOR : Begin list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg)); end; else internalerror(20020729); end; end; procedure tcg68k.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); var hreg1,hreg2: tregister; begin case op of OP_ADD : Begin if aktoptprocessor = ColdFire then begin { operation only allowed only a longword } sign_extend(list, size, reg1); sign_extend(list, size, reg2); list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2)); end else begin list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2)); end; end; OP_AND,OP_OR, OP_SAR,OP_SHL, OP_SHR,OP_SUB,OP_XOR : Begin { load to data registers } if (rg.isaddressregister(reg1)) then begin hreg1 := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); end else hreg1 := reg1; if (rg.isaddressregister(reg2)) then begin hreg2:= cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); end else hreg2 := reg2; if aktoptprocessor = ColdFire then begin { operation only allowed only a longword } {!*************************************** in the case of shifts, the value to shift by, should already be valid, so no need to sign extend the value ! } if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then sign_extend(list, size, hreg1); sign_extend(list, size, hreg2); list.concat(taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2)); end else begin list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2)); end; if reg1 <> hreg1 then cg.free_scratch_reg(list,hreg1); { move back result into destination register } if reg2 <> hreg2 then begin list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); cg.free_scratch_reg(list,hreg2); end; end; OP_DIV : Begin internalerror(20020816); end; OP_IDIV : Begin internalerror(20020816); end; OP_IMUL : Begin sign_extend(list, size,reg1); sign_extend(list, size,reg2); if aktoptprocessor = MC68000 then begin rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D1); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, R_D0)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, R_D1)); cg.a_call_name(list,'FPC_MUL_LONGINT'); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg2)); rg.ungetregisterint(list,R_D0); rg.ungetregisterint(list,R_D1); end else begin if (rg.isaddressregister(reg1)) then hreg1 := cg.get_scratch_reg_int(list) else hreg1 := reg1; if (rg.isaddressregister(reg2)) then hreg2:= cg.get_scratch_reg_int(list) else hreg2 := reg2; if reg1 <> hreg1 then list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); if reg2 <> hreg2 then list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2)); if reg1 <> hreg1 then cg.free_scratch_reg(list,hreg1); { move back result into destination register } if reg2 <> hreg2 then begin list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); cg.free_scratch_reg(list,hreg2); end; end; end; OP_MUL : Begin sign_extend(list, size,reg1); sign_extend(list, size,reg2); if aktoptprocessor = MC68000 then begin rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D1); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, R_D0)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, R_D1)); cg.a_call_name(list,'FPC_MUL_CARDINAL'); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg2)); rg.ungetregisterint(list,R_D0); rg.ungetregisterint(list,R_D1); end else begin if (rg.isaddressregister(reg1)) then begin hreg1 := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); end else hreg1 := reg1; if (rg.isaddressregister(reg2)) then begin hreg2:= cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); end else hreg2 := reg2; list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2)); if reg1 <> hreg1 then cg.free_scratch_reg(list,hreg1); { move back result into destination register } if reg2 <> hreg2 then begin list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); cg.free_scratch_reg(list,hreg2); end; end; end; OP_NEG, OP_NOT : Begin if reg1 <> R_NO then internalerror(200112291); if (rg.isaddressregister(reg2)) then begin hreg2 := cg.get_scratch_reg_int(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); end else hreg2 := reg2; { coldfire only supports long version } if aktoptprocessor = ColdFire then begin sign_extend(list, size,hreg2); list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2)); end else begin list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2)); end; if reg2 <> hreg2 then begin list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); cg.free_scratch_reg(list,hreg2); end; end; else internalerror(20020729); end; end; procedure tcg68k.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : tasmlabel); var hregister : tregister; begin if a = 0 then begin list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg)); end else begin if (aktoptprocessor = ColdFire) then begin { only longword comparison is supported, and only on data registers. } hregister := cg.get_scratch_reg_int(list); { always move to a data register } list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister)); { sign/zero extend the register } sign_extend(list, size,hregister); list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister)); cg.free_scratch_reg(list,hregister); end else begin list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg)); end; end; { emit the actual jump to the label } a_jmp_cond(list,cmp_op,l); end; procedure tcg68k.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); begin list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2)); { emit the actual jump to the label } a_jmp_cond(list,cmp_op,l); end; procedure tcg68k.a_jmp_always(list : taasmoutput;l: tasmlabel); var ai: taicpu; begin ai := Taicpu.op_sym(A_JMP,S_NO,l); ai.is_jmp := true; list.concat(ai); end; procedure tcg68k.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); var ai : taicpu; begin ai := Taicpu.op_sym(A_BXX,S_NO,l); ai.SetCondition(flags_to_cond(f)); ai.is_jmp := true; list.concat(ai); end; procedure tcg68k.g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); var ai : taicpu; hreg : tregister; begin { move to a Dx register? } if (rg.isaddressregister(reg)) then begin hreg := get_scratch_reg_int(list); a_load_const_reg(list,size,0,hreg); ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg); ai.SetCondition(flags_to_cond(f)); list.concat(ai); if (aktoptprocessor = ColdFire) then begin { neg.b does not exist on the Coldfire so we need to sign extend the value before doing a neg.l } list.concat(taicpu.op_reg(A_EXTB,S_L,hreg)); list.concat(taicpu.op_reg(A_NEG,S_L,hreg)); end else begin list.concat(taicpu.op_reg(A_NEG,S_B,hreg)); end; list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg)); free_scratch_reg(list,hreg); end else begin a_load_const_reg(list,size,0,reg); ai:=Taicpu.Op_reg(A_Sxx,S_B,reg); ai.SetCondition(flags_to_cond(f)); list.concat(ai); if (aktoptprocessor = ColdFire) then begin { neg.b does not exist on the Coldfire so we need to sign extend the value before doing a neg.l } list.concat(taicpu.op_reg(A_EXTB,S_L,reg)); list.concat(taicpu.op_reg(A_NEG,S_L,reg)); end else begin list.concat(taicpu.op_reg(A_NEG,S_B,reg)); end; end; end; procedure tcg68k.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean); var helpsize : longint; i : byte; reg8,reg32 : tregister; swap : boolean; hregister : tregister; iregister : tregister; jregister : tregister; hp1 : treference; hp2 : treference; hl : tasmlabel; hl2: tasmlabel; popaddress : boolean; srcref,dstref : treference; begin popaddress := false; { this should never occur } if len > 65535 then internalerror(0); hregister := get_scratch_reg_int(list); if delsource then reference_release(list,source); { from 12 bytes movs is being used } if (not loadref) and ((len<=8) or (not(cs_littlesize in aktglobalswitches) and (len<=12))) then begin srcref := source; dstref := dest; helpsize:=len div 4; { move a dword x times } for i:=1 to helpsize do begin a_load_ref_reg(list,OS_INT,srcref,hregister); a_load_reg_ref(list,OS_INT,hregister,dstref); inc(srcref.offset,4); inc(dstref.offset,4); dec(len,4); end; { move a word } if len>1 then begin a_load_ref_reg(list,OS_16,srcref,hregister); a_load_reg_ref(list,OS_16,hregister,dstref); inc(srcref.offset,2); inc(dstref.offset,2); dec(len,2); end; { move a single byte } if len>0 then begin a_load_ref_reg(list,OS_8,srcref,hregister); a_load_reg_ref(list,OS_8,hregister,dstref); end end else begin iregister := get_scratch_reg_address(list); jregister := get_scratch_reg_address(list); { reference for move (An)+,(An)+ } reference_reset(hp1); hp1.base := iregister; { source register } hp1.direction := dir_inc; reference_reset(hp2); hp2.base := jregister; hp2.direction := dir_inc; { iregister = source } { jregister = destination } if loadref then a_load_ref_reg(list,OS_INT,source,iregister) else a_loadaddr_ref_reg(list,source,iregister); a_loadaddr_ref_reg(list,dest,jregister); { double word move only on 68020+ machines } { because of possible alignment problems } { use fast loop mode } if (aktoptprocessor=MC68020) then begin helpsize := len - len mod 4; len := len mod 4; list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister)); objectlibrary.getlabel(hl2); a_jmp_always(list,hl2); objectlibrary.getlabel(hl); a_label(list,hl); list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2)); cg.a_label(list,hl2); list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); if len > 1 then begin dec(len,2); list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2)); end; if len = 1 then list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2)); end else begin { Fast 68010 loop mode with no possible alignment problems } helpsize := len; list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister)); objectlibrary.getlabel(hl2); a_jmp_always(list,hl2); objectlibrary.getlabel(hl); a_label(list,hl); list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2)); a_label(list,hl2); list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); end; { restore the registers that we have just used olny if they are used! } if jregister = R_A1 then hp2.base := R_NO; if iregister = R_A0 then hp1.base := R_NO; reference_release(list,hp1); reference_release(list,hp2); end; { loading SELF-reference again } g_maybe_loadself(list); if delsource then tg.ungetiftemp(list,source); free_scratch_reg(list,hregister); end; procedure tcg68k.g_overflowcheck(list: taasmoutput; const p: tnode); begin end; procedure tcg68k.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); begin end; procedure tcg68k.g_stackframe_entry(list : taasmoutput;localsize : longint); begin if localsize<>0 then begin { Not to complicate the code generator too much, and since some } { of the systems only support this format, the localsize cannot } { exceed 32K in size. } if (localsize < low(smallint)) or (localsize > high(smallint)) then CGMessage(cg_e_stacklimit_in_local_routine); list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize)); end { endif localsize <> 0 } else begin list.concat(taicpu.op_reg_reg(A_MOVE,S_L,frame_pointer_reg,R_SPPUSH)); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,stack_pointer_reg,frame_pointer_reg)); end; end; procedure tcg68k.g_restore_frame_pointer(list : taasmoutput); begin list.concat(taicpu.op_reg(A_UNLK,S_NO,frame_pointer_reg)); end; procedure tcg68k.g_return_from_proc(list : taasmoutput;parasize : aword); var hregister : tregister; begin {Routines with the poclearstack flag set use only a ret.} { also routines with parasize=0 } if (po_clearstack in aktprocdef.procoptions) then begin { complex return values are removed from stack in C code PM } if paramanager.ret_in_param(aktprocdef.rettype.def) then list.concat(taicpu.op_const(A_RTD,S_NO,4)) else list.concat(taicpu.op_none(A_RTS,S_NO)); end else if (parasize=0) then begin list.concat(taicpu.op_none(A_RTS,S_NO)); end else begin { return with immediate size possible here } { signed! } { RTD is not supported on the coldfire } if (aktoptprocessor = MC68020) and (parasize < $7FFF) then list.concat(taicpu.op_const(A_RTD,S_NO,parasize)) { manually restore the stack } else begin { We must pull the PC Counter from the stack, before } { restoring the stack pointer, otherwise the PC would } { point to nowhere! } { save the PC counter (pop it from the stack) } hregister := get_scratch_reg_address(list); list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_SPPULL,hregister)); { can we do a quick addition ... } if (parasize > 0) and (parasize < 9) then list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,R_SP)) else { nope ... } list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,R_SP)); { restore the PC counter (push it on the stack) } list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)); list.concat(taicpu.op_none(A_RTS,S_NO)); free_scratch_reg(list,hregister); end; end; end; procedure tcg68k.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset); var tosave : tregisterlist; begin tosave:=std_saved_registers; { only save the registers which are not used and must be saved } tosave:=tosave*usedinproc; if tosave<>[] then list.concat(taicpu.op_reglist_reg(A_MOVEM,S_L,tosave,R_SPPUSH)); end; procedure tcg68k.g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset); var torestore : tregisterset; begin torestore:=std_saved_registers; { should be intersected with used regs, no ? } torestore:=torestore*usedinproc; if torestore<>[] then list.concat(taicpu.op_reg_reglist(A_MOVEM,S_L,R_SPPULL,torestore)); end; procedure tcg68k.g_save_all_registers(list : taasmoutput); begin end; procedure tcg68k.g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean); begin end; procedure tcg68k.sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister); begin case _oldsize of { sign extend } OS_S8: begin if (rg.isaddressregister(reg)) then internalerror(20020729); if (aktoptprocessor = MC68000) then begin list.concat(taicpu.op_reg(A_EXT,S_W,reg)); list.concat(taicpu.op_reg(A_EXT,S_L,reg)); end else begin list.concat(taicpu.op_reg(A_EXTB,S_L,reg)); end; end; OS_S16: begin if (rg.isaddressregister(reg)) then internalerror(20020729); list.concat(taicpu.op_reg(A_EXT,S_L,reg)); end; { zero extend } OS_8: begin if (rg.isaddressregister(reg)) then internalerror(20020729); list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg)); end; OS_16: begin if (rg.isaddressregister(reg)) then internalerror(20020729); list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg)); end; end; { otherwise the size is already correct } end; procedure tcg68k.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); var ai : taicpu; begin if cond=OC_None then ai := Taicpu.Op_sym(A_JMP,S_NO,l) else begin ai:=Taicpu.Op_sym(A_Bxx,S_NO,l); ai.SetCondition(TOpCmp2AsmCond[cond]); end; ai.is_jmp:=true; list.concat(ai); end; {****************************************************************************} { TCG64F68K } {****************************************************************************} procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64); var hreg1, hreg2 : tregister; opcode : tasmop; begin opcode := topcg2tasmop[op]; case op of OP_ADD : begin { if one of these three registers is an address register, we'll really get into problems! } if rg.isaddressregister(regdst.reglo) or rg.isaddressregister(regdst.reghi) or rg.isaddressregister(regsrc.reghi) then internalerror(20020817); list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi)); end; OP_AND,OP_OR : begin { at least one of the registers must be a data register } if (rg.isaddressregister(regdst.reglo) and rg.isaddressregister(regsrc.reglo)) or (rg.isaddressregister(regsrc.reghi) and rg.isaddressregister(regdst.reghi)) then internalerror(20020817); cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo); cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi); end; { this is handled in 1st pass for 32-bit cpu's (helper call) } OP_IDIV,OP_DIV, OP_IMUL,OP_MUL: internalerror(2002081701); { this is also handled in 1st pass for 32-bit cpu's (helper call) } OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702); OP_SUB: begin { if one of these three registers is an address register, we'll really get into problems! } if rg.isaddressregister(regdst.reglo) or rg.isaddressregister(regdst.reghi) or rg.isaddressregister(regsrc.reghi) then internalerror(20020817); list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi)); end; OP_XOR: begin if rg.isaddressregister(regdst.reglo) or rg.isaddressregister(regsrc.reglo) or rg.isaddressregister(regsrc.reghi) or rg.isaddressregister(regdst.reghi) then internalerror(20020817); list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo)); list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi)); end; end; { end case } end; procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64); var lowvalue : cardinal; highvalue : cardinal; begin { is it optimized out ? } if optimize64_op_const_reg(list,op,value,reg) then exit; lowvalue := cardinal(value); highvalue:= value shr 32; { the destination registers must be data registers } if rg.isaddressregister(reg.reglo) or rg.isaddressregister(reg.reghi) then internalerror(20020817); case op of OP_ADD : begin list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,reg.reglo)); list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,reg.reglo)); end; OP_AND : begin { should already be optimized out } internalerror(2002081801); end; OP_OR : begin { should already be optimized out } internalerror(2002081802); end; { this is handled in 1st pass for 32-bit cpu's (helper call) } OP_IDIV,OP_DIV, OP_IMUL,OP_MUL: internalerror(2002081701); { this is also handled in 1st pass for 32-bit cpu's (helper call) } OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702); OP_SUB: begin list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,reg.reglo)); list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,reg.reglo)); end; OP_XOR: begin list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,reg.reglo)); list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,reg.reglo)); end; end; { end case } end; begin cg := tcg68k.create; cg64 :=tcg64f68k.create; end. { $Log$ Revision 1.6 2002-09-07 15:25:12 peter * old logs removed and tabs fixed Revision 1.5 2002/08/19 18:17:48 carl + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) * more fixes to m68k for 64-bit operations Revision 1.4 2002/08/16 14:24:59 carl * issameref() to test if two references are the same (then emit no opcodes) + ret_in_reg to replace ret_in_acc (fix some register allocation bugs at the same time) + save_std_register now has an extra parameter which is the usedinproc registers Revision 1.3 2002/08/15 08:13:54 carl - a_load_sym_ofs_reg removed * loadvmt now calls loadaddr_ref_reg instead Revision 1.2 2002/08/14 19:16:34 carl + m68k type conversion nodes + started some mathematical nodes * out of bound references should now be handled correctly Revision 1.1 2002/08/13 18:30:22 carl * rename swatoperands to swapoperands + m68k first compilable version (still needs a lot of testing): assembler generator, system information , inline assembler reader. Revision 1.5 2002/08/12 15:08:43 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class * many many updates for m68k (will soon start to compile) - removed some ifdef or correct them for correct cpu Revision 1.2 2002/08/05 17:27:52 carl + updated m68k Revision 1.1 2002/07/29 17:51:32 carl + restart m68k support }