Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393J-SM - monitor-sources/timer.mac
There are 45 other files named timer.mac in the archive. Click here to see a list.
;<4-1-FIELD-IMAGE.MONITOR>TIMER.MAC.2, 25-Feb-82 20:48:50, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 53, FARK:<4-WORKING-SOURCES.MONITOR>TIMER.MAC.3,   7-Jun-80 11:40:17 by SCHMITT
; fix edit numbers for edit 1733
; UPD ID= 52, FARK:<4-WORKING-SOURCES.MONITOR>TIMER.MAC.2,   7-Jun-80 11:29:31 by SCHMITT
; edit 1733 Allow TIMER JSYS to cont. if certain functions.
;<4.MONITOR>TIMER.MAC.14,  3-Jan-80 08:10:37, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>TIMER.MAC.13, 11-Sep-79 16:47:44, EDIT BY HELLIWELL
;TCO #4.2456 Bypass PSI channel test for delete functions
;TCO #4.2455 fix millisecond time computation for .TIMBF function
;<4.MONITOR>TIMER.MAC.12, 11-Mar-79 13:10:43, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>TIMER.MAC.11, 18-Jan-79 16:03:30, EDIT BY HALL
;TYPO IN PREVIOUS EDIT - MISSING RET IN CLKRL
;<4.MONITOR>TIMER.MAC.10, 14-Jan-79 14:56:19, EDIT BY HALL
;MERGE CHANGES PROVIDED BY JIM CALVIN:
; ADD LCKTIM AND ULKTIM, MAKE CODE CALL IT INSTEAD OF LOCKING
;	THE LOCK DIRECTLY.
; TIMRT - LOCK THE LOCK WHILE WORKING WITH TIMER BLOCK
; INSTMQ - RETURN OKINT IF GTTMBK FAILS
; TIMMAX - CALL FUNLK IF TAKING RETERR
; TIMSCM/TIMSCD - STORE -1 IN TIMSTL
;<4.MONITOR>TIMER.MAC.9,  9-Jan-79 17:23:33, EDIT BY MILLER
;FIX FREE SPACE ROUTINES NOT TO USE HEADER OF FREE BLOCK
;<4.MONITOR>TIMER.MAC.8,  8-Jan-79 12:37:39, EDIT BY HALL
;MORE OF THE SAME
;<4.MONITOR>TIMER.MAC.7,  8-Jan-79 11:38:45, EDIT BY HALL
;TRY TO MAKE THIS CODE FOLLOW THE CODING CONVENTIONS
;<4.MONITOR>TIMER.MAC.6,  4-Jan-79 14:44:55, EDIT BY HALL
; CAUSE CALL TO TIMFND IN INSTMQ TO POINT TO FIRST BLK, NOT HEADER
;<4.MONITOR>TIMER.MAC.5,  6-Oct-78 18:47:19, EDIT BY OSMAN
;TCO 4.2036 - FIX CODE AT TIMSC3
;<4.MONITOR>TIMER.MAC.4, 28-Aug-78 14:52:51, EDIT BY MILLER
;FIX BUGS AT TIMDLD
;<4.MONITOR>TIMER.MAC.3, 14-Aug-78 23:26:12, Edit by MCLEAN
;<4.MONITOR>TIMER.MAC.2, 14-Aug-78 23:25:40, Edit by MCLEAN
;ADD LOCK TO TIMDLD SOONER
;<4.MONITOR>TIMER.MAC.1, 12-Dec-77 11:09:04, EDIT BY CROSSLAND
;MODIFICATIONS TO CAUSE SCHEDULER TO SCAN QUEUES LESS OFTEN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG,MACSYM
	TTITLE TIMER

	SWAPCD

; This module implements the TIMER JSYS and all of its support. This
; includes scheduler clock routines (called from CLK2CL) and the code
; to kill pending clock that belong to a dying fork (KSELF)
;TIMER JSYS - SET VARIOUS CLOCKS FOR JOB OR FORK

