ngenutil.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760
  1. {
  2. Copyright (c) 1998-20011 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. node,symtype,symsym,symconst,symdef;
  23. type
  24. tnodeutils = class
  25. class function call_fail_node:tnode; virtual;
  26. class function initialize_data_node(p:tnode):tnode; virtual;
  27. class function finalize_data_node(p:tnode):tnode; virtual;
  28. { returns true if the unit requires an initialisation section (e.g.,
  29. to force class constructors for the JVM target to initialise global
  30. records/arrays) }
  31. class function force_init: boolean; virtual;
  32. { idem for finalization }
  33. class function force_final: boolean; virtual;
  34. { called after parsing a routine with the code of the entire routine
  35. as argument; can be used to modify the node tree. By default handles
  36. insertion of code for systems that perform the typed constant
  37. initialisation via the node tree }
  38. class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
  39. class procedure insertbssdata(sym : tstaticvarsym); virtual;
  40. class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
  41. class procedure InsertInitFinalTable; virtual;
  42. public
  43. class procedure InsertThreadvarTablesTable; virtual;
  44. class procedure InsertThreadvars; virtual;
  45. class procedure InsertWideInitsTablesTable; virtual;
  46. class procedure InsertWideInits; virtual;
  47. class procedure InsertResourceTablesTable; virtual;
  48. class procedure InsertResourceInfo(ResourcesUsed : boolean); virtual;
  49. class procedure InsertMemorySizes; virtual;
  50. strict protected
  51. class procedure add_main_procdef_paras(pd: tdef); virtual;
  52. end;
  53. tnodeutilsclass = class of tnodeutils;
  54. const
  55. cnodeutils: tnodeutilsclass = tnodeutils;
  56. implementation
  57. uses
  58. verbose,version,globtype,globals,cclasses,cutils,constexp,
  59. scanner,systems,procinfo,fmodule,
  60. aasmbase,aasmdata,aasmtai,
  61. symbase,symtable,defutil,
  62. nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils,
  63. ppu,
  64. pass_1;
  65. class function tnodeutils.call_fail_node:tnode;
  66. var
  67. para : tcallparanode;
  68. newstatement : tstatementnode;
  69. srsym : tsym;
  70. begin
  71. result:=internalstatements(newstatement);
  72. { call fail helper and exit normal }
  73. if is_class(current_structdef) then
  74. begin
  75. srsym:=search_struct_member(current_structdef,'FREEINSTANCE');
  76. if assigned(srsym) and
  77. (srsym.typ=procsym) then
  78. begin
  79. { if self<>0 and vmt<>0 then freeinstance }
  80. addstatement(newstatement,cifnode.create(
  81. caddnode.create(andn,
  82. caddnode.create(unequaln,
  83. load_self_pointer_node,
  84. cnilnode.create),
  85. caddnode.create(unequaln,
  86. load_vmt_pointer_node,
  87. cnilnode.create)),
  88. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
  89. nil));
  90. end
  91. else
  92. internalerror(200305108);
  93. end
  94. else
  95. if is_object(current_structdef) then
  96. begin
  97. { parameter 3 : vmt_offset }
  98. { parameter 2 : pointer to vmt }
  99. { parameter 1 : self pointer }
  100. para:=ccallparanode.create(
  101. cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false),
  102. ccallparanode.create(
  103. ctypeconvnode.create_internal(
  104. load_vmt_pointer_node,
  105. voidpointertype),
  106. ccallparanode.create(
  107. ctypeconvnode.create_internal(
  108. load_self_pointer_node,
  109. voidpointertype),
  110. nil)));
  111. addstatement(newstatement,
  112. ccallnode.createintern('fpc_help_fail',para));
  113. end
  114. else
  115. internalerror(200305132);
  116. { self:=nil }
  117. addstatement(newstatement,cassignmentnode.create(
  118. load_self_pointer_node,
  119. cnilnode.create));
  120. { exit }
  121. addstatement(newstatement,cexitnode.create(nil));
  122. end;
  123. class function tnodeutils.initialize_data_node(p:tnode):tnode;
  124. begin
  125. if not assigned(p.resultdef) then
  126. typecheckpass(p);
  127. if is_ansistring(p.resultdef) or
  128. is_wide_or_unicode_string(p.resultdef) or
  129. is_interfacecom_or_dispinterface(p.resultdef) or
  130. is_dynamic_array(p.resultdef) then
  131. begin
  132. result:=cassignmentnode.create(
  133. ctypeconvnode.create_internal(p,voidpointertype),
  134. cnilnode.create
  135. );
  136. end
  137. else
  138. begin
  139. result:=ccallnode.createintern('fpc_initialize',
  140. ccallparanode.create(
  141. caddrnode.create_internal(
  142. crttinode.create(
  143. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  144. ccallparanode.create(
  145. caddrnode.create_internal(p),
  146. nil)));
  147. end;
  148. end;
  149. class function tnodeutils.finalize_data_node(p:tnode):tnode;
  150. var
  151. newstatement : tstatementnode;
  152. begin
  153. if not assigned(p.resultdef) then
  154. typecheckpass(p);
  155. if is_ansistring(p.resultdef) then
  156. begin
  157. result:=internalstatements(newstatement);
  158. addstatement(newstatement,ccallnode.createintern('fpc_ansistr_decr_ref',
  159. ccallparanode.create(
  160. ctypeconvnode.create_internal(p,voidpointertype),
  161. nil)));
  162. addstatement(newstatement,cassignmentnode.create(
  163. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  164. cnilnode.create
  165. ));
  166. end
  167. else if is_widestring(p.resultdef) then
  168. begin
  169. result:=internalstatements(newstatement);
  170. addstatement(newstatement,ccallnode.createintern('fpc_widestr_decr_ref',
  171. ccallparanode.create(
  172. ctypeconvnode.create_internal(p,voidpointertype),
  173. nil)));
  174. addstatement(newstatement,cassignmentnode.create(
  175. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  176. cnilnode.create
  177. ));
  178. end
  179. else if is_unicodestring(p.resultdef) then
  180. begin
  181. result:=internalstatements(newstatement);
  182. addstatement(newstatement,ccallnode.createintern('fpc_unicodestr_decr_ref',
  183. ccallparanode.create(
  184. ctypeconvnode.create_internal(p,voidpointertype),
  185. nil)));
  186. addstatement(newstatement,cassignmentnode.create(
  187. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  188. cnilnode.create
  189. ));
  190. end
  191. else if is_interfacecom_or_dispinterface(p.resultdef) then
  192. begin
  193. result:=internalstatements(newstatement);
  194. addstatement(newstatement,ccallnode.createintern('fpc_intf_decr_ref',
  195. ccallparanode.create(
  196. ctypeconvnode.create_internal(p,voidpointertype),
  197. nil)));
  198. addstatement(newstatement,cassignmentnode.create(
  199. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  200. cnilnode.create
  201. ));
  202. end
  203. else
  204. result:=ccallnode.createintern('fpc_finalize',
  205. ccallparanode.create(
  206. caddrnode.create_internal(
  207. crttinode.create(
  208. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  209. ccallparanode.create(
  210. caddrnode.create_internal(p),
  211. nil)));
  212. end;
  213. class function tnodeutils.force_init: boolean;
  214. begin
  215. result:=
  216. (target_info.system in systems_typed_constants_node_init) and
  217. assigned(current_module.tcinitcode);
  218. end;
  219. class function tnodeutils.force_final: boolean;
  220. begin
  221. result:=false;
  222. end;
  223. class function tnodeutils.wrap_proc_body(pd: tprocdef; n: tnode): tnode;
  224. var
  225. stat: tstatementnode;
  226. block: tnode;
  227. psym: tsym;
  228. tcinitproc: tprocdef;
  229. begin
  230. result:=n;
  231. if target_info.system in systems_typed_constants_node_init then
  232. begin
  233. case pd.proctypeoption of
  234. potype_class_constructor:
  235. begin
  236. { even though the initialisation code for typed constants may
  237. not yet be complete at this point (there may be more inside
  238. method definitions coming after this class constructor), the
  239. ones from inside the class definition have already been parsed.
  240. in case of {$j-}, these are marked "final" in Java and such
  241. static fields must be initialsed in the class constructor
  242. itself -> add them here }
  243. block:=internalstatements(stat);
  244. if assigned(pd.struct.tcinitcode) then
  245. begin
  246. addstatement(stat,pd.struct.tcinitcode);
  247. pd.struct.tcinitcode:=nil;
  248. end;
  249. psym:=tsym(pd.struct.symtable.find('FPC_INIT_TYPED_CONSTS_HELPER'));
  250. if not assigned(psym) or
  251. (psym.typ<>procsym) or
  252. (tprocsym(psym).procdeflist.count<>1) then
  253. internalerror(2011040301);
  254. tcinitproc:=tprocdef(tprocsym(psym).procdeflist[0]);
  255. addstatement(stat,ccallnode.create(nil,tprocsym(psym),
  256. pd.struct.symtable,nil,[]));
  257. addstatement(stat,result);
  258. result:=block
  259. end;
  260. potype_unitinit:
  261. begin
  262. if assigned(current_module.tcinitcode) then
  263. begin
  264. block:=internalstatements(stat);
  265. addstatement(stat,tnode(current_module.tcinitcode));
  266. current_module.tcinitcode:=nil;
  267. addstatement(stat,result);
  268. result:=block;
  269. end;
  270. end;
  271. else case pd.synthetickind of
  272. tsk_tcinit:
  273. begin
  274. if assigned(pd.struct.tcinitcode) then
  275. begin
  276. block:=internalstatements(stat);
  277. addstatement(stat,pd.struct.tcinitcode);
  278. pd.struct.tcinitcode:=nil;
  279. addstatement(stat,result);
  280. result:=block
  281. end
  282. end;
  283. end;
  284. end;
  285. end;
  286. end;
  287. class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
  288. var
  289. l : asizeint;
  290. varalign : shortint;
  291. storefilepos : tfileposinfo;
  292. list : TAsmList;
  293. sectype : TAsmSectiontype;
  294. begin
  295. storefilepos:=current_filepos;
  296. current_filepos:=sym.fileinfo;
  297. l:=sym.getsize;
  298. varalign:=sym.vardef.alignment;
  299. if (varalign=0) then
  300. varalign:=var_align_size(l)
  301. else
  302. varalign:=var_align(varalign);
  303. if tf_section_threadvars in target_info.flags then
  304. begin
  305. if (vo_is_thread_var in sym.varoptions) then
  306. begin
  307. list:=current_asmdata.asmlists[al_threadvars];
  308. sectype:=sec_threadvar;
  309. end
  310. else
  311. begin
  312. list:=current_asmdata.asmlists[al_globals];
  313. sectype:=sec_bss;
  314. end;
  315. end
  316. else
  317. begin
  318. if (vo_is_thread_var in sym.varoptions) then
  319. begin
  320. inc(l,sizeof(pint));
  321. { it doesn't help to set a higher alignment, as }
  322. { the first sizeof(pint) bytes field will offset }
  323. { everything anyway }
  324. varalign:=sizeof(pint);
  325. end;
  326. list:=current_asmdata.asmlists[al_globals];
  327. sectype:=sec_bss;
  328. end;
  329. maybe_new_object_file(list);
  330. if vo_has_section in sym.varoptions then
  331. new_section(list,sec_user,sym.section,varalign)
  332. else
  333. new_section(list,sectype,lower(sym.mangledname),varalign);
  334. if (sym.owner.symtabletype=globalsymtable) or
  335. create_smartlink or
  336. DLLSource or
  337. (assigned(current_procinfo) and
  338. (po_inline in current_procinfo.procdef.procoptions)) or
  339. (vo_is_public in sym.varoptions) then
  340. list.concat(Tai_datablock.create_global(sym.mangledname,l))
  341. else
  342. list.concat(Tai_datablock.create(sym.mangledname,l));
  343. current_filepos:=storefilepos;
  344. end;
  345. class function tnodeutils.create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef;
  346. var
  347. pd: tprocdef;
  348. begin
  349. pd:=tprocdef.create(main_program_level);
  350. pd.procsym:=ps;
  351. ps.ProcdefList.Add(pd);
  352. include(pd.procoptions,po_global);
  353. { set procdef options }
  354. pd.proctypeoption:=potype;
  355. pd.proccalloption:=pocall_default;
  356. include(pd.procoptions,po_hascallingconvention);
  357. pd.forwarddef:=false;
  358. { may be required to calculate the mangled name }
  359. add_main_procdef_paras(pd);
  360. pd.setmangledname(name);
  361. pd.aliasnames.insert(pd.mangledname);
  362. result:=pd;
  363. end;
  364. procedure AddToStructInits(p:TObject;arg:pointer);
  365. var
  366. StructList: TFPList absolute arg;
  367. begin
  368. if (tdef(p).typ in [objectdef,recorddef]) and
  369. ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
  370. StructList.Add(p);
  371. end;
  372. class procedure tnodeutils.InsertInitFinalTable;
  373. var
  374. hp : tused_unit;
  375. unitinits : TAsmList;
  376. count : longint;
  377. procedure write_struct_inits(u: tmodule);
  378. var
  379. i: integer;
  380. structlist: TFPList;
  381. pd: tprocdef;
  382. begin
  383. structlist := TFPList.Create;
  384. if assigned(u.globalsymtable) then
  385. u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
  386. u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
  387. { write structures }
  388. for i := 0 to structlist.Count - 1 do
  389. begin
  390. pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
  391. if assigned(pd) then
  392. unitinits.concat(Tai_const.Createname(pd.mangledname,0))
  393. else
  394. unitinits.concat(Tai_const.Create_pint(0));
  395. pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
  396. if assigned(pd) then
  397. unitinits.concat(Tai_const.Createname(pd.mangledname,0))
  398. else
  399. unitinits.concat(Tai_const.Create_pint(0));
  400. inc(count);
  401. end;
  402. structlist.free;
  403. end;
  404. begin
  405. unitinits:=TAsmList.Create;
  406. count:=0;
  407. hp:=tused_unit(usedunits.first);
  408. while assigned(hp) do
  409. begin
  410. { insert class constructors/destructors of the unit }
  411. if (hp.u.flags and uf_classinits) <> 0 then
  412. write_struct_inits(hp.u);
  413. { call the unit init code and make it external }
  414. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  415. begin
  416. if (hp.u.flags and uf_init)<>0 then
  417. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0))
  418. else
  419. unitinits.concat(Tai_const.Create_sym(nil));
  420. if (hp.u.flags and uf_finalize)<>0 then
  421. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0))
  422. else
  423. unitinits.concat(Tai_const.Create_sym(nil));
  424. inc(count);
  425. end;
  426. hp:=tused_unit(hp.next);
  427. end;
  428. { insert class constructors/destructor of the program }
  429. if (current_module.flags and uf_classinits) <> 0 then
  430. write_struct_inits(current_module);
  431. { Insert initialization/finalization of the program }
  432. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  433. begin
  434. if (current_module.flags and uf_init)<>0 then
  435. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0))
  436. else
  437. unitinits.concat(Tai_const.Create_sym(nil));
  438. if (current_module.flags and uf_finalize)<>0 then
  439. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0))
  440. else
  441. unitinits.concat(Tai_const.Create_sym(nil));
  442. inc(count);
  443. end;
  444. { Insert TableCount,InitCount at start }
  445. unitinits.insert(Tai_const.Create_32bit(0));
  446. unitinits.insert(Tai_const.Create_32bit(count));
  447. { Add to data segment }
  448. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  449. new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(pint));
  450. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
  451. current_asmdata.asmlists[al_globals].concatlist(unitinits);
  452. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
  453. unitinits.free;
  454. end;
  455. class procedure tnodeutils.InsertThreadvarTablesTable;
  456. var
  457. hp : tused_unit;
  458. ltvTables : TAsmList;
  459. count : longint;
  460. begin
  461. if (tf_section_threadvars in target_info.flags) then
  462. exit;
  463. ltvTables:=TAsmList.Create;
  464. count:=0;
  465. hp:=tused_unit(usedunits.first);
  466. while assigned(hp) do
  467. begin
  468. If (hp.u.flags and uf_threadvars)=uf_threadvars then
  469. begin
  470. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),0));
  471. inc(count);
  472. end;
  473. hp:=tused_unit(hp.next);
  474. end;
  475. { Add program threadvars, if any }
  476. If (current_module.flags and uf_threadvars)=uf_threadvars then
  477. begin
  478. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),0));
  479. inc(count);
  480. end;
  481. { Insert TableCount at start }
  482. ltvTables.insert(Tai_const.Create_32bit(count));
  483. { insert in data segment }
  484. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  485. new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(pint));
  486. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
  487. current_asmdata.asmlists[al_globals].concatlist(ltvTables);
  488. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
  489. ltvTables.free;
  490. end;
  491. procedure AddToThreadvarList(p:TObject;arg:pointer);
  492. var
  493. ltvTable : TAsmList;
  494. begin
  495. ltvTable:=TAsmList(arg);
  496. if (tsym(p).typ=staticvarsym) and
  497. (vo_is_thread_var in tstaticvarsym(p).varoptions) then
  498. begin
  499. { address of threadvar }
  500. ltvTable.concat(tai_const.Createname(tstaticvarsym(p).mangledname,0));
  501. { size of threadvar }
  502. ltvTable.concat(tai_const.create_32bit(tstaticvarsym(p).getsize));
  503. end;
  504. end;
  505. class procedure tnodeutils.InsertThreadvars;
  506. var
  507. s : string;
  508. ltvTable : TAsmList;
  509. begin
  510. if (tf_section_threadvars in target_info.flags) then
  511. exit;
  512. ltvTable:=TAsmList.create;
  513. if assigned(current_module.globalsymtable) then
  514. current_module.globalsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable);
  515. current_module.localsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable);
  516. if ltvTable.first<>nil then
  517. begin
  518. s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
  519. { end of the list marker }
  520. ltvTable.concat(tai_const.create_sym(nil));
  521. { add to datasegment }
  522. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  523. new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
  524. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
  525. current_asmdata.asmlists[al_globals].concatlist(ltvTable);
  526. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
  527. current_module.flags:=current_module.flags or uf_threadvars;
  528. end;
  529. ltvTable.Free;
  530. end;
  531. class procedure tnodeutils.InsertWideInitsTablesTable;
  532. var
  533. hp: tused_unit;
  534. lwiTables: TAsmList;
  535. count: longint;
  536. begin
  537. lwiTables:=TAsmList.Create;
  538. count:=0;
  539. hp:=tused_unit(usedunits.first);
  540. while assigned(hp) do
  541. begin
  542. if (hp.u.flags and uf_wideinits)=uf_wideinits then
  543. begin
  544. lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',hp.u.globalsymtable,''),0));
  545. inc(count);
  546. end;
  547. hp:=tused_unit(hp.next);
  548. end;
  549. { Add program widestring consts, if any }
  550. if (current_module.flags and uf_wideinits)=uf_wideinits then
  551. begin
  552. lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',current_module.localsymtable,''),0));
  553. inc(count);
  554. end;
  555. { Insert TableCount at start }
  556. lwiTables.insert(Tai_const.Create_32bit(count));
  557. { insert in data segment }
  558. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  559. new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_WIDEINITTABLES',sizeof(pint));
  560. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_WIDEINITTABLES',AT_DATA,0));
  561. current_asmdata.asmlists[al_globals].concatlist(lwiTables);
  562. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_WIDEINITTABLES'));
  563. lwiTables.free;
  564. end;
  565. class procedure tnodeutils.InsertWideInits;
  566. var
  567. s: string;
  568. item: TTCInitItem;
  569. begin
  570. item:=TTCInitItem(current_asmdata.WideInits.First);
  571. if item=nil then
  572. exit;
  573. s:=make_mangledname('WIDEINITS',current_module.localsymtable,'');
  574. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  575. new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
  576. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
  577. repeat
  578. { optimize away unused local/static symbols }
  579. if (item.sym.refs>0) or (item.sym.owner.symtabletype=globalsymtable) then
  580. begin
  581. { address to initialize }
  582. current_asmdata.asmlists[al_globals].concat(Tai_const.createname(item.sym.mangledname, item.offset));
  583. { value with which to initialize }
  584. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(item.datalabel));
  585. end;
  586. item:=TTCInitItem(item.Next);
  587. until item=nil;
  588. { end-of-list marker }
  589. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
  590. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
  591. current_module.flags:=current_module.flags or uf_wideinits;
  592. end;
  593. class procedure tnodeutils.InsertResourceTablesTable;
  594. var
  595. hp : tmodule;
  596. ResourceStringTables : tasmlist;
  597. count : longint;
  598. begin
  599. ResourceStringTables:=tasmlist.Create;
  600. count:=0;
  601. hp:=tmodule(loaded_units.first);
  602. while assigned(hp) do
  603. begin
  604. If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
  605. begin
  606. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'START'),0));
  607. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'END'),0));
  608. inc(count);
  609. end;
  610. hp:=tmodule(hp.next);
  611. end;
  612. { Insert TableCount at start }
  613. ResourceStringTables.insert(Tai_const.Create_pint(count));
  614. { Add to data segment }
  615. maybe_new_object_file(current_asmdata.AsmLists[al_globals]);
  616. new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(pint));
  617. current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
  618. current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables);
  619. current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  620. ResourceStringTables.free;
  621. end;
  622. class procedure tnodeutils.InsertResourceInfo(ResourcesUsed: boolean);
  623. var
  624. ResourceInfo : TAsmList;
  625. begin
  626. if (target_res.id in [res_elf,res_macho]) then
  627. begin
  628. ResourceInfo:=TAsmList.Create;
  629. maybe_new_object_file(ResourceInfo);
  630. new_section(ResourceInfo,sec_data,'FPC_RESLOCATION',sizeof(aint));
  631. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
  632. if ResourcesUsed then
  633. { Valid pointer to resource information }
  634. ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0))
  635. else
  636. { Nil pointer to resource information }
  637. {$IFDEF CPU32}
  638. ResourceInfo.Concat(Tai_const.Create_32bit(0));
  639. {$ELSE}
  640. ResourceInfo.Concat(Tai_const.Create_64bit(0));
  641. {$ENDIF}
  642. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  643. current_asmdata.asmlists[al_globals].concatlist(ResourceInfo);
  644. ResourceInfo.free;
  645. end;
  646. end;
  647. class procedure tnodeutils.InsertMemorySizes;
  648. {$IFDEF POWERPC}
  649. var
  650. stkcookie: string;
  651. {$ENDIF POWERPC}
  652. begin
  653. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  654. { Insert Ident of the compiler in the .fpc.version section }
  655. new_section(current_asmdata.asmlists[al_globals],sec_fpc,'version',const_align(32));
  656. current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
  657. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
  658. if not(tf_no_generic_stackcheck in target_info.flags) then
  659. begin
  660. { stacksize can be specified and is now simulated }
  661. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(pint));
  662. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(pint)));
  663. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(stacksize));
  664. end;
  665. {$IFDEF POWERPC}
  666. { AmigaOS4 "stack cookie" support }
  667. if ( target_info.system = system_powerpc_amiga ) then
  668. begin
  669. { this symbol is needed to ignite powerpc amigaos' }
  670. { stack allocation magic for us with the given stack size. }
  671. { note: won't work for m68k amigaos or morphos. (KB) }
  672. str(stacksize,stkcookie);
  673. stkcookie:='$STACK: '+stkcookie+#0;
  674. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  675. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stack_cookie',length(stkcookie));
  676. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie)));
  677. current_asmdata.asmlists[al_globals].concat(Tai_string.Create(stkcookie));
  678. end;
  679. {$ENDIF POWERPC}
  680. { Initial heapsize }
  681. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  682. new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(pint));
  683. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(pint)));
  684. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(heapsize));
  685. { Initial heapsize }
  686. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  687. new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',sizeof(boolean));
  688. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__fpc_valgrind',AT_DATA,sizeof(boolean)));
  689. current_asmdata.asmlists[al_globals].concat(Tai_const.create_8bit(byte(cs_gdb_valgrind in current_settings.globalswitches)));
  690. end;
  691. class procedure tnodeutils.add_main_procdef_paras(pd: tdef);
  692. begin
  693. { no parameters by default }
  694. end;
  695. end.