ncgutil.pas 127 KB

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