;ACCEPTS IN 1/	FORK HANDLE OR -5 ,, FUNCTION CODE
;	.TIMRT - Set job runtime limit (-5 for fork handle)
;	.TIMEL - Set elapsed timer (milliseconds)
;	.TIMDT - D&T Alarm
;	.TIMDD - Delete explict D&T entry
;	.TIMBF - Delete all entries before D&T (D&T and mil entries)
;	.TIMAL - Delete all clocks pending for fork
;	    2/	TIME LIMIT IN MILLISECONDS OR D&T
;	    3/	CHANNEL TO INTERRUPT ON
;	TIMER
;RETURNS +1:	ERROR - ERROR CODE IN AC 1
;	 +2:	SUCCESSFUL

.TIMER::MCENT
;**; [1733] At .TIMER+1, Replace 2 lines with following  RAS  7-JUN-80
	SKIPGE TADIDT		; System date & time set?
	JRST [	HRRZ T4,T1	; Get function code
		CAILE T4,.TIMEL	; Is it .TIMEL or .TIMRT?
		CAIL T4,.TIMAL	; or .TIMAL?
		JRST .+1	; Yes, then can continue
		RETERR(TIMX10)]	; No, then this is useless

;GET THE USER'S ARGUMENTS AND CHECK THEM

	UMOVE T1,1		; Pick up FORK,,FUNCTION code
	UMOVE P2,2		; Elapsed millisec or GTAD
	CAIGE P2,0		; Anything past 27 Sep 2217 2359GMT
	MOVE P2,[.INFIN]	; Is treated as just that
	HLRZ P1,T1		; Fork # requested
	HRRES T1		; Function code
	SKIPL T1		; In range?
	CAILE T1,.TIMAL
	RETERR(TIMX1)		; No, bad function code

;SEE WHAT FUNCTION IS TO BE DONE. SKIP CERTAIN CHECKS FOR
;SOME FUNCTIONS

	CAIE T1,.TIMDD		; Delete requests at specific D&T?
	CAIN T1,.TIMBF		; Delete requests before specific D&T?
	JRST TIMER2		; Yes, no channel check
	CAIN T1,.TIMAL		; Delete all requests?
	JRST TIMER2		; Yes, no channel check
	UMOVE P3,3		; Channel #
	SKIPL P3		; Now check validity of channel #
	CAIL P3,^D36
	RETERR(TIMX5)		; Garbage channel #
TIMER2:	CAIN T1,.TIMRT		; Do runtime limit?
	JRST TIMRT		; Yes, just go do that
	PUSH P,T1		; Save function code
	CAIE T1,.TIMAL		; Delete all clocks?
	CAIN T1,.TIMEL		; Milliseconds?
	JRST TIMER1		; Yes, bypass next check
	CALL LGTAD
	CAMG P2,T1		; Has requested time gone by?
	RETERR(TIMX6)		; Yes, inform user

;HERE FOR ALL BUT .TIMRT. GET A SYSTEM WIDE FORK HANDLE TO STORE
;IN THE TIMER BLOCK

TIMER1:	CALL FLOCK		; Lock things down
	MOVE T1,P1		; Fork requested
	CAIL T1,400000
	CAILE T1,400000+NUFKS	; LEGAL FORK HANDLE?
	CAIA			; NO GIVE ERROR.
	CALL STJFKR		;GET JOB WIDE FORK HANDLE
	 RETERR(TIMX2,<CALL FUNLK>) ; Bad fork handle
	HRRZ P1,SYSFK(T1)	; Get system wide fork #
	POP P,T1		; Function code that was saved
	JRST @TIMFUN(T1)	; Dispatch to appropriate routine

TIMFUN:	IFIW!TIMRT		; Set job runtime limit
	IFIW!TIMMLE		; Set a milliseconds elapsed clock
	IFIW!TIMDAT		; Set an alarm clock for T&D
	IFIW!TIMDLD		; Delete an explicit D&T entry
	IFIW!TIMDLA		; Delete all pending clocks before D&T
	IFIW!TIMDAL		; Delete all pending clocks for a fork
;HERE WHEN USER SPECIFIED FUNCTION .TIMRT - SET JOB RUN TIME

;CONTENTS OF AC'S:
;	P1/ FORK HANDLE FROM USER'S AC 1 (MUST BE .FHJOB)
;	P2/ RUN TIME IN MILLISECONDS FROM USER'S AC 2 (OR 0 TO REMOVE)
;	P3/ CHANNEL NUMBER FROM USER'S AC 3

