ncgutil.pas 84 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Helper routines for all code generators
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ncgutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,cpuinfo,
  23. globtype,
  24. cpubase,cgbase,
  25. aasmbase,aasmtai,aasmcpu,
  26. symconst,symbase,symdef,symsym,symtype,symtable
  27. {$ifndef cpu64bit}
  28. ,cg64f32
  29. {$endif cpu64bit}
  30. ;
  31. type
  32. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  33. procedure firstcomplex(p : tbinarynode);
  34. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  35. // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  36. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  37. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  38. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  39. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  40. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  41. procedure gen_proc_symbol(list:Taasmoutput);
  42. procedure gen_proc_symbol_end(list:Taasmoutput);
  43. procedure gen_proc_entry_code(list:Taasmoutput);
  44. procedure gen_proc_exit_code(list:Taasmoutput);
  45. procedure gen_save_used_regs(list:TAAsmoutput);
  46. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
  47. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  48. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  49. procedure gen_entry_code(list:TAAsmoutput);
  50. procedure gen_exit_code(list:TAAsmoutput);
  51. procedure gen_load_para_value(list:TAAsmoutput);
  52. procedure gen_load_return_value(list:TAAsmoutput);
  53. (*
  54. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  55. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  56. *)
  57. {#
  58. Allocate the buffers for exception management and setjmp environment.
  59. Return a pointer to these buffers, send them to the utility routine
  60. so they are registered, and then call setjmp.
  61. Then compare the result of setjmp with 0, and if not equal
  62. to zero, then jump to exceptlabel.
  63. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  64. It is to note that this routine may be called *after* the stackframe of a
  65. routine has been called, therefore on machines where the stack cannot
  66. be modified, all temps should be allocated on the heap instead of the
  67. stack.
  68. }
  69. const
  70. EXCEPT_BUF_SIZE = 3*sizeof(aint);
  71. type
  72. texceptiontemps=record
  73. jmpbuf,
  74. envbuf,
  75. reasonbuf : treference;
  76. end;
  77. procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
  78. procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
  79. procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
  80. procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  81. procedure insertconstdata(sym : ttypedconstsym);
  82. procedure insertbssdata(sym : tvarsym);
  83. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  84. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  85. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  86. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  87. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  88. { rtti and init/final }
  89. procedure generate_rtti(p:Ttypesym);
  90. procedure generate_inittable(p:tsym);
  91. implementation
  92. uses
  93. {$ifdef Delphi}
  94. Sysutils,
  95. {$else}
  96. strings,
  97. {$endif}
  98. cutils,cclasses,
  99. globals,systems,verbose,
  100. ppu,defutil,
  101. procinfo,paramgr,fmodule,
  102. regvars,dwarf,
  103. {$ifdef GDB}
  104. gdb,
  105. {$endif GDB}
  106. pass_1,pass_2,
  107. ncon,nld,nutils,
  108. tgobj,cgutils,cgobj;
  109. {*****************************************************************************
  110. Misc Helpers
  111. *****************************************************************************}
  112. { DO NOT RELY on the fact that the tnode is not yet swaped
  113. because of inlining code PM }
  114. procedure firstcomplex(p : tbinarynode);
  115. var
  116. hp : tnode;
  117. begin
  118. { always calculate boolean AND and OR from left to right }
  119. if (p.nodetype in [orn,andn]) and
  120. is_boolean(p.left.resulttype.def) then
  121. begin
  122. if nf_swaped in p.flags then
  123. internalerror(234234);
  124. end
  125. else
  126. if (
  127. (p.location.loc=LOC_FPUREGISTER) and
  128. (p.right.registersfpu > p.left.registersfpu)
  129. ) or
  130. (
  131. (
  132. (
  133. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  134. (p.location.loc<>LOC_FPUREGISTER)
  135. ) and
  136. (p.left.registersint<p.right.registersint)
  137. )
  138. ) then
  139. begin
  140. hp:=p.left;
  141. p.left:=p.right;
  142. p.right:=hp;
  143. if nf_swaped in p.flags then
  144. exclude(p.flags,nf_swaped)
  145. else
  146. include(p.flags,nf_swaped);
  147. end;
  148. end;
  149. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  150. {
  151. produces jumps to true respectively false labels using boolean expressions
  152. depending on whether the loading of regvars is currently being
  153. synchronized manually (such as in an if-node) or automatically (most of
  154. the other cases where this procedure is called), loadregvars can be
  155. "lr_load_regvars" or "lr_dont_load_regvars"
  156. }
  157. var
  158. opsize : tcgsize;
  159. storepos : tfileposinfo;
  160. begin
  161. if nf_error in p.flags then
  162. exit;
  163. storepos:=aktfilepos;
  164. aktfilepos:=p.fileinfo;
  165. if is_boolean(p.resulttype.def) then
  166. begin
  167. {$ifdef OLDREGVARS}
  168. if loadregvars = lr_load_regvars then
  169. load_all_regvars(list);
  170. {$endif OLDREGVARS}
  171. if is_constboolnode(p) then
  172. begin
  173. if tordconstnode(p).value<>0 then
  174. cg.a_jmp_always(list,truelabel)
  175. else
  176. cg.a_jmp_always(list,falselabel)
  177. end
  178. else
  179. begin
  180. opsize:=def_cgsize(p.resulttype.def);
  181. case p.location.loc of
  182. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  183. begin
  184. {$ifdef OLDREGVARS}
  185. if (p.location.loc = LOC_CREGISTER) then
  186. load_regvar_reg(list,p.location.register);
  187. {$endif OLDREGVARS}
  188. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  189. 0,p.location,truelabel);
  190. { !!! should happen right after cmp (JM) }
  191. location_release(list,p.location);
  192. cg.a_jmp_always(list,falselabel);
  193. end;
  194. LOC_JUMP:
  195. ;
  196. {$ifdef cpuflags}
  197. LOC_FLAGS :
  198. begin
  199. cg.a_jmp_flags(list,p.location.resflags,
  200. truelabel);
  201. cg.a_jmp_always(list,falselabel);
  202. end;
  203. {$endif cpuflags}
  204. else
  205. begin
  206. printnode(output,p);
  207. internalerror(200308241);
  208. end;
  209. end;
  210. end;
  211. end
  212. else
  213. internalerror(200112305);
  214. aktfilepos:=storepos;
  215. end;
  216. (*
  217. This code needs fixing. It is not safe to use rgint; on the m68000 it
  218. would be rgaddr.
  219. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  220. begin
  221. case t.loc of
  222. LOC_REGISTER:
  223. begin
  224. { can't be a regvar, since it would be LOC_CREGISTER then }
  225. exclude(regs,getsupreg(t.register));
  226. if t.registerhigh<>NR_NO then
  227. exclude(regs,getsupreg(t.registerhigh));
  228. end;
  229. LOC_CREFERENCE,LOC_REFERENCE:
  230. begin
  231. if not(cs_regvars in aktglobalswitches) or
  232. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  233. exclude(regs,getsupreg(t.reference.base));
  234. if not(cs_regvars in aktglobalswitches) or
  235. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  236. exclude(regs,getsupreg(t.reference.index));
  237. end;
  238. end;
  239. end;
  240. *)
  241. {*****************************************************************************
  242. EXCEPTION MANAGEMENT
  243. *****************************************************************************}
  244. procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
  245. begin
  246. tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
  247. tg.GetTemp(list,JMP_BUF_SIZE,tt_persistent,t.jmpbuf);
  248. tg.GetTemp(list,sizeof(aint),tt_persistent,t.reasonbuf);
  249. end;
  250. procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
  251. begin
  252. tg.Ungettemp(list,t.jmpbuf);
  253. tg.ungettemp(list,t.envbuf);
  254. tg.ungettemp(list,t.reasonbuf);
  255. end;
  256. procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
  257. var
  258. paraloc1,paraloc2,paraloc3 : tparalocation;
  259. begin
  260. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  261. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  262. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  263. paramanager.allocparaloc(list,paraloc3);
  264. cg.a_paramaddr_ref(list,t.envbuf,paraloc3);
  265. paramanager.allocparaloc(list,paraloc2);
  266. cg.a_paramaddr_ref(list,t.jmpbuf,paraloc2);
  267. { push type of exceptionframe }
  268. paramanager.allocparaloc(list,paraloc1);
  269. cg.a_param_const(list,OS_S32,1,paraloc1);
  270. paramanager.freeparaloc(list,paraloc3);
  271. paramanager.freeparaloc(list,paraloc2);
  272. paramanager.freeparaloc(list,paraloc1);
  273. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  274. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  275. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  276. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  277. paramanager.allocparaloc(list,paraloc1);
  278. cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
  279. paramanager.freeparaloc(list,paraloc1);
  280. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  281. cg.a_call_name(list,'FPC_SETJMP');
  282. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  283. cg.g_exception_reason_save(list, t.reasonbuf);
  284. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
  285. end;
  286. procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  287. begin
  288. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  289. cg.a_call_name(list,'FPC_POPADDRSTACK');
  290. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  291. if not onlyfree then
  292. begin
  293. cg.g_exception_reason_load(list, t.reasonbuf);
  294. cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
  295. end;
  296. end;
  297. {*****************************************************************************
  298. TLocation
  299. *****************************************************************************}
  300. {$ifndef cpu64bit}
  301. { 32-bit version }
  302. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  303. var
  304. hregister,
  305. hregisterhi : tregister;
  306. hreg64 : tregister64;
  307. hl : tasmlabel;
  308. oldloc : tlocation;
  309. const_location: boolean;
  310. begin
  311. oldloc:=l;
  312. if dst_size=OS_NO then
  313. internalerror(200309144);
  314. { handle transformations to 64bit separate }
  315. if dst_size in [OS_64,OS_S64] then
  316. begin
  317. if not (l.size in [OS_64,OS_S64]) then
  318. begin
  319. { load a smaller size to OS_64 }
  320. if l.loc=LOC_REGISTER then
  321. begin
  322. hregister:=cg.makeregsize(list,l.registerlow,OS_32);
  323. cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
  324. end
  325. else
  326. begin
  327. location_release(list,l);
  328. hregister:=cg.getintregister(list,OS_INT);
  329. end;
  330. { load value in low register }
  331. case l.loc of
  332. LOC_FLAGS :
  333. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  334. LOC_JUMP :
  335. begin
  336. cg.a_label(list,truelabel);
  337. cg.a_load_const_reg(list,OS_INT,1,hregister);
  338. objectlibrary.getlabel(hl);
  339. cg.a_jmp_always(list,hl);
  340. cg.a_label(list,falselabel);
  341. cg.a_load_const_reg(list,OS_INT,0,hregister);
  342. cg.a_label(list,hl);
  343. end;
  344. else
  345. cg.a_load_loc_reg(list,OS_INT,l,hregister);
  346. end;
  347. { reset hi part, take care of the signed bit of the current value }
  348. hregisterhi:=cg.getintregister(list,OS_INT);
  349. if (l.size in [OS_S8,OS_S16,OS_S32]) then
  350. begin
  351. if l.loc=LOC_CONSTANT then
  352. begin
  353. if (longint(l.value)<0) then
  354. cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi)
  355. else
  356. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  357. end
  358. else
  359. begin
  360. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  361. hregisterhi);
  362. end;
  363. end
  364. else
  365. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  366. location_reset(l,LOC_REGISTER,dst_size);
  367. l.registerlow:=hregister;
  368. l.registerhigh:=hregisterhi;
  369. end
  370. else
  371. begin
  372. { 64bit to 64bit }
  373. if (l.loc=LOC_REGISTER) or
  374. ((l.loc=LOC_CREGISTER) and maybeconst) then
  375. begin
  376. hregister:=l.registerlow;
  377. hregisterhi:=l.registerhigh;
  378. end
  379. else
  380. begin
  381. hregister:=cg.getintregister(list,OS_INT);
  382. hregisterhi:=cg.getintregister(list,OS_INT);
  383. location_release(list,l);
  384. end;
  385. hreg64.reglo:=hregister;
  386. hreg64.reghi:=hregisterhi;
  387. { load value in new register }
  388. cg64.a_load64_loc_reg(list,l,hreg64);
  389. location_reset(l,LOC_REGISTER,dst_size);
  390. l.registerlow:=hregister;
  391. l.registerhigh:=hregisterhi;
  392. end;
  393. end
  394. else
  395. begin
  396. {Do not bother to recycle the existing register. The register
  397. allocator eliminates unnecessary moves, so it's not needed
  398. and trying to recycle registers can cause problems because
  399. the registers changes size and may need aditional constraints.
  400. Not if it's about LOC_CREGISTER's (JM)
  401. }
  402. const_location :=
  403. (maybeconst) and
  404. (l.loc = LOC_CREGISTER) and
  405. (TCGSize2Size[l.size] = TCGSize2Size[dst_size]) and
  406. ((l.size = dst_size) or
  407. (TCGSize2Size[l.size] = TCGSize2Size[OS_INT]));
  408. if not const_location then
  409. begin
  410. location_release(list,l);
  411. hregister:=cg.getintregister(list,dst_size)
  412. end
  413. else
  414. hregister := l.register;
  415. { load value in new register }
  416. case l.loc of
  417. LOC_FLAGS :
  418. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  419. LOC_JUMP :
  420. begin
  421. cg.a_label(list,truelabel);
  422. cg.a_load_const_reg(list,dst_size,1,hregister);
  423. objectlibrary.getlabel(hl);
  424. cg.a_jmp_always(list,hl);
  425. cg.a_label(list,falselabel);
  426. cg.a_load_const_reg(list,dst_size,0,hregister);
  427. cg.a_label(list,hl);
  428. end;
  429. else
  430. begin
  431. { load_loc_reg can only handle size >= l.size, when the
  432. new size is smaller then we need to adjust the size
  433. of the orignal and maybe recalculate l.register for i386 }
  434. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  435. begin
  436. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  437. l.register:=cg.makeregsize(list,l.register,dst_size);
  438. { for big endian systems, the reference's offset must }
  439. { be increased in this case, since they have the }
  440. { MSB first in memory and e.g. byte(word_var) should }
  441. { return the second byte in this case (JM) }
  442. if (target_info.endian = ENDIAN_BIG) and
  443. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  444. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  445. {$ifdef x86}
  446. l.size:=dst_size;
  447. {$endif x86}
  448. end;
  449. cg.a_load_loc_reg(list,dst_size,l,hregister);
  450. {$ifndef x86}
  451. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  452. l.size:=dst_size;
  453. {$endif not x86}
  454. end;
  455. end;
  456. if not const_location then
  457. location_reset(l,LOC_REGISTER,dst_size)
  458. else
  459. location_reset(l,LOC_CREGISTER,dst_size);
  460. l.register:=hregister;
  461. end;
  462. { Release temp when it was a reference }
  463. if oldloc.loc=LOC_REFERENCE then
  464. location_freetemp(list,oldloc);
  465. end;
  466. {$else cpu64bit}
  467. { 64-bit version }
  468. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  469. var
  470. hregister : tregister;
  471. hl : tasmlabel;
  472. oldloc : tlocation;
  473. begin
  474. oldloc:=l;
  475. {Do not bother to recycle the existing register. The register
  476. allocator eliminates unnecessary moves, so it's not needed
  477. and trying to recycle registers can cause problems because
  478. the registers changes size and may need aditional constraints.}
  479. location_release(list,l);
  480. hregister:=cg.getintregister(list,dst_size);
  481. { load value in new register }
  482. case l.loc of
  483. LOC_FLAGS :
  484. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  485. LOC_JUMP :
  486. begin
  487. cg.a_label(list,truelabel);
  488. cg.a_load_const_reg(list,dst_size,1,hregister);
  489. objectlibrary.getlabel(hl);
  490. cg.a_jmp_always(list,hl);
  491. cg.a_label(list,falselabel);
  492. cg.a_load_const_reg(list,dst_size,0,hregister);
  493. cg.a_label(list,hl);
  494. end;
  495. else
  496. begin
  497. { load_loc_reg can only handle size >= l.size, when the
  498. new size is smaller then we need to adjust the size
  499. of the orignal and maybe recalculate l.register for i386 }
  500. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  501. begin
  502. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  503. l.register:=cg.makeregsize(list,l.register,dst_size);
  504. { for big endian systems, the reference's offset must }
  505. { be increased in this case, since they have the }
  506. { MSB first in memory and e.g. byte(word_var) should }
  507. { return the second byte in this case (JM) }
  508. if (target_info.endian = ENDIAN_BIG) and
  509. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  510. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  511. {$ifdef x86}
  512. l.size:=dst_size;
  513. {$endif x86}
  514. end;
  515. cg.a_load_loc_reg(list,dst_size,l,hregister);
  516. {$ifndef x86}
  517. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  518. l.size:=dst_size;
  519. {$endif not x86}
  520. end;
  521. end;
  522. if (l.loc <> LOC_CREGISTER) or
  523. not maybeconst then
  524. location_reset(l,LOC_REGISTER,dst_size)
  525. else
  526. location_reset(l,LOC_CREGISTER,dst_size);
  527. l.register:=hregister;
  528. { Release temp when it was a reference }
  529. if oldloc.loc=LOC_REFERENCE then
  530. location_freetemp(list,oldloc);
  531. end;
  532. {$endif cpu64bit}
  533. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  534. var
  535. reg : tregister;
  536. href : treference;
  537. begin
  538. if (l.loc<>LOC_FPUREGISTER) and
  539. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  540. begin
  541. { if it's in an mm register, store to memory first }
  542. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  543. begin
  544. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  545. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
  546. location_release(list,l);
  547. location_reset(l,LOC_REFERENCE,l.size);
  548. l.reference:=href;
  549. end;
  550. reg:=cg.getfpuregister(list,l.size);
  551. cg.a_loadfpu_loc_reg(list,l,reg);
  552. location_freetemp(list,l);
  553. location_release(list,l);
  554. location_reset(l,LOC_FPUREGISTER,l.size);
  555. l.register:=reg;
  556. end;
  557. end;
  558. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  559. var
  560. reg : tregister;
  561. href : treference;
  562. begin
  563. if (l.loc<>LOC_MMREGISTER) and
  564. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  565. begin
  566. { if it's in an fpu register, store to memory first }
  567. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  568. begin
  569. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  570. cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
  571. location_release(list,l);
  572. location_reset(l,LOC_REFERENCE,l.size);
  573. l.reference:=href;
  574. end;
  575. reg:=cg.getmmregister(list,l.size);
  576. cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
  577. location_freetemp(list,l);
  578. location_release(list,l);
  579. location_reset(l,LOC_MMREGISTER,l.size);
  580. l.register:=reg;
  581. end;
  582. end;
  583. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  584. var
  585. r : treference;
  586. begin
  587. case l.loc of
  588. LOC_FPUREGISTER,
  589. LOC_CFPUREGISTER :
  590. begin
  591. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  592. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  593. location_release(list,l);
  594. location_reset(l,LOC_REFERENCE,l.size);
  595. l.reference:=r;
  596. end;
  597. LOC_MMREGISTER,
  598. LOC_CMMREGISTER:
  599. begin
  600. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  601. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
  602. location_release(list,l);
  603. location_reset(l,LOC_REFERENCE,l.size);
  604. l.reference:=r;
  605. end;
  606. LOC_CONSTANT,
  607. LOC_REGISTER,
  608. LOC_CREGISTER :
  609. begin
  610. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  611. {$ifndef cpu64bit}
  612. if l.size in [OS_64,OS_S64] then
  613. begin
  614. cg64.a_load64_loc_ref(list,l,r);
  615. location_release(list,l);
  616. end
  617. else
  618. {$endif cpu64bit}
  619. begin
  620. location_release(list,l);
  621. cg.a_load_loc_ref(list,l.size,l,r);
  622. end;
  623. location_reset(l,LOC_REFERENCE,l.size);
  624. l.reference:=r;
  625. end;
  626. LOC_CREFERENCE,
  627. LOC_REFERENCE : ;
  628. else
  629. internalerror(200203219);
  630. end;
  631. end;
  632. {*****************************************************************************
  633. Maybe_Save
  634. *****************************************************************************}
  635. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  636. begin
  637. {$ifdef i386}
  638. if (needed>=maxfpuregs) and
  639. (l.loc = LOC_FPUREGISTER) then
  640. begin
  641. location_force_mem(list,l);
  642. maybe_pushfpu:=true;
  643. end
  644. else
  645. maybe_pushfpu:=false;
  646. {$else i386}
  647. maybe_pushfpu:=false;
  648. {$endif i386}
  649. end;
  650. {****************************************************************************
  651. Init/Finalize Code
  652. ****************************************************************************}
  653. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  654. var
  655. href1,href2 : treference;
  656. list:TAAsmoutput;
  657. hsym : tvarsym;
  658. l : longint;
  659. loadref : boolean;
  660. localcopyloc : tparalocation;
  661. begin
  662. list:=taasmoutput(arg);
  663. if (tsym(p).typ=varsym) and
  664. (tvarsym(p).varspez=vs_value) and
  665. (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
  666. begin
  667. loadref:=true;
  668. case tvarsym(p).localloc.loc of
  669. LOC_REGISTER :
  670. begin
  671. reference_reset_base(href1,tvarsym(p).localloc.register,0);
  672. loadref:=false;
  673. end;
  674. LOC_REFERENCE :
  675. reference_reset_base(href1,tvarsym(p).localloc.reference.index,
  676. tvarsym(p).localloc.reference.offset);
  677. else
  678. internalerror(200309181);
  679. end;
  680. if is_open_array(tvarsym(p).vartype.def) or
  681. is_array_of_const(tvarsym(p).vartype.def) then
  682. begin
  683. { cdecl functions don't have a high pointer so it is not possible to generate
  684. a local copy }
  685. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  686. begin
  687. hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
  688. if not assigned(hsym) then
  689. internalerror(200306061);
  690. case hsym.localloc.loc of
  691. LOC_REFERENCE :
  692. begin
  693. { this code is only executed before the code for the body and the entry/exit code is generated
  694. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  695. }
  696. include(current_procinfo.flags,pi_do_call);
  697. reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
  698. cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
  699. end
  700. else
  701. internalerror(200309182);
  702. end;
  703. end;
  704. end
  705. else
  706. begin
  707. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  708. internalerror(200309183);
  709. { Allocate space for the local copy }
  710. l:=tvarsym(p).getvaluesize;
  711. localcopyloc.loc:=LOC_REFERENCE;
  712. localcopyloc.size:=int_cgsize(l);
  713. tg.GetLocal(list,l,tvarsym(p).vartype.def,localcopyloc.reference);
  714. { Copy data }
  715. reference_reset_base(href2,localcopyloc.reference.index,localcopyloc.reference.offset);
  716. if is_shortstring(tvarsym(p).vartype.def) then
  717. begin
  718. { this code is only executed before the code for the body and the entry/exit code is generated
  719. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  720. }
  721. include(current_procinfo.flags,pi_do_call);
  722. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
  723. end
  724. else
  725. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
  726. { update localloc of varsym }
  727. tg.Ungetlocal(list,tvarsym(p).localloc.reference);
  728. tvarsym(p).localloc:=localcopyloc;
  729. end;
  730. end;
  731. end;
  732. { generates the code for initialisation of local data }
  733. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  734. var
  735. oldexprasmlist : TAAsmoutput;
  736. hp : tnode;
  737. begin
  738. if (tsym(p).typ=varsym) and
  739. (tvarsym(p).refs>0) and
  740. not(is_class(tvarsym(p).vartype.def)) and
  741. tvarsym(p).vartype.def.needs_inittable then
  742. begin
  743. oldexprasmlist:=exprasmlist;
  744. exprasmlist:=taasmoutput(arg);
  745. hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  746. firstpass(hp);
  747. secondpass(hp);
  748. hp.free;
  749. exprasmlist:=oldexprasmlist;
  750. end;
  751. end;
  752. { generates the code for finalisation of local data }
  753. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  754. var
  755. oldexprasmlist : TAAsmoutput;
  756. hp : tnode;
  757. dofinalize : boolean;
  758. begin
  759. dofinalize:=false;
  760. case tsym(p).typ of
  761. varsym :
  762. begin
  763. if (tvarsym(p).refs>0) and
  764. not(vo_is_funcret in tvarsym(p).varoptions) and
  765. not(is_class(tvarsym(p).vartype.def)) and
  766. tvarsym(p).vartype.def.needs_inittable then
  767. dofinalize:=true;
  768. end;
  769. {
  770. typedconstsym :
  771. begin
  772. if ttypedconstsym(p).is_writable and
  773. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  774. dofinalize:=true;
  775. end;
  776. }
  777. end;
  778. if dofinalize then
  779. begin
  780. include(current_procinfo.flags,pi_needs_implicit_finally);
  781. oldexprasmlist:=exprasmlist;
  782. exprasmlist:=taasmoutput(arg);
  783. hp:=finalize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  784. firstpass(hp);
  785. secondpass(hp);
  786. hp.free;
  787. exprasmlist:=oldexprasmlist;
  788. end;
  789. end;
  790. { generates the code for incrementing the reference count of parameters and
  791. initialize out parameters }
  792. procedure init_paras(p : tnamedindexitem;arg:pointer);
  793. var
  794. href : treference;
  795. tmpreg : tregister;
  796. list:TAAsmoutput;
  797. begin
  798. list:=taasmoutput(arg);
  799. if (tsym(p).typ=varsym) and
  800. not is_class(tvarsym(p).vartype.def) and
  801. tvarsym(p).vartype.def.needs_inittable then
  802. begin
  803. case tvarsym(p).varspez of
  804. vs_value :
  805. begin
  806. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  807. internalerror(200309187);
  808. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  809. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  810. end;
  811. vs_out :
  812. begin
  813. case tvarsym(p).localloc.loc of
  814. LOC_REFERENCE :
  815. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  816. else
  817. internalerror(2003091810);
  818. end;
  819. tmpreg:=cg.getaddressregister(list);
  820. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
  821. reference_reset_base(href,tmpreg,0);
  822. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  823. cg.ungetregister(list,tmpreg);
  824. end;
  825. end;
  826. end;
  827. end;
  828. { generates the code for decrementing the reference count of parameters }
  829. procedure final_paras(p : tnamedindexitem;arg:pointer);
  830. var
  831. href : treference;
  832. list:TAAsmoutput;
  833. begin
  834. list:=taasmoutput(arg);
  835. if (tsym(p).typ=varsym) and
  836. not is_class(tvarsym(p).vartype.def) and
  837. tvarsym(p).vartype.def.needs_inittable then
  838. begin
  839. if (tvarsym(p).varspez=vs_value) then
  840. begin
  841. include(current_procinfo.flags,pi_needs_implicit_finally);
  842. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  843. internalerror(200309188);
  844. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  845. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  846. end;
  847. end
  848. else if (tsym(p).typ=varsym) and
  849. (tvarsym(p).varspez=vs_value) and
  850. (is_open_array(tvarsym(p).vartype.def) or
  851. is_array_of_const(tvarsym(p).vartype.def)) then
  852. begin
  853. { cdecl functions don't have a high pointer so it is not possible to generate
  854. a local copy }
  855. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  856. begin
  857. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  858. cg.g_releasevaluepara_openarray(list,href);
  859. end;
  860. end;
  861. end;
  862. { Initialize temp ansi/widestrings,interfaces }
  863. procedure inittempvariables(list:taasmoutput);
  864. var
  865. hp : ptemprecord;
  866. href : treference;
  867. begin
  868. hp:=tg.templist;
  869. while assigned(hp) do
  870. begin
  871. if assigned(hp^.def) and
  872. hp^.def.needs_inittable then
  873. begin
  874. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  875. cg.g_initialize(list,hp^.def,href,false);
  876. end;
  877. hp:=hp^.next;
  878. end;
  879. end;
  880. procedure finalizetempvariables(list:taasmoutput);
  881. var
  882. hp : ptemprecord;
  883. href : treference;
  884. begin
  885. hp:=tg.templist;
  886. while assigned(hp) do
  887. begin
  888. if assigned(hp^.def) and
  889. hp^.def.needs_inittable then
  890. begin
  891. include(current_procinfo.flags,pi_needs_implicit_finally);
  892. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  893. cg.g_finalize(list,hp^.def,href,false);
  894. end;
  895. hp:=hp^.next;
  896. end;
  897. end;
  898. procedure gen_load_return_value(list:TAAsmoutput);
  899. var
  900. ressym : tvarsym;
  901. resloc : tlocation;
  902. hreg : tregister;
  903. resultloc : tparalocation;
  904. begin
  905. resultloc:=current_procinfo.procdef.funcret_paraloc[calleeside];
  906. { Is the loading needed? }
  907. if is_void(current_procinfo.procdef.rettype.def) or
  908. (
  909. (po_assembler in current_procinfo.procdef.procoptions) and
  910. (not(assigned(current_procinfo.procdef.funcretsym)) or
  911. (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
  912. ) then
  913. exit;
  914. { constructors return self }
  915. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  916. ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
  917. else
  918. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  919. if (ressym.refs>0) then
  920. begin
  921. case ressym.localloc.loc of
  922. LOC_FPUREGISTER:
  923. begin
  924. location_reset(resloc,LOC_CFPUREGISTER,resultloc.size);
  925. resloc.register:=ressym.localloc.register;
  926. end;
  927. LOC_REGISTER:
  928. begin
  929. location_reset(resloc,LOC_CREGISTER,resultloc.size);
  930. resloc.register:=ressym.localloc.register;
  931. end;
  932. LOC_MMREGISTER:
  933. begin
  934. location_reset(resloc,LOC_CMMREGISTER,resultloc.size);
  935. resloc.register:=ressym.localloc.register;
  936. end;
  937. LOC_REFERENCE:
  938. begin
  939. location_reset(resloc,LOC_REFERENCE,resultloc.size);
  940. reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
  941. end;
  942. else
  943. internalerror(200309184);
  944. end;
  945. { Here, we return the function result. In most architectures, the value is
  946. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  947. function returns in a register and the caller receives it in an other one }
  948. case resultloc.loc of
  949. LOC_REGISTER:
  950. begin
  951. {$ifndef cpu64bit}
  952. if resloc.size in [OS_64,OS_S64] then
  953. begin
  954. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  955. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  956. cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  957. cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  958. // for the optimizer
  959. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  960. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  961. cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
  962. NR_FUNCTION_RETURN64_HIGH_REG));
  963. end
  964. else
  965. {$endif cpu64bit}
  966. begin
  967. cg.getexplicitregister(list,resultloc.register);
  968. hreg:=cg.makeregsize(list,resultloc.register,resloc.size);
  969. cg.ungetregister(list,hreg);
  970. // for the optimizer
  971. cg.a_reg_alloc(list,resultloc.register);
  972. cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
  973. end;
  974. end;
  975. LOC_FPUREGISTER:
  976. begin
  977. cg.a_loadfpu_loc_reg(list,resloc,resultloc.register);
  978. end;
  979. LOC_MMREGISTER:
  980. begin
  981. cg.a_loadmm_loc_reg(list,resloc.size,resloc,resultloc.register,mms_movescalar);
  982. end;
  983. LOC_INVALID,
  984. LOC_REFERENCE:
  985. ;
  986. else
  987. internalerror(200405025);
  988. end;
  989. end;
  990. end;
  991. procedure gen_load_para_value(list:TAAsmoutput);
  992. var
  993. hp : tparaitem;
  994. href : treference;
  995. gotregvarparas : boolean;
  996. begin
  997. { Store register parameters in reference or in register variable }
  998. if assigned(current_procinfo.procdef.parast) and
  999. not (po_assembler in current_procinfo.procdef.procoptions) then
  1000. begin
  1001. { move register parameters which aren't regable into memory }
  1002. { we do this before init_paras because that one calls routines which may overwrite these }
  1003. { registers and it also expects the values to be in memory }
  1004. hp:=tparaitem(current_procinfo.procdef.para.first);
  1005. gotregvarparas := false;
  1006. while assigned(hp) do
  1007. begin
  1008. case tvarsym(hp.parasym).localloc.loc of
  1009. LOC_REGISTER,
  1010. LOC_MMREGISTER,
  1011. LOC_FPUREGISTER:
  1012. begin
  1013. gotregvarparas := true;
  1014. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1015. { register (if the parameter resides in a register) and then allocate }
  1016. { the regvar (which is currently not allocated) }
  1017. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
  1018. end;
  1019. LOC_REFERENCE :
  1020. begin
  1021. if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
  1022. begin
  1023. if getregtype(hp.paraloc[calleeside].register)=R_INTREGISTER then
  1024. begin
  1025. if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
  1026. begin
  1027. {$ifndef cpu64bit}
  1028. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1029. begin
  1030. cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
  1031. cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
  1032. end
  1033. else
  1034. {$endif cpu64bit}
  1035. cg.getexplicitregister(list,hp.paraloc[calleeside].register);
  1036. end;
  1037. { Release parameter register }
  1038. {$ifndef cpu64bit}
  1039. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1040. begin
  1041. cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
  1042. cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
  1043. end
  1044. else
  1045. {$endif cpu64bit}
  1046. cg.ungetregister(list,hp.paraloc[calleeside].register);
  1047. end;
  1048. reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
  1049. cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,mms_movescalar);
  1050. end;
  1051. end;
  1052. else
  1053. internalerror(200309185);
  1054. end;
  1055. hp:=tparaitem(hp.next);
  1056. end;
  1057. if gotregvarparas then
  1058. begin
  1059. { deallocate all register variables again }
  1060. hp:=tparaitem(current_procinfo.procdef.para.first);
  1061. while assigned(hp) do
  1062. begin
  1063. if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
  1064. cg.ungetregister(list,tvarsym(hp.parasym).localloc.register);
  1065. hp:=tparaitem(hp.next);
  1066. end;
  1067. end;
  1068. end;
  1069. { generate copies of call by value parameters, must be done before
  1070. the initialization and body is parsed because the refcounts are
  1071. incremented using the local copies }
  1072. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1073. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1074. end;
  1075. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  1076. begin
  1077. { initialize local data like ansistrings }
  1078. case current_procinfo.procdef.proctypeoption of
  1079. potype_unitinit:
  1080. begin
  1081. { this is also used for initialization of variables in a
  1082. program which does not have a globalsymtable }
  1083. if assigned(current_module.globalsymtable) then
  1084. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1085. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1086. end;
  1087. { units have seperate code for initilization and finalization }
  1088. potype_unitfinalize: ;
  1089. { program init/final is generated in separate procedure }
  1090. potype_proginit: ;
  1091. else
  1092. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1093. end;
  1094. { initialisizes temp. ansi/wide string data }
  1095. inittempvariables(list);
  1096. { initialize ansi/widesstring para's }
  1097. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1098. {$ifdef OLDREGVARS}
  1099. load_regvars(list,nil);
  1100. {$endif OLDREGVARS}
  1101. end;
  1102. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  1103. begin
  1104. {$ifdef OLDREGVARS}
  1105. cleanup_regvars(list);
  1106. {$endif OLDREGVARS}
  1107. { finalize temporary data }
  1108. finalizetempvariables(list);
  1109. { finalize local data like ansistrings}
  1110. case current_procinfo.procdef.proctypeoption of
  1111. potype_unitfinalize:
  1112. begin
  1113. { this is also used for initialization of variables in a
  1114. program which does not have a globalsymtable }
  1115. if assigned(current_module.globalsymtable) then
  1116. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1117. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1118. end;
  1119. { units/progs have separate code for initialization and finalization }
  1120. potype_unitinit: ;
  1121. { program init/final is generated in separate procedure }
  1122. potype_proginit: ;
  1123. else
  1124. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1125. end;
  1126. { finalize paras data }
  1127. if assigned(current_procinfo.procdef.parast) then
  1128. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1129. end;
  1130. procedure gen_entry_code(list:TAAsmoutput);
  1131. var
  1132. href : treference;
  1133. paraloc1,
  1134. paraloc2 : tparalocation;
  1135. hp : tused_unit;
  1136. begin
  1137. { the actual profile code can clobber some registers,
  1138. therefore if the context must be saved, do it before
  1139. the actual call to the profile code
  1140. }
  1141. if (cs_profile in aktmoduleswitches) and
  1142. not(po_assembler in current_procinfo.procdef.procoptions) then
  1143. begin
  1144. { non-win32 can call mcout even in main }
  1145. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1146. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1147. begin
  1148. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1149. cg.g_profilecode(list);
  1150. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1151. end;
  1152. end;
  1153. { call startup helpers from main program }
  1154. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1155. begin
  1156. { initialize profiling for win32 }
  1157. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1158. (cs_profile in aktmoduleswitches) then
  1159. begin
  1160. reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
  1161. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1162. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1163. paramanager.allocparaloc(list,paraloc2);
  1164. cg.a_paramaddr_ref(list,href,paraloc2);
  1165. reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
  1166. paramanager.allocparaloc(list,paraloc1);
  1167. cg.a_paramaddr_ref(list,href,paraloc1);
  1168. paramanager.freeparaloc(list,paraloc2);
  1169. paramanager.freeparaloc(list,paraloc1);
  1170. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1171. cg.a_call_name(list,'_monstartup');
  1172. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1173. end;
  1174. { initialize units }
  1175. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1176. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1177. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1178. {$ifdef GDB}
  1179. if (cs_debuginfo in aktmoduleswitches) then
  1180. begin
  1181. { include reference to all debuginfo sections of used units }
  1182. hp:=tused_unit(usedunits.first);
  1183. while assigned(hp) do
  1184. begin
  1185. If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
  1186. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
  1187. hp:=tused_unit(hp.next);
  1188. end;
  1189. { include reference to debuginfo for this program }
  1190. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
  1191. end;
  1192. {$endif GDB}
  1193. end;
  1194. {$ifdef GDB}
  1195. if (cs_debuginfo in aktmoduleswitches) then
  1196. list.concat(Tai_force_line.Create);
  1197. {$endif GDB}
  1198. {$ifdef OLDREGVARS}
  1199. load_regvars(list,nil);
  1200. {$endif OLDREGVARS}
  1201. end;
  1202. procedure gen_exit_code(list:TAAsmoutput);
  1203. begin
  1204. { call __EXIT for main program }
  1205. if (not DLLsource) and
  1206. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1207. cg.a_call_name(list,'FPC_DO_EXIT');
  1208. end;
  1209. {****************************************************************************
  1210. Entry/Exit
  1211. ****************************************************************************}
  1212. procedure gen_proc_symbol(list:Taasmoutput);
  1213. var
  1214. hs : string;
  1215. begin
  1216. { add symbol entry point as well as debug information }
  1217. { will be inserted in front of the rest of this list. }
  1218. { Insert alignment and assembler names }
  1219. { Align, gprof uses 16 byte granularity }
  1220. if (cs_profile in aktmoduleswitches) then
  1221. list.concat(Tai_align.create(16))
  1222. else
  1223. list.concat(Tai_align.create(aktalignment.procalign));
  1224. {$ifdef GDB}
  1225. if (cs_debuginfo in aktmoduleswitches) then
  1226. begin
  1227. if (po_public in current_procinfo.procdef.procoptions) then
  1228. Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
  1229. current_procinfo.procdef.concatstabto(list);
  1230. Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
  1231. end;
  1232. {$endif GDB}
  1233. repeat
  1234. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1235. if hs='' then
  1236. break;
  1237. {$ifdef GDB}
  1238. if (cs_debuginfo in aktmoduleswitches) and
  1239. target_info.use_function_relative_addresses then
  1240. list.concat(Tai_stab_function_name.create(strpnew(hs)));
  1241. {$endif GDB}
  1242. if (cs_profile in aktmoduleswitches) or
  1243. (po_public in current_procinfo.procdef.procoptions) then
  1244. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1245. else
  1246. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1247. until false;
  1248. end;
  1249. procedure gen_proc_symbol_end(list:Taasmoutput);
  1250. {$ifdef GDB}
  1251. var
  1252. stabsendlabel : tasmlabel;
  1253. mangled_length : longint;
  1254. p : pchar;
  1255. {$endif GDB}
  1256. begin
  1257. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1258. {$ifdef GDB}
  1259. if (cs_debuginfo in aktmoduleswitches) then
  1260. begin
  1261. objectlibrary.getlabel(stabsendlabel);
  1262. cg.a_label(list,stabsendlabel);
  1263. { define calling EBP as pseudo local var PM }
  1264. { this enables test if the function is a local one !! }
  1265. {if assigned(current_procinfo.parent) and
  1266. (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  1267. list.concat(Tai_stabs.Create(strpnew(
  1268. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1269. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
  1270. if assigned(current_procinfo.procdef.funcretsym) and
  1271. (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
  1272. begin
  1273. if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
  1274. begin
  1275. {$warning Need to add gdb support for ret in param register calling}
  1276. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1277. begin
  1278. list.concat(Tai_stabs.Create(strpnew(
  1279. '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1280. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1281. if (m_result in aktmodeswitches) then
  1282. list.concat(Tai_stabs.Create(strpnew(
  1283. '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1284. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
  1285. end
  1286. else
  1287. begin
  1288. list.concat(Tai_stabs.Create(strpnew(
  1289. '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1290. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1291. if (m_result in aktmodeswitches) then
  1292. list.concat(Tai_stabs.Create(strpnew(
  1293. '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1294. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1295. end;
  1296. end;
  1297. end;
  1298. mangled_length:=length(current_procinfo.procdef.mangledname);
  1299. getmem(p,2*mangled_length+50);
  1300. strpcopy(p,'192,0,0,');
  1301. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1302. if (target_info.use_function_relative_addresses) then
  1303. begin
  1304. strpcopy(strend(p),'-');
  1305. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1306. end;
  1307. list.concat(Tai_stabn.Create(strnew(p)));
  1308. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1309. +current_procinfo.procdef.mangledname))));
  1310. p[0]:='2';p[1]:='2';p[2]:='4';
  1311. strpcopy(strend(p),'_end');}
  1312. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1313. if (target_info.use_function_relative_addresses) then
  1314. begin
  1315. strpcopy(strend(p),'-');
  1316. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1317. end;
  1318. list.concatlist(withdebuglist);
  1319. list.concat(Tai_stabn.Create(strnew(p)));
  1320. { strpnew('224,0,0,'
  1321. +current_procinfo.procdef.mangledname+'_end'))));}
  1322. freemem(p,2*mangled_length+50);
  1323. end;
  1324. {$endif GDB}
  1325. end;
  1326. procedure gen_proc_entry_code(list:Taasmoutput);
  1327. var
  1328. hitemp,
  1329. lotemp,
  1330. stackframe : longint;
  1331. check : boolean;
  1332. paraloc1 : tparalocation;
  1333. href : treference;
  1334. begin
  1335. { generate call frame marker for dwarf call frame info }
  1336. dwarfcfi.start_frame(list);
  1337. { allocate temp for saving the argument used when
  1338. stack checking uses a register for pushing the stackframe size }
  1339. check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
  1340. if check then
  1341. begin
  1342. { Allocate tempspace to store register parameter than
  1343. is destroyed when calling stackchecking code }
  1344. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1345. if paraloc1.loc=LOC_REGISTER then
  1346. tg.GetTemp(list,sizeof(aint),tt_normal,href);
  1347. end;
  1348. { Calculate size of stackframe }
  1349. stackframe:=current_procinfo.calc_stackframe_size;
  1350. { All temps are know, write offsets used for information }
  1351. if (cs_asm_source in aktglobalswitches) then
  1352. begin
  1353. if tg.direction>0 then
  1354. begin
  1355. lotemp:=current_procinfo.tempstart;
  1356. hitemp:=tg.lasttemp;
  1357. end
  1358. else
  1359. begin
  1360. lotemp:=tg.lasttemp;
  1361. hitemp:=current_procinfo.tempstart;
  1362. end;
  1363. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1364. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1365. end;
  1366. { generate target specific proc entry code }
  1367. cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
  1368. { Add stack checking code? }
  1369. if check then
  1370. begin
  1371. { The tempspace to store original register is already
  1372. allocated above before the stackframe size is calculated. }
  1373. if paraloc1.loc=LOC_REGISTER then
  1374. cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
  1375. paramanager.allocparaloc(list,paraloc1);
  1376. cg.a_param_const(list,OS_INT,stackframe,paraloc1);
  1377. paramanager.freeparaloc(list,paraloc1);
  1378. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1379. cg.a_call_name(list,'FPC_STACKCHECK');
  1380. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1381. if paraloc1.loc=LOC_REGISTER then
  1382. begin
  1383. cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
  1384. tg.UnGetTemp(list,href);
  1385. end;
  1386. end;
  1387. end;
  1388. procedure gen_proc_exit_code(list:Taasmoutput);
  1389. var
  1390. parasize : longint;
  1391. begin
  1392. { c style clearstack does not need to remove parameters from the stack, only the
  1393. return value when it was pushed by arguments }
  1394. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1395. begin
  1396. parasize:=0;
  1397. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1398. inc(parasize,sizeof(aint));
  1399. end
  1400. else
  1401. parasize:=current_procinfo.para_stack_size;
  1402. { generate target specific proc exit code }
  1403. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1404. { release return registers, needed for optimizer }
  1405. if current_procinfo.procdef.funcret_paraloc[calleeside].loc<>LOC_INVALID then
  1406. paramanager.freeparaloc(list,
  1407. current_procinfo.procdef.funcret_paraloc[calleeside]);
  1408. { end of frame marker for call frame info }
  1409. dwarfcfi.end_frame(list);
  1410. end;
  1411. procedure gen_save_used_regs(list:TAAsmoutput);
  1412. begin
  1413. { Pure assembler routines need to save the registers themselves }
  1414. if (po_assembler in current_procinfo.procdef.procoptions) then
  1415. exit;
  1416. { for the save all registers we can simply use a pusha,popa which
  1417. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1418. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1419. cg.g_save_all_registers(list)
  1420. else
  1421. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1422. cg.g_save_standard_registers(list);
  1423. end;
  1424. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
  1425. begin
  1426. { Pure assembler routines need to save the registers themselves }
  1427. if (po_assembler in current_procinfo.procdef.procoptions) then
  1428. exit;
  1429. { for the save all registers we can simply use a pusha,popa which
  1430. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1431. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1432. cg.g_restore_all_registers(list,funcretparaloc)
  1433. else
  1434. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1435. cg.g_restore_standard_registers(list);
  1436. end;
  1437. {****************************************************************************
  1438. Inlining
  1439. ****************************************************************************}
  1440. (*
  1441. procedure load_inlined_return_value(list:TAAsmoutput);
  1442. var
  1443. ressym: tvarsym;
  1444. resloc: tlocation;
  1445. r,r2 : tregister;
  1446. begin
  1447. if not is_void(current_procinfo.procdef.rettype.def) then
  1448. begin
  1449. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  1450. if ressym.reg.enum <> R_NO then
  1451. begin
  1452. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1453. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  1454. else
  1455. if ressym.vartype.def.deftype = floatdef then
  1456. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  1457. else
  1458. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1459. resloc.register := ressym.reg;
  1460. end
  1461. else
  1462. begin
  1463. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1464. reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
  1465. end;
  1466. { Here, we return the function result. In most architectures, the value is
  1467. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1468. function returns in a register and the caller receives it in an other one }
  1469. case current_procinfo.procdef.rettype.def.deftype of
  1470. orddef,
  1471. enumdef :
  1472. begin
  1473. {$ifndef cpu64bit}
  1474. if resloc.size in [OS_64,OS_S64] then
  1475. begin
  1476. r:=cg.getregisterint(list,OS_INT);
  1477. r2:=cg.getregisterint(list,OS_INT);
  1478. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1479. end
  1480. else
  1481. {$endif cpu64bit}
  1482. begin
  1483. r:=cg.getregisterint(list,resloc.size);
  1484. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1485. end;
  1486. end;
  1487. floatdef :
  1488. begin
  1489. {$ifdef cpufpemu}
  1490. if cs_fp_emulation in aktmoduleswitches then
  1491. r.enum := FUNCTION_RETURN_REG
  1492. else
  1493. {$endif cpufpemu}
  1494. r.enum:=FPU_RESULT_REG;
  1495. cg.a_loadfpu_loc_reg(list,resloc,r);
  1496. end;
  1497. else
  1498. begin
  1499. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1500. begin
  1501. {$ifndef cpu64bit}
  1502. { Win32 can return records in EAX:EDX }
  1503. if resloc.size in [OS_64,OS_S64] then
  1504. begin
  1505. r:=cg.getregisterint(list,OS_INT);
  1506. r2:=cg.getregisterint(list,OS_INT);
  1507. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1508. end
  1509. else
  1510. {$endif cpu64bit}
  1511. begin
  1512. r:=cg.getregisterint(list,resloc.size);
  1513. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1514. end;
  1515. end
  1516. end;
  1517. end;
  1518. end;
  1519. end;
  1520. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  1521. begin
  1522. { initialize return value }
  1523. initretvalue(list);
  1524. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1525. { initialisizes temp. ansi/wide string data }
  1526. inittempvariables(list);
  1527. { initialize ansi/widesstring para's }
  1528. if assigned(current_procinfo.procdef.parast) then
  1529. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1530. { generate copies of call by value parameters }
  1531. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1532. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1533. load_regvars(list,nil);
  1534. end;
  1535. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  1536. var
  1537. usesacc,
  1538. usesacchi,
  1539. usesfpu : boolean;
  1540. begin
  1541. if aktexitlabel.is_used then
  1542. cg.a_label(list,aktexitlabel);
  1543. cleanup_regvars(list);
  1544. { finalize temporary data }
  1545. finalizetempvariables(list);
  1546. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1547. { finalize paras data }
  1548. if assigned(current_procinfo.procdef.parast) then
  1549. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1550. { handle return value, this is not done for assembler routines when
  1551. they didn't reference the result variable }
  1552. if not(po_assembler in current_procinfo.procdef.procoptions) or
  1553. (assigned(current_procinfo.procdef.funcretsym) and
  1554. (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
  1555. begin
  1556. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1557. internalerror(200305263);
  1558. // load_inlined_return_value(list);
  1559. load_return_value(list,usesacc,usesacchi,usesfpu)
  1560. end;
  1561. cleanup_regvars(list);
  1562. end;
  1563. *)
  1564. {****************************************************************************
  1565. Const Data
  1566. ****************************************************************************}
  1567. procedure insertconstdata(sym : ttypedconstsym);
  1568. { this does not affect the local stack space, since all
  1569. typed constansts and initialized variables are always
  1570. put in the .data / .rodata section
  1571. }
  1572. var
  1573. storefilepos : tfileposinfo;
  1574. curconstsegment : taasmoutput;
  1575. l : longint;
  1576. begin
  1577. storefilepos:=aktfilepos;
  1578. aktfilepos:=sym.fileinfo;
  1579. if sym.is_writable then
  1580. curconstsegment:=datasegment
  1581. else
  1582. curconstsegment:=consts;
  1583. l:=sym.getsize;
  1584. { insert cut for smartlinking or alignment }
  1585. maybe_new_object_file(curconstSegment);
  1586. new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
  1587. if (sym.owner.symtabletype=globalsymtable) or
  1588. maybe_smartlink_symbol or
  1589. (assigned(current_procinfo) and
  1590. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1591. DLLSource then
  1592. curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l))
  1593. else
  1594. curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l));
  1595. aktfilepos:=storefilepos;
  1596. end;
  1597. procedure insertbssdata(sym : tvarsym);
  1598. var
  1599. l,varalign : longint;
  1600. storefilepos : tfileposinfo;
  1601. begin
  1602. storefilepos:=aktfilepos;
  1603. aktfilepos:=sym.fileinfo;
  1604. l:=sym.getvaluesize;
  1605. if (vo_is_thread_var in sym.varoptions) then
  1606. inc(l,sizeof(aint));
  1607. varalign:=var_align(l);
  1608. maybe_new_object_file(bssSegment);
  1609. new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
  1610. if (sym.owner.symtabletype=globalsymtable) or
  1611. maybe_smartlink_symbol or
  1612. DLLSource or
  1613. (assigned(current_procinfo) and
  1614. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1615. (vo_is_exported in sym.varoptions) or
  1616. (vo_is_C_var in sym.varoptions) then
  1617. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1618. else
  1619. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1620. aktfilepos:=storefilepos;
  1621. end;
  1622. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1623. var
  1624. sym : tsym;
  1625. begin
  1626. sym:=tsym(st.symindex.first);
  1627. while assigned(sym) do
  1628. begin
  1629. { Only allocate space for referenced locals }
  1630. if (sym.typ=varsym) and
  1631. (tvarsym(sym).refs>0) then
  1632. begin
  1633. with tvarsym(sym) do
  1634. begin
  1635. {$warning TODO Add support for register variables}
  1636. localloc.loc:=LOC_REFERENCE;
  1637. tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
  1638. if cs_asm_source in aktglobalswitches then
  1639. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1640. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1641. end;
  1642. end;
  1643. sym:=tsym(sym.indexnext);
  1644. end;
  1645. end;
  1646. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1647. var
  1648. sym : tsym;
  1649. begin
  1650. sym:=tsym(st.symindex.first);
  1651. while assigned(sym) do
  1652. begin
  1653. if (sym.typ=varsym) and
  1654. (tvarsym(sym).refs>0) then
  1655. begin
  1656. with tvarsym(sym) do
  1657. begin
  1658. { Note: We need to keep the data available in memory
  1659. for the sub procedures that can access local data
  1660. in the parent procedures }
  1661. case localloc.loc of
  1662. LOC_REFERENCE :
  1663. tg.Ungetlocal(list,localloc.reference);
  1664. LOC_REGISTER :
  1665. begin
  1666. {$ifndef cpu64bit}
  1667. if localloc.size in [OS_64,OS_S64] then
  1668. begin
  1669. cg.ungetregister(list,localloc.registerlow);
  1670. cg.ungetregister(list,localloc.registerhigh);
  1671. end
  1672. else
  1673. {$endif cpu64bit}
  1674. cg.ungetregister(list,localloc.register);
  1675. end;
  1676. end;
  1677. end;
  1678. end;
  1679. sym:=tsym(sym.indexnext);
  1680. end;
  1681. end;
  1682. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1683. var
  1684. sym : tsym;
  1685. begin
  1686. sym:=tsym(st.symindex.first);
  1687. while assigned(sym) do
  1688. begin
  1689. if sym.typ=varsym then
  1690. begin
  1691. with tvarsym(sym) do
  1692. begin
  1693. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1694. begin
  1695. case paraitem.paraloc[calleeside].loc of
  1696. LOC_MMREGISTER,
  1697. LOC_FPUREGISTER,
  1698. LOC_REGISTER:
  1699. begin
  1700. (*
  1701. if paraitem.paraloc[calleeside].register=NR_NO then
  1702. begin
  1703. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1704. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1705. {$ifndef cpu64bit}
  1706. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1707. begin
  1708. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1709. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1710. end
  1711. else
  1712. {$endif cpu64bit}
  1713. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1714. end;
  1715. *)
  1716. (*
  1717. {$warning TODO Allocate register paras}
  1718. localloc.loc:=LOC_REGISTER;
  1719. localloc.size:=paraitem.paraloc[calleeside].size;
  1720. {$ifndef cpu64bit}
  1721. if localloc.size in [OS_64,OS_S64] then
  1722. begin
  1723. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1724. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1725. end
  1726. else
  1727. {$endif cpu64bit}
  1728. localloc.register:=cg.getregisterint(list,localloc.size);
  1729. *)
  1730. localloc.loc:=LOC_REFERENCE;
  1731. localloc.size:=paraitem.paraloc[calleeside].size;
  1732. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1733. end;
  1734. {$ifdef powerpc}
  1735. LOC_REFERENCE:
  1736. begin
  1737. localloc.loc := LOC_REFERENCE;
  1738. localloc.size:=paraitem.paraloc[calleeside].size;
  1739. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1740. end;
  1741. {$endif powerpc}
  1742. else
  1743. localloc:=paraitem.paraloc[calleeside];
  1744. end;
  1745. end
  1746. else
  1747. localloc:=paraitem.paraloc[calleeside];
  1748. if cs_asm_source in aktglobalswitches then
  1749. case localloc.loc of
  1750. LOC_REFERENCE :
  1751. begin
  1752. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1753. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1754. end;
  1755. end;
  1756. end;
  1757. end;
  1758. sym:=tsym(sym.indexnext);
  1759. end;
  1760. end;
  1761. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1762. var
  1763. sym : tsym;
  1764. begin
  1765. if (po_assembler in current_procinfo.procdef.procoptions) then
  1766. exit;
  1767. sym:=tsym(st.symindex.first);
  1768. while assigned(sym) do
  1769. begin
  1770. if sym.typ=varsym then
  1771. begin
  1772. with tvarsym(sym) do
  1773. begin
  1774. { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
  1775. localloc.loc:=LOC_REFERENCE;
  1776. localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
  1777. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1778. case paraitem.paraloc[calleeside].loc of
  1779. LOC_FPUREGISTER:
  1780. begin
  1781. paraitem.paraloc[calleeside].register := cg.getfpuregister(list,paraitem.paraloc[calleeside].size);
  1782. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1783. end;
  1784. LOC_REGISTER:
  1785. begin
  1786. paraitem.paraloc[calleeside].register := cg.getintregister(list,paraitem.paraloc[calleeside].size);
  1787. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1788. end;
  1789. LOC_MMREGISTER:
  1790. begin
  1791. paraitem.paraloc[calleeside].register := cg.getmmregister(list,paraitem.paraloc[calleeside].size);
  1792. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1793. end;
  1794. LOC_REFERENCE:
  1795. begin
  1796. paraitem.paraloc[calleeside] := localloc;
  1797. paraitem.paraloc[callerside] := localloc;
  1798. end;
  1799. end;
  1800. if cs_asm_source in aktglobalswitches then
  1801. begin
  1802. case localloc.loc of
  1803. LOC_REFERENCE :
  1804. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1805. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1806. end;
  1807. end;
  1808. end;
  1809. end;
  1810. sym:=tsym(sym.indexnext);
  1811. end;
  1812. end;
  1813. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1814. var
  1815. sym : tsym;
  1816. begin
  1817. sym:=tsym(st.symindex.first);
  1818. while assigned(sym) do
  1819. begin
  1820. if sym.typ=varsym then
  1821. begin
  1822. with tvarsym(sym) do
  1823. begin
  1824. { Note: We need to keep the data available in memory
  1825. for the sub procedures that can access local data
  1826. in the parent procedures }
  1827. case localloc.loc of
  1828. LOC_REFERENCE :
  1829. tg.UngetLocal(list,localloc.reference);
  1830. LOC_REGISTER :
  1831. begin
  1832. if localloc.register<>paraitem.paraloc[calleeside].register then
  1833. begin
  1834. {$ifndef cpu64bit}
  1835. if localloc.size in [OS_64,OS_S64] then
  1836. begin
  1837. cg.ungetregister(list,localloc.registerlow);
  1838. cg.ungetregister(list,localloc.registerhigh);
  1839. end
  1840. else
  1841. {$endif cpu64bit}
  1842. cg.ungetregister(list,localloc.register);
  1843. end;
  1844. end;
  1845. end;
  1846. end;
  1847. end;
  1848. sym:=tsym(sym.indexnext);
  1849. end;
  1850. end;
  1851. { persistent rtti generation }
  1852. procedure generate_rtti(p:Ttypesym);
  1853. var
  1854. rsym : trttisym;
  1855. def : tstoreddef;
  1856. begin
  1857. { rtti can only be generated for classes that are always typesyms }
  1858. def:=tstoreddef(ttypesym(p).restype.def);
  1859. { there is an error, skip rtti info }
  1860. if (def.deftype=errordef) or (Errorcount>0) then
  1861. exit;
  1862. { only create rtti once for each definition }
  1863. if not(df_has_rttitable in def.defoptions) then
  1864. begin
  1865. { definition should be in the same symtable as the symbol }
  1866. if p.owner<>def.owner then
  1867. internalerror(200108262);
  1868. { create rttisym }
  1869. rsym:=trttisym.create(p.name,fullrtti);
  1870. p.owner.insert(rsym);
  1871. { register rttisym in definition }
  1872. include(def.defoptions,df_has_rttitable);
  1873. def.rttitablesym:=rsym;
  1874. { write rtti data }
  1875. def.write_child_rtti_data(fullrtti);
  1876. maybe_new_object_file(rttilist);
  1877. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1878. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1879. def.write_rtti_data(fullrtti);
  1880. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1881. end;
  1882. end;
  1883. { persistent init table generation }
  1884. procedure generate_inittable(p:tsym);
  1885. var
  1886. rsym : trttisym;
  1887. def : tstoreddef;
  1888. begin
  1889. { anonymous types are also allowed for records that can be varsym }
  1890. case p.typ of
  1891. typesym :
  1892. def:=tstoreddef(ttypesym(p).restype.def);
  1893. varsym :
  1894. def:=tstoreddef(tvarsym(p).vartype.def);
  1895. else
  1896. internalerror(200108263);
  1897. end;
  1898. { only create inittable once for each definition }
  1899. if not(df_has_inittable in def.defoptions) then
  1900. begin
  1901. { definition should be in the same symtable as the symbol }
  1902. if p.owner<>def.owner then
  1903. internalerror(200108264);
  1904. { create rttisym }
  1905. rsym:=trttisym.create(p.name,initrtti);
  1906. p.owner.insert(rsym);
  1907. { register rttisym in definition }
  1908. include(def.defoptions,df_has_inittable);
  1909. def.inittablesym:=rsym;
  1910. { write inittable data }
  1911. def.write_child_rtti_data(initrtti);
  1912. maybe_new_object_file(rttilist);
  1913. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1914. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1915. def.write_rtti_data(initrtti);
  1916. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1917. end;
  1918. end;
  1919. end.
  1920. {
  1921. $Log$
  1922. Revision 1.213 2004-08-23 11:00:06 michael
  1923. + Patch from Peter to fix debuginfo in constructor.
  1924. Revision 1.212 2004/07/17 13:14:17 jonas
  1925. * don't finalize typed consts (fixes bug3212, but causes memory leak;
  1926. they should be finalized at the end of the module)
  1927. Revision 1.211 2004/07/09 23:41:04 jonas
  1928. * support register parameters for inlined procedures + some inline
  1929. cleanups
  1930. Revision 1.210 2004/07/04 12:24:59 jonas
  1931. * fixed one regvar problem, but regvars are still broken since the dwarf
  1932. merge...
  1933. Revision 1.209 2004/06/29 20:57:21 peter
  1934. * fixed size of exceptbuf
  1935. Revision 1.208 2004/06/20 08:55:29 florian
  1936. * logs truncated
  1937. Revision 1.207 2004/06/16 20:07:08 florian
  1938. * dwarf branch merged
  1939. Revision 1.206 2004/06/01 20:39:33 jonas
  1940. * fixed bug regarding parameters on the ppc (they were allocated twice
  1941. under some circumstances and not at all in others)
  1942. Revision 1.205 2004/05/30 21:41:15 jonas
  1943. * more regvar optimizations in location_force_reg
  1944. Revision 1.204 2004/05/30 21:18:22 jonas
  1945. * some optimizations and associated fixes for better regvar code
  1946. Revision 1.203 2004/05/28 21:14:13 peter
  1947. * first load para's to temps before calling entry code (profile
  1948. }