(*****************************************
*                                        *
*           D E C O D E                  *
*                                        *
*    for PDP11 MODULA-2 compiler.        *
*                                        *
*    Decodes MODULA-2 load files         *
*    (extension .LOD).                   *
*                                        *
*    Version of 19.03.80                 *
*                                        *
*    Institut fuer Informatik            *
*    ETH-Zentrum                         *
*    CH-8092 Zuerich                     *
*                                        *
*    Derived from DECODE for MODULA-2    *
*    link files (extension .LNK).        *
*                                        *
*****************************************)
(*$T+,$S+*)
MODULE DecLoad; (* A. Gorrengourt *)
  IMPORT SYSTEM;
  IMPORT Files,NewStreams,Options,WriteStrings;

MODULE Numbers;  (* A.K.G. 02-Mar-79 *)
  FROM NewStreams IMPORT WriteChar,STREAM;
  EXPORT QUALIFIED WriteCard,WriteOct,WriteInt;

  CONST digitbegin = 60B;
  TYPE Digitbuffer = ARRAY [1..6] OF CHAR;

  PROCEDURE WriteOct(VAR f: STREAM; x: CARDINAL; l: INTEGER);
    VAR db: Digitbuffer; i: INTEGER;
  BEGIN i:= 0;
    REPEAT INC(i);
      db[i] := CHR(x MOD 8 + digitbegin);
      x := x DIV 8
    UNTIL x=0;
    WHILE l > 6 DO WriteChar(f,' '); DEC(l) END;
    WHILE l > i DO WriteChar(f,'0'); DEC(l) END;
    WHILE i > 0 DO WriteChar(f,db[i]); DEC(i) END;
  END WriteOct;

  PROCEDURE WriteDec(VAR f: STREAM; x: CARDINAL; l: INTEGER; neg: BOOLEAN);
    VAR db: Digitbuffer; i: INTEGER;
  BEGIN i:= 0;
    REPEAT INC(i);
      db[i] := CHR(x MOD 10 + digitbegin);
      x := x DIV 10
    UNTIL x=0;
    IF neg THEN INC(i); db[i] := '-' END;
    WHILE l > i DO WriteChar(f,' '); DEC(l) END;
    WHILE i > 0 DO WriteChar(f,db[i]); DEC(i) END;
  END WriteDec;

  PROCEDURE WriteCard(VAR f: STREAM; x: CARDINAL; l: INTEGER);
  BEGIN WriteDec(f,x,l,FALSE);
  END WriteCard;

  PROCEDURE WriteInt(VAR f: STREAM; x,l: INTEGER);
  BEGIN WriteDec(f,ABS(x),l, x < 0);
  END WriteInt;

