ngenutil.pas 67 KB

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