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