ncgutil.pas 84 KB

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