PROGRAM DIS;
              (* (C) LZR Soft, 25-Oct-91 *)

{

DIS - inteligentni disassembler pro Z80 s generovanim tabulek

Program je napsan v jazyce ESI Pascal a byl prelozen a zkompilovan
na pocitaci DEC PDP11/23+ s bezicim operacnim systemem DEC RT-11.
Navod k inplementaci jazyka ESI Pascal pro systemy RT je k dispozici.

Znaky < " " (ASCII 32 - mezera) slouzily k:
[G] - pipnuti
[L] - <FF> tez form feed, nebo-li odstrankovani pri tisku zdrojaku
      na ASCII tiskarne

Pripony souboru:
to, co dnes zname jako *.BAT (batak, davka pro sekvencni zpracovani
 uloh) v PC-DOSu bylo v OS RT-11 jako *.COM, RSX-11M jako *.CMD,
 jmenovalo se to Indirect Command File Processing a funkcnosti to
 PeCeckovske BATaky prevysovalo asi tak 100x (netroufam si srovnavat,
 ale nejspis to umelo tolik, co dnes unixove davky).
to, co dnes zname jako *.COM a *.EXE v PC-DOSu bylo v OS RT-11 *.SAV
 a v RSX-11M *.TSK

nejspis proto byl binarni soubor pojmenovan *.EXE, aby nekolidoval
se standardnimi priponami systemu RT-11 a RSX-11M (oba systemy byly
na PDPckach opravdu pouzivany a kazdy mel jine pripony)

(C) 1987-2001, LZR Soft, Kladno, Czech Republic



Program vyzaduje ke sve cinnosti soubor *.RID, ktery obsahuje tyto informace:

INPUT			<- jmeno vstupniho souboru .EXE
OUTPUT			<- jmeno vystupniho souboru .DIS
0000			<- pocatecni adresa
0000			<- pocatecni posun ve vstupnim souboru
dale nasleduji informace o datovych oblastech disassemblovaneho programu,
ktere jsou serazeny podle adres. Zadava se: adresa odkud mezera adresa kam
mezera format dat mezera komentar. Mezer muze byt vice, lze je nahradit
i tabelatory. Priklady:
1FE3 1FE3 B1		<- 1FE3 :            DB 0C3
2000 2004 D1B1T3	<- 2000 :            DB 235T,0FE,'ABC'
2005 200C W1R		<- 2005 :            DW 1574,6375,0AFCD,0003
2010 2020 B2T6|R ;com	<- 2010 :            DB 30,0BC,'RESUME'
			   2018 :            DB 31,0AF,'CURSOR'
			   2020 :            DB 00
2143 2150 T13		<- 2143 :            DB 'ahoj ',0CD,'lov',0CE,0CD,'e!'
3000	;komentar k instrukci
4000 |zacatek velke tabulky nebo rutiny se tiskne na extra radce
4111 4112 T1R	;komentar ke kratke tabulce je na stejne radce

Adresy se zadavaji jako hexa cislo 0-FFFF nebo jako dekadicke cislo 0T-64535T
Ridici znaky formatu znamenaji: B - hexadecimalne zobrazeny byte, D - dekadic-
ky zobrazeny byte, T - ASCII text, W - hexadecimalne zobrazene slovo, | - nu-
ceny prechod na novy radek, R - opakovani az do vycerpani tabulky. Za ridicimi
znaky B, D, T a W musi nasledovat dekadicka informace o delce polozky. Vzdy se
konci na adrese kam. I v pripade, kdy delka koliduje s koncovou adresou.

}
CONST
 PISM=370;
 HEXA=7;
 OPT=24;
 PRM=32;

 ROT=0;  BITOP=8; BLOK=11; T007=15; MAT=23;  ED40=31; EN42=37; ED47=44;
 HLT=52; T000=53; T001=61; T300=68; T301=76; T303=84; T002=92;

 DEFNME ='DCD42A        ';
 EXTRID ='RID'; EXTINF ='EXE'; EXTOUT ='DIS';
 
TYPE
 INTR =INTEGER;
 TEXTY =ARRAY[0..PISM] OF CHAR;
 CISLA =ARRAY[31..99] OF INTEGER;
 VSTBUF =ARRAY[0..4] OF INTEGER;
 DEFW =ARRAY[0..1] OF CHAR;
 BUFER =ARRAY [0..45] OF CHAR;
 NUMIN =ARRAY [0..6] OF CHAR;

