ncgutil.pas 84 KB

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