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 >
Pascal/Delphi Source File  |  1995-06-04  |  8KB  |  419 lines
  1. (***********************************************************************
  2.  
  3. Name:        CtlCTrap.Pas
  4. Version:    1.0
  5.  
  6.  
  7. ABSTRACT:
  8.  
  9.     Provides reliable CTRL/C trapping for TURBO Pascal programs  running
  10.     under MS-DOS and PC-DOS.
  11.  
  12. ENVIRONMENT:
  13.  
  14.     MS-DOS or PC-DOS, compiled with TURBO Pascal.
  15.  
  16.     Tested combinations:
  17.  
  18.     MS-DOS V2.11 with TURBO Pascal V3.01A (MS-DOS generic)
  19.     MS-DOS V2.11 with TURBO Pascal V3.02A (MS-DOS generic)
  20.     PC-DOS V2.10 with TURBO Pascal V3.00B (PC-DOS specific)
  21.     PC-DOS V2.10 with TURBO Pascal V3.01A (PC-DOS specific)
  22.     PC-DOS V2.10 with TURBO Pascal V3.02A (MS-DOS generic)
  23.     PC-DOS V2.10 with TURBO Pascal V3.02A (PC-DOS specific)
  24.  
  25. AUTHOR:
  26.  
  27.     Brian Hetrick
  28.  
  29. EDIT HISTORY:
  30.  
  31.     Brian Hetrick, 12 December 1986: Version 1.0
  32.   000 - Original creation of module.
  33.  
  34. ACKNOWLEDGMENTS:
  35.  
  36.     This is an enhanced version of the CTRLC.PAS public domain    program,
  37.     discovered    on  the  MARKET public access bulletin board, author un-
  38.     known.
  39.  
  40. ***********************************************************************)
  41. {.PA}
  42. (*
  43.  *  TYPE DECLARATIONS:
  44.  *)
  45.  
  46. TYPE
  47.  
  48.     CtrlCPtr = ^ CHAR;
  49.  
  50. (*
  51.  *  CONSTANT DECLARATIONS:
  52.  *)
  53.  
  54. CONST
  55.  
  56.     CtrlCCount : INTEGER = 0;
  57.     CtrlCFlag  : BOOLEAN = FALSE;
  58.  
  59. (*
  60.  *  VARIABLE DECLARATIONS:
  61.  *)
  62.  
  63. VAR
  64.  
  65.     CtrlCVect  : CtrlCPtr;
  66. {.PA}
  67. PROCEDURE CtrlCHandler;
  68.  
  69. (***********************************************************************
  70.  
  71. FUNCTIONAL DESCRIPTION:
  72.  
  73.     THIS ROUTINE MUST NOT BE CALLED BY THE CLIENT PROGRAM.  THIS ROUTINE
  74.     MUST BE DEFINED AT THE OUTERMOST LEVEL (i.e., not nested inside  an-
  75.     other routine).
  76.  
  77.     Control/C interrupt handler.  Called by MS-DOS when a  Control/C  is
  78.     detected in the input stream.  Sets the Control/C flag and dismisses
  79.     the Control/C interrupt.
  80.  
  81.     Ray Duncan's book "Advanced MS-DOS" documents the  possible  actions
  82.     that could be taken by a Control/C handler as any one of:
  83.  
  84.      o    Take any appropriate action and execute  an  IRET.   The  MS-DOS
  85.     function in progress will be restarted and return normally.
  86.      o    Take any appropriate action and execute a far RETURN.  If  carry
  87.     is  set,  MS-DOS  will abort the application and otherwise "will
  88.     continue in the normal manner".
  89.      o    Keep control and never return.
  90.  
  91.     The first alternative is chosen here.  Although any MS-DOS    function
  92.     call  can by used an a Control/C interrupt handler, a TURBO function
  93.     may have been occurring and so no TURBO functions may be used.
  94.  
  95. FORMAL PARAMETERS:
  96.  
  97.     None.
  98.  
  99. RETURN VALUE:
  100.  
  101.     None.
  102.  
  103. IMPLICIT INPUTS:
  104.  
  105.     None.
  106.  
  107. IMPLICIT OUTPUTS:
  108.  
  109.     CtrlCFlag - The Control/C flag.
  110.  
  111. SIDE EFFECTS:
  112.  
  113.     None.
  114.  
  115. ***********************************************************************)
  116.  
  117.     BEGIN
  118.  
  119.     (*
  120.      *    Standard TURBO procedure entry for  routines  at  the  outermost
  121.      *    level.    A different entry sequence is used for routines that are
  122.      *    within other routines (it  must  ensure  addressability  of  the
  123.      *    outer routine's variables), and this other sequence is NOT legal
  124.      *    for interrupt routines
  125.      *)
  126.  
  127.                 {      PUSH      BP               }
  128.                 {      MOV      BP,SP            }
  129.                 {      PUSH      BP               }
  130.                 {      JMP      procedure body       }
  131.  
  132.     (*
  133.      *    Recommended TURBO interrupt procedure entry
  134.      *)
  135.  
  136.     InLine ($50/        {      PUSH      AX               }
  137.         $53/        {      PUSH      BX               }
  138.         $51/        {      PUSH      CX               }
  139.         $52/        {      PUSH      DX               }
  140.         $56/        {      PUSH      SI               }
  141.         $57/        {      PUSH      DI               }
  142.         $1E/        {      PUSH      DS               }
  143.         $06/        {      PUSH      ES               }
  144.         $FB);        {      STI                   }
  145.  
  146.     (*
  147.      *    Note CTRL/C occurrence.  As the data segment is not  addressable
  148.      *    at this point, only CONST variables may be used
  149.      *)
  150.  
  151.     CtrlCFlag := TRUE;
  152.  
  153.     (*
  154.      *    Recommended TURBO interrupt procedure exit
  155.      *)
  156.  
  157.     InLine ($07/        {      POP      ES               }
  158.         $1F/        {      POP      DS               }
  159.         $5F/        {      POP      DI               }
  160.         $5E/        {      POP      SI               }
  161.         $5A/        {      POP      DX               }
  162.         $59/        {      POP      CX               }
  163.         $5B/        {      POP      BX               }
  164.         $58/        {      POP      AX               }
  165.         $8B/$E5/        {      MOV      SP,BP            }
  166.         $5D/        {      POP      BP               }
  167.         $CF)        {      IRET                   }
  168.  
  169.     END;
  170. {.PA}
  171. FUNCTION CtrlCOccurred : BOOLEAN;
  172.  
  173. (***********************************************************************
  174.  
  175. FUNCTIONAL DESCRIPTION:
  176.  
  177.     Tests whether a Control/C has occurred.  This function MUST be  used
  178.     rather  than just checking the CtrlCFlag variable, as Control/Cs are
  179.     detected only at MS-DOS function calls.
  180.  
  181. FORMAL PARAMETERS:
  182.  
  183.     None.
  184.  
  185. RETURN VALUE:
  186.  
  187.     TRUE - There is an unhandled Ctrl/C present.
  188.     FALSE - There is no unhandled Ctrl/C present.
  189.  
  190. IMPLICIT INPUTS:
  191.  
  192.     CtrlCCount - The count of outstanding enables of the Control/C pack-
  193.     age.
  194.     CtrlCFlag - The Control/C pending flag.
  195.  
  196. IMPLICIT OUTPUTS:
  197.  
  198.     CtrlCFlag - The Control/C pending flag.
  199.  
  200. SIDE EFFECTS:
  201.  
  202.     May issue an MS-DOS function call permitting Control/C detection.
  203.  
  204. ***********************************************************************)
  205.  
  206.     TYPE
  207.  
  208.     RegisterPackage = RECORD
  209.         AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
  210.         END;
  211.  
  212.     VAR
  213.  
  214.     Registers : RegisterPackage;
  215.  
  216.     BEGIN
  217.  
  218.     (*
  219.      *    If the Control/C package is  not  initialized,    then  it  cannot
  220.      *    detect Control/Cs.
  221.      *)
  222.  
  223.     IF CtrlCCount = 0
  224.     THEN
  225.  
  226.     CtrlCOccurred := FALSE
  227.  
  228.     ELSE
  229.     BEGIN
  230.  
  231.     (*
  232.      *  If there is no Control/C pending, issue MS-DOS function call
  233.      *)
  234.  
  235.     IF NOT CtrlCFlag
  236.     THEN
  237.         BEGIN
  238.  
  239.         Registers . AX := $0B00;
  240.         MsDos (Registers)
  241.  
  242.         END;
  243.  
  244.     (*
  245.      *  Return Control/C status and reset pending flag
  246.      *)
  247.  
  248.     CtrlCOccurred := CtrlCFlag;
  249.     CtrlCFlag := FALSE;
  250.  
  251.     END
  252.     END;
  253. {.PA}
  254. PROCEDURE CtrlCSetup;
  255.  
  256. (***********************************************************************
  257.  
  258. FUNCTIONAL DESCRIPTION:
  259.  
  260.     Initializes the Control/C package.
  261.  
  262. FORMAL PARAMETERS:
  263.  
  264.     None.
  265.  
  266. RETURN VALUE:
  267.  
  268.     None.
  269.  
  270. IMPLICIT INPUTS:
  271.  
  272.     CtrlCCount - The count of outstanding enables of the Control/C pack-
  273.     age.
  274.     Interrupt vector 23 (Control/C trap).
  275.  
  276. IMPLICIT OUTPUTS:
  277.  
  278.     CtrlCCount - The count of outstanding enables of the Control/C pack-
  279.     age.
  280.     Interrupt vector 23 (Control/C trap).
  281.     CtrlCVect - The original Control/C trap vector.
  282.  
  283. SIDE EFFECTS:
  284.  
  285.     None.
  286.  
  287. ***********************************************************************)
  288.  
  289.     TYPE
  290.  
  291.     RegisterPackage = RECORD
  292.         AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
  293.         END;
  294.  
  295.     VAR
  296.  
  297.     Registers : RegisterPackage;
  298.  
  299.     BEGIN
  300.  
  301.     (*
  302.      *    If necessary, set up the Control/C vector
  303.      *)
  304.  
  305.     IF CtrlCCount = 0
  306.     THEN
  307.     BEGIN
  308.  
  309.     (*
  310.      *  Initialize the CtrlCFlag
  311.      *)
  312.  
  313.     CtrlCFlag := FALSE;
  314.  
  315.     (*
  316.      *  Save the old Control/C vector
  317.      *)
  318.  
  319.     Registers . AX := $3523;
  320.     MsDos (Registers);
  321.     CtrlCVect := Ptr (Registers . ES, Registers . BX);
  322.  
  323.     (*
  324.      *  Install the new Control/C vector
  325.      *)
  326.  
  327.     Registers . AX := $2523;
  328.     Registers . DS := Cseg;
  329.     Registers . DX := Ofs (CtrlCHandler);
  330.     MsDos (Registers)
  331.  
  332.     END;
  333.  
  334.     (*
  335.      *    Increment the installation count
  336.      *)
  337.  
  338.     CtrlCCount := CtrlCCount + 1
  339.  
  340.     END;
  341. {.PA}
  342. PROCEDURE CtrlCTearDown;
  343.  
  344. (***********************************************************************
  345.  
  346. FUNCTIONAL DESCRIPTION:
  347.  
  348.     Tears down the Control/C package.
  349.  
  350. FORMAL PARAMETERS:
  351.  
  352.     None.
  353.  
  354. RETURN VALUE:
  355.  
  356.     None.
  357.  
  358. IMPLICIT INPUTS:
  359.  
  360.     CtrlCCount - The count of outstanding enables of the Control/C pack-
  361.     age.
  362.     CtrlCVect - The original Control/C trap vector.
  363.  
  364. IMPLICIT OUTPUTS:
  365.  
  366.     CtrlCCount - The count of outstanding enables of the Control/C pack-
  367.     age.
  368.     Interrupt vector 23 (Control/C trap).
  369.  
  370. SIDE EFFECTS:
  371.  
  372.     None.
  373.  
  374. ***********************************************************************)
  375.  
  376.     TYPE
  377.  
  378.     RegisterPackage = RECORD
  379.         AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
  380.         END;
  381.  
  382.     VAR
  383.  
  384.     Registers : RegisterPackage;
  385.  
  386.     BEGIN
  387.  
  388.     (*
  389.      *    Decrement the installation count
  390.      *)
  391.  
  392.     CtrlCCount := CtrlCCount - 1;
  393.  
  394.     (*
  395.      *    If necessary, remove handler
  396.      *)
  397.  
  398.     IF CtrlCCount = 0
  399.     THEN
  400.     BEGIN
  401.  
  402.     (*
  403.      *  Restore old Control/C routine
  404.      *)
  405.  
  406.     Registers . AX := $2523;
  407.     Registers . DS := Seg (CtrlCVect ^);
  408.     Registers . DX := Ofs (CtrlCVect ^);
  409.     MsDos (Registers);
  410.  
  411.     (*
  412.      *  Ignore any Control/Cs that were captured
  413.      *)
  414.  
  415.     CtrlCCount := 0
  416.  
  417.     END
  418.     END;
  419.