VAR
 INSTR :TEXTY;
 PARAM :CISLA;
 PISMENO:CHAR;
 FLG :ARRAY[0..15]OF CHAR;
 REG :ARRAY[0..7]OF CHAR;
 P1,P2 :ARRAY[31..99] OF CHAR;
 ST1,ST2,ST3,ST4,VALERR :BOOLEAN;
 INPUT :VSTBUF;
 HL,POS,CIT,DELKA,ADRESA,STROP,COMM,
	LINERID,POSICE,POSUN :INTEGER;
 OUF,RID :FILE OF TEXT;
 INF :FILE OF CHAR;
 JENKOM,KONEC,UZBYL :BOOLEAN;
 JMENO :ARRAY [0..13] OF CHAR;
 CISLO : NUMIN;

 ODKUD,KAM : REAL;
 FORM : ARRAY[0..80] OF CHAR;
 MEZI : ARRAY[0..1] OF CHAR;
 AKCE : CHAR;
 I,J,K :INTEGER;

PROCEDURE ERROR(KDE:INTEGER);

BEGIN
 WRITELN('ERROR n.',KDE:1);
 ST1:=TRUE;
END;

FUNCTION VAL(NUM:NUMIN;ZAKL:INTEGER):INTEGER;
VAR I,J,CSL:INTEGER;
    PREV:REAL;
BEGIN
VALERR:=FALSE;
VAL:=0;
IF NUM[0]<>' ' THEN
 BEGIN
 I:=0;
 IF ZAKL<>2 THEN WHILE (NUM[I]<>' ') DO I:=I+1 ELSE I:=8;
 PREV:=0.0;
 IF NUM[I-1]='T' THEN BEGIN I:=I-1; NUM[I]:=' '; ZAKL:=10 END;
 FOR J:=0 TO I-1 DO
  BEGIN
  CSL:=ORD(NUM[J])-48;
  IF CSL>9 THEN CSL:=CSL-7;
  VALERR:=VALERR OR (CSL>=ZAKL) OR (CSL<0);
  IF NOT VALERR THEN PREV:=PREV*ZAKL+CSL;
  END;
 VALERR:=VALERR OR (PREV>65535.0);
 IF NOT(VALERR) THEN
  BEGIN
  IF PREV>32767.0 THEN PREV:=PREV-65536.0;
  IF PREV<-32767.0 THEN VAL:=-32768 ELSE VAL:=ROUND(PREV);
  END;
 END;
END;

FUNCTION CDBL(I:INTEGER): REAL;
VAR GFG:REAL;
BEGIN
 GFG:=I; IF I<0 THEN GFG:=65536.0+GFG;
 CDBL:=GFG;
END;

FUNCTION VEMCISLO:REAL;
VAR
 I,J:INTEGER;
BEGIN
 I:=0; WHILE (I<40) AND (FORM[I]=' ') DO I:=I+1;
 J:=0; WHILE (J<6) AND (FORM[I+J]<>' ') DO
  BEGIN CISLO[J]:=FORM[I+J]; J:=J+1; END;
 CISLO[J]:=' ';
 I:=I+J; WHILE FORM[I]=' ' DO I:=I+1;
 FOR J:=0 TO 80 DO IF J+I>80 THEN FORM[J]:=' ' ELSE FORM[J]:=FORM[J+I];
 VEMCISLO:=CDBL(VAL(CISLO,16));
END;

PROCEDURE NACTIRADEK;
VAR I:INTEGER;
    KOMENTAR:BOOLEAN;
 PROCEDURE DALSIRAD;
 BEGIN
  READLN(RID);
  LINERID:=LINERID+1;
 END;

