ncgutil.pas 84 KB

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