%include "inc:util.imp"
%option "-nodiag"
%begin; ! 8086 object file decoder

! Directives
%constinteger setcode=1,setgla=2,setloc=3,append=4,patch=5
%constinteger def=6,segref=7,extref=8,eom=9,eof=10

%owninteger cloc=0,gloc=0,mode=setcode
%integername loc
%integer sym

%switch s(setcode:eof)

%integerfn w
%integer l,h
  readsymbol(l); readsymbol(h); %result=h<<8+l
%end

%routine name
%integer n,sym
  readsymbol(n)
  %while n>0 %cycle
    n=n-1; readsymbol(sym); printsymbol(sym)
  %repeat
  newline
%end

%routine dhex(%integer n)
  n=n&15; n=n+7 %if n>9; printsymbol(n+'0')
%end

%routine bhex(%integer n)
  dhex(n>>4); dhex(n)
%end

%routine phex(%integer n)
  bhex(n>>8); bhex(n)
%end

%routine showloc
  %if mode=setcode %then printsymbol('C') %else printsymbol('D')
  phex(loc)
%end

%routine gla(%integer n)
%integer s,pos
  %cycle
    showloc; space; pos=0
    %while pos<16 %cycle
      pos=pos+1; %exitif n=0; n=n-1
      space; readsymbol(s); bhex(s); gloc=gloc+1
    %repeat
    newline
  %repeatuntil n=0
%end

%routine code(%integer size)
%integer op,ab,x
%integer pos
%string(31)s

  %routine p(%string(31)a)
    s=s.a
  %end

  %routine wr(%integer n)
  %integer d
    d=rem(n,10); n=n//10
    %if d!n<0 %start
      d=-d; n=-n; p("-")
    %finish
    wr(n) %if n>0
    p(tostring(d+'0'))
  %end

%integerfn next
%integer x
  %if size=0 %start
    printstring("**"); pos=pos+2; %result=0
  %finish
  size=size-1; cloc=cloc+1
  readsymbol(x); bhex(x); pos=pos+2; %result=x
%end

%integerfn long(%integer x)
  x=x!(-1!!16_ffff) %if x&16_8000#0
  %result=x
%end

%integerfn adisp(%integer word)
%integer d
  d=next; d=next<<8+d %if word#0
  d=d!16_ff00 %if word=0 %and d&128#0
  %result=long(d)
%end

%routine ph(%integer x)
%integer i,d
  %for i=12,-4,0 %cycle
    d=x>>i&15; d=d+7 %if d>9
    p(tostring(d+'0'))
  %repeat
%end

%switch sw(0:26)
%conststring(2)%array segr(0:3)="ES","CS","SS","DS"
%conststring(2)%array wreg(0:7)="AX","CX","DX","BX","SP","BP","SI","DI"
%conststring(2)%array br(0:7)="AL","CL","DL","BL","AH","CH","DH","BH"
%conststring(7)%array rm(0:8)="(BX+SI)","(BX+DI)","(BP+SI)","(BP+DI)",
                              "(SI)","(DI)","(BP)","(BX)","(0)"
%conststring(6)%array mnem(0:255)=
"Add"(6),"Push","Pop","Or"(6),"Push","Pop",
"Adc"(6),"Push","Pop","Sbb"(6),"Push","Pop",
"And"(6),"Use","Daa","Sub"(6),"Use","Das",
"Xor"(6),"Use","Aaa","Cmp"(6),"Use","Aas",
"Inc"(8),"Dec"(8),
"Push"(8),"Pop"(8),
"?"(15),"Jnp",
"Jo","Jno","Jb","Jae","Je","Jne","Jbe","Ja",
   "Js","Jns","Jp","?","Jl","Jge","Jle","Jg",
""(4),"Test"(2),"Xchg"(2),"Mov"(5),"Lea","Mov","",
"Xchg"(8),
   "Cbw","Cwd","Xcall","Wait","Pushf","Popf","Sahf","Lahf",
"Mov"(4),"Movb","Movw","Cmp"(2),
   "Test"(2),"Stob","Stow","Lodb","Lodw","Scab","Scaw",
