(*---------------------------------------------------------------------------
   :Program.    Dump
   :Author.     Fridtjof Björn Siebert (Amok)
   :Address.    Nobileweg 67, D-7000 Stuttgart-40
   :Phone.      (0)711/822509
   :Shortcut.   [fbs]
   :Version.    0.99
   :Date.       28.03.88
   :Copyright.  PD
   :Language.   Modula-II
   :Translator. M2Amiga
   :Imports.    none.
   :Contents.   Program to make a Hex-Dump from a File.
   :Remark.     Usage: Dump Source [[TO] Dest] [WIDTH xx]
---------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------*)
(*                            -----------------                            *)
(*                  -   -   -   -  D U M P  -  -  -  -  -                  *)
(*                            -----------------                            *)
(*                                                                         *)
(*  © 1988 by Fridtjof Siebert                                             *)
(*            Nobileweg 67                                                 *)
(*            7000 Stuttgart 40 (Stammheim)                                *)
(*            Germany                                                      *)
(*     Phone: (0)711/822509                                                *)
(*                                                                         *)
(*  Usage:                                                                 *)
(*    Dump Source [[TO] Dest] [WIDTH xx]                                   *)
(*                                                                         *)
(*     Source: The file to be dumped                                       *)
(*     Dest:   The Destination File, no Dest -> Type into CLI              *)
(*     xx:     The number of Words to be dumped per Line.                  *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE Dump;

(*------  Importlist:  ------*)

FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,WORD,BITSET,SHIFT,CAST;
FROM Arguments IMPORT NumArgs,GetArg;
FROM Dos IMPORT Open,Close,Read,Write,FileHandlePtr,oldFile,newFile,Output;
FROM Exec IMPORT AllocMem,FreeMem,MemReqSet,MemReqs;
FROM InOut IMPORT WriteString,WriteLn,WriteCard;
FROM Strings IMPORT first,last,Delete,Copy,Insert,Compare,Length,Occurs;
FROM Conversions IMPORT ValToStr,StrToVal;

(*------  Types:  ------*)

TYPE
  ArgStr  = ARRAY[0..79] OF CHAR;
  String2 = ARRAY[0..1] OF CHAR;

(*------  Variables:  ------*)

VAR
  argc: CARDINAL;                     (* count args *)
  argv: ARRAY[0..4] OF ArgStr;        (* the arguments *)
  i,j: INTEGER;                       (* no special use *)
  ic,jc:CARDINAL;                     (* no special use *)
  InBuffer: POINTER TO CARDINAL;      (* Buffer for Input *)
  OutBuffer: POINTER TO ARRAY[0..255] OF CHAR;
  BytePtr: POINTER TO String2;        (* Chars of InBuffer *)
  InH,OutH: FileHandlePtr;            (* FileHandles for I/O *)
  len: LONGCARD;                      (* for saving Writes's result *)
  Hex: ARRAY[0..39] OF CHAR;          (* for Hex-Numbers *)
  ok,ok2: BOOLEAN;                    (* for getting boolean results *)
  code: CARDINAL;                     (* for saving read code *)
  chars: String2;
  Chars: ArgStr;
  Width: LONGINT;
  Dest: BOOLEAN;                      (* is there an Destination-File? *)
  SourceFile: ArgStr;

(*-----------------------  Write String :  --------------------------------*)

PROCEDURE WriteBuf(Lines:CARDINAL);

BEGIN
  IF Write(OutH,OutBuffer,LONGCARD(Length(OutBuffer^)))= -1 THEN
    Close(OutH);
    IF InH#NIL THEN Close(InH) END;
    WriteString("Error while writing"); WriteLn; HALT;
  END;
  OutBuffer^[0] := CHR(10); len := Write(OutH,OutBuffer,1);
  WHILE Lines>1 DO
    len := Write(OutH,OutBuffer,1); DEC(Lines);
  END;
END WriteBuf;

(*------------------------  LineFeed:  ------------------------------------*)

PROCEDURE LF(Lines: CARDINAL);

BEGIN
  OutBuffer^[0] := CHR(10); len := Write(OutH,OutBuffer,1);
  WHILE Lines>1 DO
    len := Write(OutH,OutBuffer,1); DEC(Lines);
  END;
END LF;

(*------------------------  Val To Hex:  ----------------------------------*)

PROCEDURE ValToHex(val:CARDINAL; VAR HexStr:ARRAY OF CHAR);

VAR
  x: CARDINAL;
  i: CARDINAL;
  HexChrs: ARRAY[0..16] OF CHAR;

BEGIN
  HexChrs := "0123456789abcdef"; HexStr := "0000";
  x:= val DIV 4096; HexStr[0] := HexChrs[x]; val := val - (x * 4096);
  x:= val DIV  256; HexStr[1] := HexChrs[x]; val := val - (x *  256);
  x:= val DIV   16; HexStr[2] := HexChrs[x]; val := val - (x *   16);
  HexStr[3] := HexChrs[val];
END ValToHex;

(*-------------------------  Start  ---------------------------------------*)

BEGIN

(*------  Get Commandline:  ------*)

argc := NumArgs();
IF argc>5 THEN WriteString("Too many parameters"); WriteLn(); HALT; END;

(*------  No Parameters? Then type Usage:  ------*)

IF argc=0 THEN
  WriteString("Usage:"); WriteLn;
  WriteString("  Dump Source [TO Dest] [WIDTH xx]"); WriteLn;
  WriteLn;
  WriteString("  Source: The File to be dumped"); WriteLn;
  WriteString("  Dest  : The destination File, no Dest. -> Type into CLI"); WriteLn;
  WriteString("  xx    : The number of Words to be dumped per line"); WriteLn;
  WriteString(" © 1988 by Fridtjof Siebert, Nobileweg 67,D-7000 Stgt-40"); WriteLn;
  WriteString("    Phone: (0)711/822509"); WriteLn;
  HALT;
END;

(*------  read parameters  ------*)

FOR i:=1 TO argc DO
  GetArg(i,argv[i-1],j);
END;

(*------  analyse commandline:  ------*)

(* Default settings: *)
Width := 8; Dest := FALSE;
OutH := Output();

SourceFile := argv[0];
ic := 1;
IF argc>1 THEN
  IF Compare(argv[1],first,2,"TO",FALSE)=0 THEN (* DestFile: *)
    IF argc<3 THEN WriteString("Wrong Parameters."); WriteLn; HALT END;
    OutH := Open(ADR(argv[2]),newFile); Dest := TRUE; ic := 3;
    IF OutH=NIL THEN WriteString("Couldn't open destination."); WriteLn; HALT END;
  END;
  IF argc>ic THEN
    IF Compare(argv[ic],first,5,"WIDTH",FALSE)=0 THEN  (* Width *)
      IF argc<ic+2 THEN WriteString("Wrong Parameters."); WriteLn; HALT END;
      ok := FALSE;
      StrToVal(argv[ic+1],Width,ok,10,ok2);
      IF ok2 THEN WriteString("Error while calculating width."); WriteLn; HALT; END;
    ELSE
      IF Dest THEN
        Close(OutH); WriteString("Wrong Parameters."); WriteLn; HALT;
      END;
      OutH := Open(ADR(argv[ic]),newFile); Dest := TRUE;
      IF OutH=NIL THEN WriteString("Couldn't open destination."); WriteLn; HALT END;
    END;
  END;
END;

InBuffer  := AllocMem(272,MemReqSet{chip,memClear}); (* Speicher *)
BytePtr := ADDRESS(InBuffer);
OutBuffer := ADDRESS(LONGCARD(InBuffer) + 16);

(*------  Open Source:  ------*)

InH := Open(ADR(SourceFile),oldFile); (* open source for reading *)
IF InH=NIL THEN WriteString(SourceFile); WriteString(" not found."); WriteLn; HALT END;

(*------  Create HexDump:  ------*)

len := Read(InH,InBuffer,2); Chars := "";
ic:= 0; jc:= 0; ValToHex(jc,OutBuffer^);
Insert(OutBuffer^,last,": ");

REPEAT
  code := InBuffer^; chars := BytePtr^;
  IF (chars[0]<CHR(32)) OR ((chars[0]>CHR(127)) AND (chars[0]<CHR(160))) THEN
    chars[0] := ".";
  END;
  IF (chars[1]<CHR(32)) OR ((chars[1]>CHR(127)) AND (chars[1]<CHR(160))) THEN
    chars[1] := ".";
  END;
  Insert(Chars,last,chars); ValToHex(code,Hex);
  Insert(OutBuffer^,last,Hex); Insert(OutBuffer^,last," ");
  INC(ic); INC(jc,2);
  IF LONGINT(ic)=Width THEN
    Insert(OutBuffer^,last,Chars); WriteBuf(1);
    ic:= 0; ValToHex(jc,OutBuffer^);
    Insert(OutBuffer^,last,": "); Chars := "";
  END;
  code := InBuffer^; chars := BytePtr^;
UNTIL Read(InH,InBuffer,2)<1;
IF ic#0 THEN
  WHILE LONGINT(ic)<Width DO
    Insert(OutBuffer^,last,"     "); INC(ic);
  END;
  Insert(OutBuffer^,last,Chars);
  WriteBuf(1);
END;
LF(1);

IF Dest THEN Close(OutH) END;
Close(InH);

(*------  Give Mem back:  ------*)

FreeMem(InBuffer,272);

(*------  That's it! ------*)

END Dump.