ncgutil.pas 57 KB

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