ngenutil.pas 64 KB

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