ngenutil.pas 62 KB

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