ncgutil.pas 123 KB

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