From 238964e4434120a48f7be8a742f1e8f3914bc3d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Tue, 13 Dec 2005 20:42:15 +0000 Subject: [PATCH] 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 - --- compiler/m68k/aasmcpu.pas | 1 + compiler/m68k/agcpugas.pas | 9 +++-- compiler/m68k/cgcpu.pas | 77 +++++++++++++++----------------------- compiler/m68k/cpunode.pas | 2 +- compiler/m68k/cpupara.pas | 2 +- compiler/m68k/n68kcnv.pas | 6 +-- compiler/m68k/ncpuadd.pas | 2 + compiler/m68k/ra68kmot.pas | 10 +++-- compiler/ncal.pas | 4 +- compiler/pdecsub.pas | 33 +++++++++++++++- compiler/scandir.pas | 2 + compiler/symdef.pas | 4 +- 12 files changed, 88 insertions(+), 64 deletions(-) diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas index 924b089d83..a159cca622 100644 --- a/compiler/m68k/aasmcpu.pas +++ b/compiler/m68k/aasmcpu.pas @@ -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 diff --git a/compiler/m68k/agcpugas.pas b/compiler/m68k/agcpugas.pas index f6ab696ca3..cda7126ddc 100644 --- a/compiler/m68k/agcpugas.pas +++ b/compiler/m68k/agcpugas.pas @@ -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; diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 8142c3cb9e..cd84971386 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -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; diff --git a/compiler/m68k/cpunode.pas b/compiler/m68k/cpunode.pas index 17f4460650..d13b38650b 100644 --- a/compiler/m68k/cpunode.pas +++ b/compiler/m68k/cpunode.pas @@ -35,7 +35,7 @@ unit cpunode; after the generic one (FK) } ncpuadd, -// nppccal, + n68kcal, // nppccon, // nppcflw, // nppcmem, diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index 579009fdde..93750212aa 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -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; diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas index 3fa1bc9f53..c4ea49ca6d 100644 --- a/compiler/m68k/n68kcnv.pas +++ b/compiler/m68k/n68kcnv.pas @@ -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; diff --git a/compiler/m68k/ncpuadd.pas b/compiler/m68k/ncpuadd.pas index 695f623128..a84014a313 100644 --- a/compiler/m68k/ncpuadd.pas +++ b/compiler/m68k/ncpuadd.pas @@ -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 diff --git a/compiler/m68k/ra68kmot.pas b/compiler/m68k/ra68kmot.pas index 11f8442c46..90c5110a4c 100644 --- a/compiler/m68k/ra68kmot.pas +++ b/compiler/m68k/ra68kmot.pas @@ -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; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 7299eaf66c..b600e159a8 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -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 diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 78a470660d..75e1dc2fc9 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -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 diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 9f2372382c..5911123125 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 033aa284e2..92b2520b1c 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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