pkgutil.pas 29 KB

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