;NOTE: THIS CODE CALLS FLOCK. THE MAIN JSYS ROUTINE BYPASSES ITS
;CALL TO FLOCK IF FUNCTION .TIMRT IS SPECIFIED.

TIMRT:	CAIE P1,.FHJOB		; For entire job?
	RETERR(TIMX2)		; No, can't do this function then
	CALL FLOCK		; Make sure no others bother us
	MOVE T2,JOBNO		; # of this job
	JUMPE P2,TIMRT1		; Want to delete it?
	LOAD T1,JOBRTP,(T2)	; Get ptr to rtl blk
	CAIE T1,0		; One set?
	RETERR(TIMX3,<CALL FUNLK>) ; Yes, complain about that
	CALL TIMMAX		; Allowed to set more?
	CALL GTTMBK		; YES. Get a blk of storage
	RETERR(TIMX7,<CALL FUNLK>) ; No storage available
	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	STOR T1,JOBRTP,(T2)	; Point to blk - JOBNO in T2
	STOR P2,TIMTIM,(T1)	; Store time limit
	STOR P3,TIMCHN,(T1)	; Channel to do this on
	MOVE T2,FORKX
	STOR T2,TIMFRK,(T1)	; Fork that set this up
	SETZRO TIMLNK,(T1)	; No forward
	SETZRO TIMKNL,(T1)	; or back link
	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
TIMRET:	OKINT			; Match NOINT in GTTMBK

;COMMON EXIT POINT. FUNCTION WAS SUCCESSFUL, AND FLOCK HAS BEEN CALLED.

TIMRT0:	CALL FUNLK		; Done release fork lock
	SMRETN			; Successfully done

;HERE IF USER WANTS TO DELETE A PREVIOUS TIMER REQUEST.

TIMRT1:	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	LOAD T1,JOBRTP,(T2)	; Pick up the pointer
	JUMPE T1,TIMRT9		; None, go away quietly
	LOAD T3,TIMFRK,(T1)	; Get fork which set this
	CAME T3,FORKX		; Match?
	RETERR(TIMX4,<	CALL ULKTIM ;NO. UNLOCK THE TIMER DATA BASE
			CALL FUNLK>) ; complain to caller
	CALL RLTMBK		; Release the blk
	SETZRO JOBRTP,(T2)	; No runtime limit anymore
TIMRT9:	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	JRST TIMRT0		; Done
;HERE IF USER SPECIFIED FUNCTION .TIMDT -- DATA AND TIME FOR
;INTERRUPT

;CONTENTS OF AC'S:
;	P1/ SYSTEM WIDE FORK HANDLE
;	P2/ TIME AND DATE FROM USER'S AC 2
;	P3/ CHANNEL NUMBER FROM USER'S AC 3

TIMDAT:	MOVEI T4,TIMDTQ		; Point to Date & time Q
	CALL TIMMAX		; Allowed to set more?
	CALL INSTMQ		; Insert on Q
	CALL TIMZDT		; Cause recalculation of time out
	JRST TIMRT0		; And return

;HERE IF USER SPECIFIED FUNCTION .TIMEL -- ELAPSED TIME BEFORE
;INTERRUPT

;CONTENTS OF AC'S:
;	P1/ SYSTEM WIDE FORK HANDLE
;	P2/ ELAPSED TIME IN MILLISECONDS
;	P3/ CHANNEL NUMBER

TIMMLE:	MOVEI T4,TIMMLQ		; Point to the millisecond Q
	ADD P2,TODCLK		; Add now to user's delta
	CALL TIMMAX		; Allowed to set more?
	CALL INSTMQ		; Insert on Q
	CALL TIMZML		; Cause recalculation of time out
	JRST TIMRT0

;INSTMQ - INSERT TIMER REQUEST IN SCHEDULER QUEUE

;ACCEPTS:
;	T4/ ADDRESS OF HEADER WORD FOR QUEUE
;	P2/ TIME AND DATE OR ELAPSED TIME FOR INTERRUPT
;	P3/ CHANNEL NUMBER

;	CALL INSTMQ

;RETURNS: ON FAILURE, JSYS ERROR DIRECTLY TO USER
;	  ON SUCCESS, +1

