home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / dpr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  5.9 KB  |  205 lines
  1. { DPR.PAS of JUGPDS Vol.11 by M. Miyao (No.78) }
  2.  
  3. program disk_parameter_read(input, output );
  4.  
  5. const
  6.      CR     = $0D;
  7.      LF     = $0A;
  8.      SRSDSK =   3;
  9.  
  10. type
  11.      hex2 = string[2];
  12.      hex4 = string[4];
  13.  
  14. var
  15.      ans    : char;
  16.      diskno : integer;
  17.  
  18. function peek( adr : integer ) : byte;
  19.     begin peek := mem[adr]; end;
  20.  
  21. procedure poke( adr : integer; data : byte );
  22.     begin mem[adr] := data; end;
  23.  
  24.  
  25. {
  26.   seldsk------> getdphadr(disk#)
  27.                     |
  28.   XLTTBL n          |
  29.   .--------.  <-----'  sector trans tavle
  30.   | XLTTBL |  --.    .--------.
  31.   :--------:    '--> |   1    |        dirbuf
  32.   |  0000  |         |   7    |     .------------------------------------.
  33.   :--------:         |   :    |  .->|   128 byte directory access buffer |
  34.   |  0000  |         |   :    |  |  '------------------------------------'
  35.   :--------:         |   22   |  |
  36.   |  0000  |         '--------'  |        .------------.
  37.   :--------:                     |   .--->| sector(l)  | DPBADR
  38.   | DIRBUF |---------------------'   |    '------------'
  39.   :--------:                         |          :
  40.   | DPBADR |-------------------------'          :
  41.   :--------:               .---------.    .------------.
  42.   |  CSV n |-------------> | CSV n   |    | sector(h)  |
  43.   :--------:               | check   |    :------------:
  44.   |  ALV n |--> .--------. | vectors |    | offset(h)  |
  45.   '--------'    | ALV n  | |         |    '------------'
  46.                 |alloca- | '---------'
  47.                 |tion    |
  48.                 |vectors |
  49.                 '--------'
  50. }
  51.  
  52.  
  53. function getdphadr( dsk : integer ) : integer;
  54.  
  55. begin
  56.      getdphadr := bioshl( 8 {seldisk}, dsk );
  57. end;
  58.  
  59. function getxltadr( dsk : integer ) : integer;
  60.  
  61. var
  62.     adr  : integer;
  63.  
  64. begin
  65.      adr := getdphadr( dsk );
  66.      getxltadr := peek(adr) + peek(adr+1)*256;
  67. end;
  68.  
  69. function getdpbadr( dsk : integer ) : integer;
  70.  
  71. var
  72.     adr  : integer;
  73.  
  74. begin
  75.      adr := getdphadr( dsk );
  76.      getdpbadr := peek(adr+10) + peek(adr+11)*256;
  77. end;
  78.  
  79.  
  80.  
  81. function hex2cnv( i : integer ) : hex2;
  82.     var j,k : integer;
  83.         st  : hex2;
  84.         ch  : byte;
  85.  
  86.     begin
  87.          st := '';
  88.          j := i;
  89.          for k:=1 to 2 do
  90.              begin
  91.                  ch :=( j mod $10 );
  92.                  if ch > 9 then ch := ch + byte('@')-9
  93.                            else ch := ch + byte('0');
  94.                  st := chr(ch) + st;
  95.                  j:=j div $10;
  96.              end;
  97.          hex2cnv:=st;
  98.      end;
  99.  
  100.  
  101. function hex4cnv( i : integer ): hex4;
  102.      begin
  103.           hex4cnv:=hex2cnv(hi(i))+hex2cnv(lo(i));
  104.      end;
  105.  
  106. procedure dphtblprint(dsk : integer);
  107.  
  108. var
  109.    adr   : integer;
  110.    data  : integer;
  111.  
  112.    begin
  113.        adr := getdphadr(dsk);
  114.        data := getxltadr(dsk);
  115.        if data = 0 then writeln('        No translation table')
  116.        else writeln( 'XLT table address            = ',
  117.                       hex4cnv(data));
  118.        writeln(      'Directory buffer address     = ',
  119.                       hex4cnv(peek(adr+8)+peek(adr+9)*256));
  120.        writeln(      'Disk Parameter Block address = ',
  121.                       hex4cnv(peek(adr+10)+peek(adr+11)*256));
  122.        writeln(      'Check vector address         = ',
  123.                       hex4cnv(peek(adr+12)+peek(adr+13)*256));
  124.        writeln(      'Allocation vector address    = ',
  125.                       hex4cnv(peek(adr+14)+peek(adr+15)*256));
  126.    end;
  127.  
  128.  
  129. procedure xlttblprint( dsk : integer );
  130.  
  131. var
  132.    adr   : integer;
  133.    data  : integer;
  134.    i     : integer;
  135.    sectn : integer;
  136.  
  137.    begin
  138.        adr := getxltadr( dsk );
  139.        if adr <> 0 then begin
  140.           write ('Sector read order : ');
  141.           sectn := peek(getdpbadr(dsk))+peek(getdpbadr(dsk)+1)*256;
  142.           for i := 0 to sectn-1 do
  143.               write( peek(getxltadr(dsk)+i),' ');
  144.           writeln;
  145.        end;
  146.    end;
  147.  
  148. procedure dpbtblprint( dsk : integer );
  149.  
  150. var
  151.    adr   : integer;
  152.    spt, bsh, blm, exm, dsm, drm, al0, al1, cks, off   : integer;
  153.  
  154.    begin
  155.         adr := getdpbadr(dsk);
  156.         spt := peek(adr)+peek(adr+1)*256;
  157.         bsh := peek(adr+2);
  158.         blm := peek(adr+3);
  159.         exm := peek(adr+4);
  160.         dsm := peek(adr+5)+peek(adr+6)*256;
  161.         drm := peek(adr+7)+peek(adr+8)*256;
  162.         al0 := peek(adr+9);
  163.         al1 := peek(adr+10);
  164.         cks := peek(adr+11)+peek(adr+12)*256;
  165.         off := peek(adr+13)+peek(adr+14)*256;
  166.         writeln('    Sector per Track   = ', hex4cnv( spt ), '/ ', spt );
  167.         writeln('    Block SHift        =   ', hex2cnv( bsh ), '/ ', bsh );
  168.         writeln('    BLock Mask         =   ', hex2cnv( blm ), '/ ', blm );
  169.         writeln('    EXtent Mask        =   ', hex2cnv( exm ), '/ ', exm );
  170.         writeln('    Disk Size Minus 1  = ', hex4cnv( dsm ), '/ ', dsm );
  171.         writeln('    DiRectory Minus 1  = ', hex4cnv( drm ), '/ ', drm );
  172.         writeln('    ALlocation 0       =   ', hex2cnv( al0 ), '/ ', al0 );
  173.         writeln('    ALlocation 1       =   ', hex2cnv( al1 ), '/ ', al1 );
  174.         writeln('    ChecK Size         = ', hex4cnv( cks ), '/ ', cks );
  175.         writeln('    OFFset             = ', hex4cnv( off ), '/ ', off );
  176.    end;
  177.  
  178. begin { MAIN program }
  179.   repeat
  180.     writeln('* DPR: Disk parameter Read *');
  181.     write('Disk drive name: A), B), C), D), E), or Q)uit?');
  182.     repeat
  183.       ans := char(bios(2){ conin function call});
  184.       write(ans);
  185.     until   ((ans>='a')and(ans<='e'))
  186.           or((ans>='A')and(ans<='E'))
  187.           or(ans='q')or(ans='Q');
  188.     if (((ans>='a')and(ans<='e'))or((ans>='A')and(ans<='E'))) then begin
  189.         if      (ans>='a')and(ans<='e') then diskno:=byte(ans)-byte('a')
  190.         else if (ans>='A')and(ans<='E') then diskno:=byte(ans)-byte('A');
  191.         writeln; writeln;
  192.         writeln( 'Disk Parameter Head Address  = ',
  193.                   hex4cnv(getdphadr(diskno)));
  194.         xlttblprint(diskno);
  195.         dphtblprint(diskno);
  196.         writeln( 'Disk Parameter Block address = ',
  197.                   hex4cnv(getdpbadr(diskno)));
  198.         dpbtblprint(diskno);
  199.         writeln; writeln;
  200.     end;
  201.   until (ans = 'Q') or (ans = 'q');
  202.   diskno := getdphadr(SRSDSK);
  203. end.
  204.  
  205.