From 6e3f0ce7f3d2302c9d162502527d0c5e632061b7 Mon Sep 17 00:00:00 2001 From: carl Date: Wed, 24 Jul 2002 04:07:49 +0000 Subject: [PATCH] + first revision (incomplete) --- compiler/ncginl.pas | 587 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 587 insertions(+) create mode 100644 compiler/ncginl.pas diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas new file mode 100644 index 0000000000..1f01ae39b4 --- /dev/null +++ b/compiler/ncginl.pas @@ -0,0 +1,587 @@ +{ + $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; + { Handle the assert routine } + 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_assigned;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, + cga,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_assigned_x : + begin + second_Assigned; + 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; + getlabel(truelabel); + 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,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; + 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_INT,href,hregister); + cg.a_label(exprasmlist,lengthlab); + location_reset(location,LOC_REGISTER,OS_INT); + 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; + + +{***************************************************************************** + ASSIGNED GENERIC HANDLING +*****************************************************************************} + procedure tcginlinenode.second_Assigned; + var + hreg : tregister; + ptrvalidlabel : tasmlabel; + begin + WriteLN('Entering assigned node!'); + secondpass(tcallparanode(left).left); + location_release(exprasmlist,tcallparanode(left).left.location); + hreg := rg.getregisterint(exprasmlist); + if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + begin + { if pointer is non-nil, and is in register, this directly the value we can use } + cg.a_load_reg_reg(exprasmlist, OS_ADDR, tcallparanode(left).left.location.register, hreg); + end + else + begin + getlabel(ptrvalidlabel); + cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg); + cg.a_cmp_const_ref_label(exprasmlist, OS_ADDR, OC_NE, 0, + tcallparanode(left).left.location.reference, ptrvalidlabel); + cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg); + cg.a_label(exprasmlist,ptrvalidlabel); + end; + location.register := hreg; + location_reset(location,LOC_REGISTER,OS_INT); + WriteLn('Exiting assigned node!'); + end; + + +{***************************************************************************** + INCLUDE/EXCLUDE GENERIC HANDLING +*****************************************************************************} + procedure tcginlinenode.second_IncludeExclude; + var + scratch_reg : boolean; + hregister : tregister; + asmop : tasmop; + L : longint; + pushedregs : TMaybesave; + cgop : topcg; + {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!} + 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 + { 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); + { determine asm operator } + if inlinenumber=in_include_x_y then + asmop:=A_BTS + else + asmop:=A_BTR; + + if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then + { we don't need a mod 32 because this is done automatically } + { by the bts instruction. For proper checking we would } + + { note: bts doesn't do any mod'ing, that's why we can also use } + { it for normalsets! (JM) } + + { need a cmp and jmp, but this should be done by the } + { type cast code which does range checking if necessary (FK) } + begin + scratch_reg := FALSE; + WriteLn('HELLO!'); + hregister := rg.makeregsize(tcallparanode(tcallparanode(left).right).left.location.register,OS_INT); + end + else + begin + scratch_reg := TRUE; + hregister:=cg.get_scratch_reg_int(exprasmlist); + end; + cg.a_load_loc_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,hregister); + if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then + emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference) + else + emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register); + if scratch_reg then + cg.free_scratch_reg(exprasmlist,hregister); + 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.1 2002-07-24 04:07:49 carl + + first revision (incomplete) + +}