ncgutil.pas 85 KB

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