home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / dskdmp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  7.1 KB  |  232 lines
  1. { DSKDMP.PAS of JUGPDS Vol.11 by M. Miyao (No.78) }
  2.  
  3. program dskdmp(input,output);
  4.  
  5. const
  6.     maxdsknminus1 =   4;
  7.     maxtrknum     =  40;
  8.     mintrknum     =   0;
  9.     maxsecnum     =  63;
  10.     minsecnum     =   0;
  11.     errorcode     =  -1;
  12.     CR            = $0D;
  13.     LF            = $0A;
  14.     HOMEDISK      =   3; { Turbo Pascal is on D/3 disk }
  15.  
  16. type
  17.     hex2 = string[2];
  18.     hex4 = string[4];
  19.  
  20. var  i,error  : integer;
  21.      ans,adrs : integer;
  22.      dskbuf   : array[0..127] of byte;
  23.      chans    : char;
  24.      incdec   : ( inc, dec , noi );
  25.      trksec   : ( track, sector, nos );
  26.      trk      : 0..maxtrknum;
  27.      sec      : 0..maxsecnum;
  28.      disk     : 0..maxdsknminus1;
  29.  
  30. function peek( adr : integer ) : byte;
  31.  
  32.     begin peek := mem[adr]; end;
  33.  
  34. procedure poke( adr : integer; data : byte );
  35.  
  36.     begin mem[adr] := data; end;
  37.  
  38.  
  39. function hex2cnv( i : integer ) : hex2;
  40.     var j,k : integer;
  41.         st  : hex2;
  42.         ch  : byte;
  43.  
  44.     begin
  45.          st := '';
  46.          j := i;
  47.          for k:=1 to 2 do
  48.              begin
  49.                  ch :=( j mod $10 );
  50.                  if ch > 9 then ch := ch + byte('@')-9
  51.                            else ch := ch + byte('0');
  52.                  st := chr(ch) + st;
  53.                  j:=j div $10;
  54.              end;
  55.          hex2cnv:=st;
  56.      end;
  57.  
  58.  
  59. function hex4cnv( i : integer ): hex4;
  60.      begin
  61.           hex4cnv:=hex2cnv(hi(i))+hex2cnv(lo(i));
  62.      end;
  63.  
  64. procedure dump( sadd, line : integer; faddress : boolean );
  65.   var
  66.        address     : integer;
  67.        hia, loa, j : byte;
  68.        stbuf       : array[0..$f] of char;
  69.  
  70.      begin
  71.           for hia:=0 to line-1 do
  72.               begin
  73.                   if faddress then write( hex4cnv(sadd+hia*$10),'  ');
  74.                   for loa:= 0 to $F do
  75.                       begin
  76.                           address := sadd+hia*$10+loa;
  77.                           write(hex2cnv(peek(address)),' ');
  78.                           stbuf[loa] := chr(peek(address));
  79.                           if (stbuf[loa] < ' ') or (stbuf[loa] > '~')
  80.                                           then  stbuf[loa]:= '.' ;
  81.                       end;
  82.                   write('    ');
  83.                   for j:=0 to $f do
  84.                       write(stbuf[j]);
  85.                   writeln;
  86.               end;
  87.       end;
  88.  
  89. function get1sect( disk, trk, sec : integer ) : integer;
  90.  
  91.    var error : integer;
  92.  
  93.    begin
  94.      if     (trk<=maxtrknum) and (trk>=mintrknum)
  95.         and (sec<=maxsecnum) and (sec>=minsecnum)
  96.         and (disk<=maxdsknminus1) and (disk>=0) then
  97.        begin
  98.          error:=bioshl(  8 {seldsk}, disk );
  99.          bios(  9 {settrk}, trk  );
  100.          bios( 10 {setsec}, sec  );
  101.          bios( 11 {setdma}, addr( dskbuf ));
  102.          get1sect:= -( bios( 12 {read} )  and $00FF );
  103.        end
  104.      else get1sect:= errorcode;
  105.    end;
  106.  
  107. procedure memdump;
  108.  
  109. var i : integer;
  110.  
  111.     begin
  112.         adrs:=0;
  113.         repeat
  114.              write('Start address (Hex) = ');
  115.              readln(adrs);
  116.              writeln;
  117.              write( '      ');
  118.              for i:= 0 to $F do write ( hex2cnv( i ), ' ');
  119.              writeln;
  120.              for i:= 0 to $E do write ( '-----');
  121.              writeln;
  122.              dump( adrs, 8, true );
  123.              adrs := adrs + $80;
  124.         until (adrs <= 0) and (adrs > $FF80) ;
  125.     end;
  126.  
  127. procedure dumpexec;
  128.  
  129.     begin
  130.         error := get1sect(disk,trk,sec);
  131.         writeln;
  132.         if error <> errorcode then begin
  133.                  writeln('Disk = ', char(disk + byte('A'))
  134.                           , '     Track = ',trk, '    Sector = ',sec );
  135.                  writeln;
  136.                  for i:= 0 to $F do
  137.                      write ( hex2cnv( i ), ' ');
  138.                  writeln;
  139.                  for i:= 0 to $10 do write ( '----');
  140.                  writeln;
  141.                  dump(addr(dskbuf),8,false);
  142.                  case trksec of
  143.                       track : case incdec of
  144.                                    inc : trk := trk + 1;
  145.                                    dec : trk := trk - 1;
  146.                       end;
  147.                       sector: case incdec of
  148.                                    inc : sec := sec + 1;
  149.                                    dec : sec := sec - 1;
  150.                       end;
  151.                  end;
  152.         end;
  153.     end;
  154.  
  155. procedure dskdump;
  156.  
  157. var
  158.     ansc   : char;
  159.     i      : integer;
  160.  
  161. begin
  162.    incdec := noi;
  163.    trksec := nos;
  164.    trk    := 0;
  165.    sec    := 0;
  166.    disk   := 0;
  167.    repeat
  168.        writeln('Q)uit or R)andum, or ');
  169.        write(  'default Inc/Decrement is T)rack or S)ector   ' );
  170.        ansc := char(bios(2)){ conin function call };
  171.        while not(( ansc = 'T' ) or ( ansc = 't' )
  172.               or ( ansc = 'S' ) or ( ansc = 's' )
  173.               or ( ansc = 'R' ) or ( ansc = 'r' )
  174.               or ( ansc = 'Q' ) or ( ansc = 'q' )
  175.               or ( ansc = char(CR)) or ( ansc = char(LF)) )
  176.           do ansc := char(bios(2)){ conin function call };
  177.        writeln ( char( ansc ));
  178.        case ansc of
  179.           'Q','q' : ;
  180.           else
  181.               case ansc of
  182.                    'R','r': begin
  183.                             writeln('Disk number A->0 ');
  184.                             writeln('            B->1 ');
  185.                             writeln('            C->2 ');
  186.                             writeln('            D->3 ');
  187.                             writeln('            E->4 ');
  188.                             write  ('            Which disk select ?    ');
  189.                             readln ( disk );
  190.                             if not((disk<0)or(disk>maxdsknminus1)) then begin
  191.                                write( 'Track number            = ');
  192.                                readln ( trk );
  193.                                write( 'Sector number           = ');
  194.                                readln ( sec );
  195.                             end;
  196.                             dumpexec;
  197.                           end;
  198.                    'T','t','S','s': begin
  199.                              case ansc of
  200.                                   'T','t' : trksec := track;
  201.                                   'S','s' : trksec := sector;
  202.                              end;
  203.                              write( '                  I)ncriment or D)ecriment ');
  204.                              chans := char(bios(2)){ conin function call };
  205.                              while not((chans='I')or(chans='i')or(chans='D')
  206.                                 or(chans='d')) do
  207.                                 chans := char(bios(2)){ conin function call };
  208.                              writeln ( char( chans ));
  209.                              case chans of
  210.                                   'I','i' : incdec := inc;
  211.                                   'D','d' : incdec := dec;
  212.                              end;
  213.                    end;
  214.                    else dumpexec;
  215.               end;
  216.      end;
  217.    until (disk<0)or(disk>maxdsknminus1)or(ansc = 'Q')or(ansc='q')
  218. end;
  219.  
  220. begin { main program }
  221.     writeln ( '** DSKDMP **');
  222.     write ( 'M)emory or D)isk dump?');
  223.     chans := char(bios(2));
  224.     while not((chans='M')or(chans='m')or(chans='D')
  225.       or(chans='d')) do chans := char(bios(2)){ conin function call };
  226.     writeln ( char( chans ));
  227.     case chans of
  228.          'M','m' : memdump;
  229.          'D','d' : dskdump;
  230.     end;
  231.     error:=bioshl(  8 {seldsk}, HOMEDISK );
  232. end.