|
@@ -41,10 +41,11 @@ implementation
|
|
aasmtai,aasmdata,aasmcpu,aasmbase,
|
|
aasmtai,aasmdata,aasmcpu,aasmbase,
|
|
cgbase,cgobj,ngenutil,
|
|
cgbase,cgobj,ngenutil,
|
|
nbas,nutils,ncgutil,
|
|
nbas,nutils,ncgutil,
|
|
- link,assemble,import,export,gendef,entfile,ppu,comprsrc,dbgbase,
|
|
|
|
|
|
+ link,assemble,import,export,gendef,entfile,ppu,comprsrc,dbgbase,fpcp,
|
|
cresstr,procinfo,
|
|
cresstr,procinfo,
|
|
pexports,
|
|
pexports,
|
|
objcgutl,
|
|
objcgutl,
|
|
|
|
+ pkgutil,
|
|
wpobase,
|
|
wpobase,
|
|
scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti,
|
|
scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti,
|
|
cpuinfo;
|
|
cpuinfo;
|
|
@@ -1370,292 +1371,11 @@ type
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
- procedure procexport(const s : string);
|
|
|
|
- var
|
|
|
|
- hp : texported_item;
|
|
|
|
- begin
|
|
|
|
- hp:=texported_item.create;
|
|
|
|
- hp.name:=stringdup(s);
|
|
|
|
- include(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);
|
|
|
|
- include(hp.options,eo_name);
|
|
|
|
- exportlib.exportvar(hp);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure insert_export(sym : TObject;arg:pointer);
|
|
|
|
- var
|
|
|
|
- i : longint;
|
|
|
|
- item : TCmdStrListItem;
|
|
|
|
- begin
|
|
|
|
- case TSym(sym).typ of
|
|
|
|
- { ignore: }
|
|
|
|
- unitsym,
|
|
|
|
- syssym,
|
|
|
|
- constsym,
|
|
|
|
- enumsym,
|
|
|
|
- typesym:
|
|
|
|
- ;
|
|
|
|
- procsym:
|
|
|
|
- begin
|
|
|
|
- for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
|
|
|
|
- begin
|
|
|
|
- if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and
|
|
|
|
- ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and
|
|
|
|
- ((tsymtable(arg).symtabletype=globalsymtable) or
|
|
|
|
- ((tsymtable(arg).symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions))
|
|
|
|
- ) then
|
|
|
|
- begin
|
|
|
|
- procexport(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname);
|
|
|
|
- { walk through all aliases }
|
|
|
|
- item:=TCmdStrListItem(tprocdef(tprocsym(sym).ProcdefList[i]).aliasnames.first);
|
|
|
|
- while assigned(item) do
|
|
|
|
- begin
|
|
|
|
- { avoid duplicate entries, sometimes aliasnames contains the mangledname }
|
|
|
|
- if item.str<>tprocdef(tprocsym(sym).ProcdefList[i]).mangledname then
|
|
|
|
- procexport(item.str);
|
|
|
|
- item:=TCmdStrListItem(item.next);
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
- staticvarsym:
|
|
|
|
- begin
|
|
|
|
- varexport(tsym(sym).mangledname);
|
|
|
|
- end;
|
|
|
|
- else
|
|
|
|
- begin
|
|
|
|
- writeln('unknown: ',ord(TSym(sym).typ));
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- Function RewritePPU(const PPUFn,PPLFn:String):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;
|
|
|
|
- { No .o file generated for this ppu, just skip }
|
|
|
|
- if (inppu.header.common.flags and uf_no_link)<>0 then
|
|
|
|
- begin
|
|
|
|
- inppu.free;
|
|
|
|
- Result:=true;
|
|
|
|
- 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 }
|
|
|
|
- if (inppu.header.common.flags and uf_static_linked)=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 }
|
|
|
|
- if PPUFn=PPLFn then
|
|
|
|
- outppu:=tppufile.create('ppumove.$$$')
|
|
|
|
- else
|
|
|
|
- outppu:=tppufile.create(PPLFn);
|
|
|
|
- outppu.createfile;
|
|
|
|
- { 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;
|
|
|
|
- { rename }
|
|
|
|
- if PPUFn=PPLFn then
|
|
|
|
- begin
|
|
|
|
- {$push}{$I-}
|
|
|
|
- assign(f,PPUFn);
|
|
|
|
- erase(f);
|
|
|
|
- assign(f,'ppumove.$$$');
|
|
|
|
- rename(f,PPUFn);
|
|
|
|
- {$pop}
|
|
|
|
- if ioresult<>0 then;
|
|
|
|
- end;
|
|
|
|
- Result:=True;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure createimportlibfromexports;
|
|
|
|
- var
|
|
|
|
- hp : texported_item;
|
|
|
|
- begin
|
|
|
|
- hp:=texported_item(current_module._exports.first);
|
|
|
|
- while assigned(hp) do
|
|
|
|
- begin
|
|
|
|
- current_module.AddExternalImport(current_module.realmodulename^,hp.name^,hp.name^,hp.index,hp.is_var,false);
|
|
|
|
- hp:=texported_item(hp.next);
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
procedure proc_package;
|
|
procedure proc_package;
|
|
var
|
|
var
|
|
main_file : tinputfile;
|
|
main_file : tinputfile;
|
|
hp,hp2 : tmodule;
|
|
hp,hp2 : tmodule;
|
|
|
|
+ pkg : tpcppackage;
|
|
{finalize_procinfo,
|
|
{finalize_procinfo,
|
|
init_procinfo,
|
|
init_procinfo,
|
|
main_procinfo : tcgprocinfo;}
|
|
main_procinfo : tcgprocinfo;}
|
|
@@ -1753,7 +1473,7 @@ type
|
|
begin
|
|
begin
|
|
if token=_ID then
|
|
if token=_ID then
|
|
begin
|
|
begin
|
|
- module_name:=pattern;
|
|
|
|
|
|
+ module_name:=orgpattern;
|
|
consume(_ID);
|
|
consume(_ID);
|
|
while token=_POINT do
|
|
while token=_POINT do
|
|
begin
|
|
begin
|
|
@@ -1847,21 +1567,13 @@ type
|
|
loaded_units.remove(hp2);
|
|
loaded_units.remove(hp2);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+ exportlib.ignoreduplicates:=true;
|
|
|
|
+
|
|
{ force exports }
|
|
{ force exports }
|
|
uu:=tused_unit(usedunits.first);
|
|
uu:=tused_unit(usedunits.first);
|
|
while assigned(uu) do
|
|
while assigned(uu) do
|
|
begin
|
|
begin
|
|
- uu.u.globalsymtable.symlist.ForEachCall(@insert_export,uu.u.globalsymtable);
|
|
|
|
- { check localsymtable for exports too to get public symbols }
|
|
|
|
- uu.u.localsymtable.symlist.ForEachCall(@insert_export,uu.u.localsymtable);
|
|
|
|
-
|
|
|
|
- { create special exports }
|
|
|
|
- if (uu.u.flags and uf_init)<>0 then
|
|
|
|
- procexport(make_mangledname('INIT$',uu.u.globalsymtable,''));
|
|
|
|
- if (uu.u.flags and uf_finalize)<>0 then
|
|
|
|
- procexport(make_mangledname('FINALIZE$',uu.u.globalsymtable,''));
|
|
|
|
- if (uu.u.flags and uf_threadvars)=uf_threadvars then
|
|
|
|
- varexport(make_mangledname('THREADVARLIST',uu.u.globalsymtable,''));
|
|
|
|
|
|
+ export_unit(uu.u);
|
|
|
|
|
|
uu:=tused_unit(uu.next);
|
|
uu:=tused_unit(uu.next);
|
|
end;
|
|
end;
|
|
@@ -1879,9 +1591,7 @@ type
|
|
|
|
|
|
exportlib.generatelib;
|
|
exportlib.generatelib;
|
|
|
|
|
|
- { write all our exports to the import library,
|
|
|
|
- needs to be done after exportlib.generatelib; }
|
|
|
|
- createimportlibfromexports;
|
|
|
|
|
|
+ exportlib.ignoreduplicates:=false;
|
|
|
|
|
|
{ generate imports }
|
|
{ generate imports }
|
|
if current_module.ImportLibraryList.Count>0 then
|
|
if current_module.ImportLibraryList.Count>0 then
|
|
@@ -1915,6 +1625,18 @@ type
|
|
|
|
|
|
if (not current_module.is_unit) then
|
|
if (not current_module.is_unit) then
|
|
begin
|
|
begin
|
|
|
|
+ { add all contained units to the package }
|
|
|
|
+ { TODO : handle implicitly imported units }
|
|
|
|
+ pkg:=tpcppackage.create(module_name);
|
|
|
|
+ uu:=tused_unit(current_module.used_units.first);
|
|
|
|
+ while assigned(uu) do
|
|
|
|
+ begin
|
|
|
|
+ pkg.addunit(uu.u);
|
|
|
|
+ uu:=tused_unit(uu.next);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ pkg.initmoduleinfo(current_module);
|
|
|
|
+
|
|
{ finally rewrite all units included into the package }
|
|
{ finally rewrite all units included into the package }
|
|
uu:=tused_unit(usedunits.first);
|
|
uu:=tused_unit(usedunits.first);
|
|
while assigned(uu) do
|
|
while assigned(uu) do
|
|
@@ -1931,6 +1653,10 @@ type
|
|
{ write .def file }
|
|
{ write .def file }
|
|
if (cs_link_deffile in current_settings.globalswitches) then
|
|
if (cs_link_deffile in current_settings.globalswitches) then
|
|
deffile.writefile;
|
|
deffile.writefile;
|
|
|
|
+
|
|
|
|
+ { generate the pcp file }
|
|
|
|
+ pkg.savepcp;
|
|
|
|
+
|
|
{ insert all .o files from all loaded units and
|
|
{ insert all .o files from all loaded units and
|
|
unload the units, we don't need them anymore.
|
|
unload the units, we don't need them anymore.
|
|
Keep the current_module because that is still needed }
|
|
Keep the current_module because that is still needed }
|
|
@@ -1957,6 +1683,8 @@ type
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
Message1(unit_f_errors_in_unit,tostr(Errorcount));
|
|
status.skip_error:=true;
|
|
status.skip_error:=true;
|
|
end;
|
|
end;
|
|
|
|
+
|
|
|
|
+ pkg.free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -2111,6 +1839,10 @@ type
|
|
setupglobalswitches;
|
|
setupglobalswitches;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+ { load all packages, so we know whether a unit is contained inside a
|
|
|
|
+ package or not }
|
|
|
|
+ load_packages;
|
|
|
|
+
|
|
{ global switches are read, so further changes aren't allowed }
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module.in_global:=false;
|
|
current_module.in_global:=false;
|
|
|
|
|
|
@@ -2439,7 +2171,7 @@ type
|
|
hp:=tmodule(loaded_units.first);
|
|
hp:=tmodule(loaded_units.first);
|
|
while assigned(hp) do
|
|
while assigned(hp) do
|
|
begin
|
|
begin
|
|
- if (hp<>sysinitmod) then
|
|
|
|
|
|
+ if (hp<>sysinitmod) and (hp.flags and uf_in_library=0) then
|
|
linker.AddModuleFiles(hp);
|
|
linker.AddModuleFiles(hp);
|
|
hp2:=tmodule(hp.next);
|
|
hp2:=tmodule(hp.next);
|
|
if (hp<>current_module) and
|
|
if (hp<>current_module) and
|