/compiler/utils/ppufiles.pp

  1{
  2    Copyright (c) 1999-2002 by Peter Vreman
  3
  4    List files needed by PPU
  5
  6    This program is free software; you can redistribute it and/or modify
  7    it under the terms of the GNU General Public License as published by
  8    the Free Software Foundation; either version 2 of the License, or
  9    (at your option) any later version.
 10
 11    This program is distributed in the hope that it will be useful,
 12    but WITHOUT ANY WARRANTY; without even the implied warranty of
 13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14    GNU General Public License for more details.
 15
 16    You should have received a copy of the GNU General Public License
 17    along with this program; if not, write to the Free Software
 18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 19
 20 ****************************************************************************}
 21Program ppufiles;
 22
 23uses
 24  dos,
 25  ppu;
 26
 27const
 28  Version   = 'Version 1.00';
 29  Title     = 'PPU-Files';
 30  Copyright = 'Copyright (c) 1999-2002 by the Free Pascal Development Team';
 31
 32  PPUExt = 'ppu';
 33
 34type
 35  poutfile = ^toutfile;
 36  toutfile = record
 37    name : string;
 38    next : poutfile;
 39  end;
 40
 41var
 42  skipdup,
 43  showstatic,
 44  showshared,
 45  showobjects : boolean;
 46
 47  OutFiles    : poutfile;
 48
 49
 50{*****************************************************************************
 51                                 Helpers
 52*****************************************************************************}
 53
 54Procedure Error(const s:string;stop:boolean);
 55{
 56  Write an error message to stderr
 57}
 58begin
 59  writeln(stderr,s);
 60  if stop then
 61   halt(1);
 62end;
 63
 64
 65Function ChangeFileExt(Const HStr,ext:String):String;
 66{
 67  Return a filename which will have extension ext added if no
 68  extension is found
 69}
 70var
 71  j : longint;
 72begin
 73  j:=length(Hstr);
 74  while (j>0) and (Hstr[j]<>'.') do
 75   dec(j);
 76  if j=0 then
 77   ChangeFileExt:=Hstr+'.'+Ext
 78  else
 79   ChangeFileExt:=HStr;
 80end;
 81
 82
 83Function SplitPath(Const HStr:String):String;
 84var
 85  i : longint;
 86begin
 87  i:=Length(Hstr);
 88  while (i>0) and not(Hstr[i] in ['\','/']) do
 89   dec(i);
 90  SplitPath:=Copy(Hstr,1,i);
 91end;
 92
 93
 94Procedure AddFile(const s:string);
 95var
 96  p : poutfile;
 97begin
 98  p:=nil;
 99  if skipdup then
100   begin
101     p:=outfiles;
102     while assigned(p) do
103      begin
104        if s=p^.name then
105         break;
106        p:=p^.next;
107      end;
108   end;
109  if not assigned(p) then
110   begin
111     new(p);
112     p^.name:=s;
113     p^.next:=outfiles;
114     outfiles:=p;
115   end;
116end;
117
118
119Function DoPPU(const PPUFn:String):Boolean;
120{
121  Convert one file (in Filename) to library format.
122  Return true if successful, false otherwise.
123}
124Var
125  inppu  : tppufile;
126  b      : byte;
127
128  procedure showfiles;
129  begin
130    while not inppu.endofentry do
131     begin
132       AddFile(inppu.getstring);
133       inppu.getlongint;
134     end;
135  end;
136
137begin
138  DoPPU:=false;
139  inppu:=tppufile.create(PPUFn);
140  if not inppu.openfile then
141   begin
142     inppu.free;
143     Error('Error: Could not open : '+PPUFn,false);
144     Exit;
145   end;
146{ Check the ppufile }
147  if not inppu.CheckPPUId then
148   begin
149     inppu.free;
150     Error('Error: Not a PPU File : '+PPUFn,false);
151     Exit;
152   end;
153  if inppu.GetPPUVersion<CurrentPPUVersion then
154   begin
155     inppu.free;
156     Error('Error: Wrong PPU Version : '+PPUFn,false);
157     Exit;
158   end;
159{ read until the object files are found }
160  repeat
161    b:=inppu.readentry;
162    case b of
163      ibendinterface,
164      ibend :
165        break;
166      iblinkunitstaticlibs :
167        if showstatic then
168         showfiles;
169      iblinkunitsharedlibs :
170        if showshared then
171         showfiles;
172      iblinkunitofiles :
173        if showobjects then
174         showfiles;
175    end;
176  until false;
177  inppu.free;
178  DoPPU:=True;
179end;
180
181
182
183var
184  i,parafile : longint;
185  dir        : SearchRec;
186  s,InFile   : String;
187  p          : poutfile;
188begin
189{ defaults }
190  skipdup:=true;
191{ options }
192  i:=1;
193  while (i<=paramcount) do
194   begin
195     s:=paramstr(i);
196     if s[1]<>'-' then
197      break;
198     case upcase(s[2]) of
199      'L' : showshared:=true;
200      'S' : showstatic:=true;
201      'O' : showobjects:=true;
202      'A' : skipdup:=false;
203      '?','H' :
204        begin
205          writeln('usage: ppufiles [options] <files>');
206          writeln('options:');
207          writeln('  -A  Show all files (don''t remove duplicates)');
208          writeln('  -L  Show only shared libraries');
209          writeln('  -S  Show only static libraries');
210          writeln('  -O  Show only object files');
211          writeln('  -H  This helpscreen');
212        end;
213     end;
214     inc(i);
215   end;
216  { default shows everything }
217  if i=1 then
218   begin
219     showshared:=true;
220     showstatic:=true;
221     showobjects:=true;
222   end;
223{ files }
224  parafile:=i;
225  for i:=parafile to ParamCount do
226   begin
227     InFile:=ChangeFileExt(ParamStr(i),PPUExt);
228     FindFirst(InFile,$20,Dir);
229     while (DosError=0) do
230      begin
231        DoPPU(SplitPath(InFile)+Dir.Name);
232        FindNext(Dir);
233      end;
234     FindClose(Dir);
235   end;
236{ Display the files }
237  while assigned(outfiles) do
238   begin
239     p:=outfiles;
240     write(outfiles^.name);
241     outfiles:=outfiles^.next;
242     dispose(p);
243     if assigned(outfiles) then
244      write(' ');
245   end;
246end.