libdump/src/Main.m3


UNSAFE MODULE Main;

IMPORT IO, Params, Rd, Wr, FileRd, Process, Stdio;
IMPORT CoffTime, Text, Fmt, Cstring, Thread, Word, OSError;
IMPORT Date, Convert, M3toC, Ctypes;

TYPE
  UINT8 = BITS 8 FOR Ctypes.unsigned_char;

CONST IMAGE_ARCHIVE_START_SIZE = 8;
VAR (* CONST *) IMAGE_ARCHIVE_START := M3toC.FlatTtoS("!<arch>\n");

TYPE
  IMAGE_ARCHIVE_MEMBER_HEADER = RECORD
    Name     : ARRAY [0 .. 15] OF UINT8;  (* member name - `/' terminated. *)
    Date     : ARRAY [0 .. 11] OF UINT8;  (* member date - decimal secs since 1970 *)
    UserID   : ARRAY [0 .. 5]  OF UINT8;  (* member user id - decimal. *)
    GroupID  : ARRAY [0 .. 5]  OF UINT8;  (* member group id - decimal. *)
    Mode     : ARRAY [0 .. 7]  OF UINT8;  (* member mode - octal. *)
    Size     : ARRAY [0 .. 9]  OF UINT8;  (* member size - decimal. *)
    EndHeader: ARRAY [0 .. 1]  OF UINT8;  (* String to end header. *)
  END;

CONST IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR = 60;

TYPE
  Header = IMAGE_ARCHIVE_MEMBER_HEADER;
  Buffer = REF ARRAY OF CHAR;

VAR
  exports1  : Buffer := NIL;
  exports2  : Buffer := NIL;
  longnames : Buffer := NIL;

PROCEDURE DumpLib (lib: TEXT) =
  VAR rd: Rd.T;
  BEGIN
    TRY
      rd := FileRd.Open (lib);
    EXCEPT OSError.E =>
      Die ("unable to open \"" & lib & "\".");
    END;

    TRY
      CheckMagic (rd, lib);
      FOR i := 0 TO LAST(INTEGER) DO
        IF Rd.EOF (rd) THEN EXIT; END;
        DumpMember (rd, i);
      END;
      DumpExports1 ();
      DumpExports2 ();
      Wr.Flush (Stdio.stdout);
      Rd.Close (rd);
    EXCEPT
    | Rd.Failure => Die ("I/O read failure.");
    | Wr.Failure => Die ("I/O write failure.");
    | Thread.Alerted => Die ("interrupted.");
    END;
  END DumpLib;

PROCEDURE CheckMagic (rd: Rd.T;  lib: TEXT)
  RAISES {Rd.Failure, Thread.Alerted} =
  VAR buf: ARRAY [0..IMAGE_ARCHIVE_START_SIZE-1] OF CHAR;
  BEGIN
    Read (rd, buf);
    IF Cstring.strncmp (ADR (buf), IMAGE_ARCHIVE_START,
                        IMAGE_ARCHIVE_START_SIZE) = 0 THEN
      IO.Put (Wr.EOL & lib & ": magic ok." & Wr.EOL & Wr.EOL);
      IO.Put (" offset  UserID  GrpID   Mode           Date            Size    Name" & Wr.EOL);
      IO.Put ("-------- ------ ------ -------- -------------------- ---------- ----------------" & Wr.EOL);
    ELSE
      Die ("\"" & lib & "\" is not an archive (wrong magic number).");
    END;
  END CheckMagic;

PROCEDURE DumpMember (rd: Rd.T;  index: INTEGER)
  RAISES {Rd.Failure, Thread.Alerted, Wr.Failure} =
  VAR
    hdr: Header;
    here := Rd.Index (rd);
    nm_offs : INTEGER;
    size    : INTEGER;
  BEGIN
    Read (rd, LOOPHOLE (hdr, ARRAY [0..BYTESIZE(hdr)-1] OF CHAR));

    OutX (here, 8);      OutC (' ');
    OutS (hdr.UserID);   OutC (' ');
    OutS (hdr.GroupID);  OutC (' ');
    OutS (hdr.Mode);     OutC (' ');
    OutD (hdr.Date);     OutC (' ');
    OutS (hdr.Size);     OutC (' ');
    IF (hdr.Name[0] = ORD ('/'))
      AND (ORD ('0') <= hdr.Name[1]) AND (hdr.Name[1] <= ORD ('9'))
      AND (longnames # NIL) THEN
      nm_offs := ToInt (SUBARRAY (hdr.Name, 1, NUMBER(hdr.Name)-1));
      IF (0 <= nm_offs) AND (nm_offs < NUMBER (longnames^))
        THEN OutSP (ADR (longnames[nm_offs]));
        ELSE OutSL (hdr.Name);
      END;
    ELSE
      OutSL (hdr.Name);
    END;
    OutT (Wr.EOL);

    (* check for special members and skip to the next header *)
    INC (here, BYTESIZE (hdr));
    size := ToInt (hdr.Size);
    size := Word.And (size + 1, Word.Not (1)); (* round up to an even size *)
    IF (index > 2) THEN
      (* skip this file *)
      Rd.Seek (rd, here + size);
    ELSIF (index = 0) AND NameMatch (hdr.Name, "/") THEN
      exports1 := NEW (Buffer, size);
      Read (rd, exports1^);
    ELSIF (index = 1) AND NameMatch (hdr.Name, "/") THEN
      exports2 := NEW (Buffer, size);
      Read (rd, exports2^);
    ELSIF (index <= 2) AND NameMatch (hdr.Name, "//") THEN
      longnames := NEW (Buffer, size);
      Read (rd, longnames^);
    ELSE
      (* skip this file *)
      Rd.Seek (rd, here + size);
    END;
  END DumpMember;

PROCEDURE DumpExports1 ()
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR
    n_syms : INTEGER;
    offs   : REF ARRAY OF INTEGER;
    next_c : INTEGER := 0;
    ch     : CHAR;
  BEGIN
    IF (exports1 = NIL) THEN RETURN; END;

    OutT (Wr.EOL);
    OutT ("Export table #1");  OutT (Wr.EOL);

    n_syms := get_be_int (exports1, next_c);
    OutT ("# symbols = ");  OutI (n_syms, 0);  OutT (Wr.EOL);
    OutT ("---------------------------");  OutT (Wr.EOL);

    (* read the file offsets *)
    offs := NEW (REF ARRAY OF INTEGER, n_syms);
    FOR i := 0 TO n_syms-1 DO
      offs[i] := get_be_int (exports1, next_c);
    END;

    (* finally, dump the exports *)
    FOR i := 0 TO n_syms-1 DO
      OutI (i, 4);        OutC (' ');
      OutX (offs[i], 8);  OutC (' ');
      WHILE (next_c < NUMBER (exports1^)) DO
        ch := exports1[next_c];  INC (next_c);
        IF (ch = '\000') THEN EXIT; END;
        OutC (ch);
      END;
      OutT (Wr.EOL);
    END;
  END DumpExports1;

PROCEDURE get_be_int (buf: Buffer;  VAR cur: INTEGER): INTEGER =
  VAR n := 0;  x := NUMBER (buf^);
  BEGIN
    IF (cur < x) THEN
      n := ORD (buf[cur]);  INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (Word.LeftShift (n, 8), ORD (buf[cur]));
      INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (Word.LeftShift (n, 8), ORD (buf[cur]));
      INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (Word.LeftShift (n, 8), ORD (buf[cur]));
      INC (cur);
    END;
    RETURN n;
  END get_be_int;

PROCEDURE DumpExports2 ()
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR
    n_files : INTEGER;
    offs    : REF ARRAY OF INTEGER;
    n_syms  : INTEGER;
    symfile : REF ARRAY OF INTEGER;
    next_c  : INTEGER := 0;
    ch      : CHAR;
  BEGIN
    IF (exports2 = NIL) THEN RETURN; END;

    OutT (Wr.EOL);
    OutT ("Export table #2");  OutT (Wr.EOL);

    n_files := get_le_int (exports2, next_c);
    OutT ("# files = ");  OutI (n_files, 0);  OutT (Wr.EOL);

    (* read the file offsets *)
    offs := NEW (REF ARRAY OF INTEGER, n_files);
    FOR i := 0 TO n_files-1 DO
      offs[i] := get_le_int (exports2, next_c);
    END;

    n_syms := get_le_int (exports2, next_c);
    OutT ("# symbols = ");  OutI (n_syms, 0);  OutT (Wr.EOL);
    OutT ("---------------------------");  OutT (Wr.EOL);

    (* read the symbol indicies *)
    symfile := NEW (REF ARRAY OF INTEGER, n_syms);
    FOR i := 0 TO n_syms-1 DO
      symfile[i] := get_le_short (exports2, next_c);
    END;

    (* finally, dump the exports *)
    FOR i := 0 TO n_syms-1 DO
      OutI (i, 4);           OutC (' ');
      OutI (symfile[i], 4);  OutC (' ');
      IF (1 <= symfile[i]) AND (symfile[i] <= NUMBER (offs^))
        THEN OutX (offs[symfile[i] - 1], 8);  OutC (' ');
        ELSE OutT ("   ***** ");
      END;
      WHILE (next_c < NUMBER (exports2^)) DO
        ch := exports2[next_c];  INC (next_c);
        IF (ch = '\000') THEN EXIT; END;
        OutC (ch);
      END;
      OutT (Wr.EOL);
    END;
  END DumpExports2;

PROCEDURE get_le_int (buf: Buffer;  VAR cur: INTEGER): INTEGER =
  VAR n := 0;  x := NUMBER (buf^);
  BEGIN
    IF (cur < x) THEN
      n := ORD (buf[cur]);  INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (n, Word.LeftShift (ORD (buf[cur]), 8));
      INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (n, Word.LeftShift (ORD (buf[cur]), 16));
      INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (n, Word.LeftShift (ORD (buf[cur]), 24));
      INC (cur);
    END;
    RETURN n;
  END get_le_int;

PROCEDURE get_le_short (buf: Buffer;  VAR cur: INTEGER): INTEGER =
  VAR n := 0;  x := NUMBER (buf^);
  BEGIN
    IF (cur < x) THEN
      n := ORD (buf[cur]);  INC (cur);
    END;
    IF (cur < x) THEN
      n := Word.Or (n, Word.LeftShift (ORD (buf[cur]), 8));
      INC (cur);
    END;
    RETURN n;
  END get_le_short;

PROCEDURE Read (rd: Rd.T;  VAR buf: ARRAY OF CHAR)
  RAISES {Rd.Failure, Thread.Alerted} =
  VAR len: INTEGER;
  BEGIN
    len := Rd.GetSub (rd, buf);
    IF (len # BYTESIZE (buf)) THEN Die ("incomplete read."); END;
  END Read;

PROCEDURE OutS (READONLY s: ARRAY OF UINT8)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR n := NUMBER (s);
  BEGIN
    WHILE (n > 0) AND (s[n-1] = ORD (' ')) DO OutC (' ');  DEC (n); END;
    FOR i := 0 TO n-1 DO OutC (VAL (s[i], CHAR)); END;
  END OutS;

PROCEDURE OutSL (READONLY s: ARRAY OF UINT8)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    FOR i := 0 TO LAST (s) DO
      IF (s[i] = ORD ('/')) THEN EXIT; END;
      OutC (VAL (s[i], CHAR));
    END;
  END OutSL;

PROCEDURE OutX (n: INTEGER;  width: INTEGER)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutText (Stdio.stdout, Fmt.Pad (Fmt.Unsigned (n), width, '0'));
  END OutX;

PROCEDURE OutI (n: INTEGER;  width: INTEGER)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutText (Stdio.stdout, Fmt.Pad (Fmt.Int (n), width));
  END OutI;

PROCEDURE OutD (READONLY s: ARRAY OF UINT8)
  RAISES {Wr.Failure, Thread.Alerted} =
  (* Archive dates are represented as seconds since Jan 1, 1970. *)
  TYPE Buffer = RECORD len: INTEGER;  buf: ARRAY [0..31] OF CHAR END;
  VAR
    secs := ToInt (s);
    time := CoffTime.EpochAdjust + FLOAT (secs, LONGREAL);
    date := Date.FromTime (time);
    b    : Buffer;

  PROCEDURE AddInt (VAR b: Buffer;  value, width: INTEGER;  pre, post: CHAR) =
    <*FATAL Convert.Failed*>
    VAR
      buf : ARRAY [0..BITSIZE(INTEGER)] OF CHAR;
      len := Convert.FromInt (buf, value);
    BEGIN
      WHILE (width > len) DO
        b.buf[b.len] := pre;  INC (b.len);
        DEC (width);
      END;
      FOR i := 0 TO len-1 DO
        b.buf[b.len] := buf[i];  INC (b.len);
      END;
      b.buf[b.len] := post;  INC (b.len);
    END AddInt;

  BEGIN (* OutD *)
    b.len := 0;
    AddInt  (b, date.hour,   2, '0', ':');
    AddInt  (b, date.minute, 2, '0', ':');
    AddInt  (b, date.second, 2, '0', ' ');
    AddInt  (b, ORD (date.month) + 1, 2, '0', '/');
    AddInt  (b, date.day,    2, '0', '/');
    AddInt  (b, date.year,   4, ' ', ' ');
    Wr.PutString (Stdio.stdout, SUBARRAY (b.buf, 0, b.len-1));
  END OutD;

PROCEDURE OutSP (cp: UNTRACED REF CHAR)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    IF (cp # NIL) THEN
      WHILE (cp^ # '\000') DO
        OutC (cp^);
        INC (cp, ADRSIZE (cp^));
      END;
    END;
  END OutSP;

PROCEDURE OutT (txt: TEXT)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutText (Stdio.stdout, txt);
  END OutT;

PROCEDURE OutC (ch: CHAR)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar (Stdio.stdout, ch);
  END OutC;

PROCEDURE NameMatch (READONLY nm: ARRAY OF UINT8;  txt: TEXT): BOOLEAN =
  VAR len := Text.Length (txt);
  BEGIN
    IF len > NUMBER (nm) THEN RETURN FALSE; END;
    FOR i := 0 TO len-1 DO
      IF nm[i] # ORD (Text.GetChar (txt, i)) THEN RETURN FALSE; END;
    END;
    FOR i := len TO LAST (nm) DO
      IF nm[i] # ORD (' ') THEN RETURN FALSE; END;
    END;
    RETURN TRUE;
  END NameMatch;

PROCEDURE ToInt (READONLY s: ARRAY OF UINT8): INTEGER =
  VAR n := 0;
  BEGIN
    FOR i := FIRST (s) TO LAST (s) DO
      IF (ORD ('0') <= s[i]) AND (s[i] <= ORD ('9')) THEN
        n := n * 10 + (s[i] - ORD ('0'));
      END;
    END;
    RETURN n;
  END ToInt;

PROCEDURE Die (msg: TEXT) =
  BEGIN
    IO.Put (msg);
    IO.Put (Wr.EOL);
    Process.Exit (1);
  END Die;

BEGIN
  <*ASSERT BYTESIZE (Header) = IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR *>
  IF Params.Count # 2 THEN Die ("usage:  libdump <foo.lib>"); END;
  DumpLib (Params.Get (1));
END Main.