ngenutil.pas 61 KB

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