mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 22:58:20 +02:00
645 lines
14 KiB
ObjectPascal
645 lines
14 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1999-2000 by the FPC Development Team
|
|
|
|
Add multiple FPC units into a static/shared library
|
|
|
|
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.
|
|
|
|
****************************************************************************}
|
|
{$ifndef TP}
|
|
{$H+}
|
|
{$endif}
|
|
Program ppumove;
|
|
uses
|
|
{$ifdef unix}
|
|
unix,
|
|
{$else unix}
|
|
dos,
|
|
{$endif unix}
|
|
ppu,
|
|
getopts;
|
|
|
|
const
|
|
Version = 'Version 1.00';
|
|
Title = 'PPU-Mover';
|
|
Copyright = 'Copyright (c) 1998-2000 by the Free Pascal Development Team';
|
|
|
|
ShortOpts = 'o:e:d:qhsvbw';
|
|
BufSize = 4096;
|
|
PPUExt = 'ppu';
|
|
ObjExt = 'o';
|
|
StaticLibExt ='a';
|
|
{$ifdef unix}
|
|
SharedLibExt ='so';
|
|
BatchExt ='.sh';
|
|
{$else}
|
|
SharedLibExt ='dll';
|
|
BatchExt ='.bat';
|
|
{$endif unix}
|
|
|
|
{ link options }
|
|
link_none = $0;
|
|
link_allways = $1;
|
|
link_static = $2;
|
|
link_smart = $4;
|
|
link_shared = $8;
|
|
|
|
Type
|
|
PLinkOEnt = ^TLinkOEnt;
|
|
TLinkOEnt = record
|
|
Name : string;
|
|
Next : PLinkOEnt;
|
|
end;
|
|
|
|
Var
|
|
ArBin,LDBin,StripBin,
|
|
OutputFile,
|
|
OutputFileForLink, { the name of the output file needed when linking }
|
|
DestPath,
|
|
PPLExt,
|
|
LibExt : string;
|
|
Batch,
|
|
Quiet,
|
|
MakeStatic : boolean;
|
|
Buffer : Pointer;
|
|
ObjFiles : PLinkOEnt;
|
|
BatchFile : Text;
|
|
|
|
{*****************************************************************************
|
|
Helpers
|
|
*****************************************************************************}
|
|
|
|
Procedure Error(const s:string;stop:boolean);
|
|
{
|
|
Write an error message to stderr
|
|
}
|
|
begin
|
|
{$ifdef FPC}
|
|
writeln(stderr,s);
|
|
{$else}
|
|
writeln(s);
|
|
{$endif}
|
|
if stop then
|
|
halt(1);
|
|
end;
|
|
|
|
|
|
function Shell(const s:string):longint;
|
|
{
|
|
Run a shell commnad and return the exitcode
|
|
}
|
|
begin
|
|
if Batch then
|
|
begin
|
|
Writeln(BatchFile,s);
|
|
Shell:=0;
|
|
exit;
|
|
end;
|
|
{$ifdef unix}
|
|
Shell:=unix.shell(s);
|
|
{$else}
|
|
exec(getenv('COMSPEC'),'/C '+s);
|
|
Shell:=DosExitCode;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
Function FileExists (Const F : String) : Boolean;
|
|
{
|
|
Returns True if the file exists, False if not.
|
|
}
|
|
Var
|
|
{$ifdef unix}
|
|
info : Stat;
|
|
{$else}
|
|
info : searchrec;
|
|
{$endif}
|
|
begin
|
|
{$ifdef unix}
|
|
FileExists:=FStat (F,Info);
|
|
{$else}
|
|
FindFirst (F,anyfile,Info);
|
|
FileExists:=DosError=0;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
Function AddExtension(Const HStr,ext:String):String;
|
|
{
|
|
Return a filename which will have extension ext added if no
|
|
extension is found
|
|
}
|
|
var
|
|
j : longint;
|
|
begin
|
|
j:=length(Hstr);
|
|
while (j>0) and (Hstr[j]<>'.') do
|
|
dec(j);
|
|
if j=0 then
|
|
AddExtension:=Hstr+'.'+Ext
|
|
else
|
|
AddExtension:=HStr;
|
|
end;
|
|
|
|
|
|
Function ForceExtension(Const HStr,ext:String):String;
|
|
{
|
|
Return a filename which certainly has the extension ext
|
|
}
|
|
var
|
|
j : longint;
|
|
begin
|
|
j:=length(Hstr);
|
|
while (j>0) and (Hstr[j]<>'.') do
|
|
dec(j);
|
|
if j=0 then
|
|
j:=255;
|
|
ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext;
|
|
end;
|
|
|
|
|
|
Procedure AddToLinkFiles(const S : String);
|
|
{
|
|
Adds a filename to a list of object files to link to.
|
|
No duplicates allowed.
|
|
}
|
|
Var
|
|
P : PLinKOEnt;
|
|
begin
|
|
P:=ObjFiles;
|
|
{ Don't add files twice }
|
|
While (P<>nil) and (p^.name<>s) do
|
|
p:=p^.next;
|
|
if p=nil then
|
|
begin
|
|
new(p);
|
|
p^.next:=ObjFiles;
|
|
p^.name:=s;
|
|
ObjFiles:=P;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function ExtractLib(const libfn:string):string;
|
|
{
|
|
Extract a static library libfn and return the files with a
|
|
wildcard
|
|
}
|
|
var
|
|
n : namestr;
|
|
d : dirstr;
|
|
e : extstr;
|
|
begin
|
|
{ create the temp dir first }
|
|
fsplit(libfn,d,n,e);
|
|
{$I-}
|
|
mkdir(n+'.sl');
|
|
{$I+}
|
|
if ioresult<>0 then;
|
|
{ Extract }
|
|
if Shell(arbin+' x '+libfn)<>0 then
|
|
Error('Fatal: Error running '+arbin,true);
|
|
{ Remove the lib file, it's extracted so it can be created with ease }
|
|
if PPLExt=PPUExt then
|
|
Shell('rm '+libfn);
|
|
{$ifdef unix}
|
|
ExtractLib:=n+'.sl/*';
|
|
{$else}
|
|
ExtractLib:=n+'.sl\*';
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
Function DoPPU(const PPUFn,PPLFn:String):Boolean;
|
|
{
|
|
Convert one file (in Filename) to library format.
|
|
Return true if successful, false otherwise.
|
|
}
|
|
Var
|
|
inppu,
|
|
outppu : pppufile;
|
|
b,
|
|
untilb : byte;
|
|
l,m : longint;
|
|
f : file;
|
|
s : string;
|
|
begin
|
|
DoPPU:=false;
|
|
If Not Quiet then
|
|
Write ('Processing ',PPUFn,'...');
|
|
inppu:=new(pppufile,init(PPUFn));
|
|
if not inppu^.open then
|
|
begin
|
|
dispose(inppu,done);
|
|
Error('Error: Could not open : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
{ Check the ppufile }
|
|
if not inppu^.CheckPPUId then
|
|
begin
|
|
dispose(inppu,done);
|
|
Error('Error: Not a PPU File : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
if inppu^.GetPPUVersion<CurrentPPUVersion then
|
|
begin
|
|
dispose(inppu,done);
|
|
Error('Error: Wrong PPU Version : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
{ No .o file generated for this ppu, just skip }
|
|
if (inppu^.header.flags and uf_no_link)<>0 then
|
|
begin
|
|
dispose(inppu,done);
|
|
If Not Quiet then
|
|
Writeln (' No files.');
|
|
DoPPU:=true;
|
|
Exit;
|
|
end;
|
|
{ Already a lib? }
|
|
if (inppu^.header.flags and uf_in_library)<>0 then
|
|
begin
|
|
dispose(inppu,done);
|
|
Error('Error: PPU is already in a library : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
{ We need a static linked unit }
|
|
if (inppu^.header.flags and uf_static_linked)=0 then
|
|
begin
|
|
dispose(inppu,done);
|
|
Error('Error: PPU is not static linked : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
{ Create the new ppu }
|
|
if PPUFn=PPLFn then
|
|
outppu:=new(pppufile,init('ppumove.$$$'))
|
|
else
|
|
outppu:=new(pppufile,init(PPLFn));
|
|
outppu^.create;
|
|
{ Create new header, with the new flags }
|
|
outppu^.header:=inppu^.header;
|
|
outppu^.header.flags:=outppu^.header.flags or uf_in_library;
|
|
if MakeStatic then
|
|
outppu^.header.flags:=outppu^.header.flags or uf_static_linked
|
|
else
|
|
outppu^.header.flags:=outppu^.header.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
|
|
dispose(inppu,done);
|
|
dispose(outppu,done);
|
|
Error('Error: No files to be linked found : '+PPUFn,false);
|
|
Exit;
|
|
end;
|
|
if b<>untilb then
|
|
begin
|
|
repeat
|
|
inppu^.getdatabuf(buffer^,bufsize,l);
|
|
outppu^.putdata(buffer^,l);
|
|
until l<bufsize;
|
|
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;
|
|
AddToLinkFiles(s);
|
|
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(outputfileforlink);
|
|
outppu^.putlongint(link_static);
|
|
outppu^.writeentry(iblinkunitstaticlibs)
|
|
end
|
|
else
|
|
begin
|
|
outppu^.putstring(outputfileforlink);
|
|
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 automaticly }
|
|
if b<>ibend then
|
|
begin
|
|
repeat
|
|
inppu^.getdatabuf(buffer^,bufsize,l);
|
|
outppu^.putdata(buffer^,l);
|
|
until l<bufsize;
|
|
outppu^.writeentry(b);
|
|
end;
|
|
until b=ibend;
|
|
{ write the last stuff and close }
|
|
outppu^.flush;
|
|
outppu^.writeheader;
|
|
dispose(outppu,done);
|
|
dispose(inppu,done);
|
|
{ rename }
|
|
if PPUFn=PPLFn then
|
|
begin
|
|
{$I-}
|
|
assign(f,PPUFn);
|
|
erase(f);
|
|
assign(f,'ppumove.$$$');
|
|
rename(f,PPUFn);
|
|
{$I+}
|
|
if ioresult<>0 then;
|
|
end;
|
|
{ the end }
|
|
If Not Quiet then
|
|
Writeln (' Done.');
|
|
DoPPU:=True;
|
|
end;
|
|
|
|
|
|
Function DoFile(const FileName:String):Boolean;
|
|
{
|
|
Process a file, mainly here for wildcard support under Dos
|
|
}
|
|
{$ifndef unix}
|
|
var
|
|
dir : searchrec;
|
|
{$endif}
|
|
begin
|
|
{$ifdef unix}
|
|
DoFile:=DoPPU(FileName,ForceExtension(FileName,PPLExt));
|
|
{$else}
|
|
DoFile:=false;
|
|
findfirst(filename,$20,dir);
|
|
while doserror=0 do
|
|
begin
|
|
if not DoPPU(Dir.Name,ForceExtension(Dir.Name,PPLExt)) then
|
|
exit;
|
|
findnext(dir);
|
|
end;
|
|
findclose(dir);
|
|
DoFile:=true;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
Procedure DoLink;
|
|
{
|
|
Link the object files together to form a (shared) library, the only
|
|
problem here is the 255 char limit of Names
|
|
}
|
|
Var
|
|
Names : String;
|
|
f : file;
|
|
Err : boolean;
|
|
P : PLinkOEnt;
|
|
begin
|
|
if not Quiet then
|
|
Write ('Linking ');
|
|
P:=ObjFiles;
|
|
names:='';
|
|
While p<>nil do
|
|
begin
|
|
if Names<>'' then
|
|
Names:=Names+' '+P^.name
|
|
else
|
|
Names:=p^.Name;
|
|
p:=p^.next;
|
|
end;
|
|
if Names='' then
|
|
begin
|
|
If not Quiet then
|
|
Writeln('Error: no files found to be linked');
|
|
exit;
|
|
end;
|
|
If not Quiet then
|
|
WriteLn(names);
|
|
{ Run ar or ld to create the lib }
|
|
If MakeStatic then
|
|
Err:=Shell(arbin+' rs '+outputfile+' '+names)<>0
|
|
else
|
|
begin
|
|
Err:=Shell(ldbin+' -shared -o '+OutputFile+' '+names)<>0;
|
|
if not Err then
|
|
Shell(stripbin+' --strip-unneeded '+OutputFile);
|
|
end;
|
|
If Err then
|
|
Error('Fatal: Library building stage failed.',true);
|
|
{ fix permission to 644, so it's not 755 }
|
|
{$ifdef unix}
|
|
ChMod(OutputFile,420);
|
|
{$endif}
|
|
{ Rename to the destpath }
|
|
if DestPath<>'' then
|
|
begin
|
|
Assign(F, OutputFile);
|
|
Rename(F,DestPath+'/'+OutputFile);
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure usage;
|
|
{
|
|
Print usage and exit.
|
|
}
|
|
begin
|
|
Writeln(paramstr(0),': [-qhwvbs] [-e ext] [-o name] [-d path] file [file ...]');
|
|
Halt(0);
|
|
end;
|
|
|
|
|
|
|
|
Procedure processopts;
|
|
{
|
|
Process command line opions, and checks if command line options OK.
|
|
}
|
|
var
|
|
C : char;
|
|
begin
|
|
if paramcount=0 then
|
|
usage;
|
|
{ Reset }
|
|
ObjFiles:=Nil;
|
|
Quiet:=False;
|
|
Batch:=False;
|
|
OutputFile:='';
|
|
PPLExt:='ppu';
|
|
ArBin:='ar';
|
|
LdBin:='ld';
|
|
StripBin:='strip';
|
|
repeat
|
|
c:=Getopt (ShortOpts);
|
|
Case C of
|
|
EndOfOptions : break;
|
|
's' : MakeStatic:=True;
|
|
'o' : OutputFile:=OptArg;
|
|
'd' : DestPath:=OptArg;
|
|
'e' : PPLext:=OptArg;
|
|
'q' : Quiet:=True;
|
|
'w' : begin
|
|
ArBin:='arw';
|
|
LdBin:='ldw';
|
|
end;
|
|
'b' : Batch:=true;
|
|
'?' : Usage;
|
|
'h' : Usage;
|
|
end;
|
|
until false;
|
|
{ Test filenames on the commandline }
|
|
if (OptInd>Paramcount) then
|
|
Error('Error: no input files',true);
|
|
if (OptInd<ParamCount) and (OutputFile='') then
|
|
Error('Error: when moving multiple units, specify an output name.',true);
|
|
{ alloc a buffer }
|
|
GetMem (Buffer,Bufsize);
|
|
If Buffer=Nil then
|
|
Error('Error: could not allocate memory for buffer.',true);
|
|
end;
|
|
|
|
|
|
var
|
|
i : longint;
|
|
begin
|
|
ProcessOpts;
|
|
{ Write Header }
|
|
if not Quiet then
|
|
begin
|
|
Writeln(Title+' '+Version);
|
|
Writeln(Copyright);
|
|
Writeln;
|
|
end;
|
|
{ Check if shared is allowed }
|
|
{$ifndef unix}
|
|
if arbin<>'arw' then
|
|
begin
|
|
Writeln('Warning: shared library not supported for Go32, switching to static library');
|
|
MakeStatic:=true;
|
|
end;
|
|
{$endif}
|
|
{ fix the libext and outputfilename }
|
|
if Makestatic then
|
|
LibExt:=StaticLibExt
|
|
else
|
|
LibExt:=SharedLibExt;
|
|
if OutputFile='' then
|
|
OutPutFile:=Paramstr(OptInd);
|
|
{ fix filename }
|
|
{$ifdef unix}
|
|
if Copy(OutputFile,1,3)<>'lib' then
|
|
OutputFile:='lib'+OutputFile;
|
|
{ For unix skip replacing the extension if a full .so.X.X if specified }
|
|
i:=pos('.so.',Outputfile);
|
|
if i<>0 then
|
|
OutputFileForLink:=Copy(Outputfile,4,i-4)
|
|
else
|
|
begin
|
|
OutputFile:=ForceExtension(OutputFile,LibExt);
|
|
OutputFileForLink:=Copy(Outputfile,4,length(Outputfile)-length(LibExt)-4);
|
|
end;
|
|
{$else}
|
|
OutputFile:=ForceExtension(OutputFile,LibExt);
|
|
OutputFileForLink:=OutputFile;
|
|
{$endif}
|
|
{ Open BatchFile }
|
|
if Batch then
|
|
begin
|
|
Assign(BatchFile,'pmove'+BatchExt);
|
|
Rewrite(BatchFile);
|
|
end;
|
|
{ Process Files }
|
|
i:=OptInd;
|
|
While (i<=ParamCount) and Dofile(AddExtension(Paramstr(i),PPUExt)) do
|
|
Inc(i);
|
|
{ Do Linking stage }
|
|
DoLink;
|
|
{ Close BatchFile }
|
|
if Batch then
|
|
begin
|
|
if Not Quiet then
|
|
Writeln('Writing pmove'+BatchExt);
|
|
Close(BatchFile);
|
|
{$ifdef unix}
|
|
ChMod('pmove'+BatchExt,493);
|
|
{$endif}
|
|
end;
|
|
{ The End }
|
|
if Not Quiet then
|
|
Writeln('Done.');
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.2 2001-01-29 21:48:26 peter
|
|
* linux -> unix
|
|
|
|
Revision 1.1 2000/07/13 10:16:22 michael
|
|
+ Initial import
|
|
|
|
Revision 1.11 2000/07/04 19:05:54 peter
|
|
* be optimistic: version 1.00 for some utils
|
|
|
|
Revision 1.10 2000/05/17 18:30:57 peter
|
|
* libname fixes for unix
|
|
|
|
Revision 1.9 2000/02/09 16:44:15 peter
|
|
* log truncated
|
|
|
|
Revision 1.8 2000/01/07 16:46:04 daniel
|
|
* copyright 2000
|
|
|
|
Revision 1.7 1999/11/25 00:00:39 peter
|
|
* strip created .so file with strip --strip-unneeded
|
|
|
|
Revision 1.6 1999/11/23 09:44:15 peter
|
|
* updated
|
|
|
|
Revision 1.5 1999/07/29 01:40:21 peter
|
|
* fsplit var type fixes
|
|
|
|
Revision 1.4 1999/07/28 16:53:58 peter
|
|
* updated for new linking, but still doesn't work because ld-unix.so.2
|
|
requires some more crt*.o files
|
|
|
|
}
|