home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / emulate / systems / read_pc / read-pc.pas
Pascal/Delphi Source File  |  1986-12-12  |  13KB  |  508 lines
  1. Program Read_PC;
  2. {    Author:  TS Kelso
  3.        Date:  22 February 1986
  4. Description:  This program is designed to read IBM PC diskettes (single or
  5.               double-sided) on a CP/M system and transfer them to a CP/M
  6.               file.  This is particularly useful for transferring data files
  7.               from MS-DOS/PC-DOS to CP/M computers.  Program requires that
  8.               the CP/M system be capable of reading comparable format CP/M
  9.               diskettes.
  10.        NOTE:  Start address for compilation must be 2500H or greater!!}
  11.  
  12. {This program is placed in the public domain by the author and is available
  13.  for unrestricted use by individuals as long as this notice is maintained.
  14.  This program may not be used for any commercial purpose without express
  15.  written permission from the author.}
  16.  
  17. label
  18.   exit;
  19. const
  20.   DMA_Address = $2100;
  21.   bytes       = 512;
  22.   SPT         = 9;         {Sectors per track}
  23.   BPS         = 4;         {Blocks per sector}
  24.   RSS         = 1;         {Reserved sectors}
  25.   FATS        = 2;         {Number of FAT sectors}
  26.   NOF         = 2;         {Number of FATs}
  27.   TPS         = 40;        {Tracks per side}
  28. {Configure to satisfy system requirements}
  29.   LDrive      = 'A';       {Low system drive -- System dependent}
  30.   HDrive      = 'D';       {High system drive -- System dependent}
  31.   target      = 'C';       {CP/M target drive}
  32.   source      = 'D';       {IBM diskette source drive}
  33. type
  34.   string12    = string[12];
  35. var
  36.   DMA         : array [1..bytes] of byte absolute $2100;
  37.   FAT         : array [1..NOF,1..1024] of byte;
  38.   Dir         : array [1..bytes] of byte;
  39.   MD          : byte;      {Media Descriptor Byte}
  40.   sides,                   {Number of sides}
  41.   SPC,                     {Sectors per cluster}
  42.   SPD         : integer;   {Sectors per directory}
  43.   response    : char;
  44.   valid       : boolean;
  45.  
  46. Function Select_Disk(arg : char) : boolean;
  47.   var
  48.     param : integer;
  49.   begin
  50.   if arg in [LDrive..HDrive] then
  51.     begin
  52.     param := ord(arg)-ord('A');
  53.     BDOS(14,param);
  54.     Select_Disk := true;
  55.     end {if}
  56.   else
  57.     begin
  58.     GotoXY(1,24);
  59.     ClrEOL;
  60.     write('Disk Select Error -- Invalid Drive');
  61.     Delay(1000);
  62.     Select_Disk := false;
  63.     end; {else}
  64.   end; {Function Select_Disk}
  65.  
  66. Function Set_Track(arg : integer) : boolean;
  67.   begin
  68.   if arg in [0..sides*TPS-1] then
  69.     begin
  70.     BIOS(9,arg);
  71.     Set_Track := true;
  72.     end {if}
  73.   else
  74.     begin
  75.     GotoXY(1,24);
  76.     ClrEOL;
  77.     write('Track Select Error -- Not in range 0-',TPS-1);
  78.     Delay(1000);
  79.     Set_Track := false;
  80.     end; {else}
  81.   end; {Function Set_Track}
  82.  
  83. Procedure Set_DMA(arg : integer);
  84.   begin
  85.   BDOS(26,arg);
  86.   end; {Procedure Set_DMA}
  87.  
  88. Procedure Set_CPM_Sector(arg : integer);
  89.   begin
  90.   BIOS(10,arg);
  91.   end; {Procedure Set_Sector}
  92.  
  93. Function Read_Sector(arg1,arg2 : integer) : boolean;
  94.   var
  95.     n1,n2  : integer;
  96.     result : boolean;
  97.   begin
  98.   GotoXY(1,23);
  99.   ClrEOL;
  100.   write('Track ',arg1,', Sector ',arg2);
  101.   result := Set_Track(arg1);
  102.   if arg2 in [1..SPT] then
  103.     begin
  104.     for n1 := 1 to BPS do
  105.       begin
  106.       Set_DMA(DMA_Address + (n1-1)*$80);
  107.       n2 := (arg2-1)*BPS + n1;
  108.       Set_CPM_Sector(n2);
  109.       Delay(10);
  110.       if BIOS(12) <> 0 then
  111.         begin
  112.         GotoXY(1,24);
  113.         ClrEOL;
  114.         write('CP/M Sector ',n2,' read failed');
  115.         Delay(1000);
  116.         result := false;
  117.         end; {if BIOS(12)}
  118.       end; {for n1}
  119.     end {if}
  120.   else
  121.     begin
  122.     GotoXY(1,24);
  123.     ClrEOL;
  124.     write('Sector Select Error -- Not in range 1-',SPT);
  125.     Delay(1000);
  126.     result := false;
  127.     end; {else}
  128.   Read_Sector := result;
  129.   end; {Function Read_Sector}
  130.  
  131. Procedure Display_Sector;
  132.   const
  133.     columns = 64;
  134.   var
  135.     i1,i2,
  136.     pos,
  137.     lines : integer;
  138.   begin
  139.   lines := bytes div columns;
  140.   for i1 := 0 to lines-1 do
  141.     begin
  142.     for i2 := 1 to columns do
  143.       begin
  144.       pos := columns*i1 + i2;
  145.       if chr(DMA[pos]) in [' '..'~'] then
  146.         write(chr(DMA[pos]))
  147.       else
  148.         write('.');
  149.       if i2 mod 16 = 0 then
  150.         write('  ');
  151.       end; {for i2}
  152.     writeln;
  153.     end; {for i1}
  154.   end; {Procedure Display_Sector}
  155.  
  156. Procedure Transfer_to_FAT(index1,index2 : integer);
  157.   var
  158.     k : integer;
  159.   begin
  160.   for k := 1 to bytes do
  161.     FAT[index1,(index2-1)*bytes+k] := DMA[k];
  162.   end; {Procedure Transfer_to_FAT}
  163.  
  164. Procedure Read_FAT(number : integer);
  165.   var
  166.     start,i : integer;
  167.   begin
  168.   start := RSS + (number-1)*FATS;
  169.   for i := 1 to FATS do
  170.     begin
  171.     valid := Read_Sector(0,start+i);
  172.     if valid then
  173.       Transfer_to_FAT(number,i);
  174.     end; {for i}
  175.   end; {Procedure Read_FAT}
  176.  
  177. Function Compare_FATs : boolean;
  178.   const
  179.     total   : integer = 0;
  180.   var
  181.     i       : integer;
  182.     result  : boolean;
  183.   begin
  184.   result := true;
  185.   for i := 1 to FATS*bytes do
  186.       if FAT[1,i] <> FAT[2,i] then
  187.         begin
  188.         total := total + 1;
  189.         result := false;
  190.         end; {if}
  191.   if not result then
  192.     begin
  193.     GotoXY(1,24);
  194.     ClrEOL;
  195.     write('File Allocation Table Error -- FATs do not compare!');
  196.     Delay(1000);
  197.     GotoXY(1,24);
  198.     ClrEOL;
  199.     write('Total disagreements = ',total);
  200.     Delay(1000);
  201.     end; {if}
  202.   Compare_FATs := result;
  203.   end; {Function Compare_FATs}
  204.  
  205. Function Convert_Filename(param : integer) : string12;
  206.   var
  207.     name : string12;
  208.     k    : integer;
  209.     next : char;
  210.   begin
  211.   name := '';
  212.   for k := 1 to 8 do
  213.     begin
  214.     next := Chr(Dir[param+k]);
  215.     if next <> ' ' then
  216.       name := name + next;
  217.     end; {for}
  218.   name := name + '.';
  219.   for k := 9 to 11 do
  220.     begin
  221.     next := Chr(Dir[param+k]);
  222.     if next <> ' ' then
  223.       name := name + next;
  224.     end; {for}
  225.   Convert_Filename := name;
  226.   end; {Function Convert_Filename}
  227.  
  228. Function Convert_Date(param : integer) : string12;
  229.   const
  230.     months = 'JanFebMarAprMayJunJulAugSepOctNovDec';
  231.   var
  232.     date     : string12;
  233.     mo,dy,yr : integer;
  234.     next     : string[2];
  235.   begin
  236.   mo := ((Dir[param+26] and 1) shl 3) or (Dir[param+25] shr 5);
  237.   dy := (Dir[param+25] and $1F);
  238.   yr := (Dir[param+26] shr 1) + 80;
  239.   Str(dy:2,next);
  240.   if next[1] = ' ' then
  241.     next[1] := '0';
  242.   if mo in [1..12] then
  243.     begin
  244.     date := next + '-' + Copy(months,(mo-1)*3+1,3) + '-';
  245.     Str(yr:2,next);
  246.     date := date + next;
  247.     end
  248.   else
  249.     date := ' No Date ';
  250.   Convert_Date := date;
  251.   end; {Function Convert_Date}
  252.  
  253. Function Convert_Time(param : integer) : string12;
  254.   var
  255.     time     : string12;
  256.     hr,mi,sc : integer;
  257.     next     : string[2];
  258.   begin
  259.   mi := ((Dir[param+24] and 7) shl 3) or (Dir[param+23] shr 5);
  260.   sc := (Dir[param+23] and $1F) shl 1;
  261.   hr := (Dir[param+24] shr 3);
  262.   Str(hr:2,next);
  263.   if next[1] = ' ' then
  264.     next[1] := '0';
  265.   time := next + ':';
  266.   Str(mi:2,next);
  267.   if next[1] = ' ' then
  268.     next[1] := '0';
  269.   time := time + next + ':';
  270.   Str(sc:2,next);
  271.   if next[1] = ' ' then
  272.     next[1] := '0';
  273.   time := time + next;
  274.   Convert_Time := time;
  275.   end; {Function Convert_Time}
  276.  
  277. Function Convert_Size(param : integer) : real;
  278.   begin
  279.   Convert_Size := 16777216.0*Dir[param+32] + 65536.0*Dir[param+31]
  280.                      + 256.0*Dir[param+30] +         Dir[param+29];
  281.   end; {Function Convert_Size}
  282.  
  283. Function Convert(param : integer) : integer;
  284.   begin
  285.   Convert := SPC*(param - 2) + RSS + NOF*FATS + SPD + 1;
  286.   end; {Function Convert}
  287.  
  288. Function Next_Cluster(param : integer) : integer;
  289.   var
  290.     next : integer;
  291.   begin
  292.   next := (3*param div 2) + 1;
  293.   next := 256*FAT[1,next+1] + FAT[1,next];
  294.   if param mod 2 = 0 then
  295.     next := next and $0FFF
  296.   else
  297.     next := next shr 4;
  298.   Next_Cluster := next;
  299.   end; {Function Next_Cluster}
  300.  
  301. Function Max(arg1,arg2 : real) : real;
  302.   begin
  303.   if arg1 >= arg2 then
  304.     Max := arg1
  305.   else
  306.     Max := arg2;
  307.   end; {Function Max}
  308.  
  309. Procedure Transfer_File(arg : integer);
  310.   var
  311.     outfile        : file;
  312.     filename       : string12;
  313.     size           : real;
  314.     m,track,sector,
  315.     start,blocks,
  316.     cluster        : integer;
  317.     done,result    : boolean;
  318.   begin
  319.   done := false;
  320.   filename := Convert_Filename(arg);
  321.   Assign(outfile,target+':'+filename);
  322.   Rewrite(outfile);
  323.   size := Convert_Size(arg);
  324.   GotoXY(1,21);
  325.   ClrEOL;
  326.   write('File being transferred:  ',
  327.          filename,'  ',Convert_Time(arg),'  ',
  328.          Convert_Date(arg),'  ',size:8:0,' bytes');
  329.   cluster := 256*Dir[arg+28] + Dir[arg+27];
  330.   GotoXY(1,22);
  331.   ClrEOL;
  332.   write('Cluster ',cluster:3);
  333.   repeat
  334.     start := Convert(cluster);
  335.     for m := start to start+SPC-1 do
  336.       begin
  337.       track := (m-1) div SPT;
  338.       if (sides = 2) then
  339.         track := Abs((track mod 2)*(sides*TPS-1) - (track div 2));
  340.       sector := ((m-1) mod SPT) + 1;
  341.       result := Read_Sector(track,sector);
  342.       if size <> 0 then
  343.         begin
  344.         if size < bytes then
  345.           begin
  346.           blocks := Trunc((size-1)/128) + 1;
  347.           BlockWrite(outfile,DMA,blocks);
  348.           end {if size < bytes}
  349.         else
  350.           BlockWrite(outfile,DMA,4);
  351.         size := Max(0,size - bytes);
  352.         end; {if size <> 0}
  353.     end; {for m}
  354.     if Next_Cluster(cluster) >= $FF8 then
  355.       done := true
  356.     else
  357.       begin
  358.       cluster := Next_Cluster(cluster);
  359.       GotoXY(1,22);
  360.       ClrEOL;
  361.       write('Cluster ',cluster:3);
  362.       end;
  363.   until done;
  364.   Close(outfile);
  365.   end; {Procedure Transfer_File}
  366.  
  367. Procedure Check_Entries;
  368.   var
  369.     offset,j      : integer;
  370.     check1,check2 : byte;
  371.   begin
  372.   for j := 1 to (bytes div 32) do
  373.     begin
  374.     offset := (j-1)*32;
  375.     check1 := Dir[offset+1];
  376.     check2 := Dir[offset+12];
  377.     if not (check1 in [$00,$2E,$E5]) and not (check2 in [$08,$10]) then
  378.       Transfer_File(offset);
  379.     end; {for j}
  380.   end; {Procedure Check_Entries}
  381.  
  382. Procedure Load_Directory;
  383.   var
  384.     k : integer;
  385.   begin
  386.   for k := 1 to bytes do
  387.     Dir[k] := DMA[k];
  388.   end; {Procedure Load_Directory}
  389.  
  390. Procedure Search_Directory;
  391.   var
  392.     track,
  393.     sector,
  394.     start,i : integer;
  395.     result  : boolean;
  396.   begin
  397.   start := RSS + NOF*FATS;
  398.   for i := 1 to SPD do
  399.     begin
  400.     GotoXY(1,20);
  401.     ClrEOL;
  402.     write('Directory Sector ',i);
  403.     sector := start + i;
  404.     track := (sector-1) div SPT;
  405.     sector := ((sector-1) mod SPT) + 1;
  406.     if (sides = 2) then
  407.       track := Abs((track mod 2)*(sides*TPS-1) - (track div 2));
  408.     result := Read_Sector(track,sector);
  409.     Load_Directory;
  410.     Check_Entries;
  411.     end; {for i}
  412.   end; {Procedure Search_Directory}
  413.  
  414. BEGIN
  415.  
  416.   ClrScr;
  417.   writeln('This program is designed to read IBM PC/XT diskettes,');
  418.   writeln('either SS or DS, and transfer the files on that diskette');
  419.   writeln('to a CP/M formatted diskette.  While written for the H-89');
  420.   writeln('using the Magnolia disk controller, it should work on any');
  421.   writeln('CP/M system which supports a format compatible with the IBM');
  422.   writeln('format.  It should also work for MS-DOS diskettes.');
  423.   writeln;
  424.  
  425. {Ensure system is prepared to read IBM format diskette}
  426.   writeln('Did you set the target drive to read IBM compatible format');
  427.   write('before running this program?  ');
  428.   repeat
  429.     read(kbd,response);
  430.     response := Upcase(response);
  431.     valid := true;
  432.     case response of
  433.       'Y' : writeln('Yes');
  434.       'N' : begin
  435.             writeln('No');
  436.             writeln;
  437.             writeln('You must exit and configure target drive.');
  438.             goto exit;
  439.             end; {No}
  440.     else
  441.             valid := false;
  442.     end; {case}
  443.   until valid;
  444.   writeln;
  445.  
  446. {Specify drives to read IBM diskette from and write CP/M files on}
  447.   writeln('Insert CP/M (target) diskette in Drive ',target,': and IBM PC/XT');
  448.   writeln('(source) diskette in Drive ',source,':.');
  449.   writeln;
  450.   write('Hit any key to begin.');
  451.   read(kbd,response);
  452.   valid := Select_Disk(source);
  453.   writeln;
  454.  
  455. {Read FATs and compare}
  456.   GotoXY(1,16);
  457.   ClrEOL;
  458.   writeln('Reading FAT Number 1');
  459.   Read_FAT(1);
  460.   GotoXY(1,16);
  461.   ClrEOL;
  462.   writeln('Reading FAT Number 2');
  463.   Read_FAT(2);
  464.   GotoXY(1,16);
  465.   ClrEOL;
  466.   write('Comparing FATs -- ');
  467.   valid := Compare_FATs;
  468.   if valid then
  469.     writeln('Successful compare')
  470.   else
  471.     goto exit;
  472.  
  473. {Determine Media Type and set media-peculiar parameters}
  474.   MD := FAT[1,1];
  475.   case MD of
  476.     $FC : begin
  477.           sides := 1;
  478.           SPC := 1;
  479.           SPD := 4;
  480.           end; {MD = $FC}
  481.     $FD : begin
  482.           sides := 2;
  483.           SPC := 2;
  484.           SPD := 7;
  485.           end; {MD = $FD}
  486.   else
  487.           begin
  488.           GotoXY(1,24);
  489.           ClrEOL;
  490.           write('Unrecognized Media Descriptor Byte');
  491.           Delay(1000);
  492.           goto exit;
  493.           end; {else}
  494.   end; {case}
  495.  
  496. {Transfer files}
  497.   Search_Directory;
  498.  
  499.   Set_DMA($0080);
  500.  
  501.   GotoXY(1,24);
  502.   ClrEOL;
  503.   writeln('File transfer completed.');
  504.  
  505. exit:
  506.  
  507. END.
  508.