externalstring(31)fn in file name
   ! Unfortunately the input to this is a vax .OBJ file, not a .EXE
   ! Fortunately... we have a Vax emulator and can regenerate .OBJ files :-)
   result = "vaxtest"
end

routine readch(integername p)
   readsymbol(p)
end

begin
   externalstring(31)fnspec in file name
   owninteger records = 0
owninteger ca = 0
integer len, this line
integer stp = 0
integerarray stack(1:63)
owninteger stream = 0
routine newline
   owninteger left = 60
   left = left-1
   if left <= 0 start
      left = 60
      printsymbol(12)
   finish
   printsymbol(nl)
end
routine select(integer n)
   stream = n
   selectinput(n)
end
conststring(6)array opcode(0:255) =
"halt  ","nop   ","rei   ","bpt   ","ret   ","rsb   ","ldpctx","svpctx",
"cvtps ","cvtsp ","index ","crc   ","prober","probew","insque","remque",
"bsbb  ","brb   ","bneq  ","beql  ","bgtr  ","bleq  ","jsb   ","jmp   ",
"bgeq  ","blss  ","bgtru ","blequ ","bvc   ","bvs   ","bgequ ","blssu ",
"addp4 ","addp6 ","subp4 ","subp6 ","cvtpt ","mulp  ","cvttp ","divp  ",
"movc3 ","cmpc3 ","scanc ","spanc ","movc5 ","cmpc5 ","movtc ","movtuc",
"bsbw  ","brw   ","cvtwl ","cvtwb ","movp  ","comp3 ","cvtpl ","cmpp4 ",
"editpc","matchc","locc  ","skpc  ","movzwl","acbw  ","movaw ","pushaw",
"addf2 ","addf3 ","subf2 ","subf3 ","mulf2 ","mulf3 ","divf2 ","divf3 ",
"cvtfb ","cvtfw ","cvtfl ","cvtrfl","cvtbf ","      ","cvtlf ","acbf  ",
"movf  ","cmpf  ","mnegf ","tstf  ","emodf ","polyf ","cvtfd ","      ",
"adawi ","      ","      ","      ","      ","      ","      ","      ",
"addd2 ","addd3 ","subd2 ","subd3 ","muld2 ","muld3 ","divd2 ","divd3 ",
"cvtdb ","cvtdw ","cvtdl ","cvtrdl","cvtbd ","cvtwd ","cvtld ","acbd  ",
"movd  ","cmpd  ","mnegd ","tstd  ","emodd ","polyd ","cvtdf ","      ",
"ashl  ","ashq  ","emul  ","ediv  ","clrq  ","movq  ","movaq ","pushaq",
"addb2 ","addb3 ","subb2 ","subb3 ","mulb2 ","mulb3 ","devb2 ","divb3 ",
"bisb2 ","bisb3 ","bicb2 ","bicb3 ","xorb2 ","xorb3 ","mnegb ","caseb ",
"movb  ","cmpb  ","mcomb ","bitb  ","clrb  ","tstb  ","incb  ","decb  ",
"cvtbl ","cvtbw ","movzbl","movzbw","rotl  ","acbb  ","movab ","pushab",
"addw2 ","addw3 ","subw2 ","subw3 ","mulw2 ","mulw3 ","divw2 ","divw3 ",
"bisw2 ","bisw3 ","bicw2 ","bicw3 ","xorw2 ","xorw3 ","mnegw ","casew ",
"movw  ","cmpw  ","mcomw ","bitw  ","clrw  ","tstw  ","incw  ","decw  ",
"bispsw","bicpsw","popr  ","pushr ","chmk  ","chme  ","chms  ","chmu  ",
"addl2 ","addl3 ","subl2 ","subl3 ","mull2 ","mull3 ","divl2 ","divl3 ",
"bisl2 ","bisl3 ","bicl2 ","bicl3 ","xorl2 ","xorl3 ","mnegl ","casel ",
"movl  ","cmpl  ","mcoml ","bitl  ","clrl  ","tstl  ","incl  ","decl  ",
"adwc  ","sbwc  ","mtpr  ","mfpr  ","movpsl","pushl ","moval ","pushal",
"bbs   ","bbc   ","bbss  ","bbcs  ","bbsc  ","bbcc  ","bbssi ","bbcci ",
"blbs  ","blbc  ","ffs   ","ffc   ","cmpv  ","cmpzv ","extv  ","extzv ",
"insv  ","acbl  ","aoblss","aobleq","sobgeq","sobgtr","cvtlb ","cvtlw ",
"ashp  ","cvtlp ","callg ","calls ","xfc   ","      ","      ","      "
constbyteintegerarray oplimit(0:255) =
  0,  0,  0,  0,  0,  0,  0,  0,  4,  4,  6,  5,  3,  3,  2,  2,
  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
  4,  6,  4,  6,  5,  6,  5,  6,  3,  3,  4,  4,  5,  5,  6,  6,
  1,  1,  2,  2,  3,  3,  3,  4,  4,  4,  3,  3,  2,  4,  2,  1,
  2,  2,  2,  3,  2,  3,  2,  3,  2,  2,  2,  2,  2,  0,  2,  4,
  2,  2,  2,  1,  5,  3,  2,  0,  2,  0,  0,  0,  0,  0,  0,  0,
  2,  3,  2,  3,  2,  3,  2,  3,  2,  2,  2,  2,  2,  2,  2,  4,
  2,  2,  2,  1,  5,  3,  2,  0,  3,  3,  4,  4,  1,  2,  2,  1,
  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,
  2,  2,  2,  2,  1,  1,  1,  1,  2,  2,  2,  2,  3,  4,  2,  1,
  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,
  2,  2,  2,  2,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,
  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,  2,  3,
  2,  2,  2,  2,  1,  1,  1,  1,  2,  2,  2,  2,  1,  1,  2,  1,
  3,  3,  3,  3,  3,  3,  3,  3,  2,  2,  4,  4,  4,  4,  4,  4,
  4,  4,  3,  3,  2,  2,  2,  2,  6,  3,  2,  2,  0,  0,  0,  0
