(*****************************************
*                                        *
*           D E C O D E                  *
*                                        *
*    for PDP11 MODULA-2 compiler.        *
*                                        *
*    Decodes MODULA-2 link files         *
*    (extension .LNK).                   *
*                                        *
*    Version of 19.03.81                 *
*                                        *
*    Institut fuer Informatik            *
*    ETH-Zentrum                         *
*    CH-8092 Zuerich                     *
*                                        *
*    Derived from DECODE for previous    *
*    versions of MODULA compiler:        *
*      04.03.77  Van Kiet Le             *
*      10.08.78  Christian Jacobi        *
*      06.07.79  Anton Gorrengourt       *
*                                        *
*****************************************)
(*$T+,$S+*)
MODULE DecodeLinkFormat; (* A. Gorrengourt *)
(* Decode of FPP instructions implemented by G.Maier *)

  IMPORT SYSTEM;
  IMPORT Files,NewStreams,WriteStrings,Options;


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;

    CONST linkFile = 1; (*channel number*)
          decFile  = 2; (*channel number*)
          DefaultLinkFile = "DK       LNK";

    VAR linkStream,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 linkName,decName: FileName;
          reply: INTEGER; ch: CHAR;
          term: Termination;
          optError: BOOLEAN;
    BEGIN
      found := FALSE;
      REPEAT
        Release(linkFile); Release(decFile);
        WriteStrings.WriteString(" link file> ");
        linkName := DefaultLinkFile; linkName[3] := '?';
        FileNameAndOptions(linkName,linkName,term,TRUE);
        WriteStrings.WriteLn;
        SetOptions(optError);
        IF term = normal THEN
          IF optError THEN
            WriteStrings.WriteString(" ---- bad option");
            WriteStrings.WriteLn;
          ELSE
            Lookup(linkFile,linkName,reply);
            IF reply > 0 THEN
              found := TRUE;
              Connect(linkStream,linkFile,TRUE);
              decName := linkName;
              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(linkStream,TRUE);
    END EndIO;

    PROCEDURE Read(VAR w: WORD);
    BEGIN
      ReadWord(linkStream,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 TrapHandling;
    (*according to MODULA-2 TRAP Handler, 17.02.81*)
    EXPORT TrapTable,InitTraps;

    VAR TrapTable: ARRAY [0..377B] OF CARDINAL;
        (*contains to every TRAP its number of parameters (words),
          that follow the TRAP instruction immediately in the code*)

    PROCEDURE InitTraps;
      VAR k: CARDINAL;
    BEGIN k := 0;
      REPEAT TrapTable[k] := 0; INC(k)
      UNTIL k = 400B;
      TrapTable[10B] := 3; TrapTable[12B] := 3; TrapTable[14B] := 3;
      TrapTable[16B] := 2; TrapTable[20B] := 1; TrapTable[22B] := 3;
      TrapTable[24B] := 1;
      TrapTable[26B] := 1; TrapTable[30B] := 1; TrapTable[32B] := 1;
      TrapTable[34B] := 2; TrapTable[36B] := 1;
    END InitTraps;

  END TrapHandling;


  MODULE Binary;
    IMPORT InputOutput,TrapTable;
    EXPORT NoDecode,Decode;

    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;


    PROCEDURE Decode(relentry,loadpoint,maxbyte,trapCode: CARDINAL);

      TYPE OctalCode = ARRAY [1..6] OF CARDINAL;

      VAR  
        error: BOOLEAN;                        (*for unused codes*)
        word1: OctalCode;                      (*PDP11-word = opcode*)
        additional: ARRAY [1..2] OF OctalCode; (*for 2- or 3-word instructions*)
        ain,aout: CARDINAL; (*index*)          (*for 2- or 3-word instructions*)
        ic: CARDINAL;                          (*instruction counter*)

      PROCEDURE NextWord(hold: BOOLEAN);

        PROCEDURE GetBinary(VAR word1: OctalCode);  
          VAR i,k: CARDINAL;
        BEGIN
          IF ic < maxbyte THEN
            i := 6; Read(k);
            REPEAT
              word1[i] := k MOD 8;
              k := k DIV 8; DEC(i);
            UNTIL i = 0;
            IF k <> 0 THEN error := TRUE END;
            REPEAT INC(i); WriteDigit(word1[i]);
            UNTIL i = 6;
          ELSE (*bad instruction at end of sequence to be decoded*)
            error := TRUE;
          END;
        END GetBinary;  

      BEGIN (*NextWord*)
        IF NOT hold THEN
          LineHeader(ic,loadpoint);
          WriteBlanks(5);
          GetBinary(word1);
          WriteBlanks(2);
        ELSIF ain < 2 THEN
          INC(ain); GetBinary(additional[ain]);
          WriteBlanks(2)
        ELSE ErrorMessage(' HALT in NextWord'); HALT;
        END;
        INC(ic,2);
      END NextWord;

      PROCEDURE Instruction;

        PROCEDURE GetWords;

          PROCEDURE Next1;
          BEGIN
            CASE word1[5] OF
              3,2:  IF word1[6] = 7 THEN NextWord(TRUE) END;
            | 6,7:  NextWord(TRUE)
              ELSE
            END 
          END Next1;

          PROCEDURE Next2;
          BEGIN
            CASE word1[3] OF
              3,2:  IF word1[4] = 7 THEN NextWord(TRUE) END;
            | 6,7:  NextWord(TRUE)
              ELSE
            END 
          END Next2;

        BEGIN (*GetWords*)
          CASE word1[2] OF  
            0: CASE word1[3] OF  
                 1,2,3,7:;                       (*[X|0|1-3,7|X|X|X]*)
               | 4: CASE word1[1] OF             (*[X|0|4|X|X|X]*)
                      0: Next1;
                    | 1:;
                    END;
               | 5: Next1;                       (*[X|0|5|X|X|X]*)
               | 6: IF (word1[4] <> 4) OR (word1[1] <> 0) THEN
                      Next1;                     (*[X|0|6|X|X|X]*)
                    END;
               | 0: CASE word1[1] OF             (*[X|0|0|X|X|X]*)
                      0: CASE word1[4] OF
                           0,2,4,5,6,7:;
                         | 3,1: Next1
                         END; 
                     | 1: ;
                     END  
               END;  
          | 1,2,3,4,5,6: Next2; Next1;           (*[X|1-6|X|X|X|X]*)
          | 7: IF (word1[1] = 0) AND (word1[3] <= 4) THEN
                 Next1;                          (*[0|7|0-4|X|X|X]*)
               ELSIF word1[1] = 1 THEN
                 (*FPP instruction*)             (*[1|7|X|X|X|X]*)
                 IF (word1[3] > 0) OR (word1[4] >= 4) THEN
                   Next1;
                 END;
               END;
          END;
          IF ain = 0 THEN WriteBlanks(19)
          ELSIF ain = 1 THEN WriteBlanks(11)
          ELSE WriteBlanks(3)
          END
        END GetWords;

        PROCEDURE Offset;
          VAR i: INTEGER;
        BEGIN
          word1[4] := word1[4] MOD 4;
          i := (word1[4]*8+word1[5])*8+word1[6];
          IF i >= 200B THEN DEC(i,400B) END;
          (*$T-*) WriteOct(CARDINAL(2*i)+ic,6); (*$T=*)
        END Offset;

        PROCEDURE Address(mode,reg: CARDINAL);
          VAR x: CARDINAL;

          PROCEDURE Number(VAR x: CARDINAL);
            VAR k: CARDINAL;
          BEGIN
            k := 1; INC(aout);
            IF aout > ain THEN
              ErrorMessage(' HALT in Address'); HALT
            END;
            x := additional[aout,1];
            IF x < 2 THEN
              REPEAT INC(k);  x := x*8 + additional[aout,k]
              UNTIL k = 6;
            ELSE WriteString(' Number too large')
            END;
          END Number;

          PROCEDURE WriteNum(x: CARDINAL);
          BEGIN  
            WriteOct(x,0(*i.e. just significant digits*));
            IF x > 7 THEN
              Write('[');
              WriteInt(x,0(*i.e. just significant digits*));
              Write('.'); Write(']');
            END;
          END WriteNum;

        BEGIN  (*Address*)
          CASE mode OF  
            0: Write('R'); WriteDigit(reg);
          | 1: WriteString('(R'); WriteDigit(reg); Write(')');
          | 2: IF reg <> 7 THEN
                 WriteString('(R'); WriteDigit(reg);
                 WriteString(')+')
               ELSE
                 Write('#'); Number(x); WriteNum(x)
               END;
          | 3: IF reg <> 7 THEN
                 WriteString('@(R'); WriteDigit(reg);
                 WriteString(')+');
               ELSE
                 WriteString('@#');
                 Number(x); WriteOct(x,6)
               END;
          | 4: WriteString('-(R'); WriteDigit(reg);
               Write(')');
          | 5: WriteString('@-(R'); WriteDigit(reg);
               Write(')');
          | 6,7:  
               IF mode = 7 THEN Write('@') END;  
               Number(x);
               IF reg <> 7 THEN  
                 WriteNum(x); WriteString('(R');
                 WriteDigit(reg); Write(')');
               ELSE
                 WriteString('R@#');
                 WriteOct(x + ic + loadpoint - 2*(ain - aout),6);
               END;
          END (*CASE*)
        END Address;

        PROCEDURE ConditionCodes; (*word1 = [0|0|0|2|4-7|X]*)
          VAR b: BOOLEAN;   
              condcode: ARRAY  [0..4]  OF BOOLEAN;  
              x: CARDINAL;   
        BEGIN
          x := word1[5] MOD 4;  
          condcode[3] := x MOD 2 = 1;  
          condcode[4] := x DIV 2 = 1;  
          condcode[2] := word1[6] DIV 4 = 1;  
          x := word1[6] MOD 4;  
          condcode[0] := x MOD 2 = 1;  
          condcode[1] := x DIV 2 = 1;  
          b := FALSE;
          IF condcode[4] THEN  
            IF condcode[3] AND (word1[6] = 7) THEN  
              b := TRUE; WriteString('SCC')
            ELSE   
              IF condcode[0] THEN
                b := TRUE; WriteString('SEC')  
              END;  
              IF condcode[1] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('SEV')
              END;  
              IF condcode[2] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('SEZ')
              END;  
              IF condcode[3] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('SEN')
              END;
            END
          ELSE
            IF condcode[3] AND (word1[6] = 7) THEN  
              b := TRUE; WriteString('CCC')
            ELSE
              IF condcode[0] THEN  
                b := TRUE; WriteString('CLC')
              END;  
              IF condcode[1] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('CLV')
              END;  
              IF condcode[2] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('CLZ')
              END;  
              IF condcode[3] THEN  
                IF b THEN Write(',') END;
                b := TRUE; WriteString('CLN');  
              END;  
            END
          END;
          IF NOT b THEN
            WriteString('NOP')
          END;
        END ConditionCodes;  

        PROCEDURE Case5; (*word1 = [X|0|5|X|X|X]*)
        BEGIN  
          CASE word1[4] OF  
            0:  WriteString('CLR') ;  
          | 1:  WriteString('COM') ;  
          | 2:  WriteString('INC') ;  
          | 3:  WriteString('DEC') ;  
          | 4:  WriteString('NEG') ;  
          | 7:  WriteString('TST') ;  
          | 5:  WriteString('ADC') ;  
          | 6:  WriteString('SBC') ;  
          END;  
          IF word1[1] = 1 THEN WriteString('B ');  
          ELSE WriteBlanks(2) END;  
          Address(word1[5],word1[6]);
        END Case5;  

        PROCEDURE Case6; (*word1 = [X|0|6|X|X|X]*)
        BEGIN  
          IF word1[1] = 0 THEN  
            CASE word1[4] OF  
              0:  WriteString('ROR ') ;  
            | 1:  WriteString('ROL ') ;  
            | 2:  WriteString('ASR ') ;  
            | 3:  WriteString('ASL ') ;  
            | 4:  WriteString('MARK') ;
                  WriteDigit(word1[5]); WriteDigit(word1[6]);
            | 5:  WriteString('MFPI') ;
            | 6:  WriteString('MTPI') ;  
            | 7:  WriteString('SXT ') ;  
            END;   
          ELSE  
            CASE word1[4] OF   
              0:  WriteString('RORB') ;  
            | 1:  WriteString('ROLB') ;  
            | 2:  WriteString('ASRB') ;  
            | 3:  WriteString('ASLB') ;  
            | 4:  WriteString('MTPS') ;  
            | 5:  WriteString('MFPD') ;  
            | 6:  WriteString('MTPD') ;  
            | 7:  WriteString('MFPS') ;  
            END;  
          END;  
          Write(' ');
          IF (word1[1] <> 0) OR (word1[4] <> 4) THEN
            Address(word1[5],word1[6])
          END;
        END Case6;  

        PROCEDURE Case4; (*word1 = [X|0|4|X|X|X]*)
          VAR code: CARDINAL;

          PROCEDURE SkipTrap;
            VAR saveword1: OctalCode; k: CARDINAL;
          BEGIN saveword1 := word1;
            k := ((word1[4] MOD 4)*8 + word1[5])*8 + word1[6];
            k := TrapTable[k];
            WHILE k > 0 DO
              WriteLn; NextWord(FALSE); DEC(k);
            END;
            word1 := saveword1;
          END SkipTrap;

        BEGIN (*Case4*)
          CASE word1[1] OF  
            1: IF word1[4] < 4 THEN
                 WriteString('EMT  '); code := 104000B;
               ELSE
                 WriteString('TRAP '); code := 104400B;
               END;
               WriteDigit(word1[4] MOD 4);
               WriteDigit(word1[5]); WriteDigit(word1[6]);
               IF code = trapCode THEN SkipTrap END;
          | 0: WriteString('JSR  R'); WriteDigit(word1[4]);  
               Write(','); Address(word1[5],word1[6]);
          END;  
        END Case4;  

        PROCEDURE FPPInstruction;
          VAR acsrc,acdst,src,dst: BOOLEAN;
        BEGIN
          acsrc := FALSE; acdst := FALSE;
          src := FALSE; dst := FALSE;
          CASE word1[3] OF
            0: CASE word1[4] OF
                 0: IF word1[5] = 0 THEN
                      CASE word1[6] OF
                        0: WriteString('CFCC ');
                      | 1: WriteString('SETF ');
                      | 2: WriteString('SETI ');
                      ELSE error := TRUE;
                      END;
                    ELSIF word1[5] = 1 THEN
                      IF word1[6] = 1 THEN
                        WriteString('SETD ');
                      ELSIF word1[6] = 2 THEN
                        WriteString('SETL ');
                      ELSE error:=TRUE;
                      END;
                    ELSE error:=TRUE;
                    END;
               | 7: WriteString('NEGF '); dst := TRUE;
               | 5: WriteString('TSTF '); dst := TRUE;
               | 6: WriteString('ABSF '); dst := TRUE;
               | 4: WriteString('CLRF '); dst := TRUE;
               ELSE error:=TRUE;
               END;
          | 1: IF word1[4] < 4 THEN
                 WriteString('MULF ');
               ELSE
                 WriteString('MODF ');
               END;
               src := TRUE; acdst := TRUE;
          | 2: IF word1[4] < 4 THEN
                 WriteString('ADDF ');
               ELSE
                 WriteString('LDF  ');
               END;
               src := TRUE; acdst := TRUE;
          | 3: IF word1[4] < 4 THEN
                 WriteString('SUBF ');
               ELSE
                 WriteString('CMPF ');
               END;
               src := TRUE; acdst := TRUE;
          | 4: IF word1[4] < 4 THEN
                 WriteString('STF  ');
                 acsrc := TRUE; dst := TRUE;
               ELSE
                 WriteString('DIVF ');
                 src := TRUE; acdst := TRUE;
               END;
          | 5: IF word1[4] < 4 THEN
                 WriteString('STEXP');
               ELSE
                 WriteString('STCFI');
               END;
               acsrc := TRUE; dst := TRUE;
          | 6: IF word1[4] < 4 THEN
                 WriteString('STCFD');
                 acsrc := TRUE; dst := TRUE;
               ELSE
                 WriteString('LDEXP');
                 src := TRUE; acdst := TRUE;
               END;
          | 7: IF word1[4] < 4 THEN
                 WriteString('LDCIF');
               ELSE
                 WriteString('LDCDF');
               END;
               src := TRUE; acdst := TRUE;
          END;
          IF acsrc THEN
            CASE word1[4] OF
              0,4: WriteString('AC0,');
            | 1,5: WriteString('AC1,');
            | 2,6: WriteString('AC2,');
            | 3,7: WriteString('AC3,');
            END;
          END;
          IF src OR dst THEN Address(word1[5],word1[6]); END;
          IF acdst THEN
            CASE word1[4] OF
              0,4: WriteString(',AC0');
            | 1,5: WriteString(',AC1');
            | 2,6: WriteString(',AC2');
            | 3,7: WriteString(',AC3');
            END;
          END;
        END FPPInstruction;

      BEGIN (*Instruction*)
        GetWords;
        CASE (*1*) word1[2] OF  
          0: CASE (*2*) word1[3] OF   
               5: Case5;                            (*[X|0|5|X|X|X]*)
             | 6: Case6;                            (*[X|0|6|X|X|X]*)
             | 0: CASE word1[1] OF
                    0: CASE word1[4] OF
                         4,5,6,7:                   (*[0|0|0|4-7|X|X]*)
                            WriteString('BR   '); Offset;
                       | 1: WriteString('JMP  ');   (*[0|0|0|1|X|X]*)
                            Address(word1[5],word1[6])
                       | 2: CASE word1[5] OF        (*[0|0|0|2|X|X]*)
                              0: WriteString('RTS  R');
                                 WriteDigit(word1[6]);
                            | 4,5,6,7: ConditionCodes;  
                            | 1,2,3: error := TRUE;  
                            END;  
                       | 3: WriteString('SWAB');    (*[0|0|0|3|X|X]*)
                            Address(word1[5],word1[6]);
                       | 0: IF word1[5] = 0 THEN    (*[0|0|0|0|X|X]*)
                              CASE word1[6] OF
                                0:  WriteString('HALT ')
                              | 1:  WriteString('WAIT ')
                              | 2:  WriteString('RTI  ')
                              | 3:  WriteString('BPT  ')
                              | 4:  WriteString('IOT  ')
                              | 5:  WriteString('RESET')
                              | 6:  WriteString('RTT  ')
                              | 7:  error := TRUE
                              END;
                            ELSE error := TRUE END;
                       END;
                  | 1: IF word1[4] < 4 THEN         (*[1|0|0|X|X|X]*)
                         WriteString('BPL  ')
                       ELSE WriteString('BMI  ')
                       END;
                       Offset;
                  END; (* CASE word1[1] *)
             | 1: CASE word1[1] OF                  (*[X|0|1|X|X|X]*)
                    1: IF word1[4] < 4 THEN WriteString('BHI  ')  
                       ELSE WriteString('BLOS ') END  
                  | 0: IF word1[4] < 4 THEN WriteString('BNE  ')  
                       ELSE WriteString('BEQ  ') END;
                  END;  
                  Offset;  
             | 2: CASE word1[1] OF                  (*[X|0|2|X|X|X]*)
                    1: IF word1[4] < 4 THEN WriteString('BVC  ')
                       ELSE                 WriteString('BVS  ') END
                  | 0: IF word1[4] < 4 THEN WriteString('BGE  ')  
                       ELSE                 WriteString('BLT  ') END
                  END;  
                  Offset;  
             | 3: CASE word1[1] OF                  (*[X|0|3|X|X|X]*)
                    1: IF word1[4] < 4 THEN WriteString('BCC  ')  
                       ELSE                 WriteString('BCS  ') END
                  | 0: IF word1[4] < 4 THEN WriteString('BGT  ')  
                       ELSE                 WriteString('BLE  ') END 
                  END;  
                  Offset;  
             | 4: Case4;                            (*[X|0|4|X|X|X]*)
             | 7: error := TRUE;                    (*[X|0|7|X|X|X]*)
             END (* (*2*) CASE word1[3] OF *)  
        | 1:  WriteString('MOV') ;                  (*[X|1|X|X|X|X]*)
        | 2:  WriteString('CMP') ;                  (*[X|2|X|X|X|X]*)
        | 3:  WriteString('BIT') ;                  (*[X|3|X|X|X|X]*)
        | 4:  WriteString('BIC') ;                  (*[X|4|X|X|X|X]*)
        | 5:  WriteString('BIS') ;                  (*[X|5|X|X|X|X]*)
        ELSE (*6,7*)                                (*[X|6-7|X|X|X|X]*)
        END; (* CASE 1 *)  
        IF word1[2] > 0 THEN
          IF word1[2] < 6 THEN                      (*[X|1-5|X|X|X|X]*)
            IF word1[1] = 1 THEN WriteString('B ')  
            ELSE WriteBlanks(2) END;  
            Address(word1[3],word1[4]); Write(',');
            Address(word1[5],word1[6]);
          ELSIF word1[2] = 6 THEN                   (*[X|6|X|X|X|X]*)
            IF word1[1] = 0 THEN WriteString('ADD  ')  
            ELSE                 WriteString('SUB  ') END;  
            Address(word1[3],word1[4]); Write(',');
            Address(word1[5],word1[6]);
          ELSE (*word1[2] = 7*)
            IF word1[1] = 0 THEN                    (*[0|7|X|X|X|X]*)
              CASE word1[3] OF
                0:  WriteString('MUL  ');
              | 1:  WriteString('DIV  ');
              | 2:  WriteString('ASH  ');
              | 3:  WriteString('ASHC ');
              | 4:  WriteString('XOR  ');
              | 5:  IF word1[4] = 0 THEN            (*[0|7|5|0|X|X]*)
                      CASE word1[5] OF
                        0: WriteString('FADD ');
                      | 1: WriteString('FSUB ');
                      | 2: WriteString('FMUL ');
                      | 3: WriteString('FDIV ');
                      ELSE error := TRUE;
                      END;
                    ELSE error := TRUE;
                    END;
                    IF NOT error THEN
                      WriteString(',R'); WriteDigit(word1[6]);
                    END;
              | 6:  error := TRUE;
              | 7:  WriteString('SOB R');  
                    WriteDigit(word1[4]); Write(',');  
                    WriteOct(ic - 2*(word1[5]*8 + word1[6]),6);
              END;
              IF word1[3] <= 4 THEN
                Address(word1[5],word1[6]); WriteString(',R');
                WriteDigit(word1[4]);
              END;
            ELSE                                    (*[1|7|X|X|X|X]*)
              FPPInstruction;
            END;
          END;
        END;
      END Instruction;

    CONST decerror = ' Decode Param. Error';

    BEGIN (*Decode*)
      ic := 0;
      WriteString('DECODE -------- ');
      WriteString('INSTRUCTION'); WriteLn;
      IF ODD(relentry) OR ODD(maxbyte) OR (relentry > maxbyte) THEN
        ErrorMessage(decerror); WriteString(decerror);
      ELSE
        WHILE ic < relentry DO
          NextWord(FALSE); WriteLn;
        END;
        WHILE ic < maxbyte DO
          error := FALSE;
          ain := 0; aout := 0;
          NextWord(FALSE);
          IF NOT error THEN Instruction END;
          IF error THEN WriteString('illegal instruction') END;
          WriteLn;
        END
      END;
    END Decode;

  END Binary;

  MODULE CompilerOutput;
    IMPORT WriteStrings,InputOutput,NoDecode,Decode;
    EXPORT InitDirectiveNames,LinkDecoder;

    TYPE Linkerdirective =
          (SCModHeader,ImportElement,DataSize,FilledData,
           ProcCode,InitCode,SCModInitCode,ExcpCode,
           RefOwnData,RefExtData,RefOwnCode,
           RefOwnProcCall,RefExtProcCall,
           RefOwnProcAss,RefExtProcAss,
           RefOwnExcp,RefExtExcp,RefExtInitCall,
           SCModEnd,LinkCodeVersion);

    CONST modnamelength = 24;

    VAR dirname: ARRAY Linkerdirective,[0..19] OF CHAR;
 
    PROCEDURE GetWriteName;
      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 >= modnamelength DIV 2;
    END GetWriteName;

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

    PROCEDURE GetWriteKey;
    BEGIN WriteString(', key =');
      GetWriteOct; GetWriteOct; GetWriteOct;
    END GetWriteKey;

    PROCEDURE GetWriteModnum;
      VAR k: CARDINAL;
    BEGIN Read(k);
      WriteString(', modnum = ');
      WriteCard(k,0(*i.e. just significant digits*));
    END GetWriteModnum;

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

    PROCEDURE GetWriteProcnum;
      VAR k: CARDINAL;
    BEGIN Read(k);
      WriteString(', procnum = ');
      WriteCard(k,0(*i.e. just significant digits*));
    END GetWriteProcnum;

    PROCEDURE GetWriteEntry(VAR entrypoint: CARDINAL);
    BEGIN Read(entrypoint);
      WriteString(', entrypoint =');
      WriteOct(entrypoint,7);
    END GetWriteEntry;

    PROCEDURE GetWriteReference;
      VAR k: CARDINAL;
    BEGIN Read(k);
      WriteString(' at'); WriteOct(k,7);
    END GetWriteReference;

    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 InitDirectiveNames;
    BEGIN
      dirname[SCModHeader]    := 'scmod header';
      dirname[ImportElement]  := 'import';
      dirname[DataSize]       := 'data size';
      dirname[FilledData]     := 'filled data';
      dirname[ProcCode]       := 'proc code';
      dirname[InitCode]       := 'init code';
      dirname[SCModInitCode]  := 'scmod init code';
      dirname[ExcpCode]       := 'excp code';
      dirname[RefOwnData]     := 'ref own data';
      dirname[RefExtData]     := 'ref ext data';
      dirname[RefOwnCode]     := 'ref own code';
      dirname[RefOwnProcCall] := 'ref own proc call';
      dirname[RefExtProcCall] := 'ref ext proc call';
      dirname[RefOwnProcAss]  := 'ref own proc ass';
      dirname[RefExtProcAss]  := 'ref ext proc ass';
      dirname[RefOwnExcp]     := 'ref own excp';
      dirname[RefExtExcp]     := 'ref ext excp';
      dirname[RefExtInitCall] := 'ref ext init call';
      dirname[SCModEnd]       := 'scmod end';
      dirname[LinkCodeVersion] := 'link code version:';
    END InitDirectiveNames;

    PROCEDURE LinkDecoder;
      VAR dir: Linkerdirective;
          entrypoint,maxbyte,k,trapCode: CARDINAL;

    BEGIN
      Read(k);
      IF k <> CARDINAL(LinkCodeVersion) THEN
        WriteStrings.WriteString("---- wrong format");
        WriteStrings.WriteLn;
        WriteString("---- wrong format"); WriteLn;
      ELSE
        WriteString(dirname[LinkCodeVersion]);
        Read(k);
        Write(' '); WriteOct(k DIV 400B,3);
        Write(' '); WriteOct(k MOD 400B,3); WriteLn;
        GetWriteChecksum;
        IF k DIV 40000B = 3 THEN trapCode := 104000B; (*UNIX: EMT*)
                            ELSE trapCode := 104400B; (*else: TRAP*)
        END;
        REPEAT WriteLn;
          Read(k);
          IF k < ORD(LinkCodeVersion) THEN
            dir := VAL(Linkerdirective,k);
            WriteString(dirname[dir]);
            CASE dir OF
              SCModHeader:
                WriteString(': MODULE '); GetWriteName; GetWriteKey;
            | ImportElement:
                Write(' '); GetWriteName; GetWriteKey; GetWriteModnum;
            | DataSize:
                GetWriteLength(maxbyte);
            | FilledData:
                WriteString(', rel. start addr. =');
                GetWriteOct;
                GetWriteLength(maxbyte); WriteLn; NoDecode(0,maxbyte);
            | ProcCode,InitCode,SCModInitCode:
                GetWriteProcnum; GetWriteEntry(entrypoint);
                IF dir = SCModInitCode THEN
                  Read(k); GetWriteLength(maxbyte);
                  WriteLn; WriteBlanks(18);
                  WriteString('first real ');
                  WriteString('instruction at');
                  WriteOct(k,7);
                ELSE GetWriteLength(maxbyte);
                END;
                WriteLn; Decode(entrypoint,0,maxbyte,trapCode);
            | ExcpCode:
                (*empty; exceptions not yet implemented*)
            | RefOwnData,RefExtData,RefOwnCode,RefOwnProcCall,
              RefExtProcCall,RefOwnProcAss,RefExtProcAss,
              RefOwnExcp,RefExtExcp:
                GetWriteReference;
                IF dir >= RefOwnExcp THEN
                  (*empty; exceptions not yet implemented*)
                ELSIF dir >= RefOwnProcCall THEN
                  GetWriteProcnum
                END;
                IF (dir = RefExtData) OR (dir = RefExtProcCall) OR
                   (dir = RefExtProcAss) OR (dir = RefExtExcp) THEN
                  GetWriteModnum
                END;
            | RefExtInitCall:
                GetWriteReference;
            | SCModEnd:
                (*nothing to do*)
            END (*CASE*);
            IF (dir < FilledData) OR (dir > ExcpCode) THEN
              WriteLn
            END;
            GetWriteChecksum;
          ELSE
            WriteStrings.WriteString("---- wrong format");
            WriteStrings.WriteLn;
            WriteString("---- wrong format"); WriteLn;
            dir := SCModEnd;
          END;
        UNTIL dir = SCModEnd;
      END;
    END LinkDecoder;

  END CompilerOutput;


  VAR found: BOOLEAN;

BEGIN (*DecodeLinkFormat*)
  StartIO(found);
  IF found THEN
    InitTraps;
    InitDirectiveNames;
    LinkDecoder;
    EndIO;
  END;
END DecodeLinkFormat.