ngenutil.pas 59 KB

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