1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354 |
- {
- 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
- {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
- ,cg64f32
- {$endif not cpu64bitalu and not cpuhighleveltarget}
- ;
- 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);
- { 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 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);
- procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
- implementation
- uses
- cutils,cclasses,
- globals,systems,verbose,
- defutil,
- procinfo,paramgr,
- dbgbase,
- nadd,nbas,ncon,nld,nmem,nutils,
- tgobj,cgobj,hlcgobj,hlcgcpu
- {$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
- {$if defined(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)<first_int_imreg then
- cg.ungetcpuregister(list,location.register);
- if getsupreg(location.registerhi)<first_int_imreg then
- cg.ungetcpuregister(list,location.registerhi);
- end
- else
- {$elseif not defined(cpuhighleveltarget)}
- if location.size in [OS_64,OS_S64] then
- begin
- if getsupreg(location.register64.reglo)<first_int_imreg then
- cg.ungetcpuregister(list,location.register64.reglo);
- if getsupreg(location.register64.reghi)<first_int_imreg then
- cg.ungetcpuregister(list,location.register64.reghi);
- end
- else
- {$endif cpu64bitalu and not cpuhighleveltarget}
- if getsupreg(location.register)<first_int_imreg then
- cg.ungetcpuregister(list,location.register);
- end;
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER:
- begin
- if getsupreg(location.register)<first_fpu_imreg then
- cg.ungetcpuregister(list,location.register);
- end;
- LOC_MMREGISTER,
- LOC_CMMREGISTER :
- begin
- if getsupreg(location.register)<first_mm_imreg then
- cg.ungetcpuregister(list,location.register);
- end;
- LOC_REFERENCE,
- LOC_CREFERENCE :
- begin
- if paramanager.use_fixed_stack then
- location_freetemp(list,location);
- end;
- else
- internalerror(2004110211);
- end;
- end;
- procedure firstcomplex(p : tbinarynode);
- var
- fcl, fcr: longint;
- ncl, ncr: longint;
- begin
- { calculate boolean AND and OR from left to right if it's short boolean evaluted }
- if (p.nodetype in [orn,andn]) and is_boolean(p.left.resultdef) and is_boolean(p.right.resultdef) and doshortbooleval(p) then
- begin
- if nf_swapped in p.flags then
- internalerror(200709253);
- end
- else
- begin
- fcl:=node_resources_fpu(p.left);
- fcr:=node_resources_fpu(p.right);
- ncl:=node_complexity(p.left);
- ncr:=node_complexity(p.right);
- { We swap left and right if
- a) right needs more floating point registers than left, and
- left needs more than 0 floating point registers (if it
- doesn't need any, swapping won't change the floating
- point register pressure)
- b) both left and right need an equal amount of floating
- point registers or right needs no floating point registers,
- and in addition right has a higher complexity than left
- (+- needs more integer registers, but not necessarily)
- }
- if ((fcr>fcl) and
- (fcl>0)) or
- (((fcr=fcl) or
- (fcr=0)) and
- (ncr>ncl)) and
- { if one tree contains nodes being conditionally executated, we cannot swap the trees
- as the other tree might depend on all nodes being executed, this applies for example
- for temp. create nodes with init part, they must be executed else things break, see
- issue #34653
- }
- not(has_conditional_nodes(p.right)) 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
- {$if defined(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;
- {$elseif not defined(cpuhighleveltarget)}
- 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 and not cpuhighleveltarget}
- 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
- internalerror(200308241);
- 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
- { 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;
- else
- internalerror(2007091502);
- 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,l.size);
- cg.a_loadmm_loc_reg(list,l.size,l,reg,nil);
- location_freetemp(list,l);
- location_reset(l,LOC_MMREGISTER,l.size);
- 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);
- {$if defined(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
- {$elseif not defined(cpuhighleveltarget)}
- 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 and not cpuhighleveltarget}
- { 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;
- else
- ;
- end;
- end;
- end;
- procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
- begin
- case loc.loc of
- LOC_CREGISTER:
- begin
- {$if defined(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
- {$elseif not defined(cpuhighleveltarget)}
- 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 and not cpuhighleveltarget}
- 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;
- else
- ;
- end;
- end;
- procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
- procedure set_para_regvar_initial_location;
- var
- paraloc: PCGParalocation;
- loc: tlocation;
- regtype: tregistertype;
- reg,reg2: tregister;
- size,regsize: tcgint;
- begin
- tparavarsym(sym).paraloc[calleeside].get_location(loc);
- size:=tparavarsym(sym).paraloc[calleeside].IntSize;
- paraloc:=tparavarsym(sym).paraloc[calleeside].Location;
- {$if defined(cpu64bitalu)}
- if sym.initialloc.size in [OS_128,OS_S128] then
- {$else}
- if sym.initialloc.size in [OS_64,OS_S64] then
- {$endif defined(cpu64bitalu)}
- begin
- if target_info.endian=endian_little then
- begin
- reg:=sym.initialloc.register;
- reg2:=sym.initialloc.registerhi;
- end
- else
- begin
- reg:=sym.initialloc.registerhi;
- reg2:=sym.initialloc.register;
- end;
- end
- else
- begin
- reg:=sym.initialloc.register;
- reg2:=NR_NO;
- end;
- regtype:=getregtype(reg);
- while true do
- begin
- regsize:=tcgsize2size[reg_cgsize(reg)];
- {$ifndef x86}
- { The size of the stack parameter must be not less than
- the size of the register because the spilling code for
- most CPU targets spills whole registers.
-
- Spilling of sub registers is supported for x86.
- }
- if (paraloc<>nil) and (regsize>tcgsize2size[paraloc^.Size]) then
- break;
- {$endif x86}
- cg.rg[regtype].set_reg_initial_location(reg,loc.reference);
- dec(size,regsize);
- if size<=0 then
- break;
- if paraloc<>nil then
- paraloc:=paraloc^.Next;
- if paraloc<>nil then
- loc.reference.offset:=paraloc^.reference.offset
- else
- inc(loc.reference.offset,regsize);
- {$if defined(cpu8bitalu) or defined(cpu16bitalu)}
- if cg.has_next_reg[getsupreg(reg)] then
- reg:=cg.GetNextReg(reg)
- else
- {$endif}
- begin
- if reg=reg2 then
- internalerror(2020090502);
- reg:=reg2;
- end;
- end;
- end;
- 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) and not defined(cpuhighleveltarget)}
- 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) and not defined(cpuhighleveltarget)}
- 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) and not defined(cpuhighleveltarget)}
- 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;
- {$if defined(cpu64bitalu)}
- if (sym.initialloc.size in [OS_128,OS_S128]) then
- varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi)
- else
- {$elseif not defined(cpuhighleveltarget)}
- if (sym.initialloc.size in [OS_64,OS_S64]) then
- varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi)
- else
- {$endif cpu64bitalu and not cpuhighleveltarget}
- varloc:=tai_varloc.create(sym,sym.initialloc.register);
- list.concat(varloc);
- { Notify the register allocator about memory location of
- the register which holds a value of a stack parameter }
- if (sym.typ=paravarsym) and
- paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then
- set_para_regvar_initial_location;
- end;
- {****************************************************************************
- Entry/Exit
- ****************************************************************************}
- procedure alloc_proc_symbol(pd: tprocdef);
- var
- item: TCmdStrListItem;
- begin
- item:=TCmdStrListItem(pd.aliasnames.first);
- while assigned(item) do
- begin
- current_asmdata.DefineProcAsmSymbol(pd,item.str,pd.needsglobalasmsym);
- item:=TCmdStrListItem(item.next);
- end;
- end;
- procedure release_proc_symbol(pd:tprocdef);
- var
- idx : longint;
- item : TCmdStrListItem;
- begin
- item:=TCmdStrListItem(pd.aliasnames.first);
- while assigned(item) do
- begin
- idx:=current_asmdata.AsmSymbolDict.findindexof(item.str);
- if idx>=0 then
- current_asmdata.AsmSymbolDict.Delete(idx);
- item:=TCmdStrListItem(item.next);
- end;
- end;
- procedure gen_proc_entry_code(list:TAsmList);
- var
- hitemp,
- lotemp, stack_frame_size : longint;
- begin
- { generate call frame marker for dwarf call frame info }
- current_asmdata.asmcfi.start_frame(list);
- { labels etc. for exception frames are inserted here }
- current_procinfo.start_eh(list);
- if current_procinfo.procdef.proctypeoption=potype_proginit then
- current_asmdata.asmcfi.outmost_frame(list);
- { All temps are know, write offsets used for information }
- if (cs_asm_source in current_settings.globalswitches) and
- (current_procinfo.tempstart<>tg.lasttemp) then
- begin
- if tg.direction>0 then
- begin
- lotemp:=current_procinfo.tempstart;
- hitemp:=tg.lasttemp;
- end
- else
- begin
- lotemp:=tg.lasttemp;
- hitemp:=current_procinfo.tempstart;
- end;
- list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
- tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
- end;
- { generate target specific proc entry code }
- stack_frame_size := current_procinfo.calc_stackframe_size;
- if (stack_frame_size <> 0) and
- (po_nostackframe in current_procinfo.procdef.procoptions) then
- message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size));
- hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions));
- end;
- procedure gen_proc_exit_code(list:TAsmList);
- var
- parasize : longint;
- begin
- { c style clearstack does not need to remove parameters from the stack, only the
- return value when it was pushed by arguments }
- if current_procinfo.procdef.proccalloption in clearstack_pocalls then
- begin
- parasize:=0;
- { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para
- which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. }
- if not current_procinfo.procdef.generate_safecall_wrapper and
- paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
- inc(parasize,sizeof(pint));
- end
- else
- begin
- parasize:=current_procinfo.para_stack_size;
- { the parent frame pointer para has to be removed always by the caller in
- case of Delphi-style parent frame pointer passing }
- if (not(paramanager.use_fixed_stack) or (target_info.abi=abi_i386_dynalignedstack)) and
- (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
- dec(parasize,sizeof(pint));
- end;
- { generate target specific proc exit code }
- hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
- { labels etc. for exception frames are inserted here }
- current_procinfo.end_eh(list);
- { release return registers, needed for optimizer }
- if not is_void(current_procinfo.procdef.returndef) then
- paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);
- { end of frame marker for call frame info }
- current_asmdata.asmcfi.end_frame(list);
- end;
- procedure gen_save_used_regs(list:TAsmList);
- begin
- if po_noreturn in current_procinfo.procdef.procoptions then
- exit;
- { Pure assembler routines need to save the registers themselves }
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- cg.g_save_registers(list);
- end;
- procedure gen_restore_used_regs(list:TAsmList);
- begin
- if po_noreturn in current_procinfo.procdef.procoptions then
- exit;
- { Pure assembler routines need to save the registers themselves }
- if (po_assembler in current_procinfo.procdef.procoptions) then
- exit;
- cg.g_restore_registers(list);
- end;
- {****************************************************************************
- Const Data
- ****************************************************************************}
- procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
- var
- i : longint;
- highsym,
- sym : tsym;
- vs : tabstractnormalvarsym;
- ptrdef : tdef;
- isaddr : boolean;
- begin
- for i:=0 to st.SymList.Count-1 do
- begin
- sym:=tsym(st.SymList[i]);
- case sym.typ of
- staticvarsym :
- begin
- vs:=tabstractnormalvarsym(sym);
- { The code in loadnode.pass_generatecode will create the
- LOC_REFERENCE instead for all none register variables. This is
- required because we can't store an asmsymbol in the localloc because
- the asmsymbol is invalid after an unit is compiled. This gives
- problems when this procedure is inlined in another unit (PFV) }
- if vs.is_regvar(false) then
- begin
- vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
- vs.initialloc.size:=def_cgsize(vs.vardef);
- gen_alloc_regvar(list,vs,true);
- hlcg.varsym_set_localloc(list,vs);
- end;
- end;
- paravarsym :
- begin
- vs:=tabstractnormalvarsym(sym);
- { Parameters passed to assembler procedures need to be kept
- in the original location }
- if (po_assembler in pd.procoptions) then
- tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
- { exception filters receive their frame pointer as a parameter }
- else if (pd.proctypeoption=potype_exceptfilter) and
- (vo_is_parentfp in vs.varoptions) then
- begin
- location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
- vs.initialloc.register:=NR_FRAME_POINTER_REG;
- end
- { Unused parameters need to be kept in the original location
- to prevent allocation of registers/resources for them. }
- else if not tparavarsym(vs).is_used and
- (cs_opt_unused_para in current_settings.optimizerswitches) then
- begin
- tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc);
- end
- else
- begin
- { if an open array is used, also its high parameter is used,
- since the hidden high parameters are inserted after the corresponding symbols,
- we can increase the ref. count here }
- if is_open_array(vs.vardef) or is_array_of_const(vs.vardef) then
- begin
- highsym:=get_high_value_sym(tparavarsym(vs));
- if assigned(highsym) then
- inc(highsym.refs);
- end;
- isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,pd.proccalloption);
- if isaddr then
- vs.initialloc.size:=def_cgsize(voidpointertype)
- else
- vs.initialloc.size:=def_cgsize(vs.vardef);
- if vs.is_regvar(isaddr) then
- vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
- else
- begin
- vs.initialloc.loc:=LOC_REFERENCE;
- { Reuse the parameter location for values to are at a single location on the stack }
- if paramanager.param_use_paraloc(tparavarsym(vs).paraloc[calleeside]) then
- begin
- hlcg.paravarsym_set_initialloc_to_paraloc(tparavarsym(vs));
- end
- else
- begin
- if isaddr then
- begin
- ptrdef:=cpointerdef.getreusable(vs.vardef);
- tg.GetLocal(list,ptrdef.size,ptrdef,vs.initialloc.reference)
- end
- else
- tg.GetLocal(list,vs.getsize,tparavarsym(vs).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
- end;
- end;
- end;
- hlcg.varsym_set_localloc(list,vs);
- end;
- localvarsym :
- begin
- vs:=tabstractnormalvarsym(sym);
- if is_vector(vs.vardef) and
- fits_in_mm_register(vs.vardef) then
- vs.initialloc.size:=def_cgmmsize(vs.vardef)
- else
- vs.initialloc.size:=def_cgsize(vs.vardef);
- if ([po_assembler,po_nostackframe] * pd.procoptions = [po_assembler,po_nostackframe]) and
- (vo_is_funcret in vs.varoptions) then
- begin
- paramanager.create_funcretloc_info(pd,calleeside);
- if assigned(pd.funcretloc[calleeside].location^.next) then
- begin
- { can't replace references to "result" with a complex
- location expression inside assembler code }
- location_reset(vs.initialloc,LOC_INVALID,OS_NO);
- end
- else
- pd.funcretloc[calleeside].get_location(vs.initialloc);
- end
- else if (m_delphi in current_settings.modeswitches) and
- (po_assembler in pd.procoptions) and
- (vo_is_funcret in vs.varoptions) and
- (vs.refs=0) then
- begin
- { not referenced, so don't allocate. Use dummy to }
- { avoid ie's later on because of LOC_INVALID }
- vs.initialloc.loc:=LOC_REGISTER;
- vs.initialloc.size:=OS_INT;
- vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
- end
- else if vs.is_regvar(false) then
- begin
- vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
- gen_alloc_regvar(list,vs,true);
- end
- else
- begin
- vs.initialloc.loc:=LOC_REFERENCE;
- tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
- end;
- hlcg.varsym_set_localloc(list,vs);
- end;
- else
- ;
- end;
- end;
- end;
- procedure add_regvars(var rv: tusedregvars; const location: tlocation);
- begin
- case location.loc of
- LOC_CREGISTER:
- {$if defined(cpu64bitalu)}
- if location.size in [OS_128,OS_S128] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register128.reglo));
- rv.intregvars.addnodup(getsupreg(location.register128.reghi));
- end
- else
- {$elseif defined(cpu32bitalu)}
- if location.size in [OS_64,OS_S64] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register64.reglo));
- rv.intregvars.addnodup(getsupreg(location.register64.reghi));
- end
- else
- {$elseif defined(cpu16bitalu)}
- if location.size in [OS_64,OS_S64] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register64.reglo));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo)));
- rv.intregvars.addnodup(getsupreg(location.register64.reghi));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi)));
- end
- else
- if location.size in [OS_32,OS_S32] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
- end
- else
- {$elseif defined(cpu8bitalu)}
- if location.size in [OS_64,OS_S64] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register64.reglo));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo)));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo))));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo)))));
- rv.intregvars.addnodup(getsupreg(location.register64.reghi));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi)));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi))));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi)))));
- end
- else
- if location.size in [OS_32,OS_S32] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register))));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register)))));
- end
- else
- if location.size in [OS_16,OS_S16] then
- begin
- rv.intregvars.addnodup(getsupreg(location.register));
- rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
- end
- else
- {$endif}
- if getregtype(location.register)=R_INTREGISTER then
- rv.intregvars.addnodup(getsupreg(location.register))
- else
- rv.addrregvars.addnodup(getsupreg(location.register));
- LOC_CFPUREGISTER:
- rv.fpuregvars.addnodup(getsupreg(location.register));
- LOC_CMMREGISTER:
- rv.mmregvars.addnodup(getsupreg(location.register));
- else
- ;
- end;
- end;
- function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
- var
- rv: pusedregvars absolute arg;
- begin
- case (n.nodetype) of
- temprefn:
- { We only have to synchronise a tempnode before a loop if it is }
- { not created inside the loop, and only synchronise after the }
- { loop if it's not destroyed inside the loop. If it's created }
- { before the loop and not yet destroyed, then before the loop }
- { is secondpassed tempinfo^.valid will be true, and we get the }
- { correct registers. If it's not destroyed inside the loop, }
- { then after the loop has been secondpassed tempinfo^.valid }
- { be true and we also get the right registers. In other cases, }
- { tempinfo^.valid will be false and so we do not add }
- { unnecessary registers. This way, we don't have to look at }
- { tempcreate and tempdestroy nodes to get this info (JM) }
- if (ti_valid in ttemprefnode(n).tempflags) then
- add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
- loadn:
- if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
- add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
- loadparentfpn:
- if current_procinfo.procdef.parast.symtablelevel>tloadparentfpnode(n).parentpd.parast.symtablelevel then
- add_regvars(rv^,tparavarsym(current_procinfo.procdef.parentfpsym).localloc);
- vecn:
- begin
- { range checks sometimes need the high parameter }
- if (cs_check_range in current_settings.localswitches) and
- (is_open_array(tvecnode(n).left.resultdef) or
- is_array_of_const(tvecnode(n).left.resultdef)) and
- not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
- add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
- end;
- else
- ;
- end;
- result := fen_true;
- end;
- procedure get_used_regvars(n: tnode; var rv: tusedregvars);
- begin
- foreachnodestatic(n,@do_get_used_regvars,@rv);
- end;
- (*
- See comments at declaration of pusedregvarscommon
- function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
- var
- rv: pusedregvarscommon absolute arg;
- begin
- if (n.nodetype = loadn) and
- (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
- with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
- case loc of
- LOC_CREGISTER:
- { if not yet encountered in this node tree }
- if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
- { but nevertheless already encountered somewhere }
- not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
- { then it's a regvar used in two or more node trees }
- rv^.commonregvars.intregvars.addnodup(getsupreg(register));
- LOC_CFPUREGISTER:
- if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
- not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
- rv^.commonregvars.intregvars.addnodup(getsupreg(register));
- LOC_CMMREGISTER:
- if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
- not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
- rv^.commonregvars.intregvars.addnodup(getsupreg(register));
- end;
- result := fen_true;
- end;
- procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
- begin
- rv.myregvars.intregvars.clear;
- rv.myregvars.fpuregvars.clear;
- rv.myregvars.mmregvars.clear;
- foreachnodestatic(n,@do_get_used_regvars_common,@rv);
- end;
- *)
- procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
- var
- count: longint;
- begin
- for count := 1 to rv.intregvars.length do
- cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
- for count := 1 to rv.addrregvars.length do
- cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE));
- for count := 1 to rv.fpuregvars.length do
- cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
- for count := 1 to rv.mmregvars.length do
- cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
- end;
- procedure gen_free_symtable(list:TAsmList;st:TSymtable);
- var
- i : longint;
- sym : tsym;
- begin
- for i:=0 to st.SymList.Count-1 do
- begin
- sym:=tsym(st.SymList[i]);
- if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
- begin
- with tabstractnormalvarsym(sym) do
- begin
- { Note: We need to keep the data available in memory
- for the sub procedures that can access local data
- in the parent procedures }
- case localloc.loc of
- LOC_CREGISTER :
- if (pi_has_label in current_procinfo.flags) then
- {$if defined(cpu64bitalu)}
- if localloc.size in [OS_128,OS_S128] then
- begin
- cg.a_reg_sync(list,localloc.register128.reglo);
- cg.a_reg_sync(list,localloc.register128.reghi);
- end
- else
- {$elseif defined(cpu32bitalu)}
- if localloc.size in [OS_64,OS_S64] then
- begin
- cg.a_reg_sync(list,localloc.register64.reglo);
- cg.a_reg_sync(list,localloc.register64.reghi);
- end
- else
- {$elseif defined(cpu16bitalu)}
- if localloc.size in [OS_64,OS_S64] then
- begin
- cg.a_reg_sync(list,localloc.register64.reglo);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo));
- cg.a_reg_sync(list,localloc.register64.reghi);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi));
- end
- else
- if localloc.size in [OS_32,OS_S32] then
- begin
- cg.a_reg_sync(list,localloc.register);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
- end
- else
- {$elseif defined(cpu8bitalu)}
- if localloc.size in [OS_64,OS_S64] then
- begin
- cg.a_reg_sync(list,localloc.register64.reglo);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo)));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo))));
- cg.a_reg_sync(list,localloc.register64.reghi);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi)));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi))));
- end
- else
- if localloc.size in [OS_32,OS_S32] then
- begin
- cg.a_reg_sync(list,localloc.register);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register)));
- cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register))));
- end
- else
- if localloc.size in [OS_16,OS_S16] then
- begin
- cg.a_reg_sync(list,localloc.register);
- cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
- end
- else
- {$endif}
- cg.a_reg_sync(list,localloc.register);
- LOC_CFPUREGISTER,
- LOC_CMMREGISTER,
- LOC_CMMXREGISTER:
- if (pi_has_label in current_procinfo.flags) then
- cg.a_reg_sync(list,localloc.register);
- LOC_REFERENCE :
- begin
- { can't free the result, because we load it after
- this call into the function result location
- (gets freed in thlcgobj.gen_load_return_value();) }
- if (typ in [localvarsym,paravarsym]) and
- (([vo_is_funcret,vo_is_result]*varoptions)=[]) and
- ((current_procinfo.procdef.proctypeoption<>potype_constructor) or
- not(vo_is_self in varoptions)) then
- tg.Ungetlocal(list,localloc.reference);
- end;
- { function results in pure assembler routines }
- LOC_REGISTER,
- LOC_FPUREGISTER,
- LOC_MMREGISTER,
- { empty parameter }
- LOC_VOID,
- { global variables in memory and typed constants don't get a location assigned,
- and neither does an unused $result variable in pure assembler routines }
- LOC_INVALID:
- ;
- else
- internalerror(2019050538);
- end;
- end;
- end;
- end;
- end;
- function getprocalign : shortint;
- begin
- { gprof uses 16 byte granularity }
- if (cs_profile in current_settings.moduleswitches) then
- result:=16
- else
- result:=current_settings.alignment.procalign;
- end;
- procedure gen_load_frame_for_exceptfilter(list : TAsmList);
- var
- para: tparavarsym;
- begin
- para:=tparavarsym(current_procinfo.procdef.paras[0]);
- if not (vo_is_parentfp in para.varoptions) then
- InternalError(201201142);
- if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
- (para.paraloc[calleeside].location^.next<>nil) then
- InternalError(201201143);
- cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,para.paraloc[calleeside].location^.register,
- NR_FRAME_POINTER_REG);
- end;
- end.
|