Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/timer.mac
There are 45 other files named timer.mac in the archive. Click here to see a list.
;<3A.MONITOR>TIMER.MAC.6, 28-Aug-78 14:50:02, EDIT BY MILLER
;FIX BUGS IN TIMDLD
;<3-MONITOR>TIMER.MAC.5, 9-Nov-77 09:58:36, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>TIMER.MAC.4, 12-Oct-77 14:17:36, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>TIMER.MAC.3, 12-Sep-77 15:49:49, EDIT BY CROSSLAND
;DO NOT ALLOW INVERIORS TO MANIPULATE SUPERIORS TIMMER REQUEST
;<3-NSW-MONITOR>TIMER.MAC.1, 22-Jul-77 22:50:38, EDIT BY CALVIN
; Modifications for release 3
;<101B-NSW>TIMER.MAC.9 21-Jul-77 15:45:30 EDIT BY CALVIN
; Remove path out of TIMDLD leaving FKLOCK locked
;<101B-NSW>TIMER.MAC.4 26-May-77 09:16:14 EDIT BY CALVIN
; Added .TIMAL function
;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 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
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
UMOVE P3,3 ; Channel #
HLRZ P1,T1 ; Fork # requested
HRRES T1 ; Function code
SKIPL T1 ; In range?
CAILE T1,.TIMAL
RETERR(TIMX1) ; No, bad function code
SKIPL P3 ; Now check validity of channel #
CAIL P3,^D36
RETERR(TIMX5) ; Garbage channel #
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
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
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
TIMRT: CAIE P1,-5 ; 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 ; Get a blk of storage
RETERR(TIMX7,<CALL FUNLK>) ; No storage available
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
TIMRET: OKINT ; Match NOINT in GTTMBK
TIMRT0: CALL FUNLK ; Done release fork lock
SMRETN ; Successfully done
TIMRT1: LOAD T1,JOBRTP,(T2) ; Pick up the pointer
CAIN T1,0 ; One there?
JRST TIMRT0 ; Go away quietly
LOAD T3,TIMFRK,(T1) ; Get fork which set this
CAME T3,FORKX ; Match?
RETERR(TIMX4,<CALL FUNLK>) ; No, complain to caller
CALL RLTMBK ; Release the blk
SETZRO JOBRTP,(T2) ; No runtime limit anymore
JRST TIMRT0 ; Done
; Set date and time clock
TIMDAT: MOVEI T4,TIMDTQ ; Point to Date & time Q
JRST TIMSET
; Set elapsed time clock
TIMMLE: MOVEI T4,TIMMLQ ; Point to the millisecond Q
ADD P2,TODCLK ; Add now to user's delta
TIMSET: CALL TIMMAX ; Allowed to set more?
CALL INSTMQ ; Insert on Q
JRST TIMRT0
INSTMQ: PUSH P,T4 ; Save head of Q
CALL GTTMBK ; Get a blk for the clock, rets NOINT
RETERR(TIMX7,<CALL FUNLK>) ; No space available
EXCH T1,0(P) ; Swap for list head
LOCK TIMLCK ; Lock it for us
MOVE T4,T1 ; TIMFND expects header in T4
SKIPN T1,0(T4) ; Empty list?
JRST INSTM2 ; Yes, 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
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 #
UNLOCK TIMLCK ; Ok, we're done
OKINT ; Matches NOINT in GTTMBK
RET
; Delete an explict D&T entry
TIMDLD: LOCK TIMLCK ;LOCK THE LOCK
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
JUMPE T4,TIMDLX ;IF NO MORE GIVE ERROR
JRST TIMDL1] ;CONTINUE
CALL CLKKIL ; Release it
UNLOCK TIMLCK
JRST TIMRT0 ; All done
TIMDLX: UNLOCK TIMLCK
CALL FUNLK
RETERR(TIMX9)
; Delete all entries before a given D&T (even elapsed time clocks)
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: LOCK TIMLCK ; Hold off SCHED and others
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
SKIPE T4,TIMMLQ ; Get head of milli Q
CALL TDBEFO
UNLOCK TIMLCK
JRST TIMRT0 ; Done
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
PUSH P,T1
CALL CLKKIL ; This wipes out T1-T4
POP P,T4
JRST TDBEFO
TDBEF1: LOAD T4,TIMLNK,(T4) ; Get next
JRST TDBEFO ; And continue
TIMDAL: CALL CLKRL ; Kill them
JRST TIMRT0
; Search Q for place for entry
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
; Get a clock block
GTTMBK: MOVE T1,[.RESP3,,TIMBSZ] ; Priority & blk size
MOVEI T2,.RSTMP ; Storage pool
NOINT
CALL ASGRES ; Get the blk
RET ; ? None available?
SOJ T1, ; Point to header (use it)
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
; Check allocation for a job
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) ; Allocation exceeded
RET
; The following code must be resident; it will be called from SCHED
RESCD
; SCHED clock test routines
TIMSCM::MOVEI T1,^D75 ; Clock interval
MOVEM T1,TMMLTM
SKIPN T4,TIMMLQ ; Anything Q'd?
RET ; No need to go on
MOVE T3,TODCLK ; Check against this
JRST TIMSC1 ; Go to main routine
TIMSCD::MOVEI T1,^D1000 ; Once a second
MOVEM T1,TMDTTM
SKIPN T4,TIMDTQ ; Q empty?
RET ; Right, done
CALL LGTAD ; Current TAD
MOVE T3,T1
TIMSC1: SKIPL TIMLCK ; Can't if held off
RET ; Done
MOVN T1,TODCLK ; Pick up now
ADDM T1,TMMUSE ; Into total
AOS TMNSS ; # of times entered
TIMSC2: LOAD T2,TIMTIM,(T4) ; Check the cell
CAMLE T2,T3 ; Time to trip it?
JRST TIMSC3 ; No, done (ordered lists)
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
TIMSC3: MOVE T1,TODCLK
ADDM T1,TMMUSE ; Into total
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: MOVE T1,JOBNO
JE TIMCNT,(T1),R ; If job has no clocks
NOINT
LOCK TIMLCK ; Lock things down
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
UNLOCK TIMLCK
OKINT
RET
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
; Kill a clock pointed to by T4
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
; Release timer blk pointed to by T1
RLTMBK: LOAD T2,TIMJOB,(T1) ; Get owning job #
PUSH P,T2 ; And save it for DECR
MOVE T2,[.RSTMP,,<<TIMBSZ+1>/4>] ; Pool & # of blks
MOVEM T2,0(T1) ; Restore blk # & size
MOVEI T1,1(T1) ; Fake back for RELRES
CALL RELRES ; Release it
POP P,T2 ; Job #
DECR TIMCNT,(T2) ; Not using the blk any longer
RET
END