home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / timer / tptimer / break.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-07  |  2.9 KB  |  91 lines
  1. {$R-,S-,I-,D-}
  2.  
  3. {Note from TurboPower: the D- directive above is essential if you want
  4.  to use this unit in a program to be run under T-DebugPLUS 4.0.}
  5.  
  6. unit Break;
  7.  
  8. { A unit to allow Control-Break to interrupt program execution.
  9.  
  10.   Version 1.00 -  1/02/1987 - First general release
  11.  
  12.   Scott Bussinger
  13.   Professional Practice Systems
  14.   110 South 131st Street
  15.   Tacoma, WA  98444
  16.   (206)531-8944
  17.   Compuserve 72247,2671 }
  18.  
  19.  
  20. interface
  21.  
  22. uses Dos;
  23.  
  24.  
  25. implementation
  26.  
  27. const ControlBreakFlag: boolean = false;
  28.  
  29. var ExitSave: pointer;
  30.     SaveInt8: pointer;
  31.     SaveInt1B: pointer;
  32.  
  33. procedure JmpOldISR(OldISR: pointer);
  34.   { Chain to previous interrupt handler }
  35.   inline($5B/                   {  pop bx             ;BX = Ofs(OldIsr)}
  36.          $58/                   {  pop ax             ;AX = Seg(OldIsr)}
  37.          $87/$5E/$0E/           {  xchg bx,[bp+14]    ;Switch old BX and Ofs(OldIsr)}
  38.          $87/$46/$10/           {  xchg ax,[bp+16]    ;Switch old AX and Seg(OldIsr)}
  39.          $89/$EC/               {  mov sp,bp          ;Restore SP}
  40.          $5D/                   {  pop bp             ;Restore BP}
  41.          $07/                   {  pop es             ;Restore ES}
  42.          $1F/                   {  pop ds             ;Restore DS}
  43.          $5F/                   {  pop di             ;Restore DI}
  44.          $5E/                   {  pop si             ;Restore SI}
  45.          $5A/                   {  pop dx             ;Restore DX}
  46.          $59/                   {  pop cx             ;Restore CX}
  47.          $CB);                  {  retf               ;Chain to OldIsr, leaving CS and IP params on the stack}
  48.  
  49. procedure HaltProgram;
  50.   { Simple routine to halt the program }
  51.   begin
  52.   halt(255)                                      { 255 is the standard error code for ^Break }
  53.   end;
  54.  
  55. {$F+}
  56. procedure ControlBreakHandler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word); interrupt;
  57.   { Set a flag on seeing a ^Break }
  58.   begin
  59.   ControlBreakFlag := true
  60.   end;
  61.  
  62. procedure TimerHandler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word); interrupt;
  63.   { Check to see that things are safe and then halt program if ^Break flag is set }
  64.   begin
  65.   if ControlBreakFlag and                        { Wait for ^Break to be hit }
  66.      (CS>=PrefixSeg) and (CS<DSeg) then          { Make sure we're in our program (and not in DOS, etc.) }
  67.     begin
  68.     CS := seg(HaltProgram);                      { Return to the halt routine }
  69.     IP := ofs(HaltProgram)
  70.     end;
  71.   JmpOldISR(SaveInt8)                            { Chain to other timer interrupts }
  72.   end;
  73.  
  74. procedure ExitHandler;
  75.   { Cleanup after ourselves }
  76.   begin
  77.   ExitProc := ExitSave;
  78.   SetIntVec($08,SaveInt8);
  79.   SetIntVec($1B,SaveInt1B)
  80.   end;
  81. {$F-}
  82.  
  83. begin
  84. ExitSave := ExitProc;
  85. ExitProc := @ExitHandler;
  86. GetIntVec($08,SaveInt8);
  87. GetIntVec($1B,SaveInt1B);
  88. SetIntVec($1B,@ControlBreakHandler);
  89. SetIntVec($08,@TimerHandler)
  90. end.
  91.