{ $Id$ Copyright (c) 1998-2002 by Florian Klaempfl Generate assembler for memory related nodes which are the same for all (most?) processors 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 ncgmem; {$i fpcdefs.inc} interface uses globtype,cgbase,cpuinfo,cpubase, node,nmem; type tcgloadvmtaddrnode = class(tloadvmtaddrnode) procedure pass_2;override; end; tcgloadparentfpnode = class(tloadparentfpnode) procedure pass_2;override; end; tcgaddrnode = class(taddrnode) procedure pass_2;override; end; tcgderefnode = class(tderefnode) procedure pass_2;override; end; tcgsubscriptnode = class(tsubscriptnode) procedure pass_2;override; end; tcgwithnode = class(twithnode) procedure pass_2;override; end; tcgvecnode = class(tvecnode) private procedure rangecheck_array; protected function get_mul_size : aint; {# This routine is used to calculate the address of the reference. On entry reg contains the index in the array, and l contains the size of each element in the array. This routine should update location.reference correctly, so it points to the correct address. } procedure update_reference_reg_mul(reg:tregister;l:aint);virtual; procedure second_wideansistring;virtual; procedure second_dynamicarray;virtual; public procedure pass_2;override; end; implementation uses systems, cutils,verbose,globals, symconst,symdef,symsym,defutil,paramgr, aasmbase,aasmtai, procinfo,pass_2,parabase, pass_1,nld,ncon,nadd,nutils, cgutils,cgobj, tgobj,ncgutil ; {***************************************************************************** TCGLOADVMTADDRNODE *****************************************************************************} procedure tcgloadvmtaddrnode.pass_2; var href : treference; begin location_reset(location,LOC_REGISTER,OS_ADDR); if (left.nodetype<>typen) then begin { left contains self, load vmt from self } secondpass(left); if is_object(left.resulttype.def) then begin case left.location.loc of LOC_CREFERENCE, LOC_REFERENCE: begin reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,href.base); end; else internalerror(200305056); end; end else begin case left.location.loc of LOC_REGISTER: begin {$ifdef cpu_uses_separate_address_registers} if getregtype(left.location.register)<>R_ADDRESSREGISTER then begin reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,href.base); end else {$endif} reference_reset_base(href,left.location.register,tobjectdef(left.resulttype.def).vmt_offset); end; LOC_CREGISTER, LOC_CREFERENCE, LOC_REFERENCE: begin reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset); cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,href.base); end; else internalerror(200305057); end; end; location.register:=cg.getaddressregister(exprasmlist); cg.g_maybe_testself(exprasmlist,href.base); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register); end else begin reference_reset_symbol(href, objectlibrary.newasmsymbol(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname,AB_EXTERNAL,AT_DATA),0); location.register:=cg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,href,location.register); end; end; {***************************************************************************** TCGLOADPARENTFPNODE *****************************************************************************} procedure tcgloadparentfpnode.pass_2; var currpi : tprocinfo; hsym : tparavarsym; href : treference; begin if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then begin location_reset(location,LOC_REGISTER,OS_ADDR); location.register:=current_procinfo.framepointer; end else begin currpi:=current_procinfo; location_reset(location,LOC_REGISTER,OS_ADDR); location.register:=cg.getaddressregister(exprasmlist); { load framepointer of current proc } hsym:=tparavarsym(currpi.procdef.parast.search('parentfp')); if not assigned(hsym) then internalerror(200309281); cg.a_load_loc_reg(exprasmlist,OS_ADDR,hsym.localloc,location.register); { walk parents } while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do begin currpi:=currpi.parent; if not assigned(currpi) then internalerror(200311201); hsym:=tparavarsym(currpi.procdef.parast.search('parentfp')); if not assigned(hsym) then internalerror(200309282); if hsym.localloc.loc<>LOC_REFERENCE then internalerror(200309283); reference_reset_base(href,location.register,hsym.localloc.reference.offset); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register); end; end; end; {***************************************************************************** TCGADDRNODE *****************************************************************************} procedure tcgaddrnode.pass_2; begin secondpass(left); location_reset(location,LOC_REGISTER,OS_ADDR); location.register:=cg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); end; {***************************************************************************** TCGDEREFNODE *****************************************************************************} procedure tcgderefnode.pass_2; var paraloc1 : tcgpara; begin secondpass(left); location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def)); case left.location.loc of LOC_REGISTER: begin {$ifdef cpu_uses_separate_address_registers} if getregtype(left.location.register)<>R_ADDRESSREGISTER then begin location.reference.base := cg.getaddressregister(exprasmlist); cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register, location.reference.base); end else {$endif} location.reference.base := left.location.register; end; LOC_CREGISTER, LOC_CREFERENCE, LOC_REFERENCE: begin location.reference.base:=cg.getaddressregister(exprasmlist); cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base); end; end; if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) and not(tpointerdef(left.resulttype.def).is_far) and not(nf_no_checkpointer in flags) then begin paraloc1.init; paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paraloc1.done; cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end; {***************************************************************************** TCGSUBSCRIPTNODE *****************************************************************************} procedure tcgsubscriptnode.pass_2; var paraloc1 : tcgpara; begin secondpass(left); if codegenerror then exit; paraloc1.init; { classes and interfaces must be dereferenced implicit } if is_class_or_interface(left.resulttype.def) then begin location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def)); case left.location.loc of LOC_CREGISTER, LOC_REGISTER: begin {$ifdef cpu_uses_separate_address_registers} if getregtype(left.location.register)<>R_ADDRESSREGISTER then begin location.reference.base:=rg.getaddressregister(exprasmlist); cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR, left.location.register,location.reference.base); end else {$endif} location.reference.base := left.location.register; end; LOC_CREFERENCE, LOC_REFERENCE: begin location.reference.base:=cg.getaddressregister(exprasmlist); cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base); end; end; { implicit deferencing } if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) then begin paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end else if is_interfacecom(left.resulttype.def) then begin tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference); cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference); { implicit deferencing also for interfaces } if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) then begin paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end else location_copy(location,left.location); inc(location.reference.offset,vs.fieldoffset); { also update the size of the location } location.size:=def_cgsize(resulttype.def); paraloc1.done; end; {***************************************************************************** TCGWITHNODE *****************************************************************************} procedure tcgwithnode.pass_2; {$ifdef WITHNODEDEBUG} const withlevel : longint = 0; var withstartlabel,withendlabel : tasmlabel; pp : pchar; mangled_length : longint; refnode : tnode; {$endif WITHNODEDEBUG} begin location_reset(location,LOC_VOID,OS_NO); {$ifdef WITHNODEDEBUG} if (cs_debuginfo in aktmoduleswitches) then begin { load reference } if (withrefnode.nodetype=derefn) and (tderefnode(withrefnode).left.nodetype=temprefn) then refnode:=tderefnode(withrefnode).left else refnode:=withrefnode; secondpass(refnode); location_freetemp(exprasmlist,refnode.location); if not(refnode.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then internalerror(2003092810); inc(withlevel); objectlibrary.getaddrlabel(withstartlabel); objectlibrary.getaddrlabel(withendlabel); cg.a_label(exprasmlist,withstartlabel); withdebugList.concat(Tai_stabs.Create(strpnew( '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+ '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+ tostr(N_LSYM)+',0,0,'+tostr(refnode.location.reference.offset)))); mangled_length:=length(current_procinfo.procdef.mangledname); getmem(pp,mangled_length+50); strpcopy(pp,'192,0,0,'+withstartlabel.name); if (target_info.use_function_relative_addresses) then begin strpcopy(strend(pp),'-'); strpcopy(strend(pp),current_procinfo.procdef.mangledname); end; withdebugList.concat(Tai_stabn.Create(strnew(pp))); end; {$endif WITHNODEDEBUG} if assigned(left) then secondpass(left); {$ifdef WITHNODEDEBUG} if (cs_debuginfo in aktmoduleswitches) then begin cg.a_label(exprasmlist,withendlabel); strpcopy(pp,'224,0,0,'+withendlabel.name); if (target_info.use_function_relative_addresses) then begin strpcopy(strend(pp),'-'); strpcopy(strend(pp),current_procinfo.procdef.mangledname); end; withdebugList.concat(Tai_stabn.Create(strnew(pp))); freemem(pp,mangled_length+50); dec(withlevel); end; {$endif WITHNODEDEBUG} end; {***************************************************************************** TCGVECNODE *****************************************************************************} function tcgvecnode.get_mul_size : aint; begin if nf_memindex in flags then get_mul_size:=1 else begin if (left.resulttype.def.deftype=arraydef) then get_mul_size:=tarraydef(left.resulttype.def).elesize else get_mul_size:=resulttype.def.size; end end; procedure tcgvecnode.update_reference_reg_mul(reg:tregister;l:aint); var hreg: tregister; begin if location.reference.base=NR_NO then begin if l<>1 then cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg); location.reference.base:=reg; end else if location.reference.index=NR_NO then begin if l<>1 then cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg); location.reference.index:=reg; end else begin hreg := cg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,location.reference,hreg); reference_reset_base(location.reference,hreg,0); { insert new index register } if l<>1 then cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg); location.reference.index:=reg; end; end; procedure tcgvecnode.second_wideansistring; begin end; procedure tcgvecnode.second_dynamicarray; begin end; procedure tcgvecnode.rangecheck_array; var hightree : tnode; poslabel, neglabel : tasmlabel; hreg : tregister; paraloc1,paraloc2 : tcgpara; begin paraloc1.init; paraloc2.init; if is_open_array(left.resulttype.def) or is_array_of_const(left.resulttype.def) then begin { cdecl functions don't have high() so we can not check the range } if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then begin { Get high value } hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); { it must be available } if not assigned(hightree) then internalerror(200212201); firstpass(hightree); secondpass(hightree); { generate compares } if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then hreg:=cg.makeregsize(exprasmlist,right.location.register,OS_INT) else begin hreg:=cg.getintregister(exprasmlist,OS_INT); cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,hreg); end; objectlibrary.getlabel(neglabel); objectlibrary.getlabel(poslabel); cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel); cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel); cg.a_label(exprasmlist,poslabel); cg.a_call_name(exprasmlist,'FPC_RANGEERROR'); cg.a_label(exprasmlist,neglabel); { release hightree } hightree.free; end; end else if is_dynamic_array(left.resulttype.def) then begin paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.getintparaloc(pocall_default,2,paraloc2); paramanager.allocparaloc(exprasmlist,paraloc2); cg.a_param_loc(exprasmlist,right.location,paraloc2); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_loc(exprasmlist,left.location,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else cg.g_rangecheck(exprasmlist,right.location,right.resulttype.def,left.resulttype.def); paraloc1.done; paraloc2.done; end; procedure tcgvecnode.pass_2; var offsetdec, extraoffset : aint; t : tnode; href : treference; otl,ofl : tasmlabel; newsize : tcgsize; mulsize : aint; isjump : boolean; paraloc1, paraloc2 : tcgpara; begin paraloc1.init; paraloc2.init; mulsize := get_mul_size; newsize:=def_cgsize(resulttype.def); secondpass(left); if left.location.loc=LOC_CREFERENCE then location_reset(location,LOC_CREFERENCE,newsize) else location_reset(location,LOC_REFERENCE,newsize); { an ansistring needs to be dereferenced } if is_ansistring(left.resulttype.def) or is_widestring(left.resulttype.def) then begin if nf_callunique in flags then internalerror(200304236); {DM!!!!!} case left.location.loc of LOC_REGISTER, LOC_CREGISTER : location.reference.base:=left.location.register; LOC_CREFERENCE, LOC_REFERENCE : begin location.reference.base:=cg.getaddressregister(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.reference.base); end; else internalerror(2002032218); end; { check for a zero length string, we can use the ansistring routine here } if (cs_check_range in aktlocalswitches) then begin paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO'); cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; { in ansistrings/widestrings S[1] is pchar(S)[0] !! } if is_ansistring(left.resulttype.def) then offsetdec:=1 else offsetdec:=2; dec(location.reference.offset,offsetdec); end else if is_dynamic_array(left.resulttype.def) then begin case left.location.loc of LOC_REGISTER, LOC_CREGISTER : location.reference.base:=left.location.register; LOC_REFERENCE, LOC_CREFERENCE : begin location.reference.base:=cg.getaddressregister(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR, left.location.reference,location.reference.base); end; else internalerror(2002032219); end; end else location_copy(location,left.location); { location must be memory } if not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then internalerror(200411013); { offset can only differ from 0 if arraydef } if (left.resulttype.def.deftype=arraydef) and not(is_dynamic_array(left.resulttype.def)) then dec(location.reference.offset,mulsize*tarraydef(left.resulttype.def).lowrange); if right.nodetype=ordconstn then begin { offset can only differ from 0 if arraydef } case left.resulttype.def.deftype of arraydef : begin if not(is_open_array(left.resulttype.def)) and not(is_array_of_const(left.resulttype.def)) and not(is_dynamic_array(left.resulttype.def)) then begin if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or (tordconstnode(right).value 32bit accesses for x86_64 * rewrote array size checking to support 64bit Revision 1.100 2004/11/01 17:15:47 peter * no checkpointer code for dynarr to openarr Revision 1.99 2004/11/01 15:31:57 peter * -Or fix for absolute Revision 1.98 2004/10/25 15:38:41 peter * heap and heapsize removed * checkpointer fixes Revision 1.97 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.96 2004/09/21 17:25:12 peter * paraloc branch merged Revision 1.95.4.1 2004/08/31 20:43:06 peter * paraloc patch Revision 1.95 2004/08/02 09:15:03 michael + Fixed range check for non-constant indexes in strings Revision 1.94 2004/07/12 17:58:19 peter * remove maxlen field from ansistring/widestrings Revision 1.93 2004/06/20 08:55:29 florian * logs truncated Revision 1.92 2004/06/16 20:07:08 florian * dwarf branch merged Revision 1.91 2004/04/29 19:56:37 daniel * Prepare compiler infrastructure for multiple ansistring types Revision 1.90 2004/04/21 17:39:40 jonas - disabled with-symtable debugging code since it was broken and at the same time confused the register allocator and therefore also the optimizer. May be fixed in the future using dwarf support Revision 1.89.2.4 2004/05/10 21:28:34 peter * section_smartlink enabled for gas under linux Revision 1.89.2.3 2004/05/02 13:04:28 peter * ofs fixed }