{ $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; end; implementation uses globtype,systems, cutils,verbose,globals,fmodule, symconst,symdef,defbase, aasmbase,aasmtai,aasmcpu, cginfo,cgbase,pass_1,pass_2, cpubase,paramgr, nbas,ncon,ncal,ncnv,nld, tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu; {***************************************************************************** TCGINLINENODE *****************************************************************************} procedure tcginlinenode.pass_2; var asmop : tasmop; l : longint; oldpushedparasize : longint; begin { save & reset pushedparasize } oldpushedparasize:=pushedparasize; pushedparasize:=0; 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; {$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; { reset pushedparasize } pushedparasize:=oldpushedparasize; end; {***************************************************************************** ASSERT GENERIC HANDLING *****************************************************************************} procedure tcginlinenode.second_Assert; var hp2 : tstringconstnode; otlabel,oflabel{,l1} : tasmlabel; begin { the node should be removed in the firstpass } if not (cs_do_assertion in aktlocalswitches) then internalerror(7123458); 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 } cg.a_param_reg(exprasmlist,OS_ADDR,FRAME_POINTER_REG,paramanager.getintparaloc(4)); { lineno } cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3)); { filename string } hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring); firstpass(hp2); secondpass(hp2); if codegenerror then exit; cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2)); hp2.free; { push msg } secondpass(tcallparanode(tcallparanode(left).right).left); cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1)); { call } cg.a_call_name(exprasmlist,'FPC_ASSERT'); cg.a_label(exprasmlist,truelabel); truelabel:=otlabel; falselabel:=oflabel; end; {***************************************************************************** SIZEOF / TYPEOF GENERIC HANDLING *****************************************************************************} { second_handle_ the sizeof and typeof routines } procedure tcginlinenode.second_SizeOfTypeOf; var href : treference; hregister : tregister; begin location_reset(location,LOC_REGISTER,OS_ADDR); { for both cases load vmt } if left.nodetype=typen then begin hregister:=rg.getaddressregister(exprasmlist); reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0); cg.a_loadaddr_ref_reg(exprasmlist,href,hregister); end else begin secondpass(left); location_release(exprasmlist,left.location); hregister:=rg.getaddressregister(exprasmlist); { load VMT pointer } inc(left.location.reference.offset,tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister); end; { in sizeof load size } if inlinenumber=in_sizeof_x then begin reference_reset_base(href,hregister,0); rg.ungetaddressregister(exprasmlist,hregister); hregister:=rg.getregisterint(exprasmlist); cg.a_load_ref_reg(exprasmlist,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); { length in ansi strings is at offset -8 } if is_ansistring(left.resulttype.def) or is_widestring(left.resulttype.def) then begin location_force_reg(exprasmlist,left.location,OS_ADDR,false); hregister:=left.location.register; objectlibrary.getlabel(lengthlab); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab); reference_reset_base(href,hregister,-8); cg.a_load_ref_reg(exprasmlist,OS_32,href,hregister); cg.a_label(exprasmlist,lengthlab); location_reset(location,LOC_REGISTER,OS_32); location.register:=hregister; end else begin location_copy(location,left.location); location.size:=OS_8; 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); if cgsize in [OS_64,OS_S64] then cg64.a_op64_const_reg(exprasmlist,cgop,1, location.register64) else cg.a_op_const_reg(exprasmlist,cgop,1,location.register); cg.g_overflowcheck(exprasmlist,self); cg.g_rangecheck(exprasmlist,self,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 : longint; addconstant : boolean; hregisterhi, hregister : tregister; cgsize : tcgsize; pushedregs : tmaybesave; 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 maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32, tcallparanode(left).left.location,pushedregs); secondpass(tcallparanode(tcallparanode(left).right).left); maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs); { 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,false); hregister:=tcallparanode(tcallparanode(left).right).left.location.register; hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh; { insert multiply with addvalue if its >1 } if addvalue>1 then cg.a_op_const_reg(exprasmlist,OP_IMUL,addvalue,hregister); addconstant:=false; end; end; { write the add instruction } if addconstant then begin if cgsize in [OS_64,OS_S64] then cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber], addvalue,tcallparanode(left).left.location) else cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber], addvalue,tcallparanode(left).left.location); end else begin if cgsize in [OS_64,OS_S64] then cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber], joinreg64(hregister,hregisterhi),tcallparanode(left).left.location) else cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber], hregister,tcallparanode(left).left.location); location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location); end; cg.g_overflowcheck(exprasmlist,tcallparanode(left).left); cg.g_rangecheck(exprasmlist,tcallparanode(left).left,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:=rg.getaddressregister(exprasmlist); reference_reset_symbol(href,tstoreddef(ttypenode(tcallparanode(left).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 scratch_reg : boolean; hregister : tregister; asmop : tasmop; L : longint; pushedregs : TMaybesave; cgop : topcg; addrreg, hregister2: tregister; use_small : boolean; cgsize : tcgsize; href : treference; begin location_copy(location,left.location); 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 32); { determine operator } if inlinenumber=in_include_x_y then cgop:=OP_OR else begin cgop:=OP_AND; l:=not(l); end; if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then begin inc(tcallparanode(left).left.location.reference.offset, (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4); cg.a_op_const_ref(exprasmlist,cgop,OS_INT,l,tcallparanode(left).left.location.reference); location_release(exprasmlist,tcallparanode(left).left.location); end else { LOC_CREGISTER } begin cg.a_op_const_reg(exprasmlist,cgop,l,tcallparanode(left).left.location.register); 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 } maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32, tcallparanode(left).left.location,pushedregs); secondpass(tcallparanode(tcallparanode(left).right).left); maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs); { bitnumber - which must be loaded into register } hregister := cg.get_scratch_reg_int(exprasmlist); hregister2 := rg.getregisterint(exprasmlist); case tcallparanode(tcallparanode(left).right).left.location.loc of LOC_CREGISTER, LOC_REGISTER: begin cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT, tcallparanode(tcallparanode(left).right).left.location.register,hregister); end; LOC_REFERENCE: begin cgsize := def_cgsize(tcallparanode(tcallparanode(left).right).left.resulttype.def); cg.a_load_ref_reg(exprasmlist,cgsize, tcallparanode(tcallparanode(left).right).left.location.reference,hregister); end; else internalerror(20020727); end; { hregister contains the bitnumber to add } cg.a_load_const_reg(exprasmlist, OS_INT, 1, hregister2); cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_INT, hregister, hregister2); if use_small then begin { 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, OS_32, hregister2, tcallparanode(left).left.location.reference); end else begin cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2); cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, 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) } cg.a_op_const_reg(exprasmlist, OP_SHR, 5, hregister); addrreg := cg.get_scratch_reg_address(exprasmlist); { 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_INT, hregister, addrreg); reference_reset_base(href,addrreg,0); if inlinenumber=in_include_x_y then begin cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, href); end else begin cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2); cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href); end; cg.free_scratch_reg(exprasmlist, addrreg); end; cg.free_scratch_reg(exprasmlist,hregister); rg.ungetregisterint(exprasmlist,hregister2); 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; begin cinlinenode:=tcginlinenode; end. { $Log$ Revision 1.14 2002-09-17 18:54:02 jonas * a_load_reg_reg() now has two size parameters: source and dest. This allows some optimizations on architectures that don't encode the register size in the register name. Revision 1.13 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 assembler reader. Revision 1.12 2002/08/11 14:32:26 peter * renamed current_library to objectlibrary Revision 1.11 2002/08/11 13:24:11 peter * saving of asmsymbols in ppu supported * asmsymbollist global is removed and moved into a new class tasmlibrarydata that will hold the info of a .a file which corresponds with a single module. Added librarydata to tmodule to keep the library info stored for the module. In the future the objectfiles will also be stored to the tasmlibrarydata class * all getlabel/newasmsymbol and friends are moved to the new class Revision 1.10 2002/08/05 18:27:48 carl + more more more documentation + first version include/exclude (can't test though, not enough scratch for i386 :()... Revision 1.9 2002/08/04 19:06:41 carl + added generic exception support (still does not work!) + more documentation Revision 1.8 2002/07/31 07:54:59 jonas * re-enabled second_assigned() Revision 1.7 2002/07/30 20:50:43 florian * the code generator knows now if parameters are in registers Revision 1.6 2002/07/29 21:23:42 florian * more fixes for the ppc + wrappers for the tcnvnode.first_* stuff introduced Revision 1.5 2002/07/28 20:45:22 florian + added direct assembler reader for PowerPC Revision 1.4 2002/07/26 09:45:20 florian * fixed a mistake in yesterday's commit, forgot to commit it Revision 1.3 2002/07/25 22:58:30 florian no message Revision 1.2 2002/07/25 17:55:41 carl + First working revision Revision 1.1 2002/07/24 04:07:49 carl + first revision (incomplete) }