unit diskio;
{$R-}
interface

type buftype=array[0..1023] of byte;
     _dpb   = array[0..31]of byte;        { Disk Parameter Block }
     _block = array[0..1023] of byte;
     _pblock = ^_block;
     formrec = record
                ssize     : byte;
                gap1,gap2 : byte;
                scount    : byte;
                tcount    : byte;
                side      : byte;
                track     : byte;
                interl    : byte;
               end;

const systrk: word=8;
var  dpb : _dpb;
     dc  : boolean;

procedure diskreset;
procedure rsect(sct,trk:byte; var buf:buftype; var flag,errc:byte);
procedure wsect(sct,trk:byte; var buf:buftype; var flag,errc:byte);
function  rblk(pblock:_pblock; n:word):byte;
function  wblk(block:_pblock; n:word):byte;
function error(sct,trk,n:byte):char;
procedure simple_error(txt:string);
function diskchange:boolean;
function ftrk(frec:formrec):byte;

implementation
uses crt,screen4,desc;

function error;
var ioc   : char;
    ios   : string[80];
    ios2  : string[8];
begin
 if n=6 then begin
  error:='R';
  exit;
 end;
 wsavescr;
 textattr:=78;
 createmenu(10,16,70,21,40,78,' Сообщения об ошибках ');
 downwin(' <A>, <R>, <I>, <Esc>=Abort ');
 case n of
  2: ios:='Плохой адресный маркер';
  3: ios:='Диск защищен от записи';
  4: ios:='Сектор не найден';
  6: ios:='Смена диска';
  9: ios:='Сбой контроллера ПДП';
  16:ios:='Ошибка в контрольном коде';
 128:ios:='Таймаут';
 $aa:ios:='Диск не готов';
 else str(n,ios);
 end;
 ios:=' Ошибка диска: '+ios;
 str(trk,ios2); ios:=ios+'. Trk='+ios2;
 str(sct,ios2); ios:=ios+', Sct='+ios2+'.';
 wwrite(ios,40,78,78);
 button(21,19,29,11,1,' Abort ');
 button(34,19,44,11,1,' Retry ');
 button(49,19,59,11,1,' Ignore ');
 bell;
 repeat
  ioc:=upcase(chr(wreadkey));
  if ioc=#27 then ioc:='A';
 until ioc in ['A','R','I'];
 error:=ioc;
 diskreset;
 wloadscr;
end;

function diskchange;
var i,j,Disk:byte;
begin
 Disk := 1;
 asm
 mov ah,16h
 mov dl,Disk
 int 13h
 mov i,ah
 mov j,dl
 end;
 diskchange:=false;
 if (i=6) and (j=0) then begin
  diskchange:=true;
  simple_error('Обнаружена смена диска');
 end;
end;

procedure simple_error;
begin
 wsavescr;
 textattr:=78;
 createmenu(12,16,68,21,40,78,' Сообщения об ошибках ');
 downwin(' Любая клавиша ');
 centrwin(1,txt);
 button(34,19,44,11,1,' OK ');
 bell;
 wreadkey;
 wloadscr;
end;

function count(var sct,trk:byte; var n1:byte; n:word):word;
{ Вычисление координат блока }
var i:word;
begin
{ Temporary dada used }
 i:=n*2+n1;
 sct:=1+(i mod 5);
 trk:=systrk + (i div 5);
 count:=i+40;
end;
procedure rsect;
var flg           : byte;
    segbuf,ofsbuf : word;
    erc           : byte;
    disk          : byte;
begin
 mem[0:$490]:=$54;
 disk := 1;
(*

For Disk B type: mem[0:$491 := $54 ].
Simply, this turns the FDC controller to work with DD diskette
which has 80 tracks.

*)

 segbuf:=seg(buf);
 ofsbuf:=ofs(buf);
  asm
   push ds
   push bx
   push bp
   mov es,segbuf
   mov bx,ofsbuf
   mov dl,Disk  (*drive*)
   mov cl,sct   (*sector*)
   mov ch,trk   (*track*)
   mov dh,0
   shr ch,1
   jnc @r
   mov dh,1
