ncgutil.pas 117 KB

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