🚀 go-pugleaf

zcaccau@cs.ucl.ac.uk writes in article <1996Feb1.125721.18589@ucl.ac.uk>:
> 
> 
> In modula-2 is there any way that you can determine whether a floppy drive
> currently contains a disk and whether it is correctly formatted,  (i.e.
> whether the drive is readable), without getting the DOS abort, retry or
> ignore message.  I would like this to work with CD's, IOMEGA ZipDrives,
> etc... as well.  I have looked through a list of interrupts, but am unable
> to find one to do this.  I am able to tell whether the drive exists, by
> using the setdrive & getdrive interrupts.

This has nothing special to do with Modula, its DOS.
You have to use DOS Interrupts and write an "Critical Error Handler-Int 24h"
to intercept the error code. You can analyse the received error code in
the Int24 Handler. You will receive information about the device - block
( eg. Diskette or Disk ) or character device ( eg. LPT or COM ) and the type
of operation involved ( eg. read, write ). You can transfer information back
of what to do ( eg. RETRY, ABORT, FAIL, IGNORE ) to DOS.

I use it in my own programs.
The following code is for Logitech Modula Vers 3.4. The Multiscope Vers 4.0
compiler needs some changes because identifier names have changed a little
and moved to other modules. But it should be no problem ( Multiscope Vers 4.0
is the Stonybrook compiler with slightly modified Librarys )


DEFINITION MODULE Int24 ;


TYPE
  ContCode   = ( ignore , retry , abort , fail ) ;
  DiskOp     = ( read , write ) ;
  DiskPart   = ( dos , fat , dir , data ) ;
  DeviceName = ARRAY [ 0 .. 7 ] OF CHAR ;
  DeviceType = ( block , char ) ;
  Int24Error = ( WriteProtect , UnknownUnit , DriveNotReady ,
                 UnknownCommand , DataError , 
                 BadRequestStructureLen , SeekError ,
                 UnknownMedium , SectorNotFound , 
                 PrinterOutOfPaper , WriteFault , ReadFault ,
                 GeneralFailure ) ;
  ErrorInfo  = RECORD
                 devname  : DeviceName ;
                 CASE devtype : DeviceType OF
                   block : diskop  : DiskOp ;
                           diskloc : DiskPart ;
                 | char  : 
                 END (* CASE *)
               END ; (* RECORD *)
  Int24Proc  = PROCEDURE ( ErrorInfo , Int24Error ) : ContCode ;


PROCEDURE StartInt24 ( errorproc : Int24Proc ) ;

PROCEDURE StopInt24 ;

END Int24 .


IMPLEMENTATION MODULE Int24 ;

FROM SYSTEM IMPORT
  SI,BP,
  NEWPROCESS , TRANSFER , IOTRANSFER ,
  PROCESS , ADDRESS ,
  WORD , BYTE , ADR , SIZE ;

FROM RTSMain IMPORT
  ProcessDescriptor ;

FROM Devices IMPORT
  InstallHandler ,
  SaveInterruptVector ,
  RestoreInterruptVector ;

CONST
  Int24  = 24H ;

TYPE 
  DeviceBlock    = RECORD 
                     notusedbyus0 : ADDRESS ;
                     notusedbyus1 : BITSET ;
                     notusedbyus2 : WORD ;
                     notusedbyus3 : WORD ;
                     devicename   : DeviceName ;
                   END ;
  ProcessPointer = RECORD
                     CASE BOOLEAN OF
                       TRUE  : Process : PROCESS ;
                     | FALSE : Point   : POINTER TO ProcessDescriptor ;
                     END ;
                   END ;


VAR
  active       : BOOLEAN ;
  OldVector    : ADDRESS ;
  WorkSpace    : ARRAY [ 0 .. 1000 ] OF BYTE ;
  IntProc      : Int24Proc ;
  Int24Process : PROCESS ;
  Main         : ProcessPointer ;



PROCEDURE StartInt24 ( errorproc : Int24Proc ) ;
BEGIN
  IF NOT active THEN
    IntProc := errorproc ; 
    SaveInterruptVector ( Int24 , OldVector ) ;
    active := TRUE ;
    NEWPROCESS ( Int24Service , ADR ( WorkSpace ) ,
                 SIZE ( WorkSpace ) , Int24Process ) ;
    TRANSFER ( Main.Process , Int24Process ) ;
  END ;
END StartInt24 ;




PROCEDURE StopInt24 ;
BEGIN
  (*** this functions doesn't work until now.
       subsequent StartInt24 and StopInt24 will
       lead to an abort of the programm with the
       message : ===> too many concurrent I/O processes
       but is no problem : never need to call Start/Stop several times

       jm 20-feb-90
  ***)
  IF active THEN
    active := FALSE ;
    RestoreInterruptVector ( Int24 , OldVector ) ;
  END ;
END StopInt24 ;



PROCEDURE Int24Service ;
VAR
  workset : BITSET ;
  info    : ErrorInfo ;
  work    : RECORD
              CASE BOOLEAN OF 
                TRUE  : adr   : ADDRESS ;
              | FALSE : point : POINTER TO DeviceBlock
              END ;
            END ;


