{.HE Unidisk 3.5 800K floppy formatting program}
program unifmt;
{
   This program is used to format 800K disks in Applicard CP/M.
   It also has the capability of performing confidence tests
   on the 800K drive and controller and Applicard driver.

   Written by : Bob Fillmore  April/87
                c/o IAD BBS @ (613) 952-2289
}
const
  debug = false;       { Debug messages if true }
  defunit = 2;         { Default unit designator. 0=A, 1=B, 2=C, etc. }
  pause = false;       { Pause for each read/write if true }
  secsize = 512;       { Host sector size }

type
  secbuft = array[0..511] of byte;     { Sector buffer }

var
  alcsizk : integer;            { Allocation unit size in kb }
  i : integer;
  keyin : char;
  code : byte;                  { Return code from driver }
  dirsecs : integer;            { Number of directory sectors }
  track, sector : byte;         { Current track and sector number }
  secbuf : secbuft;             { Sector buffer }
  sectrk : integer;             { Sectors per track }
  tracks : integer;             { Tracks per disk }
  ualcmsk : integer;            { Allocation mask }
  ublkshf : byte;               { Block shift factor }
  ublkmsk : byte;               { Block mask }
  uchksiz : integer;            { Check size }
  udirofs : integer;            { Directory offset (tracks) }
  udirsiz : integer;            { Directory size -1 (entries) }
  udsksiz : integer;            { Disk size -1 in alloc blks }
  uextmsk : byte;               { Extent mask }
  unit : byte;                  { Unit number 0=A etc. }
  unitc : char;                 { Unit character A,B,C, etc. }
  uname : string[15];           { Unit driver name }
  urecalc : byte;               { CP/M records per alloc blk }
  urecblk : byte;               { CP/M records per host blk }
  urectrk : integer;            { CP/M records per track }
  usecmsk : byte;               { Sector mask }
  usecshf : byte;               { Sector shift count }
  usecsz : integer;             { Sector size (bytes) }

procedure title;      { Clear screen and put up title }
begin
  clrscr;
  writeln('Unidisk 3.5 Disk Formatter  V1.0'); writeln;
end;

procedure rdbyte(var byt : byte);   { Read a byte from the 6502 }
var
  b : byte;
begin
  inline( $CD/$FFE0/        (*  CALL $FFE0  READ HOST BYTE *)
          $32/B             (*  LD  BYT,A   *)
        );
  byt := b;
end;

procedure rdword(var wrd : integer);   { Read a word from the 6502 }
var
  lo, hi : byte;
begin
  rdbyte(lo);
  rdbyte(hi);
  wrd := hi*256 + lo;
end;


procedure wrbyte(byt:byte);            { Write a byte to the 6502 }
begin
  inline( $3a/byt/          (*  LD  A,BYT   *)
          $4F/              (*  LD  C,A     *)
          $CD/$FFE3         (*  CALL $FFE3  WRITE HOST BYTE *)
        );
end;

procedure wrword(wrd:integer);         { Write a word to the 6502 }
var
  lo,hi : byte;
begin
  lo := wrd mod 256;
  hi := wrd div 256;
  wrbyte(lo);
  wrbyte(hi);
end;

procedure rdcode;        { Read the return code from the driver }
begin
  rdbyte(code);
  if code<>0 then begin  { Return code indicates an error }
    write(' -- Unit ',unitc,':  -- ');
    case code of
      $27: writeln('I/O Error or bad block number');
      $28: writeln('No device connected');
      $2B: writeln('Disk is write protected');
      else writeln('Driver error ',code);
      end;
    end; { Error }
end;

procedure unitinfo;      { Fetch and display info about selected unit }
var
  len : byte;
begin
  title;
  uname := '';
  wrbyte($83+unit*4);         { Other }
  wrbyte(15);                 { Get driver name }
  rdbyte(len);
  for i := 1 to len do begin rdbyte(code); uname:=uname+chr(code); end;
  rdcode;
  wrbyte($83+unit*4);         { Other }
  wrbyte(0);                  { Get disk parameters }
  wrbyte(unit);
  rdword(usecsz);   { Sector size }
  rdword(urectrk);  { CP/M rec/trk }
  rdbyte(urecblk);  { CP/M rec/hostblk }
  rdbyte(urecalc);  { CP/M rec/alloc blk }
  rdbyte(usecmsk);  { Sector mask }
  rdbyte(usecshf);  { Sector shift count }
  rdword(urectrk);  { CP/M rec/trk }
  rdbyte(ublkshf);  { Blk shift factor }
  rdbyte(ublkmsk);  { Blk shift mask }
  rdbyte(uextmsk);  { Extent mask }
  rdword(udsksiz);  { Disk size-1 in alloc blks }
  rdword(udirsiz);  { Directory size - 1 (entries) }
  rdword(ualcmsk);  { Allocation mask }
  rdword(uchksiz);  { Check size }
  rdword(udirofs);  { Directory offset }
  rdcode;
  sectrk := urectrk div urecblk;
  tracks := ((udsksiz+1)*urecalc) div urectrk;
  dirsecs := ((udirsiz+1)*32) div usecsz;
  if dirsecs > sectrk then begin
    writeln(' ** Directory size exceeds one track');
    end;
  writeln('Unit ',unitc,':            Driver name : ',uname);
  writeln('                   Sector size : ',usecsz);
  writeln('            CP/M records/track : ',urectrk);
  writeln('       CP/M records/host block : ',urecblk);
  writeln(' CP/M records/allocation block : ',urecalc);
  writeln('                   Sector mask : ',usecmsk);
  writeln('            Sector shift count : ',usecshf);
  writeln('            Block shift factor : ',ublkshf);
  writeln('              Block shift mask : ',ublkmsk);
  writeln('     Disk size in alloc blocks : ',udsksiz+1);
  writeln('      Directory size (entries) : ',udirsiz+1);
  writeln('               Allocation mask : ',ualcmsk);
  writeln('                    Check size : ',uchksiz);
  writeln('              Directory offset : ',udirofs);
  gotoxy(50,4); writeln('Sectors per track : ',sectrk);
  gotoxy(50,5); writeln('   Tracks on disk : ',tracks);
  gotoxy(50,6); writeln('Directory sectors : ',dirsecs);
  alcsizk := (urecalc * 128) div 1024;
  gotoxy(50,7); writeln('  Allocation unit : ',alcsizk,'K');
  gotoxy(50,8); writeln('    Disk capacity : ',(udsksiz+1)*alcsizk,'K');
  gotoxy(1,17);
