ncgutil.pas 116 KB

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