Trailing-Edge
-
PDP-10 Archives
-
bb-m780a-sm
-
monitor-sources/timer.mac
There are 45 other files named timer.mac in the archive. Click here to see a list.
;<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 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
SKIPN TADIDT ; System date & time set?
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