ncgutil.pas 84 KB

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