{ Copyright (c) 1998-2002 by Florian Klaempfl Helper routines for all code generators 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 ncgutil; {$i fpcdefs.inc} interface uses node, globtype, cpubase,cgbase,parabase,cgutils, aasmbase,aasmtai,aasmdata,aasmcpu, symconst,symbase,symdef,symsym,symtype {$ifndef cpu64bitalu} ,cg64f32 {$endif not cpu64bitalu} ; type tloadregvars = (lr_dont_load_regvars, lr_load_regvars); pusedregvars = ^tusedregvars; tusedregvars = record intregvars, addrregvars, fpuregvars, mmregvars: Tsuperregisterworklist; end; { Not used currently, implemented because I thought we had to synchronise around if/then/else as well, but not needed. May still be useful for SSA once we get around to implementing that (JM) pusedregvarscommon = ^tusedregvarscommon; tusedregvarscommon = record allregvars, commonregvars, myregvars: tusedregvars; end; } procedure firstcomplex(p : tbinarynode); procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean); { loads a cgpara into a tlocation; assumes that loc.loc is already initialised } procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); { allocate registers for a tlocation; assumes that loc.loc is already set to LOC_CREGISTER/LOC_CFPUREGISTER/... } procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef); procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint); procedure alloc_proc_symbol(pd: tprocdef); procedure release_proc_symbol(pd:tprocdef); procedure gen_proc_entry_code(list:TAsmList); procedure gen_proc_exit_code(list:TAsmList); procedure gen_save_used_regs(list:TAsmList); procedure gen_restore_used_regs(list:TAsmList); procedure gen_load_para_value(list:TAsmList); procedure get_used_regvars(n: tnode; var rv: tusedregvars); { adds the regvars used in n and its children to rv.allregvars, those which were already in rv.allregvars to rv.commonregvars and uses rv.myregvars as scratch (so that two uses of the same regvar in a single tree to make it appear in commonregvars). Useful to find out which regvars are used in two different node trees e.g. in the "else" and "then" path, or in various case blocks } // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon); procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars); procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable); procedure gen_free_symtable(list:TAsmList;st:TSymtable); procedure location_free(list: TAsmList; const location : TLocation); function getprocalign : shortint; procedure gen_load_frame_for_exceptfilter(list : TAsmList); implementation uses cutils,cclasses, globals,systems,verbose, defutil, procinfo,paramgr, dbgbase, nbas,ncon,nld,nmem,nutils, tgobj,cgobj,hlcgobj,hlcgcpu {$ifdef llvm} { override create_hlcodegen from hlcgcpu } , hlcgllvm {$endif} {$ifdef powerpc} , cpupi {$endif} {$ifdef powerpc64} , cpupi {$endif} {$ifdef SUPPORT_MMX} , cgx86 {$endif SUPPORT_MMX} ; {***************************************************************************** Misc Helpers *****************************************************************************} {$if first_mm_imreg = 0} {$WARN 4044 OFF} { Comparison might be always false ... } {$endif} procedure location_free(list: TAsmList; const location : TLocation); begin case location.loc of LOC_VOID: ; LOC_REGISTER, LOC_CREGISTER: begin {$ifdef cpu64bitalu} { x86-64 system v abi: structs with up to 16 bytes are returned in registers } if location.size in [OS_128,OS_S128] then begin if getsupreg(location.register)fcl) and (fcl>0)) or (((fcr=fcl) or (fcr=0)) and (ncr>ncl)) then p.swapleftright end; end; procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); { produces jumps to true respectively false labels using boolean expressions } var opsize : tcgsize; storepos : tfileposinfo; tmpreg : tregister; begin if nf_error in p.flags then exit; storepos:=current_filepos; current_filepos:=p.fileinfo; if is_boolean(p.resultdef) then begin if is_constboolnode(p) then begin if Tordconstnode(p).value.uvalue<>0 then cg.a_jmp_always(list,truelabel) else cg.a_jmp_always(list,falselabel) end else begin opsize:=def_cgsize(p.resultdef); case p.location.loc of LOC_SUBSETREG,LOC_CSUBSETREG: begin if p.location.sreg.bitlen=1 then begin tmpreg:=cg.getintregister(list,p.location.sreg.subsetregsize); hlcg.a_op_const_reg_reg(list,OP_AND,cgsize_orddef(p.location.sreg.subsetregsize),1 shl p.location.sreg.startbit,p.location.sreg.subsetreg,tmpreg); end else begin tmpreg:=cg.getintregister(list,OS_INT); hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg); end; cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel); cg.a_jmp_always(list,falselabel); end; LOC_SUBSETREF,LOC_CSUBSETREF: begin if (p.location.sref.bitindexreg=NR_NO) and (p.location.sref.bitlen=1) then begin tmpreg:=cg.getintregister(list,OS_INT); hlcg.a_load_ref_reg(list,u8inttype,osuinttype,p.location.sref.ref,tmpreg); if target_info.endian=endian_big then hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl (8-(p.location.sref.startbit+1)),tmpreg,tmpreg) else hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl p.location.sref.startbit,tmpreg,tmpreg); end else begin tmpreg:=cg.getintregister(list,OS_INT); hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg); end; cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel); cg.a_jmp_always(list,falselabel); end; LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE : begin {$ifdef cpu64bitalu} if opsize in [OS_128,OS_S128] then begin hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true); tmpreg:=cg.getintregister(list,OS_64); cg.a_op_reg_reg_reg(list,OP_OR,OS_64,p.location.register128.reglo,p.location.register128.reghi,tmpreg); location_reset(p.location,LOC_REGISTER,OS_64); p.location.register:=tmpreg; opsize:=OS_64; end; {$else cpu64bitalu} if opsize in [OS_64,OS_S64] then begin hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true); tmpreg:=cg.getintregister(list,OS_32); cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg); location_reset(p.location,LOC_REGISTER,OS_32); p.location.register:=tmpreg; opsize:=OS_32; end; {$endif cpu64bitalu} cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel); cg.a_jmp_always(list,falselabel); end; LOC_JUMP: begin if truelabel<>p.location.truelabel then begin cg.a_label(list,p.location.truelabel); cg.a_jmp_always(list,truelabel); end; if falselabel<>p.location.falselabel then begin cg.a_label(list,p.location.falselabel); cg.a_jmp_always(list,falselabel); end; end; {$ifdef cpuflags} LOC_FLAGS : begin cg.a_jmp_flags(list,p.location.resflags,truelabel); cg.a_reg_dealloc(list,NR_DEFAULTFLAGS); cg.a_jmp_always(list,falselabel); end; {$endif cpuflags} else begin printnode(output,p); internalerror(200308241); end; end; end; location_reset_jump(p.location,truelabel,falselabel); end else internalerror(200112305); current_filepos:=storepos; end; (* This code needs fixing. It is not safe to use rgint; on the m68000 it would be rgaddr. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); begin case t.loc of LOC_REGISTER: begin { can't be a regvar, since it would be LOC_CREGISTER then } exclude(regs,getsupreg(t.register)); if t.register64.reghi<>NR_NO then exclude(regs,getsupreg(t.register64.reghi)); end; LOC_CREFERENCE,LOC_REFERENCE: begin if not(cs_opt_regvar in current_settings.optimizerswitches) or (getsupreg(t.reference.base) in cg.rgint.usableregs) then exclude(regs,getsupreg(t.reference.base)); if not(cs_opt_regvar in current_settings.optimizerswitches) or (getsupreg(t.reference.index) in cg.rgint.usableregs) then exclude(regs,getsupreg(t.reference.index)); end; end; end; *) {***************************************************************************** TLocation *****************************************************************************} procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint); var tmpreg: tregister; begin if (setbase<>0) then begin if not(l.loc in [LOC_REGISTER,LOC_CREGISTER]) then internalerror(2007091502); { subtract the setbase } case l.loc of LOC_CREGISTER: begin tmpreg := hlcg.getintregister(list,opdef); hlcg.a_op_const_reg_reg(list,OP_SUB,opdef,setbase,l.register,tmpreg); l.loc:=LOC_REGISTER; l.register:=tmpreg; end; LOC_REGISTER: begin hlcg.a_op_const_reg(list,OP_SUB,opdef,setbase,l.register); end; end; end; end; procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); var reg : tregister; begin if (l.loc<>LOC_MMREGISTER) and ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then begin reg:=cg.getmmregister(list,OS_VECTOR); cg.a_loadmm_loc_reg(list,OS_VECTOR,l,reg,nil); location_freetemp(list,l); location_reset(l,LOC_MMREGISTER,OS_VECTOR); l.register:=reg; end; end; procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean); begin l.size:=def_cgsize(def); if (def.typ=floatdef) and not(cs_fp_emulation in current_settings.moduleswitches) then begin if use_vectorfpu(def) then begin if constant then location_reset(l,LOC_CMMREGISTER,l.size) else location_reset(l,LOC_MMREGISTER,l.size); l.register:=cg.getmmregister(list,l.size); end else begin if constant then location_reset(l,LOC_CFPUREGISTER,l.size) else location_reset(l,LOC_FPUREGISTER,l.size); l.register:=cg.getfpuregister(list,l.size); end; end else begin if constant then location_reset(l,LOC_CREGISTER,l.size) else location_reset(l,LOC_REGISTER,l.size); {$ifdef cpu64bitalu} if l.size in [OS_128,OS_S128,OS_F128] then begin l.register128.reglo:=cg.getintregister(list,OS_64); l.register128.reghi:=cg.getintregister(list,OS_64); end else {$else cpu64bitalu} if l.size in [OS_64,OS_S64,OS_F64] then begin l.register64.reglo:=cg.getintregister(list,OS_32); l.register64.reghi:=cg.getintregister(list,OS_32); end else {$endif cpu64bitalu} { Note: for widths of records (and maybe objects, classes, etc.) an address register could be set here, but that is later changed to an intregister neverthless when in the tcgassignmentnode thlcgobj.maybe_change_load_node_reg is called for the temporary node; so the workaround for now is to fix the symptoms... } l.register:=hlcg.getregisterfordef(list,def); end; end; {**************************************************************************** Init/Finalize Code ****************************************************************************} { generates the code for incrementing the reference count of parameters and initialize out parameters } procedure init_paras(p:TObject;arg:pointer); var href : treference; hsym : tparavarsym; eldef : tdef; list : TAsmList; needs_inittable : boolean; begin list:=TAsmList(arg); if (tsym(p).typ=paravarsym) then begin needs_inittable:=is_managed_type(tparavarsym(p).vardef); if not needs_inittable then exit; case tparavarsym(p).varspez of vs_value : begin { variants are already handled by the call to fpc_variant_copy_overwrite if they are passed by reference } if not((tparavarsym(p).vardef.typ=variantdef) and paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then begin hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href, is_open_array(tparavarsym(p).vardef) or ((target_info.system in systems_caller_copy_addr_value_para) and paramanager.push_addr_param(vs_value,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)), sizeof(pint)); if is_open_array(tparavarsym(p).vardef) then begin { open arrays do not contain correct element count in their rtti, the actual count must be passed separately. } hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); eldef:=tarraydef(tparavarsym(p).vardef).elementdef; if not assigned(hsym) then internalerror(201003031); hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_addref_array'); end else hlcg.g_incrrefcount(list,tparavarsym(p).vardef,href); end; end; vs_out : begin { we have no idea about the alignment at the callee side, and the user also cannot specify "unaligned" here, so assume worst case } hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1); if is_open_array(tparavarsym(p).vardef) then begin hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); eldef:=tarraydef(tparavarsym(p).vardef).elementdef; if not assigned(hsym) then internalerror(201103033); hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_initialize_array'); end else hlcg.g_initialize(list,tparavarsym(p).vardef,href); end; end; end; end; procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef); begin case loc.loc of LOC_CREGISTER: begin {$ifdef cpu64bitalu} if loc.size in [OS_128,OS_S128] then begin loc.register128.reglo:=cg.getintregister(list,OS_64); loc.register128.reghi:=cg.getintregister(list,OS_64); end else {$else cpu64bitalu} if loc.size in [OS_64,OS_S64] then begin loc.register64.reglo:=cg.getintregister(list,OS_32); loc.register64.reghi:=cg.getintregister(list,OS_32); end else {$endif cpu64bitalu} if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then loc.register:=hlcg.getaddressregister(list,def) else loc.register:=cg.getintregister(list,loc.size); end; LOC_CFPUREGISTER: begin loc.register:=cg.getfpuregister(list,loc.size); end; LOC_CMMREGISTER: begin loc.register:=cg.getmmregister(list,loc.size); end; end; end; procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean); var usedef: tdef; varloc: tai_varloc; begin if allocreg then begin if sym.typ=paravarsym then usedef:=tparavarsym(sym).paraloc[calleeside].def else usedef:=sym.vardef; gen_alloc_regloc(list,sym.initialloc,usedef); end; if (pi_has_label in current_procinfo.flags) then begin { Allocate register already, to prevent first allocation to be inside a loop } {$if defined(cpu64bitalu)} if sym.initialloc.size in [OS_128,OS_S128] then begin cg.a_reg_sync(list,sym.initialloc.register128.reglo); cg.a_reg_sync(list,sym.initialloc.register128.reghi); end else {$elseif defined(cpu32bitalu)} if sym.initialloc.size in [OS_64,OS_S64] then begin cg.a_reg_sync(list,sym.initialloc.register64.reglo); cg.a_reg_sync(list,sym.initialloc.register64.reghi); end else {$elseif defined(cpu16bitalu)} if sym.initialloc.size in [OS_64,OS_S64] then begin cg.a_reg_sync(list,sym.initialloc.register64.reglo); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo)); cg.a_reg_sync(list,sym.initialloc.register64.reghi); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi)); end else if sym.initialloc.size in [OS_32,OS_S32] then begin cg.a_reg_sync(list,sym.initialloc.register); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); end else {$elseif defined(cpu8bitalu)} if sym.initialloc.size in [OS_64,OS_S64] then begin cg.a_reg_sync(list,sym.initialloc.register64.reglo); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo)); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo))); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo)))); cg.a_reg_sync(list,sym.initialloc.register64.reghi); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi)); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi))); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi)))); end else if sym.initialloc.size in [OS_32,OS_S32] then begin cg.a_reg_sync(list,sym.initialloc.register); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register))); cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register)))); end else if sym.initialloc.size in [OS_16,OS_S16] then begin cg.a_reg_sync(list,sym.initialloc.register); cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); end else {$endif} cg.a_reg_sync(list,sym.initialloc.register); end; {$ifdef cpu64bitalu} if (sym.initialloc.size in [OS_128,OS_S128]) then varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi) {$else cpu64bitalu} if (sym.initialloc.size in [OS_64,OS_S64]) then varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi) {$endif cpu64bitalu} else varloc:=tai_varloc.create(sym,sym.initialloc.register); list.concat(varloc); end; procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); procedure unget_para(const paraloc:TCGParaLocation); begin case paraloc.loc of LOC_REGISTER : begin if getsupreg(paraloc.register)LOC_REFERENCE) or assigned(paraloc^.next) then internalerror(2005013010); cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); inc(href.offset,sizeleft); sizeleft:=0; end else begin { the min(...) call ensures that we do not store more than place is left as paraloc^.size could be bigger than destloc.size of a parameter occupies a full register and as on big endian system the parameters might be left aligned, we have to work with the full register size for paraloc^.size } if tcgsize2size[destloc.size]<>0 then loadsize:=min(min(tcgsize2size[paraloc^.size],tcgsize2size[destloc.size]),sizeleft) else loadsize:=min(tcgsize2size[paraloc^.size],sizeleft); cg.a_load_cgparaloc_ref(list,paraloc^,href,loadsize,destloc.reference.alignment); inc(href.offset,loadsize); dec(sizeleft,loadsize); end; unget_para(paraloc^); paraloc:=paraloc^.next; end; end; end; LOC_REGISTER, LOC_CREGISTER : begin {$ifdef cpu64bitalu} if (para.size in [OS_128,OS_S128,OS_F128]) and ({ in case of fpu emulation, or abi's that pass fpu values via integer registers } (vardef.typ=floatdef) or is_methodpointer(vardef) or is_record(vardef)) then begin case paraloc^.loc of LOC_REGISTER, LOC_MMREGISTER: begin if not assigned(paraloc^.next) then internalerror(200410104); if (target_info.endian=ENDIAN_BIG) then begin { paraloc^ -> high paraloc^.next -> low } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { reg->reg, alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8); end else begin { paraloc^ -> low paraloc^.next -> high } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8); end; end; LOC_REFERENCE: begin gen_alloc_regloc(list,destloc,vardef); reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,paraloc^.reference.temppos,para.alignment,[]); cg128.a_load128_ref_reg(list,href,destloc.register128); unget_para(paraloc^); end; else internalerror(2012090607); end end else {$else cpu64bitalu} if (para.size in [OS_64,OS_S64,OS_F64]) and (is_64bit(vardef) or { in case of fpu emulation, or abi's that pass fpu values via integer registers } (vardef.typ=floatdef) or is_methodpointer(vardef) or is_record(vardef)) then begin case paraloc^.loc of LOC_REGISTER: begin case para.locations_count of {$if defined(cpu8bitalu)} { 8 paralocs? } 8: if (target_info.endian=ENDIAN_BIG) then begin { is there any big endian 8 bit ALU/16 bit Addr CPU? } internalerror(2015041003); { paraloc^ -> high paraloc^.next^.next^.next^.next -> low } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { reg->reg, alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),1); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1); unget_para(paraloc^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),1); unget_para(paraloc^.next^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1); end else begin { paraloc^ -> low paraloc^.next^.next^.next^.next -> high } curparaloc:=paraloc; unget_para(curparaloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2); unget_para(curparaloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reglo),1); unget_para(curparaloc^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo)),1); unget_para(curparaloc^.next^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo))),1); curparaloc:=paraloc^.next^.next^.next^.next; unget_para(curparaloc^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2); unget_para(curparaloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reghi),1); unget_para(curparaloc^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi)),1); unget_para(curparaloc^.next^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi))),1); end; {$endif defined(cpu8bitalu)} {$if defined(cpu16bitalu) or defined(cpu8bitalu)} { 4 paralocs? } 4: if (target_info.endian=ENDIAN_BIG) then begin { paraloc^ -> high paraloc^.next^.next -> low } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { reg->reg, alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),2); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2); unget_para(paraloc^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),2); unget_para(paraloc^.next^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2); end else begin { paraloc^ -> low paraloc^.next^.next -> high } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,cg.GetNextReg(destloc.register64.reglo),2); unget_para(paraloc^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2); unget_para(paraloc^.next^.next^.next^); cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,cg.GetNextReg(destloc.register64.reghi),2); end; {$endif defined(cpu16bitalu) or defined(cpu8bitalu)} 2: if (target_info.endian=ENDIAN_BIG) then begin { paraloc^ -> high paraloc^.next -> low } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { reg->reg, alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4); end else begin { paraloc^ -> low paraloc^.next -> high } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4); unget_para(paraloc^.next^); cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4); end; else { unexpected number of paralocs } internalerror(200410104); end; end; LOC_REFERENCE: begin gen_alloc_regloc(list,destloc,vardef); reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,paraloc^.reference.temppos,para.alignment,[]); cg64.a_load64_ref_reg(list,href,destloc.register64); unget_para(paraloc^); end; else internalerror(2005101501); end end else {$endif cpu64bitalu} begin if assigned(paraloc^.next) then begin if (destloc.size in [OS_PAIR,OS_SPAIR]) and (para.Size in [OS_PAIR,OS_SPAIR]) then begin unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint)); unget_para(paraloc^.Next^); {$if defined(cpu16bitalu) or defined(cpu8bitalu)} cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint)); {$else} cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint)); {$endif} end {$if defined(cpu8bitalu)} else if (destloc.size in [OS_32,OS_S32]) and (para.Size in [OS_32,OS_S32]) then begin unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint)); unget_para(paraloc^.Next^); cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint)); unget_para(paraloc^.Next^.Next^); cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(destloc.register)),sizeof(aint)); unget_para(paraloc^.Next^.Next^.Next^); cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register))),sizeof(aint)); end {$endif defined(cpu8bitalu)} else begin { this can happen if a parameter is spread over multiple paralocs, e.g. if a record with two single fields must be passed in two single precision registers } { does it fit in the register of destloc? } sizeleft:=para.intsize; if sizeleft<>vardef.size then internalerror(2014122806); if sizeleft<>tcgsize2size[destloc.size] then internalerror(200410105); { store everything first to memory, then load it in destloc } tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref); gen_alloc_regloc(list,destloc,vardef); while sizeleft>0 do begin if not assigned(paraloc) then internalerror(2014122807); unget_para(paraloc^); cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft)); if (paraloc^.size=OS_NO) and assigned(paraloc^.next) then internalerror(2014122805); inc(tempref.offset,tcgsize2size[paraloc^.size]); dec(sizeleft,tcgsize2size[paraloc^.size]); paraloc:=paraloc^.next; end; dec(tempref.offset,para.intsize); cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register); tg.ungettemp(list,tempref); end; end else begin unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { we can't directly move regular registers into fpu registers } if getregtype(paraloc^.register)=R_FPUREGISTER then begin { store everything first to memory, then load it in destloc } tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref); cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment); cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register); tg.ungettemp(list,tempref); end else cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint)); end; end; end; LOC_FPUREGISTER, LOC_CFPUREGISTER : begin {$ifdef mips} if (destloc.size = paraloc^.Size) and (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then begin unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment); end else if (destloc.size = OS_F32) and (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then begin gen_alloc_regloc(list,destloc,vardef); unget_para(paraloc^); list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register)); end { TODO: Produces invalid code, needs fixing together with regalloc setup. } { else if (destloc.size = OS_F64) and (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then begin gen_alloc_regloc(list,destloc,vardef); tmpreg:=destloc.register; unget_para(paraloc^); list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg)); setsupreg(tmpreg,getsupreg(tmpreg)+1); unget_para(paraloc^.next^); list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg)); end } else begin sizeleft := TCGSize2Size[destloc.size]; tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref); href:=tempref; while assigned(paraloc) do begin unget_para(paraloc^); cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); inc(href.offset,TCGSize2Size[paraloc^.size]); dec(sizeleft,TCGSize2Size[paraloc^.size]); paraloc:=paraloc^.next; end; gen_alloc_regloc(list,destloc,vardef); cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register); tg.UnGetTemp(list,tempref); end; {$else mips} {$if defined(sparc) or defined(arm)} { Arm and Sparc passes floats in int registers, when loading to fpu register we need a temp } sizeleft := TCGSize2Size[destloc.size]; tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref); href:=tempref; while assigned(paraloc) do begin unget_para(paraloc^); cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); inc(href.offset,TCGSize2Size[paraloc^.size]); dec(sizeleft,TCGSize2Size[paraloc^.size]); paraloc:=paraloc^.next; end; gen_alloc_regloc(list,destloc,vardef); cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register); tg.UnGetTemp(list,tempref); {$else defined(sparc) or defined(arm)} unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { from register to register -> alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); if assigned(paraloc^.next) then internalerror(200410109); {$endif defined(sparc) or defined(arm)} {$endif mips} end; LOC_MMREGISTER, LOC_CMMREGISTER : begin {$ifndef cpu64bitalu} { ARM vfp floats are passed in integer registers } if (para.size=OS_F64) and (paraloc^.size in [OS_32,OS_S32]) and use_vectorfpu(vardef) then begin { we need 2x32bit reg } if not assigned(paraloc^.next) or assigned(paraloc^.next^.next) then internalerror(2009112421); unget_para(paraloc^.next^); case paraloc^.next^.loc of LOC_REGISTER: tempreg:=paraloc^.next^.register; LOC_REFERENCE: begin tempreg:=cg.getintregister(list,OS_32); cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4); end; else internalerror(2012051301); end; { don't free before the above, because then the getintregister could reallocate this register and overwrite it } unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); if (target_info.endian=endian_big) then { paraloc^ -> high paraloc^.next -> low } reg64:=joinreg64(tempreg,paraloc^.register) else reg64:=joinreg64(paraloc^.register,tempreg); cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register); end else {$endif not cpu64bitalu} begin if not assigned(paraloc^.next) then begin unget_para(paraloc^); gen_alloc_regloc(list,destloc,vardef); { from register to register -> alignment is irrelevant } cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); end else begin internalerror(200410108); end; { data could come in two memory locations, for now we simply ignore the sanity check (FK) if assigned(paraloc^.next) then internalerror(200410108); } end; end; else internalerror(2010052903); end; end; procedure gen_load_para_value(list:TAsmList); procedure get_para(const paraloc:TCGParaLocation); begin case paraloc.loc of LOC_REGISTER : begin if getsupreg(paraloc.register)