ncgutil.pas 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Helper routines for all code generators
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ncgutil;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. node,
  22. globtype,
  23. cpubase,cgbase,parabase,cgutils,
  24. aasmbase,aasmtai,aasmdata,aasmcpu,
  25. symconst,symbase,symdef,symsym,symtype
  26. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  27. ,cg64f32
  28. {$endif not cpu64bitalu and not cpuhighleveltarget}
  29. ;
  30. type
  31. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  32. pusedregvars = ^tusedregvars;
  33. tusedregvars = record
  34. intregvars, addrregvars, fpuregvars, mmregvars: Tsuperregisterworklist;
  35. end;
  36. {
  37. Not used currently, implemented because I thought we had to
  38. synchronise around if/then/else as well, but not needed. May
  39. still be useful for SSA once we get around to implementing
  40. that (JM)
  41. pusedregvarscommon = ^tusedregvarscommon;
  42. tusedregvarscommon = record
  43. allregvars, commonregvars, myregvars: tusedregvars;
  44. end;
  45. }
  46. procedure firstcomplex(p : tbinarynode);
  47. procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel);
  48. // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  49. procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  50. procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean);
  51. { allocate registers for a tlocation; assumes that loc.loc is already
  52. set to LOC_CREGISTER/LOC_CFPUREGISTER/... }
  53. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
  54. procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint);
  55. procedure alloc_proc_symbol(pd: tprocdef);
  56. procedure release_proc_symbol(pd:tprocdef);
  57. procedure gen_proc_entry_code(list:TAsmList);
  58. procedure gen_proc_exit_code(list:TAsmList);
  59. procedure gen_save_used_regs(list:TAsmList);
  60. procedure gen_restore_used_regs(list:TAsmList);
  61. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  62. { adds the regvars used in n and its children to rv.allregvars,
  63. those which were already in rv.allregvars to rv.commonregvars and
  64. uses rv.myregvars as scratch (so that two uses of the same regvar
  65. in a single tree to make it appear in commonregvars). Useful to
  66. find out which regvars are used in two different node trees
  67. e.g. in the "else" and "then" path, or in various case blocks }
  68. // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  69. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  70. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  71. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  72. procedure location_free(list: TAsmList; const location : TLocation);
  73. function getprocalign : shortint;
  74. procedure gen_load_frame_for_exceptfilter(list : TAsmList);
  75. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
  76. implementation
  77. uses
  78. cutils,cclasses,
  79. globals,systems,verbose,
  80. defutil,
  81. procinfo,paramgr,
  82. dbgbase,
  83. nadd,nbas,ncon,nld,nmem,nutils,
  84. tgobj,cgobj,hlcgobj,hlcgcpu
  85. {$ifdef powerpc}
  86. , cpupi
  87. {$endif}
  88. {$ifdef powerpc64}
  89. , cpupi
  90. {$endif}
  91. {$ifdef SUPPORT_MMX}
  92. , cgx86
  93. {$endif SUPPORT_MMX}
  94. ;
  95. {*****************************************************************************
  96. Misc Helpers
  97. *****************************************************************************}
  98. {$if first_mm_imreg = 0}
  99. {$WARN 4044 OFF} { Comparison might be always false ... }
  100. {$endif}
  101. procedure location_free(list: TAsmList; const location : TLocation);
  102. begin
  103. case location.loc of
  104. LOC_VOID:
  105. ;
  106. LOC_REGISTER,
  107. LOC_CREGISTER:
  108. begin
  109. {$if defined(cpu64bitalu)}
  110. { x86-64 system v abi:
  111. structs with up to 16 bytes are returned in registers }
  112. if location.size in [OS_128,OS_S128] then
  113. begin
  114. if getsupreg(location.register)<first_int_imreg then
  115. cg.ungetcpuregister(list,location.register);
  116. if getsupreg(location.registerhi)<first_int_imreg then
  117. cg.ungetcpuregister(list,location.registerhi);
  118. end
  119. else
  120. {$elseif not defined(cpuhighleveltarget)}
  121. if location.size in [OS_64,OS_S64] then
  122. begin
  123. if getsupreg(location.register64.reglo)<first_int_imreg then
  124. cg.ungetcpuregister(list,location.register64.reglo);
  125. if getsupreg(location.register64.reghi)<first_int_imreg then
  126. cg.ungetcpuregister(list,location.register64.reghi);
  127. end
  128. else
  129. {$endif cpu64bitalu and not cpuhighleveltarget}
  130. if getsupreg(location.register)<first_int_imreg then
  131. cg.ungetcpuregister(list,location.register);
  132. end;
  133. LOC_FPUREGISTER,
  134. LOC_CFPUREGISTER:
  135. begin
  136. if getsupreg(location.register)<first_fpu_imreg then
  137. cg.ungetcpuregister(list,location.register);
  138. end;
  139. LOC_MMREGISTER,
  140. LOC_CMMREGISTER :
  141. begin
  142. if getsupreg(location.register)<first_mm_imreg then
  143. cg.ungetcpuregister(list,location.register);
  144. end;
  145. LOC_REFERENCE,
  146. LOC_CREFERENCE :
  147. begin
  148. if paramanager.use_fixed_stack then
  149. location_freetemp(list,location);
  150. end;
  151. else
  152. internalerror(2004110211);
  153. end;
  154. end;
  155. procedure firstcomplex(p : tbinarynode);
  156. var
  157. fcl, fcr: longint;
  158. ncl, ncr: longint;
  159. begin
  160. { calculate boolean AND and OR from left to right if it's short boolean evaluted }
  161. if (p.nodetype in [orn,andn]) and is_boolean(p.left.resultdef) and is_boolean(p.right.resultdef) and doshortbooleval(p) then
  162. begin
  163. if nf_swapped in p.flags then
  164. internalerror(200709253);
  165. end
  166. else
  167. begin
  168. fcl:=node_resources_fpu(p.left);
  169. fcr:=node_resources_fpu(p.right);
  170. ncl:=node_complexity(p.left);
  171. ncr:=node_complexity(p.right);
  172. { We swap left and right if
  173. a) right needs more floating point registers than left, and
  174. left needs more than 0 floating point registers (if it
  175. doesn't need any, swapping won't change the floating
  176. point register pressure)
  177. b) both left and right need an equal amount of floating
  178. point registers or right needs no floating point registers,
  179. and in addition right has a higher complexity than left
  180. (+- needs more integer registers, but not necessarily)
  181. }
  182. if ((fcr>fcl) and
  183. (fcl>0)) or
  184. (((fcr=fcl) or
  185. (fcr=0)) and
  186. (ncr>ncl)) and
  187. { if one tree contains nodes being conditionally executated, we cannot swap the trees
  188. as the other tree might depend on all nodes being executed, this applies for example
  189. for temp. create nodes with init part, they must be executed else things break, see
  190. issue #34653
  191. }
  192. not(has_conditional_nodes(p.right)) then
  193. p.swapleftright
  194. end;
  195. end;
  196. procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel);
  197. {
  198. produces jumps to true respectively false labels using boolean expressions
  199. }
  200. var
  201. opsize : tcgsize;
  202. storepos : tfileposinfo;
  203. tmpreg : tregister;
  204. begin
  205. if nf_error in p.flags then
  206. exit;
  207. storepos:=current_filepos;
  208. current_filepos:=p.fileinfo;
  209. if is_boolean(p.resultdef) then
  210. begin
  211. if is_constboolnode(p) then
  212. begin
  213. if Tordconstnode(p).value.uvalue<>0 then
  214. cg.a_jmp_always(list,truelabel)
  215. else
  216. cg.a_jmp_always(list,falselabel)
  217. end
  218. else
  219. begin
  220. opsize:=def_cgsize(p.resultdef);
  221. case p.location.loc of
  222. LOC_SUBSETREG,LOC_CSUBSETREG:
  223. begin
  224. if p.location.sreg.bitlen=1 then
  225. begin
  226. tmpreg:=cg.getintregister(list,p.location.sreg.subsetregsize);
  227. 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);
  228. end
  229. else
  230. begin
  231. tmpreg:=cg.getintregister(list,OS_INT);
  232. hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg);
  233. end;
  234. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel);
  235. cg.a_jmp_always(list,falselabel);
  236. end;
  237. LOC_SUBSETREF,LOC_CSUBSETREF:
  238. begin
  239. if (p.location.sref.bitindexreg=NR_NO) and (p.location.sref.bitlen=1) then
  240. begin
  241. tmpreg:=cg.getintregister(list,OS_INT);
  242. hlcg.a_load_ref_reg(list,u8inttype,osuinttype,p.location.sref.ref,tmpreg);
  243. if target_info.endian=endian_big then
  244. hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl (8-(p.location.sref.startbit+1)),tmpreg,tmpreg)
  245. else
  246. hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl p.location.sref.startbit,tmpreg,tmpreg);
  247. end
  248. else
  249. begin
  250. tmpreg:=cg.getintregister(list,OS_INT);
  251. hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg);
  252. end;
  253. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel);
  254. cg.a_jmp_always(list,falselabel);
  255. end;
  256. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  257. begin
  258. {$if defined(cpu64bitalu)}
  259. if opsize in [OS_128,OS_S128] then
  260. begin
  261. hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
  262. tmpreg:=cg.getintregister(list,OS_64);
  263. cg.a_op_reg_reg_reg(list,OP_OR,OS_64,p.location.register128.reglo,p.location.register128.reghi,tmpreg);
  264. location_reset(p.location,LOC_REGISTER,OS_64);
  265. p.location.register:=tmpreg;
  266. opsize:=OS_64;
  267. end;
  268. {$elseif not defined(cpuhighleveltarget)}
  269. if opsize in [OS_64,OS_S64] then
  270. begin
  271. hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
  272. tmpreg:=cg.getintregister(list,OS_32);
  273. cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg);
  274. location_reset(p.location,LOC_REGISTER,OS_32);
  275. p.location.register:=tmpreg;
  276. opsize:=OS_32;
  277. end;
  278. {$endif cpu64bitalu and not cpuhighleveltarget}
  279. cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel);
  280. cg.a_jmp_always(list,falselabel);
  281. end;
  282. LOC_JUMP:
  283. begin
  284. if truelabel<>p.location.truelabel then
  285. begin
  286. cg.a_label(list,p.location.truelabel);
  287. cg.a_jmp_always(list,truelabel);
  288. end;
  289. if falselabel<>p.location.falselabel then
  290. begin
  291. cg.a_label(list,p.location.falselabel);
  292. cg.a_jmp_always(list,falselabel);
  293. end;
  294. end;
  295. {$ifdef cpuflags}
  296. LOC_FLAGS :
  297. begin
  298. cg.a_jmp_flags(list,p.location.resflags,truelabel);
  299. cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
  300. cg.a_jmp_always(list,falselabel);
  301. end;
  302. {$endif cpuflags}
  303. else
  304. begin
  305. printnode(output,p);
  306. internalerror(200308241);
  307. end;
  308. end;
  309. end;
  310. location_reset_jump(p.location,truelabel,falselabel);
  311. end
  312. else
  313. internalerror(200112305);
  314. current_filepos:=storepos;
  315. end;
  316. (*
  317. This code needs fixing. It is not safe to use rgint; on the m68000 it
  318. would be rgaddr.
  319. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  320. begin
  321. case t.loc of
  322. LOC_REGISTER:
  323. begin
  324. { can't be a regvar, since it would be LOC_CREGISTER then }
  325. exclude(regs,getsupreg(t.register));
  326. if t.register64.reghi<>NR_NO then
  327. exclude(regs,getsupreg(t.register64.reghi));
  328. end;
  329. LOC_CREFERENCE,LOC_REFERENCE:
  330. begin
  331. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  332. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  333. exclude(regs,getsupreg(t.reference.base));
  334. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  335. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  336. exclude(regs,getsupreg(t.reference.index));
  337. end;
  338. end;
  339. end;
  340. *)
  341. {*****************************************************************************
  342. TLocation
  343. *****************************************************************************}
  344. procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint);
  345. var
  346. tmpreg: tregister;
  347. begin
  348. if (setbase<>0) then
  349. begin
  350. { subtract the setbase }
  351. case l.loc of
  352. LOC_CREGISTER:
  353. begin
  354. tmpreg := hlcg.getintregister(list,opdef);
  355. hlcg.a_op_const_reg_reg(list,OP_SUB,opdef,setbase,l.register,tmpreg);
  356. l.loc:=LOC_REGISTER;
  357. l.register:=tmpreg;
  358. end;
  359. LOC_REGISTER:
  360. begin
  361. hlcg.a_op_const_reg(list,OP_SUB,opdef,setbase,l.register);
  362. end;
  363. else
  364. internalerror(2007091502);
  365. end;
  366. end;
  367. end;
  368. procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  369. var
  370. reg : tregister;
  371. begin
  372. if (l.loc<>LOC_MMREGISTER) and
  373. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  374. begin
  375. reg:=cg.getmmregister(list,l.size);
  376. cg.a_loadmm_loc_reg(list,l.size,l,reg,nil);
  377. location_freetemp(list,l);
  378. location_reset(l,LOC_MMREGISTER,l.size);
  379. l.register:=reg;
  380. end;
  381. end;
  382. procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean);
  383. begin
  384. l.size:=def_cgsize(def);
  385. if (def.typ=floatdef) and
  386. not(cs_fp_emulation in current_settings.moduleswitches) then
  387. begin
  388. if use_vectorfpu(def) then
  389. begin
  390. if constant then
  391. location_reset(l,LOC_CMMREGISTER,l.size)
  392. else
  393. location_reset(l,LOC_MMREGISTER,l.size);
  394. l.register:=cg.getmmregister(list,l.size);
  395. end
  396. else
  397. begin
  398. if constant then
  399. location_reset(l,LOC_CFPUREGISTER,l.size)
  400. else
  401. location_reset(l,LOC_FPUREGISTER,l.size);
  402. l.register:=cg.getfpuregister(list,l.size);
  403. end;
  404. end
  405. else
  406. begin
  407. if constant then
  408. location_reset(l,LOC_CREGISTER,l.size)
  409. else
  410. location_reset(l,LOC_REGISTER,l.size);
  411. {$if defined(cpu64bitalu)}
  412. if l.size in [OS_128,OS_S128,OS_F128] then
  413. begin
  414. l.register128.reglo:=cg.getintregister(list,OS_64);
  415. l.register128.reghi:=cg.getintregister(list,OS_64);
  416. end
  417. else
  418. {$elseif not defined(cpuhighleveltarget)}
  419. if l.size in [OS_64,OS_S64,OS_F64] then
  420. begin
  421. l.register64.reglo:=cg.getintregister(list,OS_32);
  422. l.register64.reghi:=cg.getintregister(list,OS_32);
  423. end
  424. else
  425. {$endif cpu64bitalu and not cpuhighleveltarget}
  426. { Note: for widths of records (and maybe objects, classes, etc.) an
  427. address register could be set here, but that is later
  428. changed to an intregister neverthless when in the
  429. tcgassignmentnode thlcgobj.maybe_change_load_node_reg is
  430. called for the temporary node; so the workaround for now is
  431. to fix the symptoms... }
  432. l.register:=hlcg.getregisterfordef(list,def);
  433. end;
  434. end;
  435. {****************************************************************************
  436. Init/Finalize Code
  437. ****************************************************************************}
  438. { generates the code for incrementing the reference count of parameters and
  439. initialize out parameters }
  440. procedure init_paras(p:TObject;arg:pointer);
  441. var
  442. href : treference;
  443. hsym : tparavarsym;
  444. eldef : tdef;
  445. list : TAsmList;
  446. needs_inittable : boolean;
  447. begin
  448. list:=TAsmList(arg);
  449. if (tsym(p).typ=paravarsym) then
  450. begin
  451. needs_inittable:=is_managed_type(tparavarsym(p).vardef);
  452. if not needs_inittable then
  453. exit;
  454. case tparavarsym(p).varspez of
  455. vs_value :
  456. begin
  457. { variants are already handled by the call to fpc_variant_copy_overwrite if
  458. they are passed by reference }
  459. if not((tparavarsym(p).vardef.typ=variantdef) and
  460. paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  461. begin
  462. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,
  463. is_open_array(tparavarsym(p).vardef) or
  464. ((target_info.system in systems_caller_copy_addr_value_para) and
  465. paramanager.push_addr_param(vs_value,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)),
  466. sizeof(pint));
  467. if is_open_array(tparavarsym(p).vardef) then
  468. begin
  469. { open arrays do not contain correct element count in their rtti,
  470. the actual count must be passed separately. }
  471. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  472. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  473. if not assigned(hsym) then
  474. internalerror(201003031);
  475. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_addref_array');
  476. end
  477. else
  478. hlcg.g_incrrefcount(list,tparavarsym(p).vardef,href);
  479. end;
  480. end;
  481. vs_out :
  482. begin
  483. { we have no idea about the alignment at the callee side,
  484. and the user also cannot specify "unaligned" here, so
  485. assume worst case }
  486. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  487. if is_open_array(tparavarsym(p).vardef) then
  488. begin
  489. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  490. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  491. if not assigned(hsym) then
  492. internalerror(201103033);
  493. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_initialize_array');
  494. end
  495. else
  496. hlcg.g_initialize(list,tparavarsym(p).vardef,href);
  497. end;
  498. else
  499. ;
  500. end;
  501. end;
  502. end;
  503. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
  504. begin
  505. case loc.loc of
  506. LOC_CREGISTER:
  507. begin
  508. {$if defined(cpu64bitalu)}
  509. if loc.size in [OS_128,OS_S128] then
  510. begin
  511. loc.register128.reglo:=cg.getintregister(list,OS_64);
  512. loc.register128.reghi:=cg.getintregister(list,OS_64);
  513. end
  514. else
  515. {$elseif not defined(cpuhighleveltarget)}
  516. if loc.size in [OS_64,OS_S64] then
  517. begin
  518. loc.register64.reglo:=cg.getintregister(list,OS_32);
  519. loc.register64.reghi:=cg.getintregister(list,OS_32);
  520. end
  521. else
  522. {$endif cpu64bitalu and not cpuhighleveltarget}
  523. if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then
  524. loc.register:=hlcg.getaddressregister(list,def)
  525. else
  526. loc.register:=cg.getintregister(list,loc.size);
  527. end;
  528. LOC_CFPUREGISTER:
  529. begin
  530. loc.register:=cg.getfpuregister(list,loc.size);
  531. end;
  532. LOC_CMMREGISTER:
  533. begin
  534. loc.register:=cg.getmmregister(list,loc.size);
  535. end;
  536. else
  537. ;
  538. end;
  539. end;
  540. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
  541. var
  542. usedef: tdef;
  543. varloc: tai_varloc;
  544. begin
  545. if allocreg then
  546. begin
  547. if sym.typ=paravarsym then
  548. usedef:=tparavarsym(sym).paraloc[calleeside].def
  549. else
  550. usedef:=sym.vardef;
  551. gen_alloc_regloc(list,sym.initialloc,usedef);
  552. end;
  553. if (pi_has_label in current_procinfo.flags) then
  554. begin
  555. { Allocate register already, to prevent first allocation to be
  556. inside a loop }
  557. {$if defined(cpu64bitalu)}
  558. if sym.initialloc.size in [OS_128,OS_S128] then
  559. begin
  560. cg.a_reg_sync(list,sym.initialloc.register128.reglo);
  561. cg.a_reg_sync(list,sym.initialloc.register128.reghi);
  562. end
  563. else
  564. {$elseif defined(cpu32bitalu) and not defined(cpuhighleveltarget)}
  565. if sym.initialloc.size in [OS_64,OS_S64] then
  566. begin
  567. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  568. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  569. end
  570. else
  571. {$elseif defined(cpu16bitalu) and not defined(cpuhighleveltarget)}
  572. if sym.initialloc.size in [OS_64,OS_S64] then
  573. begin
  574. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  575. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo));
  576. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  577. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi));
  578. end
  579. else
  580. if sym.initialloc.size in [OS_32,OS_S32] then
  581. begin
  582. cg.a_reg_sync(list,sym.initialloc.register);
  583. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register));
  584. end
  585. else
  586. {$elseif defined(cpu8bitalu) and not defined(cpuhighleveltarget)}
  587. if sym.initialloc.size in [OS_64,OS_S64] then
  588. begin
  589. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  590. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo));
  591. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo)));
  592. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo))));
  593. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  594. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi));
  595. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi)));
  596. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi))));
  597. end
  598. else
  599. if sym.initialloc.size in [OS_32,OS_S32] then
  600. begin
  601. cg.a_reg_sync(list,sym.initialloc.register);
  602. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register));
  603. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register)));
  604. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register))));
  605. end
  606. else
  607. if sym.initialloc.size in [OS_16,OS_S16] then
  608. begin
  609. cg.a_reg_sync(list,sym.initialloc.register);
  610. cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register));
  611. end
  612. else
  613. {$endif}
  614. cg.a_reg_sync(list,sym.initialloc.register);
  615. end;
  616. {$if defined(cpu64bitalu)}
  617. if (sym.initialloc.size in [OS_128,OS_S128]) then
  618. varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi)
  619. else
  620. {$elseif not defined(cpuhighleveltarget)}
  621. if (sym.initialloc.size in [OS_64,OS_S64]) then
  622. varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi)
  623. else
  624. {$endif cpu64bitalu and not cpuhighleveltarget}
  625. varloc:=tai_varloc.create(sym,sym.initialloc.register);
  626. list.concat(varloc);
  627. end;
  628. {****************************************************************************
  629. Entry/Exit
  630. ****************************************************************************}
  631. procedure alloc_proc_symbol(pd: tprocdef);
  632. var
  633. item: TCmdStrListItem;
  634. begin
  635. item:=TCmdStrListItem(pd.aliasnames.first);
  636. while assigned(item) do
  637. begin
  638. current_asmdata.DefineProcAsmSymbol(pd,item.str,pd.needsglobalasmsym);
  639. item:=TCmdStrListItem(item.next);
  640. end;
  641. end;
  642. procedure release_proc_symbol(pd:tprocdef);
  643. var
  644. idx : longint;
  645. item : TCmdStrListItem;
  646. begin
  647. item:=TCmdStrListItem(pd.aliasnames.first);
  648. while assigned(item) do
  649. begin
  650. idx:=current_asmdata.AsmSymbolDict.findindexof(item.str);
  651. if idx>=0 then
  652. current_asmdata.AsmSymbolDict.Delete(idx);
  653. item:=TCmdStrListItem(item.next);
  654. end;
  655. end;
  656. procedure gen_proc_entry_code(list:TAsmList);
  657. var
  658. hitemp,
  659. lotemp, stack_frame_size : longint;
  660. begin
  661. { generate call frame marker for dwarf call frame info }
  662. current_asmdata.asmcfi.start_frame(list);
  663. { labels etc. for exception frames are inserted here }
  664. current_procinfo.start_eh(list);
  665. if current_procinfo.procdef.proctypeoption=potype_proginit then
  666. current_asmdata.asmcfi.outmost_frame(list);
  667. { All temps are know, write offsets used for information }
  668. if (cs_asm_source in current_settings.globalswitches) and
  669. (current_procinfo.tempstart<>tg.lasttemp) then
  670. begin
  671. if tg.direction>0 then
  672. begin
  673. lotemp:=current_procinfo.tempstart;
  674. hitemp:=tg.lasttemp;
  675. end
  676. else
  677. begin
  678. lotemp:=tg.lasttemp;
  679. hitemp:=current_procinfo.tempstart;
  680. end;
  681. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  682. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  683. end;
  684. { generate target specific proc entry code }
  685. stack_frame_size := current_procinfo.calc_stackframe_size;
  686. if (stack_frame_size <> 0) and
  687. (po_nostackframe in current_procinfo.procdef.procoptions) then
  688. message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size));
  689. hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  690. end;
  691. procedure gen_proc_exit_code(list:TAsmList);
  692. var
  693. parasize : longint;
  694. begin
  695. { c style clearstack does not need to remove parameters from the stack, only the
  696. return value when it was pushed by arguments }
  697. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  698. begin
  699. parasize:=0;
  700. { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para
  701. which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. }
  702. if not current_procinfo.procdef.generate_safecall_wrapper and
  703. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  704. inc(parasize,sizeof(pint));
  705. end
  706. else
  707. begin
  708. parasize:=current_procinfo.para_stack_size;
  709. { the parent frame pointer para has to be removed always by the caller in
  710. case of Delphi-style parent frame pointer passing }
  711. if (not(paramanager.use_fixed_stack) or (target_info.abi=abi_i386_dynalignedstack)) and
  712. (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
  713. dec(parasize,sizeof(pint));
  714. end;
  715. { generate target specific proc exit code }
  716. hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  717. { labels etc. for exception frames are inserted here }
  718. current_procinfo.end_eh(list);
  719. { release return registers, needed for optimizer }
  720. if not is_void(current_procinfo.procdef.returndef) then
  721. paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);
  722. { end of frame marker for call frame info }
  723. current_asmdata.asmcfi.end_frame(list);
  724. end;
  725. procedure gen_save_used_regs(list:TAsmList);
  726. begin
  727. { Pure assembler routines need to save the registers themselves }
  728. if (po_assembler in current_procinfo.procdef.procoptions) then
  729. exit;
  730. cg.g_save_registers(list);
  731. end;
  732. procedure gen_restore_used_regs(list:TAsmList);
  733. begin
  734. { Pure assembler routines need to save the registers themselves }
  735. if (po_assembler in current_procinfo.procdef.procoptions) then
  736. exit;
  737. cg.g_restore_registers(list);
  738. end;
  739. {****************************************************************************
  740. Const Data
  741. ****************************************************************************}
  742. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  743. var
  744. i : longint;
  745. highsym,
  746. sym : tsym;
  747. vs : tabstractnormalvarsym;
  748. ptrdef : tdef;
  749. isaddr : boolean;
  750. begin
  751. for i:=0 to st.SymList.Count-1 do
  752. begin
  753. sym:=tsym(st.SymList[i]);
  754. case sym.typ of
  755. staticvarsym :
  756. begin
  757. vs:=tabstractnormalvarsym(sym);
  758. { The code in loadnode.pass_generatecode will create the
  759. LOC_REFERENCE instead for all none register variables. This is
  760. required because we can't store an asmsymbol in the localloc because
  761. the asmsymbol is invalid after an unit is compiled. This gives
  762. problems when this procedure is inlined in another unit (PFV) }
  763. if vs.is_regvar(false) then
  764. begin
  765. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  766. vs.initialloc.size:=def_cgsize(vs.vardef);
  767. gen_alloc_regvar(list,vs,true);
  768. hlcg.varsym_set_localloc(list,vs);
  769. end;
  770. end;
  771. paravarsym :
  772. begin
  773. vs:=tabstractnormalvarsym(sym);
  774. { Parameters passed to assembler procedures need to be kept
  775. in the original location }
  776. if (po_assembler in pd.procoptions) then
  777. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  778. { exception filters receive their frame pointer as a parameter }
  779. else if (pd.proctypeoption=potype_exceptfilter) and
  780. (vo_is_parentfp in vs.varoptions) then
  781. begin
  782. location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
  783. vs.initialloc.register:=NR_FRAME_POINTER_REG;
  784. end
  785. { Unused parameters need to be kept in the original location
  786. to prevent allocation of registers/resources for them. }
  787. else if not tparavarsym(vs).is_used then
  788. begin
  789. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc);
  790. end
  791. else
  792. begin
  793. { if an open array is used, also its high parameter is used,
  794. since the hidden high parameters are inserted after the corresponding symbols,
  795. we can increase the ref. count here }
  796. if is_open_array(vs.vardef) or is_array_of_const(vs.vardef) then
  797. begin
  798. highsym:=get_high_value_sym(tparavarsym(vs));
  799. if assigned(highsym) then
  800. inc(highsym.refs);
  801. end;
  802. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,pd.proccalloption);
  803. if isaddr then
  804. vs.initialloc.size:=def_cgsize(voidpointertype)
  805. else
  806. vs.initialloc.size:=def_cgsize(vs.vardef);
  807. if vs.is_regvar(isaddr) then
  808. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  809. else
  810. begin
  811. vs.initialloc.loc:=LOC_REFERENCE;
  812. { Reuse the parameter location for values to are at a single location on the stack }
  813. if paramanager.param_use_paraloc(tparavarsym(vs).paraloc[calleeside]) then
  814. begin
  815. hlcg.paravarsym_set_initialloc_to_paraloc(tparavarsym(vs));
  816. end
  817. else
  818. begin
  819. if isaddr then
  820. begin
  821. ptrdef:=cpointerdef.getreusable(vs.vardef);
  822. tg.GetLocal(list,ptrdef.size,ptrdef,vs.initialloc.reference)
  823. end
  824. else
  825. tg.GetLocal(list,vs.getsize,tparavarsym(vs).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  826. end;
  827. end;
  828. end;
  829. hlcg.varsym_set_localloc(list,vs);
  830. end;
  831. localvarsym :
  832. begin
  833. vs:=tabstractnormalvarsym(sym);
  834. if is_vector(vs.vardef) and
  835. fits_in_mm_register(vs.vardef) then
  836. vs.initialloc.size:=def_cgmmsize(vs.vardef)
  837. else
  838. vs.initialloc.size:=def_cgsize(vs.vardef);
  839. if ([po_assembler,po_nostackframe] * pd.procoptions = [po_assembler,po_nostackframe]) and
  840. (vo_is_funcret in vs.varoptions) then
  841. begin
  842. paramanager.create_funcretloc_info(pd,calleeside);
  843. if assigned(pd.funcretloc[calleeside].location^.next) then
  844. begin
  845. { can't replace references to "result" with a complex
  846. location expression inside assembler code }
  847. location_reset(vs.initialloc,LOC_INVALID,OS_NO);
  848. end
  849. else
  850. pd.funcretloc[calleeside].get_location(vs.initialloc);
  851. end
  852. else if (m_delphi in current_settings.modeswitches) and
  853. (po_assembler in pd.procoptions) and
  854. (vo_is_funcret in vs.varoptions) and
  855. (vs.refs=0) then
  856. begin
  857. { not referenced, so don't allocate. Use dummy to }
  858. { avoid ie's later on because of LOC_INVALID }
  859. vs.initialloc.loc:=LOC_REGISTER;
  860. vs.initialloc.size:=OS_INT;
  861. vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
  862. end
  863. else if vs.is_regvar(false) then
  864. begin
  865. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  866. gen_alloc_regvar(list,vs,true);
  867. end
  868. else
  869. begin
  870. vs.initialloc.loc:=LOC_REFERENCE;
  871. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  872. end;
  873. hlcg.varsym_set_localloc(list,vs);
  874. end;
  875. else
  876. ;
  877. end;
  878. end;
  879. end;
  880. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  881. begin
  882. case location.loc of
  883. LOC_CREGISTER:
  884. {$if defined(cpu64bitalu)}
  885. if location.size in [OS_128,OS_S128] then
  886. begin
  887. rv.intregvars.addnodup(getsupreg(location.register128.reglo));
  888. rv.intregvars.addnodup(getsupreg(location.register128.reghi));
  889. end
  890. else
  891. {$elseif defined(cpu32bitalu)}
  892. if location.size in [OS_64,OS_S64] then
  893. begin
  894. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  895. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  896. end
  897. else
  898. {$elseif defined(cpu16bitalu)}
  899. if location.size in [OS_64,OS_S64] then
  900. begin
  901. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  902. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo)));
  903. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  904. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi)));
  905. end
  906. else
  907. if location.size in [OS_32,OS_S32] then
  908. begin
  909. rv.intregvars.addnodup(getsupreg(location.register));
  910. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
  911. end
  912. else
  913. {$elseif defined(cpu8bitalu)}
  914. if location.size in [OS_64,OS_S64] then
  915. begin
  916. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  917. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo)));
  918. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo))));
  919. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo)))));
  920. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  921. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi)));
  922. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi))));
  923. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi)))));
  924. end
  925. else
  926. if location.size in [OS_32,OS_S32] then
  927. begin
  928. rv.intregvars.addnodup(getsupreg(location.register));
  929. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
  930. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register))));
  931. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register)))));
  932. end
  933. else
  934. if location.size in [OS_16,OS_S16] then
  935. begin
  936. rv.intregvars.addnodup(getsupreg(location.register));
  937. rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register)));
  938. end
  939. else
  940. {$endif}
  941. if getregtype(location.register)=R_INTREGISTER then
  942. rv.intregvars.addnodup(getsupreg(location.register))
  943. else
  944. rv.addrregvars.addnodup(getsupreg(location.register));
  945. LOC_CFPUREGISTER:
  946. rv.fpuregvars.addnodup(getsupreg(location.register));
  947. LOC_CMMREGISTER:
  948. rv.mmregvars.addnodup(getsupreg(location.register));
  949. else
  950. ;
  951. end;
  952. end;
  953. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  954. var
  955. rv: pusedregvars absolute arg;
  956. begin
  957. case (n.nodetype) of
  958. temprefn:
  959. { We only have to synchronise a tempnode before a loop if it is }
  960. { not created inside the loop, and only synchronise after the }
  961. { loop if it's not destroyed inside the loop. If it's created }
  962. { before the loop and not yet destroyed, then before the loop }
  963. { is secondpassed tempinfo^.valid will be true, and we get the }
  964. { correct registers. If it's not destroyed inside the loop, }
  965. { then after the loop has been secondpassed tempinfo^.valid }
  966. { be true and we also get the right registers. In other cases, }
  967. { tempinfo^.valid will be false and so we do not add }
  968. { unnecessary registers. This way, we don't have to look at }
  969. { tempcreate and tempdestroy nodes to get this info (JM) }
  970. if (ti_valid in ttemprefnode(n).tempflags) then
  971. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  972. loadn:
  973. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  974. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  975. loadparentfpn:
  976. if current_procinfo.procdef.parast.symtablelevel>tloadparentfpnode(n).parentpd.parast.symtablelevel then
  977. add_regvars(rv^,tparavarsym(current_procinfo.procdef.parentfpsym).localloc);
  978. vecn:
  979. begin
  980. { range checks sometimes need the high parameter }
  981. if (cs_check_range in current_settings.localswitches) and
  982. (is_open_array(tvecnode(n).left.resultdef) or
  983. is_array_of_const(tvecnode(n).left.resultdef)) and
  984. not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  985. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  986. end;
  987. else
  988. ;
  989. end;
  990. result := fen_true;
  991. end;
  992. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  993. begin
  994. foreachnodestatic(n,@do_get_used_regvars,@rv);
  995. end;
  996. (*
  997. See comments at declaration of pusedregvarscommon
  998. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  999. var
  1000. rv: pusedregvarscommon absolute arg;
  1001. begin
  1002. if (n.nodetype = loadn) and
  1003. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1004. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  1005. case loc of
  1006. LOC_CREGISTER:
  1007. { if not yet encountered in this node tree }
  1008. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1009. { but nevertheless already encountered somewhere }
  1010. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1011. { then it's a regvar used in two or more node trees }
  1012. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1013. LOC_CFPUREGISTER:
  1014. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1015. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1016. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1017. LOC_CMMREGISTER:
  1018. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1019. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1020. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1021. end;
  1022. result := fen_true;
  1023. end;
  1024. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  1025. begin
  1026. rv.myregvars.intregvars.clear;
  1027. rv.myregvars.fpuregvars.clear;
  1028. rv.myregvars.mmregvars.clear;
  1029. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  1030. end;
  1031. *)
  1032. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  1033. var
  1034. count: longint;
  1035. begin
  1036. for count := 1 to rv.intregvars.length do
  1037. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  1038. for count := 1 to rv.addrregvars.length do
  1039. cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE));
  1040. for count := 1 to rv.fpuregvars.length do
  1041. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  1042. for count := 1 to rv.mmregvars.length do
  1043. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  1044. end;
  1045. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  1046. var
  1047. i : longint;
  1048. sym : tsym;
  1049. begin
  1050. for i:=0 to st.SymList.Count-1 do
  1051. begin
  1052. sym:=tsym(st.SymList[i]);
  1053. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  1054. begin
  1055. with tabstractnormalvarsym(sym) do
  1056. begin
  1057. { Note: We need to keep the data available in memory
  1058. for the sub procedures that can access local data
  1059. in the parent procedures }
  1060. case localloc.loc of
  1061. LOC_CREGISTER :
  1062. if (pi_has_label in current_procinfo.flags) then
  1063. {$if defined(cpu64bitalu)}
  1064. if localloc.size in [OS_128,OS_S128] then
  1065. begin
  1066. cg.a_reg_sync(list,localloc.register128.reglo);
  1067. cg.a_reg_sync(list,localloc.register128.reghi);
  1068. end
  1069. else
  1070. {$elseif defined(cpu32bitalu)}
  1071. if localloc.size in [OS_64,OS_S64] then
  1072. begin
  1073. cg.a_reg_sync(list,localloc.register64.reglo);
  1074. cg.a_reg_sync(list,localloc.register64.reghi);
  1075. end
  1076. else
  1077. {$elseif defined(cpu16bitalu)}
  1078. if localloc.size in [OS_64,OS_S64] then
  1079. begin
  1080. cg.a_reg_sync(list,localloc.register64.reglo);
  1081. cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo));
  1082. cg.a_reg_sync(list,localloc.register64.reghi);
  1083. cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi));
  1084. end
  1085. else
  1086. if localloc.size in [OS_32,OS_S32] then
  1087. begin
  1088. cg.a_reg_sync(list,localloc.register);
  1089. cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
  1090. end
  1091. else
  1092. {$elseif defined(cpu8bitalu)}
  1093. if localloc.size in [OS_64,OS_S64] then
  1094. begin
  1095. cg.a_reg_sync(list,localloc.register64.reglo);
  1096. cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo));
  1097. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo)));
  1098. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo))));
  1099. cg.a_reg_sync(list,localloc.register64.reghi);
  1100. cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi));
  1101. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi)));
  1102. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi))));
  1103. end
  1104. else
  1105. if localloc.size in [OS_32,OS_S32] then
  1106. begin
  1107. cg.a_reg_sync(list,localloc.register);
  1108. cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
  1109. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register)));
  1110. cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register))));
  1111. end
  1112. else
  1113. if localloc.size in [OS_16,OS_S16] then
  1114. begin
  1115. cg.a_reg_sync(list,localloc.register);
  1116. cg.a_reg_sync(list,cg.GetNextReg(localloc.register));
  1117. end
  1118. else
  1119. {$endif}
  1120. cg.a_reg_sync(list,localloc.register);
  1121. LOC_CFPUREGISTER,
  1122. LOC_CMMREGISTER,
  1123. LOC_CMMXREGISTER:
  1124. if (pi_has_label in current_procinfo.flags) then
  1125. cg.a_reg_sync(list,localloc.register);
  1126. LOC_REFERENCE :
  1127. begin
  1128. { can't free the result, because we load it after
  1129. this call into the function result location
  1130. (gets freed in thlcgobj.gen_load_return_value();) }
  1131. if (typ in [localvarsym,paravarsym]) and
  1132. (([vo_is_funcret,vo_is_result]*varoptions)=[]) and
  1133. ((current_procinfo.procdef.proctypeoption<>potype_constructor) or
  1134. not(vo_is_self in varoptions)) then
  1135. tg.Ungetlocal(list,localloc.reference);
  1136. end;
  1137. { function results in pure assembler routines }
  1138. LOC_REGISTER,
  1139. LOC_FPUREGISTER,
  1140. LOC_MMREGISTER,
  1141. { empty parameter }
  1142. LOC_VOID,
  1143. { global variables in memory and typed constants don't get a location assigned,
  1144. and neither does an unused $result variable in pure assembler routines }
  1145. LOC_INVALID:
  1146. ;
  1147. else
  1148. internalerror(2019050538);
  1149. end;
  1150. end;
  1151. end;
  1152. end;
  1153. end;
  1154. function getprocalign : shortint;
  1155. begin
  1156. { gprof uses 16 byte granularity }
  1157. if (cs_profile in current_settings.moduleswitches) then
  1158. result:=16
  1159. else
  1160. result:=current_settings.alignment.procalign;
  1161. end;
  1162. procedure gen_load_frame_for_exceptfilter(list : TAsmList);
  1163. var
  1164. para: tparavarsym;
  1165. begin
  1166. para:=tparavarsym(current_procinfo.procdef.paras[0]);
  1167. if not (vo_is_parentfp in para.varoptions) then
  1168. InternalError(201201142);
  1169. if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
  1170. (para.paraloc[calleeside].location^.next<>nil) then
  1171. InternalError(201201143);
  1172. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,para.paraloc[calleeside].location^.register,
  1173. NR_FRAME_POINTER_REG);
  1174. end;
  1175. end.