06_disassembler.bas

100000 REM DISASSEMBLER by Colin I Clayman 1985.
100000 REM This is known to not work entirely but is probably fixable.
100010 DEFPROC DISAS(A,B)
100020 LET I=1,P=3,E=7,H=&0010,Q=H*H,X=&000A
100030 DIM R$(I+I)(E),C$(P)(E),X$(P+P)(E),S$(P)(P),Q$(P)(P),Y$(P)(P),W$(72)
100040 PROC SETUP
100050 CLS 
100060 FOR a=A TO B
100070   PROC OP(a)
100080 NEXT a
100090 ENDPROC
100100 DEFPROC OP(a)
100110 PRINT #a;" : ";
100120 LET c=FALSE,x=c,A$=""
100130 REPEAT 
100140   PROC TYPE(PEEK(a))
100150 UNTIL q
100160 IF NOTc THEN  PROC NORMAL
100170 IF c=I THEN  PROC CB-OP
100180 IF c=I+I THEN  PROC ED-OP
100190 PROC CONV
100200 IF KEYN THEN  LET q=GETN
100210 ENDPROC 
100220 DEFPROC TYPE(b)
100230 REM h=HIGH b76, m=MID b543, l=LOW b210, p=PLANE b54, r=RIGHT b3
100240 LET h=b DIV &0040,m=(b BNAND &0038) DIV (E+I),l=b BNAND E,p=m DIV (I+I),r=m BNAND I,q=TRUE
100250 IF NOTc AND (b=&00CB OR b=&00ED) THEN  LET c=I+(b=&00ED),a=a+I+(x>=I),q=FALSE
100260 IF NOTc+x AND (b=&00DD OR b=&00FD) THEN  LET x=I+(b=&00FD),a=a+I,q=FALSE
100270 ENDPROC 
100280 DEFPROC NORMAL
100290 IF b=&0076 THEN  LET A$="HALT"
100300 ELSE  IF NOTh THEN  PROC NORMAL0
100310 ELSE  IF h=I THEN  LET A$="LD"+R$(m)+R$(l)
100320 ELSE  IF h=I+I THEN  LET A$=X$(m)+R$(l)
100330 ELSE  PROC NORMAL3
100340 ENDPROC 
100350 DEFPROC NORMAL0
100360 IF NOTl AND m>P THEN  LET A$="JR "+C$(m-P-I)+"n"
100370 ELSE  IF NOTl THEN  LET W$="NOP     EX AF AF'DJNZ n   JR n",A$=MID$(W$,X*m-m+I,X-I)
100380 ELSE  IF l=I AND r THEN  LET A$="ADD y "+S$(p)
100390 ELSE  IF l=I THEN  LET A$="LD "+S$(p)+"d"
100400 ELSE  IF l=I+I THEN  LET W$="(BC) AA (BC) (DE) AA (DE) (d) y y (d) (d) A A (d) ",A$="LD "+MID$(W$,6*m+I,P+P)
100410 ELSE  IF l=P THEN  LET W$="INCDEC",A$=MID$(W$,P*r+I,P)+" "+S$(p)
100420 ELSE  IF l=P+I THEN  LET A$="INC"+R$(m)
100430 ELSE  IF l=P+I+I THEN  LET A$="DEC"+R$(m)
100440 ELSE  IF l=P+P THEN  LET A$="LD"+R$(m)+"n"
100450 ELSE  LET W$="RLCARRCARLA RRA DAA CPL SCF CCF",A$=MID$(W$,P*m+m+I,P+I)
100460 ENDPROC 
100470 DEFPROC NORMAL3
100480 IF NOTl THEN  LET A$="RET"+C$(m)
100490 ELSE  IF l=I AND r THEN  LET W$="RET EXX JP (y) LD SP y",A$=MID$(W$,E*p+I,E)
100500 ELSE  IF l=I THEN  LET A$="POP "+Q$(p)
100510 ELSE  IF l=I+I THEN  LET A$="JP "+C$(m)+"d"
100520 ELSE  IF l=P THEN  LET W$="JP d               OUT (n) A IN A (n) EX (SP) yEX DE HL DI ",A$=MID$(W$,X*m-m+I,X-I)
100530 ELSE  IF l=P+I THEN  LET A$="CALL "+C$(m)+"d"
100540 ELSE  IF l=P+I+I AND NOTx AND r THEN  LET A$="CALL d"
100550 ELSE  IF l=P+I+I AND NOTr THEN  LET A$="PUSH "+Q$(p)
100560 ELSE  IF l=P+P THEN  LET A$=X$(m)+"n"
100570 ELSE  IF l=E THEN  LET W$="0008101820283038",A$="RST  &"+MID$(W$,m+m+I,I+I)
100580 ENDPROC 
100590 DEFPROC CB-OP
100600 IF h THEN  LET W$="   BITRESSET",A$=MID$(W$,P*h+I,P)+" "+STR$(m)+" "+R$(l)
100610 ELSE  IF m<>P+P THEN  LET W$="RLCRRCRL RR SLASRA   SRL",A$=MID$(W$,P*m+I,P)+" "+R$(l)
100620 ENDPROC 
100630 DEFPROC ED-OP
100640 IF NOTh OR h=P OR h=I+I AND (l>P OR m<=P) THEN  ENDPROC 
100650 IF h=I+I THEN  LET W$="LDCPINOT",V$="I D IRDR",A$=MID$(W$,l+l+I,I+I)+MID$(V$,m+m-E,I+I)
100660 ELSE  IF NOTl THEN  LET A$="IN"+R$(m)+"(C)"
100670 ELSE  IF l=I THEN  LET A$="OUT (C) "+R$(m)
100680 ELSE  IF l=I+I THEN  LET W$="SBCADC ",A$=MID$(W$,P*r+I,P)+" HL "+S$(p)
100690 ELSE  IF l=P AND r THEN  LET A$="LD "+S$(p)+"(d)"
100700 ELSE  IF l=P THEN  LET A$="LD (d) "+S$(p)
100710 ELSE  IF l=P+I AND NOTm THEN  LET A$="NEG"
100720 ELSE  IF l=P+I+I AND NOTP THEN  LET W$="NI",A$="RET"+MID$(W$,r+I,I)
100730 ELSE  IF l=P+P AND m<=P AND m<>I THEN  LET W$=" IM 0  IM 1   IM 2",A$=MID$(W$,P*m+m+I,P+I)
100740 ELSE  IF l=E THEN  LET W$="LDI ALDR ALDO A ILDA RRRD  RLRD",A$=MID$(W$,6*m+I,P+P)
100750 ENDPROC 
100760 DEFPROC CONV
100770 IF A$="" THEN  LET a=a-NOTx,W$="&CB&ED&DD&FD"
100780 IF A$="" THEN  PRINT MID$(W$,P*(x+I+(c-I-I)*NOTx+I),P)
100790 IF A$="" THEN  ENDPROC 
100800 FOR i=I TO LEN(A$)
100810   LET B$=MID$(A$,i,I)
100820   IF B$="x" THEN  PROC INDEX
100830   ELSE  IF B$="y" THEN  PRINT Y$(x);
100840   ELSE  IF B$="d" THEN  PROC ADDR
100850   ELSE  IF B$="n" THEN  PROC BYTE
100860   ELSE  PRINT B$;
100870 NEXT i
100880 PRINT 
100890 ENDPROC 
100900 DEFPROC INDEX
100910 PRINT "(";
100920 PRINT Y$(x);
100930 IF x THEN  PRINT "+";
100940 IF x THEN  PROC PBYTE(PEEK(a+I-2*(c>=I)))
100950 IF x THEN  LET a=a+(NOTc)
100960 PRINT ")";
100970 ENDPROC 
100980 DEFPROC ADDR
100990 PRINT #DPEEK(a+I);
101000 LET a=a+I+I
101010 ENDPROC 
101020 DEFPROC BYTE
101030 LET a=a+I
101040 PROC PBYTE(PEEK(a))
101050 ENDPROC 
101060 DEFPROC HEX(h)
101070 IF h<X THEN  PRINT h;
101080 ELSE  PRINT CHR$(ASC("A")+h-X);
101090 ENDPROC 
101100 DEFPROC PBYTE(b)
101110 PRINT "&";
101120 PROC HEX(b DIV H)
101130 PROC HEX(b MOD H)
101140 ENDPROC 
101150 DEFPROC SETUP
101160 DATA B,NZ,ADD A,C,Z,ADC A,D,NC,SUB,E,C,SBC A,H,PO,AND,L,PE,XOR,x,P,OR,A,M,CP, 
101170 DATA BC,BC,HL,DE,DE,IX,y,y,IY,SP,AF, 
101180 RESTORE 
101190 FOR i=FALSE TO E
101200   READ R$(i),C$(i),X$(i)
101210 NEXT i
101220 FOR i=FALSE TO P
101230   READ S$(i),Q$(i),Y$(i)
101240 NEXT i
101250 ENDPROC