diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index ee6258a15a..14ae2aedad 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -78,20 +78,27 @@ unit cgcpu; procedure g_restore_standard_registers(list : taasmoutput);override; procedure g_save_all_registers(list : taasmoutput);override; procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);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; -Implementation - uses - globtype,globals,verbose,systems,cutils, - symdef,symsym,defbase,paramgr, - rgobj,tgobj,rgcpu; + { 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 = @@ -100,6 +107,17 @@ const S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO); + + +Implementation + + uses + globtype,globals,verbose,systems,cutils, + symdef,symsym,defbase,paramgr, + rgobj,tgobj,rgcpu; + + + const { opcode table lookup } topcg2tasmop: Array[topcg] of tasmop = ( @@ -137,6 +155,58 @@ const ); + function isvalidrefoffset(const ref: treference): boolean; + begin + isvalidrefoffset := true; + if ref.index <> R_NO then + begin + if ref.base <> R_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; + + + function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean; + + var + tmpreg: tregister; + begin + result := false; + if (ref.base <> R_NO) then + begin + if (ref.index <> R_NO) and assigned(ref.symbol) then + internalerror(20020814); + { base + reg } + if ref.index <> R_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); @@ -147,9 +217,12 @@ const procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference); - + var + href : treference; begin - list.concat(taicpu.op_ref(A_JSR,S_NO,ref)); + href := ref; + fixref(list,href); + list.concat(taicpu.op_ref(A_JSR,S_NO,href)); end; @@ -164,7 +237,7 @@ const list.concat(taicpu.op_reg(A_CLR,S_L,register)) else begin - if (longint(a) >= -128) and (longint(a) <= 127) then + if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register)) else list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) @@ -172,9 +245,13 @@ const end; procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : 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[size],register,ref)); + list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,href)); end; procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); @@ -186,8 +263,12 @@ const end; procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister); + var + href : treference; begin - list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],ref,register)); + href := ref; + fixref(list,href); + list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register)); { extend the value in the register } sign_extend(list, size, register); end; @@ -198,12 +279,16 @@ const end; procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); + var + href : treference; begin if (not rg.isaddressregister(r)) then begin internalerror(2002072901); end; - list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r)); + 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; reg1, reg2: tregister); @@ -215,12 +300,14 @@ const 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); - list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,ref,reg)); + fixref(list,href); + 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); @@ -261,6 +348,9 @@ const scratch_reg2: tregister; opcode : tasmop; begin + { need to emit opcode? } + if not optimize_const_reg(op, a) then + exit; opcode := topcg2tasmop[op]; case op of OP_ADD : @@ -288,7 +378,7 @@ const end; OP_IMUL : Begin - if aktoptprocessor = MC68000 then + if aktoptprocessor = MC68000 then begin rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D1); @@ -751,8 +841,8 @@ const { move a dword x times } for i:=1 to helpsize do begin - list.concat(taicpu.op_ref_reg(A_MOVE,S_L,srcref,hregister)); - list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,dstref)); + a_load_ref_reg(list,OS_INT,srcref,hregister); + a_load_reg_ref(list,OS_INT,hregister,dstref); inc(srcref.offset,4); inc(dstref.offset,4); dec(len,4); @@ -760,8 +850,8 @@ const { move a word } if len>1 then begin - list.concat(taicpu.op_ref_reg(A_MOVE,S_W,srcref,hregister)); - list.concat(taicpu.op_reg_ref(A_MOVE,S_W,hregister,dstref)); + a_load_ref_reg(list,OS_16,srcref,hregister); + a_load_reg_ref(list,OS_16,hregister,dstref); inc(srcref.offset,2); inc(dstref.offset,2); dec(len,2); @@ -769,8 +859,8 @@ const { move a single byte } if len>0 then begin - list.concat(taicpu.op_ref_reg(A_MOVE,S_B,srcref,hregister)); - list.concat(taicpu.op_reg_ref(A_MOVE,S_B,hregister,dstref)); + a_load_ref_reg(list,OS_8,srcref,hregister); + a_load_reg_ref(list,OS_8,hregister,dstref); end end @@ -789,11 +879,11 @@ const { jregister = destination } if loadref then - list.concat(taicpu.op_ref_reg(A_MOVE,S_L,source,iregister)) + a_load_ref_reg(list,OS_INT,source,iregister) else - list.concat(taicpu.op_ref_reg(A_LEA,S_L,source,iregister)); + a_loadaddr_ref_reg(list,source,iregister); - list.concat(taicpu.op_ref_reg(A_LEA,S_L,dest,jregister)); + a_loadaddr_ref_reg(list,dest,jregister); { double word move only on 68020+ machines } { because of possible alignment problems } @@ -865,7 +955,7 @@ const { 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 < -32767) or (localsize > 32768) then + if (localsize < low(smallint)) or (localsize > high(smallint)) then CGMessage(cg_e_stacklimit_in_local_routine); list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize)); end { endif localsize <> 0 } @@ -1012,7 +1102,12 @@ end. { $Log$ - Revision 1.1 2002-08-13 18:30:22 carl + Revision 1.2 2002-08-14 19:16:34 carl + + m68k type conversion nodes + + started some mathematical nodes + * out of bound references should now be handled correctly + + Revision 1.1 2002/08/13 18:30:22 carl * rename swatoperands to swapoperands + m68k first compilable version (still needs a lot of testing): assembler generator, system information , inline diff --git a/compiler/m68k/cpunode.pas b/compiler/m68k/cpunode.pas index 731ea4c748..55b957e23c 100644 --- a/compiler/m68k/cpunode.pas +++ b/compiler/m68k/cpunode.pas @@ -30,7 +30,7 @@ unit cpunode; uses { generic nodes } - ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat { to be able to only parts of the generic code, the processor specific nodes must be included after the generic one (FK) @@ -46,13 +46,18 @@ unit cpunode; { this not really a node } // nppcobj, // nppcmat, -// nppccnv + ,n68kcnv ; end. { $Log$ - Revision 1.1 2002-08-13 18:01:52 carl + Revision 1.2 2002-08-14 19:16:34 carl + + m68k type conversion nodes + + started some mathematical nodes + * out of bound references should now be handled correctly + + Revision 1.1 2002/08/13 18:01:52 carl * rename swatoperands to swapoperands + m68k first compilable version (still needs a lot of testing): assembler generator, system information , inline diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas new file mode 100644 index 0000000000..7475e66f55 --- /dev/null +++ b/compiler/m68k/n68kcnv.pas @@ -0,0 +1,301 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate m68k assembler for type converting nodes + + 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. + + **************************************************************************** +} +unit n68kcnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,defbase; + + type + tm68ktypeconvnode = class(tcgtypeconvnode) + protected + function first_int_to_real: tnode; override; + procedure second_int_to_real;override; + procedure second_int_to_bool;override; + procedure pass_2;override; + procedure second_call_helper(c : tconverttype); override; + end; + +implementation + + uses + verbose,globals,systems, + symconst,symdef,aasmbase,aasmtai, + cgbase,pass_1,pass_2, + ncon,ncal, + ncgutil, + cpubase,aasmcpu, + rgobj,tgobj,cgobj,cginfo,globtype,cgcpu; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tm68ktypeconvnode.first_int_to_real: tnode; + var + fname: string[19]; + begin + { In case we are in emulation mode, we must + always call the helpers + } + if (cs_fp_emulation in aktmoduleswitches) then + begin + result := inherited first_int_to_real; + exit; + end + else + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resulttype.def) then + begin + if is_signed(left.resulttype.def) then + fname := 'fpc_int64_to_double' + else + fname := 'fpc_qword_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resulttype.def) then + inserttypeconv(left,s32bittype) + else + { the fpu always considers 32-bit values as signed + therefore we need to call the helper in case of + a cardinal value. + } + begin + fname := 'fpc_cardinal_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end; + firstpass(left); + end; + result := nil; + if registersfpu<1 then + registersfpu:=1; + location.loc:=LOC_FPUREGISTER; + end; + + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + + + + procedure tm68ktypeconvnode.second_int_to_real; + + var + tempconst: trealconstnode; + ref: treference; + valuereg, tempreg, leftreg, tmpfpureg: tregister; + signed : boolean; + scratch_used : boolean; + opsize : tcgsize; + begin + scratch_used := false; + location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); + signed := is_signed(left.resulttype.def); + opsize := def_cgsize(left.resulttype.def); + { has to be handled by a helper } + if is_64bitint(left.resulttype.def) then + internalerror(200110011); + { has to be handled by a helper } + if not signed then + internalerror(20020814); + + location.register := rg.getregisterfpu(exprasmlist); + case left.location.loc of + LOC_REGISTER, LOC_CREGISTER: + begin + leftreg := left.location.register; + exprasmlist.concat(taicpu.op_reg_reg(A_FMOVE,TCGSize2OpSize[opsize],leftreg, + location.register)); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + exprasmlist.concat(taicpu.op_ref_reg(A_FMOVE,TCGSize2OpSize[opsize], + left.location.reference,location.register)); + end + else + internalerror(200110012); + end; + end; + + + procedure tm68ktypeconvnode.second_int_to_bool; + var + hreg1, + hreg2 : tregister; + resflags : tresflags; + opsize : tcgsize; + begin + { byte(boolean) or word(wordbool) or longint(longbool) must } + { be accepted for var parameters } + if (nf_explizit in flags) and + (left.resulttype.def.size=resulttype.def.size) and + (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + begin + location_copy(location,left.location); + exit; + end; + location_reset(location,LOC_REGISTER,def_cgsize(left.resulttype.def)); + opsize := def_cgsize(left.resulttype.def); + case left.location.loc of + LOC_CREFERENCE,LOC_REFERENCE : + begin + { can we optimize it, or do we need to fix the ref. ? } + if isvalidrefoffset(left.location.reference) then + begin + exprasmlist.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize], + left.location.reference)); + end + else + begin + hreg2:=rg.getregisterint(exprasmlist); + cg.a_load_ref_reg(exprasmlist,opsize, + left.location.reference,hreg2); + exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); + rg.ungetregister(exprasmlist,hreg2); + end; + reference_release(exprasmlist,left.location.reference); + resflags:=F_NE; + hreg1 := rg.getregisterint(exprasmlist); + end; + LOC_REGISTER,LOC_CREGISTER : + begin + hreg2 := left.location.register; + exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); + rg.ungetregister(exprasmlist,hreg2); + hreg1 := rg.getregisterint(exprasmlist); + resflags:=F_NE; + end; + LOC_FLAGS : + begin + hreg1:=rg.getregisterint(exprasmlist); + resflags:=left.location.resflags; + end; + else + internalerror(10062); + end; + cg.g_flags2reg(exprasmlist,location.size,resflags,hreg1); + location.register := hreg1; + end; + + + procedure tm68ktypeconvnode.second_call_helper(c : tconverttype); + + const + secondconvert : array[tconverttype] of pointer = ( + @second_nothing, {equal} + @second_nothing, {not_possible} + @second_nothing, {second_string_to_string, handled in resulttype pass } + @second_char_to_string, + @second_nothing, {char_to_charray} + @second_nothing, { pchar_to_string, handled in resulttype pass } + @second_nothing, {cchar_to_pchar} + @second_cstring_to_pchar, + @second_ansistring_to_pchar, + @second_string_to_chararray, + @second_nothing, { chararray_to_string, handled in resulttype pass } + @second_array_to_pointer, + @second_pointer_to_array, + @second_int_to_int, + @second_int_to_bool, + @second_bool_to_int, { bool_to_bool } + @second_bool_to_int, + @second_real_to_real, + @second_int_to_real, + @second_proc_to_procvar, + @second_nothing, { arrayconstructor_to_set } + @second_nothing, { second_load_smallset, handled in first pass } + @second_cord_to_pointer, + @second_nothing, { interface 2 string } + @second_nothing, { interface 2 guid } + @second_class_to_intf, + @second_char_to_char, + @second_nothing, { normal_2_smallset } + @second_nothing { dynarray_2_openarray } + ); + type + tprocedureofobject = procedure of object; + + var + r : packed record + proc : pointer; + obj : pointer; + end; + + begin + { this is a little bit dirty but it works } + { and should be quite portable too } + r.proc:=secondconvert[c]; + r.obj:=self; + tprocedureofobject(r){$ifdef FPC}();{$endif FPC} + end; + + + procedure tm68ktypeconvnode.pass_2; +{$ifdef TESTOBJEXT2} + var + r : preference; + nillabel : plabel; +{$endif TESTOBJEXT2} + begin + { this isn't good coding, I think tc_bool_2_int, shouldn't be } + { type conversion (FK) } + + if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then + begin + secondpass(left); + location_copy(location,left.location); + if codegenerror then + exit; + end; + second_call_helper(convtype); + end; + + +begin + ctypeconvnode:=tppctypeconvnode; +end. +{ + $Log$ + Revision 1.1 2002-08-14 19:16:34 carl + + m68k type conversion nodes + + started some mathematical nodes + * out of bound references should now be handled correctly + + +} diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas new file mode 100644 index 0000000000..7b0f4f37af --- /dev/null +++ b/compiler/m68k/n68kmat.pas @@ -0,0 +1,510 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 assembler for math nodes + + 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. + + **************************************************************************** +} +unit ncgmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat; + + type + tm68kmoddivnode = class(tmoddivnode) + procedure pass_2;override; + end; + + tm68kshlshrnode = class(tshlshrnode) + procedure pass_2;override; + end; + + tm68knotnode = class(tnotnode) + procedure pass_2;override; + end; + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase, + cginfo,cgbase,pass_1,pass_2, + ncon, + cpubase,cpuinfo, + tgobj,ncgutil,cgobj,rgobj,rgcpu; + +{***************************************************************************** + TI386MODDIVNODE +*****************************************************************************} + + procedure tm68kmoddivnode.pass_2; + var + hreg1 : tregister; + hreg2 : tregister; + hdenom : tregister; + shrdiv,popeax,popedx : boolean; + power : longint; + hl : tasmlabel; + pushedregs : tmaybesave; + begin + shrdiv := false; + secondpass(left); + if codegenerror then + exit; + maybe_save(exprasmlist,right.registers32,left.location,pushedregs); + secondpass(right); + maybe_restore(exprasmlist,left.location,pushedregs); + if codegenerror then + exit; + location_copy(location,left.location); + + if is_64bitint(resulttype.def) then + begin + { should be handled in pass_1 (JM) } + internalerror(200109052); + end + else + begin + { put numerator in register } + location_force_reg(exprasmlist,left.location,OS_INT,false); + hreg1:=left.location.register; + + if (nodetype=divn) and + (right.nodetype=ordconstn) and + ispowerof2(tordconstnode(right).value,power) then + Begin + shrdiv := true; + { for signed numbers, the numerator must be adjusted before the + shift instruction, but not wih unsigned numbers! Otherwise, + "Cardinal($ffffffff) div 16" overflows! (JM) } + If is_signed(left.resulttype.def) Then + Begin + objectlibrary.getlabel(hl); + cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg,hl); + if power=1 then + cg.a_op_const_reg(exprasmlist,OP_ADD,OS_32,1,hreg1) + else + cg.a_op_const_reg(exprasmlist,OP_ADD,OS_32, + tordconstnode(right).value-1,hreg1); + cg.a_label(exprasmlist,hl); + cg.a_op_const_reg(exprasmlist,OP_SAR,OS_INT,power,hreg1); + End + Else { not signed } + Begin + cg.a_op_const_reg(exprasmlist,OP_SHR,OS_INT,power,hreg1); + end; + End + else + begin + { bring denominator to D1 } + { D1 is always free, it's } + { only used for temporary } + { purposes } + hdenom := rg.getregisterint(exprasmlist); + if right.location.loc<>LOC_CREGISTER then + location_release(exprasmlist,right.location); + cg.a_load_loc_reg(exprasmlist,right.location,hdenom); + + { verify if the divisor is zero, if so return an error + immediately + } + objectlibrary.getlabel(hl1); + cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl1); + cg.a_param_reg(exprasmlist,OS_S32,paramanager.getintparaloc(1)); + cg.a_call_name('FPC_HANDLERROR'); + cg.a_label(exprasmlist,hl1); +{ This should be moved to emit_moddiv_reg_reg } + if is_signed(left.resulttype.def) then + cg.a_op_reg_reg(exprasmlist,OS_INT,OP_IDIV,hdenom,hreg1) + else + cg.a_op_reg_reg(exprasmlist,OS_INT,OP_DIV,hdenom,hreg1); + if nodetype = modn then + begin +{$warning modnode should be tested} + { multiply by denominator to get modulo } + cg.a_op_reg_reg(exprasmlist,OS_INT,OP_IMUL,hdenom,hreg1) + end; + end; + location_reset(location,LOC_REGISTER,OS_INT); + location.register:=hreg1; + end; + end; + + +{***************************************************************************** + TI386SHLRSHRNODE +*****************************************************************************} + + procedure tm68kshlshrnode.pass_2; + var + hregister2,hregister3, + hregisterhigh,hregisterlow : tregister; + popecx : boolean; + op : tasmop; + l1,l2,l3 : tasmlabel; + pushedregs : tmaybesave; + begin + popecx:=false; + + secondpass(left); + maybe_save(exprasmlist,right.registers32,left.location,pushedregs); + secondpass(right); + maybe_restore(exprasmlist,left.location,pushedregs); + + { determine operator } + case nodetype of + shln: op:=A_SHL; + shrn: op:=A_SHR; + end; +(* + if is_64bitint(left.resulttype.def) then + begin + location_reset(location,LOC_REGISTER,OS_64); + + { load left operator in a register } + location_force_reg(exprasmlist,left.location,OS_64,false); + hregisterhigh:=left.location.registerhigh; + hregisterlow:=left.location.registerlow; + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + { shrd/shl works only for values <=31 !! } + if tordconstnode(right).value>31 then + begin + if nodetype=shln then + begin + emit_reg_reg(A_XOR,S_L,hregisterhigh, + hregisterhigh); + if ((tordconstnode(right).value and 31) <> 0) then + emit_const_reg(A_SHL,S_L,tordconstnode(right).value and 31, + hregisterlow); + end + else + begin + emit_reg_reg(A_XOR,S_L,hregisterlow, + hregisterlow); + if ((tordconstnode(right).value and 31) <> 0) then + emit_const_reg(A_SHR,S_L,tordconstnode(right).value and 31, + hregisterhigh); + end; + location.registerhigh:=hregisterlow; + location.registerlow:=hregisterhigh; + end + else + begin + if nodetype=shln then + begin + emit_const_reg_reg(A_SHLD,S_L,tordconstnode(right).value and 31, + hregisterlow,hregisterhigh); + emit_const_reg(A_SHL,S_L,tordconstnode(right).value and 31, + hregisterlow); + end + else + begin + emit_const_reg_reg(A_SHRD,S_L,tordconstnode(right).value and 31, + hregisterhigh,hregisterlow); + emit_const_reg(A_SHR,S_L,tordconstnode(right).value and 31, + hregisterhigh); + end; + location.registerlow:=hregisterlow; + location.registerhigh:=hregisterhigh; + end; + end + else + begin + { load right operators in a register } + if right.location.loc<>LOC_REGISTER then + begin + if right.location.loc<>LOC_CREGISTER then + location_release(exprasmlist,right.location); + hregister2:=rg.getexplicitregisterint(exprasmlist,R_ECX); + cg.a_load_loc_reg(exprasmlist,right.location,hregister2); + end + else + hregister2:=right.location.register; + + { left operator is already in a register } + { hence are both in a register } + { is it in the case ECX ? } + if (hregisterlow=R_ECX) then + begin + { then only swap } + emit_reg_reg(A_XCHG,S_L,hregisterlow,hregister2); + hregister3:=hregisterlow; + hregisterlow:=hregister2; + hregister2:=hregister3; + end + else if (hregisterhigh=R_ECX) then + begin + { then only swap } + emit_reg_reg(A_XCHG,S_L,hregisterhigh,hregister2); + hregister3:=hregisterhigh; + hregisterhigh:=hregister2; + hregister2:=hregister3; + end + + { if second operator not in ECX ? } + else if (hregister2<>R_ECX) then + begin + { ECX occupied then push it } + if not (R_ECX in rg.unusedregsint) then + begin + popecx:=true; + emit_reg(A_PUSH,S_L,R_ECX); + end + else + rg.getexplicitregisterint(exprasmlist,R_ECX); + emit_reg_reg(A_MOV,S_L,hregister2,R_ECX); + end; + + if hregister2 <> R_ECX then + rg.ungetregisterint(exprasmlist,hregister2); + + { the damned shift instructions work only til a count of 32 } + { so we've to do some tricks here } + if nodetype=shln then + begin + objectlibrary.getlabel(l1); + objectlibrary.getlabel(l2); + objectlibrary.getlabel(l3); + emit_const_reg(A_CMP,S_L,64,R_ECX); + emitjmp(C_L,l1); + emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow); + emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh); + cg.a_jmp_always(exprasmlist,l3); + cg.a_label(exprasmlist,l1); + emit_const_reg(A_CMP,S_L,32,R_ECX); + emitjmp(C_L,l2); + emit_const_reg(A_SUB,S_L,32,R_ECX); + emit_reg_reg(A_SHL,S_L,R_CL, + hregisterlow); + emit_reg_reg(A_MOV,S_L,hregisterlow,hregisterhigh); + emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow); + cg.a_jmp_always(exprasmlist,l3); + cg.a_label(exprasmlist,l2); + emit_reg_reg_reg(A_SHLD,S_L,R_CL, + hregisterlow,hregisterhigh); + emit_reg_reg(A_SHL,S_L,R_CL, + hregisterlow); + cg.a_label(exprasmlist,l3); + end + else + begin + objectlibrary.getlabel(l1); + objectlibrary.getlabel(l2); + objectlibrary.getlabel(l3); + emit_const_reg(A_CMP,S_L,64,R_ECX); + emitjmp(C_L,l1); + emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow); + emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh); + cg.a_jmp_always(exprasmlist,l3); + cg.a_label(exprasmlist,l1); + emit_const_reg(A_CMP,S_L,32,R_ECX); + emitjmp(C_L,l2); + emit_const_reg(A_SUB,S_L,32,R_ECX); + emit_reg_reg(A_SHR,S_L,R_CL, + hregisterhigh); + emit_reg_reg(A_MOV,S_L,hregisterhigh,hregisterlow); + emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh); + cg.a_jmp_always(exprasmlist,l3); + cg.a_label(exprasmlist,l2); + emit_reg_reg_reg(A_SHRD,S_L,R_CL, + hregisterhigh,hregisterlow); + emit_reg_reg(A_SHR,S_L,R_CL, + hregisterhigh); + cg.a_label(exprasmlist,l3); + + end; + + { maybe put ECX back } + if popecx then + emit_reg(A_POP,S_L,R_ECX) + else + rg.ungetregisterint(exprasmlist,R_ECX); + + location.registerlow:=hregisterlow; + location.registerhigh:=hregisterhigh; + end; + end + else + begin + { load left operators in a register } + location_copy(location,left.location); + location_force_reg(exprasmlist,location,OS_INT,false); + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK) + if right.value<=31 then + } + emit_const_reg(op,S_L,tordconstnode(right).value and 31, + location.register); + { + else + emit_reg_reg(A_XOR,S_L,hregister1, + hregister1); + } + end + else + begin + { load right operators in a register } + if right.location.loc<>LOC_REGISTER then + begin + if right.location.loc<>LOC_CREGISTER then + location_release(exprasmlist,right.location); + hregister2:=rg.getexplicitregisterint(exprasmlist,R_ECX); + cg.a_load_loc_reg(exprasmlist,right.location,hregister2); + end + else + hregister2:=right.location.register; + + { left operator is already in a register } + { hence are both in a register } + { is it in the case ECX ? } + if (location.register=R_ECX) then + begin + { then only swap } + emit_reg_reg(A_XCHG,S_L,location.register,hregister2); + hregister3:=location.register; + location.register:=hregister2; + hregister2:=hregister3; + end + { if second operator not in ECX ? } + else if (hregister2<>R_ECX) then + begin + { ECX occupied then push it } + if not (R_ECX in rg.unusedregsint) then + begin + popecx:=true; + emit_reg(A_PUSH,S_L,R_ECX); + end + else + rg.getexplicitregisterint(exprasmlist,R_ECX); + emit_reg_reg(A_MOV,S_L,hregister2,R_ECX); + end; + rg.ungetregisterint(exprasmlist,hregister2); + { right operand is in ECX } + emit_reg_reg(op,S_L,R_CL,location.register); + { maybe ECX back } + if popecx then + emit_reg(A_POP,S_L,R_ECX) + else + rg.ungetregisterint(exprasmlist,R_ECX); + end; + end; +*) + end; + + + +{***************************************************************************** + TI386NOTNODE +*****************************************************************************} + + procedure tm68knotnode.pass_2; + const + flagsinvers : array[F_E..F_BE] of tresflags = + (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C, + F_BE,F_B,F_AE,F_A); + var + hl : tasmlabel; + opsize : topsize; + begin + if is_boolean(resulttype.def) then + begin + opsize:=def_opsize(resulttype.def); + { the second pass could change the location of left } + { if it is a register variable, so we've to do } + { this before the case statement } + if left.location.loc<>LOC_JUMP then + secondpass(left); + + case left.location.loc of + LOC_JUMP : + begin + location_reset(location,LOC_JUMP,OS_NO); + hl:=truelabel; + truelabel:=falselabel; + falselabel:=hl; + secondpass(left); + maketojumpbool(exprasmlist,left,lr_load_regvars); + hl:=truelabel; + truelabel:=falselabel; + falselabel:=hl; + end; + LOC_FLAGS : + begin + location_release(exprasmlist,left.location); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=flagsinvers[left.location.resflags]; + end; + LOC_CONSTANT, + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE : + begin + location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true); + list.concat(taicpu.op_reg(A_TST,opsize,left.location.register)); + location_release(exprasmlist,left.location); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_E; + end; + else + internalerror(200203224); + end; + end + else if is_64bitint(left.resulttype.def) then + begin + secondpass(left); + location_copy(location,left.location); + location_force_reg(exprasmlist,location,OS_64,false); + cg.a_op64_op_loc_reg(exprasmlist,A_NOT,OS_64, + location,joinreg64(l.registerlow,l.registerhigh)); + end + else + begin + secondpass(left); + location_copy(location,left.location); + location_force_reg(exprasmlist,location,def_cgsize(resulttype.def),false); + + opsize:=def_cgsize(resulttype.def); + cg.a_op_reg_reg(exprasmlist,OP_NOT,location.register,location.register); + end; + end; + +begin + cmoddivnode:=tm68kmoddivnode; + cshlshrnode:=tm68kshlshrnode; + cnotnode:=tm68knotnode; +end. +{ + $Log$ + Revision 1.1 2002-08-14 19:16:34 carl + + m68k type conversion nodes + + started some mathematical nodes + * out of bound references should now be handled correctly + +}