{ Copyright (c) 2000-2002 by Florian Klaempfl Generate assembler for nodes that handle type conversions 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 ncgcnv; {$i fpcdefs.inc} interface uses node,ncnv,defutil,defcmp; type { tcgtypeconvnode } tcgtypeconvnode = class(ttypeconvnode) private function needs_indirect:boolean; protected {$ifdef cpuflags} { CPUs without flags need a specific implementation of int -> bool } procedure second_int_to_bool;override; {$endif cpuflags} procedure second_int_to_int;override; procedure second_cstring_to_pchar;override; procedure second_cstring_to_int;override; procedure second_string_to_chararray;override; procedure second_array_to_pointer;override; procedure second_pointer_to_array;override; procedure second_char_to_string;override; procedure second_real_to_real;override; procedure second_cord_to_pointer;override; procedure second_proc_to_procvar;override; procedure second_nil_to_methodprocvar;override; procedure second_bool_to_int;override; procedure second_bool_to_bool;override; procedure second_ansistring_to_pchar;override; procedure second_class_to_intf;override; procedure second_char_to_char;override; procedure second_elem_to_openarray;override; procedure second_nothing;override; public procedure pass_generate_code;override; end; tcgasnode = class(tasnode) procedure pass_generate_code;override; end; implementation uses cutils,verbose,globtype,globals, aasmbase,aasmdata,symconst,symdef,symtable, nutils,ncon, cpubase,systems, pass_2, cgbase, cgutils,cgobj,hlcgobj, fmodule, tgobj ; function tcgtypeconvnode.needs_indirect:boolean; begin result:=(tf_supports_packages in target_info.flags) and (target_info.system in systems_indirect_var_imports) and ( not assigned(current_module) or (current_module.globalsymtable<>systemunit) ); end; procedure tcgtypeconvnode.second_int_to_int; var orgsize, newsize : tcgsize; ressize, leftsize : longint; begin newsize:=def_cgsize(resultdef); { insert range check if not explicit or interally generated conversion } if (flags*[nf_explicit,nf_internal])=[] then hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef); { is the result size smaller? when typecasting from void we always reuse the current location, because there is nothing that we can load in a register } ressize := resultdef.size; leftsize := left.resultdef.size; if ((ressize<>leftsize) or is_bitpacked_access(left)) and not is_void(left.resultdef) then begin location_copy(location,left.location); { reuse a loc_reference when the newsize is smaller than than the original, else load it to a register } if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and (ressizeunsigned, which still needs high bits cleared). } else if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and (tcgsize2size[(reg_cgsize(left.location.register))]=sizeof(aint)) and (ressize>leftsize) and (newsize in [OS_32,OS_S32,OS_16,OS_S16]) and (not is_signed(left.resultdef) or is_signed(resultdef)) then location.size:=newsize {$endif} else hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false); end else begin { no special loading is required, reuse current location } { that's not true, if you go from signed to unsiged or } { vice versa, you need sign extension/removal if the } { value is already in a register (at least for archs } { which don't have 8bit register components etc) (JM) } location_copy(location,left.location); location.size:=newsize; orgsize := def_cgsize(left.resultdef); if (ressize < sizeof(aint)) and (location.loc in [LOC_REGISTER,LOC_CREGISTER]) and (orgsize <> newsize) then begin location.register := cg.getintregister(current_asmdata.CurrAsmList,newsize); location.loc := LOC_REGISTER; hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register); end else if location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(left.resultdef),cpointerdef.getreusable(resultdef),location.reference) {$ifdef cpuhighleveltarget} { high level targets require the types to be correct in all cases } else if left.resultdef<>resultdef then hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false); {$endif cpuhighleveltarget} end; end; {$ifdef cpuflags} procedure tcgtypeconvnode.second_int_to_bool; var hregister : tregister; href : treference; resflags : tresflags; hlabel : tasmlabel; newsize : tcgsize; begin secondpass(left); if codegenerror then exit; { Explicit typecasts from any ordinal type to a boolean type } { must not change the ordinal value } if (nf_explicit in flags) and not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then begin { overriding methods must be able to know in advance whether this code path will be taken by checking expectloc, so they can call the inherited method in that case } if left.expectloc in [LOC_FLAGS,LOC_JUMP] then internalerror(2014122901); location_copy(location,left.location); newsize:=def_cgsize(resultdef); { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true) else location.size:=newsize; exit; end; { though ppc/ppc64 doesn't use the generic code, we need to ifdef here because the code is included into the powerpc compilers } {$if defined(POWERPC) or defined(POWERPC64)} resflags.cr := RS_CR0; resflags.flag:=F_NE; {$elseif defined(mips)} resflags.reg1:=NR_NO; resflags.reg2:=NR_NO; resflags.cond:=OC_NONE; {$elseif defined(sparcgen)} { Load left node into flag F_NE/F_E } resflags.Init(NR_ICC,F_NE); {$elseif defined(xtensa)} { Xtensa uses its own implementation } Internalerror(2020032901); {$else} { Load left node into flag F_NE/F_E } resflags:=F_NE; {$endif defined(POWERPC) or defined(POWERPC64)} case left.location.loc of LOC_CREFERENCE, LOC_REFERENCE : begin if left.location.size in [OS_64,OS_S64] then begin hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister); href:=left.location.reference; inc(href.offset,4); cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister); end else begin hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); end; end; LOC_FLAGS : begin resflags:=left.location.resflags; end; LOC_REGISTER,LOC_CREGISTER : begin {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)} if left.location.size in [OS_64,OS_S64] then begin hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister); cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister); end else {$endif not cpu64bitalu and not cpuhighleveltarget} begin cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); end; end; LOC_JUMP : begin hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); current_asmdata.getjumplabel(hlabel); cg.a_label(current_asmdata.CurrAsmList,left.location.truelabel); cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister); cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); cg.a_label(current_asmdata.CurrAsmList,left.location.falselabel); cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister); cg.a_label(current_asmdata.CurrAsmList,hlabel); cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister); end; else internalerror(200311301); end; { load flags to register } location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register); cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS); if (is_cbool(resultdef)) then cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register); end; {$endif cpuflags} procedure tcgtypeconvnode.second_cstring_to_pchar; var hr : treference; begin if left.nodetype<>stringconstn then internalerror(200601131); if not is_pchar(resultdef) and not is_pwidechar(resultdef) then internalerror(2014032802); location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); case tstringconstnode(left).cst_type of cst_conststring : begin location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register); end; cst_shortstring : begin inc(left.location.reference.offset); location.reference.alignment:=1; location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register); end; cst_widestring, cst_unicodestring, cst_ansistring : begin if tstringconstnode(left).len=0 then begin { FPC_EMPTYCHAR is a widechar -> 2 bytes } reference_reset(hr,2,[]); hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR',AT_DATA,needs_indirect); current_module.add_extern_asmsym('FPC_EMPTYCHAR',AB_EXTERNAL,AT_DATA); location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,cwidechartype,resultdef,hr,location.register); end else begin location_copy(location,left.location); end; end; cst_longstring: begin {!!!!!!!} internalerror(8888); end; end; end; procedure tcgtypeconvnode.second_cstring_to_int; begin { this can't happen because constants are already processed in pass 1 } internalerror(200510013); end; procedure tcgtypeconvnode.second_string_to_chararray; begin if is_chararray(left.resultdef) then begin location_copy(location,left.location); exit; end; { should be handled already in resultdef pass (JM) } internalerror(200108292); end; procedure tcgtypeconvnode.second_array_to_pointer; begin location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register); end; procedure tcgtypeconvnode.second_pointer_to_array; begin { assume natural alignment, volatility of pointer has no effect on the volatility of the data it points to } location_reset_ref(location,LOC_REFERENCE,OS_NO,resultdef.alignment,[]); 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:=cg.getaddressregister(current_asmdata.CurrAsmList); cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR, left.location.register,location.reference.base); end else {$endif} hlcg.reference_reset_base(location.reference,left.resultdef,left.location.register,0,ctempposinvalid,location.reference.alignment,location.reference.volatility); end; LOC_REFERENCE, LOC_CREFERENCE, { tricky type casting of parameters can cause these locations, see tb0593.pp on x86_64-linux } LOC_SUBSETREG, LOC_CSUBSETREG, LOC_SUBSETREF, LOC_CSUBSETREF: begin hlcg.reference_reset_base(location.reference,left.resultdef, hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef),0,ctempposinvalid,location.reference.alignment,[]); hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location, location.reference.base); if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then location_freetemp(current_asmdata.CurrAsmList,left.location); end; LOC_CONSTANT: begin location.reference.offset:=left.location.value; end else internalerror(2002032216); end; end; procedure tcgtypeconvnode.second_char_to_string; var tmpref: treference; begin location_reset_ref(location,LOC_REFERENCE,OS_NO,2,[]); case tstringdef(resultdef).stringtype of st_shortstring : begin tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference); tmpref:=location.reference; hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList, cpointerdef.getreusable(resultdef), cpointerdef.getreusable(left.resultdef),tmpref); hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location, tmpref); location_freetemp(current_asmdata.CurrAsmList,left.location); end; { the rest is removed in the resultdef pass and converted to compilerprocs } else internalerror(4179); end; end; procedure tcgtypeconvnode.second_real_to_real; {$ifdef x86} var tr: treference; {$endif x86} begin location_reset(location,expectloc,def_cgsize(resultdef)); {$ifdef x86} { extended types in memory which should be loaded into the sse unit must be converted by the fpu first, so force them to be loaded into the fpu } if (expectloc=LOC_MMREGISTER) and (left.location.size in [OS_F80,OS_C64]) then begin if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false); { round them down to the proper precision } tg.gethltemp(current_asmdata.currasmlist,resultdef,resultdef.size,tt_normal,tr); hlcg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,tr); location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment,tr.volatility); left.location.reference:=tr; left.resultdef:=resultdef; end; {$endif x86} { ARM VFP values are in integer registers when they are function results } if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false); case left.location.loc of LOC_FPUREGISTER, LOC_CFPUREGISTER: begin case expectloc of LOC_FPUREGISTER: begin { on sparc a move from double -> single means from two to one register. } { On all other platforms it also needs rounding to avoid that } { single(double_regvar) = double_regvar is true in all cases } location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register); end; LOC_MMREGISTER: begin hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false); location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register,mms_movescalar); end else internalerror(2003012262); end; exit end; LOC_CREFERENCE, LOC_REFERENCE: begin if expectloc=LOC_MMREGISTER then begin location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); hlcg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register,mms_movescalar) end else begin hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false); location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register); end; location_freetemp(current_asmdata.CurrAsmList,left.location); end; LOC_MMREGISTER, LOC_CMMREGISTER: begin case expectloc of LOC_FPUREGISTER: begin hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false); location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register); end; LOC_MMREGISTER: begin location.register:=hlcg.getmmregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register,mms_movescalar); end; else internalerror(2003012261); end; end; else internalerror(2002032215); end; end; procedure tcgtypeconvnode.second_cord_to_pointer; begin { this can't happen because constants are already processed in pass 1 } internalerror(47423985); end; procedure tcgtypeconvnode.second_proc_to_procvar; var href: treference; tmpreg: tregister; procvarrectype: trecorddef; procvarselfname: TIDString; begin if tabstractprocdef(resultdef).is_addressonly then begin location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); { only a code pointer? (when taking the address of classtype.method we also only get a code pointer even though the resultdef is a procedure of object, and hence is_addressonly would return false) } if left.location.size = def_cgsize(tabstractprocdef(left.resultdef).address_type) then begin case left.location.loc of LOC_REFERENCE,LOC_CREFERENCE: begin { the procedure symbol is encoded in reference.symbol -> take address } location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register); end; else internalerror(2013031501) end; end else begin { conversion from a procedure of object/nested procvar to plain procvar } case left.location.loc of LOC_REFERENCE,LOC_CREFERENCE: begin location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); { code field is the first one } hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(cprocvardef.getreusableprocaddr(tprocdef(left.resultdef),pc_normal)),cpointerdef.getreusable(resultdef),left.location.reference); hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register); end; LOC_REGISTER,LOC_CREGISTER: begin if target_info.endian=endian_little then location.register:=left.location.register else location.register:=left.location.registerhi; end; else internalerror(2013031502) end; end; end else begin if not tabstractprocdef(left.resultdef).is_addressonly then location_copy(location,left.location) else begin { assigning a global function to a nested procvar -> create tmethodpointer record and set the "frame pointer" to nil } if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then internalerror(2013031503); location_reset_ref(location,LOC_REFERENCE,int_cgsize(resultdef.size),sizeof(pint),[]); tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference); href:=location.reference; if is_nested_pd(tabstractprocdef(resultdef)) then begin procvarrectype:=trecorddef(nestedprocpointertype); procvarselfname:='parentfp'; end else begin procvarrectype:=trecorddef(methodpointertype); procvarselfname:='self'; end; hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(resultdef),cpointerdef.getreusable(procvarrectype),href); tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,tprocdef(left.resultdef),voidcodepointertype,left.location.reference,tmpreg); hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,voidcodepointertype,trecorddef(procvarrectype),tmpreg,'proc',href); { setting the frame pointer to nil is not strictly necessary since the global procedure won't use it, but it can help with debugging } hlcg.g_load_const_field_by_name(current_asmdata.CurrAsmList,trecorddef(procvarrectype),0,procvarselfname,href); end; end; end; procedure Tcgtypeconvnode.second_nil_to_methodprocvar; begin location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.registerhi:=hlcg.getaddressregister(current_asmdata.currasmlist,voidpointertype); hlcg.a_load_const_reg(current_asmdata.currasmlist,voidpointertype,0,location.registerhi); location.register:=hlcg.getaddressregister(current_asmdata.currasmlist,voidcodepointertype); hlcg.a_load_const_reg(current_asmdata.currasmlist,voidcodepointertype,0,location.register); end; procedure tcgtypeconvnode.second_bool_to_int; var newsize: tcgsize; begin secondpass(left); location_copy(location,left.location); newsize:=def_cgsize(resultdef); { byte(bytebool) or word(wordbool) or longint(longbool) must be } { accepted for var parameters and assignments, and must not } { change the ordinal value or value location. } { htypechk.valid_for_assign ensures that such locations with a } { sizeleft.location.size) and ((left.resultdef.size<>resultdef.size) or not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true) else { may differ in sign, e.g. bytebool -> byte } location.size:=newsize; end; procedure tcgtypeconvnode.second_bool_to_bool; begin { we can reuse the conversion already available in bool_to_int to resize the value. But when the size of the new boolean is smaller we need to calculate the value as is done in int_to_bool. This is needed because the bits that define the true status can be outside the limits of the new size and truncating the register can result in a 0 value } if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and { a cbool must be converted to -1/0 } not is_cbool(resultdef) then begin secondpass(left); if (left.location.loc <> left.expectloc) then internalerror(2010081601); location_copy(location,left.location); end else if (resultdef.size=left.resultdef.size) and (is_cbool(resultdef)=is_cbool(left.resultdef)) then second_bool_to_int else begin if (resultdef.size<>left.resultdef.size) then { remove nf_explicit to perform full conversion if boolean sizes are different } exclude(flags, nf_explicit); second_int_to_bool; end; end; procedure tcgtypeconvnode.second_ansistring_to_pchar; var l1 : tasmlabel; hr : treference; begin location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); current_asmdata.getjumplabel(l1); location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef, left.location,location.register); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,0,location.register,l1); { FPC_EMPTYCHAR is a widechar -> 2 bytes } reference_reset(hr,2,[]); hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR',AT_DATA,needs_indirect); current_module.add_extern_asmsym('FPC_EMPTYCHAR',AB_EXTERNAL,AT_DATA); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,cwidechartype,resultdef,hr,location.register); hlcg.a_label(current_asmdata.CurrAsmList,l1); end; procedure tcgtypeconvnode.second_class_to_intf; var l1 : tasmlabel; hd : tobjectdef; ImplIntf : TImplementedInterface; begin l1:=nil; location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); case left.location.loc of LOC_CREFERENCE, LOC_REFERENCE: begin location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register); location_freetemp(current_asmdata.CurrAsmList,left.location); end; LOC_CREGISTER: begin location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register); end; LOC_REGISTER: begin location.register:=left.location.register; hlcg.g_ptrtypecast_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,location.register); end; LOC_CONSTANT: begin location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,left.location.value,location.register); end else internalerror(121120001); end; hd:=tobjectdef(left.resultdef); while assigned(hd) do begin ImplIntf:=find_implemented_interface(hd,tobjectdef(resultdef)); if assigned(ImplIntf) then begin case ImplIntf.IType of etStandard: begin current_asmdata.getjumplabel(l1); hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_EQ,0,location.register,l1); hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,ImplIntf.ioffset,location.register); break; end; else internalerror(200802163); end; end; hd:=hd.childof; end; if hd=nil then internalerror(2002081301); if l1=nil then internalerror(2013120101); cg.a_label(current_asmdata.CurrAsmList,l1); end; procedure tcgtypeconvnode.second_char_to_char; begin internalerror(2007081202); end; procedure tcgtypeconvnode.second_elem_to_openarray; begin { nothing special to do by default } second_nothing; end; procedure tcgtypeconvnode.second_nothing; var newsize : tcgsize; begin { we reuse the old value } location_copy(location,left.location); { Floats should never be returned as LOC_CONSTANT, do the moving to memory before the new size is set. Also when converting from a float to a non-float move to memory first to prevent invalid LOC_(C)MM/FPUREGISTER locations } if ( (resultdef.typ=floatdef) and (location.loc=LOC_CONSTANT) ) or ((resultdef.typ=floatdef) xor (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER,LOC_CMMREGISTER,LOC_MMREGISTER])) then begin { check if the CPU supports direct moves between int and fpu registers and take advantage of it } {$ifdef cpufloatintregmov} if (resultdef.typ<>floatdef) and (location.loc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) then begin location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); cg.a_loadfpu_reg_intreg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register); end else {$endif cpufloatintregmov} hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef); end; { but use the new size, but we don't know the size of all arrays } newsize:=def_cgsize(resultdef); location.size:=newsize; end; {$ifdef TESTOBJEXT2} procedure tcgtypeconvnode.checkobject; begin { no checking by default } end; {$endif TESTOBJEXT2} procedure tcgtypeconvnode.pass_generate_code; begin { the boolean routines can be called with LOC_JUMP and call secondpass themselves in the helper } if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then begin secondpass(left); if codegenerror then exit; end; second_call_helper(convtype); {$ifdef TESTOBJEXT2} { Check explicit conversions to objects pointers !! } if p^.explizit and (p^.resultdef.typ=pointerdef) and (tpointerdef(p^.resultdef).definition.typ=objectdef) and not (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and (cs_check_range in current_settings.localswitches) then checkobject; {$endif TESTOBJEXT2} end; procedure tcgasnode.pass_generate_code; begin secondpass(call); location_copy(location,call.location); end; begin ctypeconvnode := tcgtypeconvnode; casnode := tcgasnode; end.