home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 339.lha / M2Lib / M2Lib.mod < prev    next >
Text File  |  1990-02-08  |  4KB  |  159 lines
  1. MODULE M2Lib;
  2.  
  3. FROM  Terminal IMPORT
  4.    WriteString,   WriteLn;
  5.  
  6. FROM  DOSFiles IMPORT
  7.    FileHandle, ModeReadOnly,  ModeNewFile,   FileInfoBlock, FileInfoBlockPtr, 
  8.    Open, Close,   Read, Write,   Examine, Lock, Unlock;
  9.  
  10. FROM  DOSLibrary  IMPORT
  11.    DOSName, DOSBase;
  12.  
  13. FROM  Libraries   IMPORT
  14.    OpenLibrary,   CloseLibrary;
  15.  
  16. FROM  Memory   IMPORT
  17.    AllocMem,   MemReqSet,  MemChip, FreeMem;
  18.  
  19. FROM  Resident IMPORT
  20.    MatchWord;
  21.  
  22. FROM  CommandLine IMPORT
  23.    CLStrings,  GetCL;
  24.  
  25. FROM  SYSTEM   IMPORT
  26.    NULL, ADDRESS, TSIZE;
  27.  
  28. TYPE
  29.    PA=POINTER TO ADDRESS;
  30.    PI=POINTER TO INTEGER;
  31.    SearchBytes=
  32.       RECORD
  33.          CASE :INTEGER OF
  34.             0:    sbChars:ARRAY[1..4] OF CHAR;|
  35.             1:    sbAddr:ADDRESS;|
  36.          END;
  37.       END;
  38.  
  39. VAR
  40.    Buf:ADDRESS;
  41.    BufSize:LONGCARD;
  42.    FileIn,FileOut:FileHandle;
  43.    FileLock:LONGCARD;
  44.    Size:LONGINT;
  45.    FIB:FileInfoBlockPtr;
  46.    BufP,BufEnd:PA;
  47.    MatchP:PI;
  48.    Search:SearchBytes;
  49.    ArgCount:CARDINAL;
  50.    Args:ARRAY[ 0..5 ] OF CLStrings;
  51.  
  52. CONST
  53.    FileName=0;
  54.    LibName=1;
  55.  
  56. PROCEDURE Msg( VAR s:ARRAY OF CHAR);
  57. BEGIN
  58.    WriteString(s);WriteLn;
  59. END Msg;
  60.  
  61. BEGIN
  62.    IF GetCL( ArgCount , Args ) THEN
  63.    ELSE
  64.       Msg( 'Too many arguments');
  65.       RETURN;
  66.    END;
  67.    IF ArgCount # 2 THEN
  68.       Msg('Format is  fixhunk object_file lib_file');
  69.       RETURN;
  70.    END;
  71.    WriteString('Object file:');WriteString(Args[ FileName ] );WriteLn;
  72.    WriteString('Library file:');WriteString(Args[ LibName ] );WriteLn;
  73.    WITH Search DO
  74.       sbChars[1]:='Z'; sbChars[2]:='X'; sbChars[3]:='C'; sbChars[4]:='V';
  75.    END;
  76.    DOSBase := OpenLibrary( DOSName , 0 );
  77.    FileLock := Lock(Args[ FileName ] , ModeReadOnly );
  78.    IF FileLock = 0 THEN
  79.       WriteString('Could not open ');Msg(Args[ FileName ] );
  80.       RETURN;
  81.    END;
  82.    FileOut := Open(Args[ LibName ] , ModeNewFile );
  83.    IF FileOut = 0 THEN
  84.       WriteString('Could not open ');Msg(Args[ LibName ] );
  85.       Unlock( FileLock );
  86.       RETURN;
  87.    END;
  88.    FIB := FileInfoBlockPtr( AllocMem( TSIZE( FileInfoBlock ) ,
  89.                                       MemReqSet{ MemChip } ) );
  90.    IF FIB = NULL THEN
  91.       Msg('Could not allocate FileInfoBlock');
  92.       Unlock( FileLock );
  93.       Close( FileOut );
  94.       RETURN;
  95.    END;
  96.    IF Examine( FileLock , FIB^ ) THEN
  97.       Unlock( FileLock );
  98.       BufSize := FIB^.fibSize + 100;
  99.       Buf := AllocMem( BufSize , MemReqSet{ MemChip } );
  100.       IF Buf # NULL THEN
  101.          FileIn := Open(Args[ FileName ] , ModeReadOnly );
  102.          Size := Read( FileIn , Buf , BufSize );
  103.  
  104.          BufP := PA( Buf );
  105.          BufEnd := PA( LONGCARD(BufP)+BufSize );
  106.          WHILE ( ADDRESS(BufP) < ADDRESS(BufEnd) ) AND ( BufP^ # Search.sbAddr ) DO
  107.             BufP := PA( ADDRESS( BufP ) + ADDRESS( 2 ) );
  108.          END;
  109.          IF ADDRESS(BufP) >= ADDRESS(BufEnd) THEN
  110.             Msg('Could not find Resident structure');
  111.             Close( FileIn );
  112.             Close( FileOut );
  113.             FreeMem( FIB , TSIZE( FileInfoBlock ) );
  114.             FreeMem( Buf , BufSize );
  115.             RETURN;
  116.          END;
  117.          MatchP := PI( ADDRESS( BufP ) + ADDRESS( 4 ) );
  118.          MatchP^ := MatchWord;
  119.          BufP := PA( ADDRESS( BufP ) + ADDRESS( 6 ) );
  120.          BufP^ := BufP^ + ADDRESS( 4 );
  121.          MatchP := PI( ADDRESS( BufP ) + ADDRESS( 18 ) );
  122.          MatchP^ := 0;
  123.  
  124.          FileOut := Open(Args[ LibName ] , ModeNewFile );
  125.          IF FileOut = 0 THEN
  126.             WriteString('Could not open ');Msg(Args[ LibName ] );
  127.             Close( FileIn );
  128.             FreeMem( FIB , TSIZE( FileInfoBlock ) );
  129.             FreeMem( Buf , BufSize );
  130.             RETURN;
  131.          END;
  132.          Size := Write( FileOut , Buf , LONGCARD( Size ) );
  133.          IF Size = -1 THEN
  134.             WriteString('Could not write to ');Msg(Args[ LibName ] );
  135.             Close( FileIn );
  136.             Close( FileOut );
  137.             FreeMem( FIB , TSIZE( FileInfoBlock ) );
  138.             FreeMem( Buf , BufSize );
  139.             RETURN;
  140.          END;
  141.          Close( FileIn );
  142.          Close( FileOut );
  143.          FreeMem( FIB , TSIZE( FileInfoBlock ) );
  144.          FreeMem( Buf , BufSize );
  145.       ELSE
  146.          Msg('Could not allocate buffer space to hold objectfile');
  147.          FreeMem( FIB , TSIZE( FileInfoBlock ) );
  148.          Close( FileOut );
  149.          RETURN;
  150.       END;
  151.    ELSE
  152.       FreeMem( FIB , TSIZE( FileInfoBlock ) );
  153.       Close( FileOut );
  154.       Msg('Could not lock objectfile');
  155.    END;
  156.    CloseLibrary( DOSBase );
  157.    Msg('Successful');
  158. END M2Lib.
  159.