{Decode routine for PDP11}

%constinteger  Absf =   1,   Adc =   2,  Adcb =   3,   Add =   4,
               Addf =   5,   Ash =   6,  Ashc =   7,   Asl =   8,
               Aslb =   9,   Asr =  10,  Asrb =  11,   Beq =  12,
                Bge =  13,   Bgt =  14,   Bhi =  15,  Bhis =  16,
                Bic =  17,  Bicb =  18,   Bis =  19,  Bisb =  20,
                Bit =  21,  Bitb =  22,   Ble =  23,   Blo =  24,
               Blos =  25,   Blt =  26,   Bmi =  27,   Bne =  28,
                Bpl =  29,   Bpt =  30,    Br =  31,   Bvc =  32,
                Bvs =  33,  Cfcc =  34,   Clr =  35,  Clrb =  36
%constinteger  Clrf =  37,   Cmp =  38,  Cmpb =  39,  Cmpf =  40,
                Com =  41,  Comb =  42,   Dec =  43,  Decb =  44,
                Div =  45,  Divf =  46,   Emt =  47,  Fadd =  48,
               Fdiv =  49,  Fmul =  50,  Fsub =  51,  Halt =  52,
                Inc =  53,  Incb =  54,   Iot =  55,   Jmp =  56,
                Jsr =  57, Ldcfd =  58, Ldcif =  59, Ldexp =  60,
                Ldf =  61, Ldfps =  62,  Mark =  63,  Mfpd =  64,
               Mfpi =  65,  Modf =  66,   Mov =  67,  Movb =  68,
               Mtpd =  69,  Mtpi =  70,   Mul =  71,  Mulf =  72
%constinteger   Neg =  73,  Negb =  74,  Negf =  75,   Nop =  76,
              Reset =  77,   Rol =  78,  Rolb =  79,   Ror =  80,
               Rorb =  81,   Rti =  82,   Rts =  83,   Rtt =  84,
                Sbc =  85,  Sbcb =  86,  Setd =  87,  Setf =  88,
               Seti =  89,  Setl =  90,   Sob =  91,   Spl =  92,
              Stcfd =  93, Stcfi =  94, Stexp =  95,   Stf =  96,
              Stfps =  97,  Stst =  98,   Sub =  99,  Subf = 100,
               Swab = 101,   Sxt = 102,  Trap = 103,   Tst = 104,
               Tstb = 105,  Tstf = 106,  Wait = 107,   Xor = 108

%conststring(5)%array OpText(1:108) =
  "Absf ",  "Adc  ",  "Adcb ",  "Add  ",
  "Addf ",  "Ash  ",  "Ashc ",  "Asl  ",
  "Aslb ",  "Asr  ",  "Asrb ",  "Beq  ",
  "Bge  ",  "Bgt  ",  "Bhi  ",  "Bhis ",
  "Bic  ",  "Bicb ",  "Bis  ",  "Bisb ",
  "Bit  ",  "Bitb ",  "Ble  ",  "Blo  ",
  "Blos ",  "Blt  ",  "Bmi  ",  "Bne  ",
  "Bpl  ",  "Bpt  ",  "Br   ",  "Bvc  ",
  "Bvs  ",  "Cfcc ",  "Clr  ",  "Clrb ",
  "Clrf ",  "Cmp  ",  "Cmpb ",  "Cmpf ",
  "Com  ",  "Comb ",  "Dec  ",  "Decb ",
  "Div  ",  "Divf ",  "Emt  ",  "Fadd ",
  "Fdiv ",  "Fmul ",  "Fsub ",  "Halt ",
  "Inc  ",  "Incb ",  "Iot  ",  "Jmp  ",
  "Jsr  ",  "Ldcfd",  "Ldcif",  "Ldexp",
  "Ldf  ",  "Ldfps",  "Mark ",  "Mfpd ",
  "Mfpi ",  "Modf ",  "Mov  ",  "Movb ",
  "Mtpd ",  "Mtpi ",  "Mul  ",  "Mulf ",
  "Neg  ",  "Negb ",  "Negf ",  "Nop  ",
  "Reset",  "Rol  ",  "Rolb ",  "Ror  ",
  "Rorb ",  "Rti  ",  "Rts  ",  "Rtt  ",
  "Sbc  ",  "Sbcb ",  "Setd ",  "Setf ",
  "Seti ",  "Setl ",  "Sob  ",  "Spl  ",
  "Stcfd",  "Stcfi",  "Stexp",  "Stf  ",
  "Stfps",  "Stst ",  "Sub  ",  "Subf ",
  "Swab ",  "Sxt  ",  "Trap ",  "Tst  ",
  "Tstb ",  "Tstf ",  "Wait ",  "Xor  "