"Mov"(16),
"?"(2),"Ret"(2),"Les","Lds","Mov"(2),
   "?"(2),"Xret"(2),"Int3","Int","Into","Iret",
""(4),"Aam","AAd","?","Xlat","Esc"(8),
"Loopne","Loope","Loop","Jcxz","In AL","In AX","Out AL","Out AX",
   "Call","Jump","Xjump","Jmp","In AL","In AX","Out AL","Out AX",
"Lock","?","Rep","Repz","Hlt","Cmc",""(2),
   "Clc","Stc","Cli","Sti","Cld","Std",""(2)

%constbyteintegerarray class(0:255)=
0(4),1(2),2(2),0(4),1(2),2(2),
0(4),1(2),2(2),0(4),1(2),2(2),
0(4),1(2),2,3,0(4),1(2),2,3,
0(4),1(2),2,3,0(4),1(2),2,3,
4(16),
4(16),
3(15),5,
5(11),3,5(4),
6(4),7(2),0(6),9,7,8,10,
11(8),3(2),12,3(5),
13(4),3(4),14(2),3(6),
15(16),
3(2),16,3,7(2),17(2),3(2),16,3(2),18,3(2),
19(4),20(2),3(2),21(8),
5(4),18(4),26(2),12,5,22(4),
3(6),23(2),3(6),24,25

!Classes
! 0: Two operands RR/RM/MR
! 1: Acc immediate
! 2: Seg reg (push/pop)
! 3: No operands
! 4: Reg (inc/dec/push/pop)
! 5: Short jump
! 6: Two op immediate RM
! 7: As class 0 but with operands reversed
! 8: Move from Segreg
! 9: Move to Segreg
!10: Pop RM
!11: Reg Acc (Xchg)
!12: Xcall
!13: Two op (mov) Acc and RM
!14: Test immediate Acc
!15: Two op immediate R
!16: Ret/Xret with adjustment
!17: Two op immediate RM (Mov)
!18: Short lit (Int,In,Out)
!19: shifts/rotates
!20: AAM/AAD
!21: Esc
!22: In/out CX
!23: Unary RM or Acc RM (inc/dec..muldiv)
!24: Unary byte inc/dec
!25: Unary word inc/dec, indirect jump/call
!26: Long Jump/Call

%conststring(3)%array x8083(0:7)="Add","Or","Adc","Sbb",
                                 "And","Sub","Xor","Cmp"
%conststring(3)%array x8f(0:7)="Pop","?"(7)
%conststring(3)%array xd0d3(0:7)="Rol","Ror","Rcl","Rcr",
                                 "Shl","Shr","?","Sar"
%conststring(4)%array xf6f7(0:7)="Test","?","Not","Neg",
                                 "Mul","Imul","Div","Idiv"
%conststring(4)%array xfe(0:7)="Incb","Decb","?"(6)
%conststring(6)%array xff(0:7)="Incw","Decw","Calli","Xcalli",
                               "Jumpi","Xjumpi","Push","?"

%routine operand(%integer w,mod,reg)
%integer disp
  p(" ")
  %if mod=3 %start
    %if w=0 %then p(br(reg)) %else p(wreg(reg))
    %return
  %finish
  %if mod=0 %start
    disp=0
    %if reg=6 %start
      reg=8; disp=adisp(1)
    %finish
  %else
    disp=adisp(mod-1)
  %finish
  wr(disp); p(rm(reg))
%end

%routine operands(%integer dw,mod,reg,rm)
  operand(dw&1,mod,rm) %and p(",") %if dw&2=0
  operand(dw&1,3,reg)
  p(",") %and operand(dw&1,mod,rm) %if dw&2#0
%end

%routine imm(%integer s,w,mod,rm)
%integer op
  operand(w,mod,rm)
  p(",")
  op=next
  %if w#0 %and s=0 %start
    op=next<<8+op
  %else
    op=op!16_ff00 %if op&128#0 %and s#0
  %finish
  wr(op)
%end

