ncgutil.pas 84 KB

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