%constbytearray OpType(-1:108) =   0, 0,
        1,        1,        1,        2,
        3,        3,        3,        1,
        1,        1,        1,        5,
        5,        5,        5,        5,
        2,        2,        2,        2,
        2,        2,        5,        5,
        5,        5,        5,        5,
        5,        0,        5,        5,
        5,        0,        1,        1,
        1,        2,        2,        3,
        1,        1,        1,        1,
        3,        3,        9,        4,
        4,        4,        4,        0,
        1,        1,        0,        1,
        3,        3,        3,        3,
        3,        1,        7,        1,
        1,        1,        2,        2,
        1,        1,        3,        3,
        1,        1,        1,        0,
        0,        1,        1,        1,
        1,        0,        4,        0,
        1,        1,        0,        0,
        0,        0,        1,        6,
        3,        3,        3,        3,
        1,        1,        2,        3,
        1,        1,        9,        1,
        1,        1,        0,        3

%Constintegerarray Special(0:127) =
 2155, 2588, 3098, 3607,   57,  360,  870,  870,
   67,   67,   67,   67,   67,   67,   67,   67,
   38,   38,   38,   38,   38,   38,   38,   38,
   21,   21,   21,   21,   21,   21,   21,   21,
   17,   17,   17,   17,   17,   17,   17,   17,
   19,   19,   19,   19,   19,   19,   19,   19,
    4,    4,    4,    4,    4,    4,    4,    4,
   71,   45,    6,    7,  108, 1843, 1843,   91,
 4125, 4633, 5153, 5656, 6247,  617, 1105, 1105,
   68,   68,   68,   68,   68,   68,   68,   68,
   39,   39,   39,   39,   39,   39,   39,   39,
   22,   22,   22,   22,   22,   22,   22,   22,
   18,   18,   18,   18,   18,   18,   18,   18,
   20,   20,   20,   20,   20,   20,   20,   20,
   99,   99,   99,   99,   99,   99,   99,   99,
 1642, 1608, 1597, 1636, 1632, 1631, 1629, 1595


%conststring(3)%array RegId(0:7) =   "R0", "R1", "R2", "R3",
                                    "LNB", "DS", "SP", "PC"

%constbytearray CLR group(0:7) =  Clr,  Com,  Inc,  Dec,  Neg,  Adc,  Sbc, Tst
%constbytearray CLRBgroup(0:7) = Clrb, Comb, Incb, Decb, Negb, Adcb, Sbcb, Tstb
%constbytearray ROR group(0:7) =  Ror,  Rol,  Asr,  Asl, Mark, Mfpi, Mtpi, Sxt
%constbytearray RORBgroup(0:7) = Rorb, Rolb, Asrb, Aslb,    0, Mfpd, Mtpd, 0
%constbytearray Old Fp   (0:7) = Fadd, Fsub, Fsub, Fdiv,    0,    0,    0, 0
%constbytearray Fp Single(0:3) = Clrf, Tstf, Absf, Negf
%constbytearray Floating(0:15) =    0,    0, Mulf, Modf, Addf,  Ldf, Subf, Cmpf,
                                  Stf, Divf,Stexp,Stcfi,Stcfd,Ldexp,Ldcif,Ldcfd
%constbytearray Fp Sets (0:15) = Cfcc, Setf, Seti, 0(6), Setd, Setl, 0(*)
%constbytearray Halts   (0:6)  = Halt, Wait,  Rti,  Bpt,  Iot, Reset, Rtt
%constbytearray Pair(10:25)    = Bne, Beq,   Bge, Blt,  Bgt, Ble,
                                 Bpl, Bmi,   Bhi, Blos, Bvc, Bvs,
                                 Bhis,Blo,   Emt, Trap
%owninteger alisting = 0


%ownstring(36)%name global
%externalroutine Print Octal(%integer N, P)
   %integer J, K
   %for J = 15,-3,0 %cycle
      K = N>>J&7
      %if K # 0 %or P # 0 %or J = 0 %start
         Printsymbol(K+'0')
         P = 1
      %finish
   %repeat
%end
%integerfn More(%integer MB)
   %integer Base, Mode
   Base = MB&7
   Mode = MB>>3
   %result=-1 %if Mode >= 6 %or (Base = 7 %and Mode!1 = 3)
   %result=0