INSTMQ:	PUSH P,T4		; Save head of Q
	CALL GTTMBK		; Get a blk for the clock, rets NOINT
	 RETERR(TIMX7,<	CALL FUNLK
			OKINT>) ; No space available
	EXCH T1,0(P)		; SAVE ADDRESS OF BLOCK, GET QUEUE HEADER
	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	SKIPN T4,0(T1)		; Empty list?
	JRST [	EXCH T1,T4	; RECOVER HEADER & NOTE NO FORWARD PTR
		JRST INSTM2]	; no need for look up
	CALL TIMFND		; Find place for it on Q
	 JFCL			; Don't care if not exactly found
	LOAD T1,TIMLNK,(T4)	; Get link out

;HERE WHEN LIST IS EMPTY OR WE FOUND THE PLACE TO INSERT THIS ENTRY
;	T1/ ADDRESS OF NEXT BLOCK IN CHAIN (0 IF NONE)
;	T4/ ADDRESS OF PREVIOUS BLOCK IN CHAIN (HEADER IF CHAIN WAS EMPTY)
;	0(P)/ ADDRESS OF THIS BLOCK

INSTM2:	POP P,T2		; Adr of new blk to insert
	STOR T2,TIMLNK,(T4)	; Point to new cell
	STOR T1,TIMLNK,(T2)	; Link out to old next
	STOR T4,TIMKNL,(T2)	; Back link to previous
	JUMPE T1,INSTM1		; Is there a next cell?
	STOR T2,TIMKNL,(T1)	; Yes, point next back to us
INSTM1:	STOR P2,TIMTIM,(T2)	; Store what ever it is
	STOR P3,TIMCHN,(T2)	; Channel requested
	STOR P1,TIMFRK,(T2)	; Fork #
	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	OKINT			; Matches NOINT in GTTMBK
	RET
;HERE WHEN USER SPECIFIED FUNCTION .TIMDD - DELETE A TIMER REQUEST
;FOR A GIVEN TIME

;CONTENTS OF AC'S:
;	P1/ SYSTEM WIDE FORK HANDLE
;	P2/ TIME AND DATE FROM USER'S AC 2
;	P3/ CHANNEL NUMBER FROM USER'S AC 3

TIMDLD:	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	SKIPN T4,TIMDTQ		; Get the head of the Q
	JRST TIMDLX		;NOT FOUND. GIVE ERROR
TIMDL1:	CALL TIMFND		; Find one that matches
	 JRST TIMDLX		; Tell user of failure
	LOAD T1,TIMFRK,(T4)	; Get SFH
	CAME T1,P1		; This it?
	JRST [	LOAD T4,TIMLNK,(T4) ;NO. GET NEXT ENTRY
		JUMPE T4,TIMDLX	;IF NO MORE GIVE ERROR
		JRST TIMDL1]	;AND PROCEED
	CALL CLKKIL		; Release it
	CALL TIMZDT		; Reset time on D&T Q
	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	JRST TIMRT0		; All done

;HERE WHEN SPECIFIED TIME WAS NOT ON THE QUEUE. RETURN AN ERROR

TIMDLX:	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	CALL FUNLK
	RETERR(TIMX9)
;HERE WHEN USER REQUESTED FUNCTION .TIMBF - REMOVE ALL INTERRUPTS
;THAT WILL OCCUR BEFORE THE SPECIFIED TIME

;CONTENTS OF AC'S:
;	P1/ SYSTEM WIDE FORK HANDLE
;	P2/ TIME AND DATE FROM USER'S AC 2
;	P3/ CHANNEL NUMBER FROM USER'S AC 3

