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

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;