ncgutil.pas 91 KB

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