ngenutil.pas 66 KB

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