paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 12:09:30 +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; function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
begin begin
// writeln('is_same_reg_move');
result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and
(regtype = R_INTREGISTER) and (regtype = R_INTREGISTER) and
(ops=2) and (ops=2) and

9
compiler/m68k/agcpugas.pas
View File

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

77
compiler/m68k/cgcpu.pas
View File

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

2
compiler/m68k/cpunode.pas
View File

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

2
compiler/m68k/cpupara.pas
View File

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

6
compiler/m68k/n68kcnv.pas
View File

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

2
compiler/m68k/ncpuadd.pas
View File

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

10
compiler/m68k/ra68kmot.pas
View File

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

4
compiler/ncal.pas
View File

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

33
compiler/pdecsub.pas
View File

@ -1230,16 +1230,45 @@ end;
procedure pd_syscall(pd:tabstractprocdef); procedure pd_syscall(pd:tabstractprocdef);
{$ifdef powerpc} {$if defined(powerpc) or defined(m68k)}
var var
vs : tparavarsym; vs : tparavarsym;
sym : tsym; sym : tsym;
symtable : tsymtable; symtable : tsymtable;
{$endif powerpc} {$endif defined(powerpc) or defined(m68k)}
begin begin
if pd.deftype<>procdef then if pd.deftype<>procdef then
internalerror(2003042614); internalerror(2003042614);
tprocdef(pd).forwarddef:=false; 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} {$ifdef powerpc}
if target_info.system in [system_powerpc_morphos] then if target_info.system in [system_powerpc_morphos] then
begin begin

2
compiler/scandir.pas
View File

@ -912,6 +912,8 @@ implementation
var var
sctype : string; sctype : string;
begin 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 if not (target_info.system in [system_powerpc_morphos]) then
comment (V_Warning,'Syscall directive is useless on this target.'); comment (V_Warning,'Syscall directive is useless on this target.');
current_scanner.skipspace; current_scanner.skipspace;

4
compiler/symdef.pas
View File

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