home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DISKIO.ZIP / DISKIO.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  3.7 KB  |  138 lines
  1. PROGRAM DiskIo;
  2.  
  3.   {
  4.   | Purpose : Allow direct disk reads and writes via BIOS INTs
  5.   | Author  : David A. Peterson
  6.   | Created : 6 Dec 1985
  7.   | Mods    : < Listed most recent first >
  8.   }
  9.  
  10.   CONST
  11.     Null       =   #00;
  12.     ReadDisk   =   $13; { Absolute disk read  via BIOS INTerrupt }
  13.     WriteDisk  =   $13; { Absolute disk write via BIOS INTerrupt }
  14.     BufferSize = 32767; { Number of bytes for disk buffer use    }
  15.     DriveA     =     0;
  16.     DriveB     =     1;
  17.     DriveC     =     2;
  18.     DriveD     =     3;
  19.  
  20.   TYPE
  21.     DiskBuffer = ARRAY [0 .. 0] OF Byte;
  22.     _String    = String[80];
  23.     Registers  =
  24.       RECORD
  25.         Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : Integer
  26.       END;
  27.  
  28.   VAR
  29.     DiskBuf : ^DiskBuffer;
  30.     Regs    : Registers;
  31.     Count   : Integer;
  32.  
  33.   FUNCTION Bit ( Check, Num : Integer ) : Byte;
  34.  
  35.     VAR
  36.       Test : Integer;
  37.  
  38.     BEGIN { Bit }
  39.       Test := 1 SHL Num;
  40.       Bit  := Ord ( (Check AND Test) > 0)
  41.     END;  { Bit }
  42.  
  43.   FUNCTION DiskRead ( Drive, Head, Track, Sector, Number : Integer ) : Byte;
  44.  
  45.     BEGIN { DiskRead }
  46.       IF      Number = 0 THEN
  47.         BEGIN
  48.           WriteLn;
  49.           WriteLn ('No data to transfer')
  50.         END
  51.       ELSE IF Number > 255 THEN
  52.         BEGIN
  53.           WriteLn;
  54.           WriteLn ('Too many sectors to read - ', Number)
  55.         END;
  56.       WITH Regs DO
  57.         BEGIN
  58.           Ax := Number + 2 * 256;
  59.           Dx := Drive + Head * 256;
  60.           Cx := Sector + Track * 256;
  61.           Es := Seg (DiskBuf);
  62.           Bx := Ofs (DiskBuf)
  63.         END;
  64.       Intr (ReadDisk, Regs);
  65.       IF Bit (Regs.Flags, 0) = 1 THEN
  66.         Write (' Error ')
  67.       ELSE
  68.         BEGIN
  69.           FOR Count := 0 TO 15 DO
  70.             Write (Bit (Regs.Flags, Count) );
  71.           Write (' ')
  72.         END;
  73.       DiskRead := Regs.Ax DIV 256
  74.     END;  { DiskRead }
  75.  
  76.   FUNCTION DiskWrite ( Drive, Head, Track, Sector, Number : Integer ) : Byte;
  77.  
  78.     BEGIN { DiskWrite }
  79.       IF      Number = 0 THEN
  80.         BEGIN
  81.           WriteLn;
  82.           WriteLn ('No data to transfer')
  83.         END
  84.       ELSE IF Number > 255 THEN
  85.         BEGIN
  86.           WriteLn;
  87.           WriteLn ('Too many sectors to write - ', Number)
  88.         END;
  89.       WITH Regs DO
  90.         BEGIN
  91.           Ax := Number + 3 * 256;
  92.           Dx := Drive + Head * 256;
  93.           Cx := Sector + Track * 256;
  94.           Es := Seg (DiskBuf);
  95.           Bx := Ofs (DiskBuf)
  96.         END;
  97.       Intr (WriteDisk, Regs);
  98.       IF Bit (Regs.Flags, 0) = 1 THEN
  99.         Write (' Error ')
  100.       ELSE
  101.         BEGIN
  102.           FOR Count := 0 TO 15 DO
  103.             Write (Bit (Regs.Flags, Count) );
  104.           Write (' ')
  105.         END;
  106.       DiskWrite := Regs.Ax DIV 256
  107.     END;  { DiskWrite }
  108.  
  109.   FUNCTION ErrorStr ( ErrorNum : Byte ) : _String;
  110.  
  111.     BEGIN { ErrorStr }
  112.       CASE ErrorNum OF
  113.         $00 : ErrorStr := 'Ok';
  114.         $01 : ErrorStr := 'Bad command';
  115.         $02 : ErrorStr := 'Address mark not found';
  116.         $03 : ErrorStr := 'Write protected disk';
  117.         $04 : ErrorStr := 'Requested sector not found';
  118.         $08 : ErrorStr := 'DMA overrun';
  119.         $09 : ErrorStr := 'Attempt to cross 64K boundary';
  120.         $10 : ErrorStr := 'Bad CRC on disk read';
  121.         $20 : ErrorStr := 'NEC controller has failed';
  122.         $40 : ErrorStr := 'Bad seek';
  123.         $80 : ErrorStr := 'Drive timed out'
  124.       ELSE
  125.         BEGIN
  126.           Write (ErrorNum, ' ');
  127.           ErrorStr := 'Unknown error'
  128.         END
  129.       END
  130.     END;  { ErrorStr }
  131.  
  132.   BEGIN { DiskIo }
  133.     New (DiskBuf);
  134.     GetMem (DiskBuf, BufferSize);
  135.     WriteLn;
  136.     WriteLn ('Disk read ', ErrorStr (DiskRead (DriveB, 0, 0, 1, 1) ) )
  137.   END   { DiskIo }.
  138.