ncgutil.pas 85 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935
  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. 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. varloc: tai_varloc;
  625. begin
  626. if allocreg then
  627. begin
  628. if sym.typ=paravarsym then
  629. usedef:=tparavarsym(sym).paraloc[calleeside].def
  630. else
  631. usedef:=sym.vardef;
  632. gen_alloc_regloc(list,sym.initialloc,usedef);
  633. end;
  634. if (pi_has_label in current_procinfo.flags) then
  635. begin
  636. { Allocate register already, to prevent first allocation to be
  637. inside a loop }
  638. {$if defined(cpu64bitalu)}
  639. if sym.initialloc.size in [OS_128,OS_S128] then
  640. begin
  641. cg.a_reg_sync(list,sym.initialloc.register128.reglo);
  642. cg.a_reg_sync(list,sym.initialloc.register128.reghi);
  643. end
  644. else
  645. {$elseif defined(cpu32bitalu)}
  646. if sym.initialloc.size in [OS_64,OS_S64] then
  647. begin
  648. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  649. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  650. end
  651. else
  652. {$elseif defined(cpu16bitalu)}
  653. if sym.initialloc.size in [OS_64,OS_S64] then
  654. begin
  655. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  656. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reglo));
  657. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  658. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reghi));
  659. end
  660. else
  661. if sym.initialloc.size in [OS_32,OS_S32] then
  662. begin
  663. cg.a_reg_sync(list,sym.initialloc.register);
  664. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  665. end
  666. else
  667. {$elseif defined(cpu8bitalu)}
  668. if sym.initialloc.size in [OS_64,OS_S64] then
  669. begin
  670. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  671. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reglo));
  672. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register64.reglo)));
  673. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register64.reglo))));
  674. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  675. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register64.reghi));
  676. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register64.reghi)));
  677. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register64.reghi))));
  678. end
  679. else
  680. if sym.initialloc.size in [OS_32,OS_S32] then
  681. begin
  682. cg.a_reg_sync(list,sym.initialloc.register);
  683. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  684. cg.a_reg_sync(list,GetNextReg(GetNextReg(sym.initialloc.register)));
  685. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(sym.initialloc.register))));
  686. end
  687. else
  688. if sym.initialloc.size in [OS_16,OS_S16] then
  689. begin
  690. cg.a_reg_sync(list,sym.initialloc.register);
  691. cg.a_reg_sync(list,GetNextReg(sym.initialloc.register));
  692. end
  693. else
  694. {$endif}
  695. cg.a_reg_sync(list,sym.initialloc.register);
  696. end;
  697. {$ifdef cpu64bitalu}
  698. if (sym.initialloc.size in [OS_128,OS_S128]) then
  699. varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi)
  700. {$else cpu64bitalu}
  701. if (sym.initialloc.size in [OS_64,OS_S64]) then
  702. varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi)
  703. {$endif cpu64bitalu}
  704. else
  705. varloc:=tai_varloc.create(sym,sym.initialloc.register);
  706. list.concat(varloc);
  707. end;
  708. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  709. procedure unget_para(const paraloc:TCGParaLocation);
  710. begin
  711. case paraloc.loc of
  712. LOC_REGISTER :
  713. begin
  714. if getsupreg(paraloc.register)<first_int_imreg then
  715. cg.ungetcpuregister(list,paraloc.register);
  716. end;
  717. LOC_MMREGISTER :
  718. begin
  719. if getsupreg(paraloc.register)<first_mm_imreg then
  720. cg.ungetcpuregister(list,paraloc.register);
  721. end;
  722. LOC_FPUREGISTER :
  723. begin
  724. if getsupreg(paraloc.register)<first_fpu_imreg then
  725. cg.ungetcpuregister(list,paraloc.register);
  726. end;
  727. end;
  728. end;
  729. var
  730. paraloc : pcgparalocation;
  731. href : treference;
  732. sizeleft : aint;
  733. tempref : treference;
  734. {$ifdef mips}
  735. //tmpreg : tregister;
  736. {$endif mips}
  737. {$ifndef cpu64bitalu}
  738. tempreg : tregister;
  739. reg64 : tregister64;
  740. {$if defined(cpu8bitalu)}
  741. curparaloc : PCGParaLocation;
  742. {$endif defined(cpu8bitalu)}
  743. {$endif not cpu64bitalu}
  744. begin
  745. paraloc:=para.location;
  746. if not assigned(paraloc) then
  747. internalerror(200408203);
  748. { skip e.g. empty records }
  749. if (paraloc^.loc = LOC_VOID) then
  750. exit;
  751. case destloc.loc of
  752. LOC_REFERENCE :
  753. begin
  754. { If the parameter location is reused we don't need to copy
  755. anything }
  756. if not reusepara then
  757. begin
  758. href:=destloc.reference;
  759. sizeleft:=para.intsize;
  760. while assigned(paraloc) do
  761. begin
  762. if (paraloc^.size=OS_NO) then
  763. begin
  764. { Can only be a reference that contains the rest
  765. of the parameter }
  766. if (paraloc^.loc<>LOC_REFERENCE) or
  767. assigned(paraloc^.next) then
  768. internalerror(2005013010);
  769. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  770. inc(href.offset,sizeleft);
  771. sizeleft:=0;
  772. end
  773. else
  774. begin
  775. cg.a_load_cgparaloc_ref(list,paraloc^,href,tcgsize2size[paraloc^.size],destloc.reference.alignment);
  776. inc(href.offset,TCGSize2Size[paraloc^.size]);
  777. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  778. end;
  779. unget_para(paraloc^);
  780. paraloc:=paraloc^.next;
  781. end;
  782. end;
  783. end;
  784. LOC_REGISTER,
  785. LOC_CREGISTER :
  786. begin
  787. {$ifdef cpu64bitalu}
  788. if (para.size in [OS_128,OS_S128,OS_F128]) and
  789. ({ in case of fpu emulation, or abi's that pass fpu values
  790. via integer registers }
  791. (vardef.typ=floatdef) or
  792. is_methodpointer(vardef) or
  793. is_record(vardef)) then
  794. begin
  795. case paraloc^.loc of
  796. LOC_REGISTER,
  797. LOC_MMREGISTER:
  798. begin
  799. if not assigned(paraloc^.next) then
  800. internalerror(200410104);
  801. if (target_info.endian=ENDIAN_BIG) then
  802. begin
  803. { paraloc^ -> high
  804. paraloc^.next -> low }
  805. unget_para(paraloc^);
  806. gen_alloc_regloc(list,destloc,vardef);
  807. { reg->reg, alignment is irrelevant }
  808. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
  809. unget_para(paraloc^.next^);
  810. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8);
  811. end
  812. else
  813. begin
  814. { paraloc^ -> low
  815. paraloc^.next -> high }
  816. unget_para(paraloc^);
  817. gen_alloc_regloc(list,destloc,vardef);
  818. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
  819. unget_para(paraloc^.next^);
  820. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
  821. end;
  822. end;
  823. LOC_REFERENCE:
  824. begin
  825. gen_alloc_regloc(list,destloc,vardef);
  826. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment,[]);
  827. cg128.a_load128_ref_reg(list,href,destloc.register128);
  828. unget_para(paraloc^);
  829. end;
  830. else
  831. internalerror(2012090607);
  832. end
  833. end
  834. else
  835. {$else cpu64bitalu}
  836. if (para.size in [OS_64,OS_S64,OS_F64]) and
  837. (is_64bit(vardef) or
  838. { in case of fpu emulation, or abi's that pass fpu values
  839. via integer registers }
  840. (vardef.typ=floatdef) or
  841. is_methodpointer(vardef) or
  842. is_record(vardef)) then
  843. begin
  844. case paraloc^.loc of
  845. LOC_REGISTER:
  846. begin
  847. case para.locations_count of
  848. {$if defined(cpu8bitalu)}
  849. { 8 paralocs? }
  850. 8:
  851. if (target_info.endian=ENDIAN_BIG) then
  852. begin
  853. { is there any big endian 8 bit ALU/16 bit Addr CPU? }
  854. internalerror(2015041003);
  855. { paraloc^ -> high
  856. paraloc^.next^.next^.next^.next -> low }
  857. unget_para(paraloc^);
  858. gen_alloc_regloc(list,destloc,vardef);
  859. { reg->reg, alignment is irrelevant }
  860. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),1);
  861. unget_para(paraloc^.next^);
  862. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1);
  863. unget_para(paraloc^.next^.next^);
  864. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,GetNextReg(destloc.register64.reglo),1);
  865. unget_para(paraloc^.next^.next^.next^);
  866. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1);
  867. end
  868. else
  869. begin
  870. { paraloc^ -> low
  871. paraloc^.next^.next^.next^.next -> high }
  872. curparaloc:=paraloc;
  873. unget_para(curparaloc^);
  874. gen_alloc_regloc(list,destloc,vardef);
  875. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2);
  876. unget_para(curparaloc^.next^);
  877. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,GetNextReg(destloc.register64.reglo),1);
  878. unget_para(curparaloc^.next^.next^);
  879. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,GetNextReg(GetNextReg(destloc.register64.reglo)),1);
  880. unget_para(curparaloc^.next^.next^.next^);
  881. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,GetNextReg(GetNextReg(GetNextReg(destloc.register64.reglo))),1);
  882. curparaloc:=paraloc^.next^.next^.next^.next;
  883. unget_para(curparaloc^);
  884. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2);
  885. unget_para(curparaloc^.next^);
  886. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,GetNextReg(destloc.register64.reghi),1);
  887. unget_para(curparaloc^.next^.next^);
  888. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,GetNextReg(GetNextReg(destloc.register64.reghi)),1);
  889. unget_para(curparaloc^.next^.next^.next^);
  890. cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,GetNextReg(GetNextReg(GetNextReg(destloc.register64.reghi))),1);
  891. end;
  892. {$endif defined(cpu8bitalu)}
  893. {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
  894. { 4 paralocs? }
  895. 4:
  896. if (target_info.endian=ENDIAN_BIG) then
  897. begin
  898. { paraloc^ -> high
  899. paraloc^.next^.next -> low }
  900. unget_para(paraloc^);
  901. gen_alloc_regloc(list,destloc,vardef);
  902. { reg->reg, alignment is irrelevant }
  903. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,GetNextReg(destloc.register64.reghi),2);
  904. unget_para(paraloc^.next^);
  905. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2);
  906. unget_para(paraloc^.next^.next^);
  907. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,GetNextReg(destloc.register64.reglo),2);
  908. unget_para(paraloc^.next^.next^.next^);
  909. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2);
  910. end
  911. else
  912. begin
  913. { paraloc^ -> low
  914. paraloc^.next^.next -> high }
  915. unget_para(paraloc^);
  916. gen_alloc_regloc(list,destloc,vardef);
  917. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2);
  918. unget_para(paraloc^.next^);
  919. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,GetNextReg(destloc.register64.reglo),2);
  920. unget_para(paraloc^.next^.next^);
  921. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2);
  922. unget_para(paraloc^.next^.next^.next^);
  923. cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,GetNextReg(destloc.register64.reghi),2);
  924. end;
  925. {$endif defined(cpu16bitalu) or defined(cpu8bitalu)}
  926. 2:
  927. if (target_info.endian=ENDIAN_BIG) then
  928. begin
  929. { paraloc^ -> high
  930. paraloc^.next -> low }
  931. unget_para(paraloc^);
  932. gen_alloc_regloc(list,destloc,vardef);
  933. { reg->reg, alignment is irrelevant }
  934. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
  935. unget_para(paraloc^.next^);
  936. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4);
  937. end
  938. else
  939. begin
  940. { paraloc^ -> low
  941. paraloc^.next -> high }
  942. unget_para(paraloc^);
  943. gen_alloc_regloc(list,destloc,vardef);
  944. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
  945. unget_para(paraloc^.next^);
  946. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
  947. end;
  948. else
  949. { unexpected number of paralocs }
  950. internalerror(200410104);
  951. end;
  952. end;
  953. LOC_REFERENCE:
  954. begin
  955. gen_alloc_regloc(list,destloc,vardef);
  956. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment,[]);
  957. cg64.a_load64_ref_reg(list,href,destloc.register64);
  958. unget_para(paraloc^);
  959. end;
  960. else
  961. internalerror(2005101501);
  962. end
  963. end
  964. else
  965. {$endif cpu64bitalu}
  966. begin
  967. if assigned(paraloc^.next) then
  968. begin
  969. if (destloc.size in [OS_PAIR,OS_SPAIR]) and
  970. (para.Size in [OS_PAIR,OS_SPAIR]) then
  971. begin
  972. unget_para(paraloc^);
  973. gen_alloc_regloc(list,destloc,vardef);
  974. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
  975. unget_para(paraloc^.Next^);
  976. {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
  977. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
  978. {$else}
  979. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint));
  980. {$endif}
  981. end
  982. {$if defined(cpu8bitalu)}
  983. else if (destloc.size in [OS_32,OS_S32]) and
  984. (para.Size in [OS_32,OS_S32]) then
  985. begin
  986. unget_para(paraloc^);
  987. gen_alloc_regloc(list,destloc,vardef);
  988. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint));
  989. unget_para(paraloc^.Next^);
  990. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
  991. unget_para(paraloc^.Next^.Next^);
  992. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,GetNextReg(GetNextReg(destloc.register)),sizeof(aint));
  993. unget_para(paraloc^.Next^.Next^.Next^);
  994. cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,GetNextReg(GetNextReg(GetNextReg(destloc.register))),sizeof(aint));
  995. end
  996. {$endif defined(cpu8bitalu)}
  997. else
  998. begin
  999. { this can happen if a parameter is spread over
  1000. multiple paralocs, e.g. if a record with two single
  1001. fields must be passed in two single precision
  1002. registers }
  1003. { does it fit in the register of destloc? }
  1004. sizeleft:=para.intsize;
  1005. if sizeleft<>vardef.size then
  1006. internalerror(2014122806);
  1007. if sizeleft<>tcgsize2size[destloc.size] then
  1008. internalerror(200410105);
  1009. { store everything first to memory, then load it in
  1010. destloc }
  1011. tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref);
  1012. gen_alloc_regloc(list,destloc,vardef);
  1013. while sizeleft>0 do
  1014. begin
  1015. if not assigned(paraloc) then
  1016. internalerror(2014122807);
  1017. unget_para(paraloc^);
  1018. cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft));
  1019. if (paraloc^.size=OS_NO) and
  1020. assigned(paraloc^.next) then
  1021. internalerror(2014122805);
  1022. inc(tempref.offset,tcgsize2size[paraloc^.size]);
  1023. dec(sizeleft,tcgsize2size[paraloc^.size]);
  1024. paraloc:=paraloc^.next;
  1025. end;
  1026. dec(tempref.offset,para.intsize);
  1027. cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register);
  1028. tg.ungettemp(list,tempref);
  1029. end;
  1030. end
  1031. else
  1032. begin
  1033. unget_para(paraloc^);
  1034. gen_alloc_regloc(list,destloc,vardef);
  1035. { we can't directly move regular registers into fpu
  1036. registers }
  1037. if getregtype(paraloc^.register)=R_FPUREGISTER then
  1038. begin
  1039. { store everything first to memory, then load it in
  1040. destloc }
  1041. tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref);
  1042. cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment);
  1043. cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register);
  1044. tg.ungettemp(list,tempref);
  1045. end
  1046. else
  1047. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint));
  1048. end;
  1049. end;
  1050. end;
  1051. LOC_FPUREGISTER,
  1052. LOC_CFPUREGISTER :
  1053. begin
  1054. {$ifdef mips}
  1055. if (destloc.size = paraloc^.Size) and
  1056. (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
  1057. begin
  1058. unget_para(paraloc^);
  1059. gen_alloc_regloc(list,destloc,vardef);
  1060. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment);
  1061. end
  1062. else if (destloc.size = OS_F32) and
  1063. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1064. begin
  1065. gen_alloc_regloc(list,destloc,vardef);
  1066. unget_para(paraloc^);
  1067. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
  1068. end
  1069. { TODO: Produces invalid code, needs fixing together with regalloc setup. }
  1070. {
  1071. else if (destloc.size = OS_F64) and
  1072. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
  1073. (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1074. begin
  1075. gen_alloc_regloc(list,destloc,vardef);
  1076. tmpreg:=destloc.register;
  1077. unget_para(paraloc^);
  1078. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg));
  1079. setsupreg(tmpreg,getsupreg(tmpreg)+1);
  1080. unget_para(paraloc^.next^);
  1081. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg));
  1082. end
  1083. }
  1084. else
  1085. begin
  1086. sizeleft := TCGSize2Size[destloc.size];
  1087. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  1088. href:=tempref;
  1089. while assigned(paraloc) do
  1090. begin
  1091. unget_para(paraloc^);
  1092. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  1093. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1094. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1095. paraloc:=paraloc^.next;
  1096. end;
  1097. gen_alloc_regloc(list,destloc,vardef);
  1098. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  1099. tg.UnGetTemp(list,tempref);
  1100. end;
  1101. {$else mips}
  1102. {$if defined(sparc) or defined(arm)}
  1103. { Arm and Sparc passes floats in int registers, when loading to fpu register
  1104. we need a temp }
  1105. sizeleft := TCGSize2Size[destloc.size];
  1106. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  1107. href:=tempref;
  1108. while assigned(paraloc) do
  1109. begin
  1110. unget_para(paraloc^);
  1111. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  1112. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1113. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1114. paraloc:=paraloc^.next;
  1115. end;
  1116. gen_alloc_regloc(list,destloc,vardef);
  1117. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  1118. tg.UnGetTemp(list,tempref);
  1119. {$else defined(sparc) or defined(arm)}
  1120. unget_para(paraloc^);
  1121. gen_alloc_regloc(list,destloc,vardef);
  1122. { from register to register -> alignment is irrelevant }
  1123. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1124. if assigned(paraloc^.next) then
  1125. internalerror(200410109);
  1126. {$endif defined(sparc) or defined(arm)}
  1127. {$endif mips}
  1128. end;
  1129. LOC_MMREGISTER,
  1130. LOC_CMMREGISTER :
  1131. begin
  1132. {$ifndef cpu64bitalu}
  1133. { ARM vfp floats are passed in integer registers }
  1134. if (para.size=OS_F64) and
  1135. (paraloc^.size in [OS_32,OS_S32]) and
  1136. use_vectorfpu(vardef) then
  1137. begin
  1138. { we need 2x32bit reg }
  1139. if not assigned(paraloc^.next) or
  1140. assigned(paraloc^.next^.next) then
  1141. internalerror(2009112421);
  1142. unget_para(paraloc^.next^);
  1143. case paraloc^.next^.loc of
  1144. LOC_REGISTER:
  1145. tempreg:=paraloc^.next^.register;
  1146. LOC_REFERENCE:
  1147. begin
  1148. tempreg:=cg.getintregister(list,OS_32);
  1149. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4);
  1150. end;
  1151. else
  1152. internalerror(2012051301);
  1153. end;
  1154. { don't free before the above, because then the getintregister
  1155. could reallocate this register and overwrite it }
  1156. unget_para(paraloc^);
  1157. gen_alloc_regloc(list,destloc,vardef);
  1158. if (target_info.endian=endian_big) then
  1159. { paraloc^ -> high
  1160. paraloc^.next -> low }
  1161. reg64:=joinreg64(tempreg,paraloc^.register)
  1162. else
  1163. reg64:=joinreg64(paraloc^.register,tempreg);
  1164. cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register);
  1165. end
  1166. else
  1167. {$endif not cpu64bitalu}
  1168. begin
  1169. if not assigned(paraloc^.next) then
  1170. begin
  1171. unget_para(paraloc^);
  1172. gen_alloc_regloc(list,destloc,vardef);
  1173. { from register to register -> alignment is irrelevant }
  1174. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1175. end
  1176. else
  1177. begin
  1178. internalerror(200410108);
  1179. end;
  1180. { data could come in two memory locations, for now
  1181. we simply ignore the sanity check (FK)
  1182. if assigned(paraloc^.next) then
  1183. internalerror(200410108);
  1184. }
  1185. end;
  1186. end;
  1187. else
  1188. internalerror(2010052903);
  1189. end;
  1190. end;
  1191. procedure gen_load_para_value(list:TAsmList);
  1192. procedure get_para(const paraloc:TCGParaLocation);
  1193. begin
  1194. case paraloc.loc of
  1195. LOC_REGISTER :
  1196. begin
  1197. if getsupreg(paraloc.register)<first_int_imreg then
  1198. cg.getcpuregister(list,paraloc.register);
  1199. end;
  1200. LOC_MMREGISTER :
  1201. begin
  1202. if getsupreg(paraloc.register)<first_mm_imreg then
  1203. cg.getcpuregister(list,paraloc.register);
  1204. end;
  1205. LOC_FPUREGISTER :
  1206. begin
  1207. if getsupreg(paraloc.register)<first_fpu_imreg then
  1208. cg.getcpuregister(list,paraloc.register);
  1209. end;
  1210. end;
  1211. end;
  1212. var
  1213. i : longint;
  1214. currpara : tparavarsym;
  1215. paraloc : pcgparalocation;
  1216. begin
  1217. if (po_assembler in current_procinfo.procdef.procoptions) or
  1218. { exceptfilters have a single hidden 'parentfp' parameter, which
  1219. is handled by tcg.g_proc_entry. }
  1220. (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  1221. exit;
  1222. { Allocate registers used by parameters }
  1223. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1224. begin
  1225. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1226. paraloc:=currpara.paraloc[calleeside].location;
  1227. while assigned(paraloc) do
  1228. begin
  1229. if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
  1230. get_para(paraloc^);
  1231. paraloc:=paraloc^.next;
  1232. end;
  1233. end;
  1234. { Copy parameters to local references/registers }
  1235. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1236. begin
  1237. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1238. { don't use currpara.vardef, as this will be wrong in case of
  1239. call-by-reference parameters (it won't contain the pointerdef) }
  1240. gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
  1241. { gen_load_cgpara_loc() already allocated the initialloc
  1242. -> don't allocate again }
  1243. if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then
  1244. begin
  1245. gen_alloc_regvar(list,currpara,false);
  1246. hlcg.varsym_set_localloc(list,currpara);
  1247. end;
  1248. end;
  1249. { generate copies of call by value parameters, must be done before
  1250. the initialization and body is parsed because the refcounts are
  1251. incremented using the local copies }
  1252. current_procinfo.procdef.parast.SymList.ForEachCall(@hlcg.g_copyvalueparas,list);
  1253. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1254. begin
  1255. { initialize refcounted paras, and trash others. Needed here
  1256. instead of in gen_initialize_code, because when a reference is
  1257. intialised or trashed while the pointer to that reference is kept
  1258. in a regvar, we add a register move and that one again has to
  1259. come after the parameter loading code as far as the register
  1260. allocator is concerned }
  1261. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  1262. end;
  1263. end;
  1264. {****************************************************************************
  1265. Entry/Exit
  1266. ****************************************************************************}
  1267. function has_alias_name(pd:tprocdef;const s:string):boolean;
  1268. var
  1269. item : TCmdStrListItem;
  1270. begin
  1271. result:=true;
  1272. if pd.mangledname=s then
  1273. exit;
  1274. item := TCmdStrListItem(pd.aliasnames.first);
  1275. while assigned(item) do
  1276. begin
  1277. if item.str=s then
  1278. exit;
  1279. item := TCmdStrListItem(item.next);
  1280. end;
  1281. result:=false;
  1282. end;
  1283. procedure alloc_proc_symbol(pd: tprocdef);
  1284. var
  1285. item : TCmdStrListItem;
  1286. begin
  1287. item := TCmdStrListItem(pd.aliasnames.first);
  1288. while assigned(item) do
  1289. begin
  1290. { The condition to use global or local symbol must match
  1291. the code written in hlcg.gen_proc_symbol to
  1292. avoid change from AB_LOCAL to AB_GLOBAL, which generates
  1293. erroneous code (at least for targets using GOT) }
  1294. if (cs_profile in current_settings.moduleswitches) or
  1295. (po_global in current_procinfo.procdef.procoptions) then
  1296. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION,pd)
  1297. else
  1298. current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION,pd);
  1299. item := TCmdStrListItem(item.next);
  1300. end;
  1301. end;
  1302. procedure release_proc_symbol(pd:tprocdef);
  1303. var
  1304. idx : longint;
  1305. item : TCmdStrListItem;
  1306. begin
  1307. item:=TCmdStrListItem(pd.aliasnames.first);
  1308. while assigned(item) do
  1309. begin
  1310. idx:=current_asmdata.AsmSymbolDict.findindexof(item.str);
  1311. if idx>=0 then
  1312. current_asmdata.AsmSymbolDict.Delete(idx);
  1313. item:=TCmdStrListItem(item.next);
  1314. end;
  1315. end;
  1316. procedure gen_proc_entry_code(list:TAsmList);
  1317. var
  1318. hitemp,
  1319. lotemp, stack_frame_size : longint;
  1320. begin
  1321. { generate call frame marker for dwarf call frame info }
  1322. current_asmdata.asmcfi.start_frame(list);
  1323. { All temps are know, write offsets used for information }
  1324. if (cs_asm_source in current_settings.globalswitches) and
  1325. (current_procinfo.tempstart<>tg.lasttemp) then
  1326. begin
  1327. if tg.direction>0 then
  1328. begin
  1329. lotemp:=current_procinfo.tempstart;
  1330. hitemp:=tg.lasttemp;
  1331. end
  1332. else
  1333. begin
  1334. lotemp:=tg.lasttemp;
  1335. hitemp:=current_procinfo.tempstart;
  1336. end;
  1337. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1338. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1339. end;
  1340. { generate target specific proc entry code }
  1341. stack_frame_size := current_procinfo.calc_stackframe_size;
  1342. if (stack_frame_size <> 0) and
  1343. (po_nostackframe in current_procinfo.procdef.procoptions) then
  1344. message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size));
  1345. hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1346. end;
  1347. procedure gen_proc_exit_code(list:TAsmList);
  1348. var
  1349. parasize : longint;
  1350. begin
  1351. { c style clearstack does not need to remove parameters from the stack, only the
  1352. return value when it was pushed by arguments }
  1353. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1354. begin
  1355. parasize:=0;
  1356. { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para
  1357. which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. }
  1358. if not ( (current_procinfo.procdef.proccalloption=pocall_safecall) and
  1359. (tf_safecall_exceptions in target_info.flags) ) and
  1360. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1361. inc(parasize,sizeof(pint));
  1362. end
  1363. else
  1364. begin
  1365. parasize:=current_procinfo.para_stack_size;
  1366. { the parent frame pointer para has to be removed by the caller in
  1367. case of Delphi-style parent frame pointer passing }
  1368. if not paramanager.use_fixed_stack and
  1369. (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
  1370. dec(parasize,sizeof(pint));
  1371. end;
  1372. { generate target specific proc exit code }
  1373. hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1374. { release return registers, needed for optimizer }
  1375. if not is_void(current_procinfo.procdef.returndef) then
  1376. paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);
  1377. { end of frame marker for call frame info }
  1378. current_asmdata.asmcfi.end_frame(list);
  1379. end;
  1380. procedure gen_save_used_regs(list:TAsmList);
  1381. begin
  1382. { Pure assembler routines need to save the registers themselves }
  1383. if (po_assembler in current_procinfo.procdef.procoptions) then
  1384. exit;
  1385. { oldfpccall expects all registers to be destroyed }
  1386. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1387. cg.g_save_registers(list);
  1388. end;
  1389. procedure gen_restore_used_regs(list:TAsmList);
  1390. begin
  1391. { Pure assembler routines need to save the registers themselves }
  1392. if (po_assembler in current_procinfo.procdef.procoptions) then
  1393. exit;
  1394. { oldfpccall expects all registers to be destroyed }
  1395. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1396. cg.g_restore_registers(list);
  1397. end;
  1398. {****************************************************************************
  1399. Const Data
  1400. ****************************************************************************}
  1401. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  1402. var
  1403. i : longint;
  1404. highsym,
  1405. sym : tsym;
  1406. vs : tabstractnormalvarsym;
  1407. ptrdef : tdef;
  1408. isaddr : boolean;
  1409. begin
  1410. for i:=0 to st.SymList.Count-1 do
  1411. begin
  1412. sym:=tsym(st.SymList[i]);
  1413. case sym.typ of
  1414. staticvarsym :
  1415. begin
  1416. vs:=tabstractnormalvarsym(sym);
  1417. { The code in loadnode.pass_generatecode will create the
  1418. LOC_REFERENCE instead for all none register variables. This is
  1419. required because we can't store an asmsymbol in the localloc because
  1420. the asmsymbol is invalid after an unit is compiled. This gives
  1421. problems when this procedure is inlined in another unit (PFV) }
  1422. if vs.is_regvar(false) then
  1423. begin
  1424. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1425. vs.initialloc.size:=def_cgsize(vs.vardef);
  1426. gen_alloc_regvar(list,vs,true);
  1427. hlcg.varsym_set_localloc(list,vs);
  1428. end;
  1429. end;
  1430. paravarsym :
  1431. begin
  1432. vs:=tabstractnormalvarsym(sym);
  1433. { Parameters passed to assembler procedures need to be kept
  1434. in the original location }
  1435. if (po_assembler in pd.procoptions) then
  1436. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  1437. { exception filters receive their frame pointer as a parameter }
  1438. else if (pd.proctypeoption=potype_exceptfilter) and
  1439. (vo_is_parentfp in vs.varoptions) then
  1440. begin
  1441. location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
  1442. vs.initialloc.register:=NR_FRAME_POINTER_REG;
  1443. end
  1444. else
  1445. begin
  1446. { if an open array is used, also its high parameter is used,
  1447. since the hidden high parameters are inserted after the corresponding symbols,
  1448. we can increase the ref. count here }
  1449. if is_open_array(vs.vardef) or is_array_of_const(vs.vardef) then
  1450. begin
  1451. highsym:=get_high_value_sym(tparavarsym(vs));
  1452. if assigned(highsym) then
  1453. inc(highsym.refs);
  1454. end;
  1455. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,pd.proccalloption);
  1456. if isaddr then
  1457. vs.initialloc.size:=def_cgsize(voidpointertype)
  1458. else
  1459. vs.initialloc.size:=def_cgsize(vs.vardef);
  1460. if vs.is_regvar(isaddr) then
  1461. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  1462. else
  1463. begin
  1464. vs.initialloc.loc:=LOC_REFERENCE;
  1465. { Reuse the parameter location for values to are at a single location on the stack }
  1466. if paramanager.param_use_paraloc(tparavarsym(vs).paraloc[calleeside]) then
  1467. begin
  1468. hlcg.paravarsym_set_initialloc_to_paraloc(tparavarsym(vs));
  1469. end
  1470. else
  1471. begin
  1472. if isaddr then
  1473. begin
  1474. ptrdef:=cpointerdef.getreusable(vs.vardef);
  1475. tg.GetLocal(list,ptrdef.size,ptrdef,vs.initialloc.reference)
  1476. end
  1477. else
  1478. tg.GetLocal(list,vs.getsize,tparavarsym(vs).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  1479. end;
  1480. end;
  1481. end;
  1482. hlcg.varsym_set_localloc(list,vs);
  1483. end;
  1484. localvarsym :
  1485. begin
  1486. vs:=tabstractnormalvarsym(sym);
  1487. vs.initialloc.size:=def_cgsize(vs.vardef);
  1488. if ([po_assembler,po_nostackframe] * pd.procoptions = [po_assembler,po_nostackframe]) and
  1489. (vo_is_funcret in vs.varoptions) then
  1490. begin
  1491. paramanager.create_funcretloc_info(pd,calleeside);
  1492. if assigned(pd.funcretloc[calleeside].location^.next) then
  1493. begin
  1494. { can't replace references to "result" with a complex
  1495. location expression inside assembler code }
  1496. location_reset(vs.initialloc,LOC_INVALID,OS_NO);
  1497. end
  1498. else
  1499. pd.funcretloc[calleeside].get_location(vs.initialloc);
  1500. end
  1501. else if (m_delphi in current_settings.modeswitches) and
  1502. (po_assembler in pd.procoptions) and
  1503. (vo_is_funcret in vs.varoptions) and
  1504. (vs.refs=0) then
  1505. begin
  1506. { not referenced, so don't allocate. Use dummy to }
  1507. { avoid ie's later on because of LOC_INVALID }
  1508. vs.initialloc.loc:=LOC_REGISTER;
  1509. vs.initialloc.size:=OS_INT;
  1510. vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
  1511. end
  1512. else if vs.is_regvar(false) then
  1513. begin
  1514. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1515. gen_alloc_regvar(list,vs,true);
  1516. end
  1517. else
  1518. begin
  1519. vs.initialloc.loc:=LOC_REFERENCE;
  1520. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  1521. end;
  1522. hlcg.varsym_set_localloc(list,vs);
  1523. end;
  1524. end;
  1525. end;
  1526. end;
  1527. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  1528. begin
  1529. case location.loc of
  1530. LOC_CREGISTER:
  1531. {$if defined(cpu64bitalu)}
  1532. if location.size in [OS_128,OS_S128] then
  1533. begin
  1534. rv.intregvars.addnodup(getsupreg(location.register128.reglo));
  1535. rv.intregvars.addnodup(getsupreg(location.register128.reghi));
  1536. end
  1537. else
  1538. {$elseif defined(cpu32bitalu)}
  1539. if location.size in [OS_64,OS_S64] then
  1540. begin
  1541. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1542. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1543. end
  1544. else
  1545. {$elseif defined(cpu16bitalu)}
  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(location.register64.reghi));
  1551. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reghi)));
  1552. end
  1553. else
  1554. if location.size in [OS_32,OS_S32] then
  1555. begin
  1556. rv.intregvars.addnodup(getsupreg(location.register));
  1557. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1558. end
  1559. else
  1560. {$elseif defined(cpu8bitalu)}
  1561. if location.size in [OS_64,OS_S64] then
  1562. begin
  1563. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1564. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reglo)));
  1565. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register64.reglo))));
  1566. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register64.reglo)))));
  1567. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1568. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register64.reghi)));
  1569. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register64.reghi))));
  1570. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register64.reghi)))));
  1571. end
  1572. else
  1573. if location.size in [OS_32,OS_S32] then
  1574. begin
  1575. rv.intregvars.addnodup(getsupreg(location.register));
  1576. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1577. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(location.register))));
  1578. rv.intregvars.addnodup(getsupreg(GetNextReg(GetNextReg(GetNextReg(location.register)))));
  1579. end
  1580. else
  1581. if location.size in [OS_16,OS_S16] then
  1582. begin
  1583. rv.intregvars.addnodup(getsupreg(location.register));
  1584. rv.intregvars.addnodup(getsupreg(GetNextReg(location.register)));
  1585. end
  1586. else
  1587. {$endif}
  1588. if getregtype(location.register)=R_INTREGISTER then
  1589. rv.intregvars.addnodup(getsupreg(location.register))
  1590. else
  1591. rv.addrregvars.addnodup(getsupreg(location.register));
  1592. LOC_CFPUREGISTER:
  1593. rv.fpuregvars.addnodup(getsupreg(location.register));
  1594. LOC_CMMREGISTER:
  1595. rv.mmregvars.addnodup(getsupreg(location.register));
  1596. end;
  1597. end;
  1598. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  1599. var
  1600. rv: pusedregvars absolute arg;
  1601. begin
  1602. case (n.nodetype) of
  1603. temprefn:
  1604. { We only have to synchronise a tempnode before a loop if it is }
  1605. { not created inside the loop, and only synchronise after the }
  1606. { loop if it's not destroyed inside the loop. If it's created }
  1607. { before the loop and not yet destroyed, then before the loop }
  1608. { is secondpassed tempinfo^.valid will be true, and we get the }
  1609. { correct registers. If it's not destroyed inside the loop, }
  1610. { then after the loop has been secondpassed tempinfo^.valid }
  1611. { be true and we also get the right registers. In other cases, }
  1612. { tempinfo^.valid will be false and so we do not add }
  1613. { unnecessary registers. This way, we don't have to look at }
  1614. { tempcreate and tempdestroy nodes to get this info (JM) }
  1615. if (ti_valid in ttemprefnode(n).tempflags) then
  1616. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  1617. loadn:
  1618. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1619. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  1620. vecn:
  1621. { range checks sometimes need the high parameter }
  1622. if (cs_check_range in current_settings.localswitches) and
  1623. (is_open_array(tvecnode(n).left.resultdef) or
  1624. is_array_of_const(tvecnode(n).left.resultdef)) and
  1625. not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  1626. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  1627. end;
  1628. result := fen_true;
  1629. end;
  1630. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  1631. begin
  1632. foreachnodestatic(n,@do_get_used_regvars,@rv);
  1633. end;
  1634. (*
  1635. See comments at declaration of pusedregvarscommon
  1636. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  1637. var
  1638. rv: pusedregvarscommon absolute arg;
  1639. begin
  1640. if (n.nodetype = loadn) and
  1641. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1642. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  1643. case loc of
  1644. LOC_CREGISTER:
  1645. { if not yet encountered in this node tree }
  1646. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1647. { but nevertheless already encountered somewhere }
  1648. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1649. { then it's a regvar used in two or more node trees }
  1650. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1651. LOC_CFPUREGISTER:
  1652. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1653. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1654. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1655. LOC_CMMREGISTER:
  1656. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1657. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1658. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1659. end;
  1660. result := fen_true;
  1661. end;
  1662. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  1663. begin
  1664. rv.myregvars.intregvars.clear;
  1665. rv.myregvars.fpuregvars.clear;
  1666. rv.myregvars.mmregvars.clear;
  1667. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  1668. end;
  1669. *)
  1670. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  1671. var
  1672. count: longint;
  1673. begin
  1674. for count := 1 to rv.intregvars.length do
  1675. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  1676. for count := 1 to rv.addrregvars.length do
  1677. cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE));
  1678. for count := 1 to rv.fpuregvars.length do
  1679. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  1680. for count := 1 to rv.mmregvars.length do
  1681. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  1682. end;
  1683. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  1684. var
  1685. i : longint;
  1686. sym : tsym;
  1687. begin
  1688. for i:=0 to st.SymList.Count-1 do
  1689. begin
  1690. sym:=tsym(st.SymList[i]);
  1691. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  1692. begin
  1693. with tabstractnormalvarsym(sym) do
  1694. begin
  1695. { Note: We need to keep the data available in memory
  1696. for the sub procedures that can access local data
  1697. in the parent procedures }
  1698. case localloc.loc of
  1699. LOC_CREGISTER :
  1700. if (pi_has_label in current_procinfo.flags) then
  1701. {$if defined(cpu64bitalu)}
  1702. if def_cgsize(vardef) in [OS_128,OS_S128] then
  1703. begin
  1704. cg.a_reg_sync(list,localloc.register128.reglo);
  1705. cg.a_reg_sync(list,localloc.register128.reghi);
  1706. end
  1707. else
  1708. {$elseif defined(cpu32bitalu)}
  1709. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1710. begin
  1711. cg.a_reg_sync(list,localloc.register64.reglo);
  1712. cg.a_reg_sync(list,localloc.register64.reghi);
  1713. end
  1714. else
  1715. {$elseif defined(cpu16bitalu)}
  1716. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1717. begin
  1718. cg.a_reg_sync(list,localloc.register64.reglo);
  1719. cg.a_reg_sync(list,GetNextReg(localloc.register64.reglo));
  1720. cg.a_reg_sync(list,localloc.register64.reghi);
  1721. cg.a_reg_sync(list,GetNextReg(localloc.register64.reghi));
  1722. end
  1723. else
  1724. if def_cgsize(vardef) in [OS_32,OS_S32] then
  1725. begin
  1726. cg.a_reg_sync(list,localloc.register);
  1727. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1728. end
  1729. else
  1730. {$elseif defined(cpu8bitalu)}
  1731. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1732. begin
  1733. cg.a_reg_sync(list,localloc.register64.reglo);
  1734. cg.a_reg_sync(list,GetNextReg(localloc.register64.reglo));
  1735. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register64.reglo)));
  1736. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register64.reglo))));
  1737. cg.a_reg_sync(list,localloc.register64.reghi);
  1738. cg.a_reg_sync(list,GetNextReg(localloc.register64.reghi));
  1739. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register64.reghi)));
  1740. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register64.reghi))));
  1741. end
  1742. else
  1743. if def_cgsize(vardef) in [OS_32,OS_S32] then
  1744. begin
  1745. cg.a_reg_sync(list,localloc.register);
  1746. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1747. cg.a_reg_sync(list,GetNextReg(GetNextReg(localloc.register)));
  1748. cg.a_reg_sync(list,GetNextReg(GetNextReg(GetNextReg(localloc.register))));
  1749. end
  1750. else
  1751. if def_cgsize(vardef) in [OS_16,OS_S16] then
  1752. begin
  1753. cg.a_reg_sync(list,localloc.register);
  1754. cg.a_reg_sync(list,GetNextReg(localloc.register));
  1755. end
  1756. else
  1757. {$endif}
  1758. cg.a_reg_sync(list,localloc.register);
  1759. LOC_CFPUREGISTER,
  1760. LOC_CMMREGISTER:
  1761. if (pi_has_label in current_procinfo.flags) then
  1762. cg.a_reg_sync(list,localloc.register);
  1763. LOC_REFERENCE :
  1764. begin
  1765. if typ in [localvarsym,paravarsym] then
  1766. tg.Ungetlocal(list,localloc.reference);
  1767. end;
  1768. end;
  1769. end;
  1770. end;
  1771. end;
  1772. end;
  1773. function getprocalign : shortint;
  1774. begin
  1775. { gprof uses 16 byte granularity }
  1776. if (cs_profile in current_settings.moduleswitches) then
  1777. result:=16
  1778. else
  1779. result:=current_settings.alignment.procalign;
  1780. end;
  1781. procedure gen_fpc_dummy(list : TAsmList);
  1782. begin
  1783. {$ifdef i386}
  1784. { fix me! }
  1785. list.concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX));
  1786. list.concat(Taicpu.Op_const(A_RET,S_W,12));
  1787. {$endif i386}
  1788. end;
  1789. procedure gen_load_frame_for_exceptfilter(list : TAsmList);
  1790. var
  1791. para: tparavarsym;
  1792. begin
  1793. para:=tparavarsym(current_procinfo.procdef.paras[0]);
  1794. if not (vo_is_parentfp in para.varoptions) then
  1795. InternalError(201201142);
  1796. if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
  1797. (para.paraloc[calleeside].location^.next<>nil) then
  1798. InternalError(201201143);
  1799. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,para.paraloc[calleeside].location^.register,
  1800. NR_FRAME_POINTER_REG);
  1801. end;
  1802. end.