constshortintegerarray opkey(0:256*6-1) =
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 2, 1, 2, 1, 0, 0, 2, 1, 2, 1, 0, 0, 4, 4, 4, 4,
 4, 4, 1, 4, 2, 1, 4, 0, 1, 2, 1, 0, 0, 0, 1, 2,
 1, 0, 0, 0, 1, 4, 0, 0, 0, 0, 1, 4, 0, 0, 0, 0,
-1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0, 0, 0,
 0, 0,-1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0,
 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
-1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0, 0, 0,
 0, 0,-1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0,
 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,
 2, 1, 2, 1, 0, 0, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
 0, 0, 2, 1, 2, 1, 2, 1, 2, 1, 1, 2, 1, 0, 2, 1,
 2, 1, 2, 1, 2, 1, 1, 2, 1, 0, 2, 1, 2, 1, 2, 1,
 2, 1, 1, 0, 0, 0, 2, 1, 1, 0, 0, 0, 2, 1, 1, 1,
 0, 0, 2, 1, 1, 1, 0, 0, 2, 1, 1, 2, 1, 0, 2, 1,
 1, 2, 1, 0, 2, 1, 1, 1, 2, 1, 2, 1, 1, 1, 2, 1,
-2, 0, 0, 0, 0, 0,-2, 0, 0, 0, 0, 0, 2, 4, 0, 0,
 0, 0, 2, 1, 0, 0, 0, 0, 2, 1, 1, 0, 0, 0, 2, 1,
 1, 0, 0, 0, 2, 1, 4, 0, 0, 0, 2, 1, 2, 1, 0, 0,
 2, 1, 1, 1, 0, 0, 2, 1, 2, 1, 0, 0, 1, 2, 1, 0,
 0, 0, 1, 2, 1, 0, 0, 0, 2, 4, 0, 0, 0, 0, 2, 2,
 2,-2, 0, 0, 2, 4, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4,
 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 4, 0, 0, 0,
 4, 1, 0, 0, 0, 0, 4, 2, 0, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 0, 0, 0, 0, 1, 4, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 4,-2, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 0, 0, 0, 0, 0, 4, 1, 4, 4, 4, 0, 4, 2,
 1, 0, 0, 0, 4, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 8, 8, 0, 0, 0, 0, 8, 8, 8, 0, 0, 0, 8, 8, 0, 0,
 0, 0, 8, 8, 8, 0, 0, 0, 8, 8, 0, 0, 0, 0, 8, 8,
 8, 0, 0, 0, 8, 8, 0, 0, 0, 0, 8, 8, 8, 0, 0, 0,
 8, 1, 0, 0, 0, 0, 8, 2, 0, 0, 0, 0, 8, 4, 0, 0,
 0, 0, 8, 4, 0, 0, 0, 0, 1, 8, 0, 0, 0, 0, 2, 4,
 0, 0, 0, 0, 4, 8, 0, 0, 0, 0, 8, 8, 8,-2, 0, 0,
 8, 8, 0, 0, 0, 0, 8, 8, 0, 0, 0, 0, 8, 8, 0, 0,
 0, 0, 8, 0, 0, 0, 0, 0, 8, 1, 8, 4, 8, 0, 8, 2,
 1, 0, 0, 0, 8, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 1, 4, 4, 0, 0, 0, 1, 8, 8, 0, 0, 0, 4, 4, 4, 8,
 0, 0, 4, 8, 4, 4, 0, 0, 8, 0, 0, 0, 0, 0, 8, 8,
 0, 0, 0, 0, 8, 4, 0, 0, 0, 0, 8, 0, 0, 0, 0, 0,
 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0,
 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1,
 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0,
 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1,
 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0,
 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0,
 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
 1, 4, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 1, 4, 0, 0,
 0, 0, 1, 2, 0, 0, 0, 0, 1, 4, 4, 0, 0, 0, 1, 1,
 1,-2, 0, 0, 1, 4, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
 2, 2, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 2, 2, 0, 0,
 0, 0, 2, 2, 2, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 2,
 2, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0,
 2, 2, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 2, 2, 0, 0,
 0, 0, 2, 2, 2, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 2,
 2, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0,
 2, 2, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 2, 0, 0,
 0, 0, 2, 2, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0,
 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0,
 2, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0, 0, 0,
 0, 0, 2, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0,
 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4,
 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 4, 0, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4,
 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 4, 0, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 4, 0,
 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0,
 4, 4, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 4, 0, 0,
 0, 0, 4, 4, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 4, 0,
 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0,
 4, 1,-1, 0, 0, 0, 4, 1,-1, 0, 0, 0, 4, 1,-1, 0,
 0, 0, 4, 1,-1, 0, 0, 0, 4, 1,-1, 0, 0, 0, 4, 1,
