/compiler/utils/ppufiles.pp

https://github.com/slibre/freepascal · Puppet · 246 lines · 228 code · 18 blank · 0 comment · 7 complexity · 325cf7293240903dfd46f8807331069d MD5 · raw file

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