end;

procedure readsec;      { Read a host sector }
begin
  if debug then writeln('Reading track ',track,' sector ',sector);
  if pause then begin writeln('  press RETURN to continue'); readln; end;
  wrbyte($81+unit*4);        (* read *)
  wrword(secsize);           (* bytes to read *)
  wrbyte(unit);              (* drive *)
  wrword(track);             (* track *)
  wrword(sector);            (* sector *)
  for i := 0 to secsize-1 do
    rdbyte(secbuf[i]);
  rdcode;
end;

procedure writesec;     { Write a host sector }
begin
  if debug then writeln('Writing track ',track,' sector ',sector);
  if pause then begin writeln('  press RETURN to continue'); readln; end;
  wrbyte($82+unit*4);        (* write *)
  wrword(secsize);           (* bytes to write *)
  wrbyte(unit);              (* drive *)
  wrword(track);             (* track *)
  wrword(sector);            (* sector *)
  for i := 0 to secsize-1 do
    wrbyte(secbuf[i]);
  rdcode;
end;

procedure credir;          { Create the CP/M directory }
begin
  writeln; writeln('Creating CP/M directory..');
  for i := 0 to secsize-1 do secbuf[i] := $e5;
  track := udirofs;
  for sector := 0 to dirsecs-1 do writesec;
  writeln('Directory created.');
end;

procedure testmap;        { Test mapping of track/sector to block }
begin
  writeln;
  writeln('Testing track/sector mapping..');
  writeln('  writing every sector');
  for track := 0 to tracks-1 do begin
    writeln('    writing track ',track);
    for i := 0 to (secsize div 2)-1 do secbuf[i*2] := track;
    for sector := 0 to sectrk-1 do
      begin
        for i := 1 to (secsize div 2)-1 do secbuf[i*2-1] := sector;
        writesec;
      end;
    end;
  writeln('  reading every sector');
  for track := 0 to tracks-1 do begin
    writeln('    reading track ',track);
    for sector := 0 to sectrk-1 do
      begin
        readsec;
        if (track<>secbuf[0]) or (sector<>secbuf[1]) then begin
          writeln('Track ',track,' sector ',sector,
            ' reads as ',secbuf[0],'/',secbuf[1]);
          end;
        for i := 2 to (secsize div 2)-1 do
          if (secbuf[i*2-2]<>track) or (secbuf[i*2-1]<>sector) then
            writeln('   track ',track,' sector ',sector,' data lost');
      end;
    end;
  writeln('Track/sector mapping test complete.');
end;

procedure lowlevel;     { Perform low-level formatting of disk }
begin
  write('Low-level formatting..');
  wrbyte($83+unit*4);  (* other function *)
  wrbyte($01);         (* format *)
  wrbyte(unit);        (* drive  *)
  rdcode;
  if code<>0 then halt;  { Can't get at the hardware }
  writeln('  complete.');
end;

begin      { Unifmt }
  title;
  unit := defunit;
  unitc := chr(unit+ord('A'));
  repeat
    write('Enter unit (',chr(unit+ord('A')),' or ',chr(unit+1+ord('A')),
      ', default is ',chr(unit+ord('A')),') : ');
    readln(keyin); if ord(keyin)=26 then keyin := chr(unit+ord('A'));
    if (ord(keyin)>=ord('a')) and (ord(keyin)<=ord('z')) then
      keyin := chr(ord('A')+ord(keyin)-ord('a'));
  until (keyin=unitc) or (keyin=chr(unit+1+ord('A')));
  unit := ord(keyin) - ord('A');
  unitc := keyin;
  unitinfo;
  gotoxy(45,12); writeln('1) Format disk');
  gotoxy(45,13); writeln('2) Test driver and data integrity');
  gotoxy(45,14); writeln('3) Quit');
  gotoxy(45,16); write('Enter option: ');
  readln(keyin);
  case keyin of
  '1': begin  (* format disk *)
         lowlevel;     (* do low-level formatting *)
         credir;       (* create directory *)
       end;
  '2': begin  (* test disk *)
         lowlevel;     (* do low-level formatting *)
         testmap;      (* test trk/sec mapping *)
       end;
  end;
  writeln('Formatting complete.');
end.