Program Read_PC;
{    Author:  TS Kelso
       Date:  22 February 1986
Description:  This program is designed to read IBM PC diskettes (single or
              double-sided) on a CP/M system and transfer them to a CP/M
              file.  This is particularly useful for transferring data files
              from MS-DOS/PC-DOS to CP/M computers.  Program requires that
              the CP/M system be capable of reading comparable format CP/M
              diskettes.
       NOTE:  Start address for compilation must be 2500H or greater!!}

{This program is placed in the public domain by the author and is available
 for unrestricted use by individuals as long as this notice is maintained.
 This program may not be used for any commercial purpose without express
 written permission from the author.}

label
  exit;
const
  DMA_Address = $2100;
  bytes       = 512;
  SPT         = 9;         {Sectors per track}
  BPS         = 4;         {Blocks per sector}
  RSS         = 1;         {Reserved sectors}
  FATS        = 2;         {Number of FAT sectors}
  NOF         = 2;         {Number of FATs}
  TPS         = 40;        {Tracks per side}
{Configure to satisfy system requirements}
  LDrive      = 'A';       {Low system drive -- System dependent}
  HDrive      = 'D';       {High system drive -- System dependent}
  target      = 'C';       {CP/M target drive}
  source      = 'D';       {IBM diskette source drive}
type
  string12    = string[12];
var
  DMA         : array [1..bytes] of byte absolute $2100;
  FAT         : array [1..NOF,1..1024] of byte;
  Dir         : array [1..bytes] of byte;
  MD          : byte;      {Media Descriptor Byte}
  sides,                   {Number of sides}
  SPC,                     {Sectors per cluster}
  SPD         : integer;   {Sectors per directory}
  response    : char;
  valid       : boolean;

Function Select_Disk(arg : char) : boolean;
  var
    param : integer;
  begin
  if arg in [LDrive..HDrive] then
    begin
    param := ord(arg)-ord('A');
    BDOS(14,param);
    Select_Disk := true;
    end {if}
  else
    begin
    GotoXY(1,24);
    ClrEOL;
    write('Disk Select Error -- Invalid Drive');
    Delay(1000);
    Select_Disk := false;
    end; {else}
  end; {Function Select_Disk}

Function Set_Track(arg : integer) : boolean;
  begin
  if arg in [0..sides*TPS-1] then
    begin
    BIOS(9,arg);
    Set_Track := true;
    end {if}
  else
    begin
    GotoXY(1,24);
    ClrEOL;
    write('Track Select Error -- Not in range 0-',TPS-1);
    Delay(1000);
    Set_Track := false;
    end; {else}
  end; {Function Set_Track}

Procedure Set_DMA(arg : integer);
  begin
  BDOS(26,arg);
  end; {Procedure Set_DMA}

Procedure Set_CPM_Sector(arg : integer);
  begin
  BIOS(10,arg);
  end; {Procedure Set_Sector}

Function Read_Sector(arg1,arg2 : integer) : boolean;
  var
    n1,n2  : integer;
    result : boolean;
  begin
  GotoXY(1,23);
  ClrEOL;
  write('Track ',arg1,', Sector ',arg2);
  result := Set_Track(arg1);
  if arg2 in [1..SPT] then
    begin
    for n1 := 1 to BPS do
      begin
      Set_DMA(DMA_Address + (n1-1)*$80);
      n2 := (arg2-1)*BPS + n1;
      Set_CPM_Sector(n2);
      Delay(10);
      if BIOS(12) <> 0 then
        begin
        GotoXY(1,24);
        ClrEOL;
        write('CP/M Sector ',n2,' read failed');
        Delay(1000);
        result := false;
        end; {if BIOS(12)}
      end; {for n1}
    end {if}
  else
    begin
    GotoXY(1,24);
    ClrEOL;
    write('Sector Select Error -- Not in range 1-',SPT);
    Delay(1000);
    result := false;
    end; {else}
  Read_Sector := result;
  end; {Function Read_Sector}

Procedure Display_Sector;
  const
    columns = 64;
  var
    i1,i2,
    pos,
    lines : integer;
  begin
  lines := bytes div columns;
  for i1 := 0 to lines-1 do
    begin
    for i2 := 1 to columns do
      begin
      pos := columns*i1 + i2;
      if chr(DMA[pos]) in [' '..'~'] then
        write(chr(DMA[pos]))
      else
        write('.');
      if i2 mod 16 = 0 then
        write('  ');
      end; {for i2}
    writeln;
    end; {for i1}
  end; {Procedure Display_Sector}

Procedure Transfer_to_FAT(index1,index2 : integer);
  var
    k : integer;
  begin
  for k := 1 to bytes do
    FAT[index1,(index2-1)*bytes+k] := DMA[k];
  end; {Procedure Transfer_to_FAT}

