2
0

ncgutil.pas 84 KB

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