!
! nb: GLOBAL declared inside routine for AMDAHL IMP compiler
!
{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)
      %FINISHELSEIF N=1 %START
         Key = FPsingle(Op>>6&3)
      %FINISHELSESTART
         Key = FPsets(Op&15)
      %FINISH; ->OK
Spec(7):Key = Old Fp(Op>>3&7); ->OK
Spec(8):%IF Op<=6 %START
         Key = HALTs(Op)
      %FINISHELSEIF Op&8_400=8_400 %START
         Key = Br
      %FINISHELSEIF Op&8_700=8_300 %START
         Key = Swab
      %FINISHELSEIF Op=8_240 %START
         Key = Nop
      %FINISHELSEIF Op&8_700=8_100 %START
         Key = Jmp
      %FINISHELSEIF Op&8_770=8_200 %START
         Key = Rts
      %FINISHELSEIF Op&8_770=8_230 %START
         Key = Spl
      %FINISHELSEIF Op&8_177740=8_000240 %START
         Key = -1
      %FINISHELSESTART
         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
   %FINISHELSESTART
      V = V!(-1)<<16 %IF V&x'8000'#0
      P = P+1; Val(P) = V; Rel(P) = R
      State = State-1
   %FINISH
   %RETURNIF 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)
         %FINISHELSESTART
            Print Octal(V,0)
            Print Reloc(R)
            Printsymbol('(')
            Printstring(RegId(B))
            Printsymbol(')')
         %FINISH
      %FINISHELSEIF M<=1 %START
         Printsymbol('(') %IF M#0
         Printstring(RegId(B))
         Printsymbol(')') %IF M#0
      %FINISHELSEIF 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
         %FINISHELSE print octal(v,0)
         Print Reloc(R)
      %FINISHELSESTART
         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") %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
   %FINISHELSESTART
      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)
      %EXTERNALINTEGERFUNCTIONSPEC exist %ALIAS "S#EXIST"(%STRING (255) file)

      %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. %C
               " does not exist or no access")
            newline
            sfile = ""; ofile = ""; lfile = ""; %RETURN
         %FINISHELSE 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 %ALIAS "S#PROMPT"(%STRING (255) s)
   %ROUTINE define(%STRING (255) s)
      %EXTERNALROUTINESPEC emas3(%STRINGNAME command,params, %INTEGERNAME flag)
      %INTEGER flag
      emas3("DEFINE",s,flag)
   %END;                                 ! Of %ROUTINE define.
   %INTEGER Code Base,Gla Base,Constant Base
   %OWNINTEGER Type=0, Chain, Module, glob
   %CONSTINTEGER maxglobals=40
   %ownstring (36) %name GLOBAL
   %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
      %RETURNIF 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
         %REPEATUNTIL S=NL
      %REPEATUNTIL 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
      %FINISHELSESTART
         Printstring("External definitions:"); Newline
         %FOR J = 1,1,N %CYCLE
            Readch(Code)
            %IF Code=5 %START {code reloc}
               Printstring("Code+")
            %FINISHELSEIF Code=6 %START {Gla reloc}
               Printstring(" Gla+")
            %FINISHELSESTART
               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
      %FINISHELSESTART
         Printstring("External references:"); Newline
         %FOR J = 1,1,N %CYCLE
            Write(J,3); Space
            %IF j<Maxglobals %THEN Externals(j) = Qstring %ELSE %C
               Externals(Maxglobals) = Qstring
            Newline
         %REPEAT
      %FINISH
      Newline
   %END

   global == string(0)
   fspec(file,source,object,listing)
   %STOPIF 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 alist11(%STRING (63) file)

   alisting = 1
   code11(file)

%END
%ENDOFFILE