diff --git a/compiler/cg64f32.pas b/compiler/cg64f32.pas index b6f91e572d..030f9d2fd9 100644 --- a/compiler/cg64f32.pas +++ b/compiler/cg64f32.pas @@ -72,6 +72,13 @@ unit cg64f32; procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override; procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override; + {# This routine tries to optimize the a_op64_const_reg operation, by + removing superfluous opcodes. Returns TRUE if normal processing + must continue in op64_const_reg, otherwise, everything is processed + entirely in this routine, by emitting the appropriate 32-bit opcodes. + } + function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override; + procedure g_rangecheck64(list: taasmoutput; const p: tnode; const todef: tdef); override; end; @@ -620,6 +627,98 @@ unit cg64f32; end; end; + function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean; + var + lowvalue, highvalue : cardinal; + hreg: tregister; + begin + lowvalue := cardinal(a); + highvalue:= a shr 32; + { assume it will be optimized out } + optimize64_op_const_reg := true; + case op of + OP_ADD: + begin + if a = 0 then + exit; + end; + OP_AND: + begin + if lowvalue <> high(cardinal) then + cg.a_op_const_reg(list,op,lowvalue,reg.reglo); + if highvalue <> high(cardinal) then + cg.a_op_const_reg(list,op,highvalue,reg.reghi); + { already emitted correctly } + exit; + end; + OP_OR: + begin + if lowvalue <> 0 then + cg.a_op_const_reg(list,op,lowvalue,reg.reglo); + if highvalue <> 0 then + cg.a_op_const_reg(list,op,highvalue,reg.reghi); + { already emitted correctly } + exit; + end; + OP_SUB: + begin + if a = 0 then + exit; + end; + OP_XOR: + begin + end; + OP_SHL: + begin + if a = 0 then + exit; + { simply clear low-register + and shift the rest and swap + registers. + } + if (a > 31) then + begin + cg.a_load_const_reg(list,OS_32,0,reg.reglo); + cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reghi); + { swap the registers } + hreg := reg.reghi; + reg.reghi := reg.reglo; + reg.reglo := hreg; + exit; + end; + end; + OP_SHR: + begin + if a = 0 then exit; + { simply clear high-register + and shift the rest and swap + registers. + } + if (a > 31) then + begin + cg.a_load_const_reg(list,OS_32,0,reg.reghi); + cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reglo); + { swap the registers } + hreg := reg.reghi; + reg.reghi := reg.reglo; + reg.reglo := hreg; + exit; + end; + end; + OP_IMUL,OP_MUL: + begin + if a = 1 then exit; + end; + OP_IDIV,OP_DIV: + begin + if a = 1 then exit; + end; + else + internalerror(20020817); + end; + optimize64_op_const_reg := false; + end; + (* procedure int64f32_assignment_int64_reg(p : passignmentnode); @@ -633,7 +732,11 @@ begin end. { $Log$ - Revision 1.26 2002-08-17 22:09:43 florian + Revision 1.27 2002-08-19 18:17:47 carl + + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) + * more fixes to m68k for 64-bit operations + + Revision 1.26 2002/08/17 22:09:43 florian * result type handling in tcgcal.pass_2 overhauled * better tnode.dowrite * some ppc stuff fixed diff --git a/compiler/cg64f64.pas b/compiler/cg64f64.pas index 3d2372d243..9dbec149cb 100644 --- a/compiler/cg64f64.pas +++ b/compiler/cg64f64.pas @@ -173,6 +173,12 @@ unit cg64f64; const todef: tdef); begin end; + + function tcg64f64.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean; + begin + { this should be the same routine as optimize_const_reg!!!!!!!! } + end; + procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister64); @@ -190,7 +196,11 @@ unit cg64f64; end. { $Log$ - Revision 1.3 2002-08-17 22:09:43 florian + Revision 1.4 2002-08-19 18:17:48 carl + + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) + * more fixes to m68k for 64-bit operations + + Revision 1.3 2002/08/17 22:09:43 florian * result type handling in tcgcal.pass_2 overhauled * better tnode.dowrite * some ppc stuff fixed diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index ca3622248c..dfd9cbde23 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -248,13 +248,15 @@ unit cgobj; This routine tries to optimize the const_reg opcode, and should be called at the start of a_op_const_reg. It returns the actual opcode to emit, and the constant value to emit. If this routine returns - FALSE, no instruction should be emitted (.eg : imul reg by 1 ) + TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 ) @param(op The opcode to emit, returns the opcode which must be emitted) @param(a The constant which should be emitted, returns the constant which must - be amitted) - } - function optimize_const_reg(var op: topcg; var a : aword): boolean;virtual; + be emitted) + @param(reg The register to emit the opcode with, returns the register with + which the opcode will be emitted) + } + function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg: tregister): boolean;virtual; {# This routine is used in exception management nodes. It should @@ -447,6 +449,19 @@ unit cgobj; procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract; procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract; + { + This routine tries to optimize the const_reg opcode, and should be + called at the start of a_op64_const_reg. It returns the actual opcode + to emit, and the constant value to emit. If this routine returns + TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 ) + + @param(op The opcode to emit, returns the opcode which must be emitted) + @param(a The constant which should be emitted, returns the constant which must + be emitted) + @param(reg The register to emit the opcode with, returns the register with + which the opcode will be emitted) + } + function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;virtual;abstract; { override to catch 64bit rangechecks } @@ -756,21 +771,21 @@ unit cgobj; end; - function tcg.optimize_const_reg(var op: topcg; var a : aword): boolean; + function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg:tregister): boolean; var powerval : longint; begin - optimize_const_reg := true; + optimize_op_const_reg := false; case op of { or with zero returns same result } - OP_OR : if a = 0 then optimize_const_reg := false; + OP_OR : if a = 0 then optimize_op_const_reg := true; { and with max returns same result } - OP_AND : if (a = high(a)) then optimize_const_reg := false; + OP_AND : if (a = high(a)) then optimize_op_const_reg := true; { division by 1 returns result } OP_DIV : begin if a = 1 then - optimize_const_reg := false + optimize_op_const_reg := true else if ispowerof2(int64(a), powerval) then begin a := powerval; @@ -781,7 +796,7 @@ unit cgobj; OP_IDIV: begin if a = 1 then - optimize_const_reg := false + optimize_op_const_reg := true else if ispowerof2(int64(a), powerval) then begin a := powerval; @@ -792,7 +807,7 @@ unit cgobj; OP_MUL,OP_IMUL: begin if a = 1 then - optimize_const_reg := false + optimize_op_const_reg := true else if ispowerof2(int64(a), powerval) then begin a := powerval; @@ -802,8 +817,8 @@ unit cgobj; end; OP_SAR,OP_SHL,OP_SHR: begin - if a = 1 then - optimize_const_reg := false; + if a = 0 then + optimize_op_const_reg := true; exit; end; end; @@ -1553,7 +1568,11 @@ finalization end. { $Log$ - Revision 1.52 2002-08-17 22:09:43 florian + Revision 1.53 2002-08-19 18:17:48 carl + + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) + * more fixes to m68k for 64-bit operations + + Revision 1.52 2002/08/17 22:09:43 florian * result type handling in tcgcal.pass_2 overhauled * better tnode.dowrite * some ppc stuff fixed diff --git a/compiler/fpcdefs.inc b/compiler/fpcdefs.inc index 28a166a1a1..c8fdd197f1 100644 --- a/compiler/fpcdefs.inc +++ b/compiler/fpcdefs.inc @@ -38,7 +38,11 @@ { $Log$ - Revision 1.5 2002-08-15 15:11:53 carl + Revision 1.6 2002-08-19 18:17:48 carl + + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) + * more fixes to m68k for 64-bit operations + + Revision 1.5 2002/08/15 15:11:53 carl * oldset define is now correct for all cpu's except i386 * correct compilation problems because of the above @@ -50,3 +54,6 @@ + log added } + +{ +} \ No newline at end of file diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 086b3a4fd6..b211d3d289 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -30,7 +30,7 @@ unit cgcpu; cginfo,cgbase,cgobj, aasmbase,aasmtai,aasmcpu, cpubase,cpuinfo,cpupara, - node,symconst; + node,symconst,cg64f32; type tcg68k = class(tcg) @@ -61,13 +61,7 @@ unit cgcpu; { 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; procedure g_return_from_proc(list : taasmoutput;parasize : aword);override; procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override; @@ -85,6 +79,10 @@ unit cgcpu; end; + tcg64f68k = class(tcg64f32) + procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override; + end; { This function returns true if the reference+offset is valid. Otherwise extra code must be generated to solve the reference. @@ -110,7 +108,7 @@ Implementation uses globtype,globals,verbose,systems,cutils, symdef,symsym,defbase,paramgr, - rgobj,tgobj,rgcpu,cg64f32; + rgobj,tgobj,rgcpu; const @@ -168,7 +166,9 @@ Implementation end; end; - +{****************************************************************************} +{ TCG68K } +{****************************************************************************} function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean; var @@ -285,7 +285,11 @@ Implementation procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); begin - list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2)); + { 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; @@ -299,7 +303,11 @@ Implementation if opsize = S_FX then internalerror(20020729); fixref(list,href); - list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg)); + { 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); @@ -310,7 +318,11 @@ Implementation { 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)); + { 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; reg1, reg2: tregister); @@ -341,7 +353,7 @@ Implementation opcode : tasmop; begin { need to emit opcode? } - if not optimize_const_reg(op, a) then + if optimize_op_const_reg(list, op, a, reg) then exit; opcode := topcg2tasmop[op]; case op of @@ -1100,15 +1112,133 @@ Implementation list.concat(ai); end; - +{****************************************************************************} +{ TCG64F68K } +{****************************************************************************} + procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64); + var + hreg1, hreg2 : tregister; + opcode : tasmop; + begin + 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 rg.isaddressregister(regdst.reglo) or + rg.isaddressregister(regdst.reghi) or + rg.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 (rg.isaddressregister(regdst.reglo) and + rg.isaddressregister(regsrc.reglo)) or + (rg.isaddressregister(regsrc.reghi) and + rg.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 rg.isaddressregister(regdst.reglo) or + rg.isaddressregister(regdst.reghi) or + rg.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 rg.isaddressregister(regdst.reglo) or + rg.isaddressregister(regsrc.reglo) or + rg.isaddressregister(regsrc.reghi) or + rg.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;value : qword;reg : tregister64); + var + lowvalue : cardinal; + highvalue : cardinal; + begin + { is it optimized out ? } + if 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 rg.isaddressregister(reg.reglo) or + rg.isaddressregister(reg.reghi) then + internalerror(20020817); + case op of + OP_ADD : + begin + list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,reg.reglo)); + list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,reg.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,reg.reglo)); + list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,reg.reglo)); + end; + OP_XOR: + begin + list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,reg.reglo)); + list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,reg.reglo)); + end; + end; { end case } + end; + begin cg := tcg68k.create; - cg64 :=tcg64f32.create; + cg64 :=tcg64f68k.create; end. { $Log$ - Revision 1.4 2002-08-16 14:24:59 carl + Revision 1.5 2002-08-19 18:17:48 carl + + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes) + * more fixes to m68k for 64-bit operations + + Revision 1.4 2002/08/16 14:24:59 carl * issameref() to test if two references are the same (then emit no opcodes) + ret_in_reg to replace ret_in_acc (fix some register allocation bugs at the same time)