BEGIN
 POS:=0; CIT:=0; MEZI:='U	';
 WHILE (NOT EOF(RID)) AND (EOLN(RID)) DO DALSIRAD;
 KONEC:=EOF(RID);
 KOMENTAR:=FALSE;
 FOR I:=0 TO 80 DO
  IF (EOLN(RID)) OR (KONEC) THEN
   FORM[I]:=' '
  ELSE
   BEGIN
   READ(RID,FORM[I]);
   IF (FORM[I]='|') OR (FORM[I]='|') THEN KOMENTAR:=TRUE;
   IF (FORM[I]<' ') AND NOT KOMENTAR THEN FORM[I]:=' ';
   END;
 DALSIRAD;
 JENKOM:=FALSE;
 ODKUD:=VEMCISLO;
 KAM:=-1.0;
 IF VALERR THEN ERROR(11)
 ELSE IF (FORM[0]='|') THEN JENKOM:=TRUE
      ELSE IF (FORM[0]<>';') THEN KAM:=VEMCISLO;
 IF VALERR THEN ERROR(12);
 COMM:=0;
 WHILE (COMM<=80) AND (FORM[COMM]<>';') DO COMM:=COMM+1;
 IF (KAM>-1.0) AND (ODKUD>KAM) THEN VALERR:=TRUE;
 IF VALERR THEN ERROR(13);
 IF (KONEC) OR (VALERR) THEN
 BEGIN
  ODKUD:=1E6; KAM:=-1.0; COMM:=200; JENKOM:=FALSE;
 END;
END;

PROCEDURE KOMENT(TAB:BOOLEAN);
VAR
 I,J,K :INTEGER;
BEGIN
  I:=80; WHILE FORM[I]=' ' DO I:=I-1;
  FOR J:=COMM TO I DO
   IF J=COMM THEN
    BEGIN
     POSICE:=POSICE DIV 8;
     IF TAB THEN FOR K:=POSICE TO 4 DO WRITE(OUF,'	');
     WRITE(OUF,'	;')
    END
   ELSE WRITE(OUF,FORM[J]);
  WRITELN(OUF); UZBYL:=FALSE;
  COMM:=200;
END;

PROCEDURE DBDW(HODN:INTEGER; WORB,NULA:BOOLEAN);
VAR
 PREV:REAL;
 CIS:INTEGER;

 PROCEDURE DIGIT(CO:REAL);
 VAR
  ZBYT:INTEGER;
  DELI:REAL;
 BEGIN
  CIS:=CIS-1; DELI:=TRUNC(CO/16); ZBYT:=ROUND(CO-16*DELI);
  IF CIS>0 THEN DIGIT (DELI);
  IF ZBYT<10 THEN ZBYT:=ZBYT+48 ELSE ZBYT:=ZBYT+55;
  WRITE(OUF,CHR(ZBYT));
 END;

BEGIN
 IF WORB THEN CIS:=4 ELSE CIS:=2;
 PREV:=HODN; IF HODN<0 THEN PREV:=65536.0+PREV;
 IF ((CIS=4) AND (PREV>40959.0) OR (CIS=2) AND (PREV>159.0)) AND (NULA) THEN
    WRITE(OUF,'0');
 DIGIT (PREV);
END;

