ncgutil.pas 84 KB

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