program readOS9(input,output);

(* this version for Turbo Pascal 3.xx *)
(* to read double density 5.25" OS9 disks *)
(* note that one "standard" has single density track 0 *)
(* however, the pc clones can not handle this with just *)
(* ROM BIOS calls *)
const
  yankfile  : string[40] = 'YANKEE.IMP' ;
  (* DD.FMT bits *)
  DSIDED    =$1;
  DDENSITY  =$2;
  TRK96     =$4;

  (* FD.ATT bits *)
  ATTread = $1;
  ATTwrite =$2;
  ATTexe   =$3;
  ATTprivate = $7; { any private attributes }
  ATTPread =   $4;
  ATTPwrite=   $8;
  ATTPexe =    $20;
  ATTPublic = $1C; { any public attribute }
  ATTsingle = $40;
  ATTdirect = $80;

  (* floppy rom stuff *)
    short  = 1000; { delays for pauses }
    medium = 2000;
    long   = 3000;
    buffersize = $3000; { 12k buffer space }
    MAXTRIES   = 2;     { number of times to try diskio before giving up }
    maxdirs    = $400;  { maximum number of directory entries }
    drivemax   = 4;
    getintrp   = $35;   { dos 21 int functions }
    setintrp   = $25;

    disktable  = $1E;   { disk parameter block has address stored here }
    equip      = $11;

    diskio     = $13;   { does the dirty work }
    diskreset  = $00;   { put one of these in ah for intr $13 }
    diskstatus = $01;
    diskread   = $02;
    diskwrite  = $03;
    diskverify = $04;
    diskformat = $05;
    onesector  = $01;  { in al }
    phys256    = $1 ;
    carryflag  = $01;

    MAXsector  = 40;   { max sector number on a track }
    driveflag  = $00c1;
type

   registers  = record    { predeclared in TURBO 4.0 }
                case integer of
                0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
                1: (AL,AH,BL,BH,CL,CH,DL,DH : byte;);
                end;
   buf16      = array[0..15] of byte;
   buf16ptr   = ^buf16; (* one line of display *)
   buf256     = array[0..255] of byte; (* one sector of os-9 *)
   buf256ptr  = ^buf256;
   buffertype = array[0..buffersize] of byte;
   bufferptr  = ^buffertype;
   nstring    = string[255];
   paramsptr  = ^params;
   params = record     { disk parameter block }
                       { don't change for 512 byte disks }
              dmode1 : byte;
              dmode2 : byte;
              clocktick : byte;
              bytesector : byte; { 0..3 128..512 }
              lastsector : byte;
              gaplen : byte;
              datalen : byte;
              gaplenformat : byte;
              formatchar : byte;
              headsettle : byte;
              motorstart : byte;
            end;

   fourbyte = record
              b3,b2,b1,b0 : byte;
              end;

   threebyte = record
               b2,b1,b0 : byte;
               end;

   twobyte  = record
                b1,b0 : byte;
                end;

   daterec = record
              year, month, day : byte;
             end;

   timerec = record
               year, month,day,hour,minute : byte;
             end;

   hi32str = array[0..31] of byte; { OS9 string is terminated by high bit set}
   hi29str = array[0..28] of byte;
   segalloc = record
                LSN : threebyte;
                numsec : twobyte;
             end;

   file_descript = record
                 ATT : byte;
                 OWN : twobyte;
                 DAT : timerec;
                 lnk : byte;
                 siz : fourbyte;
                 create : daterec;
                 segg : array[0..47] of segalloc;
                end;

   ID_Sector = record
                 tot : threebyte;
                 tks : byte;
                 map : twobyte;
                 bit : twobyte;
                 dir : threebyte;
                 own : twobyte;
                 att : byte;
                 dsk : twobyte;
                 fmt : byte;
                 spt : twobyte;
                 res : twobyte;
                 bt : threebyte;
                 bsz : twobyte;
                 dat : timerec;
                 nam : hi32str;
                 end;
   Id_Sector_ptr = ^Id_Sector;

   dir_entry = record { 32 bytes per entry }
               name: hi29str;
               { stops on hibit, 0 in first spot for unused }
               descriptor : threebyte;
               end;
var
    buffercount   : integer;
    secsize       : integer;
    buffer        : bufferptr;
    drivenumber   : byte;
    oldROMparams  : paramsptr;
    myROMparams   : params;
    saveROMparams : params;
    ulsn0         : ^id_sector;
    myboot        : id_sector;
    os9volume     : nstring;
    os9dir        : nstring;
    logged        : boolean;
    final_exit    : boolean;
    yfile         : file;

function bits (x : byte) : integer;
{ number of bits in x which are 1 }
var test,i,j : integer;
begin
  test:=1;
  i:=0;
  for j:=1 to 8 do begin
   if (x and test) <> 0 then i:=i+1;
   test:=test*2;
  end;
  bits:=i;
end; { bits }

procedure makeupper(var s : nstring);
var i,n : integer;
begin
   n:=length(s);
   for i:=1 to n do s[i]:=upcase(s[i]);
end; (* make upper *)

const
   hexint : string[16] = '0123456789ABCDEF';


procedure puthex( n : byte);
begin
     write(hexint[ (n and $0F) + 1]);
end;  { puthex }

procedure putbyte (n : byte);
var
   hinibble  : byte;
   lownibble : byte;
begin
   hinibble:= n div 16;
   lownibble:= n mod 16;
   puthex(hinibble);
   puthex(lownibble);
end; { puthex }


procedure putoctal(x : byte );
begin
    write( x div 64 );
    write ( ( x mod 64 ) div 8);
    write ( x mod 8);
 end;


procedure putword( n: integer );
begin
   putbyte(hi(n));  { use Turbo intrinsics hi and lo }
   putbyte(lo(n));
end; { putword }

procedure putwordrev(n : integer);
begin
    putbyte(lo(n));
    putbyte(hi(n));
end;

procedure putbinary( x : byte );
var i,j : integer;
begin
     j:=$80;
     for i:=0 to 7 do begin
        if (j and x) <> 0 then write('1') else write('0');
        j:=j div 2;
     end; { i }
end; { putbinary }



procedure puthexln( z : integer; u : buf256);
{ print 16 bytes, with label starting at z}
var i,j,w : integer;
begin
     putword(z);
     write('   ');
     for i:=0 to 3 do begin
          for j:=0 to 3 do begin
             w:=u[ j + 4*i];
             putbyte(w);
          end; { j }
          write(' ');
     end; { i }
 end; { puthexln }

function makeascii( x : byte ) : char;
begin
   x:= x and 127;
   if (x < 32) or (x = 127) then x:=46;
   makeascii:= chr(x);
end; { makeascii }

procedure putasciiln( u : buf256 );   { displays 16 bytes of memory in ascii }
var i,w : integer;
begin
  write(' * ');
  for i:=0 to 15 do begin
     w:=u[i];
     write(makeascii(w));
  end; {i}
  writeln(' *');
end; { putasciiln }

procedure hexdisplay( z : integer; u : buf256ptr);
{ displays z bytes, up to 256  }
var i,index,jj : integer;
    v : buf256ptr;
begin
    v:=u;
    if ((z mod 16) = 0) then
       index:=(z div 16)-1
    else index :=z div 16;
    writeln('       0        4        8        C             Ascii');
    jj:=0;
    for i:=0 to index do begin
       puthexln( 16*i, v^);
       putasciiln(v^);
       jj:=jj+16;
       (* now increment pointer u by 16 *)
       v:=addr(u^[jj]);
       (* slightly sleasy *)
    end; { i }
end; { hexdsply }



procedure conv32tostr(var t : hi32str; s : nstring);
var i : integer;
begin
  i:=0;
  s:='';
  repeat
    if (i < 32) then s:=s+chr((t[i]) and $7f) ;
    i:=i+1;
 until ( (t[i] and $80) <> 0 ) or ( i > 32);
end; { convert os9 strings to turbo strings }

procedure conv29tostr(var t : hi29str; s : nstring);
var i : integer;
begin
  i:=0;
  s:='';
  repeat
    if (i < 29) then s:=s+chr((t[i]) and $7f) ;
    i:=i+1;
 until ( (t[i] and $80) <> 0 ) or ( i > 29);
end; { convert os9 strings to turbo strings }


procedure initialize;
begin
  os9volume:='';
  os9dir:='ROOT';
  logged:=false;
  final_exit:=false;
end;

procedure putnibble(x: integer);
begin
   x:=x and $0f;
   write(hexint[x+1]);
end;

procedure dputbyte( x: integer);
begin
   x:= x and $ff;
   putnibble((x and $f0) shr 4);
   putnibble( x and $0f);
end;

function three2real( three : threebyte ): real;
var x : real;
begin
   x:= ( 1.0*three.b0) + (256.0*three.b1) + (65536.0*three.b2);
   three2real:=x;
end; { three2real }

function three2int( three : threebyte ) : integer;
var x : integer;
begin
  x:=three.b0 or (three.b1 shl 8);
  if three.b2 <> 0 then x:=x or $8000; (* make it negative as error *)
  three2int:=x;
end;

function byte2binary(x : byte) : nstring;
var j,i,y : byte;
    s : nstring;
begin
    j:=128;
    s:='';
    for i:=0 to 7 do begin
      y := j and x;
      if y <> 0 then s:=s + '1';
      if y = 0 then  s:=s + '0';
      j:=j div 2;
    end;
    byte2binary:=s;
end; { byte2string }


function two2real(  two : twobyte): real ;
var x : real;
begin
  x:=(two.b0*1.0)  + (two.b1*256.0);
  two2real:=x;
end; { two2integer }

function two2int(two : twobyte) : integer;
var x : integer;
begin
  x:= two.b0 or (two.b1 shl 8);
  two2int:=x;
end; { two2int }

function getstring( p : hi32str) : nstring;
var i, myofs,myseg : integer;
    s : nstring;
begin
  s:='';   i:=0;
  repeat
    s:= s + chr( p[i] and $7f) ;
    i:=i+1;
  until (i=32) or ( ( p[i-1] and $80 ) <> 0);
  getstring:=s;
 end; { getstring }


function readkey : char;
var ch : char;
begin
  read(kbd,ch);
  readkey:=ch;
end; { readkey }

procedure presscrlf;
var ch : char;
begin
  writeln;clreol;
  writeln('Press <CR> to continue.');
  repeat
     ch:=readkey;
  until ch=#$0d;
  writeln;
end; { presscrlf }

procedure insertdisk;
begin
  writeln;
  writeln('Insert diskette in drive ',chr(65+drivenumber),': ');
  presscrlf;
end; { insertdisk }


function checkabort : boolean;
{ check keyboard , if no key pressed, return false }
{ if ^C or ^Z, return true }
{ if ^S return false after getting next char }
var ch,ch1 : char;

begin
  checkabort:=false;
  if keypressed then begin
     ch:=readkey;
     case ch of
      ^C,^Z : checkabort:=true;
      ^S    : begin
                 while keypressed do ch:=readkey; { empty queue }
                 ch1:=readkey; { get it, ignore }
                 if ch1=^C then checkabort:=true;
                 if ch1=^Z then checkabort:=true;
               end;
      else begin end; { do nothing otherwise }
     end;   { end of case }
   end;  { if then }
end; { checkabort }

procedure notimplemented;
begin
  writeln;
  writeln('Procedure not yet implemented.');
  writeln;
  presscrlf;
end;

procedure errormsg( x : byte);
begin
   writeln;
   case x of
      0   : writeln('No error.');
      1   : writeln('Bad command.');
      2   : writeln('Bad address mark.');
      3   : writeln('Write-protected disk.');
      4   : writeln('Record not found.');
      5   : writeln('Controller reset failed.');
      7   : writeln('Controller won''t accept drive parameters.');
      8   : writeln('DMA overrun.');
      9   : writeln('DMA bounds error.');
      $0b : writeln('Bad track flag found.');
      $10 : writeln('Bad CRC on disk read.');
      $11 : writeln('Recoverable ECC error.');
      $20 : writeln('Disk controller chip failure.');
      $40 : writeln('Bad seek.');
      $80 : writeln('Time out error.');
      $BB : writeln('Undefined error.');
      $ff : writeln('Sense Drive Status failure.');
    end;
    writeln;
 end; { error msg }


procedure setparamsptr( x : paramsptr );
   var y : Registers;
begin
   y.ah:=setintrp ;
   y.al:=disktable;
   y.dx:=ofs( x^);
   y.ds:=seg(x^);
   msdos(y);  { set the interrupt  block to point to our block }
end; { set }

procedure getparamsptr( var x : paramsptr );
   var y : Registers;
begin
   y.ah:= getintrp;
   y.al:=disktable;
   msdos(y);
   x:= ptr(y.es,y.bx);
end; { getpar }

procedure smooth;
{ have to get this to be only exit }
{ and make sure it restores disk params to normal }
begin
  setparamsptr(oldROMparams);

end; { smoothexit }

function getdrives : integer;
var x : Registers;
    y : integer;
begin
  { returns number of floppy drives }
  intr(equip,x);
  y:=x.ax and ($00c1);
   { stupid ibm scheme, bit 0 = 0 => no drives }
   { bit 0 = 1 => bits 6,7 give number -1 }
 if ((y and 1) = 0) then getdrives:=0 else
  begin
     y:=y shr 6;
     y:=y and 3;
     getdrives:=y+1;
  end;
end; { getdrives }

procedure logdrive; (* silent verson *)
begin
end;

procedure getdrive; (* interactive version *)
var ch : char;
begin
  repeat
      clreol;
      write('Which drive for OS-9 disk? <B:>  ');
      ch:=readkey;
      writeln;
      if ch = #$0d then ch:='B' else ch:=upcase(ch);
      drivenumber:=ord(ch) - ord('A');
  until (ch in ['A'..'P']) and (drivenumber < 4 );
 end; { getdrive }


procedure floppyreset;
var z : Registers;
begin
  z.dl:=0;
  z.dh:=0;
  z.ch:=0;
  z.cl:=1;
  z.ah:=diskreset;
  z.al:=1;
  intr(DISKIO,z);
end; { floppyreset }

function readsec(VAR trk,sector,side : integer; u : buf256ptr) : boolean;
var z : Registers;
    errflag : integer;
    errcount : integer;
procedure tryagain;  { put in a block for repeats }
begin
   myROMparams.bytesector:=phys256;
   myROMparams.lastsector:=20; (* 18 should be last for os9 *)
   setparamsptr(addr(myROMparams));
   z.dl:= drivenumber;
   z.dh:= side;
   z.ch:= lo(trk);
   z.cl:= lo(sector+1); (* number sectors starting at 0 instead of 1 *)
   z.ah:= diskread ;
   z.al:= 1; (* one sector read *)
   z.es:= seg(u^[0]);
   z.bx:= ofs(u^[0]);
   intr(DISKIO,z);
   smooth;
end; { tryagain }

begin  { readsec }
 errcount:=MAXTRIES;
 readsec:=false; (* assume failure *)
  repeat
   { switch to my parameters }
   setparamsptr(addr(myROMparams)); { point to my table }
   readsec:=false;
   tryagain;
   errflag:=z.flags and carryflag;
   errcount:=errcount-1;
   if errflag<> 0 then begin
      writeln('Try errcount ',errcount);
      writeln(#7,'Trying to read side ',side,' sector ',sector,' track ',trk);
   end;
  until (errflag=0) or (errcount <= 0);
   if errflag <> 0 then begin
      errormsg(z.ah);
      readsec:=false;
   end else readsec:=true;
end; { readsec read 1 physical sector }

function firstread  : boolean; { read absolute sector 0 }
{ tries to read sector 1 of track 0, side 0. If cannot read with }
{ sector sizes 256 declares failure, returns }
{ false. Else returns true, with this sector in the buffer }
label 123;
var z :  Registers;
    i :  integer;           { test with sector 1, track 1, side 0 }
    errorcnt : integer;
    errflag : integer;
    procedure try;
    begin
      secsize:=phys256;
      myROMparams.bytesector:=phys256;
      z.dl:= DRIVENUMBER;
      z.dh:= 0 ; { side }
      z.ch:= 0 ; { track }
      z.cl:= 1;  { sector number }
      z.ah:= diskread;
      z.al:= 1;  { number of sectors to transfer }
      z.es:= seg(buffer^[0]);
      z.bx:= ofs(buffer^[0]);
      intr(DISKIO,z);
   end; { try }

begin { firstread }
 buffercount:=0;
 firstread:=false;
 setparamsptr(addr(myROMparams));
 errorcnt:=MAXTRIES; { set max num of retries }
 repeat
       try;
       errorcnt:=errorcnt-1;
       errflag:=z.flags and carryflag;
 until (errorcnt <= 0) or (errflag =0);
 if (errflag <> 0) and (i = 1)  then
    errormsg(z.ah);
 if errflag = 0 then begin
    writeln;
    writeln('256 bytes per sector.');
    firstread:=true;
    goto 123;
 end;
123:
smooth; { restore old parameters }
end; { firstread }

procedure logo;
begin
  clrscr;
  writeln;
  writeln;
  writeln('This reads double density OS-9 disks on PC compatible computers.');
  writeln('Copyright 4/12/1988 Clarence Wilkerson. All rights reserved.');
  presscrlf;
end; { logo }

procedure  showdate;
begin
end;  { showdate }

procedure showos9; { print out os-9 lsn 0 parameters }
begin
if not logged then exit;
  with myboot do begin
    writeln('Number of sectors          ', three2real(tot):0:0);
    writeln('Sectors per track          ', tks:0);
    writeln('Bytes in alloc. bit map    ', two2int(map):0);
    writeln('Sectors per cluster        ',two2int(bit):0);
    writeln('First sector of ROOT dir   ',three2real(dir):0:0);
    writeln('Owner''s user num.          ',two2int(own):0);
    writeln('Disk attributes            ',byte2binary(att),'  ',att:0);
    writeln('Disk id num.               ',two2int(dsk):0);
    writeln('Disk format                ',byte2binary(fmt),'  ',fmt:0);
    writeln('Boot first sector          ',three2real(bt):0:0);
    writeln('Boot file size             ',two2int(bsz):0);
      write('Date/Time                  ');
    write(dat.year:0,'/',dat.month:0);
    writeln('/',dat.day:0,'  ',dat.hour:0,':',dat.minute:0);
    writeln('Volume Name                ',getstring(nam));
  end;
  presscrlf;
end;


function convert(LSN : integer; VAR trk, sec : integer) : boolean;
(* converts os9 logical sector number to track, sector and side, using
the parameters read off sector 0 *)
var logicalsector: integer;
begin
   (* if disk is two-sided, count tracks by doubling, so that even
      numbers are on front, odd on back *)
   convert:=false;
   (* writeln('Converting lsn #',lsn:0); *)
   if (myboot.tks <= 0) then begin
     writeln;writeln(#7,#7,'Bad TKS parameter = 0');
     presscrlf;
     convert:=false;
   end;
   (* track 0, sector 0, side 0 is first sector on disk *)
   logicalsector:=lsn ;(*.b0 or (lsn.b1 shl 8);  *)
   if logicalsector < 0 then begin
        convert:=false;
        writeln;
        writeln(#7,#7,'Huge disk. Negative LSN.');
        presscrlf;
        exit;
    end;
    trk:=logicalsector div myboot.tks;
    sec:=logicalsector mod myboot.tks;
    convert:=true;
end; { convert }


function getonesector(lsn : integer; u : buf256ptr) : boolean;
var mytrk,mysector,myside : integer;
begin
  if not logged then begin      (* lsn to physical uses log info *)
     getonesector:=false;
     writeln('Disk not logged in.');
     presscrlf;
     exit;
  end;
  if ( lsn >= three2int(myboot.tot)) then begin
     getonesector:=false;
     writeln('Sector out of range.');
     presscrlf;
     exit;
  end;
  if not convert(lsn,mytrk,mysector) then begin
     getonesector:=false;
     writeln('Conversion failure.');
     presscrlf;
     exit;
  end;        (* was out of range data *)
  if ((myboot.fmt and DSIDED) <> 0) then begin
    (* convert had double the number of tracks *)
      mytrk:=mytrk div 2;
      myside:=mytrk mod 2;
  end else myside:=0;
  if readsec(mytrk,mysector,myside,u)   then
    getonesector:=true
  else getonesector:=false;
end; { getonesector }


procedure showroot; { show the root directory }
var  kk,jj,trk,sec,side : integer;
      u : buf16ptr;
      v : buf256ptr;
      w : buf256;
      lsn : integer;
begin
  if not logged then exit;
  writeln('This is root directory of ',getstring( myboot.nam ));
  lsn:= three2int(myboot.dir);
  writeln('Showing sector ',lsn:0);
  v:= addr(w);
 for jj:=0 to 3 do begin
  if getonesector(lsn + jj ,v) then begin
     writeln;writeln(' Logical Sector ',lsn+jj);writeln;
     kk:=256;
     hexdisplay(kk,v);
     presscrlf;
  end else writeln(#7,#7);
end; { for jj }
end;  { show root }

procedure  dumpsector(trk,sec,side : integer; u : buf256ptr);
begin
  if readsec( trk,sec,side,u ) then begin
     writeln;
     writeln(' Sector ',sec:3,' Track ',trk:3, ' Side ',side:2);
     writeln;
     hexdisplay(256,u);
     presscrlf;
  end else writeln(#7,#7);
end; (* dumpsector *)

procedure  LSNdmpsec(lsn : integer; u : buf256ptr);
begin
  if getonesector( lsn,u ) then begin
     writeln;
     write(' Logical Sector ', lsn);
     write('  ');putword(lsn);writeln('H');
     writeln;
     hexdisplay(256,u);
     presscrlf;
  end else writeln(#7,#7);
end; (* LSNdmpsec *)

procedure dmphex;
var x : integer;
    z : buf256;
    u : buf256ptr;
begin
  u:=addr(z[0]);
  if not logged then exit;
  gotoxy(1,24); clreol;
  write('Sector to dump?  ');
  readln(x);
  repeat
    if x > three2int(myboot.tot) then begin
       writeln('Sector out of range. ');
       writeln('Max sector is ',three2int(myboot.tot));
       exit;
    end
    else  LSNdmpsec(x,u);
    x:=x+1;
  until keypressed;
end; {dmphex}



procedure du; (* commands imitate CP/M DU commands *)
(* disk utility *)
(* deals with OS-9 disk only physically, no file structure *)
(* DU variables *)
var  duside,dusec,dutrk: integer;
     dosfile  : file of byte;
     dosname  : nstring;
     duLSN    : integer;
     commandstr,duparam : nstring;
     grabflag,prtflag : boolean;
     grabcount : integer;
     DU_exit   : boolean;
     exhausted : boolean;
     command : char;
     du_answer : integer;

procedure DU_init;
begin
  duside:=0;
  dutrk :=0;
  dusec :=0;
  duLSN :=0;
  commandstr:='';
  duparam:='';
  dosname:='';
  grabcount:=0;
  grabflag:=FALSE;
  DU_exit:=false;
  exhausted:=false;
  prtflag:=FALSE;
end; {duinit}

procedure DU_menu;
begin
 clrscr;
 writeln;writeln;
 writeln;
 writeln('     Commands for DU     ');writeln;
 writeln('     LX    ... log disk X as OS-9 disk');
 writeln('     TX    ... set track X');
 writeln('     SX    ... set sector X');
 writeln('     GX    ... go to LSN X');
 writeln('     +X    ... advance X sectors ');
 writeln('     -X    ... retreat X sectors ');
 writeln('     D     ... display current sector');
 writeln('     CH    ... edit current sector in hex ');
 writeln('     CA    ... edit current sector in ascii');
 writeln('     ?     ... get this help screen');
 writeln('     Y     ... yank sectors into buffer');
 writeln('     W     ... write current sector buffer to disk');
 writeln('     Kfile ... send yank buffer to msdos file');
 writeln('     /X    ... repeat command string X times.');
 writeln('     Q     ... return to main menu');
 writeln('     P     ... toggle printer');
 writeln('     ;     ... continue with another command');
 writeln;
 writeln(' >>>> Press <CR> to continue ');
end; (* DU_menu *)

procedure getcommand;
var i : integer;
begin
(* find first ';' in command line, get piece up to there *)
(* put first letter into COMMAND *)
(* put tail in duparam *)
(* chop it down to size *)
if length(commandstr) =0 then begin
   exhausted:=false;
   command:=' ';
end;
   COMMAND:=upcase(commandstr[1]);
   i:=pos(';',commandstr);
   if i > 1 then duparam:=copy(commandstr,2,i-2)
   else duparam:=copy(commandstr,2,255);
   if i=0 then commandstr:='' else
       commandstr:=copy(commandstr,i+1,length(commandstr));
end;

procedure getparams;
begin
end;

function getnum( s: nstring; lo,hi : integer; var answer : integer): boolean;
var x : integer;
begin
  getnum:=false;
end; { get num}

procedure editascii(duparams:nstring);
begin
end;

procedure edithex(duparams:nstring);
begin
end;

begin { DU }
 DU_init;
 DU_menu;
 repeat
  write('DU> ');
  readln(commandstr);
  makeupper(commandstr);
  repeat
    getcommand;  (* bite off a chunk of command line and process *)
    getparams; (* put first letter in CoMMaND, rest in duparam *)
    case CoMMaND of
    ' '   : begin end;
    '?' : begin
              DU_menu;
             end;
       'D' : begin
             end;
       'L' : begin
             end;
       'G' : begin
             end;
       'y' : begin
                grabflag:=TRUE;
                grabcount:=0;
             end;
       'Q','X' :begin
                 DU_exit:=true;
                 exhausted:=true;
               end;
       'T' : begin
              if ( getnum( duparam,0,160,du_answer) ) then dutrk:= du_answer;
             end;
       'S' : begin
              if (getnum(duparam,0,20,du_answer)) then dusec:=du_answer;
             end;
        '+' : begin
              end;
        '-' : begin
              end;

        'C' : begin
                 if duparam[1]='A' then editascii(copy(duparam,2,255));
                 if duparam[1]='H' then edithex(copy(duparam,2,255));
              end;
         'W' :begin  (* write current buffer to current sector *)
                     (* notice buffer is not refilled until    *)
                     (* display command is processed, so this  *)
                     (* so this gives a way to move sectors around *)

               end;

      else begin end; end;
   until exhausted;
 until DU_exit;
end; (* disk utility *)

procedure putbitln( z : integer; u : buf256);
{ print 8 bytes, with label starting at z}
var i,j,w : integer;
begin
     putword(z);
     write(' ');
     for i:=0 to 7 do begin
        w:=u[ i ];
        putbinary(w and $ff);
        write(' ');
     end; { i }
     writeln;
 end; { puthexln }

procedure allocation_map(u : buf256ptr; z : integer);
(* display z bytes of area pointed to by u as bitmap *)
var i,index,jj : integer;
    v : buf256ptr;
begin
    v:=u;
    if ((z mod 8) = 0) then
       index:=(z div 8)-1
    else index :=z div 8;
    writeln;
    writeln('Bit map of ',z:0,' bytes');
    writeln;
    write('       0        1        2        3        4');
    writeln('        5        6        7');
    jj:=0;
    for i:=0 to index do begin
       putbitln( 8*i, v^);
       jj:=jj+8;
       (* now increment pointer u by 8 *)
       v:=addr(u^[jj]);
       (* slightly sleasy *)
    end; { i }
end; { allocation_map }

function getfree(w : buf256): integer;
var  sum,i,j : integer;
begin
  sum:=0;
  i:=two2int(myboot.map);
  for j:=0 to (i-1) do begin
      sum:=sum+(8-bits(w[j]));
  end;
  getfree:=sum;
end;  { get free }

procedure showalloc;
var  kk,jj,trk,sec,side : integer;
      u : buf16ptr;
      v : buf256ptr;
      w : buf256;
begin
if not logged then exit;

  writeln('This is the allocation bit map for ',getstring( myboot.nam ));
  writeln;
  sec:=1;
  v:= addr(w[0]);
  if getonesector(sec,v) then begin
     write('There are ',getfree(w):0,' free clusters  of ');
     writeln(two2int(myboot.bit):0, ' sector(s) each.');
     writeln;writeln;
     kk:=256;
     hexdisplay(kk,v);
     presscrlf;
     writeln;
     allocation_map(v, two2int(myboot.map) );
     writeln;
     presscrlf;
  end else writeln(#7,#7,#7);
end;  { show alloc }

procedure menu; (* shows choices *)
begin
  clrscr;
  writeln;
  Writeln(' OS-9 to MSDOS Transfer Utility ');
  writeln('      copyright 4/30/1988 by Clarence Wilkerson');
  writeln;
  writeln('      OS-9 VOL. ',os9volume:15, '  OS-9 DIR. ',os9dir:20);
  writeln;
  writeln('   L  ...  log in OS-9 disk. ');
  writeln('   S  ...  show parameters of OS-9 disk.');
  writeln('   D  ...  show current directory of OS-9 disk.');
  writeln('   C  ...  change to subdirectory of current directory');
  writeln('   U  ...  use DU commands to disk zap.');
  writeln('   V  ...  view a file in the current directory.');
  writeln('   P  ...  send OS-9 file to printer.');
  writeln('   M  ...  copy a OS-9 file to a MSDOS file.');
  writeln('   T  ...  copy a MSDOS file to the root directory of OS-9 disk.');
  writeln('   A  ...  show allocation bitmap and free space for OS-9 disk.');
  writeln('   H  ...  show brief help file.');
  writeln('   J  ...  dump sector in hex and ascii.');
  writeln('   X  ...  return to MSDOS.');
end;

procedure help;
begin

writeln('L (og) :');
writeln('    Asks for the floppy drive for the OS-9 disk. Only drives ');
writeln('    0 and 1 are supported on the AT or 0 ->3 on an XT with ');
writeln('    external drives. The AT hi-density drive can be used to ');
writeln('    read 96 tpi OS-9 diskettes. Single density track 0 is ');
writeln('    not supported.');
writeln('  S (how) :');
writeln('    gives a dump of the LSN0 parameters for the OS-9 disk. ');
writeln('  D (irectory): ');
writeln('    gives a listing of the root directory.');
writeln('  V (iew)');
writeln('    lists to the screen a OS-9 file in the current directory.');
writeln('    If text, tabs are expanded and \n changed to CR/LF pairs.');
writeln('    If the file is not text, it dumps the file in hex. ');
presscrlf;
writeln('  P (rint) : ');
writeln('    same as view, but sends to MSDOS PRN: device.');
writeln('  M (ove)  : ');
writeln('    an OS-9 file in the current directory to a MSDOS file.  ');
writeln('  T (ransfer) ');
writeln('    a MSDOS file to the root directory of the OS-9 disk ');
writeln('  U (disk utility) :');
writeln('    goes to submenu for disk zapper with command line');
writeln('    modeled on CP/M''s DU .');
writeln('  A (llocation) :');
writeln('    print to screen the allocation bit map and hex dump of it. ');
writeln('  H (elp) :');
writeln('    show this screen again. ');
writeln('  X (exit) ');
writeln('    return to MSDOS. Q,Z also work here. ');

end; { help }

function getchoice : char;
var s : string[25];
    ch : char;
begin
  repeat
    gotoxy(1,24);
    clreol;
    write('     >>>>  Choice?  ');
    readln(s);
    ch:=upcase(s[1]);
  until ch in ['A','C','D','H','J','L','M','P','Q','S','T','U','V','X','Y','Z'];
  getchoice:=ch;
end; { getchoice }

procedure log;
begin
  logged:=false;
  getdrive;
  insertdisk;
  initialize;
  if not firstread then begin
    floppyreset;
    logged:=false;
    gotoxy(1,24);
    clreol;
    write('Can''t read track 0 sector 1.');
    presscrlf;
    exit;
  end;(* leave *)
  logged:=true;
  ulsn0 :=addr(buffer^[0]);
  myboot:=ulsn0^; (* copy it to myboot *);
  os9volume:= getstring(myboot.nam);
  writeln('Have logged ',os9volume);
  presscrlf;
  floppyreset;
 end; { log }

procedure yankit;
label cleanitup;
var x,i,many : integer;
    z : buf256;
    u : buf256ptr;
begin
  u:=addr(z[0]);
  if not logged then exit;
  gotoxy(1,24); clreol;
  assign(yfile, yankfile);
  rewrite(yfile);
  write('First Sector to Save to YANKEE.IMP?  ');
  readln(x);
  write('How many sectors? '); readln(many);
  i:=0;
  repeat
    i:=i+1;
    if (x + i) > three2int(myboot.tot) then begin
       writeln('Sector out of range. ');
       writeln('Max sector is ',three2int(myboot.tot));
       goto cleanitup;
    end;
    if getonesector( (x+i), u ) then
        blockwrite(yfile,z[0],2)
    else begin
        writeln('Error writing save file. Aborted! ');
        goto cleanitup;
    end;
  until i > many;
  cleanitup:
  close(yfile);
end; {yankit}

begin {main}
  new(buffer);
  initialize;
  buffercount:=0;
  getparamsptr(oldROMparams);
  logo;
  menu;
  repeat
    case getchoice of
      'A' : showalloc;
      'S' : showos9;
      'H' : help;
      'X','Q','Z' : final_exit:=true;
      'D' :  showroot;
      'C','V','P','T','M' :  notimplemented;
      'L' : log;
      'U' : du;
      'J' : dmphex;
      'Y' : yankit;
     end;
     menu;
   until  final_exit;
   floppyreset;
end.