ncgutil.pas 114 KB

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