ngenutil.pas 55 KB

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