ngenutil.pas 66 KB

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