ncgutil.pas 79 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792
  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,cpuinfo,
  22. globtype,
  23. cpubase,cgbase,parabase,cgutils,
  24. aasmbase,aasmtai,aasmdata,aasmcpu,
  25. symconst,symbase,symdef,symsym,symtype,symtable
  26. {$ifndef cpu64bitalu}
  27. ,cg64f32
  28. {$endif not cpu64bitalu}
  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. { loads a cgpara into a tlocation; assumes that loc.loc is already
  52. initialised }
  53. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  54. { allocate registers for a tlocation; assumes that loc.loc is already
  55. set to LOC_CREGISTER/LOC_CFPUREGISTER/... }
  56. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
  57. procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint);
  58. procedure alloc_proc_symbol(pd: tprocdef);
  59. procedure release_proc_symbol(pd:tprocdef);
  60. procedure gen_proc_entry_code(list:TAsmList);
  61. procedure gen_proc_exit_code(list:TAsmList);
  62. procedure gen_save_used_regs(list:TAsmList);
  63. procedure gen_restore_used_regs(list:TAsmList);
  64. procedure gen_load_para_value(list:TAsmList);
  65. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  66. { adds the regvars used in n and its children to rv.allregvars,
  67. those which were already in rv.allregvars to rv.commonregvars and
  68. uses rv.myregvars as scratch (so that two uses of the same regvar
  69. in a single tree to make it appear in commonregvars). Useful to
  70. find out which regvars are used in two different node trees
  71. e.g. in the "else" and "then" path, or in various case blocks }
  72. // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  73. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  74. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  75. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  76. procedure location_free(list: TAsmList; const location : TLocation);
  77. function getprocalign : shortint;
  78. procedure gen_fpc_dummy(list : TAsmList);
  79. procedure gen_load_frame_for_exceptfilter(list : TAsmList);
  80. implementation
  81. uses
  82. version,
  83. cutils,cclasses,
  84. globals,systems,verbose,export,
  85. ppu,defutil,
  86. procinfo,paramgr,fmodule,
  87. dbgbase,
  88. pass_1,pass_2,
  89. nbas,ncon,nld,nmem,nutils,ngenutil,
  90. tgobj,cgobj,hlcgobj,hlcgcpu
  91. {$ifdef llvm}
  92. { override create_hlcodegen from hlcgcpu }
  93. , hlcgllvm
  94. {$endif}
  95. {$ifdef powerpc}
  96. , cpupi
  97. {$endif}
  98. {$ifdef powerpc64}
  99. , cpupi
  100. {$endif}
  101. {$ifdef SUPPORT_MMX}
  102. , cgx86
  103. {$endif SUPPORT_MMX}
  104. ;
  105. {*****************************************************************************
  106. Misc Helpers
  107. *****************************************************************************}
  108. {$if first_mm_imreg = 0}
  109. {$WARN 4044 OFF} { Comparison might be always false ... }
  110. {$endif}
  111. procedure location_free(list: TAsmList; const location : TLocation);
  112. begin
  113. case location.loc of
  114. LOC_VOID:
  115. ;
  116. LOC_REGISTER,
  117. LOC_CREGISTER:
  118. begin
  119. {$ifdef cpu64bitalu}
  120. { x86-64 system v abi:
  121. structs with up to 16 bytes are returned in registers }
  122. if location.size in [OS_128,OS_S128] then
  123. begin
  124. if getsupreg(location.register)<first_int_imreg then
  125. cg.ungetcpuregister(list,location.register);
  126. if getsupreg(location.registerhi)<first_int_imreg then
  127. cg.ungetcpuregister(list,location.registerhi);
  128. end
  129. {$else cpu64bitalu}
  130. if location.size in [OS_64,OS_S64] then
  131. begin
  132. if getsupreg(location.register64.reglo)<first_int_imreg then
  133. cg.ungetcpuregister(list,location.register64.reglo);
  134. if getsupreg(location.register64.reghi)<first_int_imreg then
  135. cg.ungetcpuregister(list,location.register64.reghi);
  136. end
  137. {$endif cpu64bitalu}
  138. else
  139. if getsupreg(location.register)<first_int_imreg then
  140. cg.ungetcpuregister(list,location.register);
  141. end;
  142. LOC_FPUREGISTER,
  143. LOC_CFPUREGISTER:
  144. begin
  145. if getsupreg(location.register)<first_fpu_imreg then
  146. cg.ungetcpuregister(list,location.register);
  147. end;
  148. LOC_MMREGISTER,
  149. LOC_CMMREGISTER :
  150. begin
  151. if getsupreg(location.register)<first_mm_imreg then
  152. cg.ungetcpuregister(list,location.register);
  153. end;
  154. LOC_REFERENCE,
  155. LOC_CREFERENCE :
  156. begin
  157. if paramanager.use_fixed_stack then
  158. location_freetemp(list,location);
  159. end;
  160. else
  161. internalerror(2004110211);
  162. end;
  163. end;
  164. procedure firstcomplex(p : tbinarynode);
  165. var
  166. fcl, fcr: longint;
  167. ncl, ncr: longint;
  168. begin
  169. { always calculate boolean AND and OR from left to right }
  170. if (p.nodetype in [orn,andn]) and
  171. is_boolean(p.left.resultdef) then
  172. begin
  173. if nf_swapped in p.flags then
  174. internalerror(200709253);
  175. end
  176. else
  177. begin
  178. fcl:=node_resources_fpu(p.left);
  179. fcr:=node_resources_fpu(p.right);
  180. ncl:=node_complexity(p.left);
  181. ncr:=node_complexity(p.right);
  182. { We swap left and right if
  183. a) right needs more floating point registers than left, and
  184. left needs more than 0 floating point registers (if it
  185. doesn't need any, swapping won't change the floating
  186. point register pressure)
  187. b) both left and right need an equal amount of floating
  188. point registers or right needs no floating point registers,
  189. and in addition right has a higher complexity than left
  190. (+- needs more integer registers, but not necessarily)
  191. }
  192. if ((fcr>fcl) and
  193. (fcl>0)) or
  194. (((fcr=fcl) or
  195. (fcr=0)) and
  196. (ncr>ncl)) then
  197. p.swapleftright
  198. end;
  199. end;
  200. procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel);
  201. {
  202. produces jumps to true respectively false labels using boolean expressions
  203. }
  204. var
  205. opsize : tcgsize;
  206. storepos : tfileposinfo;
  207. tmpreg : tregister;
  208. begin
  209. if nf_error in p.flags then
  210. exit;
  211. storepos:=current_filepos;
  212. current_filepos:=p.fileinfo;
  213. if is_boolean(p.resultdef) then
  214. begin
  215. if is_constboolnode(p) then
  216. begin
  217. if Tordconstnode(p).value.uvalue<>0 then
  218. cg.a_jmp_always(list,truelabel)
  219. else
  220. cg.a_jmp_always(list,falselabel)
  221. end
  222. else
  223. begin
  224. opsize:=def_cgsize(p.resultdef);
  225. case p.location.loc of
  226. LOC_SUBSETREG,LOC_CSUBSETREG,
  227. LOC_SUBSETREF,LOC_CSUBSETREF:
  228. begin
  229. tmpreg := cg.getintregister(list,OS_INT);
  230. hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg);
  231. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel);
  232. cg.a_jmp_always(list,falselabel);
  233. end;
  234. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  235. begin
  236. {$ifdef cpu64bitalu}
  237. if opsize in [OS_128,OS_S128] then
  238. begin
  239. hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
  240. tmpreg:=cg.getintregister(list,OS_64);
  241. cg.a_op_reg_reg_reg(list,OP_OR,OS_64,p.location.register128.reglo,p.location.register128.reghi,tmpreg);
  242. location_reset(p.location,LOC_REGISTER,OS_64);
  243. p.location.register:=tmpreg;
  244. opsize:=OS_64;
  245. end;
  246. {$else cpu64bitalu}
  247. if opsize in [OS_64,OS_S64] then
  248. begin
  249. hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true);
  250. tmpreg:=cg.getintregister(list,OS_32);
  251. cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg);
  252. location_reset(p.location,LOC_REGISTER,OS_32);
  253. p.location.register:=tmpreg;
  254. opsize:=OS_32;
  255. end;
  256. {$endif cpu64bitalu}
  257. cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel);
  258. cg.a_jmp_always(list,falselabel);
  259. end;
  260. LOC_JUMP:
  261. begin
  262. if truelabel<>p.location.truelabel then
  263. begin
  264. cg.a_label(list,p.location.truelabel);
  265. cg.a_jmp_always(list,truelabel);
  266. end;
  267. if falselabel<>p.location.falselabel then
  268. begin
  269. cg.a_label(list,p.location.falselabel);
  270. cg.a_jmp_always(list,falselabel);
  271. end;
  272. end;
  273. {$ifdef cpuflags}
  274. LOC_FLAGS :
  275. begin
  276. cg.a_jmp_flags(list,p.location.resflags,truelabel);
  277. cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
  278. cg.a_jmp_always(list,falselabel);
  279. end;
  280. {$endif cpuflags}
  281. else
  282. begin
  283. printnode(output,p);
  284. internalerror(200308241);
  285. end;
  286. end;
  287. end;
  288. location_reset_jump(p.location,truelabel,falselabel);
  289. end
  290. else
  291. internalerror(200112305);
  292. current_filepos:=storepos;
  293. end;
  294. (*
  295. This code needs fixing. It is not safe to use rgint; on the m68000 it
  296. would be rgaddr.
  297. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  298. begin
  299. case t.loc of
  300. LOC_REGISTER:
  301. begin
  302. { can't be a regvar, since it would be LOC_CREGISTER then }
  303. exclude(regs,getsupreg(t.register));
  304. if t.register64.reghi<>NR_NO then
  305. exclude(regs,getsupreg(t.register64.reghi));
  306. end;
  307. LOC_CREFERENCE,LOC_REFERENCE:
  308. begin
  309. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  310. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  311. exclude(regs,getsupreg(t.reference.base));
  312. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  313. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  314. exclude(regs,getsupreg(t.reference.index));
  315. end;
  316. end;
  317. end;
  318. *)
  319. {*****************************************************************************
  320. TLocation
  321. *****************************************************************************}
  322. procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint);
  323. var
  324. tmpreg: tregister;
  325. begin
  326. if (setbase<>0) then
  327. begin
  328. if not(l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  329. internalerror(2007091502);
  330. { subtract the setbase }
  331. case l.loc of
  332. LOC_CREGISTER:
  333. begin
  334. tmpreg := hlcg.getintregister(list,opdef);
  335. hlcg.a_op_const_reg_reg(list,OP_SUB,opdef,setbase,l.register,tmpreg);
  336. l.loc:=LOC_REGISTER;
  337. l.register:=tmpreg;
  338. end;
  339. LOC_REGISTER:
  340. begin
  341. hlcg.a_op_const_reg(list,OP_SUB,opdef,setbase,l.register);
  342. end;
  343. end;
  344. end;
  345. end;
  346. procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  347. var
  348. reg : tregister;
  349. begin
  350. if (l.loc<>LOC_MMREGISTER) and
  351. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  352. begin
  353. reg:=cg.getmmregister(list,OS_VECTOR);
  354. cg.a_loadmm_loc_reg(list,OS_VECTOR,l,reg,nil);
  355. location_freetemp(list,l);
  356. location_reset(l,LOC_MMREGISTER,OS_VECTOR);
  357. l.register:=reg;
  358. end;
  359. end;
  360. procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean);
  361. begin
  362. l.size:=def_cgsize(def);
  363. if (def.typ=floatdef) and
  364. not(cs_fp_emulation in current_settings.moduleswitches) then
  365. begin
  366. if use_vectorfpu(def) then
  367. begin
  368. if constant then
  369. location_reset(l,LOC_CMMREGISTER,l.size)
  370. else
  371. location_reset(l,LOC_MMREGISTER,l.size);
  372. l.register:=cg.getmmregister(list,l.size);
  373. end
  374. else
  375. begin
  376. if constant then
  377. location_reset(l,LOC_CFPUREGISTER,l.size)
  378. else
  379. location_reset(l,LOC_FPUREGISTER,l.size);
  380. l.register:=cg.getfpuregister(list,l.size);
  381. end;
  382. end
  383. else
  384. begin
  385. if constant then
  386. location_reset(l,LOC_CREGISTER,l.size)
  387. else
  388. location_reset(l,LOC_REGISTER,l.size);
  389. {$ifdef cpu64bitalu}
  390. if l.size in [OS_128,OS_S128,OS_F128] then
  391. begin
  392. l.register128.reglo:=cg.getintregister(list,OS_64);
  393. l.register128.reghi:=cg.getintregister(list,OS_64);
  394. end
  395. else
  396. {$else cpu64bitalu}
  397. if l.size in [OS_64,OS_S64,OS_F64] then
  398. begin
  399. l.register64.reglo:=cg.getintregister(list,OS_32);
  400. l.register64.reghi:=cg.getintregister(list,OS_32);
  401. end
  402. else
  403. {$endif cpu64bitalu}
  404. { Note: for widths of records (and maybe objects, classes, etc.) an
  405. address register could be set here, but that is later
  406. changed to an intregister neverthless when in the
  407. tcgassignmentnode thlcgobj.maybe_change_load_node_reg is
  408. called for the temporary node; so the workaround for now is
  409. to fix the symptoms... }
  410. l.register:=hlcg.getregisterfordef(list,def);
  411. end;
  412. end;
  413. {****************************************************************************
  414. Init/Finalize Code
  415. ****************************************************************************}
  416. { generates the code for incrementing the reference count of parameters and
  417. initialize out parameters }
  418. procedure init_paras(p:TObject;arg:pointer);
  419. var
  420. href : treference;
  421. hsym : tparavarsym;
  422. eldef : tdef;
  423. list : TAsmList;
  424. needs_inittable : boolean;
  425. begin
  426. list:=TAsmList(arg);
  427. if (tsym(p).typ=paravarsym) then
  428. begin
  429. needs_inittable:=is_managed_type(tparavarsym(p).vardef);
  430. if not needs_inittable then
  431. exit;
  432. case tparavarsym(p).varspez of
  433. vs_value :
  434. begin
  435. { variants are already handled by the call to fpc_variant_copy_overwrite if
  436. they are passed by reference }
  437. if not((tparavarsym(p).vardef.typ=variantdef) and
  438. paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  439. begin
  440. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,
  441. is_open_array(tparavarsym(p).vardef) or
  442. ((target_info.system in systems_caller_copy_addr_value_para) and
  443. paramanager.push_addr_param(vs_value,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)),
  444. sizeof(pint));
  445. if is_open_array(tparavarsym(p).vardef) then
  446. begin
  447. { open arrays do not contain correct element count in their rtti,
  448. the actual count must be passed separately. }
  449. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  450. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  451. if not assigned(hsym) then
  452. internalerror(201003031);
  453. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_addref_array');
  454. end
  455. else
  456. hlcg.g_incrrefcount(list,tparavarsym(p).vardef,href);
  457. end;
  458. end;
  459. vs_out :
  460. begin
  461. { we have no idea about the alignment at the callee side,
  462. and the user also cannot specify "unaligned" here, so
  463. assume worst case }
  464. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  465. if is_open_array(tparavarsym(p).vardef) then
  466. begin
  467. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  468. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  469. if not assigned(hsym) then
  470. internalerror(201103033);
  471. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_initialize_array');
  472. end
  473. else
  474. hlcg.g_initialize(list,tparavarsym(p).vardef,href);
  475. end;
  476. end;
  477. end;
  478. end;
  479. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef);
  480. begin
  481. case loc.loc of
  482. LOC_CREGISTER:
  483. begin
  484. {$ifdef cpu64bitalu}
  485. if loc.size in [OS_128,OS_S128] then
  486. begin
  487. loc.register128.reglo:=cg.getintregister(list,OS_64);
  488. loc.register128.reghi:=cg.getintregister(list,OS_64);
  489. end
  490. else
  491. {$else cpu64bitalu}
  492. if loc.size in [OS_64,OS_S64] then
  493. begin
  494. loc.register64.reglo:=cg.getintregister(list,OS_32);
  495. loc.register64.reghi:=cg.getintregister(list,OS_32);
  496. end
  497. else
  498. {$endif cpu64bitalu}
  499. if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then
  500. loc.register:=hlcg.getaddressregister(list,def)
  501. else
  502. loc.register:=cg.getintregister(list,loc.size);
  503. end;
  504. LOC_CFPUREGISTER:
  505. begin
  506. loc.register:=cg.getfpuregister(list,loc.size);
  507. end;
  508. LOC_CMMREGISTER:
  509. begin
  510. loc.register:=cg.getmmregister(list,loc.size);
  511. end;
  512. end;
  513. end;
  514. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
  515. var
  516. usedef: tdef;
  517. varloc: tai_varloc;
  518. begin
  519. if allocreg then
  520. begin
  521. if sym.typ=paravarsym then
  522. usedef:=tparavarsym(sym).paraloc[calleeside].def
  523. else
  524. usedef:=sym.vardef;
  525. gen_alloc_regloc(list,sym.initialloc,usedef);
  526. end;
  527. if (pi_has_label in current_procinfo.flags) then
  528. begin
  529. { Allocate register already, to prevent first allocation to be
  530. inside a loop }
  531. {$if defined(cpu64bitalu)}
  532. if sym.initialloc.size in [OS_128,OS_S128] then
  533. begin
  534. cg.a_reg_sync(list,sym.initialloc.register128.reglo);
  535. cg.a_reg_sync(list,sym.initialloc.register128.reghi);
  536. end
  537. else
  538. {$elseif defined(cpu32bitalu)}
  539. if sym.initialloc.size in [OS_64,OS_S64] then
  540. begin
  541. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  542. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  543. end
  544. else
  545. {$elseif defined(cpu16bitalu)}
  546. if sym.initialloc.size in [OS_64,OS_S64] then
  547. begin
  548. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  549. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reglo));
  550. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  551. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reghi));
  552. end
  553. else
  554. if sym.initialloc.size in [OS_32,OS_S32] then
  555. begin
  556. cg.a_reg_sync(list,sym.initialloc.register);
  557. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  558. end
  559. else
  560. {$elseif defined(cpu8bitalu)}
  561. if sym.initialloc.size in [OS_64,OS_S64] then
  562. begin
  563. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  564. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reglo));
  565. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register64.reglo)));
  566. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register64.reglo))));
  567. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  568. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reghi));
  569. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register64.reghi)));
  570. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register64.reghi))));
  571. end
  572. else
  573. if sym.initialloc.size in [OS_32,OS_S32] then
  574. begin
  575. cg.a_reg_sync(list,sym.initialloc.register);
  576. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  577. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register)));
  578. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register))));
  579. end
  580. else
  581. if sym.initialloc.size in [OS_16,OS_S16] then
  582. begin
  583. cg.a_reg_sync(list,sym.initialloc.register);
  584. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  585. end
  586. else
  587. {$endif}
  588. cg.a_reg_sync(list,sym.initialloc.register);
  589. end;
  590. {$ifdef cpu64bitalu}
  591. if (sym.initialloc.size in [OS_128,OS_S128]) then
  592. varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi)
  593. {$else cpu64bitalu}
  594. if (sym.initialloc.size in [OS_64,OS_S64]) then
  595. varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi)
  596. {$endif cpu64bitalu}
  597. else
  598. varloc:=tai_varloc.create(sym,sym.initialloc.register);
  599. list.concat(varloc);
  600. end;
  601. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  602. procedure unget_para(const paraloc:TCGParaLocation);
  603. begin
  604. case paraloc.loc of
  605. LOC_REGISTER :
  606. begin
  607. if getsupreg(paraloc.register)<first_int_imreg then
  608. cg.ungetcpuregister(list,paraloc.register);
  609. end;
  610. LOC_MMREGISTER :
  611. begin
  612. if getsupreg(paraloc.register)<first_mm_imreg then
  613. cg.ungetcpuregister(list,paraloc.register);
  614. end;
  615. LOC_FPUREGISTER :
  616. begin
  617. if getsupreg(paraloc.register)<first_fpu_imreg then
  618. cg.ungetcpuregister(list,paraloc.register);
  619. end;
  620. end;
  621. end;
  622. var
  623. paraloc : pcgparalocation;
  624. href : treference;
  625. sizeleft : aint;
  626. tempref : treference;
  627. {$ifdef mips}
  628. //tmpreg : tregister;
  629. {$endif mips}
  630. {$ifndef cpu64bitalu}
  631. tempreg : tregister;
  632. reg64 : tregister64;
  633. {$if defined(cpu8bitalu)}
  634. curparaloc : PCGParaLocation;
  635. {$endif defined(cpu8bitalu)}
  636. {$endif not cpu64bitalu}
  637. begin
  638. paraloc:=para.location;
  639. if not assigned(paraloc) then
  640. internalerror(200408203);
  641. { skip e.g. empty records }
  642. if (paraloc^.loc = LOC_VOID) then
  643. exit;
  644. case destloc.loc of
  645. LOC_REFERENCE :
  646. begin
  647. { If the parameter location is reused we don't need to copy
  648. anything }
  649. if not reusepara then
  650. begin
  651. href:=destloc.reference;
  652. sizeleft:=para.intsize;
  653. while assigned(paraloc) do
  654. begin
  655. if (paraloc^.size=OS_NO) then
  656. begin
  657. { Can only be a reference that contains the rest
  658. of the parameter }
  659. if (paraloc^.loc<>LOC_REFERENCE) or
  660. assigned(paraloc^.next) then
  661. internalerror(2005013010);
  662. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  663. inc(href.offset,sizeleft);
  664. sizeleft:=0;
  665. end
  666. else
  667. begin
  668. cg.a_load_cgparaloc_ref(list,paraloc^,href,tcgsize2size[paraloc^.size],destloc.reference.alignment);
  669. inc(href.offset,TCGSize2Size[paraloc^.size]);
  670. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  671. end;
  672. unget_para(paraloc^);
  673. paraloc:=paraloc^.next;
  674. end;
  675. end;
  676. end;
  677. LOC_REGISTER,
  678. LOC_CREGISTER :
  679. begin
  680. {$ifdef cpu64bitalu}
  681. if (para.size in [OS_128,OS_S128,OS_F128]) and
  682. ({ in case of fpu emulation, or abi's that pass fpu values
  683. via integer registers }
  684. (vardef.typ=floatdef) or
  685. is_methodpointer(vardef) or
  686. is_record(vardef)) then
  687. begin
  688. case paraloc^.loc of
  689. LOC_REGISTER,
  690. LOC_MMREGISTER:
  691. begin
  692. if not assigned(paraloc^.next) then
  693. internalerror(200410104);
  694. if (target_info.endian=ENDIAN_BIG) then
  695. begin
  696. { paraloc^ -> high
  697. paraloc^.next -> low }
  698. unget_para(paraloc^);
  699. gen_alloc_regloc(list,destloc,vardef);
  700. { reg->reg, alignment is irrelevant }
  701. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
  702. unget_para(paraloc^.next^);
  703. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8);
  704. end
  705. else
  706. begin
  707. { paraloc^ -> low
  708. paraloc^.next -> high }
  709. unget_para(paraloc^);
  710. gen_alloc_regloc(list,destloc,vardef);
  711. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
  712. unget_para(paraloc^.next^);
  713. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
  714. end;
  715. end;
  716. LOC_REFERENCE:
  717. begin
  718. gen_alloc_regloc(list,destloc,vardef);
  719. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment,[]);
  720. cg128.a_load128_ref_reg(list,href,destloc.register128);
  721. unget_para(paraloc^);
  722. end;
  723. else
  724. internalerror(2012090607);
  725. end
  726. end
  727. else
  728. {$else cpu64bitalu}
  729. if (para.size in [OS_64,OS_S64,OS_F64]) and
  730. (is_64bit(vardef) or
  731. { in case of fpu emulation, or abi's that pass fpu values
  732. via integer registers }
  733. (vardef.typ=floatdef) or
  734. is_methodpointer(vardef) or
  735. is_record(vardef)) then
  736. begin
  737. case paraloc^.loc of
  738. LOC_REGISTER:
  739. begin
  740. case para.locations_count of
  741. {$if defined(cpu8bitalu)}
  742. { 8 paralocs? }
  743. 8:
  744. if (target_info.endian=ENDIAN_BIG) then
  745. begin
  746. { is there any big endian 8 bit ALU/16 bit Addr CPU? }
  747. internalerror(2015041003);
  748. { paraloc^ -> high
  749. paraloc^.next^.next^.next^.next -> low }
  750. unget_para(paraloc^);
  751. gen_alloc_regloc(list,destloc,vardef);
  752. { reg->reg, alignment is irrelevant }
  753. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),1);
  754. unget_para(paraloc^.next^);
  755. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1);
  756. unget_para(paraloc^.next^.next^);
  757. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,GetNextReg(destloc.register64.reglo),1);
  758. unget_para(paraloc^.next^.next^.next^);
  759. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1);
  760. end
  761. else
  762. begin
  763. { paraloc^ -> low
  764. paraloc^.next^.next^.next^.next -> high }
  765. curparaloc:=paraloc;
  766. unget_para(curparaloc^);
  767. gen_alloc_regloc(list,destloc,vardef);
  768. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2);
  769. unget_para(curparaloc^.next^);
  770. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,GetNextReg(destloc.register64.reglo),1);
  771. unget_para(curparaloc^.next^.next^);
  772. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,GetNextReg(GetNextReg(destloc.register64.reglo)),1);
  773. unget_para(curparaloc^.next^.next^.next^);
  774. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,GetNextReg(GetNextReg(GetNextReg(destloc.register64.reglo))),1);
  775. curparaloc:=paraloc^.next^.next^.next^.next;
  776. unget_para(curparaloc^);
  777. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2);
  778. unget_para(curparaloc^.next^);
  779. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,GetNextReg(destloc.register64.reghi),1);
  780. unget_para(curparaloc^.next^.next^);
  781. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,GetNextReg(GetNextReg(destloc.register64.reghi)),1);
  782. unget_para(curparaloc^.next^.next^.next^);
  783. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,GetNextReg(GetNextReg(GetNextReg(destloc.register64.reghi))),1);
  784. end;
  785. {$endif defined(cpu8bitalu)}
  786. {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
  787. { 4 paralocs? }
  788. 4:
  789. if (target_info.endian=ENDIAN_BIG) then
  790. begin
  791. { paraloc^ -> high
  792. paraloc^.next^.next -> low }
  793. unget_para(paraloc^);
  794. gen_alloc_regloc(list,destloc,vardef);
  795. { reg->reg, alignment is irrelevant }
  796. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),2);
  797. unget_para(paraloc^.next^);
  798. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2);
  799. unget_para(paraloc^.next^.next^);
  800. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,GetNextReg(destloc.register64.reglo),2);
  801. unget_para(paraloc^.next^.next^.next^);
  802. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2);
  803. end
  804. else
  805. begin
  806. { paraloc^ -> low
  807. paraloc^.next^.next -> high }
  808. unget_para(paraloc^);
  809. gen_alloc_regloc(list,destloc,vardef);
  810. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2);
  811. unget_para(paraloc^.next^);
  812. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,GetNextReg(destloc.register64.reglo),2);
  813. unget_para(paraloc^.next^.next^);
  814. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2);
  815. unget_para(paraloc^.next^.next^.next^);
  816. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,GetNextReg(destloc.register64.reghi),2);
  817. end;
  818. {$endif defined(cpu16bitalu) or defined(cpu8bitalu)}
  819. 2:
  820. if (target_info.endian=ENDIAN_BIG) then
  821. begin
  822. { paraloc^ -> high
  823. paraloc^.next -> low }
  824. unget_para(paraloc^);
  825. gen_alloc_regloc(list,destloc,vardef);
  826. { reg->reg, alignment is irrelevant }
  827. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
  828. unget_para(paraloc^.next^);
  829. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4);
  830. end
  831. else
  832. begin
  833. { paraloc^ -> low
  834. paraloc^.next -> high }
  835. unget_para(paraloc^);
  836. gen_alloc_regloc(list,destloc,vardef);
  837. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
  838. unget_para(paraloc^.next^);
  839. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
  840. end;
  841. else
  842. { unexpected number of paralocs }
  843. internalerror(200410104);
  844. end;
  845. end;
  846. LOC_REFERENCE:
  847. begin
  848. gen_alloc_regloc(list,destloc,vardef);
  849. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment,[]);
  850. cg64.a_load64_ref_reg(list,href,destloc.register64);
  851. unget_para(paraloc^);
  852. end;
  853. else
  854. internalerror(2005101501);
  855. end
  856. end
  857. else
  858. {$endif cpu64bitalu}
  859. begin
  860. if assigned(paraloc^.next) then
  861. begin
  862. if (destloc.size in [OS_PAIR,OS_SPAIR]) and
  863. (para.Size in [OS_PAIR,OS_SPAIR]) then
  864. begin
  865. unget_para(paraloc^);
  866. gen_alloc_regloc(list,destloc,vardef);
  867. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
  868. unget_para(paraloc^.Next^);
  869. {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
  870. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
  871. {$else}
  872. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint));
  873. {$endif}
  874. end
  875. {$if defined(cpu8bitalu)}
  876. else if (destloc.size in [OS_32,OS_S32]) and
  877. (para.Size in [OS_32,OS_S32]) then
  878. begin
  879. unget_para(paraloc^);
  880. gen_alloc_regloc(list,destloc,vardef);
  881. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint));
  882. unget_para(paraloc^.Next^);
  883. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
  884. unget_para(paraloc^.Next^.Next^);
  885. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,GetNextReg(GetNextReg(destloc.register)),sizeof(aint));
  886. unget_para(paraloc^.Next^.Next^.Next^);
  887. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,GetNextReg(GetNextReg(GetNextReg(destloc.register))),sizeof(aint));
  888. end
  889. {$endif defined(cpu8bitalu)}
  890. else
  891. begin
  892. { this can happen if a parameter is spread over
  893. multiple paralocs, e.g. if a record with two single
  894. fields must be passed in two single precision
  895. registers }
  896. { does it fit in the register of destloc? }
  897. sizeleft:=para.intsize;
  898. if sizeleft<>vardef.size then
  899. internalerror(2014122806);
  900. if sizeleft<>tcgsize2size[destloc.size] then
  901. internalerror(200410105);
  902. { store everything first to memory, then load it in
  903. destloc }
  904. tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref);
  905. gen_alloc_regloc(list,destloc,vardef);
  906. while sizeleft>0 do
  907. begin
  908. if not assigned(paraloc) then
  909. internalerror(2014122807);
  910. unget_para(paraloc^);
  911. cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft));
  912. if (paraloc^.size=OS_NO) and
  913. assigned(paraloc^.next) then
  914. internalerror(2014122805);
  915. inc(tempref.offset,tcgsize2size[paraloc^.size]);
  916. dec(sizeleft,tcgsize2size[paraloc^.size]);
  917. paraloc:=paraloc^.next;
  918. end;
  919. dec(tempref.offset,para.intsize);
  920. cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register);
  921. tg.ungettemp(list,tempref);
  922. end;
  923. end
  924. else
  925. begin
  926. unget_para(paraloc^);
  927. gen_alloc_regloc(list,destloc,vardef);
  928. { we can't directly move regular registers into fpu
  929. registers }
  930. if getregtype(paraloc^.register)=R_FPUREGISTER then
  931. begin
  932. { store everything first to memory, then load it in
  933. destloc }
  934. tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref);
  935. cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment);
  936. cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register);
  937. tg.ungettemp(list,tempref);
  938. end
  939. else
  940. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint));
  941. end;
  942. end;
  943. end;
  944. LOC_FPUREGISTER,
  945. LOC_CFPUREGISTER :
  946. begin
  947. {$ifdef mips}
  948. if (destloc.size = paraloc^.Size) and
  949. (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
  950. begin
  951. unget_para(paraloc^);
  952. gen_alloc_regloc(list,destloc,vardef);
  953. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment);
  954. end
  955. else if (destloc.size = OS_F32) and
  956. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  957. begin
  958. gen_alloc_regloc(list,destloc,vardef);
  959. unget_para(paraloc^);
  960. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
  961. end
  962. { TODO: Produces invalid code, needs fixing together with regalloc setup. }
  963. {
  964. else if (destloc.size = OS_F64) and
  965. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
  966. (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  967. begin
  968. gen_alloc_regloc(list,destloc,vardef);
  969. tmpreg:=destloc.register;
  970. unget_para(paraloc^);
  971. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg));
  972. setsupreg(tmpreg,getsupreg(tmpreg)+1);
  973. unget_para(paraloc^.next^);
  974. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg));
  975. end
  976. }
  977. else
  978. begin
  979. sizeleft := TCGSize2Size[destloc.size];
  980. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  981. href:=tempref;
  982. while assigned(paraloc) do
  983. begin
  984. unget_para(paraloc^);
  985. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  986. inc(href.offset,TCGSize2Size[paraloc^.size]);
  987. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  988. paraloc:=paraloc^.next;
  989. end;
  990. gen_alloc_regloc(list,destloc,vardef);
  991. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  992. tg.UnGetTemp(list,tempref);
  993. end;
  994. {$else mips}
  995. {$if defined(sparc) or defined(arm)}
  996. { Arm and Sparc passes floats in int registers, when loading to fpu register
  997. we need a temp }
  998. sizeleft := TCGSize2Size[destloc.size];
  999. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  1000. href:=tempref;
  1001. while assigned(paraloc) do
  1002. begin
  1003. unget_para(paraloc^);
  1004. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  1005. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1006. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1007. paraloc:=paraloc^.next;
  1008. end;
  1009. gen_alloc_regloc(list,destloc,vardef);
  1010. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  1011. tg.UnGetTemp(list,tempref);
  1012. {$else defined(sparc) or defined(arm)}
  1013. unget_para(paraloc^);
  1014. gen_alloc_regloc(list,destloc,vardef);
  1015. { from register to register -> alignment is irrelevant }
  1016. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1017. if assigned(paraloc^.next) then
  1018. internalerror(200410109);
  1019. {$endif defined(sparc) or defined(arm)}
  1020. {$endif mips}
  1021. end;
  1022. LOC_MMREGISTER,
  1023. LOC_CMMREGISTER :
  1024. begin
  1025. {$ifndef cpu64bitalu}
  1026. { ARM vfp floats are passed in integer registers }
  1027. if (para.size=OS_F64) and
  1028. (paraloc^.size in [OS_32,OS_S32]) and
  1029. use_vectorfpu(vardef) then
  1030. begin
  1031. { we need 2x32bit reg }
  1032. if not assigned(paraloc^.next) or
  1033. assigned(paraloc^.next^.next) then
  1034. internalerror(2009112421);
  1035. unget_para(paraloc^.next^);
  1036. case paraloc^.next^.loc of
  1037. LOC_REGISTER:
  1038. tempreg:=paraloc^.next^.register;
  1039. LOC_REFERENCE:
  1040. begin
  1041. tempreg:=cg.getintregister(list,OS_32);
  1042. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4);
  1043. end;
  1044. else
  1045. internalerror(2012051301);
  1046. end;
  1047. { don't free before the above, because then the getintregister
  1048. could reallocate this register and overwrite it }
  1049. unget_para(paraloc^);
  1050. gen_alloc_regloc(list,destloc,vardef);
  1051. if (target_info.endian=endian_big) then
  1052. { paraloc^ -> high
  1053. paraloc^.next -> low }
  1054. reg64:=joinreg64(tempreg,paraloc^.register)
  1055. else
  1056. reg64:=joinreg64(paraloc^.register,tempreg);
  1057. cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register);
  1058. end
  1059. else
  1060. {$endif not cpu64bitalu}
  1061. begin
  1062. if not assigned(paraloc^.next) then
  1063. begin
  1064. unget_para(paraloc^);
  1065. gen_alloc_regloc(list,destloc,vardef);
  1066. { from register to register -> alignment is irrelevant }
  1067. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1068. end
  1069. else
  1070. begin
  1071. internalerror(200410108);
  1072. end;
  1073. { data could come in two memory locations, for now
  1074. we simply ignore the sanity check (FK)
  1075. if assigned(paraloc^.next) then
  1076. internalerror(200410108);
  1077. }
  1078. end;
  1079. end;
  1080. else
  1081. internalerror(2010052903);
  1082. end;
  1083. end;
  1084. procedure gen_load_para_value(list:TAsmList);
  1085. procedure get_para(const paraloc:TCGParaLocation);
  1086. begin
  1087. case paraloc.loc of
  1088. LOC_REGISTER :
  1089. begin
  1090. if getsupreg(paraloc.register)<first_int_imreg then
  1091. cg.getcpuregister(list,paraloc.register);
  1092. end;
  1093. LOC_MMREGISTER :
  1094. begin
  1095. if getsupreg(paraloc.register)<first_mm_imreg then
  1096. cg.getcpuregister(list,paraloc.register);
  1097. end;
  1098. LOC_FPUREGISTER :
  1099. begin
  1100. if getsupreg(paraloc.register)<first_fpu_imreg then
  1101. cg.getcpuregister(list,paraloc.register);
  1102. end;
  1103. end;
  1104. end;
  1105. var
  1106. i : longint;
  1107. currpara : tparavarsym;
  1108. paraloc : pcgparalocation;
  1109. begin
  1110. if (po_assembler in current_procinfo.procdef.procoptions) or
  1111. { exceptfilters have a single hidden 'parentfp' parameter, which
  1112. is handled by tcg.g_proc_entry. }
  1113. (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  1114. exit;
  1115. { Allocate registers used by parameters }
  1116. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1117. begin
  1118. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1119. paraloc:=currpara.paraloc[calleeside].location;
  1120. while assigned(paraloc) do
  1121. begin
  1122. if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
  1123. get_para(paraloc^);
  1124. paraloc:=paraloc^.next;
  1125. end;
  1126. end;
  1127. { Copy parameters to local references/registers }
  1128. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1129. begin
  1130. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1131. { don't use currpara.vardef, as this will be wrong in case of
  1132. call-by-reference parameters (it won't contain the pointerdef) }
  1133. gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
  1134. { gen_load_cgpara_loc() already allocated the initialloc
  1135. -> don't allocate again }
  1136. if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then
  1137. begin
  1138. gen_alloc_regvar(list,currpara,false);
  1139. hlcg.varsym_set_localloc(list,currpara);
  1140. end;
  1141. end;
  1142. { generate copies of call by value parameters, must be done before
  1143. the initialization and body is parsed because the refcounts are
  1144. incremented using the local copies }
  1145. current_procinfo.procdef.parast.SymList.ForEachCall(@hlcg.g_copyvalueparas,list);
  1146. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1147. begin
  1148. { initialize refcounted paras, and trash others. Needed here
  1149. instead of in gen_initialize_code, because when a reference is
  1150. intialised or trashed while the pointer to that reference is kept
  1151. in a regvar, we add a register move and that one again has to
  1152. come after the parameter loading code as far as the register
  1153. allocator is concerned }
  1154. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  1155. end;
  1156. end;
  1157. {****************************************************************************
  1158. Entry/Exit
  1159. ****************************************************************************}
  1160. procedure alloc_proc_symbol(pd: tprocdef);
  1161. var
  1162. item : TCmdStrListItem;
  1163. begin
  1164. item := TCmdStrListItem(pd.aliasnames.first);
  1165. while assigned(item) do
  1166. begin
  1167. { The condition to use global or local symbol must match
  1168. the code written in hlcg.gen_proc_symbol to
  1169. avoid change from AB_LOCAL to AB_GLOBAL, which generates
  1170. erroneous code (at least for targets using GOT) }
  1171. if (cs_profile in current_settings.moduleswitches) or
  1172. (po_global in current_procinfo.procdef.procoptions) then
  1173. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION,pd)
  1174. else
  1175. current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION,pd);
  1176. item := TCmdStrListItem(item.next);
  1177. end;
  1178. end;
  1179. procedure release_proc_symbol(pd:tprocdef);
  1180. var
  1181. idx : longint;
  1182. item : TCmdStrListItem;
  1183. begin
  1184. item:=TCmdStrListItem(pd.aliasnames.first);
  1185. while assigned(item) do
  1186. begin
  1187. idx:=current_asmdata.AsmSymbolDict.findindexof(item.str);
  1188. if idx>=0 then
  1189. current_asmdata.AsmSymbolDict.Delete(idx);
  1190. item:=TCmdStrListItem(item.next);
  1191. end;
  1192. end;
  1193. procedure gen_proc_entry_code(list:TAsmList);
  1194. var
  1195. hitemp,
  1196. lotemp, stack_frame_size : longint;
  1197. begin
  1198. { generate call frame marker for dwarf call frame info }
  1199. current_asmdata.asmcfi.start_frame(list);
  1200. { All temps are know, write offsets used for information }
  1201. if (cs_asm_source in current_settings.globalswitches) and
  1202. (current_procinfo.tempstart<>tg.lasttemp) then
  1203. begin
  1204. if tg.direction>0 then
  1205. begin
  1206. lotemp:=current_procinfo.tempstart;
  1207. hitemp:=tg.lasttemp;
  1208. end
  1209. else
  1210. begin
  1211. lotemp:=tg.lasttemp;
  1212. hitemp:=current_procinfo.tempstart;
  1213. end;
  1214. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1215. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1216. end;
  1217. { generate target specific proc entry code }
  1218. stack_frame_size := current_procinfo.calc_stackframe_size;
  1219. if (stack_frame_size <> 0) and
  1220. (po_nostackframe in current_procinfo.procdef.procoptions) then
  1221. message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size));
  1222. hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1223. end;
  1224. procedure gen_proc_exit_code(list:TAsmList);
  1225. var
  1226. parasize : longint;
  1227. begin
  1228. { c style clearstack does not need to remove parameters from the stack, only the
  1229. return value when it was pushed by arguments }
  1230. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1231. begin
  1232. parasize:=0;
  1233. { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para
  1234. which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. }
  1235. if not ( (current_procinfo.procdef.proccalloption=pocall_safecall) and
  1236. (tf_safecall_exceptions in target_info.flags) ) and
  1237. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1238. inc(parasize,sizeof(pint));
  1239. end
  1240. else
  1241. begin
  1242. parasize:=current_procinfo.para_stack_size;
  1243. { the parent frame pointer para has to be removed by the caller in
  1244. case of Delphi-style parent frame pointer passing }
  1245. if not paramanager.use_fixed_stack and
  1246. (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
  1247. dec(parasize,sizeof(pint));
  1248. end;
  1249. { generate target specific proc exit code }
  1250. hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1251. { release return registers, needed for optimizer }
  1252. if not is_void(current_procinfo.procdef.returndef) then
  1253. paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);
  1254. { end of frame marker for call frame info }
  1255. current_asmdata.asmcfi.end_frame(list);
  1256. end;
  1257. procedure gen_save_used_regs(list:TAsmList);
  1258. begin
  1259. { Pure assembler routines need to save the registers themselves }
  1260. if (po_assembler in current_procinfo.procdef.procoptions) then
  1261. exit;
  1262. { oldfpccall expects all registers to be destroyed }
  1263. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1264. cg.g_save_registers(list);
  1265. end;
  1266. procedure gen_restore_used_regs(list:TAsmList);
  1267. begin
  1268. { Pure assembler routines need to save the registers themselves }
  1269. if (po_assembler in current_procinfo.procdef.procoptions) then
  1270. exit;
  1271. { oldfpccall expects all registers to be destroyed }
  1272. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1273. cg.g_restore_registers(list);
  1274. end;
  1275. {****************************************************************************
  1276. Const Data
  1277. ****************************************************************************}
  1278. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  1279. var
  1280. i : longint;
  1281. highsym,
  1282. sym : tsym;
  1283. vs : tabstractnormalvarsym;
  1284. ptrdef : tdef;
  1285. isaddr : boolean;
  1286. begin
  1287. for i:=0 to st.SymList.Count-1 do
  1288. begin
  1289. sym:=tsym(st.SymList[i]);
  1290. case sym.typ of
  1291. staticvarsym :
  1292. begin
  1293. vs:=tabstractnormalvarsym(sym);
  1294. { The code in loadnode.pass_generatecode will create the
  1295. LOC_REFERENCE instead for all none register variables. This is
  1296. required because we can't store an asmsymbol in the localloc because
  1297. the asmsymbol is invalid after an unit is compiled. This gives
  1298. problems when this procedure is inlined in another unit (PFV) }
  1299. if vs.is_regvar(false) then
  1300. begin
  1301. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1302. vs.initialloc.size:=def_cgsize(vs.vardef);
  1303. gen_alloc_regvar(list,vs,true);
  1304. hlcg.varsym_set_localloc(list,vs);
  1305. end;
  1306. end;
  1307. paravarsym :
  1308. begin
  1309. vs:=tabstractnormalvarsym(sym);
  1310. { Parameters passed to assembler procedures need to be kept
  1311. in the original location }
  1312. if (po_assembler in pd.procoptions) then
  1313. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  1314. { exception filters receive their frame pointer as a parameter }
  1315. else if (pd.proctypeoption=potype_exceptfilter) and
  1316. (vo_is_parentfp in vs.varoptions) then
  1317. begin
  1318. location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
  1319. vs.initialloc.register:=NR_FRAME_POINTER_REG;
  1320. end
  1321. else
  1322. begin
  1323. { if an open array is used, also its high parameter is used,
  1324. since the hidden high parameters are inserted after the corresponding symbols,
  1325. we can increase the ref. count here }
  1326. if is_open_array(vs.vardef) or is_array_of_const(vs.vardef) then
  1327. begin
  1328. highsym:=get_high_value_sym(tparavarsym(vs));
  1329. if assigned(highsym) then
  1330. inc(highsym.refs);
  1331. end;
  1332. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,pd.proccalloption);
  1333. if isaddr then
  1334. vs.initialloc.size:=def_cgsize(voidpointertype)
  1335. else
  1336. vs.initialloc.size:=def_cgsize(vs.vardef);
  1337. if vs.is_regvar(isaddr) then
  1338. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  1339. else
  1340. begin
  1341. vs.initialloc.loc:=LOC_REFERENCE;
  1342. { Reuse the parameter location for values to are at a single location on the stack }
  1343. if paramanager.param_use_paraloc(tparavarsym(vs).paraloc[calleeside]) then
  1344. begin
  1345. hlcg.paravarsym_set_initialloc_to_paraloc(tparavarsym(vs));
  1346. end
  1347. else
  1348. begin
  1349. if isaddr then
  1350. begin
  1351. ptrdef:=cpointerdef.getreusable(vs.vardef);
  1352. tg.GetLocal(list,ptrdef.size,ptrdef,vs.initialloc.reference)
  1353. end
  1354. else
  1355. tg.GetLocal(list,vs.getsize,tparavarsym(vs).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  1356. end;
  1357. end;
  1358. end;
  1359. hlcg.varsym_set_localloc(list,vs);
  1360. end;
  1361. localvarsym :
  1362. begin
  1363. vs:=tabstractnormalvarsym(sym);
  1364. vs.initialloc.size:=def_cgsize(vs.vardef);
  1365. if ([po_assembler,po_nostackframe] * pd.procoptions = [po_assembler,po_nostackframe]) and
  1366. (vo_is_funcret in vs.varoptions) then
  1367. begin
  1368. paramanager.create_funcretloc_info(pd,calleeside);
  1369. if assigned(pd.funcretloc[calleeside].location^.next) then
  1370. begin
  1371. { can't replace references to "result" with a complex
  1372. location expression inside assembler code }
  1373. location_reset(vs.initialloc,LOC_INVALID,OS_NO);
  1374. end
  1375. else
  1376. pd.funcretloc[calleeside].get_location(vs.initialloc);
  1377. end
  1378. else if (m_delphi in current_settings.modeswitches) and
  1379. (po_assembler in pd.procoptions) and
  1380. (vo_is_funcret in vs.varoptions) and
  1381. (vs.refs=0) then
  1382. begin
  1383. { not referenced, so don't allocate. Use dummy to }
  1384. { avoid ie's later on because of LOC_INVALID }
  1385. vs.initialloc.loc:=LOC_REGISTER;
  1386. vs.initialloc.size:=OS_INT;
  1387. vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
  1388. end
  1389. else if vs.is_regvar(false) then
  1390. begin
  1391. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1392. gen_alloc_regvar(list,vs,true);
  1393. end
  1394. else
  1395. begin
  1396. vs.initialloc.loc:=LOC_REFERENCE;
  1397. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  1398. end;
  1399. hlcg.varsym_set_localloc(list,vs);
  1400. end;
  1401. end;
  1402. end;
  1403. end;
  1404. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  1405. begin
  1406. case location.loc of
  1407. LOC_CREGISTER:
  1408. {$if defined(cpu64bitalu)}
  1409. if location.size in [OS_128,OS_S128] then
  1410. begin
  1411. rv.intregvars.addnodup(getsupreg(location.register128.reglo));
  1412. rv.intregvars.addnodup(getsupreg(location.register128.reghi));
  1413. end
  1414. else
  1415. {$elseif defined(cpu32bitalu)}
  1416. if location.size in [OS_64,OS_S64] then
  1417. begin
  1418. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1419. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1420. end
  1421. else
  1422. {$elseif defined(cpu16bitalu)}
  1423. if location.size in [OS_64,OS_S64] then
  1424. begin
  1425. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1426. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reglo)));
  1427. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1428. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reghi)));
  1429. end
  1430. else
  1431. if location.size in [OS_32,OS_S32] then
  1432. begin
  1433. rv.intregvars.addnodup(getsupreg(location.register));
  1434. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1435. end
  1436. else
  1437. {$elseif defined(cpu8bitalu)}
  1438. if location.size in [OS_64,OS_S64] then
  1439. begin
  1440. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1441. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reglo)));
  1442. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register64.reglo))));
  1443. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register64.reglo)))));
  1444. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1445. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reghi)));
  1446. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register64.reghi))));
  1447. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register64.reghi)))));
  1448. end
  1449. else
  1450. if location.size in [OS_32,OS_S32] then
  1451. begin
  1452. rv.intregvars.addnodup(getsupreg(location.register));
  1453. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1454. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register))));
  1455. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register)))));
  1456. end
  1457. else
  1458. if location.size in [OS_16,OS_S16] then
  1459. begin
  1460. rv.intregvars.addnodup(getsupreg(location.register));
  1461. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1462. end
  1463. else
  1464. {$endif}
  1465. if getregtype(location.register)=R_INTREGISTER then
  1466. rv.intregvars.addnodup(getsupreg(location.register))
  1467. else
  1468. rv.addrregvars.addnodup(getsupreg(location.register));
  1469. LOC_CFPUREGISTER:
  1470. rv.fpuregvars.addnodup(getsupreg(location.register));
  1471. LOC_CMMREGISTER:
  1472. rv.mmregvars.addnodup(getsupreg(location.register));
  1473. end;
  1474. end;
  1475. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  1476. var
  1477. rv: pusedregvars absolute arg;
  1478. begin
  1479. case (n.nodetype) of
  1480. temprefn:
  1481. { We only have to synchronise a tempnode before a loop if it is }
  1482. { not created inside the loop, and only synchronise after the }
  1483. { loop if it's not destroyed inside the loop. If it's created }
  1484. { before the loop and not yet destroyed, then before the loop }
  1485. { is secondpassed tempinfo^.valid will be true, and we get the }
  1486. { correct registers. If it's not destroyed inside the loop, }
  1487. { then after the loop has been secondpassed tempinfo^.valid }
  1488. { be true and we also get the right registers. In other cases, }
  1489. { tempinfo^.valid will be false and so we do not add }
  1490. { unnecessary registers. This way, we don't have to look at }
  1491. { tempcreate and tempdestroy nodes to get this info (JM) }
  1492. if (ti_valid in ttemprefnode(n).tempflags) then
  1493. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  1494. loadn:
  1495. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1496. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  1497. vecn:
  1498. { range checks sometimes need the high parameter }
  1499. if (cs_check_range in current_settings.localswitches) and
  1500. (is_open_array(tvecnode(n).left.resultdef) or
  1501. is_array_of_const(tvecnode(n).left.resultdef)) and
  1502. not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  1503. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  1504. end;
  1505. result := fen_true;
  1506. end;
  1507. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  1508. begin
  1509. foreachnodestatic(n,@do_get_used_regvars,@rv);
  1510. end;
  1511. (*
  1512. See comments at declaration of pusedregvarscommon
  1513. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  1514. var
  1515. rv: pusedregvarscommon absolute arg;
  1516. begin
  1517. if (n.nodetype = loadn) and
  1518. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1519. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  1520. case loc of
  1521. LOC_CREGISTER:
  1522. { if not yet encountered in this node tree }
  1523. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1524. { but nevertheless already encountered somewhere }
  1525. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1526. { then it's a regvar used in two or more node trees }
  1527. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1528. LOC_CFPUREGISTER:
  1529. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1530. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1531. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1532. LOC_CMMREGISTER:
  1533. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1534. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1535. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1536. end;
  1537. result := fen_true;
  1538. end;
  1539. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  1540. begin
  1541. rv.myregvars.intregvars.clear;
  1542. rv.myregvars.fpuregvars.clear;
  1543. rv.myregvars.mmregvars.clear;
  1544. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  1545. end;
  1546. *)
  1547. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  1548. var
  1549. count: longint;
  1550. begin
  1551. for count := 1 to rv.intregvars.length do
  1552. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  1553. for count := 1 to rv.addrregvars.length do
  1554. cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE));
  1555. for count := 1 to rv.fpuregvars.length do
  1556. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  1557. for count := 1 to rv.mmregvars.length do
  1558. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  1559. end;
  1560. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  1561. var
  1562. i : longint;
  1563. sym : tsym;
  1564. begin
  1565. for i:=0 to st.SymList.Count-1 do
  1566. begin
  1567. sym:=tsym(st.SymList[i]);
  1568. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  1569. begin
  1570. with tabstractnormalvarsym(sym) do
  1571. begin
  1572. { Note: We need to keep the data available in memory
  1573. for the sub procedures that can access local data
  1574. in the parent procedures }
  1575. case localloc.loc of
  1576. LOC_CREGISTER :
  1577. if (pi_has_label in current_procinfo.flags) then
  1578. {$if defined(cpu64bitalu)}
  1579. if def_cgsize(vardef) in [OS_128,OS_S128] then
  1580. begin
  1581. cg.a_reg_sync(list,localloc.register128.reglo);
  1582. cg.a_reg_sync(list,localloc.register128.reghi);
  1583. end
  1584. else
  1585. {$elseif defined(cpu32bitalu)}
  1586. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1587. begin
  1588. cg.a_reg_sync(list,localloc.register64.reglo);
  1589. cg.a_reg_sync(list,localloc.register64.reghi);
  1590. end
  1591. else
  1592. {$elseif defined(cpu16bitalu)}
  1593. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1594. begin
  1595. cg.a_reg_sync(list,localloc.register64.reglo);
  1596. cg.a_reg_sync(list,GetNextReg(localloc.register64.reglo));
  1597. cg.a_reg_sync(list,localloc.register64.reghi);
  1598. cg.a_reg_sync(list,GetNextReg(localloc.register64.reghi));
  1599. end
  1600. else
  1601. if def_cgsize(vardef) in [OS_32,OS_S32] then
  1602. begin
  1603. cg.a_reg_sync(list,localloc.register);
  1604. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1605. end
  1606. else
  1607. {$elseif defined(cpu8bitalu)}
  1608. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1609. begin
  1610. cg.a_reg_sync(list,localloc.register64.reglo);
  1611. cg.a_reg_sync(list,GetNextReg(localloc.register64.reglo));
  1612. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register64.reglo)));
  1613. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register64.reglo))));
  1614. cg.a_reg_sync(list,localloc.register64.reghi);
  1615. cg.a_reg_sync(list,GetNextReg(localloc.register64.reghi));
  1616. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register64.reghi)));
  1617. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register64.reghi))));
  1618. end
  1619. else
  1620. if def_cgsize(vardef) in [OS_32,OS_S32] then
  1621. begin
  1622. cg.a_reg_sync(list,localloc.register);
  1623. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1624. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register)));
  1625. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register))));
  1626. end
  1627. else
  1628. if def_cgsize(vardef) in [OS_16,OS_S16] then
  1629. begin
  1630. cg.a_reg_sync(list,localloc.register);
  1631. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1632. end
  1633. else
  1634. {$endif}
  1635. cg.a_reg_sync(list,localloc.register);
  1636. LOC_CFPUREGISTER,
  1637. LOC_CMMREGISTER:
  1638. if (pi_has_label in current_procinfo.flags) then
  1639. cg.a_reg_sync(list,localloc.register);
  1640. LOC_REFERENCE :
  1641. begin
  1642. if typ in [localvarsym,paravarsym] then
  1643. tg.Ungetlocal(list,localloc.reference);
  1644. end;
  1645. end;
  1646. end;
  1647. end;
  1648. end;
  1649. end;
  1650. function getprocalign : shortint;
  1651. begin
  1652. { gprof uses 16 byte granularity }
  1653. if (cs_profile in current_settings.moduleswitches) then
  1654. result:=16
  1655. else
  1656. result:=current_settings.alignment.procalign;
  1657. end;
  1658. procedure gen_fpc_dummy(list : TAsmList);
  1659. begin
  1660. {$ifdef i386}
  1661. { fix me! }
  1662. list.concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX));
  1663. list.concat(Taicpu.Op_const(A_RET,S_W,12));
  1664. {$endif i386}
  1665. end;
  1666. procedure gen_load_frame_for_exceptfilter(list : TAsmList);
  1667. var
  1668. para: tparavarsym;
  1669. begin
  1670. para:=tparavarsym(current_procinfo.procdef.paras[0]);
  1671. if not (vo_is_parentfp in para.varoptions) then
  1672. InternalError(201201142);
  1673. if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
  1674. (para.paraloc[calleeside].location^.next<>nil) then
  1675. InternalError(201201143);
  1676. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,para.paraloc[calleeside].location^.register,
  1677. NR_FRAME_POINTER_REG);
  1678. end;
  1679. end.