ngenutil.pas 61 KB

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