ncgutil.pas 86 KB

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