@r:mov al,1      (*sector cnt*)
   mov ah,2
   int 13h
   mov erc,ah
   lahf
   mov flg,ah
   pop bp
   pop bx
   pop ds
  end;
  flag:=flg;
  errc:=erc;
end;

procedure wsect;
var flg,erc       : byte;
    segbuf,ofsbuf : word;
    disk          : byte;
begin
 mem[0:$490]:=$54;
 disk := 1;

(* See comment above. *)

 segbuf:=seg(buf);
 ofsbuf:=ofs(buf);
  asm
   push ds
   push bx
   push bp
   mov es,segbuf
   mov bx,ofsbuf
   mov dl,Disk
   mov cl,sct
   mov ch,trk
   mov dh,0
   shr ch,1
   jnc @r
   mov dh,1
@r:mov al,1
   mov ah,3
   int 13h
   mov erc,ah
   lahf
   mov flg,ah
   pop bp
   pop bx
   pop ds
  end;
  flag:=flg;
  errc:=erc;
end;

function ftrk;
var block : array[1..128,0..3] of byte;
    i,j,bs,bo : word;
    s,err: byte;
    side,track:byte;
    disk      : byte;
begin
 mem[0:$490]:=$54;
 disk :=1;

(* See comment above *)

 fillchar(block,512,0);
 s:=0;
 frec.side:=frec.track and 1;
 frec.track:=frec.track shr 1;
 for i:=1 to frec.scount do
 begin
  block[i,0]:=frec.track;
  block[i,1]:=frec.side;
  block[i,2]:=s+1;
  block[i,3]:=frec.ssize;
  s:=(s+frec.interl) mod frec.scount;
 end;
 bs:=seg(block);
 bo:=ofs(block);
 side:=frec.side;
 track:=frec.track;
 asm
  push ds
  push es
  mov es,bs
  mov bx,bo
  mov ah,5
  mov dl,Disk
  mov dh,side
  mov ch,track
  int 13h
  mov err,ah
  pop es
  pop ds
 end;
 ftrk:=err;
end;

function rblk;
{ Temporary data used }
var i,trk,sct:byte;
    buf:buftype;
    flag,errc:byte;
    c: char;
begin
 dc:=false;
 rblk:=0;
 for i:=0 to 1 do begin
  repeat
   count(sct,trk,i,n);
   c:=' ';
   rsect(sct,trk,buf,flag,errc);
   if (errc*(flag and 1))=6 then dc:=true;
   if errc>0 then c:=error(sct,trk,errc);
  until ((errc*(flag and 1))<>6) and (c<>'R');
  if c='A' then begin rblk:=errc; exit end;
  move(buf,ptr(seg(pblock^),ofs(pblock^)+(1024*i))^,1024);
 end;
 if dc then rblk:=6 else if c='A' then rblk:=errc;
end;

function wblk;
{ Temporary data used }
var i,trk,sct:byte;
    buf:buftype;
    flag,errc:byte;
    c: char;
begin
 dc:=false;
 wblk:=0;
 for i:=0 to 1 do begin
  move(ptr(seg(block^),ofs(block^)+(1024*i))^,buf,1024);
  repeat
   count(sct,trk,i,n);
   c:=' ';
   wsect(sct,trk,buf,flag,errc);
   if (errc*(flag and 1))=6 then dc:=true;
   if errc>0 then c:=error(sct,trk,errc);
  until ((errc*(flag and 1))<>6) and (c<>'R');
  if c in ['A',#27] then begin wblk:=errc; exit end;
 end;
 if dc then wblk:=6 else if c in ['A',#27] then wblk:=errc;
end;

procedure diskreset;
begin
 asm
  mov ah,0
  mov dl,0
  int 13h
 end;

 mem[0:$490]:=$54; (* See comment above *)
end;

BEGIN
dc:=false;
END.
