program FloppyDiag;

const   {GLOBALS}                                                                               { .IX }

    SECSIZE     =       128;    {number of bytes per sector}

    ESCAPE      =       $1B;    {Hex for Escape character}
    Escchr      =       '\1B';  {an Escape character}

    NOTRACK     =       FALSE;  {error msg has no track number}
    HASTRACK    =       TRUE;   {error msg has a track number}

    {error return codes from floppy driver interface code}
    GOOD        =       0;      {no error}
    NOFLOPPY    =       1;      {no floppy controller card in slot}
    INVSLOT     =       2;      {invalid slot number}
    DCRCERR     =       3;      {CRC error}
    DWRPROT     =       4;      {floppy write protected}
    DRECNFND    =       5;      {record not found-track or sector}
    DBUSYDV     =       6;      {device is busy}
    DNOTRDY     =       7;      {device not ready}
    DSEEKERR    =       8;      {seek error}
    DWRFAULT    =       9;      {write fault}
    UNKNOWN     =      -1;      {driver returned an unknown error code}

    {error codes not returned but used internal by this program}
    INVSECTOR   =      10;      {invalid sector number}
    MISCOMPR    =      11;      {miscompare of readback data to write data}


    {Msg type numbers}
    SLOTINPUT   =       0;      {msg to get slot input}
    SEEKMSG     =       1;      {msg telling user doing SEEK}
    READMSG     =       2;      {msg telling user doing READ}
    WRITEMSG    =       3;      {msg telling user doing WRITE}
    RDBACKM     =       4;      {msg telling user doing READ-BACK}
    REPEATMSG   =       5;      {msg asking user if want to continue}
    GTSECMSG    =       6;      {msg asking user which sector on track to use}
    CMPRSECS    =       7;      {msg telling user doing compare}

    OpLine      =       4;      {operation message row}
    ErrLine     =       9;      {err msg row}
    Buf1Line    =      15;      {first line of Buffer display}
    LftMarOp    =       4;      {left margin of OpLine message}
    LftMarErr   =      10;      {left margin of ErrLine message}
    LftMarBuf   =       3;      {left margin of first line of Buffer display}
    MAXBUFDSPLINES =    8;      {max number of lines displayed per buffer, 16 bytes per line}

    {tracks used by diagnostic program}
    trk1 =    0;
    trk2 =  $4C;
    trk3 =  $2B;
    trk4 =  $2C;
    trk5 =  $4B;
    NumberTracks =      5;      {number of tracks to do}

type    {GLOBALS}                                                                               { .IX }
    byte = -128..127;
    secbuffer = array[1..SECSIZE] of byte;
    ErrorArray = array[1..SECSIZE] of boolean;
    str40 = string[40];
    dual = record
             case integer of
               0 : (int : integer);
               1 : (bytes : array[0..1] of byte);
             end; {case}

var   {GLOBALS}                                                                                 { .IX }
    SlotNumber : integer;
    Result : dual;
    Continue : boolean;
    track,sector : integer;
    opstr : string[10];

{ External procedures and functions }                                                           { .IX }

FUNCTION Setup( SlNumb : integer ) : integer; {returns error code}
 external;
FUNCTION Seeks( trk1,trk2,trk3,trk4, SlNumb : integer ) : integer; {returns error code & track}
 external;
FUNCTION ReadSec( SlNumb, track, sector : integer; var Buffer : secbuffer ) : integer;
 external;                                                        {returns error code & track}
FUNCTION WriteSec( SlNumb, track, sector : integer; var Buffer : secbuffer ) : integer;
 external;                                                        {returns error code & track}

{debug procedures}                                                                              { .IX }

{ Internal procedures and Functions }

procedure clearscreen;                                                                          { .IX }
{clear the current window}
 Begin
  writeln(Escchr,'J');   {clearscreen}
 End; {clearscreen}

procedure PosCursor(x,y : byte);                                                                { .IX }
{position cursor at x,y}
{ x is columns and y is rows}
const
   GOTOXY =  '\1B=';    {goto x,y escape sequence}
Begin
   write( GOTOXY,chr(x),chr(y) );
End;  {PosCursor}

