ncgutil.pas 125 KB

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