(***********************************************************************

Name:           CtlCTrap.Pas
Version:        1.0


ABSTRACT:

   Provides reliable CTRL/C trapping for TURBO Pascal programs  running
   under MS-DOS and PC-DOS.

ENVIRONMENT:

   MS-DOS or PC-DOS, compiled with TURBO Pascal.

   Tested combinations:

       MS-DOS V2.11 with TURBO Pascal V3.01A (MS-DOS generic)
       MS-DOS V2.11 with TURBO Pascal V3.02A (MS-DOS generic)
       PC-DOS V2.10 with TURBO Pascal V3.00B (PC-DOS specific)
       PC-DOS V2.10 with TURBO Pascal V3.01A (PC-DOS specific)
       PC-DOS V2.10 with TURBO Pascal V3.02A (MS-DOS generic)
       PC-DOS V2.10 with TURBO Pascal V3.02A (PC-DOS specific)

AUTHOR:

   Brian Hetrick

EDIT HISTORY:

       Brian Hetrick, 12 December 1986: Version 1.0
 000 - Original creation of module.

ACKNOWLEDGMENTS:

   This is an enhanced version of the CTRLC.PAS public domain  program,
   discovered  on  the  MARKET public access bulletin board, author un-
   known.

***********************************************************************)
{.PA}
(*
*  TYPE DECLARATIONS:
*)

TYPE

   CtrlCPtr = ^ CHAR;

(*
*  CONSTANT DECLARATIONS:
*)

CONST

   CtrlCCount : INTEGER = 0;
   CtrlCFlag  : BOOLEAN = FALSE;

(*
*  VARIABLE DECLARATIONS:
*)

VAR

   CtrlCVect  : CtrlCPtr;
{.PA}
PROCEDURE CtrlCHandler;