-1, 0, 0, 0, 4, 1,-1, 0, 0, 0, 4, 1,-1, 0, 0, 0,
 4,-1, 0, 0, 0, 0, 4,-1, 0, 0, 0, 0, 4, 1, 1, 4,
 0, 0, 4, 1, 1, 4, 0, 0, 4, 1, 1, 4, 0, 0, 4, 1,
 1, 4, 0, 0, 4, 1, 1, 4, 0, 0, 4, 1, 1, 4, 0, 0,
 4, 4, 1, 1, 0, 0, 4, 4, 4,-2, 0, 0, 4, 4,-1, 0,
 0, 0, 4, 4,-1, 0, 0, 0, 4,-1, 0, 0, 0, 0, 4,-1,
 0, 0, 0, 0, 4, 1, 0, 0, 0, 0, 4, 2, 0, 0, 0, 0,
 1, 2, 1, 1, 2, 1, 4, 2, 1, 0, 0, 0, 1, 1, 0, 0,
 0, 0, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
!*t*
routine vaxcode(integer v)
   string(15) temp
   constinteger pc = 15
   ownstring(3) prefix
   ownstring(72) operand, current
   owninteger state=0
   integer mode, reg
   owninteger extra, hexlen, p, key, limit
   switch st(0:3), ops(0:15)
   conststring(3)array sreg(0:15) = "R0", "R1", "R2", "R3",
                                      "R4", "R5", "R6", "R7",
                                      "R8", "R9", "R10","GLA",
                                      "AP", "FP", "SP", "PC"

string(2)fn hex(integer x)
   conststring(1)array xsym(0:15) = "0","1","2","3","4","5","6","7",
                                      "8","9","A","B","C","D","E","F"
   result = xsym(x>>4&15).xsym(x&15)
end

routine addr(integer n)
   printstring(hex(n>>16))
   printstring(hex(n>>8))
   printstring(hex(n))
end

routine hex byte(integer n)
   printstring(hex(nl))
   hexlen = hexlen+2
end

routine dump line
   spaces(20-hexlen)
   hexlen = 0
   printstring(current);  current = ""
   newline
end

