home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / isr.swg / 0006_MYCHECK.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  3.8 KB  |  117 lines
  1. {$ifDEF VER70}
  2. {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+}
  3. {$else}
  4. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S+,V-,X-}
  5. {$endif}
  6. {$DEFinE COLor}
  7. Unit MyCheck;
  8. {
  9.   Version: 2.0 (8 jan 1993).
  10.  
  11.              TeeCee     Bob Swart  Saved:
  12.   Code size: 514 Bytes  472 Bytes  42 Bytes
  13.   Data size:  32 Bytes   32 Bytes   0 Bytes
  14.  
  15.   Here is the $1C ISR that I will add (unless you wish to do that).
  16.  
  17.   Some changes were made, which resulted in less code and data size, a
  18.   little more speed, and display of the progress Variable on screen is
  19.   made 'ticking' each second by changing the colour from white on blue
  20.   to gray on blue and back With each update.
  21.   Also, the Variable Test8086 is set to 0 when the ISR in entered, and
  22.   reset to the value Save8086 (initialized at startup) on Exit. Hereby
  23.   we elimiate potential BTP7 problems With using LongInts in ISRs, and
  24.   not saving Extended Registers properly.
  25. }
  26. Interface
  27.  
  28. Var progress: LongInt Absolute $0040:$00F0;
  29.  
  30. Implementation
  31. { Everything is private to this Unit }
  32. Uses Dos;
  33.  
  34. Const
  35.   Line      = 0;    { Change as required For position of display on screen }
  36.   Column    = 72;                                 { top left corner is 0,0 }
  37.   ScreenPos = (line * 80 * 2) + (column * 2);
  38.   Colour: Byte = $1F;                                 { White/Gray on Blue }
  39.  
  40. Type
  41.   TimeStr = Array[0..15] of Char;
  42.   TimePtr = ^TimeStr;
  43.  
  44. Var
  45.   {$ifDEF COLor}
  46.   Time: TimeStr Absolute $B800:ScreenPos;  { Assume colour display adaptor }
  47.   {$else}
  48.   Time: TimeStr Absolute $B000:ScreenPos; { otherwise mono display adaptor }
  49.   {$endif}
  50.   OldInt1C: Pointer;
  51.   ExitSave: Pointer;
  52.   Save8086: Byte;
  53.  
  54.  
  55. {$F+}
  56. Procedure Int1CISR; Interrupt;
  57. { This will be called every clock tick by hardware interrupt $08 }
  58. Const DisplayTickCount = 20;
  59.       TickCount: LongInt = DisplayTickCount;
  60.       HexChars: Array[$0..$F] of Char = '0123456789ABCDEF';
  61. Var HexA: Array[0..3] of Byte Absolute progress;
  62. begin
  63.   {$ifDEF VER70}
  64.   Test8086 := 0;
  65.   {$endif}
  66.   Asm
  67.     cli
  68.   end;
  69.   inc(TickCount);
  70.   if TickCount > DisplayTickCount then { ticks to update the display }
  71.   begin
  72.     TickCount := 0;        { equality check and assignment faster than mod }
  73.             { The following statements actually display the on-screen time }
  74.     Colour := Colour xor $08;        { Swap between white and gray on blue }
  75.     FillChar(Time[1],Sizeof(Time)-1,Colour);
  76.     Time[00] := HexChars[HexA[3] SHR 4];
  77.     Time[02] := HexChars[HexA[3] and $F];
  78.     Time[04] := HexChars[HexA[2] SHR 4];
  79.     Time[06] := HexChars[HexA[2] and $F];
  80.     Time[08] := HexChars[HexA[1] SHR 4];
  81.     Time[10] := HexChars[HexA[1] and $F];
  82.     Time[12] := HexChars[HexA[0] SHR 4];
  83.     Time[14] := HexChars[HexA[0] and $F]
  84.   end { if TickCount > DisplayTickCount };
  85.   Asm
  86.     sti
  87.     pushf                                  { push flags to set up For IRET }
  88.     call  OldInt1C                              { Call old ISR entry point }
  89.   end;
  90.   {$ifDEF VER70}
  91.   Test8086 := Save8086
  92.   {$endif}
  93. end {Int1CISR};
  94. {$F-}
  95.  
  96.  
  97. Procedure ClockExitProc; Far;
  98. { This Procedure is VERY important as you have hooked the timer interrupt  }
  99. { and thereFore if this is omitted when the Unit is terminated your        }
  100. { system will crash in an unpredictable and possibly damaging way.         }
  101. begin
  102.   ExitProc := ExitSave;
  103.   SetIntVec($1C,OldInt1C);               { This "unhooks" the timer vector }
  104. end {ClockExitProc};
  105.  
  106.  
  107. begin
  108.   progress := 0;
  109.   {$ifDEF VER70}
  110.   Save8086 := Test8086;
  111.   {$endif}
  112.   ExitSave := ExitProc;                          { Save old Exit Procedure }
  113.   ExitProc := @ClockExitProc;                 { Setup a new Exit Procedure }
  114.   GetIntVec($1C,OldInt1C);              { Get old timer vector and save it }
  115.   SetIntVec($1C,@Int1CISR);   { Hook the timer vector to the new Procedure }
  116. end.
  117.