ncgutil.pas 86 KB

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