* QL WORLD DIY TOOLKIT - timing routines
* Ver. 0.6, Copyright 1989,90 Simon N Goodwin.
*
initialise lea.l    define,a1
           move.w   $110,a2         BP.INIT vector
           jmp      (a2)
*
turnon     lea.l    serve_flag,a0
			  tst.w    (a0)            Already on?
           bne.s    job_done  		If so, do nothing
	        moveq    #28,d0		      MT.LPOLL
           move.w   d0,(a0)+        Set flag
			  lea.l	  server,a2       Address of interrupt code
			  move.l   a2,4(a0)        Put address in SERVE_PTR
           trap     #1              Link server to QDOS
           bra.s    job_done
*
turnoff    lea.l    serve_flag,a0
			  tst.w    (a0)            Already off?
           beq.s    job_done
           clr.w    (a0)+           Clear flag
	        moveq    #29,d0		      MT.RPOLL - remove server
           trap     #1
			  bra.s    job_done
*
start      bsr.s    check_par
           clr.l    (a4)            Count from zero
           bra.s    job_done
*
tstop      bsr.s    check_par
           bset     #7,(a4)         Set sign bit of count
           bra.s    job_done
*
restart    bsr.s    check_par
           bclr     #7,(a4)         Clear sign of count
job_done   moveq    #0,d0
           rts
*
count      bsr.s    check_par
           move.l   (a4),d1
           bclr     #31,d1          Strip sign bit
*
* Convert D1.L into a floating point value (see December QLW)
*
return_fp  move.w   d1,d4           D4 will be exponent
           move.l   d1,d5           D5 will be mantissa
           beq.s    normalised      Zero is a trivial case
           move.w   #2079,d4        First guess at exponent
           add.l    d1,d1           Already normalised?
           bvs.s    normalised
           subq.w   #1,d4           No, halve exponent weight
           move.l   d1,d5           Double mantissa to match
           moveq    #16,d0          Try a 16 bit shift
*
normalise  move.l   d5,d1           Take copy of mantissa
           asl.l    d0,d1           Shift mantissa D0 places
           bvs.s    too_far         Overflow; must shift less
           sub.w    d0,d4           Correct exponent for shift
           move.l   d1,d5           New mantissa is more normal
too_far    asr.w    #1,d0           Halve shift distance
           bne.s    normalise       Try shift of 8, 4, 2 and 1
*
* Check there's enough space for the result: 6 bytes
*
normalised moveq    #6,d1           No. of bytes needed
           move.w   $11A,a0         BV.CHRIX vector
           jsr      (a0)
           movea.l  $58(a6),a1      Get safe A1 value
           subq.l   #6,a1
           move.l   a1,$58(a6)      Grab 6 more bytes safely
*
           move.l   d5,2(a1,a6.l)   Stack mantissa
           move.w   d4,0(a1,a6.l)   Stack exponent
           moveq    #2,d4           Floating point result
			  bra.s    job_done
*
check_par  lea.l    clocks,a4       A4 -> first timer
           cmpa.l   a3,a5
           beq.s    return          No parameters, A4 is set
           move.w   $112,a2         CA.GTINT vector
           jsr      (a2)
           bne.s    bad_return
           subq.w   #1,d3           Only one parameter wanted
           bne.s    bad_param
           move.w   0(a1,a6.l),d0   Fetch parameter
           addq.l   #2,$58(a6)      Tidy maths stack
           subq.w   #1,d0           Clock offsets start at 0
           bmi.s    bad_param       Reject anything negative
           cmp.w    #3,d0           Valid range is 1 to 4
           bhi.s    bad_param       Reject anything too big
           asl.w    #2,d0           *4 to index among clocks
           adda.w   d0,a4           Implicit EXT.L
return     rts
*           
bad_param  moveq    #-15,d0         Error code ERR.BP
bad_return addq.l   #4,a7           Return to old caller
           rts
*
server     lea.l    clocks,a0       Scan all clocks
			  moveq    #4-1,d0         DBRA clock count
loop       move.l   (a0)+,d1        Get current time
           bmi.s    next				Is clock running?
           addq.l   #1,d1           If so, tick
           move.l   d1,-4(a0)			Store new time
next		  dbra     d0,loop			Do the next one
           rts
*
serve_flag dc.w     0					Set if server is on
serve_link dc.l     0               Points to server list
serve_ptr  dc.l     0               Points to server code
*
clocks	  dc.l	  -1,-1,-1,-1
*
define     dc.w     5               Five procedures
           dc.w     start-*
           dc.b     7,'T_START'
           dc.w     tstop-*
           dc.b     6,'T_STOP'
           dc.w     restart-*
           dc.b     9,'T_RESTART'
           dc.w     turnon-*
           dc.b     4,'T_ON'
           dc.w     turnoff-*
           dc.b     5,'T_OFF'		  
           dc.w     0,1             One function
           dc.w     count-*
           dc.b     7,'T_COUNT'
           dc.w     0
*
           end