home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 06 / clock_p.asc < prev    next >
Text File  |  1991-05-02  |  22KB  |  657 lines
  1. _USING THE REAL-TIME CLOCK_
  2. by Kenneth Roach
  3.  
  4. [TURBO PASCAL VERSION]
  5.  
  6. [LISTING ONE]
  7.  
  8. (*
  9. ** TIMELIB.PAS
  10. ** (C) Copyright 1990 by Kenneth Roach
  11. ** This module contains procedures similar to Turbo Pascal's GetTime and
  12. ** GetDate procedures, but which are based on use of the AT class of
  13. ** system's real time clock.  Additionally, procedures and functions are
  14. ** provided to enable and disable periodic interrupts from the real time
  15. ** clock along with an interrupt handler for same.  Interrupts from the
  16. ** real time clock are provided at a rate of 1024 per second, and a
  17. ** function is provided to return the number of interrupts received in the
  18. ** current second.  Also provided are emulations of the C language's
  19. ** time(), ctime() and clock() functions.
  20. *)
  21.  
  22. Unit TimeLib;
  23.  
  24. Interface
  25.  
  26. Uses Dos;
  27.  
  28. Type
  29.    TimeString = String[24];
  30.    TimeStrPtr = ^TimeString;
  31.  
  32. Function  RtcClock    : LongInt;
  33. Function  MilliCount  : Integer;
  34. Function  CTime2(Time : LongInt) : TimeStrPtr;
  35. Procedure RtcTime(Var Where : LongInt);
  36. Procedure Time2(Var Result : LongInt);
  37. Procedure EnableRtcInts;
  38. Procedure DisableRtcInts;
  39. Procedure GetRtcTime(Var Hr,Mn,Sc,Hn : Word);
  40. Procedure GetRtcDate(Var Yr,Mo,Dy : Word);
  41.  
  42.  
  43. Implementation
  44.  
  45. Type
  46.    ShortString = String[3];
  47.    OldVec      = Procedure;
  48.  
  49. Const
  50.    CLI           = $FA;
  51.    STI           = $FB;
  52.    MASK_24       = $02;
  53.    BCD_MASK      = $04;
  54.    CMOSFLAG      = $70;
  55.    CMOSDATA      = $71;
  56.    SECONDS_REQ   = $00;
  57.    MINUTES_REQ   = $02;
  58.    HOURS_REQ     = $04;
  59.    STATUSA       = $0A;
  60.    DATE_REQ      = $07;
  61.    MONTH_REQ     = $08;
  62.    YEAR_REQ      = $09;
  63.    CENTURY_REQ   = $32;
  64.    UPDATE        = $80;
  65.    HINIBBLE      = $F0;
  66.    LONIBBLE      = $0F;
  67.  
  68.    SECS_PER_MIN  = 60;
  69.    SECS_PER_HOUR = 3600;
  70.    SECS_PER_DAY  = 86400;
  71.    SECS_PER_YEAR = 31536000;
  72.    MINS_PER_HOUR = 60;
  73.    DAYS_PER_YEAR = 365;
  74.    BASE_YEAR     = 1980;
  75.    DAYS_PER_WEEK = 7;
  76.    TUESDAY       = 3;                      { day of week for 1-1-1980 }
  77.    APRIL         = 4;
  78.    JUNE          = 6;
  79.    SEPTEMBER     = 9;
  80.    NOVEMBER      = 11;
  81.    FEBRUARY      = 2;
  82.  
  83.    RTC_VEC       = $70;
  84.    IMR2          = $A1;
  85.    CMD1          = $20;
  86.    CMD2          = $A0;
  87.    EOI           = $20;
  88.    RTC_MASK      = $FE;
  89.    STATUSB       = $0B;
  90.    STATUSC       = $0C;
  91.    RTC_FLAG      = $40;
  92.  
  93.    Months : Array[1..12] of ShortString =
  94.               ('Jan','Feb','Mar','Apr','May','Jun',
  95.                'Jul','Aug','Sep','Oct','Nov','Dec');
  96.    Days   : Array[1..7]  of ShortString =
  97.               ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  98.  
  99. Var
  100.    Bcd       : Boolean;
  101.    RtcCount  : Integer;
  102.    TickCount : LongInt;
  103.    OldRtcVec : Pointer;
  104.    OldCall   : OldVec;
  105.    OldMask   : Byte;
  106.    TimeStr   : TimeString;
  107.  
  108. (*
  109. ** emulation of the C language clock() function.  RtcClock returns
  110. ** a value corresponding to the number of periodic interrupts which
  111. ** have occurred since interrupts from the real time clock were
  112. ** enabled. The value will remain positive for some 24 days from
  113. ** initialization.
  114. *)
  115.  
  116. Function RtcClock : LongInt;
  117. Begin
  118.    RtcClock := TickCount;
  119. End;
  120.  
  121. (*
  122. ** MilliCount returns the real time clock periodic interrupt count for
  123. ** the current second.  Range of value is 0 to 1023.
  124. *)
  125.  
  126. Function MilliCount : Integer;
  127. Begin
  128.    MilliCount := RtcCount;
  129. End;
  130.  
  131. (*
  132. ** real time clock interrupt handler
  133. *)
  134.  
  135. Procedure Rtc; Interrupt;
  136. Begin
  137.    Inline(CLI);
  138.    Port[CMOSFLAG] := STATUSC;            { determine cause of interrupt }
  139.    If (Port[CMOSDATA] and $40) <> 0 Then                { is it for us? }
  140.    Begin
  141.       Inc(RtcCount);    { update number of times ISR called this second }
  142.       Inc(TickCount);             { update total number of times called }
  143.       If RtcCount = 1024 Then             { if start of new second then }
  144.          RtcCount := 0                                 { reset RtcCount }
  145.       Else
  146.       Begin
  147.          Port[CMOSFLAG] := STATUSA;       { check it again for accuracy }
  148.          If (Port[CMOSDATA] and UPDATE) <> 0 Then
  149.             RtcCount := 0;
  150.       End;
  151.       Port[CMD1] := EOI;      { signal end of interrupt to primary 8259 }
  152.       Port[CMD2] := EOI;      { signal end of interrupt to chained 8259 }
  153.    End
  154.    Else
  155.       OldCall;                           { not for us, so call bios ISR }
  156.    Inline(STI);
  157. End;
  158.  
  159. (*
  160. ** turn on interrupts from the real time clock
  161. *)
  162.  
  163. Procedure EnableRtcInts;
  164. Begin
  165.    RtcCount  := 0;                           { reset ISR counter values }
  166.    TickCount := 0;
  167.    GetIntVec(RTC_VEC,OldRtcVec);
  168.    Move(OldRtcVec^,OldCall,Sizeof(Pointer));       { fake out Pascal... }
  169.    SetIntVec(RTC_VEC,@Rtc);                { point to interrupt handler }
  170.    Port[IMR2] := Port[IMR2] and RTC_MASK;      { enable clock interrupt }
  171.    Port[CMOSFLAG] := STATUSB;
  172.    OldMask := Port[CMOSDATA];                  { get rtc mask register  }
  173.    Port[CMOSFLAG] := STATUSB;
  174.    Port[CMOSDATA] := OldMask or RTC_FLAG;  { enable periodic interrupts }
  175. End;
  176.  
  177. (*
  178. ** turn off interrupts from the real time clock
  179. *)
  180.  
  181. Procedure DisableRtcInts;
  182. Begin
  183.    Port[CMOSFLAG] := STATUSB;
  184.    Port[CMOSDATA] := OldMask;            { turn off periodic interrupts }
  185.    Port[IMR2]     := Port[IMR2] and (not RTC_MASK);   { reset 8259 mask }
  186.    SetIntVec(RTC_VEC,OldRtcVec);                       { remove our ISR }
  187. End;
  188.  
  189. (*
  190. ** emulation of the C language's ctime() function
  191. *)
  192.  
  193. Function CTime2(Time : LongInt) : TimeStrPtr;
  194. Var
  195.    Hr,Mn,Sc  : Word;
  196.    Yr,Mo,Dy  : Word;
  197.    Bias,Dw,T : Word;
  198.    Junk,S    : Byte;
  199.    Temp      : LongInt;
  200. Begin
  201.    Temp := Time mod SECS_PER_DAY;       { get seconds left for this day }
  202.    Hr   := Temp div SECS_PER_HOUR;           { determine hours this day }
  203.    Temp := Temp mod SECS_PER_HOUR;                { lose hours this day }
  204.    Mn   := Temp div MINS_PER_HOUR;        { determine minutes this hour }
  205.    Sc   := Temp mod SECS_PER_MIN;       { determine seconds this minute }
  206.  
  207.    Inline(CLI);
  208.    Repeat                           { duplicate a bit of code for speed }
  209.       Port[CMOSFLAG] := STATUSA;        { wait until not in update mode }
  210.    Until (Port[CMOSDATA] and UPDATE) = 0;
  211.    Port[CMOSFLAG] := CENTURY_REQ; T    := Port[CMOSDATA]; { get century }
  212.    Port[CMOSFLAG] := YEAR_REQ;    Bias := Port[CMOSDATA]; { get year    }
  213.    Port[CMOSFLAG] := MONTH_REQ;   Mo   := Port[CMOSDATA]; { get month   }
  214.    Port[CMOSFLAG] := DATE_REQ;    Dy   := Port[CMOSDATA]; { get day     }
  215.    Inline(STI);
  216.    If Bcd Then                 { convert from BCD to binary as required }
  217.    Begin
  218.       T    := ((T    and HINIBBLE) shr 4) * 10 + (T    and LONIBBLE);
  219.       Bias := ((Bias and HINIBBLE) shr 4) * 10 + (Bias and LONIBBLE);
  220.       Mo   := ((Mo   and HINIBBLE) shr 4) * 10 + (Mo   and LONIBBLE);
  221.       Dy   := ((Dy   and HINIBBLE) shr 4) * 10 + (Dy   and LONIBBLE);
  222.    End;
  223.    Inc(Bias,T * 100);
  224.  
  225.    Temp := Time div SECS_PER_DAY;   { get number of days for this value }
  226.    Yr   := Temp div DAYS_PER_YEAR;            { now convert it to years }
  227.    Bias := (Bias - BASE_YEAR) shr 2;     { get leap year days for value }
  228.    Dy   := Temp - Yr * DAYS_PER_YEAR - Bias;     { get unprocessed days }
  229.    Inc(Dy);                                          { add back 'today' }
  230.    Inc(Yr,BASE_YEAR);                  { now add in the 1980 start date }
  231.    Dw   := Time div SECS_PER_DAY + TUESDAY;      { 1-1-80 was a Tuesday }
  232.    Dw   := Dw mod DAYS_PER_WEEK;                    { determine weekday }
  233.  
  234.    Mo   := 1;   S := 1;                { now determine the month's name }
  235.    While S <> 0 Do              { process total remaining days for year }
  236.    Begin
  237.       Junk := 0;
  238.       Case S of
  239.          APRIL,
  240.          JUNE,
  241.          SEPTEMBER,
  242.          NOVEMBER:   If Dy >= 30 Then         { month has 30 days in it }
  243.                         Junk := 30;
  244.          FEBRUARY:   If (Yr shr 2) = 0 Then     { special case february }
  245.                         If Dy >= 29 Then
  246.                            Junk := 29
  247.                         Else
  248.                      Else If Dy >= 28 Then
  249.             Junk := 28;
  250.      Else        If Dy >= 31 Then
  251.                         Junk := 31;            { else month has 31 days }
  252.       End;
  253.       If Junk <> 0 Then
  254.       Begin
  255.          Inc(Mo);                    { account for month just processed }
  256.          Inc(S);                                      { bump case index }
  257.          Dec(Dy,Junk);                   { subtract days just processed }
  258.       End
  259.       Else
  260.          S := 0;             { Dy is less than 1 month, clear while var }
  261.    End;
  262.  
  263.    TimeStr[1]  := Days[Dw][1];     { now convert all values to a string }
  264.    TimeStr[2]  := Days[Dw][2];                  { done inline for speed }
  265.    TimeStr[3]  := Days[Dw][3];
  266.    TimeStr[4]  := ' ';
  267.    TimeStr[5]  := Months[Mo][1];
  268.    TimeStr[6]  := Months[Mo][2];
  269.    TimeStr[7]  := Months[Mo][3];
  270.    TimeStr[8]  := ' ';
  271.    TimeStr[9]  := Chr(Dy div   10 + Ord('0'));
  272.    TimeStr[10] := Chr(Dy mod   10 + Ord('0'));
  273.    TimeStr[11] := ' ';
  274.    TimeStr[12] := Chr(Hr div   10 + Ord('0'));
  275.    TimeStr[13] := Chr(Hr mod   10 + Ord('0'));
  276.    TimeStr[14] := ':';
  277.    TimeStr[15] := Chr(Mn div   10 + Ord('0'));
  278.    TimeStr[16] := Chr(Mn mod   10 + Ord('0'));
  279.    TimeStr[17] := ':';
  280.    TimeStr[18] := Chr(Sc div   10 + Ord('0'));
  281.    TimeStr[19] := Chr(Sc mod   10 + Ord('0'));
  282.    TimeStr[20] := ' ';
  283.    TimeStr[21] := Chr(Yr div 1000 + Ord('0'));  Yr := Yr mod 1000;
  284.    TimeStr[22] := Chr(Yr div  100 + Ord('0'));  Yr := Yr mod 100;
  285.    TimeStr[23] := Chr(Yr div   10 + Ord('0'));
  286.    TimeStr[24] := Chr(Yr mod   10 + Ord('0'));
  287.    TimeStr[0]  := Chr(24);
  288.    CTime2 := @TimeStr;
  289. End;
  290.  
  291. (*
  292. ** replacement for Turbo Pascal's GetTime procedure
  293. *)
  294.  
  295. Procedure GetRtcTime(Var Hr,Mn,Sc,Hn : Word);
  296. Begin
  297.    Inline(CLI);
  298.    Repeat
  299.       Port[CMOSFLAG] := STATUSA;       { wait until not in update cycle }
  300.    Until (Port[CMOSDATA] and UPDATE) = 0;
  301.    Port[CMOSFLAG] := SECONDS_REQ;  Sc := Port[CMOSDATA];  { get seconds }
  302.    Port[CMOSFLAG] := MINUTES_REQ;  Mn := Port[CMOSDATA];  { get minutes }
  303.    Port[CMOSFLAG] := HOURS_REQ;    Hr := Port[CMOSDATA];  { get hour    }
  304.    Inline(STI);
  305.    If Bcd Then                 { convert from BCD to binary as required }
  306.    Begin
  307.       Sc := ((Sc and HINIBBLE) shr 4) * 10 + (Sc and LONIBBLE);
  308.       Mn := ((Mn and HINIBBLE) shr 4) * 10 + (Mn and LONIBBLE);
  309.       Hr := ((Hr and HINIBBLE) shr 4) * 10 + (Hr and LONIBBLE);
  310.    End;
  311.    Hn := RtcCount div 10;                       { RtcCount goes to 1024 }
  312.    If Hn > 75 Then              { correct for values to 102 each second }
  313.       Dec(Hn,3)
  314.    Else If Hn > 50 Then
  315.       Dec(Hn,2)
  316.    Else If Hn > 25 Then
  317.       Dec(Hn);
  318. End;
  319.  
  320.  
  321. (*
  322. ** replacement for Turbo Pascal's GetDate procedure
  323. *)
  324.  
  325. Procedure GetRtcDate(Var Yr, Mo, Dy : Word);
  326. Var T : Integer;
  327. Begin
  328.    Inline(CLI);
  329.    Repeat
  330.       Port[CMOSFLAG] := STATUSA;        { wait until not in update mode }
  331.    Until (Port[CMOSDATA] and UPDATE) = 0;
  332.    Port[CMOSFLAG] := CENTURY_REQ; T  := Port[CMOSDATA];   { get century }
  333.    Port[CMOSFLAG] := YEAR_REQ;    Yr := Port[CMOSDATA];   { get year    }
  334.    Port[CMOSFLAG] := MONTH_REQ;   Mo := Port[CMOSDATA];   { get month   }
  335.    Port[CMOSFLAG] := DATE_REQ;    Dy := Port[CMOSDATA];   { get day     }
  336.    Inline(STI);
  337.    If Bcd Then            { convert time from BCD to binary as required }
  338.    Begin
  339.       T  := ((T  and HINIBBLE) shr 4) * 10 + (T  and LONIBBLE);
  340.       Yr := ((Yr and HINIBBLE) shr 4) * 10 + (Yr and LONIBBLE);
  341.       Mo := ((Mo and HINIBBLE) shr 4) * 10 + (Mo and LONIBBLE);
  342.       Dy := ((Dy and HINIBBLE) shr 4) * 10 + (Dy and LONIBBLE);
  343.    End;
  344.    Inc(Yr,T * 100);                                    { add in century }
  345. End;
  346.  
  347. (*
  348. ** emulation of the C language's time() function
  349. *)
  350.  
  351. Procedure RtcTime(Var Where : LongInt);
  352. Var
  353.    Hr : LongInt;
  354.    T,S,B,Yr,Sc,Mn,Mo,Dy : Word;
  355. Begin
  356.    Inline(CLI);                { following code is duplicated for speed }
  357.    Repeat
  358.       Port[CMOSFLAG] := STATUSA;
  359.    Until (Port[CMOSDATA] and UPDATE) = 0;
  360.    Port[CMOSFLAG] := SECONDS_REQ;  Sc := Port[CMOSDATA];  { get seconds }
  361.    Port[CMOSFLAG] := MINUTES_REQ;  Mn := Port[CMOSDATA];  { get minutes }
  362.    Port[CMOSFLAG] := HOURS_REQ;    Hr := Port[CMOSDATA];  { get hour    }
  363.    Port[CMOSFLAG] := CENTURY_REQ;  T  := Port[CMOSDATA];  { get century }
  364.    Port[CMOSFLAG] := YEAR_REQ;     Yr := Port[CMOSDATA];  { get year    }
  365.    Port[CMOSFLAG] := MONTH_REQ;    Mo := Port[CMOSDATA];  { get month   }
  366.    Port[CMOSFLAG] := DATE_REQ;     Dy := Port[CMOSDATA];  { get day     }
  367.    Inline(STI);
  368.    If Bcd Then            { convert time from BCD to binary as required }
  369.    Begin
  370.       Sc := ((Sc and HINIBBLE) shr 4) * 10 + (Sc and LONIBBLE);
  371.       Mn := ((Mn and HINIBBLE) shr 4) * 10 + (Mn and LONIBBLE);
  372.       Hr := ((Hr and HINIBBLE) shr 4) * 10 + (Hr and LONIBBLE);
  373.       T  := ((T  and HINIBBLE) shr 4) * 10 + (T  and LONIBBLE);
  374.       Yr := ((Yr and HINIBBLE) shr 4) * 10 + (Yr and LONIBBLE);
  375.       Mo := ((Mo and HINIBBLE) shr 4) * 10 + (Mo and LONIBBLE);
  376.       Dy := ((Dy and HINIBBLE) shr 4) * 10 + (Dy and LONIBBLE);
  377.    End;
  378.  
  379.    Inline(STI);
  380.    Mn := Mn * SECS_PER_MIN  + Sc;   { convert today's values to seconds }
  381.    Hr := Hr * SECS_PER_HOUR + Mn;
  382.    Inc(Yr,T * 100);                               { account for century }
  383.    Dec(Yr,BASE_YEAR);                           { keep years since 1980 }
  384.    Inc(Dy,(Yr shr 2));                               { check leap years }
  385.    S  := 1;
  386.    While S < Mo Do                             { add days for this year }
  387.    Begin
  388.       Case S of
  389.          APRIL,
  390.          JUNE,
  391.          SEPTEMBER,                           { month has 30 days in it }
  392.          NOVEMBER:   Inc(Dy,30);
  393.          FEBRUARY:   If (Yr shr 2) = 0 Then { is this year a leap year? }
  394.                         Inc(Dy,29)                                { yes }
  395.                      Else
  396.             Inc(Dy,28);                               { no  }
  397.      Else        Inc(Dy,31);               { else month has 31 days }
  398.       End;
  399.       Inc(S);
  400.    End;
  401.    Dec(Dy);                                             { lose today... }
  402.    Where := Yr * SECS_PER_YEAR +                   { return final value }
  403.             Dy * SECS_PER_DAY  + Hr;
  404. End;
  405.  
  406. (*
  407. ** Pascal substitute for Turbo-C's time() function, based on calls to
  408. ** GetDate, GetTime.  Provided for use on systems not equipped with a
  409. ** real time clock.
  410. *)
  411.  
  412. Procedure Time2(Var Result : LongInt);
  413. Var
  414.    H : LongInt;
  415.    S,Hr,Yr,Sc,Mn,Mo,Dy : Word;
  416. Begin
  417.    GetTime(Hr,Mn,Sc,S);                     { get time from Turbo Pascal }
  418.    Mn := Mn * 60   + Sc;                            { convert to seconds }
  419.    H  := Hr * 3600 + Mn;
  420.    GetDate(Yr,Mo,Dy,S);                     { get date from Turbo Pascal }
  421.    Dec(Yr,1980);                                  { get years since 1980 }
  422.  
  423.    Inc(Dy,Yr shr 2);                                  { check leap years }
  424.    S  := 1;
  425.    While S < Mo Do                              { add days for this year }
  426.    Begin
  427.       Case S of
  428.          APRIL,
  429.          JUNE,
  430.          SEPTEMBER,
  431.          NOVEMBER:   Inc(Dy,30);               { month has 30 days in it }
  432.          FEBRUARY:   If (Yr shr 2) = 0 Then  { is this year a leap year? }
  433.                         Inc(Dy,29)           { yes }
  434.                      Else
  435.             Inc(Dy,28);          { no  }
  436.      Else        Inc(Dy,31);                { else month has 31 days }
  437.       End;
  438.       Inc(S);
  439.    End;
  440.    Result := (Yr * SECS_PER_YEAR +                  { return final value }
  441.            Dy * SECS_PER_DAY  + H);
  442. End;
  443.  
  444. (*
  445. ** unit initialization
  446. *)
  447.  
  448. Begin
  449.    Port[CMOSFLAG] := STATUSB;
  450.    Bcd  := (Port[CMOSDATA] and BCD_MASK) = 0;       { check for BCD mode }
  451.    Port[CMOSFLAG] := STATUSB;
  452.    Port[CMOSDATA] := Port[CMOSDATA] or MASK_24;     { force 24 hour mode }
  453.    RtcCount  := 0;
  454.    TickCount := 0;
  455. End.
  456.  
  457.  
  458. [LISTING TWO]
  459.  
  460. (*
  461. ** TIME_PAS
  462. ** (C) Copyright 1990 by Kenneth Roach
  463. ** This program uses the time and date functions provided by Turbo Pascal
  464. ** compiler, as well as similar functions contained in the module TIMELIB.PAS.
  465. ** TIME_PAS calls each function for five seconds, counting the number of
  466. ** times the function in question was called.  It then compares the number
  467. ** of times each function was called and displays the results.  Following
  468. ** this, it displays the current date and time obtained from the
  469. ** GetRtcTime function, and as reported and converted by the RtcTime
  470. ** and CTime2 functions.
  471. *)
  472.  
  473. Program TimePas;
  474.  
  475. Uses Dos,Crt,TimeLib;
  476.  
  477. Const
  478.    TEST_TIME = 5120;                 { 5 seconds * 1024 ticks per second }
  479.  
  480. Var
  481.    GrtCount    : LongInt;                 { counter for GetRtcTime calls }
  482.    GtCount     : LongInt;                    { counter for GetTime calls }
  483.    GrdCount    : LongInt;                 { counter for GetRtcDate calls }
  484.    GdCount     : LongInt;                    { counter for GetDate calls }
  485.    TCount      : LongInt;                       { counter for Time calls }
  486.    RtCount     : LongInt;                    { counter for RtcTime calls }
  487.    CtCount     : LongInt;                     { counter for CTime2 calls }
  488.    Timer1      : LongInt;                { used in Time, RtcTime testing }
  489.    Temp        : LongInt;
  490.    Hr,Mn,Sc,Hn : Word;            { used in calls to GetTime, GetRtcTime }
  491.    Yr,Mo,Dy,Dw : Word;            { used in calls to GetDate, GetRtcDate }
  492.    St : TimeStrPtr;                             { used in CTime2 testing }
  493.  
  494. (*
  495. ** test performance of real time clock based time functions
  496. *)
  497.  
  498. Procedure TestRtc;
  499. Begin
  500.  
  501.    Writeln;
  502.    Write('Testing GetRtcTime...');
  503.    Temp := RtcClock;                       { get current time tick count }
  504.    Repeat
  505.       GetRtcTime(Hr,Mn,Sc,Hn);
  506.       Inc(GrtCount);
  507.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  508.  
  509.    Writeln;
  510.    Write('Testing GetRtcDate...');
  511.    Temp := RtcClock;
  512.    Repeat
  513.       GetRtcDate(Yr,Mo,Dy);
  514.       Inc(GrdCount);
  515.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  516.  
  517.    Writeln;
  518.    Write('Testing RtcTime...');
  519.    Temp := RtcClock;
  520.    Repeat
  521.       RtcTime(Timer1);
  522.       Inc(RtCount);
  523.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  524.  
  525.    Writeln;
  526.    Write('Testing CTime2...');
  527.    Temp := RtcClock;
  528.    Repeat
  529.       St := CTime2(Timer1);
  530.       Inc(CtCount);
  531.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  532.  
  533. End;
  534.  
  535. (*
  536. ** test performance of Turbo Pascal/DOS based time functions
  537. *)
  538.  
  539. Procedure TestPas;
  540. Begin
  541.  
  542.    Writeln;
  543.    Write('Testing GetTime...');
  544.    Temp := RtcClock;
  545.    Repeat
  546.       GetTime(Hr,Mn,Sc,Hn);
  547.       Inc(GtCount);
  548.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  549.  
  550.    Writeln;
  551.    Write('Testing GetDate...');
  552.    Temp := RtcClock;
  553.    Repeat
  554.       GetDate(Yr,Mo,Dy,Dw);
  555.       Inc(GdCount);
  556.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  557.  
  558.    Writeln;
  559.    Write('Testing Time2...');
  560.    Temp := RtcClock;
  561.    Repeat
  562.       Time2(Timer1);
  563.       Inc(TCount);
  564.    Until (RtcClock - Temp) = TEST_TIME;            { count for 5 seconds }
  565.  
  566. End;
  567.  
  568. (*
  569. ** determine percentage one value represents of another
  570. *)
  571.  
  572. Function Percent(Count1,Count2 : LongInt) : LongInt;
  573. Var Temp : LongInt;
  574. Begin
  575.    Temp := (Count1 * 100) div Count2;
  576.    If ((Count1 * 100) mod Count2) >= 50 Then
  577.       Inc(Temp);
  578.    Percent := Temp;
  579. End;
  580.  
  581. (*
  582. ** show results of timing tests
  583. *)
  584.  
  585. Procedure DisplayResults;
  586. Begin
  587.    Writeln;
  588.    Writeln('Test Summary:');
  589.    Writeln;
  590.    Writeln('GetTime    called ',GtCount,' times');
  591.    Writeln('GetRtcTime called ',GrtCount,' times');
  592.    If GrtCount > GtCount Then
  593.       Writeln('GetRtcTime was ',Percent(GrtCount,GtCount),
  594.                                 '% the speed of GetTime')
  595.    Else
  596.       Writeln('GetTime    was ',Percent(GtCount,GrtCount),
  597.                              '% the speed of GetRtcTime');
  598.  
  599.    Writeln;
  600.    Writeln('GetDate    called ',GdCount,' times');
  601.    Writeln('GetRtcDate called ',GrdCount,' times');
  602.    If GrdCount > GdCount Then
  603.       Writeln('GetRtcDate was ',Percent(GrdCount,GdCount),
  604.                                 '% the speed of GetDate')
  605.    Else
  606.       Writeln('GetDate    was ',Percent(GdCount,GrdCount),
  607.                              '% the speed of GetRtcDate');
  608.  
  609.    Writeln;
  610.    Writeln('Time2      called ',TCount,' times');
  611.    Writeln('RtcTime    called ',RtCount,' times');
  612.    If TCount > RtCount Then
  613.       Writeln('Time2      was ',Percent(TCount,RtCount),
  614.                               '% the speed of RtcTime')
  615.    Else
  616.       Writeln('RtcTime    was ',Percent(RtCount,TCount),
  617.                                 '% the speed of Time2');
  618.  
  619.    Writeln;
  620.    Writeln('CTime2     called ',CtCount,' times');
  621. End;
  622.  
  623. Begin
  624.    GrtCount := 0;                         { initialize counter variables }
  625.    GtCount  := 0;
  626.    GrdCount := 0;
  627.    GdCount  := 0;
  628.    TCount   := 0;
  629.    RtCount  := 0;
  630.    CtCount  := 0;
  631.  
  632.    EnableRtcInts;
  633.  
  634.    ClrScr;
  635.  
  636.    TestRtc;               { test the functions using the real time clock }
  637.    TestPas;            { test the normal Pascal/DOS based time functions }
  638.  
  639.    DisplayResults;
  640.  
  641.    Writeln;
  642.    Writeln('End of test.');
  643.    Writeln('Start time display.');
  644.    Writeln('Depress any key to stop');
  645.    Writeln;
  646.    While not KeyPressed Do
  647.    Begin
  648.       GetRtcTime(Hr,Mn,Sc,Hn);
  649.       RtcTime(Timer1);
  650.       Write(Chr(13),Hr:2,':',Mn:2,':',Sc:2,'.',Hn:2,
  651.                          '       ',CTime2(Timer1)^);
  652.    End;
  653.  
  654.    DisableRtcInts;
  655. End.
  656.  
  657.