TIMDLA:	CALL LGTAD		; Get now
	MOVE P3,T1		; Save now (don't need chan #)
	MOVE T1,JOBNO		; Who we are
	JN TIMCNT,(T1),TIMDL2	; Any to delete?
	RETERR(TIMX9,<CALL FUNLK>) ; No, just return
TIMDL2:	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	SKIPE T4,TIMDTQ		; Do date & time Q first
	CALL TDBEFO		; Delete any before tad in P2
	SUB P2,P3		; Find difference from "now"
	MULI P2,^D60*^D60*^D24	; Secs/day
	DIVI P2,-1		; TOPS20 units/day
	MULI P2,^D1000		; Milliseconds/second
	MOVE P2,P3		; Didn't need channel anyway
	ADD P2,TODCLK		; Make it milliseconds since system start
	SKIPE T4,TIMMLQ		; Get head of milli Q
	CALL TDBEFO		; delete entries before tad in P2
	CALL TIMZML		; Reset times (? which if any were
	CALL TIMZDT		; modified?)
	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	JRST TIMRT0		; Done

;TDBEFO - DELETE ENTRIES FOR INTERRUPTS BEFORE TIME AND DATE SPECIFIED

;ACCEPTS:
;	T4/ ADDRESS OF HEAD OF QUEUE
;	P1/ SYSTEM WIDE FORK HANDLE
;	P2/ TIME AND DATE

;	CALL TDBEFO

;RETURNS +1: ALWAYS

;THIS ROUTINE SEARCHES THE SPECIFIED QUEUE AND FINDS ANY ENTRIES
;FOR THE SPECIFIED FORK THAT REQUIRE INTERRUPTS TO OCCUR BEFORE THE
;SPEICIFIED TIME. SINCE THE QUEUE IS IN CHRONOLOGICAL ORDER, IT
;QUITS WHEN IT FINDS THE FIRST ENTRY PAST THE SPECIFIED TIME

TDBEFO:	JUMPE T4,R		; If any more
	LOAD T1,TIMTIM,(T4)	; Get time to set it off
	CAML T1,P2		; This a possibility?
	RET			; No, too far into Q
	LOAD T1,TIMFRK,(T4)	; Get fork # that set it
	CAME T1,P1		; A match?
	JRST TDBEF1		; No
	LOAD T1,TIMLNK,(T4)	; Get next

;FOUND AN ENTRY THAT QUALIFIES. DELETE IT FROM THE QUEUE AND
;RETURN THE BLOCK TO THE FREE POOL.

	PUSH P,T1
	CALL CLKKIL		; This wipes out T1-T4
	POP P,T4
	JRST TDBEFO		;GO BACK TO HEAD OF QUEUE

;STEP TO NEXT ENTRY BECAUSE THIS ONE WAS FOR THE WRONG FORK

TDBEF1:	LOAD T4,TIMLNK,(T4)	; Get next
	JRST TDBEFO		; And continue


;HERE WHEN USER SPECIFIED FUNCTION .TIMAL -- REMOVE ALL REQUEST
;FOR THE SPECIFIED PROCESS

;CONTENTS OF AC'S:
;	P1/ SYSTEM WIDE FORK HANDLE

TIMDAL:	CALL CLKRL		; Kill them
	JRST TIMRT0
; Search Q for place for entry

;ACCEPTS:
;	T4/ ADDRESS OF CURRENT BLOCK (START HERE)
;	P2/ TIME AND DATE TO TRY TO MATCH

;	CALL TIMFND

;RETURNS +1: DID NOT FIND AN EXACT MATCH
;		T4/ ADDRESS OF BLOCK THAT THE NEW ONE SHOULD FOLLOW
;	 +2: FOUND AN EXACT MATCH
;		T4/ ADDRESS OF BLOCK WITH SPECIFIED TIME

;THIS ROUTINE IS USED EITHER TO
;	1. FIND THE CORRECT SPOT IN WHICH TO INSERT A NEW TIMER
;		REQUEST (THE REQUESTS ARE QUEUED IN CHRONOLOGICAL
;		ORDER)
;	2. FIND AN ENTRY THAT HAS THE SPECIFIED TIME IN ORDER TO
;		DELETE IT)

TIMFND:	LOAD T2,TIMTIM,(T4)	; Get clock time
	CAMG P2,T2		; Past what we're looking for?
	JRST TIMFN1		; No, done
	LOAD T1,TIMLNK,(T4)	; Get next
	JUMPE T1,R		; Nothing left, insert goes after it
	MOVE T4,T1		; Link on
	JRST TIMFND		; Loop
TIMFN1:	CAMN T2,P2		; Exact match?
	RETSKP			; Yes
	LOAD T4,TIMKNL,(T4)	; Position before one that was too large
	RET

