/compiler/utils/ppumove.pp

https://github.com/slibre/freepascal · Puppet · 651 lines · 615 code · 36 blank · 0 comment · 48 complexity · bf25e4324733f1a33908ad5013948a4a MD5 · raw file

  1. {
  2. Copyright (c) 1999-2002 by the FPC Development Team
  3. Add multiple FPC units into a static/shared library
  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. {$ifndef TP}
  17. {$H+}
  18. {$endif}
  19. Program ppumove;
  20. uses
  21. {$IFDEF MACOS}
  22. {$DEFINE USE_FAKE_SYSUTILS}
  23. {$ENDIF MACOS}
  24. {$IFNDEF USE_FAKE_SYSUTILS}
  25. sysutils,
  26. {$ELSE}
  27. fksysutl,
  28. {$ENDIF}
  29. {$ifdef unix}
  30. Baseunix,Unix, Dos,
  31. {$else unix}
  32. dos,
  33. {$endif unix}
  34. cutils,ppu,systems,
  35. getopts;
  36. const
  37. Version = 'Version 2.1.1';
  38. Title = 'PPU-Mover';
  39. Copyright = 'Copyright (c) 1998-2007 by the Free Pascal Development Team';
  40. ShortOpts = 'o:e:d:i:qhsvb';
  41. BufSize = 4096;
  42. PPUExt = 'ppu';
  43. ObjExt = 'o';
  44. StaticLibExt ='a';
  45. {$ifdef unix}
  46. SharedLibExt ='so';
  47. BatchExt ='.sh';
  48. {$else}
  49. SharedLibExt ='dll';
  50. BatchExt ='.bat';
  51. {$endif unix}
  52. { link options }
  53. link_none = $0;
  54. link_always = $1;
  55. link_static = $2;
  56. link_smart = $4;
  57. link_shared = $8;
  58. Type
  59. PLinkOEnt = ^TLinkOEnt;
  60. TLinkOEnt = record
  61. Name : string;
  62. Next : PLinkOEnt;
  63. end;
  64. Var
  65. ArBin,LDBin,StripBin,
  66. OutputFileForPPU,
  67. OutputFile,
  68. OutputFileForLink, { the name of the output file needed when linking }
  69. InputPath,
  70. DestPath,
  71. PPLExt,
  72. LibExt : string;
  73. DoStrip,
  74. Batch,
  75. Quiet,
  76. MakeStatic : boolean;
  77. Buffer : Pointer;
  78. ObjFiles : PLinkOEnt;
  79. BatchFile : Text;
  80. Libs : ansistring;
  81. {*****************************************************************************
  82. Helpers
  83. *****************************************************************************}
  84. Procedure Error(const s:string;stop:boolean);
  85. {
  86. Write an error message to stderr
  87. }
  88. begin
  89. writeln(stderr,s);
  90. if stop then
  91. halt(1);
  92. end;
  93. function Shell(const s:string):longint;
  94. {
  95. Run a shell commnad and return the exitcode
  96. }
  97. begin
  98. if Batch then
  99. begin
  100. Writeln(BatchFile,s);
  101. Shell:=0;
  102. exit;
  103. end;
  104. {$ifdef unix}
  105. Shell:=unix.fpsystem(s);
  106. {$else}
  107. exec(getenv('COMSPEC'),'/C '+s);
  108. Shell:=DosExitCode;
  109. {$endif}
  110. end;
  111. Function FileExists (Const F : String) : Boolean;
  112. {
  113. Returns True if the file exists, False if not.
  114. }
  115. Var
  116. {$ifdef unix}
  117. info : Stat;
  118. {$else}
  119. info : searchrec;
  120. {$endif}
  121. begin
  122. {$ifdef unix}
  123. FileExists:=FpStat(F,Info)=0;
  124. {$else}
  125. FindFirst (F,anyfile,Info);
  126. FileExists:=DosError=0;
  127. {$endif}
  128. end;
  129. Function ChangeFileExt(Const HStr,ext:String):String;
  130. {
  131. Return a filename which will have extension ext added if no
  132. extension is found
  133. }
  134. var
  135. j : longint;
  136. begin
  137. j:=length(Hstr);
  138. while (j>0) and (Hstr[j]<>'.') do
  139. dec(j);
  140. if j=0 then
  141. ChangeFileExt:=Hstr+'.'+Ext
  142. else
  143. ChangeFileExt:=HStr;
  144. end;
  145. Function ForceExtension(Const HStr,ext:String):String;
  146. {
  147. Return a filename which certainly has the extension ext
  148. }
  149. var
  150. j : longint;
  151. begin
  152. j:=length(Hstr);
  153. while (j>0) and (Hstr[j]<>'.') do
  154. dec(j);
  155. if j=0 then
  156. j:=255;
  157. ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext;
  158. end;
  159. Procedure AddToLinkFiles(const S : String);
  160. {
  161. Adds a filename to a list of object files to link to.
  162. No duplicates allowed.
  163. }
  164. Var
  165. P : PLinKOEnt;
  166. begin
  167. P:=ObjFiles;
  168. { Don't add files twice }
  169. While (P<>nil) and (p^.name<>s) do
  170. p:=p^.next;
  171. if p=nil then
  172. begin
  173. new(p);
  174. p^.next:=ObjFiles;
  175. p^.name:=s;
  176. ObjFiles:=P;
  177. end;
  178. end;
  179. Function ExtractLib(const libfn:string):string;
  180. {
  181. Extract a static library libfn and return the files with a
  182. wildcard
  183. }
  184. var
  185. n : namestr;
  186. d : dirstr;
  187. e : extstr;
  188. begin
  189. { create the temp dir first }
  190. fsplit(libfn,d,n,e);
  191. {$push}{$I-}
  192. mkdir(n+'.sl');
  193. {$pop}
  194. if ioresult<>0 then;
  195. { Extract }
  196. if Shell(arbin+' x '+libfn)<>0 then
  197. Error('Fatal: Error running '+arbin,true);
  198. { Remove the lib file, it's extracted so it can be created with ease }
  199. if PPLExt=PPUExt then
  200. Shell('rm '+libfn);
  201. {$ifdef unix}
  202. ExtractLib:=n+'.sl/*';
  203. {$else}
  204. ExtractLib:=n+'.sl\*';
  205. {$endif}
  206. end;
  207. Function DoPPU(const PPUFn,PPLFn:String):Boolean;
  208. {
  209. Convert one file (in Filename) to library format.
  210. Return true if successful, false otherwise.
  211. }
  212. Var
  213. inppu,
  214. outppu : tppufile;
  215. b,
  216. untilb : byte;
  217. l,m : longint;
  218. f : file;
  219. ext,
  220. s : string;
  221. ppuversion : dword;
  222. begin
  223. DoPPU:=false;
  224. If Not Quiet then
  225. Write ('Processing ',PPUFn,'...');
  226. inppu:=tppufile.create(PPUFn);
  227. if not inppu.openfile then
  228. begin
  229. inppu.free;
  230. Error('Error: Could not open : '+PPUFn,false);
  231. Exit;
  232. end;
  233. { Check the ppufile }
  234. if not inppu.CheckPPUId then
  235. begin
  236. inppu.free;
  237. Error('Error: Not a PPU File : '+PPUFn,false);
  238. Exit;
  239. end;
  240. ppuversion:=inppu.GetPPUVersion;
  241. if ppuversion<CurrentPPUVersion then
  242. begin
  243. inppu.free;
  244. Error('Error: Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn,false);
  245. Exit;
  246. end;
  247. { No .o file generated for this ppu, just skip }
  248. if (inppu.header.flags and uf_no_link)<>0 then
  249. begin
  250. inppu.free;
  251. If Not Quiet then
  252. Writeln (' No files.');
  253. DoPPU:=true;
  254. Exit;
  255. end;
  256. { Already a lib? }
  257. if (inppu.header.flags and uf_in_library)<>0 then
  258. begin
  259. inppu.free;
  260. Error('Error: PPU is already in a library : '+PPUFn,false);
  261. Exit;
  262. end;
  263. { We need a static linked unit }
  264. if (inppu.header.flags and uf_static_linked)=0 then
  265. begin
  266. inppu.free;
  267. Error('Error: PPU is not static linked : '+PPUFn,false);
  268. Exit;
  269. end;
  270. { Check if shared is allowed }
  271. if tsystem(inppu.header.target) in [system_i386_go32v2] then
  272. begin
  273. Writeln('Warning: shared library not supported for ppu target, switching to static library');
  274. MakeStatic:=true;
  275. end;
  276. { Create the new ppu }
  277. if PPUFn=PPLFn then
  278. outppu:=tppufile.create('ppumove.$$$')
  279. else
  280. outppu:=tppufile.create(PPLFn);
  281. outppu.createfile;
  282. { Create new header, with the new flags }
  283. outppu.header:=inppu.header;
  284. outppu.header.flags:=outppu.header.flags or uf_in_library;
  285. if MakeStatic then
  286. outppu.header.flags:=outppu.header.flags or uf_static_linked
  287. else
  288. outppu.header.flags:=outppu.header.flags or uf_shared_linked;
  289. { read until the object files are found }
  290. untilb:=iblinkunitofiles;
  291. repeat
  292. b:=inppu.readentry;
  293. if b in [ibendinterface,ibend] then
  294. begin
  295. inppu.free;
  296. outppu.free;
  297. Error('Error: No files to be linked found : '+PPUFn,false);
  298. Exit;
  299. end;
  300. if b<>untilb then
  301. begin
  302. repeat
  303. inppu.getdatabuf(buffer^,bufsize,l);
  304. outppu.putdata(buffer^,l);
  305. until l<bufsize;
  306. outppu.writeentry(b);
  307. end;
  308. until (b=untilb);
  309. { we have now reached the section for the files which need to be added,
  310. now add them to the list }
  311. case b of
  312. iblinkunitofiles :
  313. begin
  314. { add all o files, and save the entry when not creating a static
  315. library to keep staticlinking possible }
  316. while not inppu.endofentry do
  317. begin
  318. s:=inppu.getstring;
  319. m:=inppu.getlongint;
  320. if not MakeStatic then
  321. begin
  322. outppu.putstring(s);
  323. outppu.putlongint(m);
  324. end;
  325. AddToLinkFiles(s);
  326. end;
  327. if not MakeStatic then
  328. outppu.writeentry(b);
  329. end;
  330. { iblinkunitstaticlibs :
  331. begin
  332. AddToLinkFiles(ExtractLib(inppu.getstring));
  333. if not inppu.endofentry then
  334. begin
  335. repeat
  336. inppu.getdatabuf(buffer^,bufsize,l);
  337. outppu.putdata(buffer^,l);
  338. until l<bufsize;
  339. outppu.writeentry(b);
  340. end;
  341. end; }
  342. end;
  343. { just add a new entry with the new lib }
  344. if MakeStatic then
  345. begin
  346. outppu.putstring(OutputfileForPPU);
  347. outppu.putlongint(link_static);
  348. outppu.writeentry(iblinkunitstaticlibs)
  349. end
  350. else
  351. begin
  352. outppu.putstring(OutputfileForPPU);
  353. outppu.putlongint(link_shared);
  354. outppu.writeentry(iblinkunitsharedlibs);
  355. end;
  356. { read all entries until the end and write them also to the new ppu }
  357. repeat
  358. b:=inppu.readentry;
  359. { don't write ibend, that's written automatically }
  360. if b<>ibend then
  361. begin
  362. if b=iblinkothersharedlibs then
  363. begin
  364. while not inppu.endofentry do
  365. begin
  366. s:=inppu.getstring;
  367. m:=inppu.getlongint;
  368. outppu.putstring(s);
  369. { strip lib prefix }
  370. if copy(s,1,3)='lib' then
  371. delete(s,1,3);
  372. { strip lib prefix }
  373. if copy(s,1,3)='lib' then
  374. delete(s,1,3);
  375. ext:=ExtractFileExt(s);
  376. if ext<>'' then
  377. delete(s,length(s)-length(ext)+1,length(ext));
  378. libs:=libs+' -l'+s;
  379. outppu.putlongint(m);
  380. end;
  381. end
  382. else
  383. repeat
  384. inppu.getdatabuf(buffer^,bufsize,l);
  385. outppu.putdata(buffer^,l);
  386. until l<bufsize;
  387. outppu.writeentry(b);
  388. end;
  389. until b=ibend;
  390. { write the last stuff and close }
  391. outppu.flush;
  392. outppu.writeheader;
  393. outppu.free;
  394. inppu.free;
  395. { rename }
  396. if PPUFn=PPLFn then
  397. begin
  398. {$push}{$I-}
  399. assign(f,PPUFn);
  400. erase(f);
  401. assign(f,'ppumove.$$$');
  402. rename(f,PPUFn);
  403. {$pop}
  404. if ioresult<>0 then;
  405. end;
  406. { the end }
  407. If Not Quiet then
  408. Writeln (' Done.');
  409. DoPPU:=True;
  410. end;
  411. Function DoFile(const FileName:String):Boolean;
  412. {
  413. Process a file, mainly here for wildcard support under Dos
  414. }
  415. {$ifndef unix}
  416. var
  417. dir : searchrec;
  418. {$endif}
  419. begin
  420. {$ifdef unix}
  421. DoFile:=DoPPU(InputPath+FileName,InputPath+ForceExtension(FileName,PPLExt));
  422. {$else}
  423. DoFile:=false;
  424. findfirst(filename,$20,dir);
  425. while doserror=0 do
  426. begin
  427. if not DoPPU(InputPath+Dir.Name,InputPath+ForceExtension(Dir.Name,PPLExt)) then
  428. exit;
  429. findnext(dir);
  430. end;
  431. findclose(dir);
  432. DoFile:=true;
  433. {$endif}
  434. end;
  435. Procedure DoLink;
  436. {
  437. Link the object files together to form a (shared) library
  438. }
  439. Var
  440. Names : ansistring;
  441. f : file;
  442. Err : boolean;
  443. P : PLinkOEnt;
  444. begin
  445. if not Quiet then
  446. Write ('Linking ');
  447. P:=ObjFiles;
  448. names:='';
  449. While p<>nil do
  450. begin
  451. if Names<>'' then
  452. Names:=Names+' '+InputPath+P^.name
  453. else
  454. Names:=InputPath+p^.Name;
  455. p:=p^.next;
  456. end;
  457. if Names='' then
  458. begin
  459. If not Quiet then
  460. Writeln('Error: no files found to be linked');
  461. exit;
  462. end;
  463. If not Quiet then
  464. WriteLn(names+Libs);
  465. { Run ar or ld to create the lib }
  466. If MakeStatic then
  467. Err:=Shell(arbin+' rs '+outputfile+' '+names)<>0
  468. else
  469. begin
  470. Err:=Shell(ldbin+' -shared -E -o '+OutputFile+' '+names+' '+libs)<>0;
  471. if (not Err) and dostrip then
  472. Shell(stripbin+' --strip-unneeded '+OutputFile);
  473. end;
  474. If Err then
  475. Error('Fatal: Library building stage failed.',true);
  476. { fix permission to 644, so it's not 755 }
  477. {$ifdef unix}
  478. FPChmod(OutputFile,420);
  479. {$endif}
  480. { Rename to the destpath }
  481. if DestPath<>'' then
  482. begin
  483. Assign(F, OutputFile);
  484. Rename(F,DestPath+DirectorySeparator+OutputFile);
  485. end;
  486. end;
  487. Procedure usage;
  488. {
  489. Print usage and exit.
  490. }
  491. begin
  492. Writeln(paramstr(0),': [-qhvbsS] [-e ext] [-o name] [-d path] file [file ...]');
  493. Halt(0);
  494. end;
  495. Procedure processopts;
  496. {
  497. Process command line opions, and checks if command line options OK.
  498. }
  499. var
  500. C : char;
  501. begin
  502. if paramcount=0 then
  503. usage;
  504. { Reset }
  505. ObjFiles:=Nil;
  506. Quiet:=False;
  507. Batch:=False;
  508. DoStrip:=False;
  509. OutputFile:='';
  510. PPLExt:='ppu';
  511. ArBin:='ar';
  512. LdBin:='ld';
  513. StripBin:='strip';
  514. repeat
  515. c:=Getopt (ShortOpts);
  516. Case C of
  517. EndOfOptions : break;
  518. 'S' : MakeStatic:=True;
  519. 'o' : OutputFile:=OptArg;
  520. 'd' : DestPath:=OptArg;
  521. 'i' : begin
  522. InputPath:=OptArg;
  523. if InputPath[length(InputPath)]<>DirectorySeparator then
  524. InputPath:=InputPath+DirectorySeparator;
  525. end;
  526. 'e' : PPLext:=OptArg;
  527. 'q' : Quiet:=True;
  528. 'b' : Batch:=true;
  529. 's' : DoStrip:=true;
  530. '?' : Usage;
  531. 'h' : Usage;
  532. end;
  533. until false;
  534. { Test filenames on the commandline }
  535. if (OptInd>Paramcount) then
  536. Error('Error: no input files',true);
  537. if (OptInd<ParamCount) and (OutputFile='') then
  538. Error('Error: when moving multiple units, specify an output name.',true);
  539. { alloc a buffer }
  540. GetMem (Buffer,Bufsize);
  541. If Buffer=Nil then
  542. Error('Error: could not allocate memory for buffer.',true);
  543. end;
  544. var
  545. i : longint;
  546. begin
  547. Libs:='';
  548. ProcessOpts;
  549. { Write Header }
  550. if not Quiet then
  551. begin
  552. Writeln(Title+' '+Version);
  553. Writeln(Copyright);
  554. Writeln;
  555. end;
  556. { fix the libext and outputfilename }
  557. if Makestatic then
  558. LibExt:=StaticLibExt
  559. else
  560. LibExt:=SharedLibExt;
  561. if OutputFile='' then
  562. OutputFile:=Paramstr(OptInd);
  563. OutputFileForPPU:=OutputFile;
  564. { fix filename }
  565. {$ifdef unix}
  566. if Copy(OutputFile,1,3)<>'lib' then
  567. OutputFile:='lib'+OutputFile;
  568. { For unix skip replacing the extension if a full .so.X.X if specified }
  569. i:=pos('.so.',Outputfile);
  570. if i<>0 then
  571. OutputFileForLink:=Copy(Outputfile,4,i-4)
  572. else
  573. begin
  574. OutputFile:=ForceExtension(OutputFile,LibExt);
  575. OutputFileForLink:=Copy(Outputfile,4,length(Outputfile)-length(LibExt)-4);
  576. end;
  577. {$else}
  578. OutputFile:=ForceExtension(OutputFile,LibExt);
  579. OutputFileForLink:=OutputFile;
  580. {$endif}
  581. { Open BatchFile }
  582. if Batch then
  583. begin
  584. Assign(BatchFile,'pmove'+BatchExt);
  585. Rewrite(BatchFile);
  586. end;
  587. { Process Files }
  588. i:=OptInd;
  589. While (i<=ParamCount) and Dofile(ChangeFileExt(Paramstr(i),PPUExt)) do
  590. Inc(i);
  591. { Do Linking stage }
  592. DoLink;
  593. { Close BatchFile }
  594. if Batch then
  595. begin
  596. if Not Quiet then
  597. Writeln('Writing pmove'+BatchExt);
  598. Close(BatchFile);
  599. {$ifdef unix}
  600. FPChmod('pmove'+BatchExt,493);
  601. {$endif}
  602. end;
  603. { The End }
  604. if Not Quiet then
  605. Writeln('Done.');
  606. end.