'===========================================================================
' Subject: DOS Timer using PIT                Date: 03-15-02 (  :  )       
'  Author: Antoni Gual                        Code: QB, Qbasic, PDS, PB    
'  Origin: agual@eic.ictnet.es              Packet: DATETIME.ABC
'===========================================================================
DECLARE FUNCTION Delay% (d AS ANY)
DECLARE FUNCTION XTimerD& ()
DECLARE FUNCTION XTimerW& ()
'--------------------------------------------------------------------------
'Microsecond timer library.Using DOS timer + PIT
'By Antoni Gual agual@eic.ictnet.es  3/2002
'--------------------------------------------------------------------------
'THE PROBLEM:
'To delay for intervals smaller than the QB'S TIMER resolution, a solution is
'to do a delay loop with parameters calculated on the speed of the pc.
'Unfortunately this calibration gives normally poor results when the user's
'pc is 'much faster, or slower than the test pc.

'HOW DOES IT WORK:
'The PIT (Programmable Interval Timer) was the chip that keped the paces in
'the software timer, the speaker beeps and the DRAM refresh.Today its
'functions are emulated in the chipset.
'A backwards counter in the PIT starts at 65535 counts at a frequency of
'1,193,181 Hz. When it gets zero resets itself and issues an interrupt
'(it happens 18,2 times per second), used by DOS to update the software timer.
'At any time you can use the PIT register reading to increase accuracy of the
'DOS timer reading.

'WINDOWS WARNING:
'In a DOS box in Win32, almost everything is emulated. The DOS timer update
'is not done at the same moment when PIT counter becomes 0, so you can have
'low readings (1/18.2 second lower than it should be)

'So I present here two routines XTimerD& and XTimerW&
'Both give times in PIT units (1/1193181 of second), the first one is faster
'but will give incorrect readings in Windows. The second corrects the problem
'but it's 50% to 100% slower.
'Both routines are able to time a maximum delay of 29.99 minutes, limited by
'the capacity of the LONG variables used.


'The Delay routine is the base to implement your delays.It deals with timer
'rollovers.You can nest delays by using diferent delay vars.
'----------------------------------------------------------------------------

'You can use these constants to convert XTimer readings to seconds
CONST clockfreq# = 1193181.666#           'PIT clock frequency
CONST secstick# = 1 / clockfreq#

TYPE delaytype
 start AS LONG
 ends AS LONG
END TYPE

CLS
xx$ = "|/\-"
'----------------speed test-----------------------------------------




nt = 3000
FOR j = 1 TO 3
dtimer& = 0
ltimer& = XTimerD&
'call xtimer nt times
FOR i% = 1 TO nt
    tim& = XTimerD&
    dtimer& = dtimer& + tim& - ltimer&
    SWAP ltimer&, tim&
NEXT

'time the empty loop
dtimer1& = 0
xtimer& = XTimerD&
lt1& = 1&

FOR i% = 1 TO nt
    tim& = 1&
    dt1& = dt1& + tim& - lt1&
    SWAP lt1&, tim&
NEXT

'substract empty loop time
dtimer& = dtimer& - XTimerD& + ltimer&
PRINT USING "A call to XtimerD needs ##.#### milliseconds(Averaged in #### calls)"; dtimer& * secstick# * 1000 / nt; nt
NEXT

'3 tests
FOR j = 1 TO 3
dtimer& = 0
ltimer& = XTimerW&
'call xtimer nt times
FOR i% = 1 TO nt
    tim& = XTimerW&
    dtimer& = dtimer& + tim& - ltimer&
    SWAP ltimer&, tim&
NEXT

'time the empty loop
dtimer1& = 0
xtimer& = XTimerW&
lt1& = 1&

FOR i% = 1 TO nt
    tim& = 1&
    dt1& = dt1& + tim& - lt1&
    SWAP lt1&, tim&
NEXT

'substract empty loop time
dtimer& = dtimer& - XTimerW& + ltimer&

PRINT USING "A call to XtimerD needs ##.#### milliseconds(Averaged in #### calls)"; dtimer& * secstick# * 1000 / nt; nt
NEXT

'--------------------------implementing a delay -------------------------

PRINT "delaying for 0.5 seconds  ";
a = 0
T& = XTimerW&
'--------to implement a delay first dim a variable of delaytype----------
DIM d AS delaytype

'Then preset it with .start=-1 and .ends=delay time in PIT ticks

d.start = -1: d.ends = .5 * clockfreq#

'--------------------call delay function to initialize it-----------------
dummy = Delay%(d)

'-----------------And loop until a delay call  returns <>0----------------
DO
    'do anything you want during the delay loop!!!!!
    a = (a + 1)
    LOCATE , 26: PRINT MID$(xx$, (a AND 3) + 1, 1);
LOOP UNTIL Delay%(d)

'-----------------------------delay ended---------------------------------
PRINT USING "Delay was called #### times.  #.##### secs "; a; (XTimerW& - T&) * secstick#


FUNCTION Delay% (d AS delaytype)
'pass a start of -1 and a time into end to initialize delay
'Keep on calling it until it returns -1

CONST tr& = &H3FFFFFFF, tc& = &H40000000
IF d.start = -1 THEN
    d.start = XTimerW&
    T& = d.ends
    d.ends = (d.start AND tr&) + (d.ends AND tr&)
    c% = ((d.start AND tc&) = tc&) + ((T& AND tc&) = tc&) + ((d.ends AND tc&) = tc&)
    IF c% AND 1 THEN d.ends = d.ends OR tc&
    EXIT FUNCTION
ELSE
    T& = XTimerW&
    IF d.ends > d.start THEN
        IF T& >= d.ends THEN Delay = -1: EXIT FUNCTION
    ELSE
        IF T& < d.start THEN
            IF T& >= d.ends THEN Delay = -1: EXIT FUNCTION
        END IF
    END IF
END IF
END FUNCTION

FUNCTION XTimerD&
'returns time in PIT ticks modulo 29 min
'for use in plain DOS. In Windows some readings are 1/18.2 seconds too low!


CONST forty = &H40
CONST byte = 256&
    DEF SEG = forty
    IF NOT ini% THEN OUT &H43, &H0: ini% = -1
    DO
        t3& = PEEK(&H6D) AND &H7F
        t2& = PEEK(&H6C)
        t0& = INP(forty)
        t1& = INP(forty)
    LOOP UNTIL t2& = PEEK(&H6C)
    XTimerD& = -t0& + byte * (-t1& + byte * (1& + t2& + byte * t3&))
END FUNCTION

FUNCTION XTimerW& STATIC
'returns time in PIT ticks modulo 30 min     
'Slow but safe to use in a DOS box in Windows as in plain DOS
CONST forty = &H40
CONST byte = 256&
    DEF SEG = forty
    IF NOT ini% THEN OUT &H43, &H0: ini% = -1
    DO
        t3& = PEEK(&H6D)
        t2& = PEEK(&H6C)
        t0& = INP(forty)
        t1& = INP(forty)
        x& = -t0& + byte * (-t1& + byte * (1& + t2& + byte * (t3& AND &H7F)))
        'rollover!
        IF (t3& AND &H80) <> lt3& THEN EXIT DO
    LOOP UNTIL x& > X1&
    SWAP x&, X1&: XTimerW& = X1&
    lt3& = t3& AND &H80
END FUNCTION