;GTTMBK - GET A RESIDENT FREE BLOCK FOR A TIMER ENTRY

;	CALL GTTMBK

;RETURNS +1: FAILURE, NOINT
;	 +2: SUCCESS, NOINT
;		T1/ ADDRESS OF BLOCK
;		T2/ THIS JOB'S NUMBER

;GET A BLOCK OF RESIDENT FREE SPACE IN WHICH TO PUT AN ENTRY
;FOR THE TIMER QUEUE. STORE THE CALLER'S JOB NUMBER IN THE BLOCK

GTTMBK:	MOVE T1,[.RESP3,,TIMBSZ] ; Priority & blk size
	MOVEI T2,.RSTMP		; Storage pool
	NOINT
	CALL ASGRES		; Get the blk
	 RET			; ? None available?
	MOVE T2,JOBNO		; Job that grabbed this
	INCR TIMCNT,(T2)	; Note that he grabbed a blk
	STOR T2,TIMJOB,(T1)	; Set the owner field
	RETSKP

;TIMMAX - SEE IF JOB CAN HAVE ANOTHER TIMER REQUEST

;	CALL TIMMAX

;RETURNS: ON FAILURE, JSYS ERROR RETURN DIRECTLY TO USER
;	  ON SUCCESS, +1

TIMMAX:	MOVE T2,JOBNO
	LOAD T2,TIMCNT,(T2)	; Get # in use currently
	SKIPE TIMALC		; Any allocation imposed on user?
	CAMGE T2,TIMALC		; Over allocation?
	CAIL T2,.RTJST(TIMCNT,TIMCNT) ; Past max possible?
	RETERR(TIMX8,<CALL FUNLK>) ; Allocation exceeded
	RET
; The following code must be resident; it will be called from SCHED

	RESCD

; SCHED clock test routines

;THIS ROUTINE IS CALLED BY THE SCHEDULER WHEN TMMLTM GOES TO 0.
;THIS WILL HAPPEN EITHER EVERY 75 MILLISECONDS OR WHEN THE CELL IS
;EXPLICITLY ZEROED BY TIMZML. IT PROCESSES THE TIMMLQ QUEUE AND GIVES ANY
;INTERRUPTS THAT SHOULD HAPPEN NOW.

TIMSCM::MOVEI T1,^D75		; Clock interval
	MOVEM T1,TMMLTM
	SKIPN T4,TIMMLQ		; Anything Q'd?
	CALLRET TIMRML		; No need to go on, set long wait time
	MOVE T3,TODCLK		; Check against this
	PUSH P,Q1		; Save this
	MOVEI Q1,TIMMLQ		; ID of Q being scanned
	JRST TIMSC1		; Go to main routine

;THIS ROUTINE IS CALLED BY THE SCHEDULER WHEN TMDTTM GOES TO 0.
;THIS WILL HAPPEN EITHER EVERY 1000 MILLISECONDS OR WHEN THE CELL IS
;EXPLICITLY ZEROED BY TIMZDT. IT PROCESSES THE TIMDTQ QUEUE AND GIVES ANY
;INTERRUPTS THAT SHOULD HAPPEN NOW.

TIMSCD::MOVEI T1,^D1000		; Once a second
	MOVEM T1,TMDTTM
	SKIPN T4,TIMDTQ		; Q empty?
	CALLRET TIMRDT		; Right, just set long timeout
	CALL LGTAD		; Current TAD
	MOVE T3,T1
	PUSH P,Q1
	MOVEI Q1,TIMDTQ		; Q ID

;HERE FOR BOTH ROUTINES.
;	T4/ ADDRESS OF FIRST ENTRY IN QUEUE
;	Q1/ ADDRESS OF QUEUE HEADER

TIMSC1:	AOSE TIMLCK		; Can't if held off
	JRST TIMSC5		; Done
	SETOM TMLSTL		;INDICATE SCHEDULER WAS LAST LOCKER
	MOVN T1,TODCLK		; Pick up now
	ADDM T1,TMMUSE		; Into total
	AOS TMNSS		; # of times entered

;STEP THROUGH QUEUE UNTIL THERE ARE NO MORE ENTRIES OR ONE IS
;NOT READY FOR AN INTERRUPT YET. (QUEUE IS ORDERED BY TIME)

