home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / diskdef.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  4.8 KB  |  176 lines
  1. { DISKDEF.PAS of JUGCPM Vol.11 }
  2. program simulate_diskdef;
  3.  
  4. type ms  = string[30];
  5.      hx2 = string[2];
  6.      hx4 = string[4];
  7.  
  8. var
  9.    als0, css0 : integer;
  10.    dn, fsc, lsc, skf, bls, dks, dir, cks, ofs : integer;
  11.  
  12. function hex2( i : integer ) : hx2;
  13.     var j,k : integer;
  14.         st  : hx2;
  15.         ch  : byte;
  16.  
  17.     begin
  18.          st := '';
  19.          j := i;
  20.          for k:=1 to 2 do
  21.              begin
  22.                  ch :=( j mod $10 );
  23.                  if ch > 9 then ch := ch + byte('@')-9
  24.                            else ch := ch + byte('0');
  25.                  st := chr(ch) + st;
  26.                  j:=j div $10;
  27.              end;
  28.          hex2:=st;
  29.      end;
  30.  
  31.  
  32. function hex4( i : integer ): hx4;
  33.  
  34.      begin
  35.           hex4:=hex2(hi(i))+hex2(lo(i));
  36.      end;
  37.  
  38.  
  39. function gcd( m, n : integer ) : integer;
  40.  
  41. var
  42.    mm, nn, r, x, i : integer;
  43.  
  44. begin
  45.      r := 0;
  46.      mm := m;
  47.      nn := n;
  48.      i := 0;
  49.      repeat
  50.            i := i + 1;
  51.            x := mm div nn;
  52.            r := mm - x * nn;
  53.            if r <> 0 then  begin
  54.               mm := nn;
  55.               nn := r;
  56.            end;
  57.      until ( r = 0 ) or ( i = $7FFF );
  58.      gcd := nn;
  59. end;
  60.  
  61. procedure diskdef( fsc, lsc, skf, bls, dks, dir, cks, ofs : integer );
  62.  
  63. var
  64.    i, sectors, secmax, blkval, blkshf, blkmsk, extmsk : integer;
  65.    dirrem, dirbks, nxtsec, nxtbas, neltst, nelts : integer;
  66.    dirblk : integer;
  67.  
  68. begin
  69.     secmax  := lsc - fsc;
  70.     sectors := secmax + 1;
  71.     if ( dks mod 8 ) = 0 then  als0 := dks div 8
  72.     else                       als0 := dks div 8 + 1;
  73.     css0    := cks div 4;
  74.     blkval  := bls div 128;
  75.     blkshf  := 0;
  76.     blkmsk  := 0;
  77.     while ( blkshf < 16 ) and ( blkval <> 1 ) do begin
  78.           blkshf  := blkshf + 1;
  79.           blkmsk  := blkmsk * 2 + 1;
  80.           blkval  := blkval div 2;
  81.     end;
  82.     blkval  := bls div 1024;
  83.     extmsk  := 0;
  84.     i       := 0;
  85.     while ( i < 16 ) and ( blkval <> 1 ) do begin
  86.           i       := i + 1;
  87.           extmsk  := extmsk * 2 + 1;
  88.           blkval  := blkval div 2;
  89.     end;
  90.     if dks > 256 then extmsk := extmsk div 2;
  91.     dirrem  := dir;
  92.     dirbks  := bls div 32;
  93.     dirblk  := 0;
  94.     i       := 0;
  95.     while ( i < 16 ) and ( dirrem <> 0 ) do begin
  96.           i      := i + 1;
  97.           dirblk := ( dirblk shr 1 ) or $8000;
  98.           if dirrem > dirbks then dirrem := dirrem - dirbks
  99.           else                    dirrem := 0;
  100.     end;
  101.     writeln('Disk Block Address');
  102.     writeln('     DW sectors per track = ',hex4( sectors   ));
  103.     writeln('     DB block shift       = ',hex2( blkshf    ));
  104.     writeln('     DB block mask        = ',hex2( blkmsk    ));
  105.     writeln('     DB extent mask       = ',hex2( extmsk    ));
  106.     writeln('     DW disk-1            = ',hex4( dks - 1   ));
  107.     writeln('     DW directory max     = ',hex4( dir - 1   ));
  108.     writeln('     DB allocation vec.0  = ',hex2( hi(dirblk)));
  109.     writeln('     DB allocation vec.1  = ',hex2( lo(dirblk)));
  110.     writeln('     DW check size        = ',hex4( cks div 4 ));
  111.     writeln('     DW offset            = ',hex4( ofs       ));
  112.     if skf = 0 then writeln ( 'XLT table := 0')
  113.     else begin
  114.          nxtsec   := 0;
  115.          nxtbas   := 0;
  116.          neltst   := sectors div gcd(sectors,skf);
  117.          nelts    := neltst;
  118.          writeln('Translation table here');
  119.          if sectors < 256 then
  120.                 write('      DB sectors ' )
  121.          else   write('      DW sectors ' );
  122.          for i := 1 to sectors do  begin
  123.              if sectors < 256 then
  124.                     write(' ',hex2( nxtsec + fsc ))
  125.              else   write(' ',hex4( nxtsec + fsc ));
  126.              nxtsec   := nxtsec + skf;
  127.              if nxtsec >= sectors then nxtsec := nxtsec - sectors;
  128.              nelts    := nelts - 1;
  129.              if nelts = 0 then begin
  130.                 nxtbas  := nxtbas + 1;
  131.                 nxtsec  := nxtbas;
  132.                 nelts   := neltst;
  133.              end;
  134.          end;
  135.          writeln;
  136.     end;
  137. end;
  138.  
  139. procedure endef;
  140.  
  141. begin
  142.     writeln('Here Directory buffer of 128 byte area');
  143.     writeln('Allocation vector work ALV0 = ', als0, ' byte' );
  144.     writeln('Dir Check  vector work CSV0 = ', css0, ' byte' );
  145. end;
  146.  
  147. function ask( message : ms ) : integer;
  148.  
  149. var ans : integer;
  150.  
  151. begin
  152.     write( message );
  153.     readln( ans );
  154.     ask := ans;
  155. end;
  156.  
  157. procedure askparam( var  fsc, lsc, skf, bls, dks, dir, cks, ofs : integer );
  158.  
  159. begin
  160.      fsc := ask( 'First sector number           ? ');
  161.      lsc := ask( 'Last  sector number           ? ');
  162.      skf := ask( 'Skew factor  0 if not         ? ');
  163.      bls := ask( 'Block size, 1024,2048...16382 ? ');
  164.      dks := ask( 'Disk size in blocks           ? ');
  165.      dir := ask( 'Number of Directory element   ? ');
  166.      cks := dir;
  167.      ofs := ask( 'Offset of track/number of sys ? ');
  168. end;
  169.  
  170.  
  171. begin {main}
  172.     askparam( fsc, lsc, skf, bls, dks, dir, cks, ofs );
  173.     diskdef(  fsc, lsc, skf, bls, dks, dir, cks, ofs );
  174.     endef;
  175. end.
  176.