(***********************************************************************

FUNCTIONAL DESCRIPTION:

   THIS ROUTINE MUST NOT BE CALLED BY THE CLIENT PROGRAM.  THIS ROUTINE
   MUST BE DEFINED AT THE OUTERMOST LEVEL (i.e., not nested inside  an-
   other routine).

   Control/C interrupt handler.  Called by MS-DOS when a  Control/C  is
   detected in the input stream.  Sets the Control/C flag and dismisses
   the Control/C interrupt.

   Ray Duncan's book "Advanced MS-DOS" documents the  possible  actions
   that could be taken by a Control/C handler as any one of:

    o  Take any appropriate action and execute  an  IRET.   The  MS-DOS
       function in progress will be restarted and return normally.
    o  Take any appropriate action and execute a far RETURN.  If  carry
       is  set,  MS-DOS  will abort the application and otherwise "will
       continue in the normal manner".
    o  Keep control and never return.

   The first alternative is chosen here.  Although any MS-DOS  function
   call  can by used an a Control/C interrupt handler, a TURBO function
   may have been occurring and so no TURBO functions may be used.

FORMAL PARAMETERS:

   None.

RETURN VALUE:

   None.

IMPLICIT INPUTS:

   None.

IMPLICIT OUTPUTS:

   CtrlCFlag - The Control/C flag.

SIDE EFFECTS:

   None.

***********************************************************************)

   BEGIN

   (*
    *  Standard TURBO procedure entry for  routines  at  the  outermost
    *  level.  A different entry sequence is used for routines that are
    *  within other routines (it  must  ensure  addressability  of  the
    *  outer routine's variables), and this other sequence is NOT legal
    *  for interrupt routines
    *)

                               {         PUSH    BP                   }
                               {         MOV     BP,SP                }
                               {         PUSH    BP                   }
                               {         JMP     procedure body       }

   (*
    *  Recommended TURBO interrupt procedure entry
    *)

   InLine ($50/                {         PUSH    AX                   }
           $53/                {         PUSH    BX                   }
           $51/                {         PUSH    CX                   }
           $52/                {         PUSH    DX                   }
           $56/                {         PUSH    SI                   }
           $57/                {         PUSH    DI                   }
           $1E/                {         PUSH    DS                   }
           $06/                {         PUSH    ES                   }
           $FB);               {         STI                          }

   (*
    *  Note CTRL/C occurrence.  As the data segment is not  addressable
    *  at this point, only CONST variables may be used
    *)

   CtrlCFlag := TRUE;

   (*
    *  Recommended TURBO interrupt procedure exit
    *)

   InLine ($07/                {         POP     ES                   }
           $1F/                {         POP     DS                   }
           $5F/                {         POP     DI                   }
           $5E/                {         POP     SI                   }
           $5A/                {         POP     DX                   }
           $59/                {         POP     CX                   }
           $5B/                {         POP     BX                   }
           $58/                {         POP     AX                   }
           $8B/$E5/            {         MOV     SP,BP                }
           $5D/                {         POP     BP                   }
           $CF)                {         IRET                         }

   END;
{.PA}
FUNCTION CtrlCOccurred : BOOLEAN;

(***********************************************************************

FUNCTIONAL DESCRIPTION:

   Tests whether a Control/C has occurred.  This function MUST be  used
   rather  than just checking the CtrlCFlag variable, as Control/Cs are
   detected only at MS-DOS function calls.

FORMAL PARAMETERS:

   None.

RETURN VALUE:

   TRUE - There is an unhandled Ctrl/C present.
   FALSE - There is no unhandled Ctrl/C present.

IMPLICIT INPUTS:

   CtrlCCount - The count of outstanding enables of the Control/C pack-
       age.
   CtrlCFlag - The Control/C pending flag.

IMPLICIT OUTPUTS:

   CtrlCFlag - The Control/C pending flag.

SIDE EFFECTS:

   May issue an MS-DOS function call permitting Control/C detection.

***********************************************************************)

   TYPE

       RegisterPackage = RECORD
           AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
           END;

   VAR

       Registers : RegisterPackage;

   BEGIN

   (*
    *  If the Control/C package is  not  initialized,  then  it  cannot
    *  detect Control/Cs.
    *)

   IF CtrlCCount = 0
   THEN

       CtrlCOccurred := FALSE

   ELSE
       BEGIN

       (*
        *  If there is no Control/C pending, issue MS-DOS function call
        *)

       IF NOT CtrlCFlag
       THEN
           BEGIN

           Registers . AX := $0B00;
           MsDos (Registers)

           END;

       (*
        *  Return Control/C status and reset pending flag
        *)

       CtrlCOccurred := CtrlCFlag;
       CtrlCFlag := FALSE;

       END
   END;
{.PA}
PROCEDURE CtrlCSetup;

(***********************************************************************

FUNCTIONAL DESCRIPTION:

   Initializes the Control/C package.

FORMAL PARAMETERS:

   None.

RETURN VALUE:

   None.

IMPLICIT INPUTS:

   CtrlCCount - The count of outstanding enables of the Control/C pack-
       age.
   Interrupt vector 23 (Control/C trap).

IMPLICIT OUTPUTS:

   CtrlCCount - The count of outstanding enables of the Control/C pack-
       age.
   Interrupt vector 23 (Control/C trap).
   CtrlCVect - The original Control/C trap vector.

SIDE EFFECTS:

   None.

***********************************************************************)

   TYPE

       RegisterPackage = RECORD
           AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
           END;

   VAR

       Registers : RegisterPackage;

   BEGIN

   (*
    *  If necessary, set up the Control/C vector
    *)

   IF CtrlCCount = 0
   THEN
       BEGIN

       (*
        *  Initialize the CtrlCFlag
        *)

       CtrlCFlag := FALSE;

       (*
        *  Save the old Control/C vector
        *)

       Registers . AX := $3523;
       MsDos (Registers);
       CtrlCVect := Ptr (Registers . ES, Registers . BX);

       (*
        *  Install the new Control/C vector
        *)

       Registers . AX := $2523;
       Registers . DS := Cseg;
       Registers . DX := Ofs (CtrlCHandler);
       MsDos (Registers)

       END;

   (*
    *  Increment the installation count
    *)

   CtrlCCount := CtrlCCount + 1

   END;
{.PA}
PROCEDURE CtrlCTearDown;

(***********************************************************************

FUNCTIONAL DESCRIPTION:

   Tears down the Control/C package.

FORMAL PARAMETERS:

   None.

RETURN VALUE:

   None.

IMPLICIT INPUTS:

   CtrlCCount - The count of outstanding enables of the Control/C pack-
       age.
   CtrlCVect - The original Control/C trap vector.

IMPLICIT OUTPUTS:

   CtrlCCount - The count of outstanding enables of the Control/C pack-
       age.
   Interrupt vector 23 (Control/C trap).

SIDE EFFECTS:

   None.

***********************************************************************)

   TYPE

       RegisterPackage = RECORD
           AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
           END;

   VAR

       Registers : RegisterPackage;

   BEGIN

   (*
    *  Decrement the installation count
    *)

   CtrlCCount := CtrlCCount - 1;

   (*
    *  If necessary, remove handler
    *)

   IF CtrlCCount = 0
   THEN
       BEGIN

       (*
        *  Restore old Control/C routine
        *)

       Registers . AX := $2523;
       Registers . DS := Seg (CtrlCVect ^);
       Registers . DX := Ofs (CtrlCVect ^);
       MsDos (Registers);

       (*
        *  Ignore any Control/Cs that were captured
        *)

       CtrlCCount := 0

       END
   END;

You are viewing proxied material from sdf.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.