TIMSC2:	LOAD T2,TIMTIM,(T4)	; Check the cell
	CAMLE T2,T3		; Time to trip it?
	JRST TIMSC3		; No, done (ordered lists)

;GIVE THE INTERRUPT AND DELETE THE ENTRY FROM THE QUEUE

	PUSH P,T3
	PUSH P,T4		; These will be clobbered
	LOAD T1,TIMCHN,(T4)	; Channel to stab
	LOAD T2,TIMFRK,(T4)	; Fork
	CALL PSIRQ		; Request it
	MOVE T4,0(P)		; Block we just did
	LOAD T3,TIMLNK,(T4)	; What will be next
	MOVEM T3,0(P)		; Clobber that
	CALL CLKKIL		; Get rid of it
	POP P,T4
	POP P,T3
	JUMPN T4,TIMSC2		; If not done, loop

;HERE WHEN QUEUE IS EMPTY. MAKE THE SCHEDULER NOT CALL THIS AGAIN
;FOR A LONG TIME

	CAIN Q1,TIMMLQ		; Millisecond Q?
	CALL TIMRML		; Set long limit
	CAIN Q1,TIMDTQ
	CALL TIMRDT
	JRST TIMSC4		; Done with everything...

;HERE WHEN FOUND AN ENTRY THAT ISN'T READY YET. FIGURE OUT WHEN
;THE NEXT WAKEUP SHOULD BE AND SAVE IT IN THE APPROPRIATE CELL FOR
;THE SCHEDULER

TIMSC3:	SUB T2,T3		; Compute time until next scan
	CAIN Q1,TIMMLQ		; Millisecond Q?
	JRST [ MOVEM T2,TMMLTM ; Yes, adjust timer
		JRST TIMSC4]
	MULI T2,^D24*^D60*^D60	; Day's worth of seconds
	DIV T2,[1,,0]		; TOPS20's day's worth of things
	MULI T2,^D1000		; Make milliseconds
	MOVEM T2+1,TMDTTM	; Set when next should go off
	JRST TIMSC4
TIMSC4:	MOVE T1,TODCLK
	ADDM T1,TMMUSE		; Into total
	SETOM TIMLCK		;UNLOCK THE TIMER DATA BASE
TIMSC5:	POP P,Q1
	RET


;CAUSE THE SCHEDULER NOT TO SCAN THE TIMMLQ (ELAPSED TIME) QUEUE
;FOR A LONG TIME. NORMALLY SCANNED EVERY 75 MS.

TIMRML:	MOVSI T1,(1B2)
	MOVEM T1,TMMLTM	; Cause sched to not scan Q for a long time
	RET

;CAUSE THE SCHEDULER NOT TO SCAN THE TIMDTQ (DATE AND TIME) QUEUE
;FOR A LONG TIME. NORMALLY SCANNED EVERY 1000 MS.

TIMRDT:	MOVSI T1,(1B2)
	MOVEM T1,TMDTTM
	RET

;CAUSE THE SCHEDULER TO SCAN THE TIMMLQ (ELAPSED TIME) QUEUE
;IMMEDIATELY. NORMALLY SCANNED EVERY 75 MS.

TIMZML:	SETZM TMMLTM		; Cause SCHED to  scan & reset this time
	RET

;CAUSE THE SCHEDULER TO SCAN THE TIMDTQ (DATE AND TIME) QUEUE
;IMMEDIATELY. NORMALLY SCANNED EVERY 1000 MS.

TIMZDT::SETZM TMDTTM
	RET

; Here to LOCK TIMER database & recorder the locker's FORKX

LCKTIM::NOINT
	LOCK TIMLCK		; Lock it for us
	PUSH P,FORKX
	POP P,TMLSTL		; Record last locker
	RET

; Here to unlock the TIMER data base

ULKTIM::UNLOCK TIMLCK
	OKINT
	RET

;INTERNAL GTAD