procedure Clr1line;                                                                             { .IX }
{clear line from current cursor position to end of that line}
Begin
  write(Escchr,'K');
End;  {Clr1line}

procedure Clearlines( row,col : byte; lines : integer );                                        { .IX }
{clear lines number of lines starting at row,col position. }
{ Exit with cursor at row,col.                             }
var
   i : integer;
   r : byte;

Begin
  r := row;
  for i:=1 to lines do begin
    PosCursor(col,r);
    Clr1line;
    r := r+1;
  end; {for}
  PosCursor(col,row);
End;  {Clearlines}

Procedure ClrErrMsg;                                                                            { .IX }
{Clear the err message lines}
Begin
 Clearlines(ErrLine,LftMarErr,2); {clear lines at row 5, starting at column 4, for 2 lines}
End; {ClrErrMsg}

Function trans( ch : char ) : integer;                                                          { .IX }
{translate one char into its integer representation}
Begin
  trans := ord(ch) - ord('0');
End;  {trans}

Procedure header;                                                                               { .IX }
{ clear window and display header message}
 const
     {version information                                                                         .IX }
     VERDATE     =       '04-30-82';     {VERSION DATE}
     VERNUMB     =       'Prelim 0.0.0';        {VERSION NUMBER}

 Begin
   clearscreen;
   writeln('8 inch Floppy drive diagnostic ',VERNUMB,' ',VERDATE);
 End;  {header}

procedure DispGetMsg( MsgType : integer);                                                     { .IX }
{displays messages for a given message type.  Assumes global variables track & sector,}
{and opstr are assigned correct values.                                                        }
Begin
  Clearlines(OpLine,LftMarOp,2);{clear lines at row 2, starting at column 4, for 2 lines}
  case MsgType of
    SLOTINPUT   : write('Enter floppy controller slot number (1-4) :  ');
    SEEKMSG     : write('Doing Seek of Tracks ',trk1:1,' ',trk2:1,' ',trk3:1,' ',trk4:1,' ',trk5:1,'.');
    READMSG     : write('Doing READ of Track ',track:2,' sector ',sector:2,'.');
    WRITEMSG    : write('Doing WRITE of Track ',track:2,' sector ',sector:2,'.');
    RDBACKM     : write('Doing READ-BACK of Track ',track:2,' sector ',sector:2,'.');
    REPEATMSG   : write('Do you want to continue? (Y/N)  ');
    GTSECMSG    : write('Enter sector number for ',opstr,' to be used on Track ',track:2,' : ');
    CMPRSECS    : write('Comparing sector : ',sector:2,' on track : ',track,'.');
  end; {case}

End; {DispGetMsg}

Procedure DspErrorMsg( Reslt : dual; HaveTrack : boolean );                                     { .IX }
{Display error msg for this error code}
Begin
  ClrErrmsg;
  case Reslt.bytes[1] of
      NOFLOPPY  :   write('no floppy controller card in slot.');
      INVSLOT   :   write('invalid slot number.');
      DCRCERR   :   write('CRC error.');
      DWRPROT   :   write('floppy write protected.');
      DRECNFND  :   write('record not found-track or sector.');
      DBUSYDV   :   write('device is busy.');
      DNOTRDY   :   write('device not ready.');
      DSEEKERR  :   write('seek error.');
      DWRFAULT  :   write('write fault.');
      INVSECTOR :   write('invalid sector : ',sector:1,'.  Must be >= 1 or <= 26.');
      MISCOMPR  :   write('data readback differs to data written, errors in inverse video.');
      UNKNOWN   :   write('driver returned an unknown error code.');
      Otherwise :   begin end;
  end; {case}

  if HaveTrack then begin
    PosCursor(LftMarErr,ErrLine+1);
    write('Error on Track :  ',Reslt.bytes[0]:3);
  end;

End; {DspErrorMsg}

Function getslot : integer;                                                                     { .IX }
{ get slot number from user}
 var
   SN : char;
   Err : boolean;
   res : dual;

 function chkslot( SN : char ) : boolean;
 {test if valid slotnumber}
  const
    LowestSN    =  '1';         {range of values low to hi }
    HighestSN   =  '4';         {for SlotNumber            }
  begin
    chkslot := NOT ((SN>=LowestSN) and (SN<=HighestSN));
  end; {chkslot}