PROCEDURE RADEK(LGAD:INTEGER; BU2:VSTBUF; VAR LEN:INTEGER);
VAR
 ADRS:REAL;
 BU3:BUFER;
 A,B,C,OP1,QQ:INTEGER;
 INDIR:DEFW;


 PROCEDURE INB(HODN:INTEGER; WORB,NULA:BOOLEAN; VAR KAM:BUFER);
 VAR
  PREV,DELI:REAL;
  CIS,ZBYT:INTEGER;
  I:INTEGER;

 BEGIN
  IF WORB THEN CIS:=4 ELSE CIS:=2;
  PREV:=HODN; IF HODN<0 THEN PREV:=65536.0+PREV;
  IF ((CIS=4) AND (PREV>40959.0) OR (CIS=2) AND (PREV>159.0)) AND (NULA) THEN
       BEGIN KAM[HL]:='0'; HL:=HL+1; END;
  HL:=HL+CIS;
  FOR I:=1 TO CIS DO
   BEGIN
    DELI:=TRUNC(PREV/16); ZBYT:=ROUND(PREV-16*DELI);
    PREV:=DELI; 
    IF ZBYT<10 THEN ZBYT:=ZBYT+48 ELSE ZBYT:=ZBYT+55;
    KAM[HL-I]:=CHR(ZBYT);
   END;
 END;

 FUNCTION BYTE:INTEGER;
 BEGIN
  BYTE:=BU2[LEN];
  LEN:=LEN+1;
 END;

 FUNCTION WORD:INTEGER;
 VAR
  U,V:INTEGER;

 BEGIN
  U:=BYTE; V:=BYTE;
  IF V<128 THEN WORD:=V*256+U
           ELSE WORD:=-((255-V)*256+255-U+1);
 END;

 PROCEDURE PRAZDNO;
 VAR
  I:INTEGER;
 BEGIN
  FOR I:=0 TO 45 DO BU3[I]:=' ';
  BU3[OPT]:='L'; BU3[OPT+1]:='D';
  LEN:=0; BU3[5]:=':';
  HL:=0; INB(LGAD, TRUE, FALSE, BU3);
 END;

 PROCEDURE SEKANA;
 BEGIN
  C:=A MOD 8; B:=(A DIV 8) MOD 8; A:=A DIV 64;
 END;

 PROCEDURE U1(X:INTEGER);
 VAR
  VNI:DEFW;

 BEGIN
  CASE X DIV 2 OF
  0: VNI:='BC';
  1: VNI:='DE';
  2: BEGIN VNI:=INDIR; ST2:=TRUE; END;
  3: VNI:='SP';
  4: VNI:='AF';
  ELSE ERROR(1)
  END;
  BU3[HL]:=VNI[0]; HL:=HL+1;
  BU3[HL]:=VNI[1]; HL:=HL+1;
 END;

 PROCEDURE S4;
 BEGIN
  BU3[HL]:='('; HL:=HL+1;
  U1(4);
  IF ST3 THEN
   BEGIN BU3[HL]:='+';
    IF QQ>127 THEN BEGIN BU3[HL]:='-'; QQ:=256-QQ; END;
    HL:=HL+1;
    INB(QQ, FALSE, FALSE, BU3);
   END;
  BU3[HL]:=')'; HL:=HL+1;
 END;

 PROCEDURE F1(E:INTEGER);
 VAR
  DUM:CHAR;
 BEGIN
  DUM:=REG[E]; BU3[HL]:=DUM; HL:=HL+1;
  IF (DUM='0') AND ( OP1<>160B) AND (OP1<>161B) THEN
     BEGIN HL:=HL-1; S4; END;
 END;

 PROCEDURE TYP(KTERY:INTEGER);
 VAR
  I,J:INTEGER; 
  PROCEDURE PAR(CO:INTEGER);
   PROCEDURE F3(P:INTEGER);
   BEGIN
    IF (P=6) AND ST3 THEN QQ:=BYTE;
    F1(P);
    IF ((P=4) OR (P=5)) AND ST3 AND NOT(ST4) THEN
       BEGIN BU3[HL]:=INDIR[1]; HL:=HL+1; ST2:=TRUE; END;
   END;
   PROCEDURE ZAVRI;
   BEGIN
    BU3[HL]:=')'; HL:=HL+1;
   END;

  BEGIN
   BU3[HL]:='(';
   CASE CO OF
   1: BEGIN IF (B MOD 2) = 0 THEN BU3[HL]:='I' ELSE BU3[HL]:='R';
      HL:=HL+1;
      END;
   2: BEGIN BU3[HL]:='A'; HL:=HL+1; END;
   3: U1(4);
   4: U1(B);
   5: BEGIN HL:=HL+1; U1(B); ZAVRI; END;
   6: BEGIN HL:=HL+1; INB(WORD,TRUE,TRUE, BU3); ZAVRI; END;
   7: F3(B);
   8: F3(C);
   9: BEGIN HL:=HL+1; INB(BYTE,FALSE,TRUE, BU3); ZAVRI; END;
   10:BEGIN IF B=6 THEN B:=8;
            U1(B);
      END;
   11:BEGIN HL:=HL+1; BU3[HL]:='C'; HL:=HL+1; ZAVRI; END;
   12:BEGIN A:=BYTE; IF A>127 THEN A:=A-256;
            A:=LGAD+A+2;
{ RIZIKO
}
            INB(A,TRUE,TRUE, BU3);
      END;
   13:INB(BYTE,FALSE,TRUE, BU3);
   14:INB(WORD,TRUE,TRUE, BU3);
   15:BEGIN IF BU3[OPT+1] = 'R' THEN B:=B MOD 4;
            IF FLG[B*2]<>' ' THEN BEGIN BU3[HL]:=FLG[B*2]; HL:=HL+1; END;
            BU3[HL]:=FLG[B*2+1]; HL:=HL+1;
      END;
   ELSE ERROR(2)
   END;
  END;
 BEGIN
  HL:=PRM; WHILE BU3[HL]<>' ' DO HL:=HL+1;
  I:=KTERY DIV 16; J:=KTERY MOD 16;
  IF I>0 THEN PAR(I);
  IF J>0 THEN BEGIN BU3[HL]:=','; HL:=HL+1; PAR(J); END;
 END;

 PROCEDURE OPR(CO:INTEGER);
 VAR I,J,K: INTEGER;
 
 BEGIN
  K:=0; HL:=OPT;
  FOR I:=1 TO CO DO
  BEGIN WHILE INSTR[K]<>'#' DO K:=K+1;
        K:=K+1;
  END;
  WHILE INSTR[K]<>'#' DO
   BEGIN BU3[HL]:=INSTR[K]; HL:=HL+1; K:=K+1; END;
  IF CO>30 THEN TYP(PARAM[CO]);
  HL:=PRM;
 END;

 PROCEDURE ARI(PRO:BOOLEAN);
 VAR KOHO:INTEGER;

 BEGIN
  OPR(B+MAT);
  IF (B>3) OR (B=2) THEN
    IF PRO THEN KOHO:=200B ELSE KOHO:=320B
  ELSE
    IF PRO THEN KOHO:=050B ELSE KOHO:=055B;
  TYP(KOHO);
 END;

 PROCEDURE ADRHEX;
 VAR I,J: INTEGER;
  
 BEGIN
  HL:=HEXA;
  FOR I:=0 TO LEN-1 DO INB(BU2[I],FALSE,FALSE, BU3);
  FOR I:=0 TO 6 DO WRITE(OUF,BU3[I]);
  J:=HEXA; WHILE (BU3[J]<>' ') DO BEGIN WRITE(OUF,BU3[J]); J:=J+1; END;
  WRITE(OUF,'		');
  J:=OPT; WHILE (BU3[J]<>' ') DO BEGIN WRITE(OUF,BU3[J]); J:=J+1; END;
  IF BU3[PRM]<>' ' THEN WRITE(OUF,'	');
  J:=PRM; WHILE (BU3[J]<>' ') DO BEGIN WRITE(OUF,BU3[J]); J:=J+1; END;
  FOR J:=0 TO 45 DO IF BU3[J]<>' ' THEN POSICE:=J+1;
 END;

 PROCEDURE DBXY;
 
 BEGIN
  ST2:=FALSE; ST3:=FALSE; ST4:=FALSE;
  PRAZDNO;
  BU3[OPT]:='D'; BU3[OPT+1]:='B';
  A:=BYTE; HL:=PRM;
  INB(A,FALSE,TRUE, BU3);
 END;

 PROCEDURE ODDILCB;
 VAR DUM:CHAR;

  PROCEDURE C4( CO:INTEGER );
  BEGIN
   F1(CO);
   IF (CO<>6) AND ST3 THEN
     BEGIN ST4:=TRUE; ST4:=TRUE; BU3[HL]:=','; HL:=HL+1; S4;
     END;
  END;
 BEGIN
  IF ST3 THEN QQ:=BYTE;
  A:=BYTE; SEKANA;
  IF A=0 THEN
    BEGIN OPR(B+ROT); C4(C); END
  ELSE BEGIN
    OPR(A-1+BITOP);
    BU3[HL]:=CHR(B+48); HL:=HL+1;
    BU3[HL]:=','; HL:=HL+1;
    C4(C);
    IF BU3[PRM+3]=',' THEN
      BEGIN
        DUM:=BU3[PRM]; BU3[PRM]:=BU3[PRM+2]; BU3[PRM+2]:=DUM;
      END;
    IF (A=1) AND (ST4) THEN DBXY;
       END;
 END;

 PROCEDURE ODDILED;
 VAR DUM:INTEGER;

 BEGIN A:=BYTE; OP1:=A; SEKANA;
  IF (A=0) OR (A=3) THEN DBXY
  ELSE
   IF A=1 THEN 
    BEGIN DUM:=C+ED40;
     CASE C OF
     0,1,4:;
     2,3,5: BEGIN
             IF B MOD 2 = 0 THEN DUM:=C-2+EN42;
             IF (C=5) AND (B>1) THEN DUM:=EN42+6;
            END;
     6: BEGIN DUM:=EN42+5;
         B:=(B MOD 4)-1; IF B<0 THEN B:=0;
         BU3[PRM]:=CHR(B+48);
        END;
     7: DUM:=B+ED47;
     ELSE ERROR(4)
     END;
     OPR (DUM);
    END
   ELSE
    IF (C>3) OR (B<4) THEN DBXY
    ELSE BEGIN
      IF B MOD 2 =0 THEN BU3[OPT+2]:='I'
      ELSE BU3[OPT+2]:='D';
      IF B-4>1 THEN BU3[OPT+3]:='R';
      OPR(C+BLOK);
         END;   
 END;

 PROCEDURE NORMAL;
 VAR DUM:INTEGER;

 BEGIN
  IF A=166B THEN OPR(HLT)
  ELSE BEGIN
    SEKANA;
    IF A=0 THEN
       BEGIN
        DUM:=C+T001;
        CASE C OF
        0: DUM:=B+T000;
        1,3: IF B MOD 2=0 THEN DUM:=C+1+EN42;
        2: DUM:=B+T002;
        4,5,6: ;
        7: DUM:=B+T007;
        ELSE ERROR(5)
        END;
        OPR (DUM);
       END
    ELSE IF A=1 THEN
       BEGIN
        IF (B=6) OR (C=6) THEN ST4:=TRUE;
        TYP (170B);
       END
    ELSE IF A=2 THEN ARI (TRUE)
    ELSE IF A=3 THEN
       IF C=6 THEN ARI(FALSE)
       ELSE BEGIN
         DUM:=C+T300;
         CASE C OF
         0,2,4: ;
         1,5: IF B MOD 2 = 1 THEN DUM:=(B DIV 2) +T301+C-1;
         3: DUM:=B+T303;
         7: BEGIN
             HL:=PRM; INB(B*8,FALSE,FALSE, BU3);
            END;
         ELSE ERROR(6)
         END;
         OPR(DUM);
            END;
       END;
 END;

 PROCEDURE KODY;
 BEGIN
   ST1:=FALSE; ST2:=FALSE; ST3:=TRUE; ST4:=FALSE;
   PRAZDNO; A:=BYTE; OP1:=0;
   IF A=335B THEN BEGIN INDIR:='IX'; A:=BYTE; END
   ELSE
    IF A=375B THEN BEGIN INDIR:='IY'; A:=BYTE; END
    ELSE BEGIN INDIR:='HL'; ST3:=FALSE; END;
   IF A=313B THEN ODDILCB
   ELSE IF A=355B THEN BEGIN IF ST3 THEN DBXY ELSE ODDILED; END
       ELSE BEGIN NORMAL;
             IF (BU3[OPT]='?') OR ((ST3)AND(NOT ST2)) THEN DBXY;
            END;
 END;

 FUNCTION ODE:CHAR;
 VAR COSI:CHAR;
 BEGIN
  COSI:=MEZI[1];
  IF COSI=' ' THEN COSI:=MEZI[0] ELSE WRITE (OUF,MEZI[0]:1);
  ODE:=COSI;
 END;

 PROCEDURE TISKUVODU;
 BEGIN
  MEZI:='U	'; UZBYL:=TRUE;
  DBDW(LGAD,TRUE,FALSE); WRITE(OUF,' :			D');
 END; 

