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