ppdep.pp 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577
  1. {
  2. This program is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Peter Vreman
  4. member of the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. { Program to create a depend makefile for a program with multiple units }
  12. program ppdep;
  13. uses Dos;
  14. {.$define debug}
  15. const
  16. {$ifdef unix}
  17. exeext='';
  18. {$else}
  19. exeext='.EXE';
  20. {$endif}
  21. type
  22. PUses=^TUses;
  23. TUses=record
  24. Name : string[32];
  25. Next : PUses;
  26. end;
  27. PUnit=^TUnit;
  28. TUnit=record
  29. UsesList : PUses;
  30. PasFn,
  31. Name : string[32];
  32. IsUnit : boolean;
  33. Next : PUnit;
  34. end;
  35. PDefine=^TDefine;
  36. TDefine = Record
  37. Name : String[32];
  38. Next : PDefine;
  39. end;
  40. var
  41. UnitList : PUnit;
  42. Define : PDefine;
  43. ParaFile : string;
  44. Verbose : boolean;
  45. AddCall : byte;
  46. CallLine,
  47. OutFile : String;
  48. UnitExt : String;
  49. {****************************************************************************
  50. Handy Routines
  51. ****************************************************************************}
  52. function UCase(Const Hstr:string):string;
  53. var
  54. i : longint;
  55. begin
  56. for i:=1to Length(Hstr) do
  57. UCase[i]:=Upcase(Hstr[i]);
  58. UCase[0]:=chr(Length(Hstr));
  59. end;
  60. function FixFn(const s:string):string;
  61. var
  62. i : longint;
  63. NoPath : boolean;
  64. begin
  65. NoPath:=true;
  66. for i:=length(s) downto 1 do
  67. begin
  68. case s[i] of
  69. {$ifdef unix}
  70. '/','\' : begin
  71. FixFn[i]:='/';
  72. NoPath:=false; {Skip lowercasing path: 'X11'<>'x11' }
  73. end;
  74. 'A'..'Z' : if NoPath then
  75. FixFn[i]:=char(byte(s[i])+32)
  76. else
  77. FixFn[i]:=s[i];
  78. {$else}
  79. '/' : FixFn[i]:='\';
  80. 'A'..'Z' : FixFn[i]:=char(byte(s[i])+32); { everything lowercase }
  81. {$endif}
  82. else
  83. FixFn[i]:=s[i];
  84. end;
  85. end;
  86. FixFn[0]:=Chr(Length(s));
  87. end;
  88. {****************************************************************************
  89. Main Program
  90. ****************************************************************************}
  91. Function SearchPas(const fn:string):string;
  92. var
  93. Dir : SearchRec;
  94. begin
  95. FindFirst(FixFn(fn+'.PP'),$20,Dir);
  96. if Doserror=0 then
  97. SearchPas:=FixFn(fn+'.PP')
  98. else
  99. SearchPas:=FixFn(fn+'.PAS')
  100. end;
  101. Function UnitDone(const fn:string):boolean;
  102. var
  103. hp : PUnit;
  104. begin
  105. hp:=UnitList;
  106. while not (hp=nil) do
  107. begin
  108. if hp^.Name=fn then
  109. begin
  110. UnitDone:=true;
  111. exit;
  112. end;
  113. hp:=hp^.Next;
  114. end;
  115. UnitDone:=false;
  116. end;
  117. Function CheckDefine(const s:string):boolean;
  118. var
  119. ss : string[32];
  120. P : PDefine;
  121. begin
  122. ss:=ucase(s);
  123. P:=Define;
  124. while (p<>Nil) do
  125. begin
  126. if ss=p^.name then
  127. begin
  128. CheckDefine:=true;
  129. exit;
  130. end;
  131. P:=P^.Next;
  132. end;
  133. CheckDefine:=false;
  134. end;
  135. Procedure AddDefine(Const S : String);
  136. Var
  137. P : PDefine;
  138. begin
  139. New(P);
  140. P^.Name:=Ucase(S);
  141. P^.Next:=Define;
  142. Define:=P;
  143. end;
  144. procedure RemoveSep(var fn:string);
  145. var
  146. i : longint;
  147. begin
  148. i:=0;
  149. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  150. inc(i);
  151. Delete(fn,1,i);
  152. end;
  153. function GetName(var fn:string):string;
  154. var
  155. i : longint;
  156. begin
  157. i:=0;
  158. while (i<length(fn)) and (fn[i+1] in ['A'..'Z','0'..'9','_','-']) do
  159. inc(i);
  160. GetName:=Copy(fn,1,i);
  161. Delete(fn,1,i);
  162. end;
  163. procedure ListDepend(const fn:string);
  164. {$ifndef FPC}
  165. procedure readln(var t:text;var s:string);
  166. var
  167. c : char;
  168. i : longint;
  169. begin
  170. c:=#0;
  171. i:=0;
  172. while (not eof(t)) and (c<>#10) do
  173. begin
  174. read(t,c);
  175. if c<>#10 then
  176. begin
  177. inc(i);
  178. s[i]:=c;
  179. end;
  180. end;
  181. if (i>0) and (s[i]=#13) then
  182. dec(i);
  183. s[0]:=chr(i);
  184. end;
  185. {$endif}
  186. const
  187. MaxLevel=200;
  188. var
  189. f : text;
  190. hs : ^string;
  191. curruses,lastuses : PUses;
  192. currunit,lastunit : PUnit;
  193. i,j : longint;
  194. UsesDone,
  195. OldComment,
  196. Done,Comment,
  197. InImplementation : boolean;
  198. Skip : array[0..MaxLevel] of boolean;
  199. Level : byte;
  200. begin
  201. if UnitDone(fn) then
  202. exit;
  203. new(hs);
  204. new(currunit);
  205. currunit^.next:=nil;
  206. currunit^.Name:=fn;
  207. currunit^.IsUnit:=true;
  208. currunit^.PasFn:=SearchPas(fn);
  209. currunit^.useslist:=nil;
  210. assign(f,currunit^.PasFn);
  211. {$I-}
  212. reset(f);
  213. {$I+}
  214. if ioresult=0 then
  215. begin
  216. if verbose then
  217. Writeln('Processing ',currunit^.PasFn);
  218. {Add to Linked List}
  219. if unitlist=nil then
  220. unitlist:=currunit
  221. else
  222. begin
  223. lastunit:=UnitList;
  224. while not (lastunit^.Next=nil) do
  225. lastunit:=lastunit^.next;
  226. lastunit^.next:=currunit;
  227. end;
  228. {Parse file}
  229. InImplementation:=false;
  230. done:=false;
  231. usesdone:=true;
  232. Comment:=false;
  233. OldComment:=false;
  234. FillChar(skip,sizeof(Skip),0);
  235. hs^:='';
  236. Level:=0;
  237. while (not done) and (not Eof(f)) do
  238. begin
  239. repeat
  240. if hs^='' then
  241. begin
  242. ReadLn(f,hs^);
  243. hs^:=UCase(hs^);
  244. end;
  245. RemoveSep(hs^);
  246. until (hs^<>'') or Eof(f);
  247. if Comment then
  248. begin
  249. i:=pos('}',hs^);
  250. if (i>0) then
  251. begin
  252. j:=pos('{',hs^);
  253. if (j>0) and (j<i) then
  254. begin
  255. Comment:=true;
  256. Delete(hs^,1,j-1);
  257. end
  258. else
  259. begin
  260. Comment:=false;
  261. Delete(hs^,1,i-1);
  262. end;
  263. end
  264. else
  265. hs^:='';
  266. end;
  267. if (pos('(*',hs^)>0) or OldComment then
  268. begin
  269. i:=pos('*)',hs^);
  270. if (i>0) then
  271. begin
  272. OldComment:=false;
  273. Delete(hs^,1,i+1);
  274. end
  275. else
  276. begin
  277. OldComment:=true;
  278. hs^:='';
  279. end;
  280. end;
  281. if (hs^<>'') then
  282. begin
  283. case hs^[1] of
  284. '}' : begin
  285. Comment:=false;
  286. hs^:='';
  287. end;
  288. '{' : begin
  289. if (Copy(hs^,2,6)='$IFDEF') then
  290. begin
  291. Delete(hs^,1,7);
  292. RemoveSep(hs^);
  293. inc(Level);
  294. if Level>=MaxLevel then
  295. begin
  296. Writeln('Too many IF(N)DEFs');
  297. Halt(1);
  298. end;
  299. skip[level]:=skip[level-1] or (not CheckDefine(GetName(hs^)));
  300. hs^:='';
  301. end
  302. else
  303. if (Copy(hs^,2,7)='$IFNDEF') then
  304. begin
  305. Delete(hs^,1,7);
  306. RemoveSep(hs^);
  307. inc(Level);
  308. if Level>=MaxLevel then
  309. begin
  310. Writeln('Too many IF(N)DEFs');
  311. Halt(1);
  312. end;
  313. skip[level]:=skip[level-1] or (CheckDefine(GetName(hs^)));
  314. hs^:='';
  315. end
  316. else
  317. if (Copy(hs^,2,6)='$ELSE') then
  318. begin
  319. skip[level]:=skip[level-1] or (not skip[level]);
  320. hs^:='';
  321. end
  322. else
  323. if (Copy(hs^,2,6)='$ENDIF') then
  324. begin
  325. skip[level]:=false;
  326. if Level=0 then
  327. begin
  328. Writeln('Too many ENDIFs');
  329. Halt(1);
  330. end;
  331. dec(level);
  332. hs^:='';
  333. end
  334. else
  335. if (Copy(hs^,2,6)='$IFOPT') then
  336. begin
  337. inc(Level);
  338. if Level>=MaxLevel then
  339. begin
  340. Writeln('Too many IF(N)DEFs');
  341. Halt(1);
  342. end;
  343. skip[level]:=true;
  344. hs^:='';
  345. end
  346. else
  347. begin
  348. i:=pos('}',hs^);
  349. if i>0 then
  350. begin
  351. Delete(hs^,1,i);
  352. Comment:=false;
  353. end
  354. else
  355. Comment:=true;
  356. end;
  357. end;
  358. ';' : begin
  359. UsesDone:=true;
  360. Done:=(UsesDone and InImplementation);
  361. hs^:='';
  362. end;
  363. else
  364. begin
  365. if skip[level] then
  366. hs^:=''
  367. else
  368. begin
  369. if (not UsesDone) then
  370. begin
  371. new(curruses);
  372. curruses^.Name:=GetName(hs^);
  373. curruses^.next:=nil;
  374. if currunit^.useslist=nil then
  375. currunit^.useslist:=curruses
  376. else
  377. begin
  378. lastuses:=currunit^.useslist;
  379. while not (lastuses^.Next=nil) do
  380. lastuses:=lastuses^.next;
  381. lastuses^.next:=curruses;
  382. end;
  383. {$ifndef debug}
  384. ListDepend(curruses^.Name);
  385. {$endif}
  386. RemoveSep(hs^);
  387. end
  388. else
  389. begin
  390. if (Copy(hs^,1,4)='USES') and ((length(hs^)=4) or (hs^[5] in [' ',#9])) then
  391. begin
  392. Delete(hs^,1,4);
  393. UsesDone:=false;
  394. end
  395. else
  396. begin
  397. if (hs^='IMPLEMENTATION') then
  398. InImplementation:=true
  399. else
  400. if (Copy(hs^,1,7)='PROGRAM') then
  401. begin
  402. currunit^.IsUnit:=false;
  403. InImplementation:=true; {there can be only 1 uses}
  404. end
  405. else
  406. if InImplementation and ((copy(hs^,1,5)='CONST') or
  407. (copy(hs^,1,3)='VAR') or (copy(hs^,1,5)='BEGIN')) then
  408. done:=true;
  409. hs^:='';
  410. end;
  411. end;
  412. end;
  413. end;
  414. end;
  415. end;
  416. end;
  417. Close(f);
  418. end
  419. else
  420. dispose(currunit);
  421. dispose(hs);
  422. end;
  423. procedure ShowDepend;
  424. var
  425. currunit : PUnit;
  426. curruses : PUses;
  427. t : text;
  428. P : PDefine;
  429. First : boolean;
  430. begin
  431. if CallLine='' then
  432. begin
  433. CallLine:='ppc386 ';
  434. P:=Define;
  435. While P<>Nil do
  436. begin
  437. CallLine:=CallLine+' -d'+P^.Name;
  438. P:=P^.Next;
  439. end;
  440. end;
  441. assign(t,OutFile);
  442. rewrite(t);
  443. currunit:=UnitList;
  444. First:=true;
  445. while not (currunit=nil) do
  446. begin
  447. if currunit^.IsUnit then
  448. Write(t,FixFn(currunit^.Name+'.'+unitext)+': '+currunit^.PasFn)
  449. else
  450. Write(t,FixFn(currunit^.Name+exeext)+': '+currunit^.PasFn);
  451. curruses:=currunit^.useslist;
  452. while not (curruses=nil) do
  453. begin
  454. {$ifndef debug}
  455. if UnitDone(curruses^.name) then
  456. {$endif}
  457. begin
  458. writeln(t,' \');
  459. write(t,#9+FixFn(curruses^.name+'.'+unitext));
  460. end;
  461. curruses:=curruses^.next;
  462. end;
  463. writeln(t,'');
  464. If (AddCall=2) or (First and (AddCall=1)) then
  465. writeln(t,#9,CallLine,' ',currunit^.PasFn);
  466. writeln(t,'');
  467. currunit:=currunit^.next;
  468. First:=false;
  469. end;
  470. close(t);
  471. end;
  472. procedure getpara;
  473. var
  474. ch : char;
  475. para : string[128];
  476. i : word;
  477. procedure helpscreen;
  478. begin
  479. writeln('ppdep [Options] <File>');
  480. Writeln;
  481. Writeln('Options can be: -D<define> Define a symbol');
  482. Writeln(' -oFile Write output to file');
  483. WRiteln(' (default stdout)');
  484. Writeln(' -eext Set unit extension to ext');
  485. Writeln(' (default ppu)');
  486. Writeln(' -V Be more verbose');
  487. Writeln(' -? or -H This HelpScreen');
  488. Writeln(' -A[call] Add compiler calls to makefile (all files)');
  489. Writeln(' -F[call] Add compiler calls to makefile (only top file)');
  490. halt(1);
  491. end;
  492. begin
  493. Define:=Nil;
  494. Outfile:='';
  495. AddCall:=0;
  496. Verbose:=False;
  497. {$IFDEF Unix}
  498. UnitExt:='ppu';
  499. {$ELSE}
  500. UnitExt:='PPU';
  501. {$endif}
  502. for i:=1 to paramcount do
  503. begin
  504. para:=Paramstr(i);
  505. if (para[1]='-') then
  506. begin
  507. ch:=Upcase(para[2]);
  508. delete(para,1,2);
  509. case ch of
  510. 'A' : begin
  511. AddCall:=2;
  512. CallLine:=Para;
  513. end;
  514. 'F' : begin
  515. AddCall:=1;
  516. CallLine:=Para;
  517. end;
  518. 'D' : AddDefine(para);
  519. 'O' : OutFile:=Para;
  520. 'E' : UnitExt:=Para;
  521. 'V' : verbose:=true;
  522. '?','H' : helpscreen;
  523. end;
  524. end
  525. else
  526. begin
  527. ParaFile:=Para;
  528. if Pos('.',ParaFile)>0 then
  529. Delete(Parafile,Pos('.',ParaFile),255);
  530. end;
  531. end;
  532. if (ParaFile='') then
  533. HelpScreen;
  534. end;
  535. begin
  536. GetPara;
  537. ListDepend(ParaFile);
  538. ShowDepend;
  539. end.