ncgutil.pas 82 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092
  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. typedconstsym :
  770. begin
  771. if ttypedconstsym(p).is_writable and
  772. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  773. dofinalize:=true;
  774. end;
  775. end;
  776. if dofinalize then
  777. begin
  778. include(current_procinfo.flags,pi_needs_implicit_finally);
  779. oldexprasmlist:=exprasmlist;
  780. exprasmlist:=taasmoutput(arg);
  781. hp:=finalize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  782. firstpass(hp);
  783. secondpass(hp);
  784. hp.free;
  785. exprasmlist:=oldexprasmlist;
  786. end;
  787. end;
  788. { generates the code for incrementing the reference count of parameters and
  789. initialize out parameters }
  790. procedure init_paras(p : tnamedindexitem;arg:pointer);
  791. var
  792. href : treference;
  793. tmpreg : tregister;
  794. list:TAAsmoutput;
  795. begin
  796. list:=taasmoutput(arg);
  797. if (tsym(p).typ=varsym) and
  798. not is_class(tvarsym(p).vartype.def) and
  799. tvarsym(p).vartype.def.needs_inittable then
  800. begin
  801. case tvarsym(p).varspez of
  802. vs_value :
  803. begin
  804. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  805. internalerror(200309187);
  806. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  807. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  808. end;
  809. vs_out :
  810. begin
  811. case tvarsym(p).localloc.loc of
  812. LOC_REFERENCE :
  813. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  814. else
  815. internalerror(2003091810);
  816. end;
  817. tmpreg:=cg.getaddressregister(list);
  818. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
  819. reference_reset_base(href,tmpreg,0);
  820. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  821. cg.ungetregister(list,tmpreg);
  822. end;
  823. end;
  824. end;
  825. end;
  826. { generates the code for decrementing the reference count of parameters }
  827. procedure final_paras(p : tnamedindexitem;arg:pointer);
  828. var
  829. href : treference;
  830. list:TAAsmoutput;
  831. begin
  832. list:=taasmoutput(arg);
  833. if (tsym(p).typ=varsym) and
  834. not is_class(tvarsym(p).vartype.def) and
  835. tvarsym(p).vartype.def.needs_inittable then
  836. begin
  837. if (tvarsym(p).varspez=vs_value) then
  838. begin
  839. include(current_procinfo.flags,pi_needs_implicit_finally);
  840. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  841. internalerror(200309188);
  842. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  843. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  844. end;
  845. end
  846. else if (tsym(p).typ=varsym) and
  847. (tvarsym(p).varspez=vs_value) and
  848. (is_open_array(tvarsym(p).vartype.def) or
  849. is_array_of_const(tvarsym(p).vartype.def)) then
  850. begin
  851. { cdecl functions don't have a high pointer so it is not possible to generate
  852. a local copy }
  853. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  854. begin
  855. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  856. cg.g_releasevaluepara_openarray(list,href);
  857. end;
  858. end;
  859. end;
  860. { Initialize temp ansi/widestrings,interfaces }
  861. procedure inittempvariables(list:taasmoutput);
  862. var
  863. hp : ptemprecord;
  864. href : treference;
  865. begin
  866. hp:=tg.templist;
  867. while assigned(hp) do
  868. begin
  869. if assigned(hp^.def) and
  870. hp^.def.needs_inittable then
  871. begin
  872. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  873. cg.g_initialize(list,hp^.def,href,false);
  874. end;
  875. hp:=hp^.next;
  876. end;
  877. end;
  878. procedure finalizetempvariables(list:taasmoutput);
  879. var
  880. hp : ptemprecord;
  881. href : treference;
  882. begin
  883. hp:=tg.templist;
  884. while assigned(hp) do
  885. begin
  886. if assigned(hp^.def) and
  887. hp^.def.needs_inittable then
  888. begin
  889. include(current_procinfo.flags,pi_needs_implicit_finally);
  890. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  891. cg.g_finalize(list,hp^.def,href,false);
  892. end;
  893. hp:=hp^.next;
  894. end;
  895. end;
  896. procedure gen_load_return_value(list:TAAsmoutput);
  897. var
  898. ressym : tvarsym;
  899. resloc : tlocation;
  900. hreg : tregister;
  901. resultloc : tparalocation;
  902. begin
  903. resultloc:=current_procinfo.procdef.funcret_paraloc[calleeside];
  904. { Is the loading needed? }
  905. if is_void(current_procinfo.procdef.rettype.def) or
  906. (
  907. (po_assembler in current_procinfo.procdef.procoptions) and
  908. (not(assigned(current_procinfo.procdef.funcretsym)) or
  909. (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
  910. ) then
  911. exit;
  912. { constructors return self }
  913. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  914. ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
  915. else
  916. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  917. if (ressym.refs>0) then
  918. begin
  919. case ressym.localloc.loc of
  920. LOC_FPUREGISTER:
  921. begin
  922. location_reset(resloc,LOC_CREGISTER,resultloc.size);
  923. resloc.register:=ressym.localloc.register;
  924. end;
  925. LOC_REGISTER:
  926. begin
  927. location_reset(resloc,LOC_CREGISTER,resultloc.size);
  928. resloc.register:=ressym.localloc.register;
  929. end;
  930. LOC_MMREGISTER:
  931. begin
  932. location_reset(resloc,LOC_CMMREGISTER,resultloc.size);
  933. resloc.register:=ressym.localloc.register;
  934. end;
  935. LOC_REFERENCE:
  936. begin
  937. location_reset(resloc,LOC_REFERENCE,resultloc.size);
  938. reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
  939. end;
  940. else
  941. internalerror(200309184);
  942. end;
  943. { Here, we return the function result. In most architectures, the value is
  944. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  945. function returns in a register and the caller receives it in an other one }
  946. case resultloc.loc of
  947. LOC_REGISTER:
  948. begin
  949. {$ifndef cpu64bit}
  950. if resloc.size in [OS_64,OS_S64] then
  951. begin
  952. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  953. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  954. cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  955. cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  956. // for the optimizer
  957. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  958. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  959. cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
  960. NR_FUNCTION_RETURN64_HIGH_REG));
  961. end
  962. else
  963. {$endif cpu64bit}
  964. begin
  965. cg.getexplicitregister(list,resultloc.register);
  966. hreg:=cg.makeregsize(list,resultloc.register,resloc.size);
  967. cg.ungetregister(list,hreg);
  968. // for the optimizer
  969. cg.a_reg_alloc(list,resultloc.register);
  970. cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
  971. end;
  972. end;
  973. LOC_FPUREGISTER:
  974. begin
  975. cg.a_loadfpu_loc_reg(list,resloc,resultloc.register);
  976. end;
  977. LOC_MMREGISTER:
  978. begin
  979. cg.a_loadmm_loc_reg(list,resloc.size,resloc,resultloc.register,mms_movescalar);
  980. end;
  981. LOC_INVALID,
  982. LOC_REFERENCE:
  983. ;
  984. else
  985. internalerror(200405025);
  986. end;
  987. end;
  988. end;
  989. procedure gen_load_para_value(list:TAAsmoutput);
  990. var
  991. hp : tparaitem;
  992. href : treference;
  993. gotregvarparas : boolean;
  994. begin
  995. { Store register parameters in reference or in register variable }
  996. if assigned(current_procinfo.procdef.parast) and
  997. not (po_assembler in current_procinfo.procdef.procoptions) then
  998. begin
  999. { move register parameters which aren't regable into memory }
  1000. { we do this before init_paras because that one calls routines which may overwrite these }
  1001. { registers and it also expects the values to be in memory }
  1002. hp:=tparaitem(current_procinfo.procdef.para.first);
  1003. gotregvarparas := false;
  1004. while assigned(hp) do
  1005. begin
  1006. case tvarsym(hp.parasym).localloc.loc of
  1007. LOC_REGISTER,
  1008. LOC_MMREGISTER,
  1009. LOC_FPUREGISTER:
  1010. begin
  1011. gotregvarparas := true;
  1012. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1013. { register (if the parameter resides in a register) and then allocate }
  1014. { the regvar (which is currently not allocated) }
  1015. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
  1016. end;
  1017. LOC_REFERENCE :
  1018. begin
  1019. if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
  1020. begin
  1021. if getregtype(hp.paraloc[calleeside].register)=R_INTREGISTER then
  1022. begin
  1023. if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
  1024. begin
  1025. {$ifndef cpu64bit}
  1026. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1027. begin
  1028. cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
  1029. cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
  1030. end
  1031. else
  1032. {$endif cpu64bit}
  1033. cg.getexplicitregister(list,hp.paraloc[calleeside].register);
  1034. end;
  1035. { Release parameter register }
  1036. {$ifndef cpu64bit}
  1037. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1038. begin
  1039. cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
  1040. cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
  1041. end
  1042. else
  1043. {$endif cpu64bit}
  1044. cg.ungetregister(list,hp.paraloc[calleeside].register);
  1045. end;
  1046. reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
  1047. cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,mms_movescalar);
  1048. end;
  1049. end;
  1050. else
  1051. internalerror(200309185);
  1052. end;
  1053. hp:=tparaitem(hp.next);
  1054. end;
  1055. if gotregvarparas then
  1056. begin
  1057. { deallocate all register variables again }
  1058. hp:=tparaitem(current_procinfo.procdef.para.first);
  1059. while assigned(hp) do
  1060. begin
  1061. if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
  1062. cg.ungetregister(list,tvarsym(hp.parasym).localloc.register);
  1063. hp:=tparaitem(hp.next);
  1064. end;
  1065. end;
  1066. end;
  1067. { generate copies of call by value parameters, must be done before
  1068. the initialization and body is parsed because the refcounts are
  1069. incremented using the local copies }
  1070. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1071. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1072. end;
  1073. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  1074. begin
  1075. { initialize local data like ansistrings }
  1076. case current_procinfo.procdef.proctypeoption of
  1077. potype_unitinit:
  1078. begin
  1079. { this is also used for initialization of variables in a
  1080. program which does not have a globalsymtable }
  1081. if assigned(current_module.globalsymtable) then
  1082. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1083. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1084. end;
  1085. { units have seperate code for initilization and finalization }
  1086. potype_unitfinalize: ;
  1087. { program init/final is generated in separate procedure }
  1088. potype_proginit: ;
  1089. else
  1090. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1091. end;
  1092. { initialisizes temp. ansi/wide string data }
  1093. inittempvariables(list);
  1094. { initialize ansi/widesstring para's }
  1095. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1096. {$ifdef OLDREGVARS}
  1097. load_regvars(list,nil);
  1098. {$endif OLDREGVARS}
  1099. end;
  1100. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  1101. begin
  1102. {$ifdef OLDREGVARS}
  1103. cleanup_regvars(list);
  1104. {$endif OLDREGVARS}
  1105. { finalize temporary data }
  1106. finalizetempvariables(list);
  1107. { finalize local data like ansistrings}
  1108. case current_procinfo.procdef.proctypeoption of
  1109. potype_unitfinalize:
  1110. begin
  1111. { this is also used for initialization of variables in a
  1112. program which does not have a globalsymtable }
  1113. if assigned(current_module.globalsymtable) then
  1114. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1115. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1116. end;
  1117. { units/progs have separate code for initialization and finalization }
  1118. potype_unitinit: ;
  1119. { program init/final is generated in separate procedure }
  1120. potype_proginit: ;
  1121. else
  1122. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1123. end;
  1124. { finalize paras data }
  1125. if assigned(current_procinfo.procdef.parast) then
  1126. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1127. end;
  1128. procedure gen_entry_code(list:TAAsmoutput);
  1129. var
  1130. href : treference;
  1131. paraloc1,
  1132. paraloc2 : tparalocation;
  1133. hp : tused_unit;
  1134. begin
  1135. { the actual profile code can clobber some registers,
  1136. therefore if the context must be saved, do it before
  1137. the actual call to the profile code
  1138. }
  1139. if (cs_profile in aktmoduleswitches) and
  1140. not(po_assembler in current_procinfo.procdef.procoptions) then
  1141. begin
  1142. { non-win32 can call mcout even in main }
  1143. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1144. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1145. begin
  1146. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1147. cg.g_profilecode(list);
  1148. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1149. end;
  1150. end;
  1151. { call startup helpers from main program }
  1152. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1153. begin
  1154. { initialize profiling for win32 }
  1155. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1156. (cs_profile in aktmoduleswitches) then
  1157. begin
  1158. reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
  1159. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1160. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1161. paramanager.allocparaloc(list,paraloc2);
  1162. cg.a_paramaddr_ref(list,href,paraloc2);
  1163. reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
  1164. paramanager.allocparaloc(list,paraloc1);
  1165. cg.a_paramaddr_ref(list,href,paraloc1);
  1166. paramanager.freeparaloc(list,paraloc2);
  1167. paramanager.freeparaloc(list,paraloc1);
  1168. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1169. cg.a_call_name(list,'_monstartup');
  1170. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1171. end;
  1172. { initialize units }
  1173. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1174. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1175. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1176. {$ifdef GDB}
  1177. if (cs_debuginfo in aktmoduleswitches) then
  1178. begin
  1179. { include reference to all debuginfo sections of used units }
  1180. hp:=tused_unit(usedunits.first);
  1181. while assigned(hp) do
  1182. begin
  1183. If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
  1184. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
  1185. hp:=tused_unit(hp.next);
  1186. end;
  1187. { include reference to debuginfo for this program }
  1188. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
  1189. end;
  1190. {$endif GDB}
  1191. end;
  1192. {$ifdef GDB}
  1193. if (cs_debuginfo in aktmoduleswitches) then
  1194. list.concat(Tai_force_line.Create);
  1195. {$endif GDB}
  1196. {$ifdef OLDREGVARS}
  1197. load_regvars(list,nil);
  1198. {$endif OLDREGVARS}
  1199. end;
  1200. procedure gen_exit_code(list:TAAsmoutput);
  1201. begin
  1202. { call __EXIT for main program }
  1203. if (not DLLsource) and
  1204. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1205. cg.a_call_name(list,'FPC_DO_EXIT');
  1206. end;
  1207. {****************************************************************************
  1208. Entry/Exit
  1209. ****************************************************************************}
  1210. procedure gen_proc_symbol(list:Taasmoutput);
  1211. var
  1212. hs : string;
  1213. begin
  1214. { add symbol entry point as well as debug information }
  1215. { will be inserted in front of the rest of this list. }
  1216. { Insert alignment and assembler names }
  1217. { Align, gprof uses 16 byte granularity }
  1218. if (cs_profile in aktmoduleswitches) then
  1219. list.concat(Tai_align.create(16))
  1220. else
  1221. list.concat(Tai_align.create(aktalignment.procalign));
  1222. {$ifdef GDB}
  1223. if (cs_debuginfo in aktmoduleswitches) then
  1224. begin
  1225. if (po_public in current_procinfo.procdef.procoptions) then
  1226. Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
  1227. current_procinfo.procdef.concatstabto(list);
  1228. Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
  1229. end;
  1230. {$endif GDB}
  1231. repeat
  1232. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1233. if hs='' then
  1234. break;
  1235. {$ifdef GDB}
  1236. if (cs_debuginfo in aktmoduleswitches) and
  1237. target_info.use_function_relative_addresses then
  1238. list.concat(Tai_stab_function_name.create(strpnew(hs)));
  1239. {$endif GDB}
  1240. if (cs_profile in aktmoduleswitches) or
  1241. (po_public in current_procinfo.procdef.procoptions) then
  1242. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1243. else
  1244. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1245. until false;
  1246. end;
  1247. procedure gen_proc_symbol_end(list:Taasmoutput);
  1248. {$ifdef GDB}
  1249. var
  1250. stabsendlabel : tasmlabel;
  1251. mangled_length : longint;
  1252. p : pchar;
  1253. {$endif GDB}
  1254. begin
  1255. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1256. {$ifdef GDB}
  1257. if (cs_debuginfo in aktmoduleswitches) then
  1258. begin
  1259. objectlibrary.getlabel(stabsendlabel);
  1260. cg.a_label(list,stabsendlabel);
  1261. { define calling EBP as pseudo local var PM }
  1262. { this enables test if the function is a local one !! }
  1263. {if assigned(current_procinfo.parent) and
  1264. (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  1265. list.concat(Tai_stabs.Create(strpnew(
  1266. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1267. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
  1268. if (not is_void(current_procinfo.procdef.rettype.def)) and
  1269. (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
  1270. begin
  1271. if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
  1272. begin
  1273. {$warning Need to add gdb support for ret in param register calling}
  1274. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1275. begin
  1276. list.concat(Tai_stabs.Create(strpnew(
  1277. '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1278. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1279. if (m_result in aktmodeswitches) then
  1280. list.concat(Tai_stabs.Create(strpnew(
  1281. '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1282. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
  1283. end
  1284. else
  1285. begin
  1286. list.concat(Tai_stabs.Create(strpnew(
  1287. '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1288. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1289. if (m_result in aktmodeswitches) then
  1290. list.concat(Tai_stabs.Create(strpnew(
  1291. '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1292. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1293. end;
  1294. end;
  1295. end;
  1296. mangled_length:=length(current_procinfo.procdef.mangledname);
  1297. getmem(p,2*mangled_length+50);
  1298. strpcopy(p,'192,0,0,');
  1299. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1300. if (target_info.use_function_relative_addresses) then
  1301. begin
  1302. strpcopy(strend(p),'-');
  1303. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1304. end;
  1305. list.concat(Tai_stabn.Create(strnew(p)));
  1306. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1307. +current_procinfo.procdef.mangledname))));
  1308. p[0]:='2';p[1]:='2';p[2]:='4';
  1309. strpcopy(strend(p),'_end');}
  1310. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1311. if (target_info.use_function_relative_addresses) then
  1312. begin
  1313. strpcopy(strend(p),'-');
  1314. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1315. end;
  1316. list.concatlist(withdebuglist);
  1317. list.concat(Tai_stabn.Create(strnew(p)));
  1318. { strpnew('224,0,0,'
  1319. +current_procinfo.procdef.mangledname+'_end'))));}
  1320. freemem(p,2*mangled_length+50);
  1321. end;
  1322. {$endif GDB}
  1323. end;
  1324. procedure gen_proc_entry_code(list:Taasmoutput);
  1325. var
  1326. hitemp,
  1327. lotemp,
  1328. stackframe : longint;
  1329. check : boolean;
  1330. paraloc1 : tparalocation;
  1331. href : treference;
  1332. begin
  1333. { generate call frame marker for dwarf call frame info }
  1334. dwarfcfi.start_frame(list);
  1335. { allocate temp for saving the argument used when
  1336. stack checking uses a register for pushing the stackframe size }
  1337. check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
  1338. if check then
  1339. begin
  1340. { Allocate tempspace to store register parameter than
  1341. is destroyed when calling stackchecking code }
  1342. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1343. if paraloc1.loc=LOC_REGISTER then
  1344. tg.GetTemp(list,sizeof(aint),tt_normal,href);
  1345. end;
  1346. { Calculate size of stackframe }
  1347. stackframe:=current_procinfo.calc_stackframe_size;
  1348. { All temps are know, write offsets used for information }
  1349. if (cs_asm_source in aktglobalswitches) then
  1350. begin
  1351. if tg.direction>0 then
  1352. begin
  1353. lotemp:=current_procinfo.tempstart;
  1354. hitemp:=tg.lasttemp;
  1355. end
  1356. else
  1357. begin
  1358. lotemp:=tg.lasttemp;
  1359. hitemp:=current_procinfo.tempstart;
  1360. end;
  1361. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1362. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1363. end;
  1364. { generate target specific proc entry code }
  1365. cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
  1366. { Add stack checking code? }
  1367. if check then
  1368. begin
  1369. { The tempspace to store original register is already
  1370. allocated above before the stackframe size is calculated. }
  1371. if paraloc1.loc=LOC_REGISTER then
  1372. cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
  1373. paramanager.allocparaloc(list,paraloc1);
  1374. cg.a_param_const(list,OS_INT,stackframe,paraloc1);
  1375. paramanager.freeparaloc(list,paraloc1);
  1376. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1377. cg.a_call_name(list,'FPC_STACKCHECK');
  1378. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1379. if paraloc1.loc=LOC_REGISTER then
  1380. begin
  1381. cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
  1382. tg.UnGetTemp(list,href);
  1383. end;
  1384. end;
  1385. end;
  1386. procedure gen_proc_exit_code(list:Taasmoutput);
  1387. var
  1388. parasize : longint;
  1389. begin
  1390. { c style clearstack does not need to remove parameters from the stack, only the
  1391. return value when it was pushed by arguments }
  1392. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1393. begin
  1394. parasize:=0;
  1395. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1396. inc(parasize,sizeof(aint));
  1397. end
  1398. else
  1399. parasize:=current_procinfo.para_stack_size;
  1400. { generate target specific proc exit code }
  1401. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1402. { release return registers, needed for optimizer }
  1403. if current_procinfo.procdef.funcret_paraloc[calleeside].loc<>LOC_INVALID then
  1404. paramanager.freeparaloc(list,
  1405. current_procinfo.procdef.funcret_paraloc[calleeside]);
  1406. { end of frame marker for call frame info }
  1407. dwarfcfi.end_frame(list);
  1408. end;
  1409. procedure gen_save_used_regs(list:TAAsmoutput);
  1410. begin
  1411. { Pure assembler routines need to save the registers themselves }
  1412. if (po_assembler in current_procinfo.procdef.procoptions) then
  1413. exit;
  1414. { for the save all registers we can simply use a pusha,popa which
  1415. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1416. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1417. cg.g_save_all_registers(list)
  1418. else
  1419. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1420. cg.g_save_standard_registers(list);
  1421. end;
  1422. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
  1423. begin
  1424. { Pure assembler routines need to save the registers themselves }
  1425. if (po_assembler in current_procinfo.procdef.procoptions) then
  1426. exit;
  1427. { for the save all registers we can simply use a pusha,popa which
  1428. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1429. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1430. cg.g_restore_all_registers(list,funcretparaloc)
  1431. else
  1432. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1433. cg.g_restore_standard_registers(list);
  1434. end;
  1435. {****************************************************************************
  1436. Inlining
  1437. ****************************************************************************}
  1438. (*
  1439. procedure load_inlined_return_value(list:TAAsmoutput);
  1440. var
  1441. ressym: tvarsym;
  1442. resloc: tlocation;
  1443. r,r2 : tregister;
  1444. begin
  1445. if not is_void(current_procinfo.procdef.rettype.def) then
  1446. begin
  1447. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  1448. if ressym.reg.enum <> R_NO then
  1449. begin
  1450. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1451. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  1452. else
  1453. if ressym.vartype.def.deftype = floatdef then
  1454. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  1455. else
  1456. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1457. resloc.register := ressym.reg;
  1458. end
  1459. else
  1460. begin
  1461. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1462. reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
  1463. end;
  1464. { Here, we return the function result. In most architectures, the value is
  1465. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1466. function returns in a register and the caller receives it in an other one }
  1467. case current_procinfo.procdef.rettype.def.deftype of
  1468. orddef,
  1469. enumdef :
  1470. begin
  1471. {$ifndef cpu64bit}
  1472. if resloc.size in [OS_64,OS_S64] then
  1473. begin
  1474. r:=cg.getregisterint(list,OS_INT);
  1475. r2:=cg.getregisterint(list,OS_INT);
  1476. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1477. end
  1478. else
  1479. {$endif cpu64bit}
  1480. begin
  1481. r:=cg.getregisterint(list,resloc.size);
  1482. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1483. end;
  1484. end;
  1485. floatdef :
  1486. begin
  1487. {$ifdef cpufpemu}
  1488. if cs_fp_emulation in aktmoduleswitches then
  1489. r.enum := FUNCTION_RETURN_REG
  1490. else
  1491. {$endif cpufpemu}
  1492. r.enum:=FPU_RESULT_REG;
  1493. cg.a_loadfpu_loc_reg(list,resloc,r);
  1494. end;
  1495. else
  1496. begin
  1497. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1498. begin
  1499. {$ifndef cpu64bit}
  1500. { Win32 can return records in EAX:EDX }
  1501. if resloc.size in [OS_64,OS_S64] then
  1502. begin
  1503. r:=cg.getregisterint(list,OS_INT);
  1504. r2:=cg.getregisterint(list,OS_INT);
  1505. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1506. end
  1507. else
  1508. {$endif cpu64bit}
  1509. begin
  1510. r:=cg.getregisterint(list,resloc.size);
  1511. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1512. end;
  1513. end
  1514. end;
  1515. end;
  1516. end;
  1517. end;
  1518. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  1519. begin
  1520. { initialize return value }
  1521. initretvalue(list);
  1522. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1523. { initialisizes temp. ansi/wide string data }
  1524. inittempvariables(list);
  1525. { initialize ansi/widesstring para's }
  1526. if assigned(current_procinfo.procdef.parast) then
  1527. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1528. { generate copies of call by value parameters }
  1529. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1530. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1531. load_regvars(list,nil);
  1532. end;
  1533. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  1534. var
  1535. usesacc,
  1536. usesacchi,
  1537. usesfpu : boolean;
  1538. begin
  1539. if aktexitlabel.is_used then
  1540. cg.a_label(list,aktexitlabel);
  1541. cleanup_regvars(list);
  1542. { finalize temporary data }
  1543. finalizetempvariables(list);
  1544. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1545. { finalize paras data }
  1546. if assigned(current_procinfo.procdef.parast) then
  1547. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1548. { handle return value, this is not done for assembler routines when
  1549. they didn't reference the result variable }
  1550. if not(po_assembler in current_procinfo.procdef.procoptions) or
  1551. (assigned(current_procinfo.procdef.funcretsym) and
  1552. (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
  1553. begin
  1554. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1555. internalerror(200305263);
  1556. // load_inlined_return_value(list);
  1557. load_return_value(list,usesacc,usesacchi,usesfpu)
  1558. end;
  1559. cleanup_regvars(list);
  1560. end;
  1561. *)
  1562. {****************************************************************************
  1563. Const Data
  1564. ****************************************************************************}
  1565. procedure insertconstdata(sym : ttypedconstsym);
  1566. { this does not affect the local stack space, since all
  1567. typed constansts and initialized variables are always
  1568. put in the .data / .rodata section
  1569. }
  1570. var
  1571. storefilepos : tfileposinfo;
  1572. curconstsegment : taasmoutput;
  1573. l : longint;
  1574. begin
  1575. storefilepos:=aktfilepos;
  1576. aktfilepos:=sym.fileinfo;
  1577. if sym.is_writable then
  1578. curconstsegment:=datasegment
  1579. else
  1580. curconstsegment:=consts;
  1581. l:=sym.getsize;
  1582. { insert cut for smartlinking or alignment }
  1583. maybe_new_object_file(curconstSegment);
  1584. new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
  1585. if (sym.owner.symtabletype=globalsymtable) or
  1586. maybe_smartlink_symbol or
  1587. (assigned(current_procinfo) and
  1588. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1589. DLLSource then
  1590. curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l))
  1591. else
  1592. curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l));
  1593. aktfilepos:=storefilepos;
  1594. end;
  1595. procedure insertbssdata(sym : tvarsym);
  1596. var
  1597. l,varalign : longint;
  1598. storefilepos : tfileposinfo;
  1599. begin
  1600. storefilepos:=aktfilepos;
  1601. aktfilepos:=sym.fileinfo;
  1602. l:=sym.getvaluesize;
  1603. if (vo_is_thread_var in sym.varoptions) then
  1604. inc(l,sizeof(aint));
  1605. varalign:=var_align(l);
  1606. maybe_new_object_file(bssSegment);
  1607. new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
  1608. if (sym.owner.symtabletype=globalsymtable) or
  1609. maybe_smartlink_symbol or
  1610. DLLSource or
  1611. (assigned(current_procinfo) and
  1612. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1613. (vo_is_exported in sym.varoptions) or
  1614. (vo_is_C_var in sym.varoptions) then
  1615. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1616. else
  1617. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1618. aktfilepos:=storefilepos;
  1619. end;
  1620. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1621. var
  1622. sym : tsym;
  1623. begin
  1624. sym:=tsym(st.symindex.first);
  1625. while assigned(sym) do
  1626. begin
  1627. { Only allocate space for referenced locals }
  1628. if (sym.typ=varsym) and
  1629. (tvarsym(sym).refs>0) then
  1630. begin
  1631. with tvarsym(sym) do
  1632. begin
  1633. {$warning TODO Add support for register variables}
  1634. localloc.loc:=LOC_REFERENCE;
  1635. tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
  1636. if cs_asm_source in aktglobalswitches then
  1637. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1638. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1639. end;
  1640. end;
  1641. sym:=tsym(sym.indexnext);
  1642. end;
  1643. end;
  1644. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1645. var
  1646. sym : tsym;
  1647. begin
  1648. sym:=tsym(st.symindex.first);
  1649. while assigned(sym) do
  1650. begin
  1651. if (sym.typ=varsym) and
  1652. (tvarsym(sym).refs>0) then
  1653. begin
  1654. with tvarsym(sym) do
  1655. begin
  1656. { Note: We need to keep the data available in memory
  1657. for the sub procedures that can access local data
  1658. in the parent procedures }
  1659. case localloc.loc of
  1660. LOC_REFERENCE :
  1661. tg.Ungetlocal(list,localloc.reference);
  1662. LOC_REGISTER :
  1663. begin
  1664. {$ifndef cpu64bit}
  1665. if localloc.size in [OS_64,OS_S64] then
  1666. begin
  1667. cg.ungetregister(list,localloc.registerlow);
  1668. cg.ungetregister(list,localloc.registerhigh);
  1669. end
  1670. else
  1671. {$endif cpu64bit}
  1672. cg.ungetregister(list,localloc.register);
  1673. end;
  1674. end;
  1675. end;
  1676. end;
  1677. sym:=tsym(sym.indexnext);
  1678. end;
  1679. end;
  1680. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1681. var
  1682. sym : tsym;
  1683. begin
  1684. sym:=tsym(st.symindex.first);
  1685. while assigned(sym) do
  1686. begin
  1687. if sym.typ=varsym then
  1688. begin
  1689. with tvarsym(sym) do
  1690. begin
  1691. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1692. begin
  1693. case paraitem.paraloc[calleeside].loc of
  1694. LOC_MMREGISTER,
  1695. LOC_FPUREGISTER,
  1696. LOC_REGISTER:
  1697. begin
  1698. (*
  1699. if paraitem.paraloc[calleeside].register=NR_NO then
  1700. begin
  1701. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1702. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1703. {$ifndef cpu64bit}
  1704. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1705. begin
  1706. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1707. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1708. end
  1709. else
  1710. {$endif cpu64bit}
  1711. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1712. end;
  1713. *)
  1714. (*
  1715. {$warning TODO Allocate register paras}
  1716. localloc.loc:=LOC_REGISTER;
  1717. localloc.size:=paraitem.paraloc[calleeside].size;
  1718. {$ifndef cpu64bit}
  1719. if localloc.size in [OS_64,OS_S64] then
  1720. begin
  1721. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1722. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1723. end
  1724. else
  1725. {$endif cpu64bit}
  1726. localloc.register:=cg.getregisterint(list,localloc.size);
  1727. *)
  1728. localloc.loc:=LOC_REFERENCE;
  1729. localloc.size:=paraitem.paraloc[calleeside].size;
  1730. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1731. end;
  1732. {$ifdef powerpc}
  1733. LOC_REFERENCE:
  1734. begin
  1735. localloc.loc := LOC_REFERENCE;
  1736. localloc.size:=paraitem.paraloc[calleeside].size;
  1737. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1738. end;
  1739. {$endif powerpc}
  1740. else
  1741. localloc:=paraitem.paraloc[calleeside];
  1742. end;
  1743. end
  1744. else
  1745. localloc:=paraitem.paraloc[calleeside];
  1746. if cs_asm_source in aktglobalswitches then
  1747. case localloc.loc of
  1748. LOC_REFERENCE :
  1749. begin
  1750. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1751. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1752. end;
  1753. end;
  1754. end;
  1755. end;
  1756. sym:=tsym(sym.indexnext);
  1757. end;
  1758. end;
  1759. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1760. var
  1761. sym : tsym;
  1762. begin
  1763. sym:=tsym(st.symindex.first);
  1764. while assigned(sym) do
  1765. begin
  1766. if sym.typ=varsym then
  1767. begin
  1768. with tvarsym(sym) do
  1769. begin
  1770. {$warning TODO Allocate register paras}
  1771. localloc.loc:=LOC_REFERENCE;
  1772. localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
  1773. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1774. if cs_asm_source in aktglobalswitches then
  1775. begin
  1776. case localloc.loc of
  1777. LOC_REFERENCE :
  1778. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1779. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1780. end;
  1781. end;
  1782. paraitem.paraloc[callerside]:=localloc;
  1783. paraitem.paraloc[calleeside]:=localloc;
  1784. end;
  1785. end;
  1786. sym:=tsym(sym.indexnext);
  1787. end;
  1788. end;
  1789. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1790. var
  1791. sym : tsym;
  1792. begin
  1793. sym:=tsym(st.symindex.first);
  1794. while assigned(sym) do
  1795. begin
  1796. if sym.typ=varsym then
  1797. begin
  1798. with tvarsym(sym) do
  1799. begin
  1800. { Note: We need to keep the data available in memory
  1801. for the sub procedures that can access local data
  1802. in the parent procedures }
  1803. case localloc.loc of
  1804. LOC_REFERENCE :
  1805. tg.UngetLocal(list,localloc.reference);
  1806. LOC_REGISTER :
  1807. begin
  1808. if localloc.register<>paraitem.paraloc[calleeside].register then
  1809. begin
  1810. {$ifndef cpu64bit}
  1811. if localloc.size in [OS_64,OS_S64] then
  1812. begin
  1813. cg.ungetregister(list,localloc.registerlow);
  1814. cg.ungetregister(list,localloc.registerhigh);
  1815. end
  1816. else
  1817. {$endif cpu64bit}
  1818. cg.ungetregister(list,localloc.register);
  1819. end;
  1820. end;
  1821. end;
  1822. end;
  1823. end;
  1824. sym:=tsym(sym.indexnext);
  1825. end;
  1826. end;
  1827. { persistent rtti generation }
  1828. procedure generate_rtti(p:Ttypesym);
  1829. var
  1830. rsym : trttisym;
  1831. def : tstoreddef;
  1832. begin
  1833. { rtti can only be generated for classes that are always typesyms }
  1834. def:=tstoreddef(ttypesym(p).restype.def);
  1835. { there is an error, skip rtti info }
  1836. if (def.deftype=errordef) or (Errorcount>0) then
  1837. exit;
  1838. { only create rtti once for each definition }
  1839. if not(df_has_rttitable in def.defoptions) then
  1840. begin
  1841. { definition should be in the same symtable as the symbol }
  1842. if p.owner<>def.owner then
  1843. internalerror(200108262);
  1844. { create rttisym }
  1845. rsym:=trttisym.create(p.name,fullrtti);
  1846. p.owner.insert(rsym);
  1847. { register rttisym in definition }
  1848. include(def.defoptions,df_has_rttitable);
  1849. def.rttitablesym:=rsym;
  1850. { write rtti data }
  1851. def.write_child_rtti_data(fullrtti);
  1852. maybe_new_object_file(rttilist);
  1853. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1854. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1855. def.write_rtti_data(fullrtti);
  1856. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1857. end;
  1858. end;
  1859. { persistent init table generation }
  1860. procedure generate_inittable(p:tsym);
  1861. var
  1862. rsym : trttisym;
  1863. def : tstoreddef;
  1864. begin
  1865. { anonymous types are also allowed for records that can be varsym }
  1866. case p.typ of
  1867. typesym :
  1868. def:=tstoreddef(ttypesym(p).restype.def);
  1869. varsym :
  1870. def:=tstoreddef(tvarsym(p).vartype.def);
  1871. else
  1872. internalerror(200108263);
  1873. end;
  1874. { only create inittable once for each definition }
  1875. if not(df_has_inittable in def.defoptions) then
  1876. begin
  1877. { definition should be in the same symtable as the symbol }
  1878. if p.owner<>def.owner then
  1879. internalerror(200108264);
  1880. { create rttisym }
  1881. rsym:=trttisym.create(p.name,initrtti);
  1882. p.owner.insert(rsym);
  1883. { register rttisym in definition }
  1884. include(def.defoptions,df_has_inittable);
  1885. def.inittablesym:=rsym;
  1886. { write inittable data }
  1887. def.write_child_rtti_data(initrtti);
  1888. maybe_new_object_file(rttilist);
  1889. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1890. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1891. def.write_rtti_data(initrtti);
  1892. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1893. end;
  1894. end;
  1895. end.
  1896. {
  1897. $Log$
  1898. Revision 1.209 2004-06-29 20:57:21 peter
  1899. * fixed size of exceptbuf
  1900. Revision 1.208 2004/06/20 08:55:29 florian
  1901. * logs truncated
  1902. Revision 1.207 2004/06/16 20:07:08 florian
  1903. * dwarf branch merged
  1904. Revision 1.206 2004/06/01 20:39:33 jonas
  1905. * fixed bug regarding parameters on the ppc (they were allocated twice
  1906. under some circumstances and not at all in others)
  1907. Revision 1.205 2004/05/30 21:41:15 jonas
  1908. * more regvar optimizations in location_force_reg
  1909. Revision 1.204 2004/05/30 21:18:22 jonas
  1910. * some optimizations and associated fixes for better regvar code
  1911. Revision 1.203 2004/05/28 21:14:13 peter
  1912. * first load para's to temps before calling entry code (profile
  1913. }