paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 06:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

Various m68k fixes/additions:

Browse Source 
- 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 -
This commit is contained in:
Károly Balogh 2005-12-13 20:42:15 +00:00
parent 4039412757
commit 238964e443
12 changed files with 88 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/m68k/aasmcpu.pas
View File

@ -430,6 +430,7 @@ type
function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
begin
// writeln('is_same_reg_move');
result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and
(regtype = R_INTREGISTER) and
(ops=2) and

9
compiler/m68k/agcpugas.pas
View File

@ -178,8 +178,10 @@ interface
i : tsuperregister;
begin
case o.typ of
top_reg:
top_reg: begin
getopstr:=gas_regname(o.reg);
// writeln('top_reg:',getopstr,'!');
end;
top_ref:
if o.ref^.refaddr=addr_full then
begin
@ -320,9 +322,10 @@ interface
(op = A_MULU) or
(op = A_MULS) or
(op = A_DIVS) or
(op = A_DIVU)) and (i=1) then
(op = A_DIVU)) and (i=2) then
begin
sep:=':'
else
end else
sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i]^)
end;

77
compiler/m68k/cgcpu.pas
View File

@ -403,7 +403,7 @@ unit cgcpu;
opcode := topcg2tasmop[op];
case op of
OP_ADD :
Begin
begin
if (a >= 1) and (a <= 8) then
list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
else
@ -414,20 +414,20 @@ unit cgcpu;
end;
OP_AND,
OP_OR:
Begin
begin
list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
end;
OP_DIV :
Begin
begin
internalerror(20020816);
end;
OP_IDIV :
Begin
begin
internalerror(20020816);
end;
OP_IMUL :
Begin
if aktoptprocessor = MC68000 then
begin
if aktoptprocessor = MC68000 then
begin
r:=NR_D0;
r2:=NR_D1;
@ -445,18 +445,17 @@ unit cgcpu;
begin
if (isaddressregister(reg)) then
begin
scratch_reg := cg.getintregister(list,OS_INT);
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));
cg.ungetcpuregister(list,scratch_reg);
end
else
list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
end;
end;
OP_MUL :
Begin
begin
if aktoptprocessor = MC68000 then
begin
r:=NR_D0;
@ -474,11 +473,10 @@ unit cgcpu;
begin
if (isaddressregister(reg)) then
begin
scratch_reg := cg.getintregister(list,OS_INT);
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));
cg.ungetcpuregister(list,scratch_reg);
end
else
list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
@ -487,17 +485,16 @@ unit cgcpu;
OP_SAR,
OP_SHL,
OP_SHR :
Begin
begin
if (a >= 1) and (a <= 8) then
begin
{ now allowed to shift an address register }
if (isaddressregister(reg)) then
begin
scratch_reg := cg.getintregister(list,OS_INT);
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));
cg.ungetcpuregister(list,scratch_reg);
end
else
list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
@ -514,15 +511,13 @@ unit cgcpu;
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.ungetcpuregister(list,scratch_reg2);
end
else
list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
cg.ungetcpuregister(list,scratch_reg);
end;
end;
OP_SUB :
Begin
begin
if (a >= 1) and (a <= 8) then
list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
else
@ -547,7 +542,7 @@ unit cgcpu;
begin
case op of
OP_ADD :
Begin
begin
if aktoptprocessor = ColdFire then
begin
{ operation only allowed only a longword }
@ -563,11 +558,11 @@ unit cgcpu;
OP_AND,OP_OR,
OP_SAR,OP_SHL,
OP_SHR,OP_SUB,OP_XOR :
Begin
begin
{ load to data registers }
if (isaddressregister(reg1)) then
begin
hreg1 := cg.getintregister(list,OS_INT);
hreg1 := getintregister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
end
else
@ -575,7 +570,7 @@ unit cgcpu;
if (isaddressregister(reg2)) then
begin
hreg2:= cg.getintregister(list,OS_INT);
hreg2:= getintregister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
end
else
@ -600,25 +595,22 @@ unit cgcpu;
list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
end;
if reg1 <> hreg1 then
cg.ungetcpuregister(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.ungetcpuregister(list,hreg2);
end;
end;
OP_DIV :
Begin
begin
internalerror(20020816);
end;
OP_IDIV :
Begin
begin
internalerror(20020816);
end;
OP_IMUL :
Begin
begin
sign_extend(list, size,reg1);
sign_extend(list, size,reg2);
if aktoptprocessor = MC68000 then
@ -636,12 +628,14 @@ unit cgcpu;
end
else
begin
// writeln('doing 68020');
if (isaddressregister(reg1)) then
hreg1 := cg.getintregister(list,OS_INT)
hreg1 := getintregister(list,OS_INT)
else
hreg1 := reg1;
if (isaddressregister(reg2)) then
hreg2:= cg.getintregister(list,OS_INT)
hreg2:= getintregister(list,OS_INT)
else
hreg2 := reg2;
@ -650,18 +644,16 @@ unit cgcpu;
list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
if reg1 <> hreg1 then
cg.ungetcpuregister(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.ungetcpuregister(list,hreg2);
end;
end;
end;
OP_MUL :
Begin
begin
sign_extend(list, size,reg1);
sign_extend(list, size,reg2);
if aktoptprocessor = MC68000 then
@ -695,16 +687,12 @@ unit cgcpu;
else
hreg2 := reg2;
list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
if reg1<>hreg1 then
cg.ungetcpuregister(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.ungetcpuregister(list,hreg2);
end;
end;
end;
@ -720,7 +708,7 @@ unit cgcpu;
if (isaddressregister(reg2)) then
begin
hreg2 := cg.getintregister(list,OS_INT);
hreg2 := getintregister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
end
else
@ -740,7 +728,6 @@ unit cgcpu;
if reg2 <> hreg2 then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
cg.ungetcpuregister(list,hreg2);
end;
end;
@ -768,13 +755,12 @@ unit cgcpu;
only longword comparison is supported,
and only on data registers.
}
hregister := cg.getintregister(list,OS_INT);
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));
cg.ungetcpuregister(list,hregister);
end
else
begin
@ -839,7 +825,6 @@ unit cgcpu;
list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
end;
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg));
cg.ungetcpuregister(list,hreg);
end
else
begin
@ -986,8 +971,6 @@ unit cgcpu;
end;
{ restore the registers that we have just used olny if they are used! }
ungetcpuregister(list, iregister);
ungetcpuregister(list, jregister);
if jregister = NR_A1 then
hp2.base := NR_NO;
if iregister = NR_A0 then
@ -998,9 +981,6 @@ unit cgcpu;
// if delsource then
// tg.ungetiftemp(list,source);
// Not needed? (KB)
// ungetcpuregister(list,hregister);
end;
procedure tcg68k.g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef);
@ -1052,6 +1032,7 @@ unit cgcpu;
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
@ -1208,6 +1189,7 @@ unit cgcpu;
hreg1, hreg2 : tregister;
opcode : tasmop;
begin
// writeln('a_op64_reg_reg');
opcode := topcg2tasmop[op];
case op of
OP_ADD :
@ -1270,6 +1252,7 @@ unit cgcpu;
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;