END Numbers;


  MODULE InputOutput;
    FROM SYSTEM IMPORT WORD;
    FROM Files IMPORT FileName,Lookup,Create,Release;
    FROM NewStreams IMPORT
      STREAM,Connect,Disconnect,ReadWord,WriteChar,EndWrite,eolc;
    FROM Options IMPORT FileNameAndOptions,Termination,GetOption;
    IMPORT WriteStrings;
    IMPORT Numbers;

    EXPORT checksum,printChecksum,ErrorMessage,StartIO,EndIO,
           Read,Write,WriteLn,WriteString,
           WriteBlanks,WriteNumbers,loadStream;

    CONST loadFile = 1; (*channel number*)
          decFile  = 2; (*channel number*)
          DefaultLoadFile = "DK       LOD";

    VAR loadStream,decStream: STREAM;
        checksum: CARDINAL; (*initialised to 0*)
        printChecksum: BOOLEAN;

    PROCEDURE ErrorMessage(str: ARRAY OF CHAR);
    BEGIN
      WriteStrings.WriteString(str);
      WriteStrings.WriteLn;
    END ErrorMessage;

    PROCEDURE StartIO(VAR found: BOOLEAN);

      PROCEDURE SetOptions(VAR optError: BOOLEAN);
        VAR optStr: ARRAY [0..1] OF CHAR;
            lgth: CARDINAL; ch: CHAR;
      BEGIN
        optError := FALSE;
        printChecksum := FALSE;
        REPEAT GetOption(optStr,lgth);
          IF lgth > 0 THEN
            IF lgth = 1 THEN
              ch := CAP(optStr[0]);
              IF ch = 'C' THEN printChecksum := TRUE;
              ELSE optError := TRUE;
              END;
            ELSE optError := TRUE;
            END;
          END;
        UNTIL lgth = 0;
      END SetOptions;

      VAR loadName,decName: FileName;
          reply: INTEGER; ch: CHAR;
          term: Termination;
          optError: BOOLEAN;
    BEGIN
      found := FALSE;
      REPEAT
        Release(loadFile); Release(decFile);
        WriteStrings.WriteString(" load file> ");
        loadName := DefaultLoadFile; loadName[3] := '?';
        FileNameAndOptions(loadName,loadName,term,TRUE);
        WriteStrings.WriteLn;
        SetOptions(optError);
        IF term = normal THEN
          IF optError THEN
            WriteStrings.WriteString(" ---- bad option");
            WriteStrings.WriteLn;
          ELSE
            Lookup(loadFile,loadName,reply);
            IF reply > 0 THEN
              found := TRUE;
              Connect(loadStream,loadFile,TRUE);
              decName := loadName;
              decName[ 9] := 'D';
              decName[10] := 'E';
              decName[11] := 'C';
              Create(decFile,decName,reply);
              Connect(decStream,decFile,FALSE);
            ELSE
              IF reply = 0 THEN
                WriteStrings.WriteString(" ---- empty file");
              ELSE
                WriteStrings.WriteString(" ---- file not found");
              END;
              WriteStrings.WriteLn;
            END;
          END;
        ELSIF term = empty THEN
          WriteStrings.WriteString(" ---- no default file");
          WriteStrings.WriteLn;
        END;
      UNTIL found OR (term = esc);
    END StartIO;

    PROCEDURE EndIO;
    BEGIN
      EndWrite(decStream);
      Disconnect(decStream,TRUE);
      Disconnect(loadStream,TRUE);
    END EndIO;

    PROCEDURE Read(VAR w: WORD);
    BEGIN
      ReadWord(loadStream,w);
      (*$T-*) INC(checksum,CARDINAL(w)); (*$T=*)
    END Read;

    PROCEDURE Write(ch: CHAR);
    BEGIN 
      WriteChar(decStream,ch);
    END Write;

    PROCEDURE WriteLn;
    BEGIN
      WriteChar(decStream,eolc);
    END WriteLn;

    PROCEDURE WriteString(str: ARRAY OF CHAR);
      VAR k: CARDINAL;
    BEGIN k := 0;
      WHILE (k <= HIGH(str)) AND (str[k] <> 0C) DO
        Write(str[k]); INC(k);
      END;
    END WriteString;

    PROCEDURE WriteBlanks(n: INTEGER);
    BEGIN
      WHILE n > 0 DO DEC(n); Write(' ') END;
    END WriteBlanks;

    MODULE WriteNumbers;
      IMPORT Numbers,Write,decStream;
      EXPORT WriteOct,WriteCard,WriteInt,WriteDigit;

      PROCEDURE WriteOct(x: CARDINAL; l: INTEGER);
      BEGIN Numbers.WriteOct(decStream,x,l);
      END WriteOct;

      PROCEDURE WriteCard(x: CARDINAL; l: INTEGER);
      BEGIN Numbers.WriteCard(decStream,x,l);
      END WriteCard;

      PROCEDURE WriteInt(x,l: INTEGER);
      BEGIN Numbers.WriteInt(decStream,x,l);
      END WriteInt;

      PROCEDURE WriteDigit(x: CARDINAL);
      BEGIN Write(CHR(x + 60B));
      END WriteDigit;

    END WriteNumbers;

  BEGIN checksum := 0;
  END InputOutput;

  MODULE Binary;
    IMPORT InputOutput;
    EXPORT NoDecode;

    PROCEDURE LineHeader(ic,loadpoint: CARDINAL);
    BEGIN
      WriteOct(ic,7);
      IF loadpoint <> 0 THEN WriteOct(loadpoint + ic,8)
      ELSE WriteBlanks(8)
      END;
    END LineHeader;

    PROCEDURE NoDecode(loadpoint,maxbyte: CARDINAL);
      VAR ic,printed,w: CARDINAL;
    BEGIN
      WriteString('NO DECODE -------- ');
      WriteString('DATA');
      ic := 0; printed := 10;
      WHILE ic < maxbyte DO
        IF printed = 10 THEN
          printed := 0; WriteLn;
          LineHeader(ic,loadpoint); Write(' ');
        END;
        Read(w); WriteOct(w,10);
        INC(ic,2); INC(printed);
      END;
      WriteLn;
    END NoDecode;

  END Binary;

  MODULE DecodeLoadFormat;
    FROM NewStreams IMPORT EOS;
    IMPORT WriteStrings,InputOutput,NoDecode;
    EXPORT InitFlagNames,LoadDecoder;

    TYPE FlagType =
          (EntryPointFlag,CodeFlag,LinkerTableFlag,
           DebuggerTableFlag,OldLoadKeyFlag,NewLoadKeyFlag,
           NewFirstFreeLocFlag,OldFirstFreeLocFlag,
           MaxFlag);

    CONST modnamlength = 24;

    VAR flagName: ARRAY FlagType,[0..23] OF CHAR;

    PROCEDURE GetWriteModuleName;
      VAR k,l: CARDINAL;
          ch: CHAR; print: BOOLEAN;
    BEGIN l := 0; print := TRUE;
      REPEAT Read(k); INC(l);
        IF print THEN
          ch := CHR(k MOD 400B);
          IF ch <> 0C THEN Write(ch)
          ELSE print := FALSE
          END
        END;
        IF print THEN
          ch := CHR(k DIV 400B);
          IF ch <> 0C THEN Write(ch)
          ELSE print := FALSE
          END
        END;
      UNTIL l >= modnamlength DIV 2;
    END GetWriteModuleName;

    PROCEDURE GetWriteOct(VAR k: CARDINAL);
    BEGIN Read(k); WriteOct(k,7);
    END GetWriteOct;

    PROCEDURE GetWriteAddress;
      VAR k: CARDINAL;
    BEGIN WriteString(", address =");
      GetWriteOct(k);
    END GetWriteAddress;

    PROCEDURE GetWriteLength(VAR length: CARDINAL);
    BEGIN Read(length);
      WriteString(", number of bytes = ");
      WriteCard(length,0(*i.e. just significant digits*));
    END GetWriteLength;

    PROCEDURE GetWriteChecksum;
      VAR savechecksum,lchecksum: CARDINAL;
    BEGIN
      savechecksum := checksum; Read(lchecksum);
      WriteString(" checksum:");
      IF printChecksum THEN
        WriteOct(lchecksum,7);
      END;
      IF savechecksum = lchecksum THEN
        WriteString(" o.k.");
      ELSE 
        WriteString(" ----- error -----");
        IF printChecksum THEN
          WriteOct(savechecksum,7);
        END;
      END;
      checksum := savechecksum;
      WriteLn;
    END GetWriteChecksum;

    PROCEDURE InitFlagNames;
    BEGIN
      flagName[EntryPointFlag]      := 'entry point';
      flagName[CodeFlag]            := 'code';
      flagName[LinkerTableFlag]     := 'linker table';
      flagName[DebuggerTableFlag]   := 'debugger table';
      flagName[OldLoadKeyFlag]      := 'old load key';
      flagName[NewLoadKeyFlag]      := 'new load key';
      flagName[NewFirstFreeLocFlag] := 'new first free location';
      flagName[OldFirstFreeLocFlag] := 'old first free location';
    END InitFlagNames;

    PROCEDURE LoadDecoder;
      VAR flag: FlagType;
          length,k: CARDINAL;
          ok: BOOLEAN;

    BEGIN
      Read(k); ok := FALSE;
      IF k = ORD(OldLoadKeyFlag) THEN
        WriteString(flagName[OldLoadKeyFlag]);
        GetWriteLength(length); ok := length = 6;
        WriteString(", load key =");
        GetWriteOct(k); WriteLn;
        GetWriteChecksum;
        LOOP
          IF NOT ok THEN EXIT END;
          Read(k);
          IF EOS(loadStream) THEN EXIT END;
          WriteLn;
          IF k < ORD(MaxFlag) THEN
            flag := VAL(FlagType,k);
            WriteString(flagName[flag]);
            GetWriteLength(length);
            CASE flag OF
              EntryPointFlag:
                ok := length = 6;
                GetWriteAddress; WriteLn;
            | CodeFlag:
                WriteString(", loadpoint =");
                GetWriteOct(k); WriteLn;
                DEC(length,6);
                NoDecode(k,length);
            | LinkerTableFlag:
                WriteLn;
                WriteString("  keys: ");
                Read(k);
                Write(' '); WriteOct(k DIV 400B,3);
                Write(' '); WriteOct(k MOD 400B,3);
                GetWriteOct(k); WriteLn;
                WriteString("  module descriptors");
                GetWriteLength(k); Write(':'); WriteLn;
                DEC(length,10);
                NoDecode(0,k);
                WriteString("  procedure descrciptors:");
                WriteLn;
                NoDecode(0,length-k);
            | DebuggerTableFlag:
                GetWriteAddress; WriteLn;
                WriteString("  module: "); GetWriteModuleName;
                WriteLn;
                DEC(length,6 + modnamlength);
                WriteString("  procedure addresses:"); WriteLn;
                NoDecode(0,length);
            | OldLoadKeyFlag: ok := FALSE;
            | NewLoadKeyFlag:
                ok := length = 6;
                WriteString(", load key =");
                GetWriteOct(k); WriteLn;
            | NewFirstFreeLocFlag,OldFirstFreeLocFlag:
                ok := length = 6;
                GetWriteAddress; WriteLn;
            END (*CASE*);
            GetWriteChecksum;
          ELSE ok := FALSE;
          END;
        END (*LOOP*);
      END;
      IF NOT ok THEN
        WriteStrings.WriteString("---- wrong format");
        WriteStrings.WriteLn;
        WriteString("---- wrong format"); WriteLn;
      END;
    END LoadDecoder;

  END DecodeLoadFormat;


  VAR found: BOOLEAN;

BEGIN (*DecLoad*)
  StartIO(found);
  IF found THEN
    InitFlagNames;
    LoadDecoder;
    EndIO;
  END;
END DecLoad.