	.TITLE	FTIMER
	.IDENT	/01/
	.PSECT	.PROG.
	.ENABL	LC
;
; P. Hays		10 May 79
;
;	clockon()	Initialize timer pool and timebase
;	ftimer()	Allocate a timer, initialize it
;
; Subroutines to create interval timers
; at runtime, link them into a list, and update them based upon the
; clock macro from RSX11-M.
;
; Each timer is equipped with a user-assigned identity when it is created,
; and each specifies a user-supplied handler function to process its expiry.
; When a timer runs down, the id of the timer is pushed to the stack
; and the user-supplied routine is called asynchronously.
;
	.dsabl gbl
 
; Offsets for timers:
t.link =	0		; Link word for timer list
t.tim =		2		; Time counter
t.id =		4		; User's i.d. word
t.funp =	6		; Pointer to user handler

TSIZE =		8.		; Size of timer struct in bytes.
 
; System macros:
.mcall	mrkt$, dir$, astx$s, wsig$s
 
; Global references:
.globl	calloc			; Pool space allocator from lb:[1,1]clib.olb
.globl	$dsw			; System's directive status word
 
; Global definitions:
.globl	ftimer			; Create new timer, set it, link to list.
.globl	clocko			; Initiate mrkt$ time base for timers.


; Local data:
timhead:	.word	0	; Pointer for the active timer list
freep:		.word	0	; Pointer for the timer free pool
abstim:		.word 077770	; Absolute time counter (15-bit cell & a flag)
				; (the initial value has no significance)

cdpb:	mrkt$	, 60, 1, clok	; Clock directive parameter block
				; (defines m.ktmg offset to magnitude word)
 
;
; int
; ftimer(funp, id, time) int (*funp)(); int id, time;
;
; Allocates a new timer structure from the pool and links it into the list
; at timhead. The timer gets the i.d. word in 'id', the function pointer
; in 'funp', and is initialized using an interval 'time' units long.
;
; The value of the user-supplied id is normally returned; 0 is returned
; in the case where the timer pool has been depleted.
;
; This function should not be called while ast recognition is enabled !!!
;
; The caller is responsible for popping the arguments; ftimer preserves
; registers r2 - r5.
;
; Calling sequence:
;	mov	time,-(sp)	; Magnitude of interval
;	mov	id,-(sp)	; Timer i.d. word
;	mov	funp, -(sp)	; Pointer to expiry handler
;	call	ftimer
;	add	#6, sp		; Pop arguments
;	mov	r0, ...		; Store timer id.

	; Offsets to parameters
	p.mag =		6 + 2
	p.id =		4 + 2
	p.funp =	2 + 2

ftimer:
	mov	r2, -(sp)	; Save reg

	; Allocate a timer from the timer pool
	mov	freep, r0
	beq	99$		; Return 0 in r0 if pool is empty ->
	mov	(r0), freep	; Unlink new timer from the pool

	mov	p.mag(sp),t.tim(r0); Store time value...
	add	abstim, t.tim(r0); 	...plus the current absolute time.
	mov	p.id(sp),t.id(r0); Store i.d. word.
	mov	p.funp(sp), t.funp(r0); Store pointer to user expiry handler.

	mov	#timhead, r2	; r2 <- pointer to timer list
5$:	; Loop to search the timer list
	mov	(r2), r1	; Move along the linked list
	beq	10$		; Done if entire list searched	->

	cmp	t.tim(r1), t.tim(r0); Compare list with requested absolute time
	bhi	10$		; Insert new timer before this one	->
	mov	r1, r2		; Store pointer to 'last' timer
	br	5$
10$:
	mov	r1, (r0)	; Insert ptr to rest of list into new timer
	mov	r0, (r2)	; Link new timer into list.


	mov	p.id(sp), r0	; Return user id.
99$:
	mov	(sp)+, r2	; Pop
	return