2
compiler/m68k/cpunode.pas
View File

@ -35,7 +35,7 @@ unit cpunode;
after the generic one (FK)
}
ncpuadd,
// nppccal,
n68kcal,
// nppccon,
// nppcflw,
// nppcmem,

2
compiler/m68k/cpupara.pas
View File

@ -43,11 +43,11 @@ unit cpupara;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
private
procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
end;

6
compiler/m68k/n68kcnv.pas
View File

@ -34,7 +34,7 @@ interface
function first_int_to_real: tnode; override;
procedure second_int_to_real;override;
procedure second_int_to_bool;override;
procedure pass_2;override;
// procedure pass_2;override;
end;
implementation
@ -212,7 +212,7 @@ implementation
location.register := hreg1;
end;
{
procedure tm68ktypeconvnode.pass_2;
{$ifdef TESTOBJEXT2}
var
@ -232,7 +232,7 @@ implementation
end;
second_call_helper(convtype);
end;
}
begin
ctypeconvnode:=tm68ktypeconvnode;

2
compiler/m68k/ncpuadd.pas
View File

@ -168,6 +168,7 @@ implementation
tmpreg : tregister;
op : tasmop;
begin
writeln('second_cmpordinal');
{ set result location }
location_reset(location,LOC_JUMP,OS_NO);
@ -320,6 +321,7 @@ implementation
procedure t68kaddnode.second_cmp64bit;
begin
writeln('second_cmp64bit');
(* load_left_right(true,false);
case nodetype of

10
compiler/m68k/ra68kmot.pas
View File

@ -168,12 +168,12 @@ const
str2opentry: tstr2opentry;
hs : string;
j : byte;
Begin
begin
is_asmopcode:=false;
{ first of all we remove the suffix }
j:=pos('.',s);
if j>0 then
hs:=copy(s,3,255)
hs:=copy(s,1,j-1)
else
hs:=s;
@ -209,7 +209,8 @@ const
function tm68kmotreader.is_register(const s:string):boolean;
begin
is_register:=false;
actasmregister:=gas_regnum_search(lower(s));
// FIX ME!!! Ugly, needs a proper fix (KB)
actasmregister:=gas_regnum_search('%'+lower(s));
if actasmregister<>NR_NO then
begin
is_register:=true;
@ -1414,12 +1415,14 @@ const
end;
{ // Register, a variable reference or a constant reference // }
AS_REGISTER: begin
// writeln('register! ',actasmpattern);
{ save the type of register used. }
tempstr := actasmpattern;
Consume(AS_REGISTER);
{ // Simple register // }
if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then
begin
// writeln('simple reg');
if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
Message(asmr_e_invalid_operand_type);
oper.opr.typ := OPR_REGISTER;
@ -1643,6 +1646,7 @@ const
BuildOperand(Instr.Operands[operandnum] as tm68koperand);
end; { end case }
end; { end while }
instr.Ops:=operandnum;
end;

4
compiler/ncal.pas
View File

@ -1458,14 +1458,14 @@ type
begin
hiddentree:=gen_vmt_tree;
end
{$ifdef powerpc}
{$if defined(powerpc) or defined(m68k)}
else
if vo_is_syscall_lib in currpara.varoptions then
begin
{ lib parameter has no special type but proccalloptions must be a syscall }
hiddentree:=cloadnode.create(tprocdef(procdefinition).libsym,tprocdef(procdefinition).libsym.owner);
end
{$endif powerpc}
{$endif powerpc or m68k}
else
if vo_is_parentfp in currpara.varoptions then
begin

33
compiler/pdecsub.pas
View File

@ -1230,16 +1230,45 @@ end;
procedure pd_syscall(pd:tabstractprocdef);
{$ifdef powerpc}
{$if defined(powerpc) or defined(m68k)}
var
vs : tparavarsym;
sym : tsym;
symtable : tsymtable;
{$endif powerpc}
{$endif defined(powerpc) or defined(m68k)}
begin
if pd.deftype<>procdef then
internalerror(2003042614);
tprocdef(pd).forwarddef:=false;
{$ifdef m68k}
if target_info.system in [system_m68k_amiga] then
begin
include(pd.procoptions,po_syscall_legacy);
if consume_sym(sym,symtable) then
begin
if (sym.typ=globalvarsym) and
(
(tabstractvarsym(sym).vartype.def.deftype=pointerdef) or
is_32bitint(tabstractvarsym(sym).vartype.def)
) then
begin
tprocdef(pd).libsym:=sym;
if po_syscall_legacy in tprocdef(pd).procoptions then
begin
vs:=tparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
paramanager.parseparaloc(vs,'A6');
pd.parast.insert(vs);
end
end
else
Message(parser_e_32bitint_or_pointer_variable_expected);
end;
{ FIX ME!!! 68k amigaos syscalls needs explicit funcretloc support to be complete (KB) }
(paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside);
(paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside);
end;
{$endif m68k}
{$ifdef powerpc}
if target_info.system in [system_powerpc_morphos] then
begin

2
compiler/scandir.pas
View File

@ -912,6 +912,8 @@ implementation
var
sctype : string;
begin
{ not needed on amiga/m68k for now, because there's only one }
{ syscall convention (legacy) (KB) }
if not (target_info.system in [system_powerpc_morphos]) then
comment (V_Warning,'Syscall directive is useless on this target.');
current_scanner.skipspace;

4
compiler/symdef.pas
View File

@ -480,11 +480,11 @@ interface
refcount : longint;
_class : tobjectdef;
_classderef : tderef;
{$ifdef powerpc}
{$if defined(powerpc) or defined(m68k)}
{ library symbol for AmigaOS/MorphOS }
libsym : tsym;
libsymderef : tderef;
{$endif powerpc}
{$endif powerpc or m68k}
{ name of the result variable to insert in the localsymtable }
resultname : stringid;
{ true, if the procedure is only declared