{ $Id$ Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere Generate generic inline 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 ncginl; {$i fpcdefs.inc} interface uses node,ninl; type tcginlinenode = class(tinlinenode) procedure pass_2;override; procedure second_assert;virtual; procedure second_sizeoftypeof;virtual; procedure second_length;virtual; procedure second_predsucc;virtual; procedure second_incdec;virtual; procedure second_typeinfo;virtual; procedure second_includeexclude;virtual; procedure second_pi; virtual; procedure second_arctan_real; virtual; procedure second_abs_real; virtual; procedure second_sqr_real; virtual; procedure second_sqrt_real; virtual; procedure second_ln_real; virtual; procedure second_cos_real; virtual; procedure second_sin_real; virtual; procedure second_assigned; virtual; procedure second_prefetch; virtual; end; implementation uses globtype,systems, cutils,verbose,globals,fmodule, symconst,symdef,defutil,symsym, aasmbase,aasmtai,aasmcpu,parabase, cgbase,pass_1,pass_2, cpuinfo,cpubase,paramgr,procinfo, nbas,ncon,ncal,ncnv,nld, tgobj,ncgutil, cgutils,cgobj, rgobj {$ifndef cpu64bit} ,cg64f32 {$endif cpu64bit} ; {***************************************************************************** TCGINLINENODE *****************************************************************************} procedure tcginlinenode.pass_2; begin location_reset(location,LOC_VOID,OS_NO); case inlinenumber of in_assert_x_y: begin second_Assert; end; in_sizeof_x, in_typeof_x : begin second_SizeofTypeOf; end; in_length_x : begin second_Length; end; in_pred_x, in_succ_x: begin second_PredSucc; end; in_dec_x, in_inc_x : begin second_IncDec; end; in_typeinfo_x: begin second_TypeInfo; end; in_include_x_y, in_exclude_x_y: begin second_IncludeExclude; end; in_pi: begin second_pi; end; in_sin_extended: begin second_sin_real; end; in_arctan_extended: begin second_arctan_real; end; in_abs_extended: begin second_abs_real; end; in_sqr_extended: begin second_sqr_real; end; in_sqrt_extended: begin second_sqrt_real; end; in_ln_extended: begin second_ln_real; end; in_cos_extended: begin second_cos_real; end; in_prefetch_var: begin second_prefetch; end; in_assigned_x: begin second_assigned; end; {$ifdef SUPPORT_MMX} in_mmx_pcmpeqb..in_mmx_pcmpgtw: begin location_reset(location,LOC_MMXREGISTER,OS_NO); if left.location.loc=LOC_REGISTER then begin {!!!!!!!} end else if tcallparanode(left).left.location.loc=LOC_REGISTER then begin {!!!!!!!} end else begin {!!!!!!!} end; end; {$endif SUPPORT_MMX} else internalerror(9); end; end; {***************************************************************************** ASSERT GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_Assert; var hp2 : tstringconstnode; otlabel,oflabel : tasmlabel; paraloc1,paraloc2, paraloc3,paraloc4 : tcgpara; begin { the node should be removed in the firstpass } if not (cs_do_assertion in aktlocalswitches) then internalerror(7123458); paraloc1.init; paraloc2.init; paraloc3.init; paraloc4.init; paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.getintparaloc(pocall_default,2,paraloc2); paramanager.getintparaloc(pocall_default,3,paraloc3); paramanager.getintparaloc(pocall_default,4,paraloc4); otlabel:=truelabel; oflabel:=falselabel; objectlibrary.getlabel(truelabel); objectlibrary.getlabel(falselabel); secondpass(tcallparanode(left).left); maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars); cg.a_label(exprasmlist,falselabel); { erroraddr } paramanager.allocparaloc(exprasmlist,paraloc4); cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4); { lineno } paramanager.allocparaloc(exprasmlist,paraloc3); cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paraloc3); { filename string } hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring); firstpass(tnode(hp2)); secondpass(tnode(hp2)); if codegenerror then exit; paramanager.allocparaloc(exprasmlist,paraloc2); cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paraloc2); hp2.free; { push msg } secondpass(tcallparanode(tcallparanode(left).right).left); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paraloc1); { call } paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); paramanager.freeparaloc(exprasmlist,paraloc3); paramanager.freeparaloc(exprasmlist,paraloc4); cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_ASSERT'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_label(exprasmlist,truelabel); truelabel:=otlabel; falselabel:=oflabel; paraloc1.done; paraloc2.done; paraloc3.done; paraloc4.done; end; {***************************************************************************** SIZEOF / TYPEOF GENERIC HANDLING *****************************************************************************} { second_handle_ the sizeof and typeof routines } procedure tcginlinenode.second_SizeOfTypeOf; var href, hrefvmt : treference; hregister : tregister; begin if inlinenumber=in_sizeof_x then location_reset(location,LOC_REGISTER,OS_INT) else location_reset(location,LOC_REGISTER,OS_ADDR); { for both cases load vmt } if left.nodetype=typen then begin hregister:=cg.getaddressregister(exprasmlist); reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname,AB_EXTERNAL,AT_DATA),0); cg.a_loadaddr_ref_reg(exprasmlist,href,hregister); end else begin secondpass(left); hregister:=cg.getaddressregister(exprasmlist); { handle self inside a method of a class } case left.location.loc of LOC_CREGISTER, LOC_REGISTER : begin if (left.resulttype.def.deftype=classrefdef) or (po_staticmethod in current_procinfo.procdef.procoptions) then cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,hregister) else begin { load VMT pointer } reference_reset_base(hrefvmt,left.location.register,tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,hrefvmt,hregister); end end; LOC_REFERENCE, LOC_CREFERENCE : begin if is_class(left.resulttype.def) then begin { deref class } cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,hregister); cg.g_maybe_testself(exprasmlist,hregister); { load VMT pointer } reference_reset_base(hrefvmt,hregister,tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,hrefvmt,hregister); end else begin { load VMT pointer, but not for classrefdefs } if (left.resulttype.def.deftype=objectdef) then inc(left.location.reference.offset,tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,hregister); end; end; else internalerror(200301301); end; end; { in sizeof load size } if inlinenumber=in_sizeof_x then begin reference_reset_base(href,hregister,0); hregister:=cg.getintregister(exprasmlist,OS_INT); cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister); end; location.register:=hregister; end; {***************************************************************************** LENGTH GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_Length; var lengthlab : tasmlabel; hregister : tregister; href : treference; begin secondpass(left); if is_shortstring(left.resulttype.def) then begin location_copy(location,left.location); location.size:=OS_8; end else begin { length in ansi/wide strings is at offset -sizeof(aint) } location_force_reg(exprasmlist,left.location,OS_ADDR,false); objectlibrary.getlabel(lengthlab); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab); reference_reset_base(href,left.location.register,-sizeof(aint)); hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT); cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister); cg.a_label(exprasmlist,lengthlab); location_reset(location,LOC_REGISTER,OS_INT); location.register:=hregister; end; end; {***************************************************************************** PRED/SUCC GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_PredSucc; var cgsize : TCGSize; cgop : topcg; begin secondpass(left); if inlinenumber=in_pred_x then cgop:=OP_SUB else cgop:=OP_ADD; cgsize:=def_cgsize(resulttype.def); { we need a value in a register } location_copy(location,left.location); location_force_reg(exprasmlist,location,cgsize,false); {$ifndef cpu64bit} if cgsize in [OS_64,OS_S64] then cg64.a_op64_const_reg(exprasmlist,cgop,1,location.register64) else {$endif cpu64bit} cg.a_op_const_reg(exprasmlist,cgop,location.size,1,location.register); cg.g_rangecheck(exprasmlist,location,resulttype.def,resulttype.def); end; {***************************************************************************** INC/DEC GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_IncDec; const addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB); var addvalue : TConstExprInt; addconstant : boolean; {$ifndef cpu64bit} hregisterhi, {$endif cpu64bit} hregister : tregister; cgsize : tcgsize; begin { set defaults } addconstant:=true; { load first parameter, must be a reference } secondpass(tcallparanode(left).left); cgsize:=def_cgsize(tcallparanode(left).left.resulttype.def); { get addvalue } case tcallparanode(left).left.resulttype.def.deftype of orddef, enumdef : addvalue:=1; pointerdef : begin if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then addvalue:=1 else addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size; end; else internalerror(10081); end; { second_ argument specified?, must be a s32bit in register } if assigned(tcallparanode(left).right) then begin secondpass(tcallparanode(tcallparanode(left).right).left); { when constant, just multiply the addvalue } if is_constintnode(tcallparanode(tcallparanode(left).right).left) then addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left) else begin location_force_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,cgsize,addvalue<=1); hregister:=tcallparanode(tcallparanode(left).right).left.location.register; {$ifndef cpu64bit} hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh; {$endif cpu64bit} { insert multiply with addvalue if its >1 } if addvalue>1 then cg.a_op_const_reg(exprasmlist,OP_IMUL,cgsize,addvalue,hregister); addconstant:=false; end; end; { write the add instruction } if addconstant then begin {$ifndef cpu64bit} if cgsize in [OS_64,OS_S64] then cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],addvalue,tcallparanode(left).left.location) else {$endif cpu64bit} cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber], aint(addvalue),tcallparanode(left).left.location); end else begin {$ifndef cpu64bit} if cgsize in [OS_64,OS_S64] then cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber], joinreg64(hregister,hregisterhi),tcallparanode(left).left.location) else {$endif cpu64bit} cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber], hregister,tcallparanode(left).left.location); end; cg.g_overflowcheck(exprasmlist,tcallparanode(left).left.location,tcallparanode(left).resulttype.def); cg.g_rangecheck(exprasmlist,tcallparanode(left).left.location,tcallparanode(left).left.resulttype.def, tcallparanode(left).left.resulttype.def); end; {***************************************************************************** TYPEINFO GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_typeinfo; var href : treference; begin location_reset(location,LOC_REGISTER,OS_ADDR); location.register:=cg.getaddressregister(exprasmlist); reference_reset_symbol(href,tstoreddef(left.resulttype.def).get_rtti_label(fullrtti),0); cg.a_loadaddr_ref_reg(exprasmlist,href,location.register); end; {***************************************************************************** INCLUDE/EXCLUDE GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_IncludeExclude; var bitsperop,l : longint; opsize : tcgsize; cgop : topcg; addrreg2,addrreg, hregister,hregister2: tregister; use_small : boolean; href : treference; begin opsize:=OS_32; bitsperop:=(8*tcgsize2size[opsize]); secondpass(tcallparanode(left).left); if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then begin { calculate bit position } l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod bitsperop); { determine operator } if inlinenumber=in_include_x_y then cgop:=OP_OR else begin cgop:=OP_AND; l:=not(l); end; case tcallparanode(left).left.location.loc of LOC_REFERENCE : begin inc(tcallparanode(left).left.location.reference.offset, (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div bitsperop)*tcgsize2size[opsize]); cg.a_op_const_ref(exprasmlist,cgop,opsize,l,tcallparanode(left).left.location.reference); end; LOC_CREGISTER : cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register); else internalerror(200405021); end; end else begin use_small:= { set type } (tsetdef(tcallparanode(left).left.resulttype.def).settype=smallset) and { elemenut number between 1 and 32 } ((tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=orddef) and (torddef(tcallparanode(tcallparanode(left).right).left.resulttype.def).high<=32) or (tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=enumdef) and (tenumdef(tcallparanode(tcallparanode(left).right).left.resulttype.def).max<=32)); { generate code for the element to set } secondpass(tcallparanode(tcallparanode(left).right).left); { bitnumber - which must be loaded into register } hregister:=cg.getintregister(exprasmlist,opsize); hregister2:=cg.getintregister(exprasmlist,opsize); cg.a_load_loc_reg(exprasmlist,opsize, tcallparanode(tcallparanode(left).right).left.location,hregister); if use_small then begin { hregister contains the bitnumber to add } cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2); cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2); { possiblities : bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER set value : LOC_REFERENCE, LOC_REGISTER } { location of set } if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then begin if inlinenumber=in_include_x_y then begin cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2, tcallparanode(left).left.location.reference); end else begin cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2,hregister2); cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2, tcallparanode(left).left.location.reference); end; end else internalerror(20020728); end else begin { possiblities : bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER set value : LOC_REFERENCE } { hregister contains the bitnumber (div 32 to get the correct offset) } { hregister contains the bitnumber to add } cg.a_op_const_reg_reg(exprasmlist, OP_SHR, opsize, 5, hregister,hregister2); cg.a_op_const_reg(exprasmlist, OP_SHL, opsize, 2, hregister2); addrreg:=cg.getaddressregister(exprasmlist); { we need an extra address register to be able to do an ADD operation } addrreg2:=cg.getaddressregister(exprasmlist); cg.a_load_reg_reg(exprasmlist,opsize,OS_ADDR,hregister2,addrreg2); { calculate the correct address of the operand } cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg); cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_ADDR, addrreg2, addrreg); { hregister contains the bitnumber to add } cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2); cg.a_op_const_reg(exprasmlist, OP_AND, opsize, 31, hregister); cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2); reference_reset_base(href,addrreg,0); if inlinenumber=in_include_x_y then cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2, href) else begin cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2, hregister2); cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2, href); end; end; end; end; {***************************************************************************** FLOAT GENERIC HANDLING *****************************************************************************} { These routines all call internal RTL routines, so if they are called here, they give an internal error } procedure tcginlinenode.second_pi; begin internalerror(20020718); end; procedure tcginlinenode.second_arctan_real; begin internalerror(20020718); end; procedure tcginlinenode.second_abs_real; begin internalerror(20020718); end; procedure tcginlinenode.second_sqr_real; begin internalerror(20020718); end; procedure tcginlinenode.second_sqrt_real; begin internalerror(20020718); end; procedure tcginlinenode.second_ln_real; begin internalerror(20020718); end; procedure tcginlinenode.second_cos_real; begin internalerror(20020718); end; procedure tcginlinenode.second_sin_real; begin internalerror(20020718); end; procedure tcginlinenode.second_prefetch; begin end; {***************************************************************************** ASSIGNED GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_assigned; begin secondpass(tcallparanode(left).left); { force left to be an OS_ADDR, since in case of method procvars } { the size is 2*OS_ADDR (JM) } cg.a_cmp_const_loc_label(exprasmlist,OS_ADDR,OC_NE,0,tcallparanode(left).left.location,truelabel); cg.a_jmp_always(exprasmlist,falselabel); location_reset(location,LOC_JUMP,OS_NO); end; begin cinlinenode:=tcginlinenode; end. { $Log$ Revision 1.64 2004-09-25 14:23:54 peter * ungetregister is now only used for cpuregisters, renamed to ungetcpuregister * renamed (get|unget)explicitregister(s) to ..cpuregister * removed location-release/reference_release Revision 1.63 2004/09/21 17:25:12 peter * paraloc branch merged Revision 1.62.4.1 2004/08/31 20:43:06 peter * paraloc patch Revision 1.62 2004/08/16 21:00:15 peter * range checks fixed Revision 1.61 2004/07/12 17:58:19 peter * remove maxlen field from ansistring/widestrings Revision 1.60 2004/06/20 08:55:29 florian * logs truncated Revision 1.59 2004/06/16 20:07:08 florian * dwarf branch merged Revision 1.58 2004/05/30 21:18:22 jonas * some optimizations and associated fixes for better regvar code Revision 1.57 2004/05/22 23:34:28 peter tai_regalloc.allocation changed to ratype to notify rgobj of register size changes Revision 1.56.2.4 2004/05/02 16:49:12 peter * 64 bit fixes Revision 1.56.2.3 2004/05/01 16:35:51 florian * fixed length() for 64 Bit CPUs }