pkgutil.pas 29 KB

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