mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-29 00:04:58 +01:00
Merge first batch of package handling related revisions from the packages branch
Merged revision(s) 28796, 28837-28845, 28847-28850, 28852, 32135 from branches/svenbarth/packages:
Provide possibility to pass packages and search paths for packages as parameters.
fpkg.pas:
+ new unit which contains the base types related to package files (most importantly "tpackage")
globals.pas:
+ new variable "packagesearchpath" which contains all paths in which package files should be looked for
+ new variable "packagelist" which contains a list of all packages that should be used in a program or library
* InitGlobals & DoneGlobals: initialize/finalize "packagesearchpath" accordingly ("packagelist" is handled in unit fpkg using a init/done-callback)
options.pas:
+ TOption: new fields "parapackagepath" and "parapackages" to keep track of package search paths and package files passed as parameters
* TOption.interpret_option: use '-Fp' for package search paths and '-FP' for package files
* read_arguments: apply the passed package search paths and packages to their respective containers
........
+ add a new unit which will contain basic functions related to handling packages
........
Move package related functions from pmodules to pkgutil.
pmodules.pas => pkgutil.pas:
* createimportlibfromexports
* varexport
* procexport
* insert_export
* RewritePPU
........
* adjust indentation
........
Extract the code to export the symbols of a unit to its own function in pkgutil so that less functions need to be exported.
pmodules.pas, proc_package:
* move code to export the symbols of a unit to new function export_unit
pkgutil.pas:
+ new function export_unit
- remove exports of procexport, varexport and insert_export
........
Some small fixes for package parsing.
pmodules.pas, proc_package:
* use orgpattern instead of pattern to build the module name (like is done in uses sections)
* ignore duplicates when generating exports
- no need to generate an import library for the package; that is done by the program/library that uses the package
........
+ new unit fpcp of which the class tpcppackage handles the reading and writing of package metadata from/to pcp files (equivalant to tppumodule).
........
+ add unit which contains representation of a PCP file (tpcpfile) like tppufile is for units.
........
Improve export generation.
pkgutil.pas:
+ new function exportprocsym to correctly export a procedure with all its aliases
+ new function exportabstractrecordsymproc to export the members of structured types
* insert_export: handle also namespacesym and propertsym (by ignoring them)
* insert_export: correctly export classes, record and objects
* insert_export: use new exportprocsym function to export a procsym
* insert_export: only export public variables of a static symtable
........
+ add entry constants for the name of the package and the package file names, both used by a PCP file
........
* use messages to get rid of most writelns related to package loading
........
Add additional entry types for PCP files
entfile.pas:
+ new entries ibstartrequireds and ibendrequireds to store the list of required packages
+ new entries ibstartcontained and ibendcontained to store the list of contained units
+ new entries ibstartppus and ibendppus to store the list of contained PPU files
........
Generate the PCP file once the package file and the used units were compiled correctly.
pmodules.pas:
* proc_package: generate the PCP file upon successful compilation
........
Add the possibility to load all packages supplied as parameters.
pkgutil.pas:
+ new function load_packages to load all packages supplied as parameters
pmodules.pas, proc_program:
* use load_packages to load all packages before any unit is loaded
........
Add code which tries to load a unit from a package first and only then as usual.
fppu.pas, tppumodule:
+ new method loadfrompackage which searches all available packages for the unit and loads it from there if found
* loadppu: first try to load the unit from a package if any are available
........
Don't link objects files of a unit that is provided by a package.
pmodules.pas, proc_program:
* if a unit has uf_in_library set we must not include it in the units we link against
........
git-svn-id: trunk@33452 -
This commit is contained in:
parent
0f9e556c80
commit
f8e9b33f99
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -174,6 +174,8 @@ compiler/finput.pas svneol=native#text/plain
|
|||||||
compiler/fmodule.pas svneol=native#text/plain
|
compiler/fmodule.pas svneol=native#text/plain
|
||||||
compiler/fpccrc.pas svneol=native#text/plain
|
compiler/fpccrc.pas svneol=native#text/plain
|
||||||
compiler/fpcdefs.inc svneol=native#text/plain
|
compiler/fpcdefs.inc svneol=native#text/plain
|
||||||
|
compiler/fpcp.pas svneol=native#text/pascal
|
||||||
|
compiler/fpkg.pas svneol=native#text/pascal
|
||||||
compiler/fppu.pas svneol=native#text/plain
|
compiler/fppu.pas svneol=native#text/plain
|
||||||
compiler/gendef.pas svneol=native#text/plain
|
compiler/gendef.pas svneol=native#text/plain
|
||||||
compiler/generic/cpuinfo.pas svneol=native#text/plain
|
compiler/generic/cpuinfo.pas svneol=native#text/plain
|
||||||
@ -524,6 +526,7 @@ compiler/parser.pas svneol=native#text/plain
|
|||||||
compiler/pass_1.pas svneol=native#text/plain
|
compiler/pass_1.pas svneol=native#text/plain
|
||||||
compiler/pass_2.pas svneol=native#text/plain
|
compiler/pass_2.pas svneol=native#text/plain
|
||||||
compiler/pbase.pas svneol=native#text/plain
|
compiler/pbase.pas svneol=native#text/plain
|
||||||
|
compiler/pcp.pas svneol=native#text/pascal
|
||||||
compiler/pdecl.pas svneol=native#text/plain
|
compiler/pdecl.pas svneol=native#text/plain
|
||||||
compiler/pdecobj.pas svneol=native#text/plain
|
compiler/pdecobj.pas svneol=native#text/plain
|
||||||
compiler/pdecsub.pas svneol=native#text/plain
|
compiler/pdecsub.pas svneol=native#text/plain
|
||||||
@ -533,6 +536,7 @@ compiler/pexpr.pas svneol=native#text/plain
|
|||||||
compiler/pgentype.pas svneol=native#text/pascal
|
compiler/pgentype.pas svneol=native#text/pascal
|
||||||
compiler/pgenutil.pas svneol=native#text/pascal
|
compiler/pgenutil.pas svneol=native#text/pascal
|
||||||
compiler/pinline.pas svneol=native#text/plain
|
compiler/pinline.pas svneol=native#text/plain
|
||||||
|
compiler/pkgutil.pas svneol=native#text/pascal
|
||||||
compiler/pmodules.pas svneol=native#text/plain
|
compiler/pmodules.pas svneol=native#text/plain
|
||||||
compiler/powerpc/agppcmpw.pas svneol=native#text/plain
|
compiler/powerpc/agppcmpw.pas svneol=native#text/plain
|
||||||
compiler/powerpc/agppcvasm.pas svneol=native#text/plain
|
compiler/powerpc/agppcvasm.pas svneol=native#text/plain
|
||||||
|
|||||||
@ -38,6 +38,10 @@ const
|
|||||||
subentryid = 2;
|
subentryid = 2;
|
||||||
{special}
|
{special}
|
||||||
iberror = 0;
|
iberror = 0;
|
||||||
|
ibstartrequireds = 244;
|
||||||
|
ibendrequireds = 245;
|
||||||
|
ibstartcontained = 246;
|
||||||
|
ibendcontained = 247;
|
||||||
ibstartdefs = 248;
|
ibstartdefs = 248;
|
||||||
ibenddefs = 249;
|
ibenddefs = 249;
|
||||||
ibstartsyms = 250;
|
ibstartsyms = 250;
|
||||||
@ -117,6 +121,8 @@ const
|
|||||||
ibmainname = 90;
|
ibmainname = 90;
|
||||||
ibsymtableoptions = 91;
|
ibsymtableoptions = 91;
|
||||||
ibrecsymtableoptions = 91;
|
ibrecsymtableoptions = 91;
|
||||||
|
ibpackagefiles = 92;
|
||||||
|
ibpackagename = 93;
|
||||||
{ target-specific things }
|
{ target-specific things }
|
||||||
iblinkotherframeworks = 100;
|
iblinkotherframeworks = 100;
|
||||||
ibjvmnamespace = 101;
|
ibjvmnamespace = 101;
|
||||||
|
|||||||
394
compiler/fpcp.pas
Normal file
394
compiler/fpcp.pas
Normal file
@ -0,0 +1,394 @@
|
|||||||
|
{
|
||||||
|
Copyright (c) 2013-2016 by Free Pascal development team
|
||||||
|
|
||||||
|
This unit implements the loading and searching of package files
|
||||||
|
|
||||||
|
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 fpcp;
|
||||||
|
|
||||||
|
{$i fpcdefs.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
cclasses,
|
||||||
|
globtype,
|
||||||
|
pcp,finput,fpkg;
|
||||||
|
|
||||||
|
type
|
||||||
|
tpcppackage=class(tpackage)
|
||||||
|
private
|
||||||
|
loaded : boolean;
|
||||||
|
pcpfile : tpcpfile;
|
||||||
|
private
|
||||||
|
function openpcp:boolean;
|
||||||
|
function search_package(ashortname:boolean):boolean;
|
||||||
|
function search_package_file:boolean;
|
||||||
|
procedure setfilename(const fn:string;allowoutput:boolean);
|
||||||
|
procedure writecontainernames;
|
||||||
|
procedure writecontainedunits;
|
||||||
|
procedure readcontainernames;
|
||||||
|
procedure readcontainedunits;
|
||||||
|
public
|
||||||
|
constructor create(const pn:string);
|
||||||
|
destructor destroy; override;
|
||||||
|
procedure loadpcp;
|
||||||
|
procedure savepcp;
|
||||||
|
procedure initmoduleinfo(module:tmodulebase);
|
||||||
|
procedure addunit(module:tmodulebase);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
sysutils,
|
||||||
|
cfileutl,cutils,
|
||||||
|
systems,globals,version,
|
||||||
|
verbose,
|
||||||
|
entfile,fppu;
|
||||||
|
|
||||||
|
{ tpcppackage }
|
||||||
|
|
||||||
|
function tpcppackage.openpcp: boolean;
|
||||||
|
var
|
||||||
|
pcpfiletime : longint;
|
||||||
|
begin
|
||||||
|
result:=false;
|
||||||
|
Message1(package_t_pcp_loading,pcpfilename);
|
||||||
|
{ Get pcpfile time (also check if the file exists) }
|
||||||
|
pcpfiletime:=getnamedfiletime(pcpfilename);
|
||||||
|
if pcpfiletime=-1 then
|
||||||
|
exit;
|
||||||
|
{ Open the pcpfile }
|
||||||
|
Message1(package_u_pcp_name,pcpfilename);
|
||||||
|
pcpfile:=tpcpfile.create(pcpfilename);
|
||||||
|
if not pcpfile.openfile then
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
Message(package_u_pcp_file_too_short);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ check for a valid PPU file }
|
||||||
|
if not pcpfile.checkpcpid then
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
Message(package_u_pcp_invalid_header);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ check for allowed PCP versions }
|
||||||
|
if not (pcpfile.getversion=CurrentPCPVersion) then
|
||||||
|
begin
|
||||||
|
Message1(package_u_pcp_invalid_version,tostr(pcpfile.getversion));
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ check the target processor }
|
||||||
|
if tsystemcpu(pcpfile.header.common.cpu)<>target_cpu then
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
Message(package_u_pcp_invalid_processor);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ check target }
|
||||||
|
if tsystem(pcpfile.header.common.target)<>target_info.system then
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
Message(package_u_pcp_invalid_target);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{$ifdef cpufpemu}
|
||||||
|
{ check if floating point emulation is on?
|
||||||
|
fpu emulation isn't unit levelwise because it affects calling convention }
|
||||||
|
if ((pcpfile.header.common.flags and uf_fpu_emulation)<>0) xor
|
||||||
|
(cs_fp_emulation in current_settings.moduleswitches) then
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
Message(package_u_pcp_invalid_fpumode);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{$endif cpufpemu}
|
||||||
|
|
||||||
|
{ Load values to be access easier }
|
||||||
|
//flags:=pcpfile.header.common.flags;
|
||||||
|
//crc:=pcpfile.header.checksum;
|
||||||
|
{ Show Debug info }
|
||||||
|
Message1(package_u_pcp_time,filetimestring(pcpfiletime));
|
||||||
|
Message1(package_u_pcp_flags,tostr(pcpfile.header.common.flags{flags}));
|
||||||
|
Message1(package_u_pcp_crc,hexstr(pcpfile.header.checksum,8));
|
||||||
|
(*Message1(package_u_pcp_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
|
||||||
|
Message1(package_u_pcp_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
|
||||||
|
Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
|
||||||
|
Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
|
||||||
|
do_compile:=false;*)
|
||||||
|
result:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function tpcppackage.search_package(ashortname:boolean):boolean;
|
||||||
|
var
|
||||||
|
singlepathstring,
|
||||||
|
filename : TCmdStr;
|
||||||
|
|
||||||
|
function package_exists(const ext:string;var foundfile:TCmdStr):boolean;
|
||||||
|
begin
|
||||||
|
if CheckVerbosity(V_Tried) then
|
||||||
|
Message1(package_t_packagesearch,Singlepathstring+filename+ext);
|
||||||
|
result:=FindFile(filename+ext,singlepathstring,true,foundfile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function package_search_path(const s:TCmdStr):boolean;
|
||||||
|
var
|
||||||
|
found : boolean;
|
||||||
|
hs : TCmdStr;
|
||||||
|
begin
|
||||||
|
found:=false;
|
||||||
|
singlepathstring:=FixPath(s,false);
|
||||||
|
{ Check for package file }
|
||||||
|
{ TODO }
|
||||||
|
found:=package_exists({target_info.pkginfoext}'.pcp',hs);
|
||||||
|
if found then
|
||||||
|
begin
|
||||||
|
setfilename(hs,false);
|
||||||
|
found:=openpcp;
|
||||||
|
end;
|
||||||
|
result:=found;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function search_path_list(list:TSearchPathList):boolean;
|
||||||
|
var
|
||||||
|
hp : TCmdStrListItem;
|
||||||
|
found : boolean;
|
||||||
|
begin
|
||||||
|
found:=false;
|
||||||
|
hp:=TCmdStrListItem(list.First);
|
||||||
|
while assigned(hp) do
|
||||||
|
begin
|
||||||
|
found:=package_search_path(hp.Str);
|
||||||
|
if found then
|
||||||
|
break;
|
||||||
|
hp:=TCmdStrListItem(hp.next);
|
||||||
|
end;
|
||||||
|
result:=found;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
filename:=packagename^;
|
||||||
|
result:=search_path_list(packagesearchpath);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function tpcppackage.search_package_file: boolean;
|
||||||
|
var
|
||||||
|
found : boolean;
|
||||||
|
begin
|
||||||
|
found:=false;
|
||||||
|
if search_package(false) then
|
||||||
|
found:=true;
|
||||||
|
if not found and
|
||||||
|
(length(packagename^)>8) and
|
||||||
|
search_package(true) then
|
||||||
|
found:=true;
|
||||||
|
result:=found;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.setfilename(const fn:string;allowoutput:boolean);
|
||||||
|
var
|
||||||
|
p,n : tpathstr;
|
||||||
|
begin
|
||||||
|
p:=FixPath(ExtractFilePath(fn),false);
|
||||||
|
n:=FixFileName(ChangeFileExt(ExtractFileName(fn),''));
|
||||||
|
{ pcp name }
|
||||||
|
if allowoutput then
|
||||||
|
if (OutputUnitDir<>'') then
|
||||||
|
p:=OutputUnitDir
|
||||||
|
else
|
||||||
|
if (OutputExeDir<>'') then
|
||||||
|
p:=OutputExeDir;
|
||||||
|
pcpfilename:=p+n+{target_info.pkginfoext}'.pcp';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.writecontainernames;
|
||||||
|
begin
|
||||||
|
pcpfile.putstring(pplfilename);
|
||||||
|
//pcpfile.putstring(ppafilename);
|
||||||
|
pcpfile.writeentry(ibpackagefiles);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.writecontainedunits;
|
||||||
|
var
|
||||||
|
p : pcontainedunit;
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
pcpfile.putlongint(containedmodules.count);
|
||||||
|
pcpfile.writeentry(ibstartcontained);
|
||||||
|
{ for now we write the unit name and the ppu file name }
|
||||||
|
for i:=0 to containedmodules.count-1 do
|
||||||
|
begin
|
||||||
|
p:=pcontainedunit(containedmodules.items[i]);
|
||||||
|
pcpfile.putstring(p^.module.modulename^);
|
||||||
|
pcpfile.putstring(p^.ppufile);
|
||||||
|
end;
|
||||||
|
pcpfile.writeentry(ibendcontained);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.readcontainernames;
|
||||||
|
begin
|
||||||
|
if pcpfile.readentry<>ibpackagefiles then
|
||||||
|
begin
|
||||||
|
message(package_f_pcp_read_error);
|
||||||
|
internalerror(424242);
|
||||||
|
end;
|
||||||
|
pplfilename:=pcpfile.getstring;
|
||||||
|
|
||||||
|
writeln('PPL filename: ',pplfilename);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.readcontainedunits;
|
||||||
|
var
|
||||||
|
cnt,i : longint;
|
||||||
|
name,path : string;
|
||||||
|
p : pcontainedunit;
|
||||||
|
begin
|
||||||
|
if pcpfile.readentry<>ibstartcontained then
|
||||||
|
begin
|
||||||
|
message(package_f_pcp_read_error);
|
||||||
|
internalerror(424242);
|
||||||
|
end;
|
||||||
|
cnt:=pcpfile.getlongint;
|
||||||
|
if pcpfile.readentry<>ibendcontained then
|
||||||
|
begin
|
||||||
|
message(package_f_pcp_read_error);
|
||||||
|
internalerror(424242);
|
||||||
|
end;
|
||||||
|
for i:=0 to cnt-1 do
|
||||||
|
begin
|
||||||
|
name:=pcpfile.getstring;
|
||||||
|
path:=ChangeFileExt(pcpfile.getstring,'.ppl.ppu');
|
||||||
|
new(p);
|
||||||
|
p^.module:=nil;
|
||||||
|
p^.ppufile:=path;
|
||||||
|
containedmodules.add(name,p);
|
||||||
|
message1(package_u_contained_unit,name);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor tpcppackage.create(const pn: string);
|
||||||
|
begin
|
||||||
|
inherited create(pn);
|
||||||
|
setfilename(pn,true);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor tpcppackage.destroy;
|
||||||
|
begin
|
||||||
|
pcpfile.free;
|
||||||
|
inherited destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.loadpcp;
|
||||||
|
var
|
||||||
|
newpackagename : string;
|
||||||
|
begin
|
||||||
|
if loaded then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if not search_package_file then
|
||||||
|
begin
|
||||||
|
Message1(package_f_cant_find_pcp,realpackagename^);
|
||||||
|
exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Message1(package_u_pcp_found,realpackagename^);
|
||||||
|
|
||||||
|
if not assigned(pcpfile) then
|
||||||
|
internalerror(2013053101);
|
||||||
|
|
||||||
|
if pcpfile.readentry<>ibpackagename then
|
||||||
|
Message1(package_f_cant_read_pcp,realpackagename^);
|
||||||
|
newpackagename:=pcpfile.getstring;
|
||||||
|
if upper(newpackagename)<>packagename^ then
|
||||||
|
Comment(V_Error,'Package was renamed: '+realpackagename^);
|
||||||
|
|
||||||
|
readcontainernames;
|
||||||
|
|
||||||
|
//readrequiredpackages
|
||||||
|
|
||||||
|
readcontainedunits;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.savepcp;
|
||||||
|
begin
|
||||||
|
{ create new ppufile }
|
||||||
|
pcpfile:=tpcpfile.create(pcpfilename);
|
||||||
|
if not pcpfile.createfile then
|
||||||
|
Message2(package_f_cant_create_pcp,realpackagename^,pcpfilename);
|
||||||
|
|
||||||
|
pcpfile.putstring(realpackagename^);
|
||||||
|
pcpfile.writeentry(ibpackagename);
|
||||||
|
|
||||||
|
writecontainernames;
|
||||||
|
|
||||||
|
//writerequiredpackages;
|
||||||
|
|
||||||
|
writecontainedunits;
|
||||||
|
|
||||||
|
//writeppus;
|
||||||
|
|
||||||
|
{ the last entry ibend is written automatically }
|
||||||
|
|
||||||
|
{ flush to be sure }
|
||||||
|
pcpfile.flush;
|
||||||
|
{ create and write header }
|
||||||
|
pcpfile.header.common.size:=pcpfile.size;
|
||||||
|
pcpfile.header.checksum:=pcpfile.crc;
|
||||||
|
pcpfile.header.common.compiler:=wordversion;
|
||||||
|
pcpfile.header.common.cpu:=word(target_cpu);
|
||||||
|
pcpfile.header.common.target:=word(target_info.system);
|
||||||
|
//pcpfile.header.flags:=flags;
|
||||||
|
pcpfile.header.ppulistsize:=containedmodules.count;
|
||||||
|
pcpfile.header.requiredlistsize:=requiredpackages.count;
|
||||||
|
pcpfile.writeheader;
|
||||||
|
|
||||||
|
{ save crc in current module also }
|
||||||
|
//crc:=pcpfile.crc;
|
||||||
|
|
||||||
|
pcpfile.closefile;
|
||||||
|
pcpfile.free;
|
||||||
|
pcpfile:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.initmoduleinfo(module: tmodulebase);
|
||||||
|
begin
|
||||||
|
pplfilename:=extractfilename(module.sharedlibfilename);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcppackage.addunit(module: tmodulebase);
|
||||||
|
var
|
||||||
|
containedunit : pcontainedunit;
|
||||||
|
begin
|
||||||
|
new(containedunit);
|
||||||
|
containedunit^.module:=module;
|
||||||
|
containedunit^.ppufile:=extractfilename(module.ppufilename);
|
||||||
|
containedmodules.add(module.modulename^,containedunit);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
131
compiler/fpkg.pas
Normal file
131
compiler/fpkg.pas
Normal file
@ -0,0 +1,131 @@
|
|||||||
|
{
|
||||||
|
Copyright (c) 2013-2016 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 fpkg;
|
||||||
|
|
||||||
|
{$i fpcdefs.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
cclasses,
|
||||||
|
globtype,
|
||||||
|
finput;
|
||||||
|
|
||||||
|
type
|
||||||
|
tcontainedunit=record
|
||||||
|
module:tmodulebase;
|
||||||
|
ppufile:tpathstr;
|
||||||
|
end;
|
||||||
|
pcontainedunit=^tcontainedunit;
|
||||||
|
|
||||||
|
tpackage=class
|
||||||
|
public
|
||||||
|
realpackagename,
|
||||||
|
packagename : pshortstring;
|
||||||
|
containedmodules : TFPHashList;
|
||||||
|
requiredpackages : TFPHashObjectList;
|
||||||
|
pcpfilename,
|
||||||
|
ppafilename,
|
||||||
|
pplfilename : tpathstr;
|
||||||
|
constructor create(const pn:string);
|
||||||
|
destructor destroy;override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
tpackageentry=record
|
||||||
|
package : tpackage;
|
||||||
|
realpkgname : string;
|
||||||
|
end;
|
||||||
|
ppackageentry=^tpackageentry;
|
||||||
|
|
||||||
|
procedure addpackage(list:tfphashlist;const pn:string);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
cutils,globals;
|
||||||
|
|
||||||
|
procedure addpackage(list: tfphashlist;const pn:string);
|
||||||
|
var
|
||||||
|
pkgentry : ppackageentry;
|
||||||
|
begin
|
||||||
|
new(pkgentry);
|
||||||
|
pkgentry^.realpkgname:=pn;
|
||||||
|
pkgentry^.package:=nil;
|
||||||
|
list.add(upper(pn),pkgentry);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ tpackage }
|
||||||
|
|
||||||
|
constructor tpackage.create(const pn: string);
|
||||||
|
begin
|
||||||
|
realpackagename:=stringdup(pn);
|
||||||
|
packagename:=stringdup(upper(pn));
|
||||||
|
containedmodules:=TFPHashList.Create;
|
||||||
|
requiredpackages:=TFPHashObjectList.Create(false);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor tpackage.destroy;
|
||||||
|
var
|
||||||
|
p : pcontainedunit;
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
if assigned(containedmodules) then
|
||||||
|
for i:=0 to containedmodules.count-1 do
|
||||||
|
begin
|
||||||
|
p:=pcontainedunit(containedmodules[i]);
|
||||||
|
dispose(p);
|
||||||
|
end;
|
||||||
|
containedmodules.free;
|
||||||
|
requiredpackages.free;
|
||||||
|
inherited destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure packageinit;
|
||||||
|
begin
|
||||||
|
packagelist:=TFPHashList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure packagedone;
|
||||||
|
var
|
||||||
|
i : longint;
|
||||||
|
pkgentry : ppackageentry;
|
||||||
|
begin
|
||||||
|
if assigned(packagelist) then
|
||||||
|
begin
|
||||||
|
for i:=0 to packagelist.count-1 do
|
||||||
|
begin
|
||||||
|
pkgentry:=ppackageentry(packagelist[i]);
|
||||||
|
pkgentry^.package.free;
|
||||||
|
dispose(pkgentry);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
packagelist.Free;
|
||||||
|
packagelist:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
register_initdone_proc(@packageinit,@packagedone);
|
||||||
|
end.
|
||||||
|
|
||||||
@ -79,6 +79,7 @@ interface
|
|||||||
function openppu(ppufiletime:longint):boolean;
|
function openppu(ppufiletime:longint):boolean;
|
||||||
function search_unit_files(onlysource:boolean):boolean;
|
function search_unit_files(onlysource:boolean):boolean;
|
||||||
function search_unit(onlysource,shortname:boolean):boolean;
|
function search_unit(onlysource,shortname:boolean):boolean;
|
||||||
|
function loadfrompackage:boolean;
|
||||||
procedure load_interface;
|
procedure load_interface;
|
||||||
procedure load_implementation;
|
procedure load_implementation;
|
||||||
procedure load_usedunits;
|
procedure load_usedunits;
|
||||||
@ -121,7 +122,7 @@ uses
|
|||||||
aasmbase,ogbase,
|
aasmbase,ogbase,
|
||||||
parser,
|
parser,
|
||||||
comphook,
|
comphook,
|
||||||
entfile;
|
entfile,fpkg;
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -507,6 +508,86 @@ var
|
|||||||
search_unit:=fnd;
|
search_unit:=fnd;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function tppumodule.loadfrompackage: boolean;
|
||||||
|
var
|
||||||
|
singlepathstring,
|
||||||
|
filename : TCmdStr;
|
||||||
|
|
||||||
|
Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
|
||||||
|
begin
|
||||||
|
if CheckVerbosity(V_Tried) then
|
||||||
|
Message1(unit_t_unitsearch,Singlepathstring+filename);
|
||||||
|
UnitExists:=FindFile(FileName,Singlepathstring,true,foundfile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function PPUSearchPath(const s:TCmdStr):boolean;
|
||||||
|
var
|
||||||
|
found : boolean;
|
||||||
|
hs : TCmdStr;
|
||||||
|
begin
|
||||||
|
Found:=false;
|
||||||
|
singlepathstring:=FixPath(s,false);
|
||||||
|
{ Check for PPU file }
|
||||||
|
Found:=UnitExists(target_info.unitext,hs);
|
||||||
|
if Found then
|
||||||
|
Begin
|
||||||
|
SetFileName(hs,false);
|
||||||
|
Found:=openppufile;
|
||||||
|
End;
|
||||||
|
PPUSearchPath:=Found;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function SearchPathList(list:TSearchPathList):boolean;
|
||||||
|
var
|
||||||
|
hp : TCmdStrListItem;
|
||||||
|
found : boolean;
|
||||||
|
begin
|
||||||
|
found:=false;
|
||||||
|
hp:=TCmdStrListItem(list.First);
|
||||||
|
while assigned(hp) do
|
||||||
|
begin
|
||||||
|
found:=PPUSearchPath(hp.Str);
|
||||||
|
if found then
|
||||||
|
break;
|
||||||
|
hp:=TCmdStrListItem(hp.next);
|
||||||
|
end;
|
||||||
|
SearchPathList:=found;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
pkg : ppackageentry;
|
||||||
|
pkgunit : pcontainedunit;
|
||||||
|
i,idx : longint;
|
||||||
|
begin
|
||||||
|
result:=false;
|
||||||
|
for i:=0 to packagelist.count-1 do
|
||||||
|
begin
|
||||||
|
pkg:=ppackageentry(packagelist[i]);
|
||||||
|
if not assigned(pkg^.package) then
|
||||||
|
internalerror(2013053103);
|
||||||
|
idx:=pkg^.package.containedmodules.FindIndexOf(modulename^);
|
||||||
|
if idx>=0 then
|
||||||
|
begin
|
||||||
|
{ the unit is part of this package }
|
||||||
|
pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
|
||||||
|
if not assigned(pkgunit^.module) then
|
||||||
|
pkgunit^.module:=self;
|
||||||
|
filename:=pkgunit^.ppufile;
|
||||||
|
if not SearchPathList(unitsearchpath) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
{ now load the unit and all used units }
|
||||||
|
load_interface;
|
||||||
|
setdefgeneration;
|
||||||
|
load_usedunits;
|
||||||
|
Message1(unit_u_finished_loading_unit,modulename^);
|
||||||
|
|
||||||
|
result:=true;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{**********************************
|
{**********************************
|
||||||
PPU Reading/Writing Helpers
|
PPU Reading/Writing Helpers
|
||||||
@ -1623,6 +1704,16 @@ var
|
|||||||
second_time:=false;
|
second_time:=false;
|
||||||
set_current_module(self);
|
set_current_module(self);
|
||||||
|
|
||||||
|
{ try to load it as a package unit first }
|
||||||
|
if (packagelist.count>0) and loadfrompackage then
|
||||||
|
begin
|
||||||
|
do_load:=false;
|
||||||
|
do_reload:=false;
|
||||||
|
state:=ms_load;
|
||||||
|
{ add the unit to the used units list of the program }
|
||||||
|
usedunits.concat(tused_unit.create(self,true,false,nil));
|
||||||
|
end;
|
||||||
|
|
||||||
{ A force reload }
|
{ A force reload }
|
||||||
if do_reload then
|
if do_reload then
|
||||||
begin
|
begin
|
||||||
|
|||||||
@ -277,6 +277,9 @@ interface
|
|||||||
objectsearchpath,
|
objectsearchpath,
|
||||||
includesearchpath,
|
includesearchpath,
|
||||||
frameworksearchpath : TSearchPathList;
|
frameworksearchpath : TSearchPathList;
|
||||||
|
packagesearchpath : TSearchPathList;
|
||||||
|
{ contains tpackageentry entries }
|
||||||
|
packagelist : TFPHashList;
|
||||||
autoloadunits : string;
|
autoloadunits : string;
|
||||||
|
|
||||||
{ linking }
|
{ linking }
|
||||||
@ -1436,6 +1439,7 @@ implementation
|
|||||||
frameworksearchpath.Free;
|
frameworksearchpath.Free;
|
||||||
LinkLibraryAliases.Free;
|
LinkLibraryAliases.Free;
|
||||||
LinkLibraryOrder.Free;
|
LinkLibraryOrder.Free;
|
||||||
|
packagesearchpath.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure InitGlobals;
|
procedure InitGlobals;
|
||||||
@ -1471,6 +1475,7 @@ implementation
|
|||||||
includesearchpath:=TSearchPathList.Create;
|
includesearchpath:=TSearchPathList.Create;
|
||||||
objectsearchpath:=TSearchPathList.Create;
|
objectsearchpath:=TSearchPathList.Create;
|
||||||
frameworksearchpath:=TSearchPathList.Create;
|
frameworksearchpath:=TSearchPathList.Create;
|
||||||
|
packagesearchpath:=TSearchPathList.Create;
|
||||||
|
|
||||||
{ Def file }
|
{ Def file }
|
||||||
usewindowapi:=false;
|
usewindowapi:=false;
|
||||||
|
|||||||
@ -26,7 +26,7 @@ unit options;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
cfileutl,
|
cfileutl,cclasses,
|
||||||
globtype,globals,verbose,systems,cpuinfo,comprsrc;
|
globtype,globals,verbose,systems,cpuinfo,comprsrc;
|
||||||
|
|
||||||
Type
|
Type
|
||||||
@ -48,8 +48,10 @@ Type
|
|||||||
ParaUnitPath,
|
ParaUnitPath,
|
||||||
ParaObjectPath,
|
ParaObjectPath,
|
||||||
ParaLibraryPath,
|
ParaLibraryPath,
|
||||||
ParaFrameworkPath : TSearchPathList;
|
ParaFrameworkPath,
|
||||||
|
parapackagepath : TSearchPathList;
|
||||||
ParaAlignment : TAlignmentInfo;
|
ParaAlignment : TAlignmentInfo;
|
||||||
|
parapackages : tfphashobjectlist;
|
||||||
paratarget : tsystem;
|
paratarget : tsystem;
|
||||||
paratargetasm : tasm;
|
paratargetasm : tasm;
|
||||||
paratargetdbg : tdbg;
|
paratargetdbg : tdbg;
|
||||||
@ -101,6 +103,7 @@ uses
|
|||||||
llvminfo,
|
llvminfo,
|
||||||
{$endif llvm}
|
{$endif llvm}
|
||||||
dirparse,
|
dirparse,
|
||||||
|
fpkg,
|
||||||
i_bsd;
|
i_bsd;
|
||||||
|
|
||||||
const
|
const
|
||||||
@ -1547,6 +1550,20 @@ begin
|
|||||||
else
|
else
|
||||||
ObjectSearchPath.AddPath(More,true);
|
ObjectSearchPath.AddPath(More,true);
|
||||||
end;
|
end;
|
||||||
|
'P' :
|
||||||
|
begin
|
||||||
|
if ispara then
|
||||||
|
parapackages.add(more,nil)
|
||||||
|
else
|
||||||
|
addpackage(packagelist,more);
|
||||||
|
end;
|
||||||
|
'p' :
|
||||||
|
begin
|
||||||
|
if ispara then
|
||||||
|
parapackagepath.AddPath(More,false)
|
||||||
|
else
|
||||||
|
packagesearchpath.AddPath(More,true);
|
||||||
|
end;
|
||||||
'r' :
|
'r' :
|
||||||
Msgfilename:=More;
|
Msgfilename:=More;
|
||||||
'R' :
|
'R' :
|
||||||
@ -3123,6 +3140,8 @@ begin
|
|||||||
ParaUnitPath:=TSearchPathList.Create;
|
ParaUnitPath:=TSearchPathList.Create;
|
||||||
ParaLibraryPath:=TSearchPathList.Create;
|
ParaLibraryPath:=TSearchPathList.Create;
|
||||||
ParaFrameworkPath:=TSearchPathList.Create;
|
ParaFrameworkPath:=TSearchPathList.Create;
|
||||||
|
parapackagepath:=TSearchPathList.Create;
|
||||||
|
parapackages:=TFPHashObjectList.Create;
|
||||||
FillChar(ParaAlignment,sizeof(ParaAlignment),0);
|
FillChar(ParaAlignment,sizeof(ParaAlignment),0);
|
||||||
MacVersionSet:=false;
|
MacVersionSet:=false;
|
||||||
paratarget:=system_none;
|
paratarget:=system_none;
|
||||||
@ -3140,6 +3159,8 @@ begin
|
|||||||
ParaUnitPath.Free;
|
ParaUnitPath.Free;
|
||||||
ParaLibraryPath.Free;
|
ParaLibraryPath.Free;
|
||||||
ParaFrameworkPath.Free;
|
ParaFrameworkPath.Free;
|
||||||
|
parapackagepath.Free;
|
||||||
|
ParaPackages.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -3213,6 +3234,7 @@ procedure read_arguments(cmd:TCmdStr);
|
|||||||
var
|
var
|
||||||
env: ansistring;
|
env: ansistring;
|
||||||
i : tfeature;
|
i : tfeature;
|
||||||
|
j : longint;
|
||||||
abi : tabi;
|
abi : tabi;
|
||||||
{$if defined(cpucapabilities)}
|
{$if defined(cpucapabilities)}
|
||||||
cpuflag : tcpuflags;
|
cpuflag : tcpuflags;
|
||||||
@ -3607,6 +3629,9 @@ begin
|
|||||||
IncludeSearchPath.AddList(option.ParaIncludePath,true);
|
IncludeSearchPath.AddList(option.ParaIncludePath,true);
|
||||||
LibrarySearchPath.AddList(option.ParaLibraryPath,true);
|
LibrarySearchPath.AddList(option.ParaLibraryPath,true);
|
||||||
FrameworkSearchPath.AddList(option.ParaFrameworkPath,true);
|
FrameworkSearchPath.AddList(option.ParaFrameworkPath,true);
|
||||||
|
packagesearchpath.addlist(option.parapackagepath,true);
|
||||||
|
for j:=0 to option.parapackages.count-1 do
|
||||||
|
addpackage(packagelist,option.parapackages.NameOfIndex(j));
|
||||||
|
|
||||||
{ add unit environment and exepath to the unit search path }
|
{ add unit environment and exepath to the unit search path }
|
||||||
if inputfilepath<>'' then
|
if inputfilepath<>'' then
|
||||||
|
|||||||
188
compiler/pcp.pas
Normal file
188
compiler/pcp.pas
Normal file
@ -0,0 +1,188 @@
|
|||||||
|
{
|
||||||
|
Copyright (c) 2013-2016 by Free Pascal development team
|
||||||
|
|
||||||
|
Routines to read/write pcp files
|
||||||
|
|
||||||
|
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 pcp;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
cstreams,entfile;
|
||||||
|
|
||||||
|
const
|
||||||
|
CurrentPCPVersion=1;
|
||||||
|
|
||||||
|
{ unit flags }
|
||||||
|
//uf_init = $000001; { unit has initialization section }
|
||||||
|
//uf_finalize = $000002; { unit has finalization section }
|
||||||
|
pf_big_endian = $000004;
|
||||||
|
//uf_has_browser = $000010;
|
||||||
|
//uf_in_library = $000020; { is the file in another file than <ppufile>.* ? }
|
||||||
|
//uf_smart_linked = $000040; { the ppu can be smartlinked }
|
||||||
|
//uf_static_linked = $000080; { the ppu can be linked static }
|
||||||
|
//uf_shared_linked = $000100; { the ppu can be linked shared }
|
||||||
|
//uf_local_browser = $000200;
|
||||||
|
//uf_no_link = $000400; { unit has no .o generated, but can still have external linking! }
|
||||||
|
//uf_has_resourcestrings = $000800; { unit has resource string section }
|
||||||
|
pf_little_endian = $001000;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
tpcpheader=record
|
||||||
|
common : tentryheader;
|
||||||
|
checksum : cardinal; { checksum for this pcpfile }
|
||||||
|
requiredlistsize, { number of entries for required packages }
|
||||||
|
ppulistsize : longint; { number of entries for contained PPUs }
|
||||||
|
end;
|
||||||
|
|
||||||
|
tpcpfile=class(tentryfile)
|
||||||
|
public
|
||||||
|
header : tpcpheader;
|
||||||
|
{ crc for the entire package }
|
||||||
|
crc : cardinal;
|
||||||
|
protected
|
||||||
|
function getheadersize:longint;override;
|
||||||
|
function getheaderaddr:pentryheader;override;
|
||||||
|
procedure newheader;override;
|
||||||
|
function readheader:longint;override;
|
||||||
|
procedure resetfile;override;
|
||||||
|
public
|
||||||
|
procedure writeheader;override;
|
||||||
|
function checkpcpid:boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ tpcpfile }
|
||||||
|
|
||||||
|
function tpcpfile.getheadersize: longint;
|
||||||
|
begin
|
||||||
|
result:=sizeof(tpcpheader);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function tpcpfile.getheaderaddr: pentryheader;
|
||||||
|
begin
|
||||||
|
result:=@header;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcpfile.newheader;
|
||||||
|
var
|
||||||
|
s : string;
|
||||||
|
begin
|
||||||
|
fillchar(header,sizeof(tpcpheader),0);
|
||||||
|
str(CurrentPCPVersion,s);
|
||||||
|
while length(s)<3 do
|
||||||
|
s:='0'+s;
|
||||||
|
with header.common do
|
||||||
|
begin
|
||||||
|
id[1]:='P';
|
||||||
|
id[2]:='C';
|
||||||
|
id[3]:='P';
|
||||||
|
ver[1]:=s[1];
|
||||||
|
ver[2]:=s[2];
|
||||||
|
ver[3]:=s[3];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function tpcpfile.readheader: longint;
|
||||||
|
begin
|
||||||
|
if fsize<sizeof(tpcpheader) then
|
||||||
|
exit(0);
|
||||||
|
result:=f.Read(header,sizeof(tpcpheader));
|
||||||
|
{ The header is always stored in little endian order }
|
||||||
|
{ therefore swap if on a big endian machine }
|
||||||
|
{$IFDEF ENDIAN_BIG}
|
||||||
|
header.common.compiler := swapendian(header.common.compiler);
|
||||||
|
header.common.cpu := swapendian(header.common.cpu);
|
||||||
|
header.common.target := swapendian(header.common.target);
|
||||||
|
header.common.flags := swapendian(header.common.flags);
|
||||||
|
header.common.size := swapendian(header.common.size);
|
||||||
|
header.checksum := swapendian(header.checksum);
|
||||||
|
header.requiredlistsize:=swapendian(header.requiredlistsize);
|
||||||
|
header.ppulistsize:=swapendian(header.ppulistsize);
|
||||||
|
{$ENDIF}
|
||||||
|
{ the PPU DATA is stored in native order }
|
||||||
|
if (header.common.flags and pf_big_endian) = pf_big_endian then
|
||||||
|
Begin
|
||||||
|
{$IFDEF ENDIAN_LITTLE}
|
||||||
|
change_endian := TRUE;
|
||||||
|
{$ELSE}
|
||||||
|
change_endian := FALSE;
|
||||||
|
{$ENDIF}
|
||||||
|
End
|
||||||
|
else if (header.common.flags and pf_little_endian) = pf_little_endian then
|
||||||
|
Begin
|
||||||
|
{$IFDEF ENDIAN_BIG}
|
||||||
|
change_endian := TRUE;
|
||||||
|
{$ELSE}
|
||||||
|
change_endian := FALSE;
|
||||||
|
{$ENDIF}
|
||||||
|
End;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tpcpfile.resetfile;
|
||||||
|
begin
|
||||||
|
crc:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tpcpfile.writeheader;
|
||||||
|
var
|
||||||
|
opos : integer;
|
||||||
|
begin
|
||||||
|
{ flush buffer }
|
||||||
|
writebuf;
|
||||||
|
{ update size (w/o header!) in the header }
|
||||||
|
header.common.size:=bufstart-sizeof(tpcpheader);
|
||||||
|
{ set the endian flag }
|
||||||
|
{$ifndef FPC_BIG_ENDIAN}
|
||||||
|
header.common.flags:=header.common.flags or pf_little_endian;
|
||||||
|
{$else not FPC_BIG_ENDIAN}
|
||||||
|
header.common.flags:=header.common.flags or pf_big_endian;
|
||||||
|
{ Now swap the header in the correct endian (always little endian) }
|
||||||
|
header.common.compiler:=swapendian(header.common.compiler);
|
||||||
|
header.common.cpu:=swapendian(header.common.cpu);
|
||||||
|
header.common.target:=swapendian(header.common.target);
|
||||||
|
header.common.flags:=swapendian(header.common.flags);
|
||||||
|
header.common.size:=swapendian(header.common.size);
|
||||||
|
header.checksum:=swapendian(header.checksum);
|
||||||
|
header.requiredlistsize:=swapendian(header.requiredlistsize);
|
||||||
|
header.ppulistsize:=swapendian(header.ppulistsize);
|
||||||
|
{$endif not FPC_BIG_ENDIAN}
|
||||||
|
{ write header and restore filepos after it }
|
||||||
|
opos:=f.Position;
|
||||||
|
f.Position:=0;
|
||||||
|
f.Write(header,sizeof(tpcpheader));
|
||||||
|
f.Position:=opos;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function tpcpfile.checkpcpid:boolean;
|
||||||
|
begin
|
||||||
|
result:=((Header.common.Id[1]='P') and
|
||||||
|
(Header.common.Id[2]='C') and
|
||||||
|
(Header.common.Id[3]='P'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
422
compiler/pkgutil.pas
Normal file
422
compiler/pkgutil.pas
Normal file
@ -0,0 +1,422 @@
|
|||||||
|
{
|
||||||
|
Copyright (c) 2013-2016 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;
|
||||||
|
|
||||||
|
procedure createimportlibfromexports;
|
||||||
|
Function RewritePPU(const PPUFn,PPLFn:String):Boolean;
|
||||||
|
procedure export_unit(u:tmodule);
|
||||||
|
procedure load_packages;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
sysutils,
|
||||||
|
globtype,systems,
|
||||||
|
cutils,cclasses,
|
||||||
|
globals,verbose,
|
||||||
|
symtype,symconst,symsym,symdef,symbase,symtable,
|
||||||
|
ppu,entfile,fpcp,fpkg,
|
||||||
|
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;
|
||||||
|
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
|
||||||
|
((symtable.symtabletype in [globalsymtable,recordsymtable,objectsymtable]) or
|
||||||
|
((symtable.symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions))
|
||||||
|
) then
|
||||||
|
begin
|
||||||
|
exportallprocdefnames(tprocsym(sym),tprocdef(tprocsym(sym).ProcdefList[i]),[]);
|
||||||
|
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);
|
||||||
|
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);
|
||||||
|
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);
|
||||||
|
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;
|
||||||
|
varexport(tsym(sym).mangledname);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
writeln('unknown: ',ord(TSym(sym).typ));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure export_unit(u: tmodule);
|
||||||
|
begin
|
||||||
|
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);
|
||||||
|
|
||||||
|
{ create special exports }
|
||||||
|
if (u.flags and uf_init)<>0 then
|
||||||
|
procexport(make_mangledname('INIT$',u.globalsymtable,''));
|
||||||
|
if (u.flags and uf_finalize)<>0 then
|
||||||
|
procexport(make_mangledname('FINALIZE$',u.globalsymtable,''));
|
||||||
|
if (u.flags and uf_threadvars)=uf_threadvars then
|
||||||
|
varexport(make_mangledname('THREADVARLIST',u.globalsymtable,''));
|
||||||
|
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 load_packages;
|
||||||
|
var
|
||||||
|
i : longint;
|
||||||
|
pcp: tpcppackage;
|
||||||
|
entry : ppackageentry;
|
||||||
|
begin
|
||||||
|
if not (tf_supports_packages in target_info.flags) then
|
||||||
|
exit;
|
||||||
|
for i:=0 to packagelist.count-1 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;
|
||||||
|
end;
|
||||||
|
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;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -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);
|
export_unit(uu.u);
|
||||||
{ 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,''));
|
|
||||||
|
|
||||||
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,
|
exportlib.ignoreduplicates:=false;
|
||||||
needs to be done after exportlib.generatelib; }
|
|
||||||
createimportlibfromexports;
|
|
||||||
|
|
||||||
{ 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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user