ngenutil.pas 55 KB

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