!
! 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