%integer hmd3,hmd4
%onevent 15 %start
  printstring("**
"); %return
%finish

  %cycle
    showloc; space; s=""; pos=0
    op=next; p(mnem(op)); ->sw(class(op))
sw(3):
rep:spaces(13-pos); printstring(s)
newline; %returnif size=0
  %repeat
sw(7): op=op!!2
sw(0): ab=next; operands(op,ab>>6,ab>>3&7,ab&7); ->rep
sw(1): imm(op&2,op&1,3,0); ->rep
sw(2): p(" "); p(segr(op>>3&3)); ->rep
sw(4): p(" "); p(wreg(op&7)); ->rep
sw(5): p(" "); ph(adisp(0)+cloc); ->rep
sw(6): ab=next; p(x8083(ab>>3&7)); p(" ")
!was! imm(op&2,op&1,ab>>6,ab&7)
{now} hmd3 = ab>>6; hmd4 = ab&7; imm(op&2,op&1,hmd3,hmd4)
      ->rep
sw(8): p(" "); ab=next; p(segr(ab>>3&3)); p(",")
      operand(1,ab>>6,ab&7); ->rep
sw(9): ab=next; operand(1,ab>>6,ab&7); p(", ")
      p(segr(ab>>3&3)); ->rep
sw(10):ab=next; p(x8f(ab>>3&7))
      operand(1,ab>>6,ab&7); ->rep
sw(11):p(" AX,"); operand(1,3,op&7); ->rep
sw(12): p(" "); ab=adisp(1); x=adisp(1)
      ph(x); p(":"); ph(ab); ->rep
sw(13):operands(op,0,0,6); ->rep
sw(14):ab=next; imm(0,op&1,3,0); ->rep
sw(15):imm(0,op&8,3,op&7); ->rep
sw(16):p(" "); wr(adisp(1)); ->rep
sw(17):ab=next; imm(0,op&1,ab>>6,ab&7); ->rep
sw(18):p(" "); wr(next); ->rep
sw(19):ab=next; p(xd0d3(ab>>3&7))

      operand(op&1,ab>>6,ab&7)
      %if op&2=0 %then p(", 1") %else p(", CL"); ->rep
sw(20):op=next; p("?") %unless op=10; ->rep
sw(21):p(" "); wr(op&7); p(","); ab=next
      operand(1,ab>>6,ab&7); ->rep
sw(22):p(" CX"); ->rep
sw(23):ab=next; p(xf6f7(ab>>3&7)); operand(op&1,ab>>6,ab&7); ->rep
sw(24):ab=next; p(xfe(ab>>3&7));   operand(0,ab>>6,ab&7); ->rep
sw(25):ab=next; p(xff(ab>>3&7));   operand(1,ab>>6,ab&7); ->rep
sw(26):p(" "); ph(adisp(1)+cloc); ->rep
%end

%string(255)infile,outfile=""

define param("IOB file",infile,pamnodefault)
define param("DIS file",outfile,pamnewgroup)
process parameters(cliparam)
openinput(1,infile.".iob")
outfile = infile.".dis" %if outfile=""
openoutput(1,outfile)
selectinput(1); selectoutput(1); loc==cloc
%cycle
  readsymbol(sym) %until 0#sym#255
  printstring("Corrupt
") %andstopunless setcode<=sym<=eof
  ->s(sym)
s(setcode):s(setgla): mode=sym
  %if mode=setcode %then loc==cloc %else loc==gloc; %continue
s(setloc): showloc; space; loc=w; showloc; newline; %continue
s(append):   %if mode=setcode %then code(w) %else gla(w); %continue
s(patch):
  printstring("Patch ")
  %if mode=setcode %then printsymbol('C') %else printsymbol('D')
  phex(w); printstring(" to "); phex(w); newline; %continue
s(def): showloc; printstring(" Define external "); name; %continue
s(extref): showloc; printstring(" Ref "); name; loc=loc+2; %continue
s(segref): showloc; printstring(" Sref "); name; loc=loc+2; %continue
s(eom): showloc; printstring("End of module
")
%repeat
s(eof): printstring("End of file
")
%endofprogram
