PROGRAM DXTOMG(OUTPUT);

ORIGIN
  BUF=80H,                                  (* BUFFER DISKETY *)
  FILENAME=5DH,
  FILETYP=65H,                                        (* FDT *)
  BREAK=39H,                 (* ADRESA PRERUSOVACIHO VEKTORU *)
  IOBYTE=03H;

LABEL 5,51,61,62,999;

CONST
  BDOS=5;                                        (* PRO CP/M *)
  FDT=5CH;
  OPN=15;
  RD =20;

  CR=0DH;
  LF=0AH;
  DVOJT=3AH;
  CTRLZ=1AH;
 
  P55CW=87H;
  BELX=0F973H;
  KONVP=0F5C2H;
  KONV1=0F5C6H;
  CTSE=0F593H;
  WEIT=0F5A2H;

TYPE
  MEM=RECORD
         ADRH,ADRL:BYTE;
         TYP,SUM,DELKA:BYTE;
         DATA:ARRAY[1..255] OF BYTE
      END;
  MEMP=^MEM;
 
 
EXTERNAL VAR
  BUF:ARRAY [0..127] OF BYTE;
  FILENAME: PACKED ARRAY [1..8] OF CHAR;
  FILETYP: PACKED ARRAY [1..3] OF CHAR;
  BREAK: MEMP;
  IOBYTE: BYTE;
 

VAR
  MEMSTRT,P,Q: MEMP;
  MEMTOP: MEMP;
  DXADR: BYTE;
  SAVEIO: BYTE;
  I,J,K:BYTE;
  SPSAVE,SVBRK:MEMP;
  KONEC,FIRST: BOOLEAN;

DYNAMIC PROCEDURE INIT;
LABEL 9;
VAR X:ARRAY [1..100] OF INTEGER;      (* REZERVA NA ZASOBNIK *)
    I:BYTE;