v = v&255
ca = ca+1
->st(state)

st(0): spaces(5);  addr(ca-1);  space
       hexlen = 0
       current = opcode(v);  operand = "";  prefix = ""
       p = v*6
       key = 0
       limit = oplimit(v)
       hex byte(v)
       if v = 16_fc start
          current = ".entry"
	  operand = "FC"
	  state = 2
	  extra = 0
	  return
      finish
      ->complete if limit = 0
      state = 1
      key = 1
      ->DONE

st(1):hex byte(v)
      if opkey(p) < 0 start
         state = 2
         extra = -opkey(p);  ->st2
      finish
      mode = v>>4&15
      reg = v&15
      extra = 0
      ->ops(mode)
ops(0):ops(1):ops(2):ops(3):
      operand = "S^".hex(v).operand;  ->complete
ops(4):operand = "[".sreg(reg)."]".operand;  ->DONE
ops(5):operand = sreg(reg).operand;  ->complete
ops(8):
ops(9):
ops(6):
ops(7):prefix = ""
      if reg = pc and mode >= 8 start
         prefix = "I^"
         temp = ""
         extra = opkey(p)
         temp = "" and extra = 4 if mode = 9
      else
         temp = "(".sreg(reg).")"
         temp = temp."+" if mode >= 8
         temp = "-".temp if mode = 7
         temp = "@".temp if mode = 9
      finish
      operand = temp.operand
      ->complete if extra = 0
      state = 2;  ->DONE

ops(10):ops(11):
      prefix = "B^";  extra = 1;  ->rest
ops(12):ops(13):
      prefix = "W^";  extra = 2;  ->rest
ops(14):ops(15):
      prefix = "L^";  extra = 4
rest: prefix = "@".prefix if mode&1 # 0
      if reg # pc start
         operand = "(".sreg(reg).")".operand
      finish
      state = 2
      ->DONE

st(2):hex byte(v)
st2:  operand = hex(v).operand
      extra = extra-1
      ->DONE if extra > 0
      operand = prefix.operand

complete:

      if length(current)+length(operand) > 40 start
         dump line
	 hex len = -6
	 spaces(12)
      finish
      current = current." ".operand
      operand = ""
      if key = limit start
         dump line
         state = 0
         ->DONE
      finish
      key = key+1
      p = p+1
      current = current.","
      state = 1
DONE: end

routine skip(integer n)
   n = n!1
   cycle
      skipsymbol
      n = n-1
      return if n <= 0
   repeat
end

routine get(integername n)
   integer j
   readch(n); readch(j)
   n = n+j<<8
end
routinespec find line

routine get tir
   integer t
   cycle
      records = records+1
      get(len)
      readch(t);  len = len-1
      if t = 3 start
         this line = 50000
	 find line
      finish
      return if t = 2
      skip(len)
   repeat
end
routine find line
   integer s
   owninteger here = 0
   return if this line <= here
   select(1)
   cycle
      here = here+1
      write(here, -4);  space
      cycle
         readsymbol(s)
	 exit if s = nl
	 printsymbol(s)
      repeat
      newline
   repeat until here >= this line
   select(2)
end
routine process tir
   integer com, d, p, extra
   extra = len&1
   ->skip if len <= 0
   readch(com);  len = len-1
   ->cc if com&16_80 # 0 and ca >= 0
   ->skip if com # 5
   readch(p);  get(d)
   skipsymbol
   len = len-4
   ca = -1
   if p = 3 start
      readch(p);  get(d)
      len = len-3
      ->skip if p # (-4)&255
      get(this line)
      len = len-2
      ->skip
   finish
   ->skip unless p = 0
   ca = d
   while len > 0 cycle
      readch(com);  len = len-1
      exit if com&16_80 = 0
cc:   com = com!16_ffffff00
      cycle
         readch(p);  len = len-1
	 vaxcode(p)
	 com = com+1
      repeat until com = 0
   repeat
skip:
   while len > 0 cycle
      skipsymbol;  len = len-1
   repeat
   skipsymbol if extra = 0
end

on 9 start
   newline
   if stream # 1 start
      printstring("*object file currupt*");  newline
      monitor;  stop
   finish
   printstring("**end**");  newline
   stop
finish
open input(2, in file name.".obj")
select(2)
select output(1)
cycle
   get tir
   find line
   process tir
repeat

endofprogram