ncgutil.pas 127 KB

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