ncgutil.pas 55 KB

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