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