LGTAD::	SKIPGE A,TADIDT
	RET			;TIME NOT SET
	MOVE A,TODPWL		;POWERLINE TIME IN JIFFIES
	MUL A,[1B17]		;SHIFT BINARY POINT
	DIV A,JFDAY		;COMPUTE DAYS AND FRACTION
	CAML B,JFDAY2		;ROUND
	AOS A
	ADD A,TADIDT		;ADD INITIAL DAY AND TIME
	RET
; Release all clocks owned (aimed at?) at the running fork

CLKREL::PUSH P,P1
	MOVE P1,FORKX		; Running fork
	CALL CLKRL		; Do the work
	POP P,P1
	RET

;CLKRL - REMOVE ALL TIMER ENTRIES FOR THE SPECIFIED FORK

;ACCEPTS:
;	P1/ SYSTEM WIDE FORK HANDLE

;	CALL CLKRL

;RETURNS +1: ALWAYS

CLKRL:	MOVE T1,JOBNO
	JE TIMCNT,(T1),R	; If job has no clocks
	CALL LCKTIM		;LOCK THE TIMER DATA BASE
	PUSH P,P2		; Save this
	MOVE P2,JOBNO		; Job under consideration
	LOAD T1,JOBRTP,(P2)	; Get ptr to runtime limit
	JUMPE T1,CLKRE1		; Any?
	LOAD T2,TIMFRK,(T1)	; Get requesting fork
	CAME T2,P1		; Match us?
	 JRST CLKRE1		; No.. go on
	CALL RLTMBK		; Get rid of it
	SETZRO JOBRTP,(P2)	; Done
CLKRE1:	JE TIMCNT,(P2),CLKREX	; Any left?
	SKIPE T4,TIMMLQ		; Check millisecond Q
	CALL CLKFRK		; Check that list for them
CLKRE2:	JE TIMCNT,(P2),CLKREX	; Any left for job?
	SKIPE T4,TIMDTQ
	CALL CLKFRK		; Yes, scan list for them
CLKREX:	POP P,P2
	CALL TIMZML
	CALL TIMZDT		; Reset timers
	CALL ULKTIM		;UNLOCK THE TIMER DATA BASE
	RET

;CLKFRK - REMOVE ENTRIES FROM THE SPECIFIED QUEUE FOR THE SPEICIFED FORK

;ACCEPTS:
;	T4/ ADDRESS OF FIRST ENTRY IN QUEUE
;	P1/ SYSTEM WIDE FORK HANDLE

;	CALL CLKFRK

;RETURNS +1: ALWAYS

CLKFRK:	LOAD T1,TIMFRK,(T4)	; Fork to be notified
	CAME T1,P1		; Us?
	JRST CLKFR1		; No, link down
	LOAD T1,TIMLNK,(T4)	; Get ptr to next
	PUSH P,T1		; And save it
	CALL CLKKIL		; Get rid of clock
	POP P,T4		; New current
CLKFR2:	JUMPN T4,CLKFRK		; Loop if more
	RET
CLKFR1:	LOAD T4,TIMLNK,(T4)	; Get next
	JRST CLKFR2
;CLKKIL - DELETE A TIMER BLOCK FROM ITS QUEUE AND RELEASE THE FREE SPACE

;ACCEPTS:
;	T4/ ADDRESS OF BLOCK

;	CALL CLKKIL

;RETURNS +1: ALWAYS

CLKKIL::LOAD T1,TIMLNK,(T4)	; Next
	LOAD T2,TIMKNL,(T4)	; Previous
	JUMPE T2,CLKKI1		; 0 if a time limit clock
	STOR T1,TIMLNK,(T2)	; Prev's new next
	JUMPE T1,CLKKI1		; Any next exist?
	STOR T2,TIMKNL,(T1)	; Yes, make next's new prev
CLKKI1:	MOVE T1,T4		; Block to release
	CALL RLTMBK		; Release the storage
	RET

;RLTMBK - RETURN TIMER BLOCK TO FREE POOL

;ACCEPTS:
;	T1/ ADDRESS OF BLOCK

;	CALL RLTMBK

;RETURNS +1: ALWAYS

RLTMBK:	LOAD T2,TIMJOB,(T1)	; Get owning job #
	PUSH P,T2		; And save it for DECR
	CALL RELRES		; Release it
	POP P,T2		; Job #
	DECR TIMCNT,(T2)	; Not using the blk any longer
	RET

	END