BEGIN
  InstallHandler ( Int24Process , Int24 ) ;
  LOOP
    IOTRANSFER ( Int24Process , Main.Process , Int24 ) ;
    workset := BITSET ( Main.Point^.topStack^.AX ) ;
    WITH Main.Point^ DO
      work.adr.OFFSET  := SI ;
      work.adr.SEGMENT := BP ;
    END ;
    WITH info DO
      IF 15 IN workset THEN
        devtype := char ;
        devname := work.point^.devicename ;
      ELSE
        devtype := block ;
        devname := '  (DISK)' ;
        devname[0] := CHR ( Main.Point^.topStack^.AX MOD 100H + ORD ( 'A' ) ) ;
        IF 8 IN workset THEN
          diskop := write ;
        ELSE
          diskop := read ;
        END ;
        diskloc := VAL ( DiskPart ,
                         ( Main.Point^.topStack^.AX MOD 800H ) DIV 200H ) ;
      END ;
    END ; (* WITH *)
    WITH Main.Point^.topStack^ DO
      AX := ORD ( IntProc ( info , VAL ( Int24Error , DI MOD 10H ) ) ) ;
    END ; (* WITH *)
  END ; (* LOOP *)
END Int24Service ;


BEGIN

  active := FALSE ;

END Int24 .





Example Handler - located in application


FROM Int24 IMPORT
  ContCode , DiskPart ,  DiskOp ,
  DeviceType , Int24Error ,
  ErrorInfo ,  StartInt24 ;




  PROCEDURE ErrorHandler ( Info : ErrorInfo ; Error : Int24Error ) : ContCode ;
  VAR
    return : ContCode ;
    str    : ARRAY [ 0 .. 4 ] OF CHAR ;
  BEGIN

    Sounds.Sound ( 4000 ) ;
    CASE Info.devtype OF
      block :
        (*                       1    1    2    2    3    3    4    4    5  *)
        (*             0....5....0....5....0....5....0....5....0....5....0  *)
        Cursor ( 10 , 20 ) ;
        WriteString ( ' Fehler bei Zugriff auf Diskette ' ) ;
        Cursor ( 10 , 21 ) ;
        WriteString ( ' Name : ' ) ;
        WriteString ( Info.devname ) ;
        CASE Info.diskop OF
          read  : WriteString ( ' during read of ' ) ;
        | write : WriteString ( ' during write of ' ) ;
        END ;
        CASE Info.diskloc OF
          dos  : WriteString ( ' DOS' ) ;
        | fat  : WriteString ( ' FAT' ) ;
        | dir  : WriteString ( ' DIR' ) ;
        | data : WriteString ( ' DATA' ) ;
        END ;
        Cursor ( 10 , 22 ) ;
        CASE Error OF
          WriteProtect      : WriteString ( ' Entferne Schreibschutz' ) ;
        | DriveNotReady     : WriteString ( ' Lege Diskette ein und Schlieáe Klappe' ) ; 
        | DataError         : WriteString ( ' Schlechte Diskette, probiere andere' ) ;
        ELSE
          WriteString ( ' Fehler # : ' ) ;
          CardToString ( ORD ( Error ) , str , 3 ) ;
          WriteString ( str ) ;
        END ; (* CASE *)
        return := retry ; 
    | char :
        (*                       1    1    2    2    3    3    4    4    5  *)
        (*             0....5....0....5....0....5....0....5....0....5....0  *)
        Cursor ( 10 , 20 ) ;
        WriteString ( ' Fehler bei Zugriff auf Printer ' ) ;
        WriteString ( ' Name : ' ) ;
        Cursor ( 10 , 21 ) ;
        WriteString ( Info.devname ) ;
        Cursor ( 10 , 22 ) ;
        CASE Error OF
          DriveNotReady     : WriteString ( ' Drucker ausgeschaltet' ) ; 
        | PrinterOutOfPaper : WriteString ( ' Kein Papier in Drucker' ) ;
        | WriteFault        : WriteString ( ' Drucker ist nicht bereit' ) ;
        ELSE
          WriteString ( ' Fehler # : ' ) ;
          CardToString ( ORD ( Error ) , str , 3 ) ;
          WriteString ( str ) ;
        END ; (* CASE *)
        return := fail ;
    END ; (* CASE devtype OF *)
    Delay.Delay ( 1000 ) ;
    Sounds.NoSound ;
    RETURN return ;
  END ErrorHandler ;


In the first lines of the main body write :

  StartInt24 ( ErrorHandler ) ;

Cursor and WriteString position the cursor an the screen and write to the
screen. In "ErrorHandler" donït use any DOS Interrupt ( but you can write
to screen ) because DOS isnït reentrant.

This "ErrorHandler" handles not all possible errors, only those I need
in this application.
Any book about DOS programming ( Ray Duncan:Advanced MSDOS .. ) should give
you information about Int24H

Hope this helps

Joachim

> 
> Any help would be appreciated.
> 
> Chris
> 
Joachim Michely, Steinkaule 50, 53757 St-Augustin, Germany
Voice/Fax  : ++49-(0)2241-337938 ( and answering machine )
Internet   : michely@nemeter.dinoco.DE
CompuServe : 100024,2476