ncgutil.pas 84 KB

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