BEGIN
  WRITELN('Kopirovani z diskety na kazetu');
  WRITELN('       Format INTEL-HEX');
  WRITELN;
  IF FILETYP='   ' THEN FILETYP:='HEX';     (* JMENO SOUBORU *)
  IF FILENAME='        ' THEN
    FILENAME:='MSAVE';
    WRITE('Kopirovany soubor: ');
  FOR I:=1 TO 8 DO IF FILENAME[I]<>' 'THEN WRITE(FILENAME[I]);
  WRITELN('.',FILETYP);
  INLINE("MVI  C,OPN                     (* OTEVRENI SOUBORU *)
         "LXI  D,FDT
         "CALL BDOS
         "ADI  1
         "JNZ  REF(9));
  WRITE('## Soubor ');
  FOR I:=1 TO 8 DO IF FILENAME[I]<>' '
  THEN WRITE(FILENAME[I]);
  WRITELN('.',FILETYP,' neexistuje');
  GOTO 999;
9:
  NEW(MEMSTRT);                 (* ALOKACE CELE VOLNE PAMETI *)
  MEMTOP:=REF(X);
  DXADR:=128;
  SAVEIO:=IOBYTE;                       (* NASTAVENI IO-BYTU *)
(*  IOBYTE:= 0A5H; *)
  P:=MEMSTRT;
  FIRST:=TRUE;
END;

FUNCTION GETB:BYTE;      (* PRECTENI JEDNOHO ZNAKU Z DISKETY *)
LABEL 9;
VAR I:BYTE;
BEGIN
  IF DXADR>127 THEN
  BEGIN                                     (* FYZICKE CTENI *)
    DXADR:=0;
    INLINE("MVI  C,RD
           "LXI  D,FDT
           "CALL BDOS
           "ANA  A
           "JZ   REF(9));
    FOR I:= 0 TO 127 DO BUF[DXADR]:=0;      (* KONEC SOUBORU *)
    9:;
  END;
  GETB:=BUF[DXADR];
  I:=BUF[DXADR];
  DXADR:=DXADR+1;
END;

FUNCTION GETD:BYTE;
VAR I,J:BYTE;
BEGIN
  I:=GETB;
  J:=I-ORD('0');
  IF (J>=0) AND (J<=9)  THEN GETD:=J
  ELSE GETD:=I-ORD('A')+10;
END;

FUNCTION GETC:BYTE;
BEGIN
  GETC:=GETD*16+GETD;
END;

BEGIN
  INIT;
  IF GETB<>DVOJT THEN
  BEGIN
    WRITELN('## Soubor neni vhodneho typu');
    GOTO 999;
  END;
  KONEC:=FALSE;
  REPEAT                        (* PRO JEDNO ZAPLNENI PAMETI *)
    P:=MEMSTRT;
    REPEAT
      P^.DELKA:=GETC;
      P^.ADRH:=GETC;    P^.ADRL:=GETC;
      P^.TYP:=GETC;
      IF P^.DELKA=0 THEN P^.TYP:=1;
      FOR I:=1 TO P^.DELKA DO
         P^.DATA[I]:=GETC;
      P^.SUM:=GETC;
      FOR := 2 DO I:=GETB;                         (* CR, LF *)
      P:=P+SIZE(MEM)-255+P^.DELKA;
      KONEC:=GETB<>DVOJT;
    UNTIL (P>MEMTOP) OR KONEC;
    Q:=MEMSTRT;
    IF FIRST THEN
    BEGIN
      FIRST:=FALSE;
      WRITELN('Zapni nahravani, po zaznamu');
      WRITELN('pilotniho signalu stiskni <BR>');
      INLINE("LXI   H,0
             "DAD   SP
             "SHLD  REF(SPSAVE));
      SVBRK:=BREAK;
      BREAK:=REF(5);
      WHILE TRUE DO;
   5: INLINE("LHLD  REF(SPSAVE)
             "SPHL
             "CALL  BELX);
      BREAK:=SVBRK;
      WRITELN('*');
    END;
    REPEAT
      INLINE("MVI   C,DVOJT
             "CALL  REF(61));
      I:=Q^.DELKA;
      INLINE("LDA   REF(I)
             "CALL  REF(51));                         (* DELKA *)
      K:=Q^.TYP;
      I:=Q^.ADRH;     J:=Q^.ADRL;
      INLINE("LDA  REF(I)                    (* ADRESA A TYP *)
             "CALL REF(51)
             "LDA  REF(J)
             "CALL REF(51)
             "LDA  REF(K)
             "CALL REF(51));
      FOR I:=1 TO Q^.DELKA DO                        (* DATA *)
      BEGIN
        J:=Q^.DATA[I];
        INLINE("LDA  REF(J)
               "CALL REF(51));
      END;
      I:=Q^.SUM;
      INLINE("LDA  REF(I)        (* KONTROLNI SOUCET, CR, LF *)
             "CALL REF(51)
             "MVI  C,CR
             "CALL REF(61)
             "MVI  C,LF
             "CALL REF(61));
      Q:=Q+SIZE(MEM)-255+Q^.DELKA;
    UNTIL P=Q;
  UNTIL KONEC;
  WRITELN('Nahravani ukonceno');
999:
(*  IOBYTE:=SAVEIO; *)
  INLINE("JMP  0);
51:INLINE("MOV   E,A                                (* PBYTE *)
          "CALL  KONVP
          "CALL  REF(61)
          "MOV   A,E
          "CALL  KONV1
          "CALL  REF(61)
          "RET);
61:INLINE("MVI   A,3
          "OUT   P55CW
          "MOV   A,C
          "PUSH  B
          "ORI   80H
          "CMA
          "MOV   C,A
          "NOP
          "CALL  CTSE
          "MVI   A,1
          "OUT   P55CW
          "MVI   B,8);
62:INLINE("CALL  CTSE
          "MOV   A,C
          "ANI   1
          "OUT   P55CW
          "MOV   A,C
          "RRC
          "MOV   C,A
          "DCR   B
          "JNZ   REF(62)
          "EI
          "POP   B
          "MOV   A,C
          "CPI   CR
          "CZ    WEIT
          "RET);
END.