%end
%externalroutine Decode11(%integer C, V, R, Sp)
   %owninteger State = 0, Expected = -1
   %owninteger Ca, P = 0, Op, T, Key, Extra, Marker = ' '
   %integer N
   %ownintegerarray Val(1:2) = 0(*)
   %ownintegerarray Rel(1:2) = 0(*)
   %switch Oper(0:9),
           Spec(0:8)

   %routine Space out
      Spaces(Sp)
      Printsymbol(Marker);  Marker = ' '
   %end
   %routine Expend(%integer N)
      Space out
      Print Octal(Expected, 1);  Expected = Expected+2
      Printstring(": ")
      Print Octal(N, 1);  Newline
   %end

   %if C # Expected %start
      Expected = Expected-2*P
      Expected = Expected-2 %and Expend(Op) %if State # 0
      Expend(Val(1)) %if P # 0
      Expend(Val(2)) %if P = 2
      Expected = C
      State = 0
      Marker = '='
   %finish
   Expected = Expected+2
   %if State = 0 %start
      Op = V&x'FFFF';  Ca = C
      P = 0
      Key = Special(Op>>9)
      N = Key>>8
      Key = Key&255
      ->Spec(N) %if N < 10
      N = N+1 %if Op&8_400 # 0
      Key = Pair(N);                    ->OK

Spec(1): Key = CLRgroup(Op>>6&7);       ->OK
Spec(2): Key = CLRBgroup(Op>>6&7);      ->OK
Spec(3): Key = RORgroup(Op>>6&7);       ->OK
Spec(4): Key = RORBgroup(Op>>6&7);      ->OK
Spec(6): N = Op>>8&15
         %if N > 1 %start
            Key = Floating(N)
         %finish %else %if N = 1 %start
            Key = FPsingle(Op>>6&3)
         %finish %else %start
            Key = FPsets(Op&15)
         %finish;                       ->OK
Spec(7): Key = Old Fp(Op>>3&7);         ->OK
Spec(8): %if Op <= 6 %start
            Key = HALTs(Op)
         %finish %else %if Op&8_400 = 8_400 %start
            Key = Br
         %finish %else %if Op&8_700 = 8_300 %start
            Key = Swab
         %finish %else %if Op = 8_240 %start
            Key = Nop
         %finish %else %if Op&8_700 = 8_100 %start
            Key = Jmp
         %finish %else %if Op&8_770 = 8_200 %start
            Key = Rts
         %finish %else %if Op&8_770 = 8_230 %start
            Key = Spl
         %finish %else %if Op&8_177740 = 8_000240 %start
            Key = -1
         %finish %else %start
            Key = 0
         %finish
OK:
Spec(0): T = OpType(Key)
         Extra = 0
         %if 1 <= T <= 3 %start
            Extra = Extra+1 %if More(Op&8_77)#0
            Extra = Extra+1 %if T = 2 %and More(Op>>6&8_77)#0
            State = Extra
         %finish
   %finish %else %start
      V = V!(-1)<<16 %if V&x'8000' # 0
      P = P+1;  Val(P) = V;  Rel(P) = R
      State = State-1
   %finish
   %return %if State # 0

   %routine Print Reloc(%integer R)
      %if R > 0 %start
         Printstring("-Pc") %if R&1 # 0
         R = R>>1
         %if R # 0 %start
            Printsymbol('+')
            Write(R, 0)
         %finish
      %finish
   %end
   %routine Print Oper(%integer MB)
      %integer M, B, V, R
      M = MB>>3
      B = MB&7
      %if M >= 6 %start
         P = P+1;  V = Val(P);  R = Rel(P)
         Ca = Ca+2
         Printsymbol('@') %if M = 7
         %if B = 7 %start
            Printsymbol('=')
            Print Octal(V+Ca, 0)
         %finish %else %start
            Print Octal(V, 0)
            Print Reloc(R)
            Printsymbol('(')
            Printstring(RegId(B))
            Printsymbol(')')
         %finish
      %finish %else %if M <= 1 %start
         Printsymbol('(') %if M # 0
         Printstring(RegId(B))
         Printsymbol(')') %if M # 0
      %finish %else %if B = 7 %and M!1 = 3 %start
         Printsymbol('@') %if M&1 # 0
         Printsymbol('#')
         P = P+1;  V = Val(P);  R = Rel(P)
         Ca = Ca+2
         %if V < 0 %start
            V = -V
            Printsymbol('-')
         %finish
        %if addr(global) # 0 %start
          printstring(global)
          %if v # 0 %start
           printstring(" + ")
            print octal(v, 0)
          %finish
        %finish %else print octal(v,0)
         Print Reloc(R)
      %finish %else %start
         Printsymbol('@') %if M&1 # 0
         Printsymbol('-') %if M!1 = 5
         Printsymbol('(')
         Printstring(RegId(B))
         Printsymbol(')')
         Printsymbol('+') %if M!1 = 3
      %finish
   %end
   %routine Print Jump(%integer D)
      D = D!(-1)<<8 %if D&128 # 0
      Print Octal(D*2+Ca, 0)
   %end

   Space out
   Print Octal(Ca, 1);  Printstring(": ")
   Print Octal(Op, 1)
   ->Done %if Key = 0     {illegal instruction}
   Space
   %if Extra # 0 %then Print Octal(Val(1), 1) %else Spaces(6)
   Space
   %if Extra = 2 %then Print Octal(Val(2), 1) %else Spaces(6)
   Space
   %if Key < 0 %start
      %if Op&8_20 = 0 %then Printstring("Clear") %c
                      %else Printstring("Set")
      Printstring(" N") %if Op&8 # 0
      Printstring(" Z") %if Op&4 # 0
      Printstring(" V") %if Op&2 # 0
      Printstring(" C") %if Op&1 # 0
   %finish %else %start
      Printstring(OpText(Key));  Ca = Ca+2
      Space %unless T = 0
   %finish
   P = 0
   ->Oper(T)

