ncgutil.pas 107 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787
  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 cpu64bit}
  27. ,cg64f32
  28. {$endif cpu64bit}
  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_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  50. procedure location_force_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  51. procedure location_force_mem(list:TAsmList;var l:tlocation);
  52. procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean);
  53. { Retrieve the location of the data pointed to in location l, when the location is
  54. a register it is expected to contain the address of the data }
  55. procedure location_get_data_ref(list:TAsmList;const l:tlocation;var ref:treference;loadref:boolean);
  56. function maybe_pushfpu(list:TAsmList;needed : byte;var l:tlocation) : boolean;
  57. procedure alloc_proc_symbol(pd: tprocdef);
  58. procedure gen_proc_symbol(list:TAsmList);
  59. procedure gen_proc_symbol_end(list:TAsmList);
  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_initialize_code(list:TAsmList);
  67. procedure gen_finalize_code(list:TAsmList);
  68. procedure gen_entry_code(list:TAsmList);
  69. procedure gen_exit_code(list:TAsmList);
  70. procedure gen_load_para_value(list:TAsmList);
  71. procedure gen_load_return_value(list:TAsmList);
  72. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  73. procedure gen_intf_wrappers(list:TAsmList;st:tsymtable);
  74. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  75. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  76. { adds the regvars used in n and its children to rv.allregvars,
  77. those which were already in rv.allregvars to rv.commonregvars and
  78. uses rv.myregvars as scratch (so that two uses of the same regvar
  79. in a single tree to make it appear in commonregvars). Useful to
  80. find out which regvars are used in two different node trees
  81. (e.g. in the "else" and "then" path, or in various case blocks }
  82. // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  83. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  84. { if the result of n is a LOC_C(..)REGISTER, try to find the corresponding }
  85. { loadn and change its location to a new register (= SSA) }
  86. procedure maybechangeloadnodereg(var n: tnode);
  87. {#
  88. Allocate the buffers for exception management and setjmp environment.
  89. Return a pointer to these buffers, send them to the utility routine
  90. so they are registered, and then call setjmp.
  91. Then compare the result of setjmp with 0, and if not equal
  92. to zero, then jump to exceptlabel.
  93. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  94. It is to note that this routine may be called *after* the stackframe of a
  95. routine has been called, therefore on machines where the stack cannot
  96. be modified, all temps should be allocated on the heap instead of the
  97. stack.
  98. }
  99. const
  100. EXCEPT_BUF_SIZE = 3*sizeof(aint);
  101. type
  102. texceptiontemps=record
  103. jmpbuf,
  104. envbuf,
  105. reasonbuf : treference;
  106. end;
  107. procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
  108. procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  109. procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
  110. procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  111. procedure insertbssdata(sym : tglobalvarsym);
  112. procedure gen_alloc_symtable(list:TAsmList;st:tsymtable);
  113. procedure gen_free_symtable(list:TAsmList;st:tsymtable);
  114. { rtti and init/final }
  115. procedure generate_rtti(p:Ttypesym);
  116. procedure generate_inittable(p:tsym);
  117. procedure location_free(list: TAsmList; const location : TLocation);
  118. function getprocalign : shortint;
  119. procedure gen_pic_helpers(list : TAsmList);
  120. procedure gen_got_load(list : TAsmList);
  121. implementation
  122. uses
  123. version,
  124. cutils,cclasses,
  125. globals,systems,verbose,
  126. ppu,defutil,
  127. procinfo,paramgr,fmodule,
  128. regvars,dbgbase,
  129. pass_1,pass_2,
  130. nbas,ncon,nld,nmem,nutils,
  131. tgobj,cgobj
  132. {$ifdef powerpc}
  133. , cpupi
  134. {$endif}
  135. {$ifdef powerpc64}
  136. , cpupi
  137. {$endif}
  138. {$ifdef SUPPORT_MMX}
  139. , cgx86
  140. {$endif SUPPORT_MMX}
  141. ;
  142. {*****************************************************************************
  143. Misc Helpers
  144. *****************************************************************************}
  145. procedure location_free(list: TAsmList; const location : TLocation);
  146. begin
  147. case location.loc of
  148. LOC_VOID:
  149. ;
  150. LOC_REGISTER,
  151. LOC_CREGISTER:
  152. begin
  153. if getsupreg(location.register)<first_int_imreg then
  154. cg.ungetcpuregister(list,location.register);
  155. end;
  156. LOC_FPUREGISTER,
  157. LOC_CFPUREGISTER:
  158. begin
  159. if getsupreg(location.register)<first_fpu_imreg then
  160. cg.ungetcpuregister(list,location.register);
  161. end;
  162. LOC_MMREGISTER,
  163. LOC_CMMREGISTER :
  164. begin
  165. if getsupreg(location.register)<first_mm_imreg then
  166. cg.ungetcpuregister(list,location.register);
  167. end;
  168. LOC_REFERENCE,
  169. LOC_CREFERENCE :
  170. begin
  171. if use_fixed_stack then
  172. location_freetemp(list,location);
  173. end;
  174. else
  175. internalerror(2004110211);
  176. end;
  177. end;
  178. { DO NOT RELY on the fact that the tnode is not yet swaped
  179. because of inlining code PM }
  180. procedure firstcomplex(p : tbinarynode);
  181. var
  182. hp : tnode;
  183. begin
  184. { always calculate boolean AND and OR from left to right }
  185. if (p.nodetype in [orn,andn]) and
  186. is_boolean(p.left.resulttype.def) then
  187. begin
  188. if nf_swaped in p.flags then
  189. internalerror(234234);
  190. end
  191. else
  192. if (
  193. (p.expectloc=LOC_FPUREGISTER) and
  194. (p.right.registersfpu > p.left.registersfpu)
  195. ) or
  196. (
  197. (
  198. (
  199. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  200. (p.expectloc<>LOC_FPUREGISTER)
  201. ) and
  202. (p.left.registersint<p.right.registersint)
  203. )
  204. ) then
  205. begin
  206. hp:=p.left;
  207. p.left:=p.right;
  208. p.right:=hp;
  209. if nf_swaped in p.flags then
  210. exclude(p.flags,nf_swaped)
  211. else
  212. include(p.flags,nf_swaped);
  213. end;
  214. end;
  215. procedure maketojumpbool(list:TAsmList; p : tnode; loadregvars: tloadregvars);
  216. {
  217. produces jumps to true respectively false labels using boolean expressions
  218. depending on whether the loading of regvars is currently being
  219. synchronized manually (such as in an if-node) or automatically (most of
  220. the other cases where this procedure is called), loadregvars can be
  221. "lr_load_regvars" or "lr_dont_load_regvars"
  222. }
  223. var
  224. opsize : tcgsize;
  225. storepos : tfileposinfo;
  226. tmpreg : tregister;
  227. begin
  228. if nf_error in p.flags then
  229. exit;
  230. storepos:=aktfilepos;
  231. aktfilepos:=p.fileinfo;
  232. if is_boolean(p.resulttype.def) then
  233. begin
  234. {$ifdef OLDREGVARS}
  235. if loadregvars = lr_load_regvars then
  236. load_all_regvars(list);
  237. {$endif OLDREGVARS}
  238. if is_constboolnode(p) then
  239. begin
  240. if tordconstnode(p).value<>0 then
  241. cg.a_jmp_always(list,current_procinfo.CurrTrueLabel)
  242. else
  243. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel)
  244. end
  245. else
  246. begin
  247. opsize:=def_cgsize(p.resulttype.def);
  248. case p.location.loc of
  249. LOC_SUBSETREG,LOC_CSUBSETREG,
  250. LOC_SUBSETREF,LOC_CSUBSETREF:
  251. begin
  252. tmpreg := cg.getintregister(list,OS_INT);
  253. cg.a_load_loc_reg(list,OS_INT,p.location,tmpreg);
  254. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,current_procinfo.CurrTrueLabel);
  255. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  256. end;
  257. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  258. begin
  259. cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,current_procinfo.CurrTrueLabel);
  260. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  261. end;
  262. LOC_JUMP:
  263. ;
  264. {$ifdef cpuflags}
  265. LOC_FLAGS :
  266. begin
  267. cg.a_jmp_flags(list,p.location.resflags,current_procinfo.CurrTrueLabel);
  268. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  269. end;
  270. {$endif cpuflags}
  271. else
  272. begin
  273. printnode(output,p);
  274. internalerror(200308241);
  275. end;
  276. end;
  277. end;
  278. end
  279. else
  280. internalerror(200112305);
  281. aktfilepos:=storepos;
  282. end;
  283. (*
  284. This code needs fixing. It is not safe to use rgint; on the m68000 it
  285. would be rgaddr.
  286. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  287. begin
  288. case t.loc of
  289. LOC_REGISTER:
  290. begin
  291. { can't be a regvar, since it would be LOC_CREGISTER then }
  292. exclude(regs,getsupreg(t.register));
  293. if t.register64.reghi<>NR_NO then
  294. exclude(regs,getsupreg(t.register64.reghi));
  295. end;
  296. LOC_CREFERENCE,LOC_REFERENCE:
  297. begin
  298. if not(cs_opt_regvar in aktoptimizerswitches) or
  299. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  300. exclude(regs,getsupreg(t.reference.base));
  301. if not(cs_opt_regvar in aktoptimizerswitches) or
  302. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  303. exclude(regs,getsupreg(t.reference.index));
  304. end;
  305. end;
  306. end;
  307. *)
  308. {*****************************************************************************
  309. EXCEPTION MANAGEMENT
  310. *****************************************************************************}
  311. procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
  312. var
  313. srsym : ttypesym;
  314. begin
  315. if jmp_buf_size=-1 then
  316. begin
  317. srsym:=search_system_type('JMP_BUF');
  318. jmp_buf_size:=srsym.restype.def.size;
  319. end;
  320. tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
  321. tg.GetTemp(list,jmp_buf_size,tt_persistent,t.jmpbuf);
  322. tg.GetTemp(list,sizeof(aint),tt_persistent,t.reasonbuf);
  323. end;
  324. procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  325. begin
  326. tg.Ungettemp(list,t.jmpbuf);
  327. tg.ungettemp(list,t.envbuf);
  328. tg.ungettemp(list,t.reasonbuf);
  329. end;
  330. procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
  331. var
  332. paraloc1,paraloc2,paraloc3 : tcgpara;
  333. begin
  334. paraloc1.init;
  335. paraloc2.init;
  336. paraloc3.init;
  337. paramanager.getintparaloc(pocall_default,1,paraloc1);
  338. paramanager.getintparaloc(pocall_default,2,paraloc2);
  339. paramanager.getintparaloc(pocall_default,3,paraloc3);
  340. paramanager.allocparaloc(list,paraloc3);
  341. cg.a_paramaddr_ref(list,t.envbuf,paraloc3);
  342. paramanager.allocparaloc(list,paraloc2);
  343. cg.a_paramaddr_ref(list,t.jmpbuf,paraloc2);
  344. { push type of exceptionframe }
  345. paramanager.allocparaloc(list,paraloc1);
  346. cg.a_param_const(list,OS_S32,1,paraloc1);
  347. paramanager.freeparaloc(list,paraloc3);
  348. paramanager.freeparaloc(list,paraloc2);
  349. paramanager.freeparaloc(list,paraloc1);
  350. cg.allocallcpuregisters(list);
  351. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  352. cg.deallocallcpuregisters(list);
  353. paramanager.getintparaloc(pocall_default,1,paraloc1);
  354. paramanager.allocparaloc(list,paraloc1);
  355. cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
  356. paramanager.freeparaloc(list,paraloc1);
  357. cg.allocallcpuregisters(list);
  358. cg.a_call_name(list,'FPC_SETJMP');
  359. cg.deallocallcpuregisters(list);
  360. cg.g_exception_reason_save(list, t.reasonbuf);
  361. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
  362. paraloc1.done;
  363. paraloc2.done;
  364. paraloc3.done;
  365. end;
  366. procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  367. begin
  368. cg.allocallcpuregisters(list);
  369. cg.a_call_name(list,'FPC_POPADDRSTACK');
  370. cg.deallocallcpuregisters(list);
  371. if not onlyfree then
  372. begin
  373. cg.g_exception_reason_load(list, t.reasonbuf);
  374. cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
  375. end;
  376. end;
  377. {*****************************************************************************
  378. TLocation
  379. *****************************************************************************}
  380. {$ifndef cpu64bit}
  381. { 32-bit version }
  382. procedure location_force_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  383. var
  384. hregister,
  385. hregisterhi : tregister;
  386. hreg64 : tregister64;
  387. hl : tasmlabel;
  388. oldloc : tlocation;
  389. const_location: boolean;
  390. begin
  391. oldloc:=l;
  392. if dst_size=OS_NO then
  393. internalerror(200309144);
  394. { handle transformations to 64bit separate }
  395. if dst_size in [OS_64,OS_S64] then
  396. begin
  397. if not (l.size in [OS_64,OS_S64]) then
  398. begin
  399. { load a smaller size to OS_64 }
  400. if l.loc=LOC_REGISTER then
  401. begin
  402. hregister:=cg.makeregsize(list,l.register64.reglo,OS_32);
  403. cg.a_load_reg_reg(list,l.size,OS_32,l.register64.reglo,hregister);
  404. end
  405. else
  406. hregister:=cg.getintregister(list,OS_INT);
  407. { load value in low register }
  408. case l.loc of
  409. LOC_FLAGS :
  410. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  411. LOC_JUMP :
  412. begin
  413. cg.a_label(list,current_procinfo.CurrTrueLabel);
  414. cg.a_load_const_reg(list,OS_INT,1,hregister);
  415. current_asmdata.getjumplabel(hl);
  416. cg.a_jmp_always(list,hl);
  417. cg.a_label(list,current_procinfo.CurrFalseLabel);
  418. cg.a_load_const_reg(list,OS_INT,0,hregister);
  419. cg.a_label(list,hl);
  420. end;
  421. else
  422. cg.a_load_loc_reg(list,OS_INT,l,hregister);
  423. end;
  424. { reset hi part, take care of the signed bit of the current value }
  425. hregisterhi:=cg.getintregister(list,OS_INT);
  426. if (l.size in [OS_S8,OS_S16,OS_S32]) then
  427. begin
  428. if l.loc=LOC_CONSTANT then
  429. begin
  430. if (longint(l.value)<0) then
  431. cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi)
  432. else
  433. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  434. end
  435. else
  436. begin
  437. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  438. hregisterhi);
  439. end;
  440. end
  441. else
  442. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  443. location_reset(l,LOC_REGISTER,dst_size);
  444. l.register64.reglo:=hregister;
  445. l.register64.reghi:=hregisterhi;
  446. end
  447. else
  448. begin
  449. { 64bit to 64bit }
  450. if ((l.loc=LOC_CREGISTER) and maybeconst) then
  451. begin
  452. hregister:=l.register64.reglo;
  453. hregisterhi:=l.register64.reghi;
  454. const_location := true;
  455. end
  456. else
  457. begin
  458. hregister:=cg.getintregister(list,OS_INT);
  459. hregisterhi:=cg.getintregister(list,OS_INT);
  460. const_location := false;
  461. end;
  462. hreg64.reglo:=hregister;
  463. hreg64.reghi:=hregisterhi;
  464. { load value in new register }
  465. cg64.a_load64_loc_reg(list,l,hreg64);
  466. if not const_location then
  467. location_reset(l,LOC_REGISTER,dst_size)
  468. else
  469. location_reset(l,LOC_CREGISTER,dst_size);
  470. l.register64.reglo:=hregister;
  471. l.register64.reghi:=hregisterhi;
  472. end;
  473. end
  474. else
  475. begin
  476. {Do not bother to recycle the existing register. The register
  477. allocator eliminates unnecessary moves, so it's not needed
  478. and trying to recycle registers can cause problems because
  479. the registers changes size and may need aditional constraints.
  480. Not if it's about LOC_CREGISTER's (JM)
  481. }
  482. const_location :=
  483. (maybeconst) and
  484. (l.loc = LOC_CREGISTER) and
  485. (TCGSize2Size[l.size] = TCGSize2Size[dst_size]) and
  486. ((l.size = dst_size) or
  487. (TCGSize2Size[l.size] = TCGSize2Size[OS_INT]));
  488. if not const_location then
  489. hregister:=cg.getintregister(list,dst_size)
  490. else
  491. hregister := l.register;
  492. { load value in new register }
  493. case l.loc of
  494. LOC_FLAGS :
  495. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  496. LOC_JUMP :
  497. begin
  498. cg.a_label(list,current_procinfo.CurrTrueLabel);
  499. cg.a_load_const_reg(list,dst_size,1,hregister);
  500. current_asmdata.getjumplabel(hl);
  501. cg.a_jmp_always(list,hl);
  502. cg.a_label(list,current_procinfo.CurrFalseLabel);
  503. cg.a_load_const_reg(list,dst_size,0,hregister);
  504. cg.a_label(list,hl);
  505. end;
  506. else
  507. begin
  508. { load_loc_reg can only handle size >= l.size, when the
  509. new size is smaller then we need to adjust the size
  510. of the orignal and maybe recalculate l.register for i386 }
  511. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  512. begin
  513. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  514. l.register:=cg.makeregsize(list,l.register,dst_size);
  515. { for big endian systems, the reference's offset must }
  516. { be increased in this case, since they have the }
  517. { MSB first in memory and e.g. byte(word_var) should }
  518. { return the second byte in this case (JM) }
  519. if (target_info.endian = ENDIAN_BIG) and
  520. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_SUBSETREF,LOC_CSUBSETREF]) then
  521. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  522. {$ifdef x86}
  523. if not (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then
  524. l.size:=dst_size;
  525. {$endif x86}
  526. end;
  527. cg.a_load_loc_reg(list,dst_size,l,hregister);
  528. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size])
  529. {$ifdef x86}
  530. and (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG])
  531. {$endif x86}
  532. then
  533. l.size:=dst_size;
  534. end;
  535. end;
  536. if not const_location then
  537. location_reset(l,LOC_REGISTER,dst_size)
  538. else
  539. location_reset(l,LOC_CREGISTER,dst_size);
  540. l.register:=hregister;
  541. end;
  542. { Release temp when it was a reference }
  543. if oldloc.loc=LOC_REFERENCE then
  544. location_freetemp(list,oldloc);
  545. end;
  546. {$else cpu64bit}
  547. { 64-bit version }
  548. procedure location_force_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  549. var
  550. hregister : tregister;
  551. hl : tasmlabel;
  552. oldloc : tlocation;
  553. begin
  554. oldloc:=l;
  555. hregister:=cg.getintregister(list,dst_size);
  556. { load value in new register }
  557. case l.loc of
  558. LOC_FLAGS :
  559. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  560. LOC_JUMP :
  561. begin
  562. cg.a_label(list,current_procinfo.CurrTrueLabel);
  563. cg.a_load_const_reg(list,dst_size,1,hregister);
  564. current_asmdata.getjumplabel(hl);
  565. cg.a_jmp_always(list,hl);
  566. cg.a_label(list,current_procinfo.CurrFalseLabel);
  567. cg.a_load_const_reg(list,dst_size,0,hregister);
  568. cg.a_label(list,hl);
  569. end;
  570. else
  571. begin
  572. { load_loc_reg can only handle size >= l.size, when the
  573. new size is smaller then we need to adjust the size
  574. of the orignal and maybe recalculate l.register for i386 }
  575. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  576. begin
  577. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  578. l.register:=cg.makeregsize(list,l.register,dst_size);
  579. { for big endian systems, the reference's offset must }
  580. { be increased in this case, since they have the }
  581. { MSB first in memory and e.g. byte(word_var) should }
  582. { return the second byte in this case (JM) }
  583. if (target_info.endian = ENDIAN_BIG) and
  584. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  585. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  586. {$ifdef x86}
  587. l.size:=dst_size;
  588. {$endif x86}
  589. end;
  590. cg.a_load_loc_reg(list,dst_size,l,hregister);
  591. {$ifndef x86}
  592. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  593. l.size:=dst_size;
  594. {$endif not x86}
  595. end;
  596. end;
  597. if (l.loc <> LOC_CREGISTER) or
  598. not maybeconst then
  599. location_reset(l,LOC_REGISTER,dst_size)
  600. else
  601. location_reset(l,LOC_CREGISTER,dst_size);
  602. l.register:=hregister;
  603. { Release temp when it was a reference }
  604. if oldloc.loc=LOC_REFERENCE then
  605. location_freetemp(list,oldloc);
  606. end;
  607. {$endif cpu64bit}
  608. procedure location_force_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  609. var
  610. reg : tregister;
  611. href : treference;
  612. begin
  613. if (l.loc<>LOC_FPUREGISTER) and
  614. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  615. begin
  616. { if it's in an mm register, store to memory first }
  617. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  618. begin
  619. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  620. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
  621. location_reset(l,LOC_REFERENCE,l.size);
  622. l.reference:=href;
  623. end;
  624. reg:=cg.getfpuregister(list,l.size);
  625. cg.a_loadfpu_loc_reg(list,l,reg);
  626. location_freetemp(list,l);
  627. location_reset(l,LOC_FPUREGISTER,l.size);
  628. l.register:=reg;
  629. end;
  630. end;
  631. procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean);
  632. var
  633. reg : tregister;
  634. href : treference;
  635. begin
  636. if (l.loc<>LOC_MMREGISTER) and
  637. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  638. begin
  639. { if it's in an fpu register, store to memory first }
  640. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  641. begin
  642. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  643. cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
  644. location_reset(l,LOC_REFERENCE,l.size);
  645. l.reference:=href;
  646. end;
  647. reg:=cg.getmmregister(list,l.size);
  648. cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
  649. location_freetemp(list,l);
  650. location_reset(l,LOC_MMREGISTER,l.size);
  651. l.register:=reg;
  652. end;
  653. end;
  654. procedure location_force_mem(list:TAsmList;var l:tlocation);
  655. var
  656. r : treference;
  657. begin
  658. case l.loc of
  659. LOC_FPUREGISTER,
  660. LOC_CFPUREGISTER :
  661. begin
  662. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  663. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  664. location_reset(l,LOC_REFERENCE,l.size);
  665. l.reference:=r;
  666. end;
  667. LOC_MMREGISTER,
  668. LOC_CMMREGISTER:
  669. begin
  670. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  671. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
  672. location_reset(l,LOC_REFERENCE,l.size);
  673. l.reference:=r;
  674. end;
  675. LOC_CONSTANT,
  676. LOC_REGISTER,
  677. LOC_CREGISTER :
  678. begin
  679. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  680. {$ifndef cpu64bit}
  681. if l.size in [OS_64,OS_S64] then
  682. cg64.a_load64_loc_ref(list,l,r)
  683. else
  684. {$endif cpu64bit}
  685. cg.a_load_loc_ref(list,l.size,l,r);
  686. location_reset(l,LOC_REFERENCE,l.size);
  687. l.reference:=r;
  688. end;
  689. LOC_SUBSETREG,
  690. LOC_CSUBSETREG,
  691. LOC_SUBSETREF,
  692. LOC_CSUBSETREF:
  693. begin
  694. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  695. cg.a_load_loc_ref(list,l.size,l,r);
  696. location_reset(l,LOC_REFERENCE,l.size);
  697. l.reference:=r;
  698. end;
  699. LOC_CREFERENCE,
  700. LOC_REFERENCE : ;
  701. else
  702. internalerror(200203219);
  703. end;
  704. end;
  705. procedure location_get_data_ref(list:TAsmList;const l:tlocation;var ref:treference;loadref:boolean);
  706. begin
  707. case l.loc of
  708. LOC_REGISTER,
  709. LOC_CREGISTER :
  710. begin
  711. if not loadref then
  712. internalerror(200410231);
  713. reference_reset_base(ref,l.register,0);
  714. end;
  715. LOC_REFERENCE,
  716. LOC_CREFERENCE :
  717. begin
  718. if loadref then
  719. begin
  720. reference_reset_base(ref,cg.getaddressregister(list),0);
  721. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,l.reference,ref.base);
  722. end
  723. else
  724. ref:=l.reference;
  725. end;
  726. else
  727. internalerror(200309181);
  728. end;
  729. end;
  730. {*****************************************************************************
  731. Maybe_Save
  732. *****************************************************************************}
  733. function maybe_pushfpu(list:TAsmList;needed : byte;var l:tlocation) : boolean;
  734. begin
  735. {$ifdef i386}
  736. if (needed>=maxfpuregs) and
  737. (l.loc = LOC_FPUREGISTER) then
  738. begin
  739. location_force_mem(list,l);
  740. maybe_pushfpu:=true;
  741. end
  742. else
  743. maybe_pushfpu:=false;
  744. {$else i386}
  745. maybe_pushfpu:=false;
  746. {$endif i386}
  747. end;
  748. {****************************************************************************
  749. Init/Finalize Code
  750. ****************************************************************************}
  751. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  752. var
  753. href : treference;
  754. hreg : tregister;
  755. list : TAsmList;
  756. hsym : tparavarsym;
  757. l : longint;
  758. localcopyloc : tlocation;
  759. begin
  760. list:=TAsmList(arg);
  761. if (tsym(p).typ=paravarsym) and
  762. (tparavarsym(p).varspez=vs_value) and
  763. (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
  764. begin
  765. location_get_data_ref(list,tparavarsym(p).localloc,href,true);
  766. if is_open_array(tparavarsym(p).vartype.def) or
  767. is_array_of_const(tparavarsym(p).vartype.def) then
  768. begin
  769. { cdecl functions don't have a high pointer so it is not possible to generate
  770. a local copy }
  771. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  772. begin
  773. hsym:=tparavarsym(tsym(p).owner.search('high'+p.name));
  774. if not assigned(hsym) then
  775. internalerror(200306061);
  776. hreg:=cg.getaddressregister(list);
  777. if not is_packed_array(tparavarsym(p).vartype.def) then
  778. cg.g_copyvaluepara_openarray(list,href,hsym.localloc,tarraydef(tparavarsym(p).vartype.def).elesize,hreg)
  779. else
  780. internalerror(2006080401);
  781. // cg.g_copyvaluepara_packedopenarray(list,href,hsym.localloc,tarraydef(tparavarsym(p).vartype.def).elepackedbitsize,hreg);
  782. cg.a_load_reg_loc(list,OS_ADDR,hreg,tparavarsym(p).localloc);
  783. end;
  784. end
  785. else
  786. begin
  787. { Allocate space for the local copy }
  788. l:=tparavarsym(p).getsize;
  789. localcopyloc.loc:=LOC_REFERENCE;
  790. localcopyloc.size:=int_cgsize(l);
  791. tg.GetLocal(list,l,tparavarsym(p).vartype.def,localcopyloc.reference);
  792. { Copy data }
  793. if is_shortstring(tparavarsym(p).vartype.def) then
  794. begin
  795. { this code is only executed before the code for the body and the entry/exit code is generated
  796. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  797. }
  798. include(current_procinfo.flags,pi_do_call);
  799. cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vartype.def).len)
  800. end
  801. else
  802. begin
  803. { pass proper alignment info }
  804. localcopyloc.reference.alignment:=tparavarsym(p).vartype.def.alignment;
  805. cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vartype.def.size);
  806. end;
  807. { update localloc of varsym }
  808. tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
  809. tparavarsym(p).localloc:=localcopyloc;
  810. end;
  811. end;
  812. end;
  813. const
  814. {$ifdef cpu64bit}
  815. trashintvalues: array[0..nroftrashvalues-1] of aint = ($5555555555555555,aint($AAAAAAAAAAAAAAAA),aint($EFEFEFEFEFEFEFEF),0);
  816. {$else cpu64bit}
  817. trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0);
  818. {$endif cpu64bit}
  819. procedure trash_reference(list: TAsmList; const ref: treference; size: aint);
  820. var
  821. countreg, valuereg: tregister;
  822. hl: tasmlabel;
  823. trashintval: aint;
  824. tmpref: treference;
  825. begin
  826. trashintval := trashintvalues[localvartrashing];
  827. case size of
  828. 0: ; { empty record }
  829. 1: cg.a_load_const_ref(list,OS_8,byte(trashintval),ref);
  830. 2: cg.a_load_const_ref(list,OS_16,word(trashintval),ref);
  831. 4: cg.a_load_const_ref(list,OS_32,longint(trashintval),ref);
  832. {$ifdef cpu64bit}
  833. 8: cg.a_load_const_ref(list,OS_64,int64(trashintval),ref);
  834. {$endif cpu64bit}
  835. else
  836. begin
  837. countreg := cg.getintregister(list,OS_ADDR);
  838. valuereg := cg.getintregister(list,OS_8);
  839. cg.a_load_const_reg(list,OS_INT,size,countreg);
  840. cg.a_load_const_reg(list,OS_8,byte(trashintval),valuereg);
  841. current_asmdata.getjumplabel(hl);
  842. tmpref := ref;
  843. if (tmpref.index <> NR_NO) then
  844. internalerror(200607201);
  845. tmpref.index := countreg;
  846. dec(tmpref.offset);
  847. cg.a_label(list,hl);
  848. cg.a_load_reg_ref(list,OS_8,OS_8,valuereg,tmpref);
  849. cg.a_op_const_reg(list,OP_SUB,OS_INT,1,countreg);
  850. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,countreg,hl);
  851. cg.a_reg_sync(list,tmpref.base);
  852. cg.a_reg_sync(list,valuereg);
  853. end;
  854. end;
  855. end;
  856. { trash contents of local variables or parameters (function result) }
  857. procedure trash_variable(p : tnamedindexitem;arg:pointer);
  858. var
  859. trashintval: aint;
  860. list: TAsmList absolute arg;
  861. begin
  862. if (tsym(p).typ=localvarsym) or
  863. ((tsym(p).typ=paravarsym) and
  864. (vo_is_funcret in tparavarsym(p).varoptions)) then
  865. begin
  866. trashintval := trashintvalues[localvartrashing];
  867. case tabstractnormalvarsym(p).localloc.loc of
  868. LOC_CREGISTER :
  869. {$ifopt q+}
  870. {$define overflowon}
  871. {$q-}
  872. {$endif}
  873. cg.a_load_const_reg(list,reg_cgsize(tabstractnormalvarsym(p).localloc.register),
  874. trashintval and (aint(1) shl (tcgsize2size[reg_cgsize(tabstractnormalvarsym(p).localloc.register)] * 8) - 1),
  875. tabstractnormalvarsym(p).localloc.register);
  876. {$ifdef overflowon}
  877. {$undef overflowon}
  878. {$q+}
  879. {$endif}
  880. LOC_REFERENCE :
  881. begin
  882. trash_reference(list,tabstractnormalvarsym(p).localloc.reference,
  883. tlocalvarsym(p).getsize);
  884. end;
  885. LOC_CMMREGISTER :
  886. ;
  887. LOC_CFPUREGISTER :
  888. ;
  889. else
  890. internalerror(200410124);
  891. end;
  892. end;
  893. end;
  894. { initializes the regvars from staticsymtable with 0 }
  895. procedure initialize_regvars(p : tnamedindexitem;arg:pointer);
  896. begin
  897. if (tsym(p).typ=globalvarsym) then
  898. begin
  899. case tglobalvarsym(p).localloc.loc of
  900. LOC_CREGISTER :
  901. cg.a_load_const_reg(TAsmList(arg),reg_cgsize(tglobalvarsym(p).localloc.register),0,
  902. tglobalvarsym(p).localloc.register);
  903. LOC_REFERENCE : ;
  904. LOC_CMMREGISTER :
  905. { clear the whole register }
  906. cg.a_opmm_reg_reg(TAsmList(arg),OP_XOR,reg_cgsize(tglobalvarsym(p).localloc.register),
  907. tglobalvarsym(p).localloc.register,
  908. tglobalvarsym(p).localloc.register,
  909. nil);
  910. LOC_CFPUREGISTER :
  911. ;
  912. else
  913. internalerror(200410124);
  914. end;
  915. end;
  916. end;
  917. { generates the code for initialisation of local data }
  918. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  919. var
  920. OldAsmList : TAsmList;
  921. hp : tnode;
  922. begin
  923. if (tsym(p).typ in [globalvarsym,localvarsym]) and
  924. (tabstractvarsym(p).refs>0) and
  925. not(vo_is_external in tabstractvarsym(p).varoptions) and
  926. not(is_class(tabstractvarsym(p).vartype.def)) and
  927. tabstractvarsym(p).vartype.def.needs_inittable then
  928. begin
  929. OldAsmList:=current_asmdata.CurrAsmList;
  930. current_asmdata.CurrAsmList:=TAsmList(arg);
  931. hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  932. firstpass(hp);
  933. secondpass(hp);
  934. hp.free;
  935. current_asmdata.CurrAsmList:=OldAsmList;
  936. end;
  937. end;
  938. procedure finalize_sym(asmlist:TAsmList;sym:tsym);
  939. var
  940. hp : tnode;
  941. OldAsmList : TAsmList;
  942. begin
  943. include(current_procinfo.flags,pi_needs_implicit_finally);
  944. OldAsmList:=current_asmdata.CurrAsmList;
  945. current_asmdata.CurrAsmList:=asmlist;
  946. hp:=finalize_data_node(cloadnode.create(sym,sym.owner));
  947. firstpass(hp);
  948. secondpass(hp);
  949. hp.free;
  950. current_asmdata.CurrAsmList:=OldAsmList;
  951. end;
  952. { generates the code for finalisation of local variables }
  953. procedure finalize_local_vars(p : tnamedindexitem;arg:pointer);
  954. begin
  955. if (tsym(p).typ=localvarsym) and
  956. (tlocalvarsym(p).refs>0) and
  957. not(vo_is_external in tlocalvarsym(p).varoptions) and
  958. not(vo_is_funcret in tlocalvarsym(p).varoptions) and
  959. not(is_class(tlocalvarsym(p).vartype.def)) and
  960. tlocalvarsym(p).vartype.def.needs_inittable then
  961. finalize_sym(TAsmList(arg),tsym(p));
  962. end;
  963. { generates the code for finalisation of local typedconsts }
  964. procedure finalize_local_typedconst(p : tnamedindexitem;arg:pointer);
  965. var
  966. i : longint;
  967. pd : tprocdef;
  968. begin
  969. case tsym(p).typ of
  970. typedconstsym :
  971. begin
  972. if ttypedconstsym(p).is_writable and
  973. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  974. finalize_sym(TAsmList(arg),tsym(p));
  975. end;
  976. procsym :
  977. begin
  978. for i:=1 to tprocsym(p).procdef_count do
  979. begin
  980. pd:=tprocsym(p).procdef[i];
  981. if assigned(pd.localst) and
  982. (pd.procsym=tprocsym(p)) and
  983. (pd.localst.symtabletype<>staticsymtable) then
  984. pd.localst.foreach_static(@finalize_local_typedconst,arg);
  985. end;
  986. end;
  987. end;
  988. end;
  989. { generates the code for finalization of static symtable and
  990. all local (static) typedconsts }
  991. procedure finalize_static_data(p : tnamedindexitem;arg:pointer);
  992. var
  993. i : longint;
  994. pd : tprocdef;
  995. begin
  996. case tsym(p).typ of
  997. globalvarsym :
  998. begin
  999. if (tglobalvarsym(p).refs>0) and
  1000. not(vo_is_funcret in tglobalvarsym(p).varoptions) and
  1001. not(vo_is_external in tglobalvarsym(p).varoptions) and
  1002. not(is_class(tglobalvarsym(p).vartype.def)) and
  1003. tglobalvarsym(p).vartype.def.needs_inittable then
  1004. finalize_sym(TAsmList(arg),tsym(p));
  1005. end;
  1006. typedconstsym :
  1007. begin
  1008. if ttypedconstsym(p).is_writable and
  1009. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  1010. finalize_sym(TAsmList(arg),tsym(p));
  1011. end;
  1012. procsym :
  1013. begin
  1014. for i:=1 to tprocsym(p).procdef_count do
  1015. begin
  1016. pd:=tprocsym(p).procdef[i];
  1017. if assigned(pd.localst) and
  1018. (pd.procsym=tprocsym(p)) and
  1019. (pd.localst.symtabletype<>staticsymtable) then
  1020. pd.localst.foreach_static(@finalize_local_typedconst,arg);
  1021. end;
  1022. end;
  1023. end;
  1024. end;
  1025. { generates the code for incrementing the reference count of parameters and
  1026. initialize out parameters }
  1027. procedure init_paras(p : tnamedindexitem;arg:pointer);
  1028. var
  1029. href : treference;
  1030. tmpreg : tregister;
  1031. list : TAsmList;
  1032. needs_inittable: boolean;
  1033. begin
  1034. list:=TAsmList(arg);
  1035. if (tsym(p).typ=paravarsym) then
  1036. begin
  1037. needs_inittable :=
  1038. not is_class_or_interface(tparavarsym(p).vartype.def) and
  1039. tparavarsym(p).vartype.def.needs_inittable;
  1040. case tparavarsym(p).varspez of
  1041. vs_value :
  1042. if needs_inittable then
  1043. begin
  1044. location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vartype.def));
  1045. cg.g_incrrefcount(list,tparavarsym(p).vartype.def,href);
  1046. end;
  1047. vs_out :
  1048. begin
  1049. if (needs_inittable) or
  1050. (localvartrashing <> -1) then
  1051. begin
  1052. tmpreg:=cg.getaddressregister(list);
  1053. cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).localloc,tmpreg);
  1054. reference_reset_base(href,tmpreg,0);
  1055. if (localvartrashing <> -1) and
  1056. { needs separate implementation to trash open arrays }
  1057. { since their size is only known at run time }
  1058. not is_special_array(tparavarsym(p).vartype.def) then
  1059. trash_reference(list,href,tparavarsym(p).vartype.def.size);
  1060. if needs_inittable then
  1061. cg.g_initialize(list,tparavarsym(p).vartype.def,href);
  1062. end;
  1063. end;
  1064. else if (localvartrashing <> -1) and
  1065. ([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
  1066. begin
  1067. tmpreg:=cg.getaddressregister(list);
  1068. cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).localloc,tmpreg);
  1069. reference_reset_base(href,tmpreg,0);
  1070. trash_reference(list,href,tparavarsym(p).vartype.def.size);
  1071. end
  1072. end;
  1073. end;
  1074. end;
  1075. { generates the code for decrementing the reference count of parameters }
  1076. procedure final_paras(p : tnamedindexitem;arg:pointer);
  1077. var
  1078. list : TAsmList;
  1079. href : treference;
  1080. begin
  1081. if not(tsym(p).typ=paravarsym) then
  1082. exit;
  1083. list:=TAsmList(arg);
  1084. if not is_class_or_interface(tparavarsym(p).vartype.def) and
  1085. tparavarsym(p).vartype.def.needs_inittable then
  1086. begin
  1087. if (tparavarsym(p).varspez=vs_value) then
  1088. begin
  1089. include(current_procinfo.flags,pi_needs_implicit_finally);
  1090. location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vartype.def));
  1091. cg.g_decrrefcount(list,tparavarsym(p).vartype.def,href);
  1092. end;
  1093. end
  1094. else
  1095. if (tparavarsym(p).varspez=vs_value) and
  1096. (is_open_array(tparavarsym(p).vartype.def) or
  1097. is_array_of_const(tparavarsym(p).vartype.def)) then
  1098. begin
  1099. { cdecl functions don't have a high pointer so it is not possible to generate
  1100. a local copy }
  1101. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  1102. cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
  1103. end;
  1104. end;
  1105. { Initialize temp ansi/widestrings,interfaces }
  1106. procedure inittempvariables(list:TAsmList);
  1107. var
  1108. hp : ptemprecord;
  1109. href : treference;
  1110. begin
  1111. hp:=tg.templist;
  1112. while assigned(hp) do
  1113. begin
  1114. if assigned(hp^.def) and
  1115. hp^.def.needs_inittable then
  1116. begin
  1117. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1118. cg.g_initialize(list,hp^.def,href);
  1119. end;
  1120. hp:=hp^.next;
  1121. end;
  1122. end;
  1123. procedure finalizetempvariables(list:TAsmList);
  1124. var
  1125. hp : ptemprecord;
  1126. href : treference;
  1127. begin
  1128. hp:=tg.templist;
  1129. while assigned(hp) do
  1130. begin
  1131. if assigned(hp^.def) and
  1132. hp^.def.needs_inittable then
  1133. begin
  1134. include(current_procinfo.flags,pi_needs_implicit_finally);
  1135. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1136. cg.g_finalize(list,hp^.def,href);
  1137. end;
  1138. hp:=hp^.next;
  1139. end;
  1140. end;
  1141. procedure gen_load_return_value(list:TAsmList);
  1142. var
  1143. {$ifndef cpu64bit}
  1144. href : treference;
  1145. {$endif cpu64bit}
  1146. ressym : tabstractnormalvarsym;
  1147. resloc,
  1148. restmploc : tlocation;
  1149. hreg : tregister;
  1150. funcretloc : tlocation;
  1151. begin
  1152. { Is the loading needed? }
  1153. if (current_procinfo.procdef.funcretloc[calleeside].loc=LOC_VOID) or
  1154. (
  1155. (po_assembler in current_procinfo.procdef.procoptions) and
  1156. (not(assigned(current_procinfo.procdef.funcretsym)) or
  1157. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0))
  1158. ) then
  1159. exit;
  1160. funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
  1161. { constructors return self }
  1162. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1163. ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.search('self'))
  1164. else
  1165. ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
  1166. if (ressym.refs>0) then
  1167. begin
  1168. {$ifdef OLDREGVARS}
  1169. case ressym.localloc.loc of
  1170. LOC_CFPUREGISTER,
  1171. LOC_FPUREGISTER:
  1172. begin
  1173. location_reset(restmploc,LOC_CFPUREGISTER,funcretloc^.size);
  1174. restmploc.register:=ressym.localloc.register;
  1175. end;
  1176. LOC_CREGISTER,
  1177. LOC_REGISTER:
  1178. begin
  1179. location_reset(restmploc,LOC_CREGISTER,funcretloc^.size);
  1180. restmploc.register:=ressym.localloc.register;
  1181. end;
  1182. LOC_MMREGISTER:
  1183. begin
  1184. location_reset(restmploc,LOC_CMMREGISTER,funcretloc^.size);
  1185. restmploc.register:=ressym.localloc.register;
  1186. end;
  1187. LOC_REFERENCE:
  1188. begin
  1189. location_reset(restmploc,LOC_REFERENCE,funcretloc^.size);
  1190. restmploc.reference:=ressym.localloc.reference;
  1191. end;
  1192. else
  1193. internalerror(200309184);
  1194. end;
  1195. {$else}
  1196. restmploc:=ressym.localloc;
  1197. {$endif}
  1198. { Here, we return the function result. In most architectures, the value is
  1199. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1200. function returns in a register and the caller receives it in an other one }
  1201. case funcretloc.loc of
  1202. LOC_REGISTER:
  1203. begin
  1204. {$ifndef cpu64bit}
  1205. if current_procinfo.procdef.funcretloc[calleeside].size in [OS_64,OS_S64] then
  1206. begin
  1207. resloc:=current_procinfo.procdef.funcretloc[calleeside];
  1208. if resloc.loc<>LOC_REGISTER then
  1209. internalerror(200409141);
  1210. { Load low and high register separate to generate better register
  1211. allocation info }
  1212. if getsupreg(resloc.register64.reglo)<first_int_imreg then
  1213. begin
  1214. cg.getcpuregister(list,resloc.register64.reglo);
  1215. end;
  1216. case restmploc.loc of
  1217. LOC_REFERENCE :
  1218. begin
  1219. href:=restmploc.reference;
  1220. if target_info.endian=ENDIAN_BIG then
  1221. inc(href.offset,4);
  1222. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.register64.reglo);
  1223. end;
  1224. LOC_CREGISTER :
  1225. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reglo,resloc.register64.reglo);
  1226. else
  1227. internalerror(200409203);
  1228. end;
  1229. if getsupreg(resloc.register64.reghi)<first_int_imreg then
  1230. begin
  1231. cg.getcpuregister(list,resloc.register64.reghi);
  1232. end;
  1233. case restmploc.loc of
  1234. LOC_REFERENCE :
  1235. begin
  1236. href:=restmploc.reference;
  1237. if target_info.endian=ENDIAN_LITTLE then
  1238. inc(href.offset,4);
  1239. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.register64.reghi);
  1240. end;
  1241. LOC_CREGISTER :
  1242. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reghi,resloc.register64.reghi);
  1243. else
  1244. internalerror(200409204);
  1245. end;
  1246. end
  1247. else
  1248. {$endif cpu64bit}
  1249. begin
  1250. hreg:=cg.makeregsize(list,funcretloc.register,funcretloc.size);
  1251. if getsupreg(funcretloc.register)<first_int_imreg then
  1252. begin
  1253. cg.getcpuregister(list,funcretloc.register);
  1254. end;
  1255. { it could be that a structure is passed in memory but the function is expected to
  1256. return a pointer to this memory }
  1257. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1258. cg.a_load_loc_reg(list,OS_ADDR,restmploc,hreg)
  1259. else
  1260. cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
  1261. end;
  1262. end;
  1263. LOC_FPUREGISTER:
  1264. begin
  1265. if getsupreg(funcretloc.register)<first_fpu_imreg then
  1266. begin
  1267. cg.getcpuregister(list,funcretloc.register);
  1268. end;
  1269. { we can't do direct moves between fpu and mm registers }
  1270. if restmploc.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then
  1271. location_force_fpureg(list,restmploc,false);
  1272. cg.a_loadfpu_loc_reg(list,restmploc,funcretloc.register);
  1273. end;
  1274. LOC_MMREGISTER:
  1275. begin
  1276. if getsupreg(funcretloc.register)<first_mm_imreg then
  1277. begin
  1278. cg.getcpuregister(list,funcretloc.register);
  1279. end;
  1280. cg.a_loadmm_loc_reg(list,restmploc.size,restmploc,funcretloc.register,mms_movescalar);
  1281. end;
  1282. LOC_INVALID,
  1283. LOC_REFERENCE:
  1284. ;
  1285. else
  1286. internalerror(200405025);
  1287. end;
  1288. end
  1289. {$ifdef x86}
  1290. else
  1291. begin
  1292. { the caller will pop a value off the cpu stack }
  1293. if (funcretloc.loc = LOC_FPUREGISTER) then
  1294. list.concat(taicpu.op_none(A_FLDZ));
  1295. end;
  1296. {$endif x86}
  1297. end;
  1298. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym);
  1299. begin
  1300. case sym.localloc.loc of
  1301. LOC_CREGISTER:
  1302. begin
  1303. {$ifndef cpu64bit}
  1304. if sym.localloc.size in [OS_64,OS_S64] then
  1305. begin
  1306. sym.localloc.register64.reglo:=cg.getintregister(list,OS_32);
  1307. sym.localloc.register64.reghi:=cg.getintregister(list,OS_32);
  1308. end
  1309. else
  1310. {$endif cpu64bit}
  1311. sym.localloc.register:=cg.getintregister(list,sym.localloc.size);
  1312. end;
  1313. LOC_CFPUREGISTER:
  1314. begin
  1315. sym.localloc.register:=cg.getfpuregister(list,sym.localloc.size);
  1316. end;
  1317. LOC_CMMREGISTER:
  1318. begin
  1319. sym. localloc.register:=cg.getmmregister(list,sym.localloc.size);
  1320. end;
  1321. end;
  1322. if (pi_has_goto in current_procinfo.flags) then
  1323. begin
  1324. { Allocate register already, to prevent first allocation to be
  1325. inside a loop }
  1326. {$ifndef cpu64bit}
  1327. if sym.localloc.size in [OS_64,OS_S64] then
  1328. begin
  1329. cg.a_reg_sync(list,sym.localloc.register64.reglo);
  1330. cg.a_reg_sync(list,sym.localloc.register64.reghi);
  1331. end
  1332. else
  1333. {$endif cpu64bit}
  1334. cg.a_reg_sync(list,sym.localloc.register);
  1335. end;
  1336. end;
  1337. procedure gen_load_para_value(list:TAsmList);
  1338. procedure get_para(const paraloc:TCGParaLocation);
  1339. begin
  1340. case paraloc.loc of
  1341. LOC_REGISTER :
  1342. begin
  1343. if getsupreg(paraloc.register)<first_int_imreg then
  1344. cg.getcpuregister(list,paraloc.register);
  1345. end;
  1346. LOC_MMREGISTER :
  1347. begin
  1348. if getsupreg(paraloc.register)<first_mm_imreg then
  1349. cg.getcpuregister(list,paraloc.register);
  1350. end;
  1351. LOC_FPUREGISTER :
  1352. begin
  1353. if getsupreg(paraloc.register)<first_fpu_imreg then
  1354. cg.getcpuregister(list,paraloc.register);
  1355. end;
  1356. end;
  1357. end;
  1358. procedure unget_para(const paraloc:TCGParaLocation);
  1359. begin
  1360. case paraloc.loc of
  1361. LOC_REGISTER :
  1362. begin
  1363. if getsupreg(paraloc.register)<first_int_imreg then
  1364. cg.ungetcpuregister(list,paraloc.register);
  1365. end;
  1366. LOC_MMREGISTER :
  1367. begin
  1368. if getsupreg(paraloc.register)<first_mm_imreg then
  1369. cg.ungetcpuregister(list,paraloc.register);
  1370. end;
  1371. LOC_FPUREGISTER :
  1372. begin
  1373. if getsupreg(paraloc.register)<first_fpu_imreg then
  1374. cg.ungetcpuregister(list,paraloc.register);
  1375. end;
  1376. end;
  1377. end;
  1378. procedure gen_load_ref(const paraloc:TCGParaLocation;const ref:treference;sizeleft:aint);
  1379. var
  1380. href : treference;
  1381. begin
  1382. case paraloc.loc of
  1383. LOC_REGISTER :
  1384. begin
  1385. {$IFDEF POWERPC64}
  1386. if (paraloc.shiftval <> 0) then
  1387. cg.a_op_const_reg_reg(list, OP_SHL, OS_INT, paraloc.shiftval, paraloc.register, paraloc.register);
  1388. {$ENDIF POWERPC64}
  1389. cg.a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
  1390. end;
  1391. LOC_MMREGISTER :
  1392. cg.a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar);
  1393. LOC_FPUREGISTER :
  1394. cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
  1395. LOC_REFERENCE :
  1396. begin
  1397. reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
  1398. { use concatcopy, because it can also be a float which fails when
  1399. load_ref_ref is used. Don't copy data when the references are equal }
  1400. if not((href.base=ref.base) and (href.offset=ref.offset)) then
  1401. cg.g_concatcopy(list,href,ref,sizeleft);
  1402. end;
  1403. else
  1404. internalerror(2002081302);
  1405. end;
  1406. end;
  1407. procedure gen_load_reg(const paraloc:TCGParaLocation;reg:tregister);
  1408. var
  1409. href : treference;
  1410. begin
  1411. case paraloc.loc of
  1412. LOC_REGISTER :
  1413. cg.a_load_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg);
  1414. LOC_MMREGISTER :
  1415. cg.a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,mms_movescalar);
  1416. LOC_FPUREGISTER :
  1417. cg.a_loadfpu_reg_reg(list,paraloc.size,paraloc.register,reg);
  1418. LOC_REFERENCE :
  1419. begin
  1420. reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
  1421. case getregtype(reg) of
  1422. R_INTREGISTER :
  1423. cg.a_load_ref_reg(list,paraloc.size,paraloc.size,href,reg);
  1424. R_FPUREGISTER :
  1425. cg.a_loadfpu_ref_reg(list,paraloc.size,href,reg);
  1426. R_MMREGISTER :
  1427. cg.a_loadmm_ref_reg(list,paraloc.size,paraloc.size,href,reg,mms_movescalar);
  1428. else
  1429. internalerror(2004101012);
  1430. end;
  1431. end;
  1432. else
  1433. internalerror(2002081302);
  1434. end;
  1435. end;
  1436. var
  1437. i : longint;
  1438. currpara : tparavarsym;
  1439. paraloc : pcgparalocation;
  1440. href : treference;
  1441. sizeleft : aint;
  1442. {$ifdef sparc}
  1443. tempref : treference;
  1444. {$endif sparc}
  1445. begin
  1446. if (po_assembler in current_procinfo.procdef.procoptions) then
  1447. exit;
  1448. { Allocate registers used by parameters }
  1449. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1450. begin
  1451. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1452. paraloc:=currpara.paraloc[calleeside].location;
  1453. while assigned(paraloc) do
  1454. begin
  1455. if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
  1456. get_para(paraloc^);
  1457. paraloc:=paraloc^.next;
  1458. end;
  1459. end;
  1460. { Copy parameters to local references/registers }
  1461. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1462. begin
  1463. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1464. paraloc:=currpara.paraloc[calleeside].location;
  1465. { skip e.g. empty records }
  1466. if not assigned(paraloc) then
  1467. internalerror(200408203);
  1468. if (paraloc^.loc = LOC_VOID) then
  1469. continue;
  1470. case currpara.localloc.loc of
  1471. LOC_REFERENCE :
  1472. begin
  1473. { If the parameter location is reused we don't need to copy
  1474. anything }
  1475. if not paramanager.param_use_paraloc(currpara.paraloc[calleeside]) then
  1476. begin
  1477. href:=currpara.localloc.reference;
  1478. sizeleft:=currpara.paraloc[calleeside].intsize;
  1479. while assigned(paraloc) do
  1480. begin
  1481. unget_para(paraloc^);
  1482. if (paraloc^.size=OS_NO) then
  1483. begin
  1484. { Can only be a reference that contains the rest
  1485. of the parameter }
  1486. if (paraloc^.loc<>LOC_REFERENCE) or
  1487. assigned(paraloc^.next) then
  1488. internalerror(2005013010);
  1489. gen_load_ref(paraloc^,href,sizeleft);
  1490. inc(href.offset,sizeleft);
  1491. sizeleft:=0;
  1492. end
  1493. else
  1494. begin
  1495. gen_load_ref(paraloc^,href,tcgsize2size[paraloc^.size]);
  1496. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1497. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1498. end;
  1499. paraloc:=paraloc^.next;
  1500. end;
  1501. end;
  1502. end;
  1503. LOC_CREGISTER :
  1504. begin
  1505. {$ifndef cpu64bit}
  1506. if (currpara.paraloc[calleeside].size in [OS_64,OS_S64]) and
  1507. is_64bit(currpara.vartype.def) then
  1508. begin
  1509. case paraloc^.loc of
  1510. LOC_REGISTER:
  1511. begin
  1512. if not assigned(paraloc^.next) then
  1513. internalerror(200410104);
  1514. if (target_info.endian=ENDIAN_BIG) then
  1515. begin
  1516. { paraloc^ -> high
  1517. paraloc^.next -> low }
  1518. unget_para(paraloc^);
  1519. gen_alloc_regvar(list,currpara);
  1520. gen_load_reg(paraloc^,currpara.localloc.register64.reghi);
  1521. unget_para(paraloc^.next^);
  1522. gen_load_reg(paraloc^.next^,currpara.localloc.register64.reglo);
  1523. end
  1524. else
  1525. begin
  1526. { paraloc^ -> low
  1527. paraloc^.next -> high }
  1528. unget_para(paraloc^);
  1529. gen_alloc_regvar(list,currpara);
  1530. gen_load_reg(paraloc^,currpara.localloc.register64.reglo);
  1531. unget_para(paraloc^.next^);
  1532. gen_load_reg(paraloc^.next^,currpara.localloc.register64.reghi);
  1533. end;
  1534. end;
  1535. LOC_REFERENCE:
  1536. begin
  1537. gen_alloc_regvar(list,currpara);
  1538. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset);
  1539. cg64.a_load64_ref_reg(list,href,currpara.localloc.register64);
  1540. unget_para(paraloc^);
  1541. end;
  1542. else
  1543. internalerror(2005101501);
  1544. end
  1545. end
  1546. else
  1547. {$endif cpu64bit}
  1548. begin
  1549. if assigned(paraloc^.next) then
  1550. internalerror(200410105);
  1551. unget_para(paraloc^);
  1552. gen_alloc_regvar(list,currpara);
  1553. gen_load_reg(paraloc^,currpara.localloc.register);
  1554. end;
  1555. end;
  1556. LOC_CFPUREGISTER :
  1557. begin
  1558. {$ifdef sparc}
  1559. { Sparc passes floats in int registers, when loading to fpu register
  1560. we need a temp }
  1561. sizeleft := TCGSize2Size[currpara.localloc.size];
  1562. tg.GetTemp(list,sizeleft,tt_normal,tempref);
  1563. href:=tempref;
  1564. while assigned(paraloc) do
  1565. begin
  1566. unget_para(paraloc^);
  1567. gen_load_ref(paraloc^,href,sizeleft);
  1568. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1569. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1570. paraloc:=paraloc^.next;
  1571. end;
  1572. gen_alloc_regvar(list,currpara);
  1573. cg.a_loadfpu_ref_reg(list,currpara.localloc.size,tempref,currpara.localloc.register);
  1574. tg.UnGetTemp(list,tempref);
  1575. {$else sparc}
  1576. unget_para(paraloc^);
  1577. gen_alloc_regvar(list,currpara);
  1578. gen_load_reg(paraloc^,currpara.localloc.register);
  1579. if assigned(paraloc^.next) then
  1580. internalerror(200410109);
  1581. {$endif sparc}
  1582. end;
  1583. LOC_CMMREGISTER :
  1584. begin
  1585. unget_para(paraloc^);
  1586. gen_alloc_regvar(list,currpara);
  1587. gen_load_reg(paraloc^,currpara.localloc.register);
  1588. { data could come in two memory locations, for now
  1589. we simply ignore the sanity check (FK)
  1590. if assigned(paraloc^.next) then
  1591. internalerror(200410108);
  1592. }
  1593. end;
  1594. end;
  1595. end;
  1596. { generate copies of call by value parameters, must be done before
  1597. the initialization and body is parsed because the refcounts are
  1598. incremented using the local copies }
  1599. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1600. {$ifdef powerpc}
  1601. { unget the register that contains the stack pointer before the procedure entry, }
  1602. { which is used to access the parameters in their original callee-side location }
  1603. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1604. cg.a_reg_dealloc(list,NR_R12);
  1605. {$endif powerpc}
  1606. {$ifdef powerpc64}
  1607. { unget the register that contains the stack pointer before the procedure entry, }
  1608. { which is used to access the parameters in their original callee-side location }
  1609. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1610. cg.a_reg_dealloc(list, NR_OLD_STACK_POINTER_REG);
  1611. {$endif powerpc64}
  1612. end;
  1613. procedure gen_initialize_code(list:TAsmList);
  1614. begin
  1615. { initialize local data like ansistrings }
  1616. case current_procinfo.procdef.proctypeoption of
  1617. potype_unitinit:
  1618. begin
  1619. { this is also used for initialization of variables in a
  1620. program which does not have a globalsymtable }
  1621. if assigned(current_module.globalsymtable) then
  1622. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1623. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1624. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
  1625. end;
  1626. { units have seperate code for initilization and finalization }
  1627. potype_unitfinalize: ;
  1628. { program init/final is generated in separate procedure }
  1629. potype_proginit:
  1630. begin
  1631. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
  1632. end;
  1633. else
  1634. begin
  1635. if (localvartrashing <> -1) and
  1636. not(po_assembler in current_procinfo.procdef.procoptions) then
  1637. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}trash_variable,list);
  1638. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1639. end;
  1640. end;
  1641. { initialisizes temp. ansi/wide string data }
  1642. inittempvariables(list);
  1643. { initialize ansi/widesstring para's }
  1644. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1645. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1646. {$ifdef OLDREGVARS}
  1647. load_regvars(list,nil);
  1648. {$endif OLDREGVARS}
  1649. end;
  1650. procedure gen_finalize_code(list:TAsmList);
  1651. begin
  1652. {$ifdef OLDREGVARS}
  1653. cleanup_regvars(list);
  1654. {$endif OLDREGVARS}
  1655. { finalize temporary data }
  1656. finalizetempvariables(list);
  1657. { finalize local data like ansistrings}
  1658. case current_procinfo.procdef.proctypeoption of
  1659. potype_unitfinalize:
  1660. begin
  1661. { this is also used for initialization of variables in a
  1662. program which does not have a globalsymtable }
  1663. if assigned(current_module.globalsymtable) then
  1664. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1665. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1666. end;
  1667. { units/progs have separate code for initialization and finalization }
  1668. potype_unitinit: ;
  1669. { program init/final is generated in separate procedure }
  1670. potype_proginit: ;
  1671. else
  1672. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_local_vars,list);
  1673. end;
  1674. { finalize paras data }
  1675. if assigned(current_procinfo.procdef.parast) and
  1676. not(po_assembler in current_procinfo.procdef.procoptions) then
  1677. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1678. end;
  1679. procedure gen_entry_code(list:TAsmList);
  1680. var
  1681. paraloc1,
  1682. paraloc2 : tcgpara;
  1683. begin
  1684. paraloc1.init;
  1685. paraloc2.init;
  1686. { the actual profile code can clobber some registers,
  1687. therefore if the context must be saved, do it before
  1688. the actual call to the profile code
  1689. }
  1690. if (cs_profile in aktmoduleswitches) and
  1691. not(po_assembler in current_procinfo.procdef.procoptions) then
  1692. begin
  1693. { non-win32 can call mcout even in main }
  1694. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1695. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1696. begin
  1697. cg.g_profilecode(list);
  1698. end;
  1699. end;
  1700. { call startup helpers from main program }
  1701. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1702. begin
  1703. { initialize units }
  1704. cg.allocallcpuregisters(list);
  1705. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1706. cg.deallocallcpuregisters(list);
  1707. end;
  1708. list.concat(Tai_force_line.Create);
  1709. {$ifdef OLDREGVARS}
  1710. load_regvars(list,nil);
  1711. {$endif OLDREGVARS}
  1712. paraloc1.done;
  1713. paraloc2.done;
  1714. end;
  1715. procedure gen_exit_code(list:TAsmList);
  1716. begin
  1717. { call __EXIT for main program }
  1718. if (not DLLsource) and
  1719. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1720. cg.a_call_name(list,'FPC_DO_EXIT');
  1721. end;
  1722. {****************************************************************************
  1723. Entry/Exit
  1724. ****************************************************************************}
  1725. procedure alloc_proc_symbol(pd: tprocdef);
  1726. var
  1727. item: tstringlistitem;
  1728. begin
  1729. item := tstringlistitem(pd.aliasnames.first);
  1730. while assigned(item) do
  1731. begin
  1732. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION);
  1733. item := tstringlistitem(item.next);
  1734. end;
  1735. end;
  1736. procedure gen_proc_symbol(list:TAsmList);
  1737. var
  1738. hs : string;
  1739. begin
  1740. repeat
  1741. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1742. if hs='' then
  1743. break;
  1744. if (cs_profile in aktmoduleswitches) or
  1745. (po_global in current_procinfo.procdef.procoptions) then
  1746. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1747. else
  1748. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1749. if tf_use_function_relative_addresses in target_info.flags then
  1750. list.concat(Tai_function_name.create(hs));
  1751. until false;
  1752. current_procinfo.procdef.procstarttai:=tai(list.last);
  1753. end;
  1754. procedure gen_proc_symbol_end(list:TAsmList);
  1755. begin
  1756. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1757. current_procinfo.procdef.procendtai:=tai(list.last);
  1758. { finalisation marker for Mac OS X }
  1759. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) and
  1760. (current_module.islibrary) and
  1761. (((current_module.flags and uf_finalize)<>0) or
  1762. (current_procinfo.procdef.proctypeoption = potype_proginit)) then
  1763. begin
  1764. if (current_procinfo.procdef.proctypeoption = potype_proginit) then
  1765. list.concat(tai_directive.create(asd_mod_init_func,''))
  1766. else
  1767. list.concat(tai_directive.create(asd_mod_term_func,''));
  1768. list.concat(tai_align.create(4));
  1769. list.concat(Tai_const.Createname(current_procinfo.procdef.mangledname,0));
  1770. end;
  1771. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1772. begin
  1773. if (target_info.system in [system_powerpc_darwin,system_i386_darwin,system_powerpc_macos]) and
  1774. not(current_module.islibrary) then
  1775. begin
  1776. list.concat(tai_section.create(sec_code,'',4));
  1777. list.concat(tai_symbol.createname_global(
  1778. target_info.cprefix+mainaliasname,AT_FUNCTION,0));
  1779. { keep argc, argv and envp properly on the stack }
  1780. cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN');
  1781. end;
  1782. end;
  1783. end;
  1784. procedure gen_proc_entry_code(list:TAsmList);
  1785. var
  1786. hitemp,
  1787. lotemp : longint;
  1788. begin
  1789. { generate call frame marker for dwarf call frame info }
  1790. current_asmdata.asmcfi.start_frame(list);
  1791. { All temps are know, write offsets used for information }
  1792. if (cs_asm_source in aktglobalswitches) then
  1793. begin
  1794. if tg.direction>0 then
  1795. begin
  1796. lotemp:=current_procinfo.tempstart;
  1797. hitemp:=tg.lasttemp;
  1798. end
  1799. else
  1800. begin
  1801. lotemp:=tg.lasttemp;
  1802. hitemp:=current_procinfo.tempstart;
  1803. end;
  1804. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1805. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1806. end;
  1807. { generate target specific proc entry code }
  1808. cg.g_proc_entry(list,current_procinfo.calc_stackframe_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1809. end;
  1810. procedure gen_proc_exit_code(list:TAsmList);
  1811. var
  1812. parasize : longint;
  1813. begin
  1814. { c style clearstack does not need to remove parameters from the stack, only the
  1815. return value when it was pushed by arguments }
  1816. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1817. begin
  1818. parasize:=0;
  1819. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1820. inc(parasize,sizeof(aint));
  1821. end
  1822. else
  1823. parasize:=current_procinfo.para_stack_size;
  1824. { generate target specific proc exit code }
  1825. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1826. { release return registers, needed for optimizer }
  1827. if not is_void(current_procinfo.procdef.rettype.def) then
  1828. location_free(list,current_procinfo.procdef.funcretloc[calleeside]);
  1829. { end of frame marker for call frame info }
  1830. current_asmdata.asmcfi.end_frame(list);
  1831. end;
  1832. procedure gen_stack_check_size_para(list:TAsmList);
  1833. var
  1834. paraloc1 : tcgpara;
  1835. begin
  1836. paraloc1.init;
  1837. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1838. paramanager.allocparaloc(list,paraloc1);
  1839. cg.a_param_const(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
  1840. paramanager.freeparaloc(list,paraloc1);
  1841. paraloc1.done;
  1842. end;
  1843. procedure gen_stack_check_call(list:TAsmList);
  1844. var
  1845. paraloc1 : tcgpara;
  1846. begin
  1847. paraloc1.init;
  1848. { Also alloc the register needed for the parameter }
  1849. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1850. paramanager.allocparaloc(list,paraloc1);
  1851. paramanager.freeparaloc(list,paraloc1);
  1852. { Call the helper }
  1853. cg.allocallcpuregisters(list);
  1854. cg.a_call_name(list,'FPC_STACKCHECK');
  1855. cg.deallocallcpuregisters(list);
  1856. paraloc1.done;
  1857. end;
  1858. procedure gen_save_used_regs(list:TAsmList);
  1859. begin
  1860. { Pure assembler routines need to save the registers themselves }
  1861. if (po_assembler in current_procinfo.procdef.procoptions) then
  1862. exit;
  1863. { oldfpccall expects all registers to be destroyed }
  1864. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1865. cg.g_save_standard_registers(list);
  1866. end;
  1867. procedure gen_restore_used_regs(list:TAsmList);
  1868. begin
  1869. { Pure assembler routines need to save the registers themselves }
  1870. if (po_assembler in current_procinfo.procdef.procoptions) then
  1871. exit;
  1872. { oldfpccall expects all registers to be destroyed }
  1873. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1874. cg.g_restore_standard_registers(list);
  1875. end;
  1876. procedure gen_got_load(list : TAsmList);
  1877. begin
  1878. { if loading got is necessary for more cpus, it can be moved
  1879. to the cg }
  1880. {$ifdef i386}
  1881. { allocate PIC register }
  1882. if (cs_create_pic in aktmoduleswitches) and
  1883. (tf_pic_uses_got in target_info.flags) and
  1884. (pi_needs_got in current_procinfo.flags) then
  1885. begin
  1886. current_module.requires_ebx_pic_helper:=true;
  1887. cg.a_call_name_static(list,'fpc_geteipasebx');
  1888. list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
  1889. list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
  1890. { ecx could be used in leave procedures }
  1891. current_procinfo.got:=NR_EBX;
  1892. end;
  1893. {$endif i386}
  1894. end;
  1895. {****************************************************************************
  1896. External handling
  1897. ****************************************************************************}
  1898. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  1899. var
  1900. ref : treference;
  1901. sym : tasmsymbol;
  1902. begin
  1903. { add the procedure to the al_procedures }
  1904. maybe_new_object_file(list);
  1905. new_section(list,sec_code,lower(pd.mangledname),aktalignment.procalign);
  1906. list.concat(Tai_align.create(aktalignment.procalign));
  1907. if (po_global in pd.procoptions) then
  1908. list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
  1909. else
  1910. list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
  1911. {$ifdef x86}
  1912. { fix this for other CPUs as well }
  1913. sym:=current_asmdata.RefAsmSymbol(externalname);
  1914. reference_reset_symbol(ref,sym,0);
  1915. { create pic'ed? }
  1916. if cs_create_pic in aktmoduleswitches then
  1917. begin
  1918. { it could be that we're called from a procedure not having the
  1919. got loaded
  1920. }
  1921. gen_got_load(list);
  1922. ref.refaddr:=addr_pic;
  1923. end
  1924. else
  1925. ref.refaddr:=addr_full;
  1926. list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
  1927. {$else x86}
  1928. cg.a_jmp_name(list,externalname);
  1929. {$endif x86}
  1930. end;
  1931. {****************************************************************************
  1932. Const Data
  1933. ****************************************************************************}
  1934. procedure insertbssdata(sym : tglobalvarsym);
  1935. var
  1936. l : aint;
  1937. varalign : shortint;
  1938. storefilepos : tfileposinfo;
  1939. list : TAsmList;
  1940. sectype : TAsmSectiontype;
  1941. begin
  1942. storefilepos:=aktfilepos;
  1943. aktfilepos:=sym.fileinfo;
  1944. l:=sym.getsize;
  1945. if tf_section_threadvars in target_info.flags then
  1946. begin
  1947. if (vo_is_thread_var in sym.varoptions) then
  1948. begin
  1949. list:=current_asmdata.asmlists[al_threadvars];
  1950. sectype:=sec_threadvar;
  1951. end
  1952. else
  1953. begin
  1954. list:=current_asmdata.asmlists[al_globals];
  1955. sectype:=sec_bss;
  1956. end;
  1957. end
  1958. else
  1959. begin
  1960. if (vo_is_thread_var in sym.varoptions) then
  1961. inc(l,sizeof(aint));
  1962. list:=current_asmdata.asmlists[al_globals];
  1963. sectype:=sec_bss;
  1964. end;
  1965. varalign:=var_align(size_2_align(l));
  1966. maybe_new_object_file(list);
  1967. new_section(list,sectype,lower(sym.mangledname),varalign);
  1968. if (sym.owner.symtabletype=globalsymtable) or
  1969. maybe_smartlink_symbol or
  1970. DLLSource or
  1971. (assigned(current_procinfo) and
  1972. (po_inline in current_procinfo.procdef.procoptions)) or
  1973. (vo_is_exported in sym.varoptions) or
  1974. (vo_is_C_var in sym.varoptions) then
  1975. list.concat(Tai_datablock.create_global(sym.mangledname,l))
  1976. else
  1977. list.concat(Tai_datablock.create(sym.mangledname,l));
  1978. aktfilepos:=storefilepos;
  1979. end;
  1980. procedure init_regvar_loc(sym:tabstractnormalvarsym;cgsize:tcgsize);
  1981. begin
  1982. with sym do
  1983. begin
  1984. localloc.size:=cgsize;
  1985. case varregable of
  1986. vr_intreg,
  1987. vr_addr :
  1988. begin
  1989. localloc.loc:=LOC_CREGISTER;
  1990. end;
  1991. vr_fpureg :
  1992. begin
  1993. localloc.loc:=LOC_CFPUREGISTER;
  1994. end;
  1995. vr_mmreg :
  1996. begin
  1997. localloc.loc:=LOC_CMMREGISTER;
  1998. end;
  1999. else
  2000. internalerror(2004101010);
  2001. end;
  2002. end;
  2003. end;
  2004. procedure gen_alloc_symtable(list:TAsmList;st:tsymtable);
  2005. var
  2006. sym : tsym;
  2007. isaddr : boolean;
  2008. cgsize : tcgsize;
  2009. begin
  2010. sym:=tsym(st.symindex.first);
  2011. while assigned(sym) do
  2012. begin
  2013. if (sym.typ in [globalvarsym,localvarsym,paravarsym]) then
  2014. begin
  2015. with tabstractnormalvarsym(sym) do
  2016. begin
  2017. { Parameters passed to assembler procedures need to be kept
  2018. in the original location }
  2019. if (sym.typ=paravarsym) and
  2020. (po_assembler in current_procinfo.procdef.procoptions) then
  2021. begin
  2022. tparavarsym(sym).paraloc[calleeside].get_location(localloc);
  2023. end
  2024. else
  2025. begin
  2026. isaddr:=(st.symtabletype=parasymtable) and
  2027. paramanager.push_addr_param(varspez,vartype.def,current_procinfo.procdef.proccalloption);
  2028. if isaddr then
  2029. cgsize:=OS_ADDR
  2030. else
  2031. cgsize:=def_cgsize(vartype.def);
  2032. {$ifndef OLDREGVARS}
  2033. { When there is assembler code we can't use regvars }
  2034. if is_regvar(isaddr) then
  2035. begin
  2036. init_regvar_loc(tabstractnormalvarsym(sym),cgsize);
  2037. if (st.symtabletype <> parasymtable) then
  2038. gen_alloc_regvar(list,tabstractnormalvarsym(sym));
  2039. end
  2040. else
  2041. {$endif NOT OLDREGVARS}
  2042. begin
  2043. localloc.loc:=LOC_REFERENCE;
  2044. localloc.size:=cgsize;
  2045. case st.symtabletype of
  2046. parasymtable :
  2047. begin
  2048. { Reuse the parameter location for values to are at a single location on the stack }
  2049. if paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then
  2050. begin
  2051. reference_reset_base(localloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
  2052. tparavarsym(sym).paraloc[calleeside].location^.reference.offset);
  2053. end
  2054. else
  2055. begin
  2056. if isaddr then
  2057. tg.GetLocal(list,sizeof(aint),voidpointertype.def,localloc.reference)
  2058. else
  2059. tg.GetLocal(list,getsize,tparavarsym(sym).paraloc[calleeside].alignment,vartype.def,localloc.reference);
  2060. end;
  2061. end;
  2062. localsymtable,
  2063. stt_exceptsymtable :
  2064. begin
  2065. tg.GetLocal(list,getsize,vartype.def,localloc.reference);
  2066. end;
  2067. staticsymtable :
  2068. begin
  2069. { PIC, DLL and Threadvar need extra code and are handled in ncgld }
  2070. if not(vo_is_dll_var in varoptions) and ((tf_section_threadvars in target_info.flags) or
  2071. not(vo_is_thread_var in varoptions)) then
  2072. reference_reset_symbol(localloc.reference,current_asmdata.RefAsmSymbol(mangledname),0);
  2073. end;
  2074. else
  2075. internalerror(200410103);
  2076. end;
  2077. end;
  2078. end;
  2079. if cs_asm_source in aktglobalswitches then
  2080. begin
  2081. case localloc.loc of
  2082. LOC_REFERENCE :
  2083. begin
  2084. if not assigned(localloc.reference.symbol) then
  2085. list.concat(Tai_comment.Create(strpnew('Var '+realname+' located at '+
  2086. std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
  2087. end;
  2088. end;
  2089. end;
  2090. end;
  2091. end;
  2092. sym:=tsym(sym.indexnext);
  2093. end;
  2094. end;
  2095. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  2096. begin
  2097. case location.loc of
  2098. LOC_CREGISTER:
  2099. {$ifndef cpu64bit}
  2100. if location.size in [OS_64,OS_S64] then
  2101. begin
  2102. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  2103. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  2104. end
  2105. else
  2106. {$endif cpu64bit}
  2107. rv.intregvars.addnodup(getsupreg(location.register));
  2108. LOC_CFPUREGISTER:
  2109. rv.fpuregvars.addnodup(getsupreg(location.register));
  2110. LOC_CMMREGISTER:
  2111. rv.mmregvars.addnodup(getsupreg(location.register));
  2112. end;
  2113. end;
  2114. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  2115. var
  2116. rv: pusedregvars absolute arg;
  2117. begin
  2118. case (n.nodetype) of
  2119. temprefn:
  2120. { We only have to synchronise a tempnode before a loop if it is }
  2121. { not created inside the loop, and only synchronise after the }
  2122. { loop if it's not destroyed inside the loop. If it's created }
  2123. { before the loop and not yet destroyed, then before the loop }
  2124. { is secondpassed tempinfo^.valid will be true, and we get the }
  2125. { correct registers. If it's not destroyed inside the loop, }
  2126. { then after the loop has been secondpassed tempinfo^.valid }
  2127. { be true and we also get the right registers. In other cases, }
  2128. { tempinfo^.valid will be false and so we do not add }
  2129. { unnecessary registers. This way, we don't have to look at }
  2130. { tempcreate and tempdestroy nodes to get this info (JM) }
  2131. if (ttemprefnode(n).tempinfo^.valid) then
  2132. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  2133. loadn:
  2134. if (tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
  2135. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  2136. vecn:
  2137. { range checks sometimes need the high parameter }
  2138. if (cs_check_range in aktlocalswitches) and
  2139. (is_open_array(tvecnode(n).left.resulttype.def) or
  2140. is_array_of_const(tvecnode(n).left.resulttype.def)) and
  2141. not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  2142. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  2143. end;
  2144. result := fen_true;
  2145. end;
  2146. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  2147. begin
  2148. foreachnodestatic(n,@do_get_used_regvars,@rv);
  2149. end;
  2150. (*
  2151. See comments at declaration of pusedregvarscommon
  2152. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  2153. var
  2154. rv: pusedregvarscommon absolute arg;
  2155. begin
  2156. if (n.nodetype = loadn) and
  2157. (tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
  2158. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  2159. case loc of
  2160. LOC_CREGISTER:
  2161. { if not yet encountered in this node tree }
  2162. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2163. { but nevertheless already encountered somewhere }
  2164. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2165. { then it's a regvar used in two or more node trees }
  2166. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2167. LOC_CFPUREGISTER:
  2168. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2169. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2170. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2171. LOC_CMMREGISTER:
  2172. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2173. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2174. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2175. end;
  2176. result := fen_true;
  2177. end;
  2178. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  2179. begin
  2180. rv.myregvars.intregvars.clear;
  2181. rv.myregvars.fpuregvars.clear;
  2182. rv.myregvars.mmregvars.clear;
  2183. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  2184. end;
  2185. *)
  2186. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  2187. var
  2188. count: longint;
  2189. begin
  2190. for count := 1 to rv.intregvars.length do
  2191. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  2192. for count := 1 to rv.fpuregvars.length do
  2193. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  2194. for count := 1 to rv.mmregvars.length do
  2195. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  2196. end;
  2197. {*****************************************************************************
  2198. SSA support
  2199. *****************************************************************************}
  2200. type
  2201. preplaceregrec = ^treplaceregrec;
  2202. treplaceregrec = record
  2203. old, new: tregister;
  2204. {$ifndef cpu64bit}
  2205. oldhi, newhi: tregister;
  2206. {$endif cpu64bit}
  2207. ressym: tsym;
  2208. end;
  2209. function doreplace(var n: tnode; para: pointer): foreachnoderesult;
  2210. var
  2211. rr: preplaceregrec absolute para;
  2212. begin
  2213. result := fen_false;
  2214. case n.nodetype of
  2215. loadn:
  2216. begin
  2217. if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  2218. not assigned(tloadnode(n).left) and
  2219. (((tloadnode(n).symtableentry <> rr^.ressym) and
  2220. not(vo_is_funcret in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) or
  2221. not(fc_exit in flowcontrol)) and
  2222. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2223. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  2224. begin
  2225. {$ifndef cpu64bit}
  2226. { it's possible a 64 bit location was shifted and/xor typecasted }
  2227. { in a 32 bit value, so only 1 register was left in the location }
  2228. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  2229. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  2230. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  2231. else
  2232. exit;
  2233. {$endif cpu64bit}
  2234. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  2235. result := fen_norecurse_true;
  2236. end;
  2237. end;
  2238. temprefn:
  2239. begin
  2240. if (ttemprefnode(n).tempinfo^.valid) and
  2241. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2242. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  2243. begin
  2244. {$ifndef cpu64bit}
  2245. { it's possible a 64 bit location was shifted and/xor typecasted }
  2246. { in a 32 bit value, so only 1 register was left in the location }
  2247. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  2248. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  2249. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  2250. else
  2251. exit;
  2252. {$endif cpu64bit}
  2253. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  2254. result := fen_norecurse_true;
  2255. end;
  2256. end;
  2257. end;
  2258. end;
  2259. procedure maybechangeloadnodereg(var n: tnode);
  2260. var
  2261. rr: treplaceregrec;
  2262. begin
  2263. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  2264. ([fc_inflowcontrol,fc_gotolabel] * flowcontrol <> []) then
  2265. exit;
  2266. rr.old := n.location.register;
  2267. rr.ressym := nil;
  2268. {$ifndef cpu64bit}
  2269. rr.oldhi := NR_NO;
  2270. {$endif cpu64bit}
  2271. case n.location.loc of
  2272. LOC_CREGISTER:
  2273. begin
  2274. {$ifndef cpu64bit}
  2275. if (n.location.size in [OS_64,OS_S64]) then
  2276. begin
  2277. rr.oldhi := n.location.register64.reghi;
  2278. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2279. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2280. end
  2281. else
  2282. {$endif cpu64bit}
  2283. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  2284. end;
  2285. LOC_CFPUREGISTER:
  2286. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  2287. {$ifdef SUPPORT_MMX}
  2288. LOC_CMMXREGISTER:
  2289. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  2290. {$endif SUPPORT_MMX}
  2291. LOC_CMMREGISTER:
  2292. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  2293. else
  2294. exit;
  2295. end;
  2296. if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
  2297. assigned(current_procinfo.procdef.funcretsym) and
  2298. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  2299. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  2300. rr.ressym:=tsym(current_procinfo.procdef.parast.search('self'))
  2301. else
  2302. rr.ressym:=current_procinfo.procdef.funcretsym;
  2303. if not foreachnodestatic(n,@doreplace,@rr) then
  2304. exit;
  2305. { now that we've change the loadn/temp, also change the node result location }
  2306. {$ifndef cpu64bit}
  2307. if (n.location.size in [OS_64,OS_S64]) then
  2308. begin
  2309. n.location.register64.reglo := rr.new;
  2310. n.location.register64.reghi := rr.newhi;
  2311. end
  2312. else
  2313. {$endif cpu64bit}
  2314. n.location.register := rr.new;
  2315. end;
  2316. procedure gen_free_symtable(list:TAsmList;st:tsymtable);
  2317. var
  2318. sym : tsym;
  2319. begin
  2320. sym:=tsym(st.symindex.first);
  2321. while assigned(sym) do
  2322. begin
  2323. if (sym.typ in [globalvarsym,localvarsym,paravarsym]) then
  2324. begin
  2325. with tabstractnormalvarsym(sym) do
  2326. begin
  2327. { Note: We need to keep the data available in memory
  2328. for the sub procedures that can access local data
  2329. in the parent procedures }
  2330. case localloc.loc of
  2331. LOC_CREGISTER :
  2332. {$ifndef cpu64bit}
  2333. if (pi_has_goto in current_procinfo.flags) then
  2334. if def_cgsize(vartype.def) in [OS_64,OS_S64] then
  2335. begin
  2336. cg.a_reg_sync(list,localloc.register64.reglo);
  2337. cg.a_reg_sync(list,localloc.register64.reghi);
  2338. end
  2339. else
  2340. {$endif cpu64bit}
  2341. cg.a_reg_sync(list,localloc.register);
  2342. LOC_CFPUREGISTER,
  2343. LOC_CMMREGISTER:
  2344. if (pi_has_goto in current_procinfo.flags) then
  2345. cg.a_reg_sync(list,localloc.register);
  2346. LOC_REFERENCE :
  2347. begin
  2348. case st.symtabletype of
  2349. localsymtable,
  2350. parasymtable,
  2351. stt_exceptsymtable :
  2352. tg.Ungetlocal(list,localloc.reference);
  2353. end;
  2354. end;
  2355. end;
  2356. end;
  2357. end;
  2358. sym:=tsym(sym.indexnext);
  2359. end;
  2360. end;
  2361. { persistent rtti generation }
  2362. procedure generate_rtti(p:Ttypesym);
  2363. var
  2364. rsym : trttisym;
  2365. def : tstoreddef;
  2366. begin
  2367. { rtti can only be generated for classes that are always typesyms }
  2368. def:=tstoreddef(ttypesym(p).restype.def);
  2369. { there is an error, skip rtti info }
  2370. if (def.deftype=errordef) or (Errorcount>0) then
  2371. exit;
  2372. { only create rtti once for each definition }
  2373. if not(df_has_rttitable in def.defoptions) then
  2374. begin
  2375. { definition should be in the same symtable as the symbol }
  2376. if p.owner<>def.owner then
  2377. internalerror(200108262);
  2378. { create rttisym }
  2379. rsym:=trttisym.create(p.name,fullrtti);
  2380. p.owner.insert(rsym);
  2381. { register rttisym in definition }
  2382. include(def.defoptions,df_has_rttitable);
  2383. def.rttitablesym:=rsym;
  2384. { write rtti data }
  2385. def.write_child_rtti_data(fullrtti);
  2386. maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
  2387. new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  2388. current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0));
  2389. def.write_rtti_data(fullrtti);
  2390. current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label));
  2391. end;
  2392. end;
  2393. { persistent init table generation }
  2394. procedure generate_inittable(p:tsym);
  2395. var
  2396. rsym : trttisym;
  2397. def : tstoreddef;
  2398. begin
  2399. { anonymous types are also allowed for records that can be varsym }
  2400. case p.typ of
  2401. typesym :
  2402. def:=tstoreddef(ttypesym(p).restype.def);
  2403. globalvarsym,
  2404. localvarsym,
  2405. paravarsym :
  2406. def:=tstoreddef(tabstractvarsym(p).vartype.def);
  2407. else
  2408. internalerror(200108263);
  2409. end;
  2410. { only create inittable once for each definition }
  2411. if not(df_has_inittable in def.defoptions) then
  2412. begin
  2413. { definition should be in the same symtable as the symbol }
  2414. if p.owner<>def.owner then
  2415. internalerror(200108264);
  2416. { create rttisym }
  2417. rsym:=trttisym.create(p.name,initrtti);
  2418. p.owner.insert(rsym);
  2419. { register rttisym in definition }
  2420. include(def.defoptions,df_has_inittable);
  2421. def.inittablesym:=rsym;
  2422. { write inittable data }
  2423. def.write_child_rtti_data(initrtti);
  2424. maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
  2425. new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  2426. current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0));
  2427. def.write_rtti_data(initrtti);
  2428. current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label));
  2429. end;
  2430. end;
  2431. procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef);
  2432. var
  2433. i,j,
  2434. proccount : longint;
  2435. tmps : string;
  2436. begin
  2437. for i:=1 to _class.implementedinterfaces.count do
  2438. begin
  2439. { only if implemented by this class }
  2440. if _class.implementedinterfaces.implindex(i)=i then
  2441. begin
  2442. proccount:=_class.implementedinterfaces.implproccount(i);
  2443. for j:=1 to proccount do
  2444. begin
  2445. tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
  2446. _class.implementedinterfaces.interfaces(i).objname^+'_$_'+
  2447. tostr(j)+'_$_'+_class.implementedinterfaces.implprocs(i,j).mangledname);
  2448. { create wrapper code }
  2449. new_section(list,sec_code,lower(tmps),0);
  2450. cg.init_register_allocators;
  2451. cg.g_intf_wrapper(list,_class.implementedinterfaces.implprocs(i,j),tmps,_class.implementedinterfaces.ioffsets(i));
  2452. cg.done_register_allocators;
  2453. end;
  2454. end;
  2455. end;
  2456. end;
  2457. procedure gen_intf_wrappers(list:TAsmList;st:tsymtable);
  2458. var
  2459. def : tstoreddef;
  2460. begin
  2461. def:=tstoreddef(st.defindex.first);
  2462. while assigned(def) do
  2463. begin
  2464. if is_class(def) then
  2465. gen_intf_wrapper(list,tobjectdef(def));
  2466. def:=tstoreddef(def.indexnext);
  2467. end;
  2468. end;
  2469. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  2470. var
  2471. href : treference;
  2472. begin
  2473. if is_object(objdef) then
  2474. begin
  2475. case selfloc.loc of
  2476. LOC_CREFERENCE,
  2477. LOC_REFERENCE:
  2478. begin
  2479. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2480. cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
  2481. end;
  2482. else
  2483. internalerror(200305056);
  2484. end;
  2485. end
  2486. else
  2487. begin
  2488. case selfloc.loc of
  2489. LOC_REGISTER:
  2490. begin
  2491. {$ifdef cpu_uses_separate_address_registers}
  2492. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  2493. begin
  2494. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2495. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base);
  2496. end
  2497. else
  2498. {$endif cpu_uses_separate_address_registers}
  2499. reference_reset_base(href,selfloc.register,objdef.vmt_offset);
  2500. end;
  2501. LOC_CREGISTER,
  2502. LOC_CREFERENCE,
  2503. LOC_REFERENCE:
  2504. begin
  2505. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2506. cg.a_load_loc_reg(list,OS_ADDR,selfloc,href.base);
  2507. end;
  2508. else
  2509. internalerror(200305057);
  2510. end;
  2511. end;
  2512. vmtreg:=cg.getaddressregister(list);
  2513. cg.g_maybe_testself(list,href.base);
  2514. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
  2515. { test validity of VMT }
  2516. if not(is_interface(objdef)) and
  2517. not(is_cppclass(objdef)) then
  2518. cg.g_maybe_testvmt(list,vmtreg,objdef);
  2519. end;
  2520. function getprocalign : shortint;
  2521. begin
  2522. { gprof uses 16 byte granularity }
  2523. if (cs_profile in aktmoduleswitches) then
  2524. result:=16
  2525. else
  2526. result:=aktalignment.procalign;
  2527. end;
  2528. procedure gen_pic_helpers(list : TAsmList);
  2529. var
  2530. href : treference;
  2531. begin
  2532. { if other cpus require such helpers as well, it can be solved more cleaner }
  2533. {$ifdef i386}
  2534. if current_module.requires_ebx_pic_helper then
  2535. begin
  2536. new_section(list,sec_code,'fpc_geteipasebx',0);
  2537. list.concat(tai_symbol.Createname('fpc_geteipasebx',AT_FUNCTION,getprocalign));
  2538. reference_reset(href);
  2539. href.base:=NR_ESP;
  2540. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_EBX));
  2541. list.concat(taicpu.op_none(A_RET,S_NO));
  2542. end;
  2543. if current_module.requires_ecx_pic_helper then
  2544. begin
  2545. new_section(list,sec_code,'fpc_geteipasecx',0);
  2546. list.concat(tai_symbol.Createname('fpc_geteipasecx',AT_FUNCTION,getprocalign));
  2547. reference_reset(href);
  2548. href.base:=NR_ESP;
  2549. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_ECX));
  2550. list.concat(taicpu.op_none(A_RET,S_NO));
  2551. end;
  2552. {$endif i386}
  2553. end;
  2554. end.