Procedure Read_FAT(number : integer);
  var
    start,i : integer;
  begin
  start := RSS + (number-1)*FATS;
  for i := 1 to FATS do
    begin
    valid := Read_Sector(0,start+i);
    if valid then
      Transfer_to_FAT(number,i);
    end; {for i}
  end; {Procedure Read_FAT}

Function Compare_FATs : boolean;
  const
    total   : integer = 0;
  var
    i       : integer;
    result  : boolean;
  begin
  result := true;
  for i := 1 to FATS*bytes do
      if FAT[1,i] <> FAT[2,i] then
        begin
        total := total + 1;
        result := false;
        end; {if}
  if not result then
    begin
    GotoXY(1,24);
    ClrEOL;
    write('File Allocation Table Error -- FATs do not compare!');
    Delay(1000);
    GotoXY(1,24);
    ClrEOL;
    write('Total disagreements = ',total);
    Delay(1000);
    end; {if}
  Compare_FATs := result;
  end; {Function Compare_FATs}

Function Convert_Filename(param : integer) : string12;
  var
    name : string12;
    k    : integer;
    next : char;
  begin
  name := '';
  for k := 1 to 8 do
    begin
    next := Chr(Dir[param+k]);
    if next <> ' ' then
      name := name + next;
    end; {for}
  name := name + '.';
  for k := 9 to 11 do
    begin
    next := Chr(Dir[param+k]);
    if next <> ' ' then
      name := name + next;
    end; {for}
  Convert_Filename := name;
  end; {Function Convert_Filename}

Function Convert_Date(param : integer) : string12;
  const
    months = 'JanFebMarAprMayJunJulAugSepOctNovDec';
  var
    date     : string12;
    mo,dy,yr : integer;
    next     : string[2];
  begin
  mo := ((Dir[param+26] and 1) shl 3) or (Dir[param+25] shr 5);
  dy := (Dir[param+25] and $1F);
  yr := (Dir[param+26] shr 1) + 80;
  Str(dy:2,next);
  if next[1] = ' ' then
    next[1] := '0';
  if mo in [1..12] then
    begin
    date := next + '-' + Copy(months,(mo-1)*3+1,3) + '-';
    Str(yr:2,next);
    date := date + next;
    end
  else
    date := ' No Date ';
  Convert_Date := date;
  end; {Function Convert_Date}

Function Convert_Time(param : integer) : string12;
  var
    time     : string12;
    hr,mi,sc : integer;
    next     : string[2];
  begin
  mi := ((Dir[param+24] and 7) shl 3) or (Dir[param+23] shr 5);
  sc := (Dir[param+23] and $1F) shl 1;
  hr := (Dir[param+24] shr 3);
  Str(hr:2,next);
  if next[1] = ' ' then
    next[1] := '0';
  time := next + ':';
  Str(mi:2,next);
  if next[1] = ' ' then
    next[1] := '0';
  time := time + next + ':';
  Str(sc:2,next);
  if next[1] = ' ' then
    next[1] := '0';
  time := time + next;
  Convert_Time := time;
  end; {Function Convert_Time}

Function Convert_Size(param : integer) : real;
  begin
  Convert_Size := 16777216.0*Dir[param+32] + 65536.0*Dir[param+31]
                     + 256.0*Dir[param+30] +         Dir[param+29];
  end; {Function Convert_Size}

Function Convert(param : integer) : integer;
  begin
  Convert := SPC*(param - 2) + RSS + NOF*FATS + SPD + 1;
  end; {Function Convert}

Function Next_Cluster(param : integer) : integer;
  var
    next : integer;
  begin
  next := (3*param div 2) + 1;
  next := 256*FAT[1,next+1] + FAT[1,next];
  if param mod 2 = 0 then
    next := next and $0FFF
  else
    next := next shr 4;
  Next_Cluster := next;
  end; {Function Next_Cluster}

Function Max(arg1,arg2 : real) : real;
  begin
  if arg1 >= arg2 then
    Max := arg1
  else
    Max := arg2;
  end; {Function Max}

