ncgutil.pas 124 KB

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