home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.update.uu.se
/
ftp.update.uu.se.2014.03.zip
/
ftp.update.uu.se
/
pub
/
rainbow
/
msdos
/
decus
/
RB125
/
ctlctrap.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-06-04
|
8KB
|
419 lines
(***********************************************************************
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;