Oper(2): Print Oper(Op>>6&8_77)
         Printstring(", ")
Oper(1): Print Oper(Op&8_77);           ->Done
Oper(3): Op = Op&8_377 %if Op&8_170000 = 8_170000
         Printstring(RegId(Op>>6&7))
         Printstring(", ")
         Print Oper(Op&8_77);                        ->Done
Oper(4): Printstring(RegId(Op&7));                   ->Done
Oper(5): Print Jump(Op&255);                         ->Done
Oper(6): Write(Op&7, 1);                             ->Done
Oper(7): Write(Op&8_77, 1);                          ->Done
Oper(8): Print Jump(-(Op&8_77));                     ->Done
Oper(9): Write(Op&255, 1)
Oper(0):
Done:    Newline
         P = 0
%end

%externalroutine Code11(%string(63) File)
%routine fspec(%string(255) s,%string(33)%name sfile,ofile,lfile)
%externalintegerfnspec exist(%string(31) f)

%string(7) fu
%string(15) pd
%string(255) f1,f2,f3
%string(15) ext
%string(15) fn
%conststring(4) dfext="#imp"
  %if s->f1.(",").f2.("/").f3 %then s=f1.",".f2.",".f3

  %if s->f1.("/").f2 %then s=f1.",,".f2
  s=s.","
  s->f1.(",").f2
  %if f2#"" %then f2->f2.(",").f3 %else f3=""
  %if f1->fu.(".").f1 %then fu=fu."." %else fu=""
  %if f1->pd.("_").f1 %then pd=pd."_" %else pd=""
  %if f1->f1.("#").ext %then ext="#".ext %else ext=""

  %if exist(fu.pd.f1.ext)=0 %start
    %if ext="" %and exist(fu.pd.f1.dfext)=0 %start
      printstring("Source file ".fu.pd.f1.ext." does not exist or no access"); newline
     sfile="";ofile="";lfile=""; %return
    %finish%else ext=dfext
  %finish

  %if f2="" %start
  %if exist(f1."#rel")#0 %then f2=f1."#rel" %else f2=fu.pd.f1."#rel"
  %finish

  %if exist(f2)=0 %start
    printstring("Object file ".f2." does not exist or no access")
    newline
    sfile=""; ofile=""; lfile=""; %return
  %finish

  %if f3="" %then f3=f1."#LST"
  sfile=fu.pd.f1.ext
  ofile=f2
  lfile=f3
  %end
   %routine Print Octal(%integer N, P)
      N = N&x'FFFF'
      printsymbol(N>>P&7+'0') %for P = 15,-3,0
   %end
   %externalroutinespec Prompt(%string(63) S)
   %externalroutinespec Define(%string(63) S)
   %integer Code Base, Gla Base, Constant Base
   %owninteger Type=0, Chain, Module, glob
   %constinteger maxglobals=40
   %ownstring(36)%array externals(1:maxglobals)
   %string(63) Listing, Object, Source
   %owninteger Ca = 0, Start = 0
   %switch T(0:15)
   %integer Sym, N, Line
   %routine Get Source Line(%integer L)
      %integer S
      %owninteger Here = 0
      %return %if Here >= L
      Select Input(1)
      %cycle
         Here = Here+1
         %if Start <= Line %start
            Write(Here, 4);  Space
           %if alisting # 0 %then print octal(ca,7) %and spaces(5)
         %finish
         %cycle
            Readsymbol(S)
            Printsymbol(S) %if Start <= Line
         %repeat %until S = NL
      %repeat %until Here = L
      Select Input(2)
   %end
   %integerfn Two Bytes
      %integer B1, B2
      Readch(B1);  Readch(B2)
      %result = B2<<8+B1
   %end

   %string(36)%fn Qstring
      %string(36) P
      %integer L, S
      P=""
      Readch(L)
      %while L > 0 %cycle
         Readch(S)
         Printsymbol(S)
         P = P.Tostring(S)
        L = L - 1
      %repeat
      %result = P
   %end

  %routine Pstring
    %string(36) s

    s = Qstring

  %end
   %routine Dump Definitions
      %integer N, J, Code
      N = Two Bytes
      %if N = 0 %start
         Printstring("No external definitions")
         Newline
      %finish %else %start
         Printstring("External definitions:");  Newline
         %for J = 1,1,N %cycle
            Readch(Code)
            %if Code = 5 %start {code reloc}
               Printstring("Code+")
            %finish %else %if Code = 6 %start {Gla reloc}
               Printstring(" Gla+")
            %finish %else %start
               Printstring("   ?+")
            %finish
            Print Octal(Two Bytes, 0)
            Space
            Pstring
            Newline
         %repeat
      %finish
      Newline
   %end
   %routine Dump References
      %integer N, J
      N = Two Bytes
      %if N = 0 %start
         Printstring("No external references")
         Newline
      %finish %else %start
         Printstring("External references:");  Newline
         %for J = 1, 1, N %cycle
            Write(J, 3);  Space
            %if j < Maxglobals %then Externals(j) = Qstring     %c
                               %else Externals(Maxglobals) = Qstring
            Newline
         %repeat
      %finish
      Newline
   %end

  global==string(0)
  fspec(file,source,object,listing)
  %stop %if source=""
   Define("ST1,".source)
   Define("ST2,".Object)
   Define("ST30,".Listing);  Select output(30)
   Select Input(0)
  Start=1
   Select Input(2)
   Module = 0
