ngenutil.pas 60 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579
  1. {
  2. Copyright (c) 1998-2011 by Florian Klaempfl
  3. Generic version of some node tree helper routines that can be overridden
  4. by cpu-specific versions
  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 ngenutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,globtype,
  23. fmodule,
  24. aasmdata,
  25. node,nbas,symtype,symsym,symconst,symdef;
  26. type
  27. tinitfinalentry = record
  28. initfunc : TSymStr;
  29. finifunc : TSymStr;
  30. initpd : tprocdef;
  31. finipd : tprocdef;
  32. module : tmodule;
  33. end;
  34. pinitfinalentry = ^tinitfinalentry;
  35. tnodeutils = class
  36. class function call_fail_node:tnode; virtual;
  37. class function initialize_data_node(p:tnode; force: boolean):tnode; virtual;
  38. class function finalize_data_node(p:tnode):tnode; virtual;
  39. strict protected
  40. class procedure sym_maybe_initialize(p: TObject; arg: pointer);
  41. { generates the code for finalisation of local variables }
  42. class procedure local_varsyms_finalize(p:TObject;arg:pointer);
  43. { generates the code for finalization of static symtable and
  44. all local (static) typed consts }
  45. class procedure static_syms_finalize(p: TObject; arg: pointer);
  46. class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
  47. public
  48. class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
  49. class procedure procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);
  50. { returns true if the unit requires an initialisation section (e.g.,
  51. to force class constructors for the JVM target to initialise global
  52. records/arrays) }
  53. class function force_init: boolean; virtual;
  54. { idem for finalization }
  55. class function force_final: boolean; virtual;
  56. { if the funcretsym was moved to the parentfpstruct, use this method to
  57. move its value back back into the funcretsym before the function exit, as
  58. the code generator is hardcoded to use to use the funcretsym when loading
  59. the value to be returned; replacing it with an absolutevarsym that
  60. redirects to the field in the parentfpstruct doesn't work, as the code
  61. generator cannot deal with such symbols }
  62. class procedure load_parentfpstruct_nested_funcret(pd: tprocdef; var stat: tstatementnode);
  63. { called after parsing a routine with the code of the entire routine
  64. as argument; can be used to modify the node tree. By default handles
  65. insertion of code for systems that perform the typed constant
  66. initialisation via the node tree }
  67. class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
  68. { trashes a paravarsym or localvarsym if possible (not a managed type,
  69. "out" in case of parameter, ...) }
  70. class procedure maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode); virtual;
  71. strict protected
  72. { called from wrap_proc_body to insert the trashing for the wrapped
  73. routine's local variables and parameters }
  74. class function maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
  75. class function check_insert_trashing(pd: tprocdef): boolean; virtual;
  76. { callback called for every local variable and parameter by
  77. maybe_insert_trashing(), calls through to maybe_trash_variable() }
  78. class procedure maybe_trash_variable_callback(p: TObject; statn: pointer);
  79. { returns whether a particular sym can be trashed. If not,
  80. maybe_trash_variable won't do anything }
  81. class function trashable_sym(p: tsym): boolean; virtual;
  82. { trashing for 1/2/3/4/8-byte sized variables }
  83. class procedure trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode); virtual;
  84. { trashing for differently sized variables that those handled by
  85. trash_small() }
  86. class procedure trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64); virtual;
  87. { insert a single bss sym, called by insert bssdata (factored out
  88. non-common part for llvm) }
  89. class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); virtual;
  90. { initialization of iso styled program parameters }
  91. class procedure initialize_textrec(p : TObject; statn : pointer);
  92. { finalization of iso styled program parameters }
  93. class procedure finalize_textrec(p : TObject; statn : pointer);
  94. public
  95. class procedure insertbssdata(sym : tstaticvarsym); virtual;
  96. class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
  97. class procedure InsertInitFinalTable; virtual;
  98. protected
  99. class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal); virtual;
  100. class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal); virtual;
  101. class function get_init_final_list: tfplist;
  102. class procedure release_init_final_list(list:tfplist);
  103. public
  104. class procedure InsertThreadvarTablesTable; virtual;
  105. class procedure InsertThreadvars; virtual;
  106. class procedure InsertWideInitsTablesTable; virtual;
  107. class procedure InsertWideInits; virtual;
  108. class procedure InsertResStrInits; virtual;
  109. class procedure InsertResStrTablesTable; virtual;
  110. class procedure InsertResourceTablesTable; virtual;
  111. class procedure InsertResourceInfo(ResourcesUsed : boolean); virtual;
  112. class procedure InsertMemorySizes; virtual;
  113. { called right before an object is assembled, can be used to insert
  114. global information into the assembler list (used by LLVM to insert type
  115. info) }
  116. class procedure InsertObjectInfo; virtual;
  117. strict protected
  118. class procedure add_main_procdef_paras(pd: tdef); virtual;
  119. end;
  120. tnodeutilsclass = class of tnodeutils;
  121. const
  122. cnodeutils: tnodeutilsclass = tnodeutils;
  123. implementation
  124. uses
  125. verbose,version,globals,cutils,constexp,compinnr,
  126. systems,procinfo,pparautl,
  127. aasmbase,aasmtai,aasmcnst,
  128. symbase,symtable,defutil,
  129. nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nutils,
  130. ppu,
  131. pass_1;
  132. class function tnodeutils.call_fail_node:tnode;
  133. var
  134. para : tcallparanode;
  135. newstatement : tstatementnode;
  136. srsym : tsym;
  137. begin
  138. result:=internalstatements(newstatement);
  139. { call fail helper and exit normal }
  140. if is_class(current_structdef) then
  141. begin
  142. srsym:=search_struct_member(current_structdef,'FREEINSTANCE');
  143. if assigned(srsym) and
  144. (srsym.typ=procsym) then
  145. begin
  146. { if self<>0 and vmt<>0 then freeinstance }
  147. addstatement(newstatement,cifnode.create(
  148. caddnode.create(andn,
  149. caddnode.create(unequaln,
  150. load_self_pointer_node,
  151. cnilnode.create),
  152. caddnode.create(unequaln,
  153. load_vmt_pointer_node,
  154. cnilnode.create)),
  155. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[],nil),
  156. nil));
  157. end
  158. else
  159. internalerror(200305108);
  160. end
  161. else
  162. if is_object(current_structdef) then
  163. begin
  164. { parameter 3 : vmt_offset }
  165. { parameter 2 : pointer to vmt }
  166. { parameter 1 : self pointer }
  167. para:=ccallparanode.create(
  168. cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false),
  169. ccallparanode.create(
  170. ctypeconvnode.create_internal(
  171. load_vmt_pointer_node,
  172. voidpointertype),
  173. ccallparanode.create(
  174. ctypeconvnode.create_internal(
  175. load_self_pointer_node,
  176. voidpointertype),
  177. nil)));
  178. addstatement(newstatement,
  179. ccallnode.createintern('fpc_help_fail',para));
  180. end
  181. else
  182. internalerror(200305132);
  183. { self:=nil }
  184. addstatement(newstatement,cassignmentnode.create(
  185. load_self_pointer_node,
  186. cnilnode.create));
  187. { exit }
  188. addstatement(newstatement,cexitnode.create(nil));
  189. end;
  190. class function tnodeutils.initialize_data_node(p:tnode; force: boolean):tnode;
  191. begin
  192. { prevent initialisation of hidden syms that were moved to
  193. parentfpstructs: the original symbol isn't used anymore, the version
  194. in parentfpstruct will be initialised when that struct gets initialised,
  195. and references to it will actually be translated into references to the
  196. field in the parentfpstruct (so we'll initialise it twice) }
  197. if (target_info.system in systems_fpnestedstruct) and
  198. (p.nodetype=loadn) and
  199. (tloadnode(p).symtableentry.typ=localvarsym) and
  200. (tloadnode(p).symtableentry.visibility=vis_hidden) then
  201. begin
  202. p.free;
  203. result:=cnothingnode.create;
  204. end
  205. else
  206. begin
  207. if not assigned(p.resultdef) then
  208. typecheckpass(p);
  209. if is_ansistring(p.resultdef) or
  210. is_wide_or_unicode_string(p.resultdef) or
  211. is_interfacecom_or_dispinterface(p.resultdef) or
  212. is_dynamic_array(p.resultdef) then
  213. begin
  214. result:=cassignmentnode.create(
  215. ctypeconvnode.create_internal(p,voidpointertype),
  216. cnilnode.create
  217. );
  218. end
  219. else if (p.resultdef.typ=variantdef) then
  220. begin
  221. result:=ccallnode.createintern('fpc_variant_init',
  222. ccallparanode.create(
  223. ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef),
  224. nil));
  225. end
  226. else
  227. begin
  228. result:=ccallnode.createintern('fpc_initialize',
  229. ccallparanode.create(
  230. caddrnode.create_internal(
  231. crttinode.create(
  232. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  233. ccallparanode.create(
  234. caddrnode.create_internal(p),
  235. nil)));
  236. end;
  237. end;
  238. end;
  239. class function tnodeutils.finalize_data_node(p:tnode):tnode;
  240. var
  241. hs : string;
  242. begin
  243. { see comment in initialize_data_node above }
  244. if (target_info.system in systems_fpnestedstruct) and
  245. (p.nodetype=loadn) and
  246. (tloadnode(p).symtableentry.typ=localvarsym) and
  247. (tloadnode(p).symtableentry.visibility=vis_hidden) then
  248. begin
  249. p.free;
  250. result:=cnothingnode.create;
  251. end
  252. else
  253. begin
  254. if not assigned(p.resultdef) then
  255. typecheckpass(p);
  256. { 'decr_ref' suffix is somewhat misleading, all these helpers
  257. set the passed pointer to nil now }
  258. if is_ansistring(p.resultdef) then
  259. hs:='fpc_ansistr_decr_ref'
  260. else if is_widestring(p.resultdef) then
  261. hs:='fpc_widestr_decr_ref'
  262. else if is_unicodestring(p.resultdef) then
  263. hs:='fpc_unicodestr_decr_ref'
  264. else if is_interfacecom_or_dispinterface(p.resultdef) then
  265. hs:='fpc_intf_decr_ref'
  266. else
  267. hs:='';
  268. if hs<>'' then
  269. result:=ccallnode.createintern(hs,
  270. ccallparanode.create(
  271. ctypeconvnode.create_internal(p,voidpointertype),
  272. nil))
  273. else if p.resultdef.typ=variantdef then
  274. begin
  275. result:=ccallnode.createintern('fpc_variant_clear',
  276. ccallparanode.create(
  277. ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef),
  278. nil));
  279. end
  280. else
  281. result:=ccallnode.createintern('fpc_finalize',
  282. ccallparanode.create(
  283. caddrnode.create_internal(
  284. crttinode.create(
  285. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  286. ccallparanode.create(
  287. caddrnode.create_internal(p),
  288. nil)));
  289. end;
  290. end;
  291. class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer);
  292. begin
  293. if ((tsym(p).typ = localvarsym) or
  294. { check staticvarsym for record management opeators and for objects
  295. which might contain record with management operators }
  296. ((tsym(p).typ = staticvarsym) and
  297. (
  298. (tabstractvarsym(p).vardef is trecorddef) or
  299. (
  300. (tabstractvarsym(p).vardef is tobjectdef) and
  301. (tobjectdef(tabstractvarsym(p).vardef).objecttype = odt_object)
  302. )
  303. )
  304. )
  305. ) and
  306. { local (procedure or unit) variables only need initialization if
  307. they are used }
  308. ((tabstractvarsym(p).refs>0) or
  309. { managed return symbols must be inited }
  310. ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
  311. ) and
  312. not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
  313. not(vo_is_external in tabstractvarsym(p).varoptions) and
  314. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  315. (is_managed_type(tabstractvarsym(p).vardef) or
  316. ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
  317. ) then
  318. begin
  319. addstatement(tstatementnode(arg^),initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false));
  320. end;
  321. end;
  322. class procedure tnodeutils.local_varsyms_finalize(p: TObject; arg: pointer);
  323. begin
  324. if (tsym(p).typ=localvarsym) and
  325. (tlocalvarsym(p).refs>0) and
  326. not(vo_is_external in tlocalvarsym(p).varoptions) and
  327. not(vo_is_funcret in tlocalvarsym(p).varoptions) and
  328. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  329. is_managed_type(tlocalvarsym(p).vardef) then
  330. sym_maybe_finalize(tstatementnode(arg^),tsym(p));
  331. end;
  332. class procedure tnodeutils.static_syms_finalize(p: TObject; arg: pointer);
  333. var
  334. i : longint;
  335. pd : tprocdef;
  336. begin
  337. case tsym(p).typ of
  338. staticvarsym :
  339. begin
  340. { local (procedure or unit) variables only need finalization
  341. if they are used
  342. }
  343. if ((tstaticvarsym(p).refs>0) or
  344. { global (unit) variables always need finalization, since
  345. they may also be used in another unit
  346. }
  347. (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
  348. (
  349. (tstaticvarsym(p).varspez<>vs_const) or
  350. (vo_force_finalize in tstaticvarsym(p).varoptions)
  351. ) and
  352. not(vo_is_funcret in tstaticvarsym(p).varoptions) and
  353. not(vo_is_external in tstaticvarsym(p).varoptions) and
  354. is_managed_type(tstaticvarsym(p).vardef) and
  355. not (
  356. assigned(tstaticvarsym(p).fieldvarsym) and
  357. assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
  358. (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
  359. )
  360. then
  361. sym_maybe_finalize(tstatementnode(arg^),tsym(p));
  362. end;
  363. procsym :
  364. begin
  365. for i:=0 to tprocsym(p).ProcdefList.Count-1 do
  366. begin
  367. pd:=tprocdef(tprocsym(p).ProcdefList[i]);
  368. if assigned(pd.localst) and
  369. (pd.procsym=tprocsym(p)) and
  370. (pd.localst.symtabletype<>staticsymtable) then
  371. pd.localst.SymList.ForEachCall(@static_syms_finalize,arg);
  372. end;
  373. end;
  374. end;
  375. end;
  376. class procedure tnodeutils.sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
  377. var
  378. hp: tnode;
  379. begin
  380. include(current_procinfo.flags,pi_needs_implicit_finally);
  381. hp:=cloadnode.create(sym,sym.owner);
  382. if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
  383. include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
  384. addstatement(stat,finalize_data_node(hp));
  385. end;
  386. class procedure tnodeutils.procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
  387. begin
  388. { initialize local data like ansistrings }
  389. case pd.proctypeoption of
  390. potype_unitinit:
  391. begin
  392. { this is also used for initialization of variables in a
  393. program which does not have a globalsymtable }
  394. if assigned(current_module.globalsymtable) then
  395. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
  396. TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
  397. end;
  398. { units have seperate code for initilization and finalization }
  399. potype_unitfinalize: ;
  400. { program init/final is generated in separate procedure }
  401. potype_proginit: ;
  402. else
  403. current_procinfo.procdef.localst.SymList.ForEachCall(@sym_maybe_initialize,@stat);
  404. end;
  405. end;
  406. class procedure tnodeutils.procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);
  407. begin
  408. { no finalization in exceptfilters, they /are/ the finalization code }
  409. if current_procinfo.procdef.proctypeoption=potype_exceptfilter then
  410. exit;
  411. { finalize local data like ansistrings}
  412. case current_procinfo.procdef.proctypeoption of
  413. potype_unitfinalize:
  414. begin
  415. { this is also used for initialization of variables in a
  416. program which does not have a globalsymtable }
  417. if assigned(current_module.globalsymtable) then
  418. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@static_syms_finalize,@stat);
  419. TSymtable(current_module.localsymtable).SymList.ForEachCall(@static_syms_finalize,@stat);
  420. end;
  421. { units/progs have separate code for initialization and finalization }
  422. potype_unitinit: ;
  423. { program init/final is generated in separate procedure }
  424. potype_proginit: ;
  425. else
  426. current_procinfo.procdef.localst.SymList.ForEachCall(@local_varsyms_finalize,@stat);
  427. end;
  428. end;
  429. class function tnodeutils.force_init: boolean;
  430. begin
  431. result:=
  432. (target_info.system in systems_typed_constants_node_init) and
  433. assigned(current_module.tcinitcode);
  434. end;
  435. class function tnodeutils.force_final: boolean;
  436. begin
  437. result:=false;
  438. end;
  439. class procedure tnodeutils.initialize_textrec(p:TObject;statn:pointer);
  440. var
  441. stat: ^tstatementnode absolute statn;
  442. begin
  443. if (tsym(p).typ=staticvarsym) and
  444. (tstaticvarsym(p).vardef.typ=filedef) and
  445. (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
  446. (tstaticvarsym(p).isoindex<>0) then
  447. begin
  448. if cs_transparent_file_names in current_settings.globalswitches then
  449. addstatement(stat^,ccallnode.createintern('fpc_textinit_filename_iso',
  450. ccallparanode.create(
  451. cstringconstnode.createstr(tstaticvarsym(p).Name),
  452. ccallparanode.create(
  453. cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
  454. ccallparanode.create(
  455. cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
  456. nil)))))
  457. else
  458. addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
  459. ccallparanode.create(
  460. cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
  461. ccallparanode.create(
  462. cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
  463. nil))));
  464. end;
  465. end;
  466. class procedure tnodeutils.finalize_textrec(p:TObject;statn:pointer);
  467. var
  468. stat: ^tstatementnode absolute statn;
  469. begin
  470. if (tsym(p).typ=staticvarsym) and
  471. (tstaticvarsym(p).vardef.typ=filedef) and
  472. (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
  473. (tstaticvarsym(p).isoindex<>0) then
  474. begin
  475. addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
  476. ccallparanode.create(
  477. cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
  478. nil)));
  479. end;
  480. end;
  481. class procedure tnodeutils.load_parentfpstruct_nested_funcret(pd: tprocdef; var stat: tstatementnode);
  482. var
  483. target: tnode;
  484. begin
  485. target:=cloadnode.create(pd.funcretsym, pd.funcretsym.owner);
  486. { ensure the target of this assignment doesn't translate the
  487. funcretsym also to its alias in the parentfpstruct }
  488. include(target.flags, nf_internal);
  489. addstatement(stat,
  490. cassignmentnode.create(
  491. target, cloadnode.create(pd.funcretsym, pd.funcretsym.owner)
  492. )
  493. );
  494. end;
  495. class function tnodeutils.wrap_proc_body(pd: tprocdef; n: tnode): tnode;
  496. var
  497. stat: tstatementnode;
  498. block: tnode;
  499. psym: tsym;
  500. begin
  501. result:=maybe_insert_trashing(pd,n);
  502. if (m_isolike_program_para in current_settings.modeswitches) and
  503. (pd.proctypeoption=potype_proginit) then
  504. begin
  505. block:=internalstatements(stat);
  506. pd.localst.SymList.ForEachCall(@initialize_textrec,@stat);
  507. addstatement(stat,result);
  508. pd.localst.SymList.ForEachCall(@finalize_textrec,@stat);
  509. result:=block;
  510. end;
  511. if target_info.system in systems_typed_constants_node_init then
  512. begin
  513. case pd.proctypeoption of
  514. potype_class_constructor:
  515. begin
  516. { even though the initialisation code for typed constants may
  517. not yet be complete at this point (there may be more inside
  518. method definitions coming after this class constructor), the
  519. ones from inside the class definition have already been parsed.
  520. in case of $j-, these are marked "final" in Java and such
  521. static fields must be initialsed in the class constructor
  522. itself -> add them here }
  523. block:=internalstatements(stat);
  524. if assigned(pd.struct.tcinitcode) then
  525. begin
  526. addstatement(stat,pd.struct.tcinitcode);
  527. pd.struct.tcinitcode:=nil;
  528. end;
  529. psym:=tsym(pd.struct.symtable.find('FPC_INIT_TYPED_CONSTS_HELPER'));
  530. if assigned(psym) then
  531. begin
  532. if (psym.typ<>procsym) or
  533. (tprocsym(psym).procdeflist.count<>1) then
  534. internalerror(2011040301);
  535. addstatement(stat,ccallnode.create(nil,tprocsym(psym),
  536. pd.struct.symtable,nil,[],nil));
  537. end;
  538. addstatement(stat,result);
  539. result:=block
  540. end;
  541. potype_unitinit:
  542. begin
  543. if assigned(current_module.tcinitcode) then
  544. begin
  545. block:=internalstatements(stat);
  546. addstatement(stat,tnode(current_module.tcinitcode));
  547. current_module.tcinitcode:=nil;
  548. addstatement(stat,result);
  549. result:=block;
  550. end;
  551. end;
  552. else case pd.synthetickind of
  553. tsk_tcinit:
  554. begin
  555. if assigned(pd.struct.tcinitcode) then
  556. begin
  557. block:=internalstatements(stat);
  558. addstatement(stat,pd.struct.tcinitcode);
  559. pd.struct.tcinitcode:=nil;
  560. addstatement(stat,result);
  561. result:=block
  562. end
  563. end;
  564. end;
  565. end;
  566. end;
  567. if target_info.system in systems_fpnestedstruct then
  568. begin
  569. if assigned(pd.funcretsym) and
  570. tabstractnormalvarsym(pd.funcretsym).inparentfpstruct then
  571. begin
  572. block:=internalstatements(stat);
  573. addstatement(stat,result);
  574. load_parentfpstruct_nested_funcret(pd,stat);
  575. result:=block;
  576. end;
  577. end;
  578. end;
  579. class function tnodeutils.maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
  580. var
  581. stat: tstatementnode;
  582. begin
  583. result:=n;
  584. if check_insert_trashing(pd) then
  585. begin
  586. result:=internalstatements(stat);
  587. pd.parast.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
  588. pd.localst.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
  589. addstatement(stat,n);
  590. end;
  591. end;
  592. class function tnodeutils.check_insert_trashing(pd: tprocdef): boolean;
  593. begin
  594. result:=
  595. (localvartrashing<>-1) and
  596. not(po_assembler in pd.procoptions);
  597. end;
  598. class function tnodeutils.trashable_sym(p: tsym): boolean;
  599. begin
  600. result:=
  601. ((p.typ=localvarsym) or
  602. ((p.typ=paravarsym) and
  603. ((vo_is_funcret in tabstractnormalvarsym(p).varoptions) or
  604. (tabstractnormalvarsym(p).varspez=vs_out)))) and
  605. not (vo_is_default_var in tabstractnormalvarsym(p).varoptions) and
  606. (not is_managed_type(tabstractnormalvarsym(p).vardef) or
  607. (is_string(tabstractnormalvarsym(p).vardef) and
  608. (vo_is_funcret in tabstractnormalvarsym(p).varoptions)
  609. )
  610. ) and
  611. not assigned(tabstractnormalvarsym(p).defaultconstsym);
  612. end;
  613. class procedure tnodeutils.maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode);
  614. var
  615. size: asizeint;
  616. trashintval: int64;
  617. begin
  618. if trashable_sym(p) then
  619. begin
  620. trashintval:=trashintvalues[localvartrashing];
  621. if (p.vardef.typ=procvardef) and
  622. ([m_tp_procvar,m_mac_procvar]*current_settings.modeswitches<>[]) then
  623. begin
  624. if tprocvardef(p.vardef).is_addressonly then
  625. { in tp/delphi mode, you need @procvar to get at the contents of
  626. a procvar ... }
  627. trashn:=caddrnode.create(trashn)
  628. else
  629. { ... but if it's a procedure of object, that will only return
  630. the procedure address -> cast to tmethod instead }
  631. trashn:=ctypeconvnode.create_explicit(trashn,methodpointertype);
  632. end;
  633. if is_managed_type(p.vardef) then
  634. begin
  635. if is_string(p.vardef) then
  636. trash_small(stat,trashn,
  637. cstringconstnode.createstr(
  638. 'uninitialized function result in '+
  639. tprocdef(p.owner.defowner).customprocname([pno_proctypeoption, pno_paranames,pno_ownername, pno_noclassmarker])
  640. )
  641. )
  642. else
  643. internalerror(2016030601);
  644. end
  645. else if ((p.typ=localvarsym) and
  646. (not(vo_is_funcret in p.varoptions) or
  647. not is_shortstring(p.vardef))) or
  648. ((p.typ=paravarsym) and
  649. not is_shortstring(p.vardef)) then
  650. begin
  651. size:=p.getsize;
  652. case size of
  653. 0:
  654. begin
  655. { open array -> at least size 1. Can also be zero-sized
  656. record, so check it's actually an array }
  657. if p.vardef.typ=arraydef then
  658. trash_large(stat,trashn,caddnode.create(addn,cinlinenode.create(in_high_x,false,trashn.getcopy),genintconstnode(1)),trashintval)
  659. else
  660. trashn.free;
  661. end;
  662. 1: trash_small(stat,
  663. ctypeconvnode.create_internal(trashn,s8inttype),
  664. genintconstnode(shortint(trashintval)));
  665. 2: trash_small(stat,
  666. ctypeconvnode.create_internal(trashn,s16inttype),
  667. genintconstnode(smallint(trashintval)));
  668. 4: trash_small(stat,
  669. ctypeconvnode.create_internal(trashn,s32inttype),
  670. genintconstnode(longint(trashintval)));
  671. 8: trash_small(stat,
  672. ctypeconvnode.create_internal(trashn,s64inttype),
  673. genintconstnode(int64(trashintval)));
  674. else
  675. trash_large(stat,trashn,genintconstnode(size),trashintval);
  676. end;
  677. end
  678. else
  679. begin
  680. { may be an open string, even if is_open_string() returns false
  681. (for some helpers in the system unit) }
  682. { an open string has at least size 2 }
  683. trash_small(stat,
  684. cvecnode.create(trashn.getcopy,genintconstnode(0)),
  685. cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
  686. trash_small(stat,
  687. cvecnode.create(trashn,genintconstnode(1)),
  688. cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
  689. end;
  690. end
  691. else
  692. trashn.free;
  693. end;
  694. class procedure tnodeutils.maybe_trash_variable_callback(p:TObject;statn:pointer);
  695. var
  696. stat: ^tstatementnode absolute statn;
  697. begin
  698. if not(tsym(p).typ in [localvarsym,paravarsym]) then
  699. exit;
  700. maybe_trash_variable(stat^,tabstractnormalvarsym(p),cloadnode.create(tsym(p),tsym(p).owner));
  701. end;
  702. class procedure tnodeutils.trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode);
  703. begin
  704. addstatement(stat,cassignmentnode.create(trashn,trashvaln));
  705. end;
  706. class procedure tnodeutils.trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64);
  707. begin
  708. addstatement(stat,ccallnode.createintern('fpc_fillmem',
  709. ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
  710. ccallparanode.Create(sizen,
  711. ccallparanode.Create(trashn,nil)))
  712. ));
  713. end;
  714. class procedure tnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint);
  715. begin
  716. if sym.globalasmsym then
  717. begin
  718. { on AIX/stabx, we cannot generate debug information that encodes
  719. the address of a global symbol, you need a symbol with the same
  720. name as the identifier -> create an extra *local* symbol.
  721. Moreover, such a local symbol will be removed if it's not
  722. referenced anywhere, so also create a reference }
  723. if (target_dbg.id=dbg_stabx) and
  724. (cs_debuginfo in current_settings.moduleswitches) and
  725. not assigned(current_asmdata.GetAsmSymbol(sym.name)) then
  726. begin
  727. list.concat(tai_symbol.Create(current_asmdata.DefineAsmSymbol(sym.name,AB_LOCAL,AT_DATA,sym.vardef),0));
  728. list.concat(tai_directive.Create(asd_reference,sym.name));
  729. end;
  730. list.concat(Tai_datablock.create_global(sym.mangledname,size,sym.vardef));
  731. end
  732. else
  733. list.concat(Tai_datablock.create(sym.mangledname,size,sym.vardef));
  734. end;
  735. class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
  736. var
  737. l : asizeint;
  738. varalign : shortint;
  739. storefilepos : tfileposinfo;
  740. list : TAsmList;
  741. sectype : TAsmSectiontype;
  742. begin
  743. storefilepos:=current_filepos;
  744. current_filepos:=sym.fileinfo;
  745. l:=sym.getsize;
  746. varalign:=sym.vardef.alignment;
  747. if (varalign=0) then
  748. varalign:=var_align_size(l)
  749. else
  750. varalign:=var_align(varalign);
  751. if tf_section_threadvars in target_info.flags then
  752. begin
  753. if (vo_is_thread_var in sym.varoptions) then
  754. begin
  755. list:=current_asmdata.asmlists[al_threadvars];
  756. sectype:=sec_threadvar;
  757. end
  758. else
  759. begin
  760. list:=current_asmdata.asmlists[al_globals];
  761. sectype:=sec_bss;
  762. end;
  763. end
  764. else
  765. begin
  766. if (vo_is_thread_var in sym.varoptions) then
  767. begin
  768. inc(l,sizeof(pint));
  769. { it doesn't help to set a higher alignment, as }
  770. { the first sizeof(pint) bytes field will offset }
  771. { everything anyway }
  772. varalign:=sizeof(pint);
  773. end;
  774. list:=current_asmdata.asmlists[al_globals];
  775. sectype:=sec_bss;
  776. end;
  777. maybe_new_object_file(list);
  778. if vo_has_section in sym.varoptions then
  779. new_section(list,sec_user,sym.section,varalign)
  780. else
  781. new_section(list,sectype,lower(sym.mangledname),varalign);
  782. insertbsssym(list,sym,l,varalign);
  783. current_filepos:=storefilepos;
  784. end;
  785. class function tnodeutils.create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef;
  786. var
  787. pd: tprocdef;
  788. begin
  789. if potype<>potype_mainstub then
  790. pd:=cprocdef.create(main_program_level,true)
  791. else
  792. pd:=cprocdef.create(normal_function_level,true);
  793. { always register the def }
  794. pd.register_def;
  795. pd.procsym:=ps;
  796. ps.ProcdefList.Add(pd);
  797. include(pd.procoptions,po_global);
  798. { set procdef options }
  799. pd.proctypeoption:=potype;
  800. pd.proccalloption:=pocall_default;
  801. include(pd.procoptions,po_hascallingconvention);
  802. pd.forwarddef:=false;
  803. { may be required to calculate the mangled name }
  804. add_main_procdef_paras(pd);
  805. pd.setmangledname(name);
  806. { the mainstub is generated via a synthetic proc -> parsed via
  807. psub.read_proc_body() -> that one will insert the mangled name in the
  808. alias names already }
  809. if potype<>potype_mainstub then
  810. pd.aliasnames.insert(pd.mangledname);
  811. result:=pd;
  812. end;
  813. procedure AddToStructInits(p:TObject;arg:pointer);
  814. var
  815. StructList: TFPList absolute arg;
  816. begin
  817. if (tdef(p).typ in [objectdef,recorddef]) and
  818. not (df_generic in tdef(p).defoptions) then
  819. begin
  820. { first add the class... }
  821. if ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
  822. StructList.Add(p);
  823. { ... and then also add all subclasses }
  824. tabstractrecorddef(p).symtable.deflist.foreachcall(@AddToStructInits,arg);
  825. end;
  826. end;
  827. class function tnodeutils.get_init_final_list:tfplist;
  828. procedure append_struct_inits(u:tmodule);
  829. var
  830. i : integer;
  831. structlist : tfplist;
  832. pd : tprocdef;
  833. entry : pinitfinalentry;
  834. begin
  835. structlist:=tfplist.Create;
  836. if assigned(u.globalsymtable) then
  837. u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
  838. u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
  839. { write structures }
  840. for i:=0 to structlist.Count-1 do
  841. begin
  842. new(entry);
  843. entry^.module:=u;
  844. pd:=tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
  845. if assigned(pd) then
  846. begin
  847. entry^.initfunc:=pd.mangledname;
  848. entry^.initpd:=pd;
  849. end
  850. else
  851. begin
  852. entry^.initfunc:='';
  853. entry^.initpd:=nil;
  854. end;
  855. pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
  856. if assigned(pd) then
  857. begin
  858. entry^.finifunc:=pd.mangledname;
  859. entry^.finipd:=pd;
  860. end
  861. else
  862. begin
  863. entry^.finifunc:='';
  864. entry^.finipd:=nil;
  865. end;
  866. if assigned(entry^.finipd) or assigned(entry^.initpd) then
  867. result.add(entry)
  868. else
  869. { AddToStructInits only adds structs that have either a class constructor or destructor or both }
  870. internalerror(2017051902);
  871. end;
  872. structlist.free;
  873. end;
  874. var
  875. hp : tused_unit;
  876. entry : pinitfinalentry;
  877. begin
  878. result:=tfplist.create;
  879. hp:=tused_unit(usedunits.first);
  880. while assigned(hp) do
  881. begin
  882. { insert class constructors/destructors of the unit }
  883. if (hp.u.flags and uf_classinits) <> 0 then
  884. append_struct_inits(hp.u);
  885. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  886. begin
  887. new(entry);
  888. entry^.module:=hp.u;
  889. entry^.initpd:=nil;
  890. entry^.finipd:=nil;
  891. if (hp.u.flags and uf_init)<>0 then
  892. entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
  893. else
  894. entry^.initfunc:='';
  895. if (hp.u.flags and uf_finalize)<>0 then
  896. entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
  897. else
  898. entry^.finifunc:='';
  899. result.add(entry);
  900. end;
  901. hp:=tused_unit(hp.next);
  902. end;
  903. if (current_module.flags and uf_classinits) <> 0 then
  904. append_struct_inits(current_module);
  905. { Insert initialization/finalization of the program }
  906. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  907. begin
  908. new(entry);
  909. entry^.module:=current_module;
  910. entry^.initpd:=nil;
  911. entry^.finipd:=nil;
  912. if (current_module.flags and uf_init)<>0 then
  913. entry^.initfunc:=make_mangledname('INIT$',current_module.localsymtable,'')
  914. else
  915. entry^.initfunc:='';
  916. if (current_module.flags and uf_finalize)<>0 then
  917. entry^.finifunc:=make_mangledname('FINALIZE$',current_module.localsymtable,'')
  918. else
  919. entry^.finifunc:='';
  920. result.add(entry);
  921. end;
  922. end;
  923. class procedure tnodeutils.release_init_final_list(list:tfplist);
  924. var
  925. i : longint;
  926. begin
  927. if not assigned(list) then
  928. internalerror(2017051901);
  929. for i:=0 to list.count-1 do
  930. dispose(pinitfinalentry(list[i]));
  931. list.free;
  932. end;
  933. class procedure tnodeutils.InsertInitFinalTable;
  934. var
  935. i : longint;
  936. unitinits : ttai_typedconstbuilder;
  937. nameinit,namefini : TSymStr;
  938. tabledef: tdef;
  939. entries : tfplist;
  940. entry : pinitfinalentry;
  941. procedure add_initfinal_import(symtable:tsymtable);
  942. var
  943. i,j : longint;
  944. foundinit,foundfini : boolean;
  945. sym : TSymEntry;
  946. pd : tprocdef;
  947. begin
  948. if (nameinit='') and (namefini='') then
  949. exit;
  950. foundinit:=nameinit='';
  951. foundfini:=namefini='';
  952. for i:=0 to symtable.SymList.Count-1 do
  953. begin
  954. sym:=tsymentry(symtable.SymList[i]);
  955. if sym.typ<>procsym then
  956. continue;
  957. for j:=0 to tprocsym(sym).procdeflist.count-1 do
  958. begin
  959. pd:=tprocdef(tprocsym(sym).procdeflist[j]);
  960. if (nameinit<>'') and not foundinit and pd.has_alias_name(nameinit) then
  961. begin
  962. current_module.addimportedsym(sym);
  963. foundinit:=true;
  964. end;
  965. if (namefini<>'') and not foundfini and pd.has_alias_name(namefini) then
  966. begin
  967. current_module.addimportedsym(sym);
  968. foundfini:=true;
  969. end;
  970. if foundinit and foundfini then
  971. break;
  972. end;
  973. if foundinit and foundfini then
  974. break;
  975. end;
  976. if not foundinit or not foundfini then
  977. internalerror(2016041401);
  978. end;
  979. begin
  980. unitinits:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  981. unitinits.begin_anonymous_record('',default_settings.packrecords,sizeof(pint),
  982. targetinfos[target_info.system]^.alignment.recordalignmin,
  983. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  984. entries:=get_init_final_list;
  985. { tablecount }
  986. unitinits.emit_ord_const(entries.count,aluuinttype);
  987. { initcount (initialised at run time }
  988. unitinits.emit_ord_const(0,aluuinttype);
  989. for i:=0 to entries.count-1 do
  990. begin
  991. entry:=pinitfinalentry(entries[i]);
  992. if assigned(entry^.initpd) or assigned(entry^.finipd) then
  993. begin
  994. if assigned(entry^.initpd) then
  995. begin
  996. unitinits.emit_procdef_const(entry^.initpd);
  997. if entry^.module<>current_module then
  998. current_module.addimportedsym(entry^.initpd.procsym);
  999. end
  1000. else
  1001. unitinits.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype);
  1002. if assigned(entry^.finipd) then
  1003. begin
  1004. unitinits.emit_procdef_const(entry^.finipd);
  1005. if entry^.module<>current_module then
  1006. current_module.addimportedsym(entry^.finipd.procsym);
  1007. end
  1008. else
  1009. unitinits.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype);
  1010. end
  1011. else
  1012. begin
  1013. nameinit:='';
  1014. namefini:='';
  1015. if entry^.initfunc<>'' then
  1016. begin
  1017. nameinit:=entry^.initfunc;
  1018. unitinits.emit_tai(
  1019. Tai_const.Createname(nameinit,AT_FUNCTION,0),
  1020. voidcodepointertype);
  1021. end
  1022. else
  1023. unitinits.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype);
  1024. if entry^.finifunc<>'' then
  1025. begin
  1026. namefini:=entry^.finifunc;
  1027. unitinits.emit_tai(
  1028. Tai_const.Createname(namefini,AT_FUNCTION,0),
  1029. voidcodepointertype);
  1030. end
  1031. else
  1032. unitinits.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype);
  1033. if entry^.module<>current_module then
  1034. add_initfinal_import(entry^.module.localsymtable);
  1035. end;
  1036. end;
  1037. release_init_final_list(entries);
  1038. { Add to data segment }
  1039. tabledef:=unitinits.end_anonymous_record;
  1040. current_asmdata.asmlists[al_globals].concatlist(
  1041. unitinits.get_final_asmlist(
  1042. current_asmdata.DefineAsmSymbol('INITFINAL',AB_GLOBAL,AT_DATA,tabledef),
  1043. tabledef,
  1044. sec_data,'INITFINAL',sizeof(pint)
  1045. )
  1046. );
  1047. unitinits.free;
  1048. end;
  1049. class procedure tnodeutils.InsertThreadvarTablesTable;
  1050. var
  1051. hp : tused_unit;
  1052. tcb: ttai_typedconstbuilder;
  1053. count: longint;
  1054. sym: tasmsymbol;
  1055. placeholder: ttypedconstplaceholder;
  1056. tabledef: tdef;
  1057. begin
  1058. if (tf_section_threadvars in target_info.flags) then
  1059. exit;
  1060. count:=0;
  1061. tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  1062. tcb.begin_anonymous_record('',1,sizeof(pint),
  1063. targetinfos[target_info.system]^.alignment.recordalignmin,
  1064. targetinfos[target_info.system]^.alignment.maxCrecordalign
  1065. );
  1066. placeholder:=tcb.emit_placeholder(u32inttype);
  1067. hp:=tused_unit(usedunits.first);
  1068. while assigned(hp) do
  1069. begin
  1070. if (hp.u.flags and uf_threadvars)=uf_threadvars then
  1071. begin
  1072. sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,true);
  1073. tcb.emit_tai(
  1074. tai_const.Create_sym(sym),
  1075. voidpointertype);
  1076. current_module.add_extern_asmsym(sym);
  1077. inc(count);
  1078. end;
  1079. hp:=tused_unit(hp.next);
  1080. end;
  1081. { Add program threadvars, if any }
  1082. if (current_module.flags and uf_threadvars)=uf_threadvars then
  1083. begin
  1084. sym:=current_asmdata.RefAsmSymbol(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,true);
  1085. tcb.emit_tai(
  1086. Tai_const.Create_sym(sym),
  1087. voidpointertype);
  1088. inc(count);
  1089. end;
  1090. { set the count at the start }
  1091. placeholder.replace(tai_const.Create_32bit(count),u32inttype);
  1092. placeholder.free;
  1093. { insert in data segment }
  1094. tabledef:=tcb.end_anonymous_record;
  1095. sym:=current_asmdata.DefineAsmSymbol('FPC_THREADVARTABLES',AB_GLOBAL,AT_DATA,tabledef);
  1096. current_asmdata.asmlists[al_globals].concatlist(
  1097. tcb.get_final_asmlist(
  1098. sym,tabledef,sec_data,'FPC_THREADVARTABLES',sizeof(pint)
  1099. )
  1100. );
  1101. tcb.free;
  1102. end;
  1103. procedure AddToThreadvarList(p:TObject;arg:pointer);
  1104. var
  1105. tcb: ttai_typedconstbuilder;
  1106. field1, field2: tsym;
  1107. begin
  1108. if (tsym(p).typ=staticvarsym) and
  1109. (vo_is_thread_var in tstaticvarsym(p).varoptions) then
  1110. begin
  1111. tcb:=ttai_typedconstbuilder(arg);
  1112. { address of threadvar }
  1113. tcb.emit_tai(tai_const.Createname(tstaticvarsym(p).mangledname,0),
  1114. cpointerdef.getreusable(
  1115. get_threadvar_record(tstaticvarsym(p).vardef,field1,field2)
  1116. )
  1117. );
  1118. { size of threadvar }
  1119. tcb.emit_ord_const(tstaticvarsym(p).getsize,u32inttype);
  1120. end;
  1121. end;
  1122. class procedure tnodeutils.InsertThreadvars;
  1123. var
  1124. s : string;
  1125. tcb: ttai_typedconstbuilder;
  1126. sym: tasmsymbol;
  1127. tabledef: trecorddef;
  1128. add : boolean;
  1129. begin
  1130. if (tf_section_threadvars in target_info.flags) then
  1131. exit;
  1132. tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  1133. tabledef:=tcb.begin_anonymous_record('',1,sizeof(pint),
  1134. targetinfos[target_info.system]^.alignment.recordalignmin,
  1135. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1136. if assigned(current_module.globalsymtable) then
  1137. current_module.globalsymtable.SymList.ForEachCall(@AddToThreadvarList,tcb);
  1138. current_module.localsymtable.SymList.ForEachCall(@AddToThreadvarList,tcb);
  1139. if trecordsymtable(tabledef.symtable).datasize<>0 then
  1140. { terminator }
  1141. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  1142. tcb.end_anonymous_record;
  1143. add:=trecordsymtable(tabledef.symtable).datasize<>0;
  1144. if add then
  1145. begin
  1146. s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
  1147. sym:=current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA_FORCEINDIRECT,tabledef);
  1148. current_asmdata.asmlists[al_globals].concatlist(
  1149. tcb.get_final_asmlist(sym,tabledef,sec_data,s,sizeof(pint)));
  1150. current_module.flags:=current_module.flags or uf_threadvars;
  1151. current_module.add_public_asmsym(sym);
  1152. end
  1153. else
  1154. s:='';
  1155. tcb.Free;
  1156. end;
  1157. class procedure tnodeutils.InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal);
  1158. var
  1159. hp: tused_unit;
  1160. tcb: ttai_typedconstbuilder;
  1161. countplaceholder: ttypedconstplaceholder;
  1162. tabledef: tdef;
  1163. count: longint;
  1164. begin
  1165. tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  1166. tcb.begin_anonymous_record('',default_settings.packrecords,sizeof(pint),
  1167. targetinfos[target_info.system]^.alignment.recordalignmin,
  1168. targetinfos[target_info.system]^.alignment.maxCrecordalign
  1169. );
  1170. { placeholder for the count }
  1171. countplaceholder:=tcb.emit_placeholder(sizesinttype);
  1172. count:=0;
  1173. hp:=tused_unit(usedunits.first);
  1174. while assigned(hp) do
  1175. begin
  1176. if (hp.u.flags and unitflag)=unitflag then
  1177. begin
  1178. tcb.emit_tai(
  1179. Tai_const.Createname(make_mangledname(prefix,hp.u.globalsymtable,''),0),
  1180. voidcodepointertype);
  1181. inc(count);
  1182. end;
  1183. hp:=tused_unit(hp.next);
  1184. end;
  1185. { Add items from program, if any }
  1186. if (current_module.flags and unitflag)=unitflag then
  1187. begin
  1188. tcb.emit_tai(
  1189. Tai_const.Createname(make_mangledname(prefix,current_module.localsymtable,''),0),
  1190. voidcodepointertype);
  1191. inc(count);
  1192. end;
  1193. { Insert TableCount at start }
  1194. countplaceholder.replace(Tai_const.Create_sizeint(count),sizesinttype);
  1195. countplaceholder.free;
  1196. { insert in data segment }
  1197. tabledef:=tcb.end_anonymous_record;
  1198. current_asmdata.asmlists[al_globals].concatlist(
  1199. tcb.get_final_asmlist(
  1200. current_asmdata.DefineAsmSymbol(tablename,AB_GLOBAL,AT_DATA,tabledef),
  1201. tabledef,
  1202. sec_data,tablename,sizeof(pint)
  1203. )
  1204. );
  1205. tcb.free;
  1206. end;
  1207. class procedure tnodeutils.InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal);
  1208. var
  1209. s: string;
  1210. item: TTCInitItem;
  1211. tcb: ttai_typedconstbuilder;
  1212. rawdatadef: tdef;
  1213. begin
  1214. item:=TTCInitItem(list.First);
  1215. if item=nil then
  1216. exit;
  1217. s:=make_mangledname(prefix,current_module.localsymtable,'');
  1218. tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  1219. tcb.begin_anonymous_record('',default_settings.packrecords,sizeof(pint),
  1220. targetinfos[target_info.system]^.alignment.recordalignmin,
  1221. targetinfos[target_info.system]^.alignment.maxCrecordalign );
  1222. repeat
  1223. { optimize away unused local/static symbols }
  1224. if (item.sym.refs>0) or (item.sym.owner.symtabletype=globalsymtable) then
  1225. begin
  1226. { address to initialize }
  1227. tcb.queue_init(voidpointertype);
  1228. rawdatadef:=carraydef.getreusable(cansichartype,tstaticvarsym(item.sym).vardef.size);
  1229. tcb.queue_vecn(rawdatadef,item.offset);
  1230. tcb.queue_typeconvn(cpointerdef.getreusable(tstaticvarsym(item.sym).vardef),cpointerdef.getreusable(rawdatadef));
  1231. tcb.queue_emit_staticvar(tstaticvarsym(item.sym));
  1232. { value with which to initialize }
  1233. tcb.emit_tai(Tai_const.Create_sym(item.datalabel),item.datadef)
  1234. end;
  1235. item:=TTCInitItem(item.Next);
  1236. until item=nil;
  1237. { end-of-list marker }
  1238. tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
  1239. rawdatadef:=tcb.end_anonymous_record;
  1240. current_asmdata.asmlists[al_globals].concatList(
  1241. tcb.get_final_asmlist(
  1242. current_asmdata.DefineAsmSymbol(s,AB_GLOBAL,AT_DATA,rawdatadef),
  1243. rawdatadef,sec_data,s,sizeof(pint)));
  1244. tcb.free;
  1245. current_module.flags:=current_module.flags or unitflag;
  1246. end;
  1247. class procedure tnodeutils.InsertWideInits;
  1248. begin
  1249. InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,uf_wideinits);
  1250. end;
  1251. class procedure tnodeutils.InsertResStrInits;
  1252. begin
  1253. InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,uf_resstrinits);
  1254. end;
  1255. class procedure tnodeutils.InsertWideInitsTablesTable;
  1256. begin
  1257. InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',uf_wideinits);
  1258. end;
  1259. class procedure tnodeutils.InsertResStrTablesTable;
  1260. begin
  1261. InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',uf_resstrinits);
  1262. end;
  1263. class procedure tnodeutils.InsertResourceTablesTable;
  1264. var
  1265. hp : tmodule;
  1266. count : longint;
  1267. tcb : ttai_typedconstbuilder;
  1268. countplaceholder : ttypedconstplaceholder;
  1269. tabledef: tdef;
  1270. begin
  1271. tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
  1272. count:=0;
  1273. hp:=tmodule(loaded_units.first);
  1274. tcb.begin_anonymous_record('',default_settings.packrecords,sizeof(pint),
  1275. targetinfos[target_info.system]^.alignment.recordalignmin,
  1276. targetinfos[target_info.system]^.alignment.maxCrecordalign);
  1277. countplaceholder:=tcb.emit_placeholder(sizesinttype);
  1278. while assigned(hp) do
  1279. begin
  1280. If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
  1281. begin
  1282. tcb.emit_tai(Tai_const.Create_sym(
  1283. ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',hp.localsymtable,[tcdssso_register_asmsym,tcdssso_use_indirect])),
  1284. voidpointertype
  1285. );
  1286. tcb.emit_tai(Tai_const.Create_sym(
  1287. ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_end('RESSTR',hp.localsymtable,[tcdssso_register_asmsym,tcdssso_use_indirect])),
  1288. voidpointertype
  1289. );
  1290. inc(count);
  1291. end;
  1292. hp:=tmodule(hp.next);
  1293. end;
  1294. { Insert TableCount at start }
  1295. countplaceholder.replace(Tai_const.Create_sizeint(count),sizesinttype);
  1296. countplaceholder.free;
  1297. { Add to data segment }
  1298. tabledef:=tcb.end_anonymous_record;
  1299. current_asmdata.AsmLists[al_globals].concatList(
  1300. tcb.get_final_asmlist(
  1301. current_asmdata.DefineAsmSymbol('FPC_RESOURCESTRINGTABLES',AB_GLOBAL,AT_DATA,tabledef),
  1302. tabledef,sec_rodata,'FPC_RESOURCESTRINGTABLES',sizeof(pint)
  1303. )
  1304. );
  1305. tcb.free;
  1306. end;
  1307. class procedure tnodeutils.InsertResourceInfo(ResourcesUsed: boolean);
  1308. var
  1309. tcb: ttai_typedconstbuilder;
  1310. begin
  1311. if (target_res.id in [res_elf,res_macho,res_xcoff]) or
  1312. { generate the FPC_RESLOCATION symbol even when using external resources,
  1313. because in SysInit we can only reference it unconditionally }
  1314. ((target_res.id=res_ext) and (target_info.system in systems_darwin)) then
  1315. begin
  1316. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]);
  1317. if ResourcesUsed and (target_res.id<>res_ext) then
  1318. tcb.emit_tai(Tai_const.Createname('FPC_RESSYMBOL',0),voidpointertype)
  1319. else
  1320. { Nil pointer to resource information }
  1321. tcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
  1322. current_asmdata.asmlists[al_globals].concatList(
  1323. tcb.get_final_asmlist(
  1324. current_asmdata.DefineAsmSymbol('FPC_RESLOCATION',AB_GLOBAL,AT_DATA,voidpointertype),
  1325. voidpointertype,
  1326. sec_rodata,
  1327. 'FPC_RESLOCATION',
  1328. sizeof(puint)
  1329. )
  1330. );
  1331. tcb.free;
  1332. end;
  1333. end;
  1334. class procedure tnodeutils.InsertMemorySizes;
  1335. var
  1336. tcb: ttai_typedconstbuilder;
  1337. s: shortstring;
  1338. sym: tasmsymbol;
  1339. def: tdef;
  1340. begin
  1341. { Insert Ident of the compiler in the .fpc.version section }
  1342. tcb:=ctai_typedconstbuilder.create([tcalo_no_dead_strip]);
  1343. s:='FPC '+full_version_string+
  1344. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname;
  1345. def:=carraydef.getreusable(cansichartype,length(s));
  1346. tcb.maybe_begin_aggregate(def);
  1347. tcb.emit_tai(Tai_string.Create(s),def);
  1348. tcb.maybe_end_aggregate(def);
  1349. sym:=current_asmdata.DefineAsmSymbol('__fpc_ident',AB_LOCAL,AT_DATA,def);
  1350. current_asmdata.asmlists[al_globals].concatlist(
  1351. tcb.get_final_asmlist(sym,def,sec_fpc,'version',const_align(32))
  1352. );
  1353. tcb.free;
  1354. if (tf_emit_stklen in target_info.flags) or
  1355. not(tf_no_generic_stackcheck in target_info.flags) then
  1356. begin
  1357. { stacksize can be specified and is now simulated }
  1358. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]);
  1359. tcb.emit_tai(Tai_const.Create_int_dataptr(stacksize),ptruinttype);
  1360. sym:=current_asmdata.DefineAsmSymbol('__stklen',AB_GLOBAL,AT_DATA,ptruinttype);
  1361. current_asmdata.asmlists[al_globals].concatlist(
  1362. tcb.get_final_asmlist(sym,ptruinttype,sec_data,'__stklen',sizeof(pint))
  1363. );
  1364. tcb.free;
  1365. end;
  1366. {$IFDEF POWERPC}
  1367. { AmigaOS4 "stack cookie" support }
  1368. if ( target_info.system = system_powerpc_amiga ) then
  1369. begin
  1370. { this symbol is needed to ignite powerpc amigaos' }
  1371. { stack allocation magic for us with the given stack size. }
  1372. { note: won't work for m68k amigaos or morphos. (KB) }
  1373. str(stacksize,s);
  1374. s:='$STACK: '+s+#0;
  1375. def:=carraydef.getreusable(cansichartype,length(s));
  1376. tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
  1377. tcb.maybe_begin_aggregate(def);
  1378. tcb.emit_tai(Tai_string.Create(s),def);
  1379. tcb.maybe_end_aggregate(def);
  1380. sym:=current_asmdata.DefineAsmSymbol('__stack_cookie',AB_GLOBAL,AT_DATA,def);
  1381. current_asmdata.asmlists[al_globals].concatlist(
  1382. tcb.get_final_asmlist(sym,def,sec_data,'__stack_cookie',sizeof(pint))
  1383. );
  1384. tcb.free;
  1385. end;
  1386. {$ENDIF POWERPC}
  1387. { Initial heapsize }
  1388. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]);
  1389. tcb.emit_tai(Tai_const.Create_int_dataptr(heapsize),ptruinttype);
  1390. sym:=current_asmdata.DefineAsmSymbol('__heapsize',AB_GLOBAL,AT_DATA,ptruinttype);
  1391. current_asmdata.asmlists[al_globals].concatlist(
  1392. tcb.get_final_asmlist(sym,ptruinttype,sec_data,'__heapsize',sizeof(pint))
  1393. );
  1394. tcb.free;
  1395. { allocate an initial heap on embedded systems }
  1396. if target_info.system in systems_embedded then
  1397. begin
  1398. { tai_datablock cannot yet be handled via the high level typed const
  1399. builder, because it implies the generation of a symbol, while this
  1400. is separate in the builder }
  1401. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  1402. new_section(current_asmdata.asmlists[al_globals],sec_bss,'__fpc_initialheap',current_settings.alignment.varalignmax);
  1403. current_asmdata.asmlists[al_globals].concat(tai_datablock.Create_global('__fpc_initialheap',heapsize,carraydef.getreusable(u8inttype,heapsize)));
  1404. end;
  1405. { Valgrind usage }
  1406. tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]);
  1407. tcb.emit_ord_const(byte(cs_gdb_valgrind in current_settings.globalswitches),u8inttype);
  1408. sym:=current_asmdata.DefineAsmSymbol('__fpc_valgrind',AB_GLOBAL,AT_DATA,u8inttype);
  1409. current_asmdata.asmlists[al_globals].concatlist(
  1410. tcb.get_final_asmlist(sym,ptruinttype,sec_data,'__fpc_valgrind',sizeof(pint))
  1411. );
  1412. tcb.free;
  1413. end;
  1414. class procedure tnodeutils.InsertObjectInfo;
  1415. begin
  1416. { don't do anything by default }
  1417. end;
  1418. class procedure tnodeutils.add_main_procdef_paras(pd: tdef);
  1419. var
  1420. pvs: tparavarsym;
  1421. begin
  1422. { stub for calling FPC_SYSTEMMAIN from the C main -> add argc/argv/argp }
  1423. if (tprocdef(pd).proctypeoption=potype_mainstub) and
  1424. (target_info.system in (systems_darwin+[system_powerpc_macos]+systems_aix)) then
  1425. begin
  1426. pvs:=cparavarsym.create('ARGC',1,vs_const,s32inttype,[]);
  1427. tprocdef(pd).parast.insert(pvs);
  1428. pvs:=cparavarsym.create('ARGV',2,vs_const,cpointerdef.getreusable(charpointertype),[]);
  1429. tprocdef(pd).parast.insert(pvs);
  1430. pvs:=cparavarsym.create('ARGP',3,vs_const,cpointerdef.getreusable(charpointertype),[]);
  1431. tprocdef(pd).parast.insert(pvs);
  1432. tprocdef(pd).calcparas;
  1433. end
  1434. { package stub for Windows is a DLLMain }
  1435. else if (tprocdef(pd).proctypeoption=potype_pkgstub) and
  1436. (target_info.system in systems_all_windows+systems_nativent) then
  1437. begin
  1438. pvs:=cparavarsym.create('HINSTANCE',1,vs_const,uinttype,[]);
  1439. tprocdef(pd).parast.insert(pvs);
  1440. pvs:=cparavarsym.create('DLLREASON',2,vs_const,u32inttype,[]);
  1441. tprocdef(pd).parast.insert(pvs);
  1442. pvs:=cparavarsym.create('DLLPARAM',3,vs_const,voidpointertype,[]);
  1443. tprocdef(pd).parast.insert(pvs);
  1444. tprocdef(pd).returndef:=bool32type;
  1445. insert_funcret_para(tprocdef(pd));
  1446. tprocdef(pd).calcparas;
  1447. end;
  1448. end;
  1449. end.