;
; int
; clockon(interval, ntimers) int interval, ntimers;
;
; Routine to allocate a coreblock for a pool of timers using calloc(),
; and initialize the time base for the task by starting
; an RSX11 mrkt$ clock ticking away at a specified rate.
;
; 'Interval' is the number of ticks (60ths of second) of the
; realtime clock per count in the interval timers.
; (This number must lie between 0 and 32768.)
; 'Ntimers' specifies a number of timers to be allocated; this must
; be at least the maximum number of timers to be active simultaneously.
;
; This routine is to be called once only, when the task is initiated.
; The return value is normally 'ntimers'; NOCORE is returned if
; calloc() returns it when the attempt to allocate a coreblock fails.
; NOCORE is now NULL, by the way (dgc)
; The value in $dsw, the directive status word, is returned if the exec
; rejects the marktime directive required to start the clock.
;
; The AST handler 'clok' is entered repeatedly to test the list
; of timers, and call the user's handler functions at ast level for those
; timers which have expired.
; A timeout handler is required to preserve registers r2 through r5.
;
; Note that the clock may 'lose time' if the system dynamic pool becomes
; depleted; a clock update which occurs while no dynamic space is available
; is delayed until space becomes available.
;
; Calling sequence:
;	mov	ntimers, -(sp)	; Push ntimers
;	mov	interval,-(sp)	; Push interval
;	call	clocko
;	cmp	(sp)+,(sp)+	; Pop arguments
;	mov	r0, ...

	; Offsets to parameters
	p.n =		4
	p.invl =	2

clocko:
	; Allocate space for a block of timers
	mov	#TSIZE, -(sp)
	mov	2+p.n(sp), -(sp)
	call	calloc		; Call space allocator from lb:[1,1]clib.olb
	cmp	(sp)+, (sp)+	; Pop args
	tst	r0		; if (r0 == NULL)
	beq	99$		; If allocation fails, leave 	->

	; Link up the free list
	mov	p.n(sp), r1
	mul	#TSIZE, r1
	add	r0, r1		; r1 <- address past last timer in the list

5$:	; Loop to link in a block
	cmp	r0, r1		; Does r0 point past last timer yet?
	bhis	10$		;	yes; done	->

	mov	freep, (r0)	; Link timer to the free list
	mov	r0, freep

	add	#TSIZE, r0	; Advance the pointer
	br	5$
10$:
	mov	p.invl(sp),cdpb+m.ktmg; Init magnitude word in d.p.b.
	mov	p.n(sp), r0	; Setup to return 'ntimers'
	dir$	#cdpb		; Start the clock
	bcc	99$		; Good return		->
	mov	@#$dsw, r0	; Error return.
99$:
	return

clok:	; Ast service entry for the task's timebase
	dir$	#cdpb		; Keep clock going.
	bcc	5$
	wsig$s			; If the directive fails, wait & try again
	br	clok
5$:
	mov	r0,(sp)		; Pop garbage, push registers
	mov	r1, -(sp)
	mov	r2, -(sp)

	inc	abstim		; Inc the absolute time counter
	bpl	15$
	clr	abstim		; If hi bit became set, reset it ...
	mov	timhead, r2
10$:
	beq	15$
	bic	#100000, t.tim(r2); ...then clear the hi bit of each time value
	mov	(r2), r2	; ...in the entire timer list.
	br	10$

15$:	; Process each expired timer, then remove it from the list.
	mov	timhead,r2	; Get top timer on the list
	beq	99$		; 	(quit if list empty)	->

	cmp	abstim, t.tim(r2); If timer value >= current time...
	blo	99$		;	(no, done)	->

	mov	t.id(r2), -(sp)	; ...push timer's id, and
	call	@t.funp(r2)	; call user's expiry routine.
	tst	(sp)+		; Pop arg

	mov	(r2), timhead	; Unlink from the timer list
	mov	freep, (r2)	; Insert timer block in the free pool
	mov	r2, freep

	br	15$		; Loop ^
99$:
	mov	(sp)+,r2
	mov	(sp)+, r1
	mov	(sp)+, r0
	astx$s			; Return to interrupted code.
.end
