pkgutil.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841
  1. {
  2. Copyright (c) 2013-2016 by Free Pascal Development Team
  3. This unit implements basic parts of the package system
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit pkgutil;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. fmodule,fpkg,link,cstreams,cclasses;
  22. procedure createimportlibfromexternals;
  23. Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
  24. procedure export_unit(u:tmodule);
  25. procedure load_packages;
  26. procedure add_package(const name:string;ignoreduplicates:boolean;direct:boolean);
  27. procedure add_package_unit_ref(package:tpackage);
  28. procedure add_package_libs(l:tlinker);
  29. procedure check_for_indirect_package_usages(modules:tlinkedlist);
  30. implementation
  31. uses
  32. sysutils,
  33. globtype,systems,
  34. cutils,
  35. globals,verbose,
  36. aasmbase,aasmdata,aasmcnst,
  37. symtype,symconst,symsym,symdef,symbase,symtable,
  38. psub,pdecsub,
  39. ncgutil,
  40. ppu,entfile,fpcp,
  41. export;
  42. procedure procexport(const s : string);
  43. var
  44. hp : texported_item;
  45. begin
  46. hp:=texported_item.create;
  47. hp.name:=stringdup(s);
  48. hp.options:=hp.options+[eo_name];
  49. exportlib.exportprocedure(hp);
  50. end;
  51. procedure varexport(const s : string);
  52. var
  53. hp : texported_item;
  54. begin
  55. hp:=texported_item.create;
  56. hp.name:=stringdup(s);
  57. hp.options:=hp.options+[eo_name];
  58. exportlib.exportvar(hp);
  59. end;
  60. procedure exportprocsym(sym:tprocsym;symtable:tsymtable);
  61. var
  62. i : longint;
  63. item : TCmdStrListItem;
  64. pd : tprocdef;
  65. begin
  66. for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
  67. begin
  68. pd:=tprocdef(tprocsym(sym).procdeflist[i]);
  69. if not(pd.proccalloption in [pocall_internproc]) and
  70. ((pd.procoptions*[po_external])=[]) and
  71. (
  72. (symtable.symtabletype in [globalsymtable,recordsymtable,objectsymtable]) or
  73. (
  74. (symtable.symtabletype=staticsymtable) and
  75. ([po_public,po_has_public_name]*pd.procoptions<>[])
  76. )
  77. ) then
  78. begin
  79. exportallprocdefnames(tprocsym(sym),pd,[eo_name,eo_no_sym_name]);
  80. end;
  81. end;
  82. end;
  83. procedure exportabstractrecorddef(def:tabstractrecorddef;symtable:tsymtable); forward;
  84. procedure exportabstractrecordsymproc(sym:tobject;arg:pointer);
  85. var
  86. def : tabstractrecorddef;
  87. begin
  88. case tsym(sym).typ of
  89. typesym:
  90. begin
  91. case ttypesym(sym).typedef.typ of
  92. objectdef,
  93. recorddef:
  94. exportabstractrecorddef(tabstractrecorddef(ttypesym(sym).typedef),tsymtable(arg));
  95. end;
  96. end;
  97. procsym:
  98. begin
  99. { don't export methods of interfaces }
  100. if is_interface(tdef(tabstractrecordsymtable(arg).defowner)) then
  101. exit;
  102. exportprocsym(tprocsym(sym),tsymtable(arg));
  103. end;
  104. staticvarsym:
  105. begin
  106. varexport(tsym(sym).mangledname);
  107. end;
  108. end;
  109. end;
  110. procedure exportabstractrecorddef(def:tabstractrecorddef;symtable:tsymtable);
  111. var
  112. hp : texported_item;
  113. begin
  114. { for cross unit type aliases this might happen }
  115. if def.owner<>symtable then
  116. exit;
  117. { don't export generics or their nested types }
  118. if df_generic in def.defoptions then
  119. exit;
  120. def.symtable.SymList.ForEachCall(@exportabstractrecordsymproc,def.symtable);
  121. if def.typ=objectdef then
  122. begin
  123. if (oo_has_vmt in tobjectdef(def).objectoptions) then
  124. begin
  125. hp:=texported_item.create;
  126. hp.name:=stringdup(tobjectdef(def).vmt_mangledname);
  127. hp.options:=hp.options+[eo_name];
  128. exportlib.exportvar(hp);
  129. end;
  130. if is_class(def) then
  131. begin
  132. hp:=texported_item.create;
  133. hp.name:=stringdup(tobjectdef(def).rtti_mangledname(fullrtti));
  134. hp.options:=hp.options+[eo_name];
  135. exportlib.exportvar(hp);
  136. end;
  137. end;
  138. end;
  139. procedure insert_export(sym : TObject;arg:pointer);
  140. var
  141. i : longint;
  142. item : TCmdStrListItem;
  143. publiconly : boolean;
  144. begin
  145. publiconly:=tsymtable(arg).symtabletype=staticsymtable;
  146. case TSym(sym).typ of
  147. { ignore: }
  148. unitsym,
  149. syssym,
  150. namespacesym,
  151. propertysym,
  152. enumsym:
  153. ;
  154. constsym:
  155. begin
  156. if tconstsym(sym).consttyp=constresourcestring then
  157. varexport(make_mangledname('RESSTR',tsym(sym).owner,tsym(sym).name));
  158. end;
  159. typesym:
  160. begin
  161. case ttypesym(sym).typedef.typ of
  162. recorddef,
  163. objectdef:
  164. exportabstractrecorddef(tabstractrecorddef(ttypesym(sym).typedef),tsymtable(arg));
  165. end;
  166. end;
  167. procsym:
  168. begin
  169. exportprocsym(tprocsym(sym),tsymtable(arg));
  170. end;
  171. staticvarsym:
  172. begin
  173. if publiconly and not (vo_is_public in tstaticvarsym(sym).varoptions) then
  174. exit;
  175. varexport(tsym(sym).mangledname);
  176. end;
  177. else
  178. begin
  179. writeln('unknown: ',TSym(sym).typ);
  180. end;
  181. end;
  182. end;
  183. procedure export_unit(u: tmodule);
  184. begin
  185. u.globalsymtable.symlist.ForEachCall(@insert_export,u.globalsymtable);
  186. { check localsymtable for exports too to get public symbols }
  187. u.localsymtable.symlist.ForEachCall(@insert_export,u.localsymtable);
  188. { create special exports }
  189. if (u.flags and uf_init)<>0 then
  190. procexport(make_mangledname('INIT$',u.globalsymtable,''));
  191. if (u.flags and uf_finalize)<>0 then
  192. procexport(make_mangledname('FINALIZE$',u.globalsymtable,''));
  193. if (u.flags and uf_threadvars)=uf_threadvars then
  194. varexport(make_mangledname('THREADVARLIST',u.globalsymtable,''));
  195. if (u.flags and uf_has_resourcestrings)<>0 then
  196. begin
  197. varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_start('RESSTR',u.localsymtable,[]).name);
  198. varexport(ctai_typedconstbuilder.get_vectorized_dead_strip_section_symbol_end('RESSTR',u.localsymtable,[]).name);
  199. end;
  200. end;
  201. Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
  202. Var
  203. MakeStatic : Boolean;
  204. Var
  205. buffer : array[0..$1fff] of byte;
  206. inppu,
  207. outppu : tppufile;
  208. b,
  209. untilb : byte;
  210. l,m : longint;
  211. f : file;
  212. ext,
  213. s : string;
  214. ppuversion : dword;
  215. begin
  216. Result:=false;
  217. MakeStatic:=False;
  218. inppu:=tppufile.create(PPUFn);
  219. if not inppu.openfile then
  220. begin
  221. inppu.free;
  222. Comment(V_Error,'Could not open : '+PPUFn);
  223. Exit;
  224. end;
  225. { Check the ppufile }
  226. if not inppu.CheckPPUId then
  227. begin
  228. inppu.free;
  229. Comment(V_Error,'Not a PPU File : '+PPUFn);
  230. Exit;
  231. end;
  232. ppuversion:=inppu.getversion;
  233. if ppuversion<CurrentPPUVersion then
  234. begin
  235. inppu.free;
  236. Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
  237. Exit;
  238. end;
  239. { Already a lib? }
  240. if (inppu.header.common.flags and uf_in_library)<>0 then
  241. begin
  242. inppu.free;
  243. Comment(V_Error,'PPU is already in a library : '+PPUFn);
  244. Exit;
  245. end;
  246. { We need a static linked unit, but we also accept those without .o file }
  247. if (inppu.header.common.flags and (uf_static_linked or uf_no_link))=0 then
  248. begin
  249. inppu.free;
  250. Comment(V_Error,'PPU is not static linked : '+PPUFn);
  251. Exit;
  252. end;
  253. { Check if shared is allowed }
  254. if tsystem(inppu.header.common.target) in [system_i386_go32v2] then
  255. begin
  256. Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
  257. MakeStatic:=true;
  258. end;
  259. { Create the new ppu }
  260. outppu:=tppufile.create(PPUFn);
  261. outppu.createstream(OutStream);
  262. { Create new header, with the new flags }
  263. outppu.header:=inppu.header;
  264. outppu.header.common.flags:=outppu.header.common.flags or uf_in_library;
  265. if MakeStatic then
  266. outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
  267. else
  268. outppu.header.common.flags:=outppu.header.common.flags or uf_shared_linked;
  269. { read until the object files are found }
  270. untilb:=iblinkunitofiles;
  271. repeat
  272. b:=inppu.readentry;
  273. if b in [ibendinterface,ibend] then
  274. begin
  275. inppu.free;
  276. outppu.free;
  277. Comment(V_Error,'No files to be linked found : '+PPUFn);
  278. Exit;
  279. end;
  280. if b<>untilb then
  281. begin
  282. repeat
  283. inppu.getdatabuf(buffer,sizeof(buffer),l);
  284. outppu.putdata(buffer,l);
  285. until l<sizeof(buffer);
  286. outppu.writeentry(b);
  287. end;
  288. until (b=untilb);
  289. { we have now reached the section for the files which need to be added,
  290. now add them to the list }
  291. case b of
  292. iblinkunitofiles :
  293. begin
  294. { add all o files, and save the entry when not creating a static
  295. library to keep staticlinking possible }
  296. while not inppu.endofentry do
  297. begin
  298. s:=inppu.getstring;
  299. m:=inppu.getlongint;
  300. if not MakeStatic then
  301. begin
  302. outppu.putstring(s);
  303. outppu.putlongint(m);
  304. end;
  305. current_module.linkotherofiles.add(s,link_always);;
  306. end;
  307. if not MakeStatic then
  308. outppu.writeentry(b);
  309. end;
  310. { iblinkunitstaticlibs :
  311. begin
  312. AddToLinkFiles(ExtractLib(inppu.getstring));
  313. if not inppu.endofentry then
  314. begin
  315. repeat
  316. inppu.getdatabuf(buffer^,bufsize,l);
  317. outppu.putdata(buffer^,l);
  318. until l<bufsize;
  319. outppu.writeentry(b);
  320. end;
  321. end; }
  322. end;
  323. { just add a new entry with the new lib }
  324. if MakeStatic then
  325. begin
  326. outppu.putstring('imp'+current_module.realmodulename^);
  327. outppu.putlongint(link_static);
  328. outppu.writeentry(iblinkunitstaticlibs)
  329. end
  330. else
  331. begin
  332. outppu.putstring('imp'+current_module.realmodulename^);
  333. outppu.putlongint(link_shared);
  334. outppu.writeentry(iblinkunitsharedlibs);
  335. end;
  336. { read all entries until the end and write them also to the new ppu }
  337. repeat
  338. b:=inppu.readentry;
  339. { don't write ibend, that's written automatically }
  340. if b<>ibend then
  341. begin
  342. if b=iblinkothersharedlibs then
  343. begin
  344. while not inppu.endofentry do
  345. begin
  346. s:=inppu.getstring;
  347. m:=inppu.getlongint;
  348. outppu.putstring(s);
  349. outppu.putlongint(m);
  350. { strip lib prefix }
  351. if copy(s,1,3)='lib' then
  352. delete(s,1,3);
  353. ext:=ExtractFileExt(s);
  354. if ext<>'' then
  355. delete(s,length(s)-length(ext)+1,length(ext));
  356. current_module.linkOtherSharedLibs.add(s,link_always);
  357. end;
  358. end
  359. else
  360. repeat
  361. inppu.getdatabuf(buffer,sizeof(buffer),l);
  362. outppu.putdata(buffer,l);
  363. until l<sizeof(buffer);
  364. outppu.writeentry(b);
  365. end;
  366. until b=ibend;
  367. { write the last stuff and close }
  368. outppu.flush;
  369. outppu.writeheader;
  370. outppu.free;
  371. inppu.free;
  372. Result:=True;
  373. end;
  374. procedure load_packages;
  375. var
  376. i,j : longint;
  377. pcp: tpcppackage;
  378. entry,
  379. entryreq : ppackageentry;
  380. name,
  381. uname : string;
  382. begin
  383. if not (tf_supports_packages in target_info.flags) then
  384. exit;
  385. i:=0;
  386. while i<packagelist.count do
  387. begin
  388. entry:=ppackageentry(packagelist[i]);
  389. if assigned(entry^.package) then
  390. internalerror(2013053104);
  391. Comment(V_Info,'Loading package: '+entry^.realpkgname);
  392. pcp:=tpcppackage.create(entry^.realpkgname);
  393. pcp.loadpcp;
  394. entry^.package:=pcp;
  395. { add all required packages that are not yet part of packagelist }
  396. for j:=0 to pcp.requiredpackages.count-1 do
  397. begin
  398. name:=pcp.requiredpackages.NameOfIndex(j);
  399. uname:=upper(name);
  400. if not assigned(packagelist.Find(uname)) then
  401. begin
  402. New(entryreq);
  403. entryreq^.realpkgname:=name;
  404. entryreq^.package:=nil;
  405. entryreq^.usedunits:=0;
  406. entryreq^.direct:=false;
  407. packagelist.add(uname,entryreq);
  408. end;
  409. end;
  410. Inc(i);
  411. end;
  412. { all packages are now loaded, so we can fill in the links of the required packages }
  413. for i:=0 to packagelist.count-1 do
  414. begin
  415. entry:=ppackageentry(packagelist[i]);
  416. if not assigned(entry^.package) then
  417. internalerror(2015111301);
  418. for j:=0 to entry^.package.requiredpackages.count-1 do
  419. begin
  420. if assigned(entry^.package.requiredpackages[j]) then
  421. internalerror(2015111303);
  422. entryreq:=packagelist.find(upper(entry^.package.requiredpackages.NameOfIndex(j)));
  423. if not assigned(entryreq) then
  424. internalerror(2015111302);
  425. entry^.package.requiredpackages[j]:=entryreq^.package;
  426. end;
  427. end;
  428. end;
  429. procedure add_package(const name:string;ignoreduplicates:boolean;direct:boolean);
  430. var
  431. entry : ppackageentry;
  432. i : longint;
  433. begin
  434. for i:=0 to packagelist.count-1 do
  435. begin
  436. if packagelist.nameofindex(i)=name then
  437. begin
  438. if not ignoreduplicates then
  439. Message1(package_e_duplicate_package,name);
  440. exit;
  441. end;
  442. end;
  443. new(entry);
  444. entry^.package:=nil;
  445. entry^.realpkgname:=name;
  446. entry^.usedunits:=0;
  447. entry^.direct:=direct;
  448. packagelist.add(upper(name),entry);
  449. end;
  450. procedure add_package_unit_ref(package: tpackage);
  451. var
  452. pkgentry : ppackageentry;
  453. begin
  454. pkgentry:=ppackageentry(packagelist.find(package.packagename^));
  455. if not assigned(pkgentry) then
  456. internalerror(2015100301);
  457. inc(pkgentry^.usedunits);
  458. end;
  459. procedure add_package_libs(l:tlinker);
  460. var
  461. pkgentry : ppackageentry;
  462. i : longint;
  463. pkgname : tpathstr;
  464. begin
  465. if target_info.system in systems_indirect_var_imports then
  466. { we're using import libraries anyway }
  467. exit;
  468. for i:=0 to packagelist.count-1 do
  469. begin
  470. pkgentry:=ppackageentry(packagelist[i]);
  471. if pkgentry^.usedunits>0 then
  472. begin
  473. //writeln('package used: ',pkgentry^.realpkgname);
  474. pkgname:=pkgentry^.package.pplfilename;
  475. if copy(pkgname,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
  476. delete(pkgname,1,length(target_info.sharedlibprefix));
  477. if copy(pkgname,length(pkgname)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
  478. delete(pkgname,length(pkgname)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext));
  479. //writeln('adding library: ', pkgname);
  480. l.sharedlibfiles.concat(pkgname);
  481. end
  482. else
  483. {writeln('ignoring package: ',pkgentry^.realpkgname)};
  484. end;
  485. end;
  486. procedure check_for_indirect_package_usages(modules:tlinkedlist);
  487. var
  488. uu : tused_unit;
  489. pentry : ppackageentry;
  490. begin
  491. uu:=tused_unit(modules.first);
  492. while assigned(uu) do
  493. begin
  494. if assigned(uu.u.package) then
  495. begin
  496. pentry:=ppackageentry(packagelist.find(uu.u.package.packagename^));
  497. if not assigned(pentry) then
  498. internalerror(2015112304);
  499. if not pentry^.direct then
  500. Message2(package_w_unit_from_indirect_package,uu.u.realmodulename^,uu.u.package.realpackagename^);
  501. end;
  502. uu:=tused_unit(uu.Next);
  503. end;
  504. end;
  505. procedure createimportlibfromexternals;
  506. type
  507. tcacheentry=record
  508. pkg:tpackage;
  509. sym:tasmsymbol;
  510. end;
  511. pcacheentry=^tcacheentry;
  512. var
  513. cache : tfphashlist;
  514. alreadyloaded : tfpobjectlist;
  515. function findpackagewithsym(symname:tsymstr):tcacheentry;
  516. var
  517. i,j : longint;
  518. pkgentry : ppackageentry;
  519. unitentry : pcontainedunit;
  520. begin
  521. for i:=0 to packagelist.count-1 do
  522. begin
  523. pkgentry:=ppackageentry(packagelist[i]);
  524. for j:=0 to pkgentry^.package.containedmodules.count-1 do
  525. begin
  526. unitentry:=pcontainedunit(pkgentry^.package.containedmodules[j]);
  527. if not assigned(unitentry^.module) then
  528. { the unit is not loaded }
  529. continue;
  530. result.sym:=tasmsymbol(tmodule(unitentry^.module).publicasmsyms.find(symname));
  531. if assigned(result.sym) then
  532. begin
  533. { completely ignore other external symbols }
  534. if result.sym.bind in [ab_external,ab_weak_external] then
  535. begin
  536. result.sym:=nil;
  537. continue;
  538. end;
  539. { only accept global symbols of the used unit }
  540. if result.sym.bind<>ab_global then
  541. begin
  542. result.sym:=nil;
  543. result.pkg:=nil;
  544. end
  545. else
  546. result.pkg:=pkgentry^.package;
  547. exit;
  548. end;
  549. end;
  550. end;
  551. result.sym:=nil;
  552. result.pkg:=nil;
  553. end;
  554. procedure processasmsyms(symlist:tfphashobjectlist);
  555. var
  556. i,j,k : longint;
  557. sym : tasmsymbol;
  558. cacheentry : pcacheentry;
  559. list : TAsmList;
  560. labind : tasmsymbol;
  561. psym : tsymentry;
  562. pd : tprocdef;
  563. found : boolean;
  564. impname,symname : TSymStr;
  565. suffixidx : longint;
  566. begin
  567. for i:=0 to symlist.count-1 do
  568. begin
  569. sym:=tasmsymbol(symlist[i]);
  570. if not (sym.bind in [ab_external,ab_external_indirect]) then
  571. continue;
  572. { remove the indirect suffix }
  573. symname:=sym.name;
  574. if sym.bind=ab_external_indirect then
  575. begin
  576. suffixidx:=pos(suffix_indirect,symname);
  577. if suffixidx=length(symname)-length(suffix_indirect)+1 then
  578. symname:=copy(symname,1,suffixidx-1)
  579. else
  580. internalerror(2016062401);
  581. end;
  582. { did we already import the symbol? }
  583. cacheentry:=pcacheentry(cache.find(symname));
  584. if assigned(cacheentry) then
  585. continue;
  586. { was the symbol already imported in the previous pass? }
  587. found:=false;
  588. for j:=0 to alreadyloaded.count-1 do
  589. begin
  590. psym:=tsymentry(alreadyloaded[j]);
  591. case psym.typ of
  592. procsym:
  593. for k:=0 to tprocsym(psym).procdeflist.count-1 do
  594. begin
  595. pd:=tprocdef(tprocsym(psym).procdeflist[k]);
  596. if has_alias_name(pd,symname) or
  597. (
  598. ([po_external,po_has_importdll]*pd.procoptions=[po_external,po_has_importdll]) and
  599. (symname=proc_get_importname(pd))
  600. ) then
  601. begin
  602. found:=true;
  603. break;
  604. end;
  605. end;
  606. staticvarsym:
  607. if tstaticvarsym(psym).mangledname=symname then
  608. found:=true;
  609. constsym:
  610. begin
  611. if tconstsym(psym).consttyp<>constresourcestring then
  612. internalerror(2016072202);
  613. if make_mangledname('RESSTR',psym.owner,psym.name)=symname then
  614. found:=true;
  615. end;
  616. else
  617. internalerror(2014101003);
  618. end;
  619. if found then
  620. break;
  621. end;
  622. if found then begin
  623. { add a dummy entry }
  624. new(cacheentry);
  625. cacheentry^.pkg:=nil;
  626. cacheentry^.sym:=sym;
  627. cache.add(symname,cacheentry);
  628. continue;
  629. end;
  630. new(cacheentry);
  631. cacheentry^:=findpackagewithsym(symname);
  632. cache.add(symname,cacheentry);
  633. { use cacheentry^.sym instead of sym, because for the later typ
  634. is always at_none in case of an external symbol }
  635. if assigned(cacheentry^.pkg) then
  636. begin
  637. impname:=symname;
  638. if cacheentry^.sym.typ=AT_DATA then
  639. { import as the $indirect symbol if it as a variable }
  640. impname:=symname+suffix_indirect;
  641. current_module.addexternalimport(cacheentry^.pkg.pplfilename,symname,impname,0,cacheentry^.sym.typ=at_data,false);
  642. end;
  643. end;
  644. end;
  645. procedure import_proc_symbol(pd:tprocdef;pkg:tpackage);
  646. var
  647. item : TCmdStrListItem;
  648. begin
  649. item := TCmdStrListItem(pd.aliasnames.first);
  650. if not assigned(item) then
  651. { at least import the mangled name }
  652. current_module.addexternalimport(pkg.pplfilename,pd.mangledname,pd.mangledname,0,false,false);
  653. while assigned(item) do
  654. begin
  655. current_module.addexternalimport(pkg.pplfilename,item.str,item.str,0,false,false);
  656. item := TCmdStrListItem(item.next);
  657. end;
  658. end;
  659. procedure processimportedsyms(syms:tfpobjectlist);
  660. var
  661. i,j,k,l : longint;
  662. pkgentry : ppackageentry;
  663. sym : TSymEntry;
  664. srsymtable : tsymtable;
  665. module : tmodule;
  666. unitentry : pcontainedunit;
  667. name : tsymstr;
  668. pd : tprocdef;
  669. begin
  670. for i:=0 to syms.count-1 do
  671. begin
  672. sym:=tsymentry(syms[i]);
  673. if not (sym.typ in [staticvarsym,procsym,constsym]) or
  674. (
  675. (sym.typ=constsym) and
  676. (tconstsym(sym).consttyp<>constresourcestring)
  677. ) then
  678. continue;
  679. if alreadyloaded.indexof(sym)>=0 then
  680. continue;
  681. { determine the unit of the symbol }
  682. srsymtable:=sym.owner;
  683. while not (srsymtable.symtabletype in [staticsymtable,globalsymtable]) do
  684. srsymtable:=srsymtable.defowner.owner;
  685. module:=tmodule(loaded_units.first);
  686. while assigned(module) do
  687. begin
  688. if (module.globalsymtable=srsymtable) or (module.localsymtable=srsymtable) then
  689. break;
  690. module:=tmodule(module.next);
  691. end;
  692. if not assigned(module) then
  693. internalerror(2014101001);
  694. if (uf_in_library and module.flags)=0 then
  695. { unit is not part of a package, so no need to handle it }
  696. continue;
  697. { loaded by a package? }
  698. for j:=0 to packagelist.count-1 do
  699. begin
  700. pkgentry:=ppackageentry(packagelist[j]);
  701. for k:=0 to pkgentry^.package.containedmodules.count-1 do
  702. begin
  703. unitentry:=pcontainedunit(pkgentry^.package.containedmodules[k]);
  704. if unitentry^.module=module then
  705. begin
  706. case sym.typ of
  707. constsym:
  708. begin
  709. if tconstsym(sym).consttyp<>constresourcestring then
  710. internalerror(2016072201);
  711. name:=make_mangledname('RESSTR',sym.owner,sym.name);
  712. current_module.addexternalimport(pkgentry^.package.pplfilename,name,name+suffix_indirect,0,true,false);
  713. end;
  714. staticvarsym:
  715. begin
  716. name:=tstaticvarsym(sym).mangledname;
  717. current_module.addexternalimport(pkgentry^.package.pplfilename,name,name+suffix_indirect,0,true,false);
  718. end;
  719. procsym:
  720. begin
  721. for l:=0 to tprocsym(sym).procdeflist.count-1 do
  722. begin
  723. pd:=tprocdef(tprocsym(sym).procdeflist[l]);
  724. if [po_external,po_has_importdll]*pd.procoptions=[po_external,po_has_importdll] then
  725. { if we use an external procedure of another unit we
  726. need to import it ourselves from the correct library }
  727. import_external_proc(pd)
  728. else
  729. import_proc_symbol(pd,pkgentry^.package);
  730. end;
  731. end;
  732. else
  733. internalerror(2014101002);
  734. end;
  735. alreadyloaded.add(sym);
  736. end;
  737. end;
  738. end;
  739. end;
  740. end;
  741. var
  742. unitentry : pcontainedunit;
  743. module : tmodule;
  744. i : longint;
  745. begin
  746. cache:=tfphashlist.create;
  747. { check each external asm symbol of each unit of the package whether it is
  748. contained in the unit of a loaded package (and thus an import entry
  749. is needed) }
  750. alreadyloaded:=tfpobjectlist.create(false);
  751. { first pass to find all symbols that were not loaded by asm name }
  752. module:=tmodule(loaded_units.first);
  753. while assigned(module) do
  754. begin
  755. if not assigned(module.package) then
  756. processimportedsyms(module.unitimportsyms);
  757. module:=tmodule(module.next);
  758. end;
  759. { second pass to find all symbols that were loaded by asm name }
  760. module:=tmodule(loaded_units.first);
  761. while assigned(module) do
  762. begin
  763. if not assigned(module.package) then
  764. processasmsyms(module.externasmsyms);
  765. module:=tmodule(module.next);
  766. end;
  767. alreadyloaded.free;
  768. for i:=0 to cache.count-1 do
  769. dispose(pcacheentry(cache[i]));
  770. cache.free;
  771. end;
  772. end.