123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858 |
- {
- Copyright (c) 2013-2014 by Free Pascal Development Team
- This unit implements basic parts of the package system
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit pkgutil;
- {$i fpcdefs.inc}
- interface
- uses
- fmodule,fpkg,link,cstreams,cclasses;
- procedure createimportlibfromexternals;
- Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
- procedure export_unit(u:tmodule);
- procedure load_packages;
- procedure add_package(const name:string;ignoreduplicates:boolean;direct:boolean);
- procedure add_package_unit_ref(package:tpackage);
- procedure add_package_libs(l:tlinker);
- procedure check_for_indirect_package_usages(modules:tlinkedlist);
- implementation
- uses
- sysutils,
- globtype,systems,
- cutils,
- globals,verbose,
- aasmbase,aasmdata,aasmtai,
- symtype,symconst,symsym,symdef,symbase,symtable,
- ppu,entfile,fpcp,
- psub,pdecsub,
- ncgutil,
- ogbase,
- export;
- procedure procexport(const s : string);
- var
- hp : texported_item;
- begin
- hp:=texported_item.create;
- hp.name:=stringdup(s);
- hp.options:=hp.options+[eo_name];
- exportlib.exportprocedure(hp);
- end;
- procedure varexport(const s : string);
- var
- hp : texported_item;
- begin
- hp:=texported_item.create;
- hp.name:=stringdup(s);
- hp.options:=hp.options+[eo_name];
- exportlib.exportvar(hp);
- end;
- procedure exportprocsym(sym:tprocsym;symtable:tsymtable);
- var
- i : longint;
- item : TCmdStrListItem;
- pd : tprocdef;
- begin
- for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
- begin
- pd:=tprocdef(tprocsym(sym).procdeflist[i]);
- if not(pd.proccalloption in [pocall_internproc]) and
- ((pd.procoptions*[po_external])=[]) and
- (
- (symtable.symtabletype in [globalsymtable,recordsymtable,objectsymtable]) or
- (
- (symtable.symtabletype=staticsymtable) and
- ([po_public,po_has_public_name]*pd.procoptions<>[])
- )
- ) and
- not pd.is_generic then
- begin
- exportallprocdefnames(tprocsym(sym),pd,[]);
- end;
- end;
- end;
- procedure exportabstractrecordsymproc(sym:tobject;arg:pointer);
- var
- def : tabstractrecorddef;
- begin
- case tsym(sym).typ of
- typesym:
- begin
- case ttypesym(sym).typedef.typ of
- objectdef,
- recorddef:
- begin
- def:=tabstractrecorddef(ttypesym(sym).typedef);
- { don't export generics or their nested types }
- if df_generic in def.defoptions then
- exit;
- { for cross unit type aliases this might happen }
- if def.owner<>tsymtable(arg) then
- exit;
- def.symtable.symlist.foreachcall(@exportabstractrecordsymproc,def.symtable);
- end;
- end;
- end;
- procsym:
- begin
- { don't export methods of interfaces }
- if is_interface(tdef(tabstractrecordsymtable(arg).defowner)) then
- exit;
- exportprocsym(tprocsym(sym),tsymtable(arg));
- end;
- staticvarsym:
- begin
- varexport(tsym(sym).mangledname);
- end;
- end;
- end;
- procedure insert_export(sym : TObject;arg:pointer);
- var
- i : longint;
- item : TCmdStrListItem;
- def : tabstractrecorddef;
- hp : texported_item;
- publiconly : boolean;
- begin
- publiconly:=tsymtable(arg).symtabletype=staticsymtable;
- case TSym(sym).typ of
- { ignore: }
- unitsym,
- syssym,
- constsym,
- namespacesym,
- propertysym,
- enumsym:
- ;
- typesym:
- begin
- case ttypesym(sym).typedef.typ of
- recorddef,
- objectdef:
- begin
- def:=tabstractrecorddef(ttypesym(sym).typedef);
- if def.is_generic then
- exit;
- { for cross unit type aliases this might happen }
- if def.owner<>tsymtable(arg) then
- exit;
- def.symtable.SymList.ForEachCall(@exportabstractrecordsymproc,def.symtable);
- if (def.typ=objectdef) and (oo_has_vmt in tobjectdef(def).objectoptions) then
- begin
- hp:=texported_item.create;
- hp.name:=stringdup(tobjectdef(def).vmt_mangledname(not (target_info.system in systems_indirect_var_imports)));
- hp.options:=hp.options+[eo_name];
- exportlib.exportvar(hp);
- end;
- end;
- end;
- end;
- procsym:
- begin
- exportprocsym(tprocsym(sym),tsymtable(arg));
- end;
- staticvarsym:
- begin
- if publiconly and not (vo_is_public in tstaticvarsym(sym).varoptions) then
- exit;
- if target_info.system in systems_indirect_var_imports then
- varexport(tsym(sym).mangledname)
- else
- varexport(tsym(sym).mangledname+indirect_suffix);
- end;
- else
- begin
- writeln('unknown: ',TSym(sym).typ);
- end;
- end;
- end;
- procedure export_unit(u: tmodule);
- var
- i : longint;
- isindirect : boolean;
- begin
- { For targets that need indirect variable exports we export the direct symbol
- and an indirect symbol will be generated in the consuming library/program.
- On systems that don't have indirect exports we directly export only the
- indirect symbols }
- u.globalsymtable.symlist.ForEachCall(@insert_export,u.globalsymtable);
- { check localsymtable for exports too to get public symbols }
- u.localsymtable.symlist.ForEachCall(@insert_export,u.localsymtable);
- { export assembler symbols }
- for i:=0 to u.globalasmsyms.count-1 do
- with tasmsymbol(u.globalasmsyms[i]) do
- if bind in [AB_GLOBAL] then
- case typ of
- AT_FUNCTION:
- procexport(name);
- AT_DATA:
- begin
- isindirect := pos(indirect_suffix,name)=length(name)-length(indirect_suffix)+1;
- if (isindirect and (target_info.system in systems_indirect_var_imports)) or
- (not isindirect and not (target_info.system in systems_indirect_var_imports)) then
- continue;
- varexport(name);
- end;
- else
- Writeln('Ignoring asm symbol ',typ);
- end;
- end;
- Function RewritePPU(const PPUFn:String;OutStream:TCStream):Boolean;
- Var
- MakeStatic : Boolean;
- Var
- buffer : array[0..$1fff] of byte;
- inppu,
- outppu : tppufile;
- b,
- untilb : byte;
- l,m : longint;
- f : file;
- ext,
- s : string;
- ppuversion : dword;
- begin
- Result:=false;
- MakeStatic:=False;
- inppu:=tppufile.create(PPUFn);
- if not inppu.openfile then
- begin
- inppu.free;
- Comment(V_Error,'Could not open : '+PPUFn);
- Exit;
- end;
- { Check the ppufile }
- if not inppu.CheckPPUId then
- begin
- inppu.free;
- Comment(V_Error,'Not a PPU File : '+PPUFn);
- Exit;
- end;
- ppuversion:=inppu.getversion;
- if ppuversion<CurrentPPUVersion then
- begin
- inppu.free;
- Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
- Exit;
- end;
- { Already a lib? }
- if (inppu.header.common.flags and uf_in_library)<>0 then
- begin
- inppu.free;
- Comment(V_Error,'PPU is already in a library : '+PPUFn);
- Exit;
- end;
- { We need a static linked unit, but we also accept those without .o file }
- if (inppu.header.common.flags and (uf_static_linked or uf_no_link))=0 then
- begin
- inppu.free;
- Comment(V_Error,'PPU is not static linked : '+PPUFn);
- Exit;
- end;
- { Check if shared is allowed }
- if tsystem(inppu.header.common.target) in [system_i386_go32v2] then
- begin
- Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
- MakeStatic:=true;
- end;
- { Create the new ppu }
- outppu:=tppufile.create(PPUFn);
- outppu.createstream(OutStream);
- { Create new header, with the new flags }
- outppu.header:=inppu.header;
- outppu.header.common.flags:=outppu.header.common.flags or uf_in_library;
- if MakeStatic then
- outppu.header.common.flags:=outppu.header.common.flags or uf_static_linked
- else
- outppu.header.common.flags:=outppu.header.common.flags or uf_shared_linked;
- { read until the object files are found }
- untilb:=iblinkunitofiles;
- repeat
- b:=inppu.readentry;
- if b in [ibendinterface,ibend] then
- begin
- inppu.free;
- outppu.free;
- Comment(V_Error,'No files to be linked found : '+PPUFn);
- Exit;
- end;
- if b<>untilb then
- begin
- repeat
- inppu.getdatabuf(buffer,sizeof(buffer),l);
- outppu.putdata(buffer,l);
- until l<sizeof(buffer);
- outppu.writeentry(b);
- end;
- until (b=untilb);
- { we have now reached the section for the files which need to be added,
- now add them to the list }
- case b of
- iblinkunitofiles :
- begin
- { add all o files, and save the entry when not creating a static
- library to keep staticlinking possible }
- while not inppu.endofentry do
- begin
- s:=inppu.getstring;
- m:=inppu.getlongint;
- if not MakeStatic then
- begin
- outppu.putstring(s);
- outppu.putlongint(m);
- end;
- current_module.linkotherofiles.add(s,link_always);;
- end;
- if not MakeStatic then
- outppu.writeentry(b);
- end;
- { iblinkunitstaticlibs :
- begin
- AddToLinkFiles(ExtractLib(inppu.getstring));
- if not inppu.endofentry then
- begin
- repeat
- inppu.getdatabuf(buffer^,bufsize,l);
- outppu.putdata(buffer^,l);
- until l<bufsize;
- outppu.writeentry(b);
- end;
- end; }
- end;
- { just add a new entry with the new lib }
- if MakeStatic then
- begin
- outppu.putstring('imp'+current_module.realmodulename^);
- outppu.putlongint(link_static);
- outppu.writeentry(iblinkunitstaticlibs)
- end
- else
- begin
- outppu.putstring('imp'+current_module.realmodulename^);
- outppu.putlongint(link_shared);
- outppu.writeentry(iblinkunitsharedlibs);
- end;
- { read all entries until the end and write them also to the new ppu }
- repeat
- b:=inppu.readentry;
- { don't write ibend, that's written automatically }
- if b<>ibend then
- begin
- if b=iblinkothersharedlibs then
- begin
- while not inppu.endofentry do
- begin
- s:=inppu.getstring;
- m:=inppu.getlongint;
- outppu.putstring(s);
- outppu.putlongint(m);
- { strip lib prefix }
- if copy(s,1,3)='lib' then
- delete(s,1,3);
- ext:=ExtractFileExt(s);
- if ext<>'' then
- delete(s,length(s)-length(ext)+1,length(ext));
- current_module.linkOtherSharedLibs.add(s,link_always);
- end;
- end
- else
- repeat
- inppu.getdatabuf(buffer,sizeof(buffer),l);
- outppu.putdata(buffer,l);
- until l<sizeof(buffer);
- outppu.writeentry(b);
- end;
- until b=ibend;
- { write the last stuff and close }
- outppu.flush;
- outppu.writeheader;
- outppu.free;
- inppu.free;
- Result:=True;
- end;
- procedure load_packages;
- var
- i,j : longint;
- pcp: tpcppackage;
- entry,
- entryreq : ppackageentry;
- name,
- uname : string;
- begin
- if not (tf_supports_packages in target_info.flags) then
- exit;
- i:=0;
- while i<packagelist.count do
- begin
- entry:=ppackageentry(packagelist[i]);
- if assigned(entry^.package) then
- internalerror(2013053104);
- //Comment(V_Info,'Loading package: '+entry^.realpkgname);
- pcp:=tpcppackage.create(entry^.realpkgname);
- pcp.loadpcp;
- entry^.package:=pcp;
- { add all required packages that are not yet part of packagelist }
- for j:=0 to pcp.requiredpackages.count-1 do
- begin
- name:=pcp.requiredpackages.NameOfIndex(j);
- uname:=upper(name);
- if not assigned(packagelist.Find(uname)) then
- begin
- New(entryreq);
- entryreq^.realpkgname:=name;
- entryreq^.package:=nil;
- entryreq^.usedunits:=0;
- entryreq^.direct:=false;
- packagelist.add(uname,entryreq);
- end;
- end;
- Inc(i);
- end;
- { all packages are now loaded, so we can fill in the links of the required packages }
- for i:=0 to packagelist.count-1 do
- begin
- entry:=ppackageentry(packagelist[i]);
- if not assigned(entry^.package) then
- internalerror(2015111301);
- for j:=0 to entry^.package.requiredpackages.count-1 do
- begin
- if assigned(entry^.package.requiredpackages[j]) then
- internalerror(2015111303);
- entryreq:=packagelist.find(upper(entry^.package.requiredpackages.NameOfIndex(j)));
- if not assigned(entryreq) then
- internalerror(2015111302);
- entry^.package.requiredpackages[j]:=entryreq^.package;
- end;
- end;
- end;
- procedure add_package(const name:string;ignoreduplicates:boolean;direct:boolean);
- var
- entry : ppackageentry;
- i : longint;
- begin
- for i:=0 to packagelist.count-1 do
- begin
- if packagelist.nameofindex(i)=name then
- begin
- if not ignoreduplicates then
- Message1(package_e_duplicate_package,name);
- exit;
- end;
- end;
- new(entry);
- entry^.package:=nil;
- entry^.realpkgname:=name;
- entry^.usedunits:=0;
- entry^.direct:=direct;
- packagelist.add(upper(name),entry);
- end;
- procedure add_package_unit_ref(package: tpackage);
- var
- pkgentry : ppackageentry;
- begin
- pkgentry:=ppackageentry(packagelist.find(package.packagename^));
- if not assigned(pkgentry) then
- internalerror(2015100301);
- inc(pkgentry^.usedunits);
- end;
- procedure add_package_libs(l:tlinker);
- var
- pkgentry : ppackageentry;
- i : longint;
- pkgname : tpathstr;
- begin
- if target_info.system in systems_indirect_var_imports then
- { we're using import libraries anyway }
- exit;
- for i:=0 to packagelist.count-1 do
- begin
- pkgentry:=ppackageentry(packagelist[i]);
- if pkgentry^.usedunits>0 then
- begin
- //writeln('package used: ',pkgentry^.realpkgname);
- pkgname:=pkgentry^.package.pplfilename;
- if copy(pkgname,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
- delete(pkgname,1,length(target_info.sharedlibprefix));
- if copy(pkgname,length(pkgname)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
- delete(pkgname,length(pkgname)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext));
- //writeln('adding library: ', pkgname);
- l.sharedlibfiles.concat(pkgname);
- end
- else
- {writeln('ignoring package: ',pkgentry^.realpkgname)};
- end;
- end;
- procedure check_for_indirect_package_usages(modules:tlinkedlist);
- var
- uu : tused_unit;
- pentry : ppackageentry;
- begin
- uu:=tused_unit(modules.first);
- while assigned(uu) do
- begin
- if assigned(uu.u.package) then
- begin
- pentry:=ppackageentry(packagelist.find(uu.u.package.packagename^));
- if not assigned(pentry) then
- internalerror(2015112304);
- if not pentry^.direct then
- Message2(package_w_unit_from_indirect_package,uu.u.realmodulename^,uu.u.package.realpackagename^);
- end;
- uu:=tused_unit(uu.Next);
- end;
- end;
- procedure createimportlibfromexternals;
- type
- tcacheentry=record
- pkg:tpackage;
- sym:tasmsymbol;
- end;
- pcacheentry=^tcacheentry;
- var
- cache : tfphashlist;
- alreadyloaded : tfpobjectlist;
- function findpackagewithsym(symname:tsymstr):tcacheentry;
- var
- i,j : longint;
- pkgentry : ppackageentry;
- unitentry : pcontainedunit;
- begin
- for i:=0 to packagelist.count-1 do
- begin
- pkgentry:=ppackageentry(packagelist[i]);
- for j:=0 to pkgentry^.package.containedmodules.count-1 do
- begin
- unitentry:=pcontainedunit(pkgentry^.package.containedmodules[j]);
- if not assigned(unitentry^.module) then
- { the unit is not loaded }
- continue;
- result.sym:=tasmsymbol(tmodule(unitentry^.module).globalasmsyms.find(symname));
- if assigned(result.sym) then
- begin
- { completely ignore other external symbols }
- if result.sym.bind in [ab_external,ab_weak_external] then
- begin
- result.sym:=nil;
- continue;
- end;
- { only accept global symbols of the used unit }
- if result.sym.bind<>ab_global then
- begin
- result.sym:=nil;
- result.pkg:=nil;
- end
- else
- result.pkg:=pkgentry^.package;
- exit;
- end;
- end;
- end;
- result.sym:=nil;
- result.pkg:=nil;
- end;
- procedure processasmsyms(symlist:tfphashobjectlist);
- var
- i,j,k : longint;
- sym : tasmsymbol;
- cacheentry : pcacheentry;
- list : TAsmList;
- labind : tasmsymbol;
- psym : tsymentry;
- pd : tprocdef;
- found : boolean;
- impname,symname : TSymStr;
- suffixidx : longint;
- begin
- for i:=0 to symlist.count-1 do
- begin
- sym:=tasmsymbol(symlist[i]);
- if sym.bind<>ab_external then
- continue;
- { remove the indirect suffix }
- symname:=sym.name;
- suffixidx:=pos(indirect_suffix,symname);
- if suffixidx=length(symname)-length(indirect_suffix)+1 then
- symname:=copy(symname,1,suffixidx-1);
- { did we already import the symbol? }
- cacheentry:=pcacheentry(cache.find(symname));
- if assigned(cacheentry) then
- continue;
- { was the symbol already imported in the previous pass? }
- found:=false;
- for j:=0 to alreadyloaded.count-1 do
- begin
- psym:=tsymentry(alreadyloaded[j]);
- case psym.typ of
- procsym:
- for k:=0 to tprocsym(psym).procdeflist.count-1 do
- begin
- pd:=tprocdef(tprocsym(psym).procdeflist[k]);
- if has_alias_name(pd,symname) or
- (
- ([po_external,po_has_importdll]*pd.procoptions=[po_external,po_has_importdll]) and
- (symname=proc_get_importname(pd))
- ) then
- begin
- found:=true;
- break;
- end;
- end;
- staticvarsym:
- if tstaticvarsym(psym).mangledname=symname then
- found:=true;
- else
- internalerror(2014101005);
- end;
- if found then
- break;
- end;
- if found then begin
- //writeln('asm symbol ', symname, ' is already imported');
- { add a dummy entry }
- new(cacheentry);
- cacheentry^.pkg:=nil;
- cacheentry^.sym:=sym;
- cache.add(symname,cacheentry);
- continue;
- end;
- new(cacheentry);
- cacheentry^:=findpackagewithsym(symname);
- cache.add(symname,cacheentry);
- { use cacheentry^.sym instead of sym, because for the later typ
- is always at_none in case of an external symbol }
- if assigned(cacheentry^.pkg) then
- begin
- impname:=symname;
- if cacheentry^.sym.typ=AT_DATA then
- { import as the $indirect symbol if it as a variable }
- impname:=symname+indirect_suffix;
- current_module.addexternalimport(cacheentry^.pkg.pplfilename,symname,impname,0,cacheentry^.sym.typ=at_data,false);
- end;
- end;
- end;
- procedure import_proc_symbol(pd:tprocdef;pkg:tpackage);
- var
- item : TCmdStrListItem;
- begin
- item := TCmdStrListItem(pd.aliasnames.first);
- if not assigned(item) then
- { at least import the mangled name }
- current_module.addexternalimport(pkg.pplfilename,pd.mangledname,pd.mangledname,0,false,false);
- while assigned(item) do
- begin
- current_module.addexternalimport(pkg.pplfilename,item.str,item.str,0,false,false);
- item := TCmdStrListItem(item.next);
- end;
- end;
- procedure processimportedsyms(syms:tfpobjectlist);
- var
- i,j,k,l : longint;
- pkgentry : ppackageentry;
- sym : TSymEntry;
- srsymtable : tsymtable;
- module : tmodule;
- unitentry : pcontainedunit;
- name : tsymstr;
- labind : tasmsymbol;
- pd : tprocdef;
- list : tasmlist;
- centry : pcacheentry;
- begin
- for i:=0 to syms.count-1 do
- begin
- sym:=tsymentry(syms[i]);
- if not (sym.typ in [staticvarsym,procsym]) then
- continue;
- if alreadyloaded.indexof(sym)>=0 then
- begin
- //writeln('symbol ', sym.name, ' already imported');
- continue;
- end;
- { determine the unit of the symbol }
- srsymtable:=sym.owner;
- while not (srsymtable.symtabletype in [staticsymtable,globalsymtable]) do
- srsymtable:=srsymtable.defowner.owner;
- module:=tmodule(loaded_units.first);
- while assigned(module) do
- begin
- if (module.globalsymtable=srsymtable) or (module.localsymtable=srsymtable) then
- break;
- module:=tmodule(module.next);
- end;
- if not assigned(module) then
- internalerror(2014101001);
- if (uf_in_library and module.flags)=0 then
- { unit is not part of a package, so no need to handle it }
- continue;
- //writeln('found symbol ', sym.name, ' in package unit ', module.modulename^);
- { loaded by a package? }
- for j:=0 to packagelist.count-1 do
- begin
- pkgentry:=ppackageentry(packagelist[j]);
- for k:=0 to pkgentry^.package.containedmodules.count-1 do
- begin
- unitentry:=pcontainedunit(pkgentry^.package.containedmodules[k]);
- if unitentry^.module=module then
- begin
- //writeln('symbol ', sym.name, ' is part of package ', pkgentry^.package.packagename^);
- case sym.typ of
- staticvarsym:
- begin
- name:=tstaticvarsym(sym).mangledname;
- current_module.addexternalimport(pkgentry^.package.pplfilename,name,name+indirect_suffix,0,true,false);
- end;
- procsym:
- begin
- for l:=0 to tprocsym(sym).procdeflist.count-1 do
- begin
- pd:=tprocdef(tprocsym(sym).procdeflist[l]);
- if [po_external,po_has_importdll]*pd.procoptions=[po_external,po_has_importdll] then
- begin
- { if we use an external procedure of another unit we
- need to import it ourselves from the correct library }
- import_external_proc(pd);
- New(centry);
- centry^.sym:=nil;
- centry^.pkg:=pkgentry^.package;
- cache.add(proc_get_importname(pd),centry);
- end
- else
- import_proc_symbol(pd,pkgentry^.package);
- end;
- end;
- else
- internalerror(2014101001);
- end;
- alreadyloaded.add(sym);
- end;
- end;
- end;
- end;
- end;
- var
- unitentry : pcontainedunit;
- i : longint;
- sym : tasmsymbol;
- module : tmodule;
- begin
- cache:=tfphashlist.create;
- { check each external asm symbol of each unit of the package whether it is
- contained in the unit of a loaded package (and thus an import entry
- is needed) }
- alreadyloaded:=tfpobjectlist.create(false);
- { we were called from a program/library }
- { first pass to find all symbols that were not loaded by asm name }
- module:=tmodule(loaded_units.first);
- while assigned(module) do
- begin
- //writeln('processing imported symbols of unit ', module.modulename^);
- if not assigned(module.package) then
- begin
- processimportedsyms(module.unitimportsyms);
- { this unit is not part of a package }
- (*if module=current_module then
- { this is the main file, which does not fill globalasmsyms }
- processasmsyms(tasmdata(module.asmdata).asmsymboldict)
- else
- { this is an ordinary unit }
- processasmsyms(module.globalasmsyms);*)
- end
- {else
- writeln(module.modulename^, ' is a package unit; ignoring')};
- module:=tmodule(module.next);
- end;
- { second pass to find all symbols that were loaded by asm name }
- module:=tmodule(loaded_units.first);
- while assigned(module) do
- begin
- if not assigned(module.package) then
- begin
- //writeln('processing assembler symbols of unit ', module.modulename^);
- if module=current_module then
- { this is the main file, which does not fill globalasmsyms }
- processasmsyms(tasmdata(module.asmdata).asmsymboldict)
- else
- { this is an ordinary unit }
- processasmsyms(module.globalasmsyms);
- end;
- module:=tmodule(module.next);
- end;
- alreadyloaded.free;
- for i:=0 to cache.count-1 do
- dispose(pcacheentry(cache[i]));
- cache.free;
- end;
- end.
|