BEGIN { OF RADEK

O<=K*A>K   KOMENT RADEK
O>K   DISS  A=O KOMENT
            A>O ERR
/A<O  DISS  ...
 /    TAB   CIT  =0 POVEL
                 /  A=O UVOD
		    AKCE
}
 ADRS:=CDBL(LGAD);

 IF (ADRS>KAM) AND (ODKUD<=KAM) THEN
  BEGIN
   IF MEZI[0]='''' THEN WRITE(OUF,'''');
   KOMENT(FALSE); NACTIRADEK;
  END;

 WHILE (JENKOM) AND (ADRS=ODKUD) DO
  BEGIN
   A:=80; LEN:=0;
   WHILE (FORM[A]=' ') DO A:=A-1;
   FOR B:=1 TO A DO WRITE(OUF,FORM[B]);
   WRITELN(OUF);
   NACTIRADEK;
  END;

  IF (ADRS<ODKUD) OR (ODKUD>KAM) THEN
  BEGIN
   KODY;
   ADRHEX;
   IF ADRS>ODKUD THEN VALERR:=TRUE
   ELSE
    IF ADRS=ODKUD THEN
     BEGIN KOMENT(TRUE); NACTIRADEK; END
    ELSE WRITELN(OUF);
   UZBYL:=FALSE;
  END ELSE
  BEGIN
   LEN:=0;
   IF CIT=0 THEN
    BEGIN AKCE:=FORM[POS];
     IF (AKCE>='a') AND (AKCE<='z') THEN AKCE:=CHR(ORD(AKCE)-32);
     IF AKCE='|' THEN
      BEGIN IF MEZI[0]='''' THEN WRITE(OUF,'''');
       KOMENT(FALSE); POS:=POS+1; TISKUVODU;
      END
     ELSE
      IF AKCE='R' THEN POS:=0
      ELSE
       BEGIN
        POS:=POS+1;
        WHILE (FORM[POS]<='9') AND (FORM[POS]>='0')
         DO BEGIN CIT:=CIT*10-48+ORD(FORM[POS]); POS:=POS+1;
            END;
        IF CIT=0 THEN VALERR:=TRUE;
       END;
    END
   ELSE
    BEGIN
     IF ADRS=ODKUD THEN TISKUVODU;
     IF NOT UZBYL THEN VALERR:=TRUE;
     IF MEZI[0]='U' THEN
      BEGIN
       IF AKCE='W' THEN MEZI[0]:='W' ELSE MEZI[0]:='B';
      END;
     IF AKCE='W' THEN
      BEGIN A:=WORD; WRITE(OUF,ODE); DBDW(A,TRUE,TRUE); MEZI:=', '; END
     ELSE
     IF AKCE='B' THEN
      BEGIN A:=BYTE; WRITE(OUF,ODE); DBDW(A,FALSE,TRUE); MEZI:=', '; END
     ELSE
     IF AKCE='D' THEN
      BEGIN A:=BYTE; WRITE(OUF,ODE,A:1,'T'); MEZI:=', '; END
     ELSE
     IF AKCE='T' THEN
      BEGIN
       A:=BYTE;
       IF (A>31) AND (A<127) AND (A<>ORD('''')) THEN
        BEGIN IF MEZI[0]='''' THEN WRITE(OUF,CHR(A))
                             ELSE WRITE(OUF,ODE,'''',CHR(A));
              MEZI:=''',';
        END ELSE
        BEGIN WRITE(OUF,ODE); DBDW(A,FALSE,TRUE);
              MEZI:=', '
        END;
      END
     ELSE VALERR:=TRUE;
     CIT:=CIT-1;
    END;
  END;
END;

PROCEDURE NADEC ( VAR KOD:INTEGER );

BEGIN
 KOD:=0;
 IF STROP>0 THEN
  BEGIN
   KOD:=ORD(INF^); GET(INF); IF KOD<0 THEN KOD:=256+KOD;
  END;
 STROP:=STROP-1;
 IF ((STROP MOD 16)=0) AND (JMENO<>'TI:           ') THEN
   WRITE('	',CHR(13),'Zbyva=',STROP:7,'		');
END;

FUNCTION PJMEN:CHAR;
VAR I:INTEGER;
BEGIN
FOR I:=0 TO 13 DO IF JMENO[I]>' ' THEN WRITE(JMENO[I]);
PJMEN:=' ';
END;


BEGIN
 INSTR:=
'RLC#RRC#RL#RR#SLA#SRA#SLE#SRL#BIT#RES#SET##CP
#IN#OT#RLCA#RRCA#RLA#RRA#DAA#CPL#SCF#CCF#ADD#ADC#SUB#SBC#AND#XOR#OR#CP
#IN#OUT#ADC##NEG#RETI#SBC###RETN#INC#IM#RET!#####RRD#RLD#NOP#NOP#HALT
#NOP#EX      AF,AF''#DJNZ#JR#JR#JR#JR#JR
#?#ADD#?#DEC#INC#DEC##RET#POP#JP#?#CALL#PUSH#?#RST
#RET#EXX#JP##CALL#?#?#?#JP#?#OUT#IN#EX      (SP)#EX      DE#DI#EI#########
########### ';
{ TOHLE JE KONSTANTA }

 FLG:='NZ ZNC CPOPE P M';	{ TOHLE JE KONSTANTA }
 REG:='BCDEHL0A';		{ TOHLE JE KONSTANTA }

 J:=0;
 FOR I:=0 TO PISM DO IF INSTR[I]<' ' THEN J:=J+1 ELSE INSTR[I-J]:=INSTR[I];

 P1:=
'7B3400364040011220000000CCFFFF0304777FAF0FA000054E000E092000052526362';
 P2:=
'B7460044E00002211000000000CCCC040000D00E0E000000300000029330025253626';
	{ TOHLE JSOU HEXA KONSTANTY }
 FOR I:=31 TO 99 DO
  BEGIN J:=ORD(P1[I])-48; IF J>9 THEN J:=J-7;
        K:=ORD(P2[I])-48; IF K>9 THEN K:=K-7;
        PARAM[I]:=J*16+K;
  END;

WRITELN('Prevod EXE souboru do DISSAS formy');
WRITELN('==================================');
 KONEC:=TRUE; JMENO:=DEFNME;
 WRITE('Jmeno ridiciho souboru [',PJMEN,'.',EXTRID,'] : ');
 READLN(JMENO);IF JMENO='              ' THEN JMENO:=DEFNME;
 FOR I:=0 TO 12 DO
  IF (JMENO[I]=':') AND (JMENO[I+1]=' ') THEN JMENO:=DEFNME;
 WRITELN;
 RESET(RID,JMENO,EXTRID,DELKA);
 IF (DELKA<1) THEN
  WRITELN('Nenalezen ridici  soubor             : ',PJMEN)
 ELSE
  BEGIN
  READLN(RID,JMENO);
  WRITELN('Je pouzit vstupni soubor     [.',EXTINF,']  : ',PJMEN);
  RESET(INF,JMENO,EXTINF,DELKA);
  IF (DELKA<1) THEN
   BEGIN
    WRITELN('Nenalezen vstupni soubor             : ',PJMEN);
    CLOSE(RID);
   END
  ELSE
   BEGIN
   STROP:=DELKA*512;
   DELKA:=DELKA*20; {@}
   READLN(RID,JMENO);
   REWRITE(OUF,JMENO,EXTOUT,DELKA);
   WRITELN('Generuje se vystupni soubor  [.',EXTOUT,']  : ',PJMEN);
   IF (DELKA<1) AND (JMENO<>'TI:           ')
      AND (JMENO<>'LP:           ') THEN
    BEGIN
     WRITELN('Neni misto pro vystupni soubor       : ',PJMEN);
     CLOSE(RID); CLOSE(INF);
    END
   ELSE
    BEGIN
     READLN(RID,CISLO); ADRESA:=VAL(CISLO,16);
     IF NOT VALERR THEN READLN(RID,CISLO); POSUN:=VAL(CISLO,16);
     IF VALERR THEN
      BEGIN
       WRITE('Chybny offset ');
       CLOSE(RID); CLOSE(INF);
      END
     ELSE KONEC:=FALSE;
    END;
   END;
  END;
IF NOT KONEC THEN
 BEGIN
  FOR I:=1 TO POSUN DO
   BEGIN
    NADEC(CIT); ADRESA:=ADRESA+1;
   END;
  IF STROP<-3 THEN KONEC:=TRUE;
 END;
IF NOT KONEC THEN
 BEGIN
  DELKA:=5; LINERID:=3;
  NACTIRADEK;
  REPEAT
   FOR I:=5-DELKA TO 4 DO NADEC(INPUT[I]);
   RADEK (ADRESA,INPUT,DELKA);
   IF VALERR THEN STROP:=-5
   ELSE FOR I:=DELKA TO 4 DO INPUT[I-DELKA]:=INPUT[I];
   ADRESA:=ADRESA+DELKA;
  UNTIL (STROP<=-4) AND (DELKA>0);
  IF VALERR THEN
   BEGIN
   WRITELN;
   WRITELN(CHR(10),
           'Chybny format tabulky v ridicim souboru od radky: ',
           LINERID:1);
   END;
  IF (ODKUD<=KAM) THEN
   BEGIN
    IF MEZI[0]='''' THEN WRITE(OUF,'''');
    KOMENT(FALSE);
   END;
  DBDW(ADRESA,TRUE,FALSE);
  WRITELN(OUF,' : End of disassembly');
  WHILE NOT(EOF(RID)) DO
   BEGIN
   WHILE NOT(EOLN(RID)) DO
    BEGIN
    READ(RID,PISMENO); WRITE(OUF,PISMENO);
    END;
   READLN(RID); WRITELN(OUF);
   END;
  CLOSE(OUF); CLOSE(RID); CLOSE(INF);
 END;
WRITELN;
WRITELN(CHR(10),'Konec prace. (C) 1991, LZR Soft, POLDI Kladno');
END.
{----------------------------------------------------------------------------}