{ $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; 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_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: 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; { This routine should setup the stack frame and allocate @var(localsize) bytes on the local stack (for local variables). It should also setup the frame pointer, so that all variables are now accessed via the frame pointer register. } procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override; { restores the previous frame pointer at procedure exit } procedure g_restore_frame_pointer(list : taasmoutput);override; { This routine should update the stack pointer so that parasize are freed from the stack. It should also emit the return instruction } procedure g_return_from_proc(list : taasmoutput;parasize : aword);override; procedure g_save_standard_registers(list : taasmoutput);override; procedure g_restore_standard_registers(list : taasmoutput);override; procedure g_save_all_registers(list : taasmoutput);override; procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override; 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; Implementation uses globtype,globals,verbose,systems,cutils, symdef,symsym,defbase,paramgr, rgobj,tgobj,rgcpu; 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); { 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 ); 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); begin list.concat(taicpu.op_ref(A_JSR,S_NO,ref)); 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) >= -128) and (longint(a) <= 127) 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); begin { move to destination reference } list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,ref)); 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); begin list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],ref,register)); { extend the value in the register } sign_extend(list, size, register); end; procedure tcg68k.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); begin {$warning To complete this section} end; procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); begin if (not rg.isaddressregister(r)) then begin internalerror(2002072901); end; list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r)); end; procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); begin 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; begin opsize := tcgsize2opsize[size]; { extended is not supported, since it is not available on Coldfire } if opsize = S_FX then internalerror(20020729); list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,ref,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); 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 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 {$warning To complete DIV opcode} end; OP_IDIV : Begin {$warning To complete IDIV opcode} 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 {$warning DIV to complete} end; OP_IDIV : Begin {$warning IDIV to complete} 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 list.concat(taicpu.op_ref_reg(A_MOVE,S_L,srcref,hregister)); list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,dstref)); inc(srcref.offset,4); inc(dstref.offset,4); dec(len,4); end; { move a word } if len>1 then begin list.concat(taicpu.op_ref_reg(A_MOVE,S_W,srcref,hregister)); list.concat(taicpu.op_reg_ref(A_MOVE,S_W,hregister,dstref)); inc(srcref.offset,2); inc(dstref.offset,2); dec(len,2); end; { move a single byte } if len>0 then begin list.concat(taicpu.op_ref_reg(A_MOVE,S_B,srcref,hregister)); list.concat(taicpu.op_reg_ref(A_MOVE,S_B,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 list.concat(taicpu.op_ref_reg(A_MOVE,S_L,source,iregister)) else list.concat(taicpu.op_ref_reg(A_LEA,S_L,source,iregister)); list.concat(taicpu.op_ref_reg(A_LEA,S_L,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 < -32767) or (localsize > 32768) 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); begin end; procedure tcg68k.g_restore_standard_registers(list : taasmoutput); begin 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; begin cg := tcg68k.create; { cg64 :=tcg64fppc.create;} end. { $Log$ 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 }