ngenutil.pas 61 KB

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