ncgutil.pas 127 KB

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