Procedure Transfer_File(arg : integer);
  var
    outfile        : file;
    filename       : string12;
    size           : real;
    m,track,sector,
    start,blocks,
    cluster        : integer;
    done,result    : boolean;
  begin
  done := false;
  filename := Convert_Filename(arg);
  Assign(outfile,target+':'+filename);
  Rewrite(outfile);
  size := Convert_Size(arg);
  GotoXY(1,21);
  ClrEOL;
  write('File being transferred:  ',
         filename,'  ',Convert_Time(arg),'  ',
         Convert_Date(arg),'  ',size:8:0,' bytes');
  cluster := 256*Dir[arg+28] + Dir[arg+27];
  GotoXY(1,22);
  ClrEOL;
  write('Cluster ',cluster:3);
  repeat
    start := Convert(cluster);
    for m := start to start+SPC-1 do
      begin
      track := (m-1) div SPT;
      if (sides = 2) then
        track := Abs((track mod 2)*(sides*TPS-1) - (track div 2));
      sector := ((m-1) mod SPT) + 1;
      result := Read_Sector(track,sector);
      if size <> 0 then
        begin
        if size < bytes then
          begin
          blocks := Trunc((size-1)/128) + 1;
          BlockWrite(outfile,DMA,blocks);
          end {if size < bytes}
        else
          BlockWrite(outfile,DMA,4);
        size := Max(0,size - bytes);
        end; {if size <> 0}
    end; {for m}
    if Next_Cluster(cluster) >= $FF8 then
      done := true
    else
      begin
      cluster := Next_Cluster(cluster);
      GotoXY(1,22);
      ClrEOL;
      write('Cluster ',cluster:3);
      end;
  until done;
  Close(outfile);
  end; {Procedure Transfer_File}

Procedure Check_Entries;
  var
    offset,j      : integer;
    check1,check2 : byte;
  begin
  for j := 1 to (bytes div 32) do
    begin
    offset := (j-1)*32;
    check1 := Dir[offset+1];
    check2 := Dir[offset+12];
    if not (check1 in [$00,$2E,$E5]) and not (check2 in [$08,$10]) then
      Transfer_File(offset);
    end; {for j}
  end; {Procedure Check_Entries}

Procedure Load_Directory;
  var
    k : integer;
  begin
  for k := 1 to bytes do
    Dir[k] := DMA[k];
  end; {Procedure Load_Directory}

Procedure Search_Directory;
  var
    track,
    sector,
    start,i : integer;
    result  : boolean;
  begin
  start := RSS + NOF*FATS;
  for i := 1 to SPD do
    begin
    GotoXY(1,20);
    ClrEOL;
    write('Directory Sector ',i);
    sector := start + i;
    track := (sector-1) div SPT;
    sector := ((sector-1) mod SPT) + 1;
    if (sides = 2) then
      track := Abs((track mod 2)*(sides*TPS-1) - (track div 2));
    result := Read_Sector(track,sector);
    Load_Directory;
    Check_Entries;
    end; {for i}
  end; {Procedure Search_Directory}

BEGIN

  ClrScr;
  writeln('This program is designed to read IBM PC/XT diskettes,');
  writeln('either SS or DS, and transfer the files on that diskette');
  writeln('to a CP/M formatted diskette.  While written for the H-89');
  writeln('using the Magnolia disk controller, it should work on any');
  writeln('CP/M system which supports a format compatible with the IBM');
  writeln('format.  It should also work for MS-DOS diskettes.');
  writeln;

{Ensure system is prepared to read IBM format diskette}
  writeln('Did you set the target drive to read IBM compatible format');
  write('before running this program?  ');
  repeat
    read(kbd,response);
    response := Upcase(response);
    valid := true;
    case response of
      'Y' : writeln('Yes');
      'N' : begin
            writeln('No');
            writeln;
            writeln('You must exit and configure target drive.');
            goto exit;
            end; {No}
    else
            valid := false;
    end; {case}
  until valid;
  writeln;

{Specify drives to read IBM diskette from and write CP/M files on}
  writeln('Insert CP/M (target) diskette in Drive ',target,': and IBM PC/XT');
  writeln('(source) diskette in Drive ',source,':.');
  writeln;
  write('Hit any key to begin.');
  read(kbd,response);
  valid := Select_Disk(source);
  writeln;

{Read FATs and compare}
  GotoXY(1,16);
  ClrEOL;
  writeln('Reading FAT Number 1');
  Read_FAT(1);
  GotoXY(1,16);
  ClrEOL;
  writeln('Reading FAT Number 2');
  Read_FAT(2);
  GotoXY(1,16);
  ClrEOL;
  write('Comparing FATs -- ');
  valid := Compare_FATs;
  if valid then
    writeln('Successful compare')
  else
    goto exit;

{Determine Media Type and set media-peculiar parameters}
  MD := FAT[1,1];
  case MD of
    $FC : begin
          sides := 1;
          SPC := 1;
          SPD := 4;
          end; {MD = $FC}
    $FD : begin
          sides := 2;
          SPC := 2;
          SPD := 7;
          end; {MD = $FD}
  else
          begin
          GotoXY(1,24);
          ClrEOL;
          write('Unrecognized Media Descriptor Byte');
          Delay(1000);
          goto exit;
          end; {else}
  end; {case}

{Transfer files}
  Search_Directory;

  Set_DMA($0080);

  GotoXY(1,24);
  ClrEOL;
  writeln('File transfer completed.');

exit:

END.