paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-02 03:55:20 +02:00
Code Issues Packages Projects Releases Wiki Activity
238964e443
fpc/compiler/m68k/cgcpu.pas
Károly Balogh 238964e443 Various m68k fixes/additions: 
- fixes in asmreader, basic stuff works again, the rest is untested
  - removed lot of unnecessary ungetcpuregister()s
  - various other fixes i forgot
  + basic amigaos syscalls support. still lacks explicit funcretloc

git-svn-id: trunk@1943 -
2005-12-13 20:42:15 +00:00

1305 lines
48 KiB
ObjectPascal
Raw Blame History

{
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.
****************************************************************************
}
{$WARNINGS OFF}
unit cgcpu;
{$i fpcdefs.inc}
interface
uses
cgbase,cgobj,globtype,
aasmbase,aasmtai,aasmcpu,
cpubase,cpuinfo,
parabase,cpupara,
node,symconst,symtype,
cgutils,cg64f32;
type
tcg68k = class(tcg)
procedure init_register_allocators;override;
procedure done_register_allocators;override;
procedure a_call_name(list : taasmoutput;const s : string);override;
procedure a_call_reg(list : taasmoutput;reg : tregister);override;
procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);override;
procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : 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; size: tcgsize; 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;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; 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 : aint;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 : aint);override;
{ generates overflow checking code for a node }
procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override;
procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
// procedure g_restore_frame_pointer(list : taasmoutput);override;
// procedure g_return_from_proc(list : taasmoutput;parasize : aint);override;
procedure g_restore_standard_registers(list:Taasmoutput);override;
procedure g_save_standard_registers(list:Taasmoutput);override;
// procedure g_save_all_registers(list : taasmoutput);override;
// procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);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; size: tcgsize; regsrc,regdst : tregister64);override;
procedure a_op64_const_reg(list : taasmoutput;op:TOpCG; size: tcgsize; value : int64;regdst : 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_NO,S_B,S_W,S_L,S_L,S_NO,
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,S_NO);
implementation
uses
globals,verbose,systems,cutils,
symdef,symsym,defutil,paramgr,procinfo,
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 <> NR_NO then
begin
if ref.base <> NR_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 }
{****************************************************************************}
procedure tcg68k.init_register_allocators;
begin
inherited init_register_allocators;
rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
[RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
first_int_imreg,[]);
rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
[RS_A0,RS_A1,RS_A2,RS_A3,RS_A4,RS_A5,RS_A6],
first_addr_imreg,[]);
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
[RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
first_fpu_imreg,[]);
end;
procedure tcg68k.done_register_allocators;
begin
rg[R_INTREGISTER].free;
rg[R_FPUREGISTER].free;
rg[R_ADDRESSREGISTER].free;
inherited done_register_allocators;
end;
function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean;
begin
result:=false;
{ The Coldfire and MC68020+ have extended
addressing capabilities with a 32-bit
displacement.
}
if (aktoptprocessor<>MC68000) then
exit;
if (ref.base<>NR_NO) then
begin
if (ref.index <> NR_NO) and assigned(ref.symbol) then
internalerror(20020814);
{ base + reg }
if ref.index <> NR_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,AB_EXTERNAL,AT_FUNCTION)));
end;
procedure tcg68k.a_call_reg(list : taasmoutput;reg : tregister);
var
href : treference;
begin
reference_reset_base(href, reg, 0);
//!!! a_call_ref(list,href);
end;
procedure tcg68k.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);
begin
if getregtype(register)=R_ADDRESSREGISTER then
begin
list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(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,longint(a),register))
else
list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
end;
end;
procedure tcg68k.a_load_reg_ref(list : taasmoutput;fromsize,tosize : 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[fromsize],register,href));
end;
procedure tcg68k.a_load_reg_reg(list : taasmoutput;fromsize,tosize : 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, fromsize, reg2);
end;
procedure tcg68k.a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
var
href : treference;
begin
href := ref;
fixref(list,href);
list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],href,register));
{ extend the value in the register }
sign_extend(list, tosize, register);
end;
procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
href : treference;
begin
if getregtype(r)=R_ADDRESSREGISTER 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; size: tcgsize; 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);
href := ref;
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;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle);
begin
internalerror(20020729);
end;
procedure tcg68k.a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle);
begin
internalerror(20020729);
end;
procedure tcg68k.a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle);
begin
internalerror(20020729);
end;
procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle);
begin
internalerror(20020729);
end;
procedure tcg68k.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; reg: TRegister);
var
scratch_reg : tregister;
scratch_reg2: tregister;
opcode : tasmop;
r,r2 : Tregister;
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,longint(a), reg));
end;
OP_DIV :
begin
internalerror(20020816);
end;
OP_IDIV :
begin
internalerror(20020816);
end;
OP_IMUL :
begin
if aktoptprocessor = MC68000 then
begin
r:=NR_D0;
r2:=NR_D1;
cg.getcpuregister(list,NR_D0);
cg.getcpuregister(list,NR_D1);
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
cg.a_call_name(list,'FPC_MUL_LONGINT');
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
cg.ungetcpuregister(list,r);
cg.ungetcpuregister(list,r2);
end
else
begin
if (isaddressregister(reg)) then
begin
scratch_reg := getintregister(list,OS_INT);
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));
end
else
list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
end;
end;
OP_MUL :
begin
if aktoptprocessor = MC68000 then
begin
r:=NR_D0;
r2:=NR_D1;
cg.getcpuregister(list,NR_D0);
cg.getcpuregister(list,NR_D1);
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
cg.a_call_name(list,'FPC_MUL_LONGWORD');
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
cg.ungetcpuregister(list,r);
cg.ungetcpuregister(list,r2);
end
else
begin
if (isaddressregister(reg)) then
begin
scratch_reg := getintregister(list,OS_INT);
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));
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 (isaddressregister(reg)) then
begin
scratch_reg := getintregister(list,OS_INT);
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));
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.getintregister(list,OS_INT);
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
{ again... since shifting with address register is not allowed }
if (isaddressregister(reg)) then
begin
scratch_reg2 := cg.getintregister(list,OS_INT);
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));
end
else
list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, 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,r,r2: 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 (isaddressregister(reg1)) then
begin
hreg1 := getintregister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
end
else
hreg1 := reg1;
if (isaddressregister(reg2)) then
begin
hreg2:= getintregister(list,OS_INT);
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;
{ move back result into destination register }
if reg2 <> hreg2 then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
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
r:=NR_D0;
r2:=NR_D1;
cg.getcpuregister(list,NR_D0);
cg.getcpuregister(list,NR_D1);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
cg.a_call_name(list,'FPC_MUL_LONGINT');
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
cg.ungetcpuregister(list,r);
cg.ungetcpuregister(list,r2);
end
else
begin
// writeln('doing 68020');
if (isaddressregister(reg1)) then
hreg1 := getintregister(list,OS_INT)
else
hreg1 := reg1;
if (isaddressregister(reg2)) then
hreg2:= getintregister(list,OS_INT)
else
hreg2 := reg2;
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
{ move back result into destination register }
if reg2 <> hreg2 then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
end;
end;
end;
OP_MUL :
begin
sign_extend(list, size,reg1);
sign_extend(list, size,reg2);
if aktoptprocessor = MC68000 then
begin
r:=NR_D0;
r2:=NR_D1;
cg.getcpuregister(list,NR_D0);
cg.getcpuregister(list,NR_D1);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
cg.a_call_name(list,'FPC_MUL_LONGWORD');
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
cg.ungetcpuregister(list,r);
cg.ungetcpuregister(list,r2);
end
else
begin
if (isaddressregister(reg1)) then
begin
hreg1 := cg.getintregister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
end
else
hreg1 := reg1;
if (isaddressregister(reg2)) then
begin
hreg2:= cg.getintregister(list,OS_INT);
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));
{ move back result into destination register }
if reg2<>hreg2 then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
end;
end;
end;
OP_NEG,
OP_NOT :
Begin
{ if there are two operands, move the register,
since the operation will only be done on the result
register.
}
if reg1 <> NR_NO then
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
if (isaddressregister(reg2)) then
begin
hreg2 := getintregister(list,OS_INT);
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));
end;
end;
else
internalerror(20020729);
end;
end;
procedure tcg68k.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;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 := getintregister(list,OS_INT);
{ 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));
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 (isaddressregister(reg)) then
begin
hreg := getintregister(list,OS_INT);
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));
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 : aint);
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;
// writeln('concatcopy:',len);
{ this should never occur }
if len > 65535 then
internalerror(0);
hregister := getintregister(list,OS_INT);
// 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,OS_INT,srcref,hregister);
a_load_reg_ref(list,OS_INT,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,OS_16,srcref,hregister);
a_load_reg_ref(list,OS_16,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,OS_8,srcref,hregister);
a_load_reg_ref(list,OS_8,OS_8,hregister,dstref);
end
end
else
begin
iregister:=getaddressregister(list);
jregister:=getaddressregister(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
cg.a_load_ref_reg(list,OS_INT,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.getjumplabel(hl2);
a_jmp_always(list,hl2);
objectlibrary.getjumplabel(hl);
a_label(list,hl);
list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
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.getjumplabel(hl2);
a_jmp_always(list,hl2);
objectlibrary.getjumplabel(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 = NR_A1 then
hp2.base := NR_NO;
if iregister = NR_A0 then
hp1.base := NR_NO;
// reference_release(list,hp1);
// reference_release(list,hp2);
end;
// if delsource then
// tg.ungetiftemp(list,source);
end;
procedure tcg68k.g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef);
begin
end;
procedure tcg68k.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);
begin
end;
procedure tcg68k.g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);
var
r,rsp:Tregister;
ref : treference;
begin
r:=NR_FRAME_POINTER_REG;
rsp:=NR_STACK_POINTER_REG;
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_localsize_too_big);
list.concat(taicpu.op_reg_const(A_LINK,S_W,r,-localsize));
end { endif localsize <> 0 }
else
begin
reference_reset_base(ref,NR_STACK_POINTER_REG,0);
ref.direction:=dir_dec;
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,r,ref));
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,rsp,r));
end;
end;
{ procedure tcg68k.g_restore_frame_pointer(list : taasmoutput);
var
r:Tregister;
begin
r:=NR_FRAME_POINTER_REG;
list.concat(taicpu.op_reg(A_UNLK,S_NO,r));
end;
}
procedure tcg68k.g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);
var
r,hregister : tregister;
ref : treference;
begin
// writeln('g_proc_exit');
{ Routines with the poclearstack flag set use only a ret.
also routines with parasize=0 }
if current_procinfo.procdef.proccalloption in clearstack_pocalls then
begin
{ complex return values are removed from stack in C code PM }
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) 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:=NR_A3;
cg.a_reg_alloc(list,hregister);
reference_reset_base(ref,NR_STACK_POINTER_REG,0);
ref.direction:=dir_inc;
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
{ can we do a quick addition ... }
r:=NR_SP;
if (parasize > 0) and (parasize < 9) then
list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
else { nope ... }
list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
{ restore the PC counter (push it on the stack) }
reference_reset_base(ref,NR_STACK_POINTER_REG,0);
ref.direction:=dir_dec;
cg.a_reg_alloc(list,hregister);
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
list.concat(taicpu.op_none(A_RTS,S_NO));
end;
end;
end;
procedure Tcg68k.g_save_standard_registers(list:Taasmoutput);
var
tosave : tcpuregisterset;
ref : treference;
begin
{!!!!!
tosave:=std_saved_registers;
{ only save the registers which are not used and must be saved }
tosave:=tosave*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
reference_reset_base(ref,NR_STACK_POINTER_REG,0);
ref.direction:=dir_dec;
if tosave<>[] then
list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,tosave,ref));
}
end;
procedure Tcg68k.g_restore_standard_registers(list:Taasmoutput);
var
torestore : tcpuregisterset;
r:Tregister;
ref : treference;
begin
{!!!!!!!!
torestore:=std_saved_registers;
{ should be intersected with used regs, no ? }
torestore:=torestore*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
reference_reset_base(ref,NR_STACK_POINTER_REG,0);
ref.direction:=dir_inc;
if torestore<>[] then
list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,ref,torestore));
}
end;
{
procedure tcg68k.g_save_all_registers(list : taasmoutput);
begin
end;
procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);
begin
end;
}
procedure tcg68k.sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
begin
case _oldsize of
{ sign extend }
OS_S8:
begin
if (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 (isaddressregister(reg)) then
internalerror(20020729);
list.concat(taicpu.op_reg(A_EXT,S_L,reg));
end;
{ zero extend }
OS_8:
begin
list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
end;
OS_16:
begin
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;size: tcgsize; regsrc,regdst : tregister64);
var
hreg1, hreg2 : tregister;
opcode : tasmop;
begin
// writeln('a_op64_reg_reg');
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 isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) or
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 (isaddressregister(regdst.reglo) and
isaddressregister(regsrc.reglo)) or
(isaddressregister(regsrc.reghi) and
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 isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) or
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 isaddressregister(regdst.reglo) or
isaddressregister(regsrc.reglo) or
isaddressregister(regsrc.reghi) or
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;size: tcgsize; value : int64;regdst : tregister64);
var
lowvalue : cardinal;
highvalue : cardinal;
begin
// writeln('a_op64_const_reg');
{ is it optimized out ? }
// if cg.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 isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) then
internalerror(20020817);
case op of
OP_ADD :
begin
list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,regdst.reglo));
list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,regdst.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,regdst.reglo));
list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,regdst.reglo));
end;
OP_XOR:
begin
list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,regdst.reglo));
list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,regdst.reglo));
end;
end; { end case }
end;
begin
cg := tcg68k.create;
cg64 :=tcg64f68k.create;
end.
Reference in New Issue View Git Blame Copy Permalink