Go:Chain = Two Bytes
   Code Base = 0
   Gla Base = 0
   Constant Base = 0
   %if Chain # 0 %start
      Module = Module+1
      Printstring("Module #");  Write(Module, 0)
      Newline
   %finish

   Printstring("Code Size: ");  Write(Two Bytes, 1);  Printstring(" bytes")
   Newline
   Printstring(" Gla Size: ");  Write(Two Bytes, 1);  Printstring(" bytes")
   Newline
   Printstring("Diag Size: ");  Write(Two Bytes, 1);  Printstring(" bytes")
   Newline
   Printstring("Line Size: ");  Write(Two Bytes, 1);  Printstring(" bytes")
   Newline
   Printstring("Event Size:");  Write(Two Bytes, 1);  Printstring(" bytes")
   Newline
   Printstring("Section: ");  Pstring;  Newline

   Dump Definitions
   Dump References

   %cycle
      Readch(Sym)
         ->T(Sym) %if 1 <= Sym <= 15
         Printstring("Corrupt object file");  Write(Sym, 1);  Newline
         %stop

T(1):    Type = 0;    Ca = Two Bytes;  %continue
T(2):    Type = 'G';  Ca = Two Bytes;  %continue
T(3):    Type = 'D';  Ca = Two Bytes;  %continue
T(4):    Type = 'L';  Ca = Two Bytes;  %continue
T(5):    %continue
T(6):    %continue
T(7):    %continue
T(8):    %continue
T(9):    N = Two Bytes;
        Global == Externals(N) %if N<Maxglobals
        %continue
T(10):   %continue
T(11):   Readch(N);  Ca = Ca+1;  %continue
T(12):   N = Two Bytes
         Decode11(Ca, N, 0, 8) %if Start <= Line %and Type = 0 %and alisting=0
         global == string(0)
         Ca = Ca+2;  %continue
T(13):   Line = Two Bytes
         Get Source Line(Line)
         %continue
T(14):   Printstring("Event: ")
         Printstring("Mask:");    Print Octal(Two Bytes, 1)
         Printstring("  Ep:");    Print Octal(Two Bytes, 1)
         Printstring("  Low:");   Print Octal(Two Bytes, 1)
         Printstring("  High:");  Print Octal(Two Bytes, 1)
         Newline
   %repeat
T(15):
   %if Chain # 0 %start
      Printstring("End of Module");  Newline
      NEWPAGE
      ->Go
   %finish
   Printstring("End of file")
   Newline
%end

%externalroutine dalist11(%string(63) file)

  alisting=1
  code11(file)

%end
%endoffile