ncgutil.pas 54 KB

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