ngenutil.pas 64 KB

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