Begin {getslot}
  repeat
   DispGetMsg( SlotInput );
   readln(SN);
   Err := FALSE;
   if SN <> Escchr then         {escape means stop}
     if chkslot(SN) then begin  {see if valid SlotNumber}
       Err := TRUE;
       res.int := INVSLOT;
       DspErrorMsg( res,NOTRACK );
     end;
  until(Not Err);

  if SN <> Escchr then
     getslot := trans( SN )
  else
     getslot := ESCAPE;

End;  {getslot}

Function CheckError( Reslt : dual ) : boolean;                                                  { .IX }
{ determine if have error from floppy routines}
Begin
  CheckError := Reslt.bytes[1] <> GOOD;
END; {CheckError}

Function DoAgain : boolean;                                                                     { .IX }
{ask user if they want to continue with the program}
var
   ans : char;
   ok : boolean;

Begin
  DispGetMsg( REPEATMSG );
  readln(ans);
  ok := ( (ans='y') or (ans='Y') );
  if ok then ClrErrMsg;
  DoAgain := ok;
End; {DoAgain}

Function GetTrack( trackNumber : integer ) : integer;                                           { .IX }
{ returns the track number for this pass}
{uses the Global constants trk1,trk2,trk3,trk4,trk5}
Begin
  case trackNumber of
    1 : GetTrack := trk1;
    2 : GetTrack := trk2;
    3 : GetTrack := trk3;
    4 : GetTrack := trk4;
    5 : GetTrack := trk5;
    Otherwise : begin
                end;
  end; {case}
end; {GetTrack}

Function GetSector( var sector : integer ) : boolean;                                           { .IX }
{gets sector number to read on this pass}
{calls DispGetMsg which assumes global variable track}
{is already assigned a valid track number.}
var
   Continue,Err : boolean;
   res : dual;

 function chksecnumber( sector : integer ) : boolean;
 {test if valid sector number. return true if error}
  const
    Lowestsec   =   1;         {range of values low to hi }
    Highestsec  =  26;         {for SectorNumbers         }
  begin
    chksecnumber := (sector<Lowestsec) or (sector>Highestsec);
  end; {chkslot}

Begin {GetSector}
  Continue := TRUE;
  repeat
    DispGetMsg( GTSECMSG );
    readln( sector );
    Err := chksecnumber( sector );
    if Err then begin
      res.int := INVSECTOR;
      DspErrorMsg( res,NOTRACK );
      Continue := DoAgain;
    end;
  until( (NOT Continue) or (NOT Err) );

  GetSector := Continue;

End;  {GetSector}

Function DoSlot( var SlotNumber : integer ) : boolean;                                          { .IX }           { .IX }
{get slot number into SlotNumber.  returns whether user wants to stop or continue}
{with diagnostic.                                                                }
var
   Continue : boolean;
   Result : dual;

Begin
  Continue := TRUE;  {Assume user wants to continue}

  repeat
    SlotNumber := getslot;

    if SlotNumber = ESCAPE then
      Continue := FALSE
    else begin
      Result.int := Setup(SlotNumber );  {verify floppy in slot}
      if CheckError( Result ) then begin {if error display msg}
        DspErrorMsg( Result,NOTRACK );
        Continue := DoAgain;             {and see if user wants to continue}
      end;
    end;
  until ( Result.int = 0 ) or ( NOT Continue );

  DoSlot := Continue;

End; {DoSlot}


Function DoSeek( SlotNumber : integer ) : boolean;                                              { .IX }
{Seek tracks 0,4C,2B,2C,4B}
{uses Global constants for track numbers}
var
   Continue : boolean;
   Result : dual;

Begin  {DoSeek}
  Continue := TRUE;
  repeat
    DispGetMsg( SEEKMSG );      {tell user what doing}
    Result.int := Seeks( trk2, trk3, trk4, trk5, SlotNumber );   {does restore command first}
    if CheckError( Result ) then begin {if error display error msg}
      DspErrorMsg( Result,HASTRACK );
      Continue := DoAgain;             {and see if user wants to continue}
    end;
  until ( Result.int = 0 ) or ( NOT Continue );

  DoSeek := Continue;

End;  {DoSeek}

Function DoRead( SlotNumber : integer ) : boolean;                                              { .IX }
{Read the same sector number on tracks 0,4C,2B,2C,4B}
{uses Global variables track , sector and opstr.    }
var
   Continue : boolean;
   pass : integer;
   Result : dual;
   Buffer1 : secbuffer;

Begin
  Continue := TRUE;
  pass := 1;
  opstr:= 'Read';

  repeat
    track := GetTrack( pass );        {get value for global variable track}
    sector := 10;  (*Continue := GetSector( sector );*){sector is a var parameter, uses track}
    if Continue then begin
      DispGetMsg( READMSG );      {tell user what doing}
      Result.int := ReadSec( SlotNumber,track,sector,Buffer1 );
      if CheckError( Result ) then begin {if error display error msg}
        DspErrorMsg( Result,HASTRACK );
        Continue := DoAgain;             {and see if user wants to continue}
      end;
    end;
    pass := pass+1;
  until ( pass>NumberTracks ) or ( NOT Continue );

  DoRead := Continue;

End;  {DoRead}

Procedure DoWriteVerify( SlotNumber : integer );                                               { .IX }
{Write then read back the same sector number on tracks 0,2B,2C,4B,4C.}
{uses Global variables track, sector and opstr.                      }
var
   Continue : boolean;
   Buffer1 : array[1..NumberTracks] of secbuffer;
   Buffer2 : array[1..NumberTracks] of secbuffer;
   sectors : array[1..NumberTracks] of integer;
   i : integer;

 Procedure BuildBuffer1( var buf : secbuffer; val : byte );                                    { .IX }
 var
   k : integer;
 Begin
   for k := 1 to SECSIZE do begin
     buf[k] := val;
     if val=127 then val := -128 else val := val+1;
   end;
 End;{BuildBuffer1}

 Function getpattern( element : integer ) : byte;                                              { .IX }
 var
   x : integer;
 Begin
   case element of
     1 : x := $AA;
     2 : x := $55;
     3 : x := $1A;
     4 : x := $E5;
     5 : x := $33;
     Otherwise : x := $CC;
   end;

   if x > 128 then getpattern := x-256 else getpattern := x;

 End; {getpattern}

 Function WriteOutSectors : boolean;                                                           { .IX }
 {write 5 sectors to the defined tracks}
 {uses Buffer1, sectors as globals}
 var
   Continue : boolean;
   pass : integer;
   Result : dual;

 Begin
   pass := 1;
   opstr := 'Write';

   repeat
     repeat
       track := GetTrack( pass );        {get value for global variable track}
       Continue := TRUE; (* GetSector( sector );*){sector is a var parameter, uses track}
       sector := 10; (* temp *)
       if Continue then begin
         sectors[pass] := sector;     {keep track of which sector used}
         DispGetMsg( WRITEMSG );      {tell user what doing}
         Result.int := WriteSec( SlotNumber,track,sector,Buffer1[pass] );
         if CheckError( Result ) then begin {if error display error msg}
           DspErrorMsg( Result,HASTRACK );
           Continue := DoAgain;             {and see if user wants to continue}
         end;
       end;
     until ( Result.int = 0 ) or ( NOT Continue );
     pass := pass+1;
   until( (NOT Continue) or (pass>NumberTracks) );

   WriteOutSectors := Continue;

 End; {WriteOutSectors}

 Function ReadBackSectors : boolean;                                                           { .IX }
 {read back the 5 sectors written by Write5Sectors.}
 {uses Buffer2, sectors as globals}
 var
   Continue : boolean;
   pass : integer;
   Result : dual;

 Begin
   pass := 1;
   repeat
     repeat
       track := GetTrack( pass );        {get value for global variable track}
       sector := sectors[pass];
       DispGetMsg( RDBACKM );      {tell user what doing}
       Result.int := ReadSec( SlotNumber,track,sector,Buffer2[pass] );
       if CheckError( Result ) then begin {if error display error msg}
         DspErrorMsg( Result,HASTRACK );
         Continue := DoAgain;             {and see if user wants to continue}
       end;
     until ( Result.int = 0 ) or ( NOT Continue );
     pass := pass+1;
   until( (NOT Continue) or (pass>NumberTracks) );

   ReadBackSectors := Continue;

 End; {ReadBackSectors}

 Procedure CmprSectors;                                                                          { .IX }
 {compare Buffer1 to Buffer2 for Miscompares}
 {report all miscompares to user.           }
 {uses Buffer1,Buffer2, sectors as globals}
 var
   i : integer;
   Continue : boolean;
   MisCmpares : ErrorArray;

  Procedure Cmp1to2( Buf1,Buf2 : secbuffer; var Errors : ErrorArray );                         { .IX }
  {Compare Buffer1 to Buffer2 looking for miscompares}
  var
    i : integer;
  Begin
    for i := 1 to SECSIZE do
      Errors[i] := (Buf1[i] <> Buf2[i]) ;
  End;  {Cmp1to2}

  Function DspMisCmp( Bufnumber : integer; Errors : ErrorArray ) : boolean;                    { .IX }
  {Display Buffer1 and Buffer2.  Display any miscompares in inverse video}
  {if had an miscompare ask user if want to continue.}
   { the buffer display                                                                           .IX

                   INFORMATION WRITTEN                              INFORMATION READ BACK
                   -------------------                              ---------------------

   00    0123 4567 89AB CDEF 0123 4567 89AB CDEF     00    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   10    0123 4567 89AB CDEF 0123 4567 89AB CDEF     10    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   20    0123 4567 89AB CDEF 0123 4567 89AB CDEF     20    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   30    0123 4567 89AB CDEF 0123 4567 89AB CDEF     30    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   40    0123 4567 89AB CDEF 0123 4567 89AB CDEF     40    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   50    0123 4567 89AB CDEF 0123 4567 89AB CDEF     50    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   60    0123 4567 89AB CDEF 0123 4567 89AB CDEF     60    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   70    0123 4567 89AB CDEF 0123 4567 89AB CDEF     70    0123 4567 89AB CDEF 0123 4567 89AB CDEF

   }
  var
    Error : boolean;
    dsplyline : byte;
    line, index : integer;
    r : dual;

   Function ChngErr( NewErr, ErrState : boolean ) : boolean;                                   { .IX }
    Begin
     if ( NewERR and ( NOT ErrState ) ) then ChngErr := TRUE
                                        else ChngErr := ErrState;
    End; {ChngErr}

   Function DspBufHeader( dline : byte ) : byte;                                              { .IX }
   {display buffer display header.  update row position and return.}
   Begin
     PosCursor( 0, dline ); {start flush against window}
     writeln('                    INFORMATION WRITTEN                              INFORMATION READ BACK');
     writeln('                    -------------------                              ---------------------');
     DspBufHeader := dline+2;  {begin of first line display area}
   End;  {DspBufHeader}

   Function DspBufLine(  Bufnumber, line : integer; dline : byte; var index : integer ) : boolean;   { .IX }
   {display 16 bytes of each Buffer on row <dline>.}
   {returns true if any miscompares.  Displays miscompares}
   {in inverse video.  Uses Errors globally.            }
    type
       nibble = 0..15;
       nibs =packed record
                    case integer of
                        0 : (b : byte);
                        1 : (n : packed array[0..1] of nibble);
                    end;
    var
      i,k : integer;
      lm1,lm2 : byte;
      mc,flg : boolean;
      str1,str2 : string[45];
      bits : nibs;

      Function cnv( a : nibble ) : char;
       Begin
        if a>9 then cnv:= chr( (a-10) + ord('A') )
               else cnv:= chr( a + ord('0') );
       End; {cnv}

       Procedure writeBlank( var lm1,lm2 : byte; dline : byte );
       var
         x : byte;
         i : integer;
       Begin
         for i:=1 to 2 do begin
          if i=1 then x := lm1 else x := lm2;
          PosCursor( x,dline );
          write(' ');
         end;
         lm1 := lm1+1; lm2 := lm2+1;
       End; {writeBlank}

    Begin {DspBufLine}
      mc := FALSE;
      str1 := '00    0123456789ABCDEF0123456789ABCDEF';
      str2 := str1;

      str1[1] := chr( (line-1) + ord('0') );    {change which 16 bytes being displayed}
      str2[1] := str1[1];

      k := 7; {position in Buffer1 string of next byte}
      for i := 0 to 15 do begin
         bits.b :=  Buffer1[Bufnumber,i+index];
         str1[k] := cnv( bits.n[1] );
         str1[k+1] := cnv( bits.n[0] );
         k := k+2;
      end;

      k := 7; {position in Buffer2 string of next byte}
      for i := 0 to 15 do begin
         bits.b := Buffer2[Bufnumber,i+index];
         str2[k] := cnv( bits.n[1] );
         str2[k+1] := cnv( bits.n[0] );
         k := k+2;
      end;

      lm1 := LftMarBuf;
      lm2 := LftMarBuf+LENGTH(str1)+4+7;

      PosCursor(lm1,dline);
      write( COPY( str1,1,6) );
      PosCursor(lm2,dline);
      write( COPY( str2,1,6) );

      lm1 := lm1+6;
      lm2 := lm2+6;

      k := 7; {position in Buffer1 string of next byte}
      flg := TRUE;
      for i := 0 to 15 do begin
        if Errors[i+index] then write('\1BG4'); {set inverse video if error}
        mc := ChngErr( Errors[i+index], mc );
        PosCursor(lm1,dline);
        write( COPY( str1,k,2) );
        PosCursor(lm2,dline);
        write( COPY( str2,k,2) );
        lm1 := lm1+2; lm2 := lm2+2;
        k := k+2; flg := NOT flg; if flg then writeBlank(lm1,lm2,dline);
        write('\1BG0');
      end;

      index := index+16;
      DspBufLine := mc;

    End; {DspBufLine}

  Begin  {DspMisCmp}                                                                           { .IX }
    Error := FALSE; line := 1; index := 1;
    dsplyline := Buf1Line;                   {init cursor pos variable to first line of Buffer display.}
    dsplyline := DspBufHeader( dsplyline );  {display header}
    repeat               {for each line of display : display the line with miscompares in inverse video}
        {if any miscompares set Error flag} {Display 1 line of buffer1 and buffer2.}
        Error := ChngErr( (DspBufLine( Bufnumber, line, dsplyline, index)), Error);
        line := line+1;
        dsplyline := dsplyline+1;
    until( line>MAXBUFDSPLINES );

    if Error then begin
      r.int := MISCOMPR;
      DspErrorMsg( r, NOTRACK );
      DspMisCmp := DoAgain
    end else
      DspMisCmp := TRUE;

  End;  {DspMisCmp}

 Begin {CmprSectors}                                                                           { .IX }
   i := 1;
   repeat
     sector := sectors[i]; track := GetTrack(i);
     DispGetMsg( CMPRSECS );
     Cmp1to2( Buffer1[i], Buffer2[i], MisCmpares ); {find miscompares}
     Continue := DspMisCmp( i, MisCmpares );  {display buffers with errors, if error ask if want to continue.}
     i := i+1;                                {next sector buffers to compare}
   until( (NOT Continue) or (i>NumberTracks) );

 End;  {CmprSectors}

Begin  {DoWriteVerify}                                                                           { .IX }
  {write out NumberTracks sectors}
  for i := 1 to NumberTracks do
    BuildBuffer( Buffer1[i],getpattern(i) );
  Continue := WriteOutSectors;
  if Continue then begin
    {read back all sectors written}
    Continue := ReadBackSectors;
    if Continue then
      {compare what was written with what was read}
      CmprSectors;
  end;
End;  {DoWriteVerify}

BEGIN  {FloppyDiag}                                                                             { .IX }

  header;

  Continue := DoSlot( SlotNumber );     {slot number is a var parameter}

  if Continue then begin
    Continue := DoSeek( SlotNumber );           {seek tracks}
    if Continue then begin
      Continue := DoRead( SlotNumber );         {read sectors}
      if Continue then DoWriteVerify( SlotNumber );   {write then read back verify sectors}
    end;
  end;

END.