.mcall	.MODULE
	.MODULE	WATCH,comment=<TSX watchdog>,release=V09,version=05

;**************************************************************;
;                                                              ;
;   Copyright (c) 1988            Bob Schor                    ;
;                                 Eye and Ear Hospital         ;
;                                 230 Lothrop St.              ;
;                                 Pittsburgh, PA   15213       ;
;                                                              ;
;                                                              ;
;**************************************************************;

;**************************************************************;
;                                                              ;
;   Copyright (c) 1989            Bob Schor                    ;
;                                 Eye and Ear Institute        ;
;                                 203 Lothrop St.              ;
;                                 Pittsburgh, PA   15213       ;
;                                                              ;
; All rights reserved.  May not be copied without this notice. ;
;                                                              ;
;**************************************************************;

; WATCH is a watch-dog timer for TSX.  It monitors all available lines
; periodically, and logs off idle lines (those whose CPU usage has not
; increased).  It will not affect detached jobs (such as itself).

; The program takes a time parameter, which marks the maximum amount of
; idle time allowed a job.  The variable "maxidl" holds this time; a default
; value is stored in the constant "defidl".  

; Note -- care is taken in most routines to preserve registers, except for
; r0, which gets altered by most EMTs.

;b schor	july 13, 1988

;modifications --
;	aug, 1988	Bug in JSTAT fixed
;	aug, 1988	PRIV, DETACH macros added
;	aug, 1988	Detached jobs handled separately
;	aug, 1988	Allow "time" argument, format nH mM lS
;				(seconds ignored, default is minutes)
;	sep, 1988	Code from HALT v8.9 back-propagated
;	sep, 1988	Fixed bug in use of DETSTA (macro modifies r0)
;	sep, 1988	In detached command files, self-delete placed last
;	nov, 1988	Changes/improvements added for TSX v6.4
;			Sub-processes can check their parents by job number
;			Add comsec, possible wait time in seconds
;			Remove "irrelevant" code to kill program ONLINE,
;				new routine SUICIDE will replace
;	dec, 1988	CASE used to clean up code, debug outputs neatened
;	may, 1989	Psects $CODE and $DATA added
;	may, 1989	Logic changed.  Now "wakes up" more frequently, keeps
;			updating "idle" entry in table, killing job when total
;			time exceeded.

;define our .psects before calling SUMAC to force ours low

	.psect	$code	ro,i,lcl,rel,con
	.psect	$data	rw,d,lcl,rel,con

;uses SUMAC for structured macro code

	.library	/lib:sumac/	;use external macro definition file

	.mcall	SUMAC
	SUMAC				;initialization macro

	.dsabl	gbl			;if undefined symbol, force error

HEAD	sysmac, <system macros>

	.mcall	.PRINT			;to announce identification
	.mcall	.EXIT			;return to RT-11 on errors
	.mcall	.SETTOP			;reserve core for tables
	.mcall	.GVAL			;used in JSTAT macro
	.mcall	.TWAIT			;to sleep
	.mcall	.ENTER, .WRITW, .CLOSE	;for creating detached file


HEAD	syscon, <system constants>

	userto	=	50		;high memory address
	errbyt	=	52		;error byte in monitor
	userrb	=	53		;user error byte

	comlen	=	510		;command length
	comcmd	=	512		;command goes here

	clk50$	=	40		;50-Hz clock, in configuration word

	tsx$	=	100000		;TSX bit in sysgen word

HEAD	offset, <monitor offsets>

	config	=	300		;offset to configuration word
	sysgen	=	372		;offset to sysgen features
	tsxver	=	-40		;offset to TSX version # (* ^d100)

HEAD	condit, <assembly conditionals>
;	debug	=	1		;define for debugging code
.iif ndf	debug	debug	=	0
.iif ne		debug	debug	=	1

HEAD	const, <miscellaneous program constants>

	snooze	=	^d5		;sleep 5 minutes between checks
	defidl	=	^d4 * ^d60	;default idle time = 4 hours
	tsx62	=	^d620		;version identification for v6.2
	tsx64	=	^d640		;version identification for v6.4
	namsiz	=	14		;bytes to reserve for job name

HEAD	ioconst, <i/o constants>

	iochan	=	1		;i/o channel
	cr	=	15		;ascii carriage return
	lf	=	12		;ascii line feed
	space	=	'   		;ascii space
	comma	=	',		;ascii comma

HEAD	tsx, <TSX emt codes>
	do.tsx	=	emt + 375	;general TSX "do" emt

	detch.	=	132		;detach job
	memto.	=	141		;fix memory size
	jstat.	=	144		;determine job status
	priv.	=	150		;privilege/priority manipulation

	p.rd	=	0		;read privileges
	p.clr	=	1		;clear privileges
	p.set	=	2		;set privileges

	cur.p	=	0		;current privileges
	set.p	=	1		;set privileges
	aut.p	=	2		;authorized privileges

	setp.w	=	1		;setprv word
	setp.b	=	3		;setprv bit
	worl.w	=	2		;world word
	worl.b	=	^d14		;world bit

;jstat sub-codes

	stat. 	= 	0		;return line job status
	exec. 	= 	1		;execution state	
	mem. 	=	2		;number of 256-word blocks in use
	conn.	=	3		;minutes connected
	posn.	=	4		;block number (256-word) in memory
	name.	=	5		;two-word .rad50 name of program
	ppn.	=	6		;two-word PPN
	cpu.	=	7		;two-word clock ticks used by job
	prio.	=	10		;current execution priority
	jname.	=	11		;12-byte job name
	jnum.	=	12		;two-word primary, parent job number

	sub.	=	1		;sub-process bit, job status
	det.	=	2		;detached bit, job status
	prv.	=	200		;privileged line bit, job status

	.sbttl	-----------------
	.sbttl	Macro definitions
	.sbttl	-----------------

HEAD	JSTAT, <macro to generate TSX job status emts>
;	JSTAT	line-#, sub-function, buffer-address
;examples -- 
;	JSTAT	#1, #stat., #stat	;get status of line 1 in "stat"

	.macro	JSTAT	linnum, subfun, bufadd

	movb	#0, tsxarg		;save default numeric value
	movb	#jstat., tsxarg+1	;save low byte, emt number
	movb	linnum, tsxarg+2	;save line number
	movb	subfun, tsxarg+3	;and status sub-function as bytes
	mov	bufadd, tsxarg+4	;save buffer address
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	JSTAT

HEAD	PRIV, <macro to execute TSX privileges>
;	PRIV	func, type
;where
;	func = 0, 1, 2 to read, bit clear, or bit set privileges
;	type = 0, 1, 2 to affect current, set, or authorized privileges	

	.macro	PRIV	func, type

	movb	#1, tsxarg		;save "privilege" numeric value
	movb	#priv., tsxarg+1	;save low byte, emt number
	movb	#func, tsxarg+2		;save function
	movb	#type, tsxarg+3		;and type
	mov	#priv, tsxarg+4		;save privilege buffer address
	clr	tsxarg+6		;and extra word at end
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	PRIV

HEAD	PRIVRD, <macro to read TSX privileges>
;	PRIVRD	

;reads privileges into 4-word table "priv"

	.macro	PRIVRD

	PRIV	p.rd, cur.p		;read current privileges

	.endm	PRIVRD

HEAD	TSTPRV, <macro to test read TSX privileges>
;	TSTPRV	word, bit	

;tests privileges in table "priv", looking at word "word", bit "prvbit"

	.macro	TSTPRV	word, prvbit

	mask	=	1		;build bit mask
.rept	prvbit
	mask	=	2*mask		;rotate bit left
.endr
	offset	=	2*<word-1>	;convert word to byte offset

	bit	#mask, priv+offset	;test bit in privilege word

	.endm	TSTPRV

HEAD	PRVSET, <macro to set a TSX privilege>
;	PRVSET	word, prvbit	

;sets bit in table "priv", then uses table to reset privileges
;tests privileges in table "priv", looking at word "word", bit "prvbit"

	.macro	PRVSET	word, prvbit

	mask	=	1		;build bit mask
.rept	prvbit
	mask	=	2*mask		;rotate bit left
.endr
	offset	=	2*<word-1>	;convert word to byte offset

	bis	#mask, priv+offset	;set bit in privilege word
	PRIV	p.set, cur.p		;set current privileges

	.endm	PRVSET

HEAD	MEMTOP, <macro to set memory size>
;	MEMTOP	memloc
;where memloc is the requested top address for the job
;returns with r0 having highest word in program space

	.macro	MEMTOP	memloc

	movb	#0, tsxarg		;save default numeric value
	movb	#memto., tsxarg+1	;save low byte, emt number
	mov	memloc, tsxarg+2	;save memory location
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	MEMTOP

HEAD	DETACH, <macro to start detached job>
;	DETACH	filnam
;where filnam points to the .asciz name of the detached file;
;on return, detached job number in r0

	.macro	DETACH	filnam

	movb	#0, tsxarg		;save "detach" numeric value
	movb	#detch., tsxarg+1	;save low byte, emt number
	mov	filnam, tsxarg+2	;save file name
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	DETACH

HEAD	DETSTA, <macro to return status of detached job>
;	DETSTA	jobnum
;returns with carry clear if job active, carry set if finished
;guard against passing arguments in via r0

	.macro	DETSTA	jobnum

	.ntype	.temp, jobnum		; get type of argument
.if eq	<.temp&7>-0			; if r0 is involved,
.if eq	.temp-00			; handle "detsta r0"
	PUSH	jobnum			;save r0 before building macro
.iff
	.error	;DETSTA shouldn't use complex arguments involving r0
.endc
.endc
	movb	#1, tsxarg		;save "status" numeric value
	movb	#detch., tsxarg+1	;save low byte, emt number
	mov	jobnum, tsxarg+2	;save file name
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX
.if eq	.temp-00
	POP	jobnum			;restore r0 after call
.endc

	.endm	DETSTA

HEAD	DETKIL, <macro to kill detached job>
;	DETKIL	jobnum

	.macro	DETKIL	jobnum

	movb	#2, tsxarg		;save "abort detached" numeric value
	movb	#detch., tsxarg+1	;save low byte, emt number
	mov	jobnum, tsxarg+2	;save file name
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	DETKIL

	.sbttl	---------------------
	.sbttl	Start of main routine
	.sbttl	---------------------

	.psect	$code

LABEL	watch, <Program start>
	NOTE
	.PRINT	#modnam			;identify module
	NOTE
	INVOKE	istsx			;make sure running TSX
	INVOKE	getver			;get current version
	INVOKE	isprv			;check for required privileges
	INVOKE	gettim			;get sleep time, if present
	INVOKE	cntlin			;set maxlin, max valid line number
	INVOKE	getspc			;get space for tables
	INVOKE	initbl			;initialize table
	REPEAT
		INVOKE	sleep		;wait awhile
		INVOKE	update		;update table entry
		INVOKE	kilidl		;kill idle lines
	UNTIL				;stay in loop
	.EXIT				;just in case hell freezes over

	.sbttl	-------------------
	.sbttl	Internal procedures
	.sbttl	-------------------

PROCED	istsx, <ensure TSX>
	.GVAL	#emtarg, #sysgen	;return sysgen options
	bit	#tsx$, r0		;test TSX bit
	IF	eq			;if missing,
		NOTE	<WATCH - F - Cannot run under RT-11>
		.EXIT
	ENDIF
ENDPROC

PROCED	getver, <get TSX version, put in "versn">
	.GVAL	#emtarg, #tsxver	;return tsx version
	IF	cs			;if emt fails,
		clr	versn		;set version to 0.00
	ELSE
		mov	r0, versn	;save version * 100
	ENDIF
.if ne	debug
	PNOTE	<TSX Version >
	mov	r0, r1			;compute proper version #
	clr	r0
	div	#^d100, r0		;(version * 100) / 100
	TYP.10	r0			;output major version #
	PNOTE	<.>
	IF	r1, lt, #^d10		;if single-digit minor version,
		PNOTE	<0>		;output leading 0
	ENDIF
	TYP.10	r1			;output minor version #
	NOTE
.endc
ENDPROC	

PROCED	isprv, <ensure line has sufficient privilege>
	PRIVRD				;read current privileges
	TSTPRV	worl.w, worl.b		;check world privilege
	IF	eq			;if not set,	
.if ne	debug
		NOTE	<World privilege not set>
.endc
		TSTPRV	setp.w, setp.b	;test setprv privilege
		IF	eq		;if not set,
			NOTE	<Cannot set WORLD privilege>
		ELSE
			PRVSET	worl.w, worl.b	;set world privilege
.if ne	debug
			IF	cs
				NOTE	<Error in performing PRVSET>
			ENDIF
			TSTPRV	worl.w, worl.b	;now test privilege
			IF	ne
				NOTE	<World privilege now set>
			ELSE
				NOTE	<Bug in setting world privilege>
			ENDIF
.endc
		ENDIF
.if ne	debug
	ELSE
		NOTE	<World privilege already set>
.endc
	ENDIF
ENDPROC

PROCED	gettim, <get time from input command string, if present>
;Commands of form nH mM lS will be converted to ticks and put in two-word
;variable "idltim".  If no command, default value "defidl" will be used.  
;The sleep variable "slptim" will also be computed, using "snooze" as the
;default number of minutes.
;Unexpected character aborts parse.

	clr	idltim			;clear two-word idle time
	clr	idltim+2
	.GVAL	#emtarg, #config	;return configuration word
	bit	r0, #clk50$		;test 50 Hz bit
	IF	ne			;leave ticks/second on stack
		PUSH	#^d50
	ELSE
		PUSH	#^d60
	ENDIF
	mov	#^d60, r2		;seconds/minute * ticks/second =
	mul	(sp), r2		;ticks/minute
	PUSH	r3			;leave on stack, as well
	mov	#comcmd, r0		;point to command buffer
	IF	@#comlen, eq		;if command of 0 length,
		clrb	(r0)		;ensure following parse fails
	ENDIF
	clr	r3			;clear time accumulator
	WHILEB	(r0), ne		;while still parsing string,
		movb	(r0)+, r1	;get next char
		IF	r1, ge, #'0	;if numeric,
		AND	r1, le, #'9
			sub	#'0, r1		;make numeral
			mul	#^d10, r3	;scale number so far
			add	r1, r3		;and add new digit
		ELSIF	r1, eq, #'H	;if hour flag,
		OR	r1, eq, #'h
			mul	#^d60, r3	;convert to minutes
			mov	r3, r2		;get product
			mul	(sp), r2	;convert to ticks
			add	r3, idltim+2	;add to total idle time
			adc	r2
			add	r2, idltim
			clr	r3		;and zero accumulator
		ELSIF	r1, eq, #'M	;if minute flag
		OR	r1, eq, #'m
			mov	r3, r2		;get product
			mul	(sp), r2	;convert to ticks
			add	r3, idltim+2	;add to total idle time
			adc	r2
			add	r2, idltim
			clr	r3		;and zero accumulator
		ELSIF	r1, eq, #'S	;if second flag
		OR	r1, eq, #'s
			mov	r3, r2		;get product
			mul	2(sp), r2	;convert to ticks
			add	r3, idltim+2	;add to total idle time
			adc	r2
			add	r2, idltim
			clr	r3		;and zero accumulator
		ELSIF	r1, eq, #space	;space, ignore
		ELSIF	r1, eq, #comma	;comma, ignore
		ELSE			;all others are errors
			clr	r3	;clear accumulator
			clrb	(r0)	;force end of parse
		ENDIF
	ENDWHILE
	IF	r3, ne			;if anything left, assume minutes
		mov	r3, r2
		mul	(sp), r2	;convert to ticks
		add	r3, idltim+2	;add to total idle time
		adc	r2
		add	r2, idltim
	ENDIF
	IF	idltim, eq		;if no time specified,
	AND	idltim+2, eq
		mov	#defidl, r2	;use default time in minutes
		mul	(sp), r2	;convert to ticks
		mov	r2, idltim	;and save time
		mov	r3, idltim+2
	ENDIF
	mov	#snooze, r2		;get default sleep time in minutes
	mul	(sp), r2		;default time in ticks
	mov	r2, slptim		;and save
	mov	r3, slptim+2
	IF	idltim, eq, slptim	;if idle time < sleep time
	AND	idltim+2, lo, slptim+2	;[ note -- order of tests important
	OR	idltim, lt, slptim	;(IF .. AND ..) OR .. ]
		mov	idltim, slptim	;shorten sleep time
		mov	idltim+2, slptim+2
	ENDIF
.if ne	debug
	mov	idltim+2, r3		;convert time to minutes, seconds
	mov	idltim, r2
	div	(sp), r2		;convert to minutes
	PNOTE	<Will kill jobs idle for more than >
	IF	r2, gt
		TYP.10	r2
		PNOTE	< minute>
		IF	r2, gt, #1
			PNOTE	<s>
		ENDIF
		PNOTE	< >
	ENDIF
	IF	r3, gt			;if some seconds specified,
		clr	r2		;convert from ticks
		div	2(sp), r2
		TYP.10	r2
		PNOTE	< seconds>
	ENDIF
	NOTE
	mov	slptim+2, r3		;convert time to minutes, seconds
	mov	slptim, r2
	div	(sp), r2		;convert to minutes
	PNOTE	<Will check jobs every >
	IF	r2, gt
		TYP.10	r2
		PNOTE	< minute>
		IF	r2, gt, #1
			PNOTE	<s>
		ENDIF
		PNOTE	< >
	ENDIF
	IF	r3, gt			;if some seconds specified,
		clr	r2		;convert from ticks
		div	2(sp), r2
		TYP.10	r2
		PNOTE	< seconds>
	ENDIF
	NOTE
.endc
	POP				;remove tick conversions from stack
	POP
ENDPROC

PROCED	cntlin, <determine the maximum legal line number>
	clr	maxlin			;initialize maximum line number
	REPEAT
		inc	maxlin		;try next line
		JSTAT	maxlin, #stat., lintab
		IF	cs
.if ne	debug
			PUSH	@#errbyt
			PNOTE	<Line >
			TYP.10	maxlin
			POP	@#errbyt
.endc
			IFB	@#errbyt, eq, #2	;invalid line code
.if ne	debug
				NOTE	< invalid>
.endc
				sec			;leave carry set
			ELSIFB	@#errbyt, eq, #0	;not logged on
.if ne	debug
				NOTE	< not logged on>
.endc
				clc			;OK
			ELSE
.if ne	debug
				NOTE	< unknown JSTAT error>
.endc
				sec			;some random error
			ENDIF
.if ne	debug
		ELSE
			PNOTE	<Line >
			TYP.10	maxlin
			NOTE	< OK>			
.endc
		ENDIF
	UNTIL	cs			;should exit on invalid line
	dec	maxlin			;point to last valid line
ENDPROC

PROCED	getspc, <reserve space for tables at end of program>
	mov	@#userto, r0		;reserve buffer space above program
	add	#2, r0			;bump to first free space
	mov	r0, lintab		;use for line table
	mov	maxlin, r1		;compute table size
	mul	#entsiz, r1
	add	r1, r0			;add to end of program
	mov	r0, endtab		;save requested end of table
	.SETTOP				;reserve space
	MEMTOP	endtab			;limit memory size
.if ne	debug
	PNOTE	<Line table located from >
	TYP.8	lintab
	PNOTE	< to >
	TYP.8	endtab
	NOTE
	PNOTE	<.SETTOP returned >
	TYP.8	@#userto
	PNOTE	<, MEMTOP returned >
	TYP.8	r0
	NOTE
.endc
	IF	r0, lo, endtab
		NOTE	<WATCH - F - Not enough room for line tables>
		.EXIT
	ENDIF
ENDPROC

PROCED	initbl, <initialize line table>
	mov	lintab, r1		;point to line table
	FOR	line, #1, maxlin	;for each line,
		JSTAT	line, #stat., r1	;get basic status
		IF	cs
			INVOKE	erase		;erase r1 entry
		ELSE
			INVOKE	inisub		;initialize entry
		ENDIF
	ENDFOR
.if ne	debug
	NOTE	<Initial table>
	INVOKE	sholin
.endc
ENDPROC

PROCED	inisub, <subroutine to initialize one table entry>
;on entry, r1 points to a line entry
;on exit, r1 points to next line entry

	add	#2, r1			;status set, bump to next entry
	FOR	stat, #exec., #jnum.
.enabl	lsb
		CASE	stat, <1$, 1$, 1$, 1$, 2$, 2$, 3$, 1$, 4$, 5$>
			;exec mem conn posn name ppn cpu prio jnam jnum
	1$:			;one-word entry
			JSTAT	line, stat, r1	;get next status entry
			add	#2, r1		;bump to next entry
		ENDEL
	2$:			;two-word entries
			JSTAT	line, stat, r1	;get next status entry
			add	#4, r1		;bump to next entry
		ENDEL
	3$:			;cpu
			JSTAT	line, stat, r1	;get next status entry
			PUSH	<2(r1), (r1)>	;save time for delta-t
			add	#4, r1		;bump to next entry
		ENDEL
	4$:			;job name		
			IF	versn, ge, #tsx62	;job name, need v6.2
				JSTAT	line, stat, r1	;job name
			ENDIF
			add	#namsiz, r1	;bump to next entry
		ENDEL
	5$:			;primary, parent
			IF	versn, ge, #tsx64	;primary, need v6.4
				JSTAT	line, stat, r1	;primary, parent jobs
			ENDIF
			add	#4,r1		;bump to next entry
		ENDEL
		ENDCASE
.dsabl	lsb
	ENDFOR
	POP	<(r1)+, (r1)+>	;initialize delta-t as CPU so far	
	clr	(r1)+		;zero out idle time
	clr	(r1)+
ENDPROC

PROCED	sleep, <suspend operations for a while>
.if ne	debug
	PNOTE	<Off to bed ...>
.endc
	.TWAIT	#emtarg, #slptim	;off to sleep
.if ne	debug
	NOTE	< Ah, back again>
.endc
ENDPROC

PROCED	update, <update line table>
	mov	lintab, r1		;point to line table
	FOR	line, #1, maxlin	;for each line,
		JSTAT	line, #stat., r1	;get basic status
		IF	cs
			INVOKE	erase		;erase r1 entry
		ELSE
			INVOKE	upsub		;update entry
		ENDIF
	ENDFOR
.if ne	debug
	INVOKE	sholin			;show me the contents
.endc
ENDPROC

PROCED	upsub, <subroutine, update table entry pointed to by r1>
;on exit, r1 points to next line entry

	add	#2, r1			;status set, bump to next entry
	FOR	stat, #exec., #jnum.
.enabl	lsb
		CASE	stat, <1$, 1$, 1$, 1$, 2$, 2$, 3$, 1$, 4$, 5$>
			;exec mem conn posn name ppn cpu prio jnam jnum
	1$:	
			JSTAT	line, stat, r1	;next entry
			add	#2, r1		;bump to next entry
		ENDEL
	2$:
			JSTAT	line, stat, r1	;next entry
			add	#4, r1		;bump to next entry
		ENDEL
	3$:
			PUSH	<(r1), 2(r1)>	;save old time
			JSTAT	line, stat, r1	;get cpu time
			PUSH	<(r1), 2(r1)>	;save time
			add	#4, r1		;bump to next entry
		ENDEL
	4$:
			IF	versn, ge, #tsx62	;job name, need v6.2
				JSTAT	line, stat, r1	;job name
			ENDIF
			add	#namsiz, r1	;bump to next entry
		ENDEL
	5$:
			IF	versn, ge, #tsx64	;primary, need v6.4
				JSTAT	line, stat, r1	;primary, parent jobs
			ENDIF
			add	#4,r1		;bump to next entry
		ENDEL
		ENDCASE
.dsabl	lsb
	ENDFOR
	POP	<r5, r4, r3, r2>	;retrieve times		
	sub	r3, r5			;subtract low times
	sbc	r4
	sub	r2, r4			;deltas now in r4-r5
	mov	r4, (r1)+		;save delta t
	mov	r5, (r1)+
	IF	r4, eq			;if no cpu time has elapsed
	AND	r5, eq			;since last watch,
		add	slptim+2, 2(r1)	;update idle timer
		adc	(r1)
		add	slptim, (r1)+
		add	#2, r1		;and bump pointer
	ELSE
		clr	(r1)+		;otherwise, clear timer
		clr	(r1)+
	ENDIF
ENDPROC

PROCED	erase, <erase table entry pointed to by r1>
;on exit, r1 points to next line entry

	mov	#-1, (r1)+		;line not logged on
	FOR	stat, #exec., #jnum.
.enabl	lsb
		CASE	stat, <1$, 1$, 1$, 1$, 2$, 2$, 2$, 1$, 3$, 2$>
			;exec mem conn posn name ppn cpu prio jnam jnum
	1$:	
			clr	(r1)+	;clear one-word entry
		ENDEL
	2$:
			clr	(r1)+	;clear two-word entry
			clr	(r1)+
		ENDEL
	3$:
			PUSH	r2	;save counter
			FOR	r2, #1, #namsiz
				clrb	(r1)+	;clear name
			ENDFOR
			POP	r2
		ENDEL
		ENDCASE
.dsabl	lsb
	ENDFOR
	clr	(r1)+			;clear delta entry
	clr	(r1)+
	clr	(r1)+			;clear idle entry
	clr	(r1)+
ENDPROC

PROCED	sholin, <show each line entry>
	PNOTE	<Line Stat Conn  Prog       PPN     CPU ticks  >
	NOTE	<Job          Pri Par  Idle ticks>
	mov	lintab, r1		;point to line table
	FOR	line, #1, maxlin	;for each line,
		IF	stat..(r1), ge		;if line active,
			IF	line, lt, #^d10
				PNOTE	< >
			ENDIF
			TYP.10	line
			INVOKE	shosta	;show selected stats
		ELSE
			add	#entsiz, r1	;bump to next entry
		ENDIF
	ENDFOR
ENDPROC

PROCED	shosta, <show selected stats>
;enter with r1 pointing to line entry
;on exit, r1 points to next entry

	INVOKE	rjusto			;right justify, octal
	TYP.8	(r1)+			;output status
	FOR	stat, #exec., #jnum.
.enabl	lsb
		CASE	stat, <7$, 7$, 1$, 7$, 2$, 3$, 4$, 7$, 5$, 6$>
			;exec mem conn posn name ppn cpu prio jnam jnum
	1$:			;connect time, minutes
			INVOKE	rjustd		;right justify, decimal
			TYP.10	(r1)+		;output value
		ENDEL
	2$:			;RAD50 name
			PNOTE	<  >
			INVOKE	r50asc		;rad50 - ascii output
		ENDEL
	3$:			;PPN
			PNOTE	<  >
			IF	(r1), lt, #^d10	;format PPN
				PNOTE	<  >
			ELSIF	(r1), lt, #^d100
				PNOTE	< >
			ENDIF
			TYP.10	(r1)+
			PNOTE	<, >
			IF	(r1), lt, #^d10	;format PPN
				PNOTE	<  >
			ELSIF	(r1), lt, #^d100
				PNOTE	< >
			ENDIF
			TYP.10	(r1)+
		ENDEL
				
	4$:			;cpu ticks
			mov	(r1)+, r2	;get high ticks
			mov	(r1)+, r3	;get low ticks
			INVOKE	shotic		;output two-word decimal
		ENDEL
	5$:			;job name
			PNOTE	<  >
			PUSH	r2	;save register
			IF	versn, ge, #tsx62	;need at least v6.2
				FOR	r2, #1, #namsiz
					IFB	(r1), ne	;if character,
						.TTYOUT	(r1)
					ELSE
						PNOTE	< >
					ENDIF
					inc	r1	;bump pointer
				ENDFOR
			ELSE
				FOR	r2, #1, #namsiz
					PNOTE	< >
				ENDFOR
				add	#namsiz, r1	;bump pointer
			ENDIF
			POP	r2		;restore register
		ENDEL
	6$:			;primary, parent lines
			IF	versn, ge, #tsx64	;need at least v6.4
				IF	(r1), lt, #^d10	;justify
					PNOTE	<  >
				ELSE
					PNOTE	< >
				ENDIF
				TYP.10	(r1)+		;output value
				PNOTE	< >		;extra space for looks
				IF	(r1), lt, #^d10	;justify
					PNOTE	<  >
				ELSE
					PNOTE	< >
				ENDIF
				TYP.10	(r1)+
			ELSE
				PNOTE	<       >
				add	#4, r1		;bump past entry
			ENDIF
		ENDEL
	7$:			;ignore entry
			add	#2, r1
		ENDEL
		ENDCASE
.dsabl	lsb
	ENDFOR
	add	#4, r1			;ignore delta-t entry
	mov	(r1)+, r2		;get high idle time
	mov	(r1)+, r3		;get low idle time
	INVOKE	shotic			;output two-word decimal
	NOTE
ENDPROC

	.sbttl	------------------
	.sbttl	Line kill routines
	.sbttl	------------------

PROCED	isidle, <determine if line truly idle>
;enter with r1 pointing to main line's table entry
;return with carry set if active and elapsed idle time > idltim

	IF	stat..(r1), lt		;if line not active
		clc			;return not-idle
	ELSE
		PUSH	<idle..(r1), idle..+2(r1)>	;save idle time
		sub	idltim+2, (sp)+	;subtract lows
		sbc	(sp)
		sub	idltim, (sp)+	;subtract highs
		IF	ge		;if idle > idltim,
			sec		;return with carry set
		ELSE
			clc
		ENDIF
	ENDIF
ENDPROC

PROCED	kilidl, <kill idle line>
	mov	endtab, r1		;point to end of line table
	FOR	line, maxlin, #1, #-1	;for each line (subprocesses first),
		sub	#entsiz, r1	;bump to previous entry
		INVOKE	isidle		;return with carry set if idle
		IF	cs		;if truly idle,
			PUSH	stat..(r1)	;save status
			bic	#^c<det.!sub.>, (sp)	;keep bits
			IF	(sp), eq, #det.	;set up case flag
				mov	#3, (sp)
			ELSIF	(sp), eq, #sub.
				mov	#2, (sp)
			ELSE
				mov	#1, (sp)
			ENDIF
			CASE	(sp)+, <k.main, k.sub, k.det>	;go kill
		k.main:
				IF	name..(r1), eq, #^rKED	;allow edits
				AND	name..+2(r1), eq
					NOTE	<Allowing idle edits>
				ELSE
					INVOKE	bsysub	;check sub-process
					IF	cs	;none match
						PNOTE	<Killing idle line >
						TYP.10	line
						NOTE
						INVOKE	kill	;kill the line
						PUSH	r1	;remember r1
						INVOKE	erase	;erase entry
						POP	r1	;restore r1
	.if ne	debug
					ELSE
						PNOTE	<Line >
						TYP.10	line
						NOTE	<, busy sub-process>
	.endc
					ENDIF
				ENDIF
			ENDEL
		k.sub:
				IF	name..(r1), eq, #^rKED	;allow edits
				AND	name..+2(r1), eq
					NOTE	<Allowing idle edits>
				ELSE
					PNOTE	<Killing idle line >
					TYP.10	line
					NOTE
					INVOKE	kill	;kill the line
					PUSH	r1	;remember r1
					INVOKE	erase	;erase entry
					POP	r1	;restore r1
				ENDIF
			ENDEL
		k.det:
.if ne	debug
				PNOTE	<Line >
				TYP.10	line
				NOTE	< detached, left alone>
.endc
			ENDEL
			ENDCASE
		ENDIF
	ENDFOR
ENDPROC

PROCED	kill, <kill line "line">
	PUSH	<#kilnam, #killdb>	;set up file name conversion
	INVOKE	parse			;parse file name
	.ENTER	#emtarg, #iochan, #killdb, #1	;open "kill" file
	IF	cs
		NOTE	<Cannot open "kill" command file>
	ELSE
		PUSH	<r1, r2>	;save registers
		mov	line, r1	;need to decode line number
		mov	#killin, r2	;location for output string
		INVOKE	dec2		;decode decimal
		.WRITW	#emtarg, #iochan, #kilstr, #killen, #0	;write string
		POP	<r2, r1>	;restore registers
		IF	cs
			NOTE	<Error in writing "kill" command file>
		ELSE
			.CLOSE	#iochan
			DETACH	#kilnam	;detach the file
			IF	cs
				NOTE	<Cannot detach "kill" file>
			ELSE
				REPEAT
					DETSTA	r0	;wait for job to end
				UNTIL	cs
			ENDIF
		ENDIF
	ENDIF
ENDPROC

PROCED	bsysub, <check if main has busy sub-process>
;return with carry clear if true, carry set if killable process
;enter with r1 pointing to main line's table entry

	PUSH	r3			;save register
	mov	line, r3		;use r3 as test line entry
	mul	#entsiz, r3		;point to entry just past "line"
	add	lintab, r3		;add start of table
	INVOKE	samlin			;see if r3 points to "same" line as r1
	POP	r3			;restore register
ENDPROC

PROCED	samlin, <see if subprocesses match r1 line>
;on entry, r3 points to current line entry to test
;for version 6.4 and later, compare primary lines via jnum..
;for older versions, compare PPN
;on exit, carry set if line "killable" (no matching subprocess), else clear

	IF	r3, his, endtab		;if all lines tested,
		sec			;no busy process, "killable"
	ELSE
		bit	#sub., stat..(r3)	;test subprocess bit
		IF	eq		;if not subprocess	
		OR	stat..(r3), lt	;nor not active
			add	#entsiz, r3	;point to next etnry
			br	samlin	;tail-end recursion
		ELSIF	versn, ge, #tsx64	;for latest versions,
			IF	jnum..(r1), eq, jnum..(r3)	;primaries 
				clc		;exit, subprocess exists
			ELSE
				add	#entsiz, r3	;point to next etnry
				br	samlin	;tail-end recursion
			ENDIF
		ELSE				;otherwise compare ppn
			IF	ppn..(r1), eq, ppn..(r3)	;if ppn
			AND	ppn..+2(r1), eq, ppn..+2(r3)	;matches,
				clc		;exit, subprocess exists
			ELSE
				add	#entsiz, r3	;point to next etnry
				br	samlin	;tail-end recursion
			ENDIF
		ENDIF
	ENDIF
ENDPROC

	.sbttl	-----------------------------
	.sbttl	Character-processing routines
	.sbttl	-----------------------------

PROCED	parse, <convert ascii file name to rad50 dblk>
;on entry, location of ascii string and dblk on stack

	PUSH	<r2, r3>		;save registers
	mov	4+4(sp), r2		;ascii pointer
	mov	4+2(sp), r3		;dblk pointer
	INVOKE	ascr50			;convert 3 characters, probable device
	IFB	(r2), eq, #':		;if device found,
		mov	r0, (r3)+	;save it
		inc	r2		;skip over colon
		INVOKE	ascr50		;get first word of file name
	ELSE
		clr	(r3)+		;null out device
	ENDIF
	IFB	(r2), eq, #'.		;if end of file name
	ORB	(r2), eq
		IF	r0, eq		;if no file name,
			mov	#^rTMP, (r3)+	;save default
		ELSE
			mov	r0, (r3)+	;save parsed name
		ENDIF
	ELSE
		mov	r0, (r3)+	;save parsed name
	ENDIF
	INVOKE	ascr50			;get rest of file name
	mov	r0, (r3)+		;and save it
	IFB	(r2), eq, #'.		;if extension present,
		inc	r2		;bump past dot
	ENDIF
	INVOKE	ascr50			;get extension
	mov	r0, (r3)+		;and save it
	POP	<r3, r2>		;restore registers
	POP	<(sp), (sp)>		;discard arguments
ENDPROC	

PROCED	ascr50, <convert character string to rad50>
;on entry, r2 points to ascii string
;on exit, r2 points to next character to convert, 3-digit code returned in r0
;note that r2 will not be bumped past characters not alphanumeric

	PUSH	r1			;save register
	clr	r1			;use for now as accumulator
	FOR	r0, #1, #3		;convert three ascii characters
		mul	#50, r1		;shift up one rad50 character
		IFB	(r2), eq, #space	;start conversion
			inc	r2	;space = 0
		ELSIFB	(r2), ge, #'A
		ANDB	(r2), le, #'Z
			PUSHB	(r2)+	;get byte
			bic	#^c177, (sp)	;keep only one char
			add	(sp)+, r1	;add rad50 value
			sub	#<'A-1>, r1	;convert to ascii, 'A = 1
		ELSIFB	(r2), ge, #'a
		ANDB	(r2), le, #'z
			PUSHB	(r2)+
			bic	#^c177, (sp)	;keep only one char
			add	(sp)+, r1
			sub	#<'a-1>, r1	;'a = 1
		ELSIFB	(r2), ge, #'0
		ANDB	(r2), le, #'9
			PUSHB	(r2)+
			bic	#^c177, (sp)	;keep only one char
			add	(sp)+, r1
			sub	#<'0-36>, r1	;'0 = 36
		ELSE				;all others illegal,
						;don't move r2 pointer
		ENDIF
	ENDFOR
	mov	r1, r0			;return value in r0
	POP	r1			;restore register
ENDPROC

PROCED	dec2, <decode number as one or two-digit decimal>
;number in r1, output string in r2, may output leading space

	IF	r1, lt			;if negative,
		clr	r1		;truncate at 0!
	ENDIF
	WHILE	r1, ge, #^d100		;reduce to two digits
		sub	#^d100, r1
	ENDWHILE
	IF	r1, lt, #^d10		;if single digit,
		movb	#space, (r2)+	;output leading space
		add	#'0, r1		;make ascii numeral
		movb	r1, (r2)+	;and save second digit
	ELSE
		clr	r0		;set up division
		div	#^d10, r0	;get high, low digits
		add	#'0, r0		;make ascii numeral
		movb	r0, (r2)+	;output high digit
		add	#'0, r1		;repeat with low digit
		movb	r1, (r2)+	;and save it
	ENDIF
ENDPROC

PROCED	rjusto, <output leading spaces to right-justify octal values in r1>
	IF	(r1), lo, #10
		PNOTE	<     >
	ELSIF	(r1), lo, #100
		PNOTE	<    >
	ELSIF	(r1), lo, #1000
		PNOTE	<   >
	ELSIF	(r1), lo, #10000
		PNOTE	<  >
	ELSIF	(r1), lo, #100000
		PNOTE	< >
	ENDIF
ENDPROC

PROCED	rjustd, <output leading spaces to right-justify decimal values in r1>
	IF	(r1), lt, #-^d1000
		PNOTE	< >
	ELSIF	(r1), lt, #-^d100
		PNOTE	<  >
	ELSIF	(r1), lt, #-^d10
		PNOTE	<   >
	ELSIF	(r1), lt, #0
		PNOTE	<    >
	ELSIF	(r1), lt, #^d10
		PNOTE	<     >
	ELSIF	(r1), lt, #^d100
		PNOTE	<    >
	ELSIF	(r1), lt, #^d1000
		PNOTE	<   >
	ELSIF	(r1), lt, #^d10000
		PNOTE	<  >
	ELSE
		PNOTE	< >
	ENDIF
ENDPROC

PROCED	r50asc, <rad-50 ascii output routine>
;enter with r1 pointing to two-word (6-char) rad50 name

	PUSH	<(r1)+, #3>		;output first rad50, 3 characters
	INVOKE	r50a
	PUSH	<(r1)+, #3>		;output second word
	INVOKE	r50a
ENDPROC

PROCED	r50a, <rad50 working recursive procedure>
;stack holds current rad50 word, current character count

	PUSH	<r4, r5>		;save registers
	mov	4+4(sp), r5		;get rad50 word
	clr	r4			;set up for division
	div	#50, r4			;isolate high, low characters
	IF	2+4(sp), gt, #1		;if not last rad50 character,
		PUSH	r4		;push most significant characters
		PUSH	2+2+4(sp)	;push current rad50 count
		dec	(sp)		;count down
		INVOKE	r50a		;output high characters first
	ENDIF
	IF	r5, eq			;decode low character
		mov	#space, r5	;0 = space
	ELSIF	r5, le, #32
		add	#<'A-1>, r5	;1 .. 32, 'A .. 'Z
	ELSIF	r5, eq, #33
		mov	#'$, r5		;33 = '$
	ELSIF	r5, eq, #34
		mov	#'., r5		;34 = '.
	ELSIF	r5, eq, #35
		mov	#'?, r5		;35 = unused
	ELSE
		add	#<'0-36>, r5	;36 .. 47, '0 .. '9
	ENDIF
	.TTYOUT	r5
	POP	<r5, r4>		;restore registers
	POP	<(sp), (sp)>		;discard arguments
ENDPROC

PROCED	shotic, <output two-word decimal ticks>
;enter with two-word value in r2, r3

	IF	r2, lt			;if negative,
		PNOTE	<->
		com	r2		;negate
		neg	r3
		adc	r2
	ELSE
		PNOTE	< >
	ENDIF
	PUSH	r1			;save register			
	div	#^d10000, r2		;separate into high, low decimal
	PUSH	r2			;save high
	mov	sp, r1			;make r1 point to high
	INVOKE	rjustd			;right justify, decimal
	IF	r2, eq			;if no high,
		mov	r3, (sp)	;replace with low
		INVOKE	rjustd
		TYP.10	r3		;output low
	ELSE
		PNOTE	< >		;output blank to align
		TYP.10	r2		;output high
		IF	r3, lt, #^d10	;output intermediate 0s
			PNOTE	<000>
		ELSIF	r3, lt, #^d100
			PNOTE	<00>
		ELSIF	r3, lt, #^d1000
			PNOTE	<0>
		ENDIF
		TYP.10	r3		;output low
	ENDIF
	POP				;discard scratch space
	POP	r1			;restore r1
ENDPROC		

	.sbttl	----------
	.sbttl	Data space
	.sbttl	----------

	.psect	$data

LABEL	modnam, <module name>
	.NLCSI				;generates .asciz module string
	.even

HEAD	var, <Variables>
versn:	.word	0			; Current TSX version
line:	.word	0			; Current line number
maxlin:	.word	0			; Maximum line number
idltim:	.blkw	2			; Maximum time (ticks) allowed idle
slptim:	.blkw	2			; Time (ticks) to sleep
stat:	.word	0			; Current status test (1 .. 8)
lintab:	.word	0			; Address of the line table
endtab:	.word	0			; End of line table
tsxarg:	.blkw	4			; Argument area for TSX emts
priv:	.blkw	4			; TSX privilege table
emtarg:	.blkw	10			; Argument area for i/o emts
killdb:	.rad50	/DK WATCH KIL/		; File name used for "kill" command
kilnam:	.asciz	"DK:WATCH.KIL"		; Ascii file name of "kill" file
	.even

.if eq	debug				; For real file, delete as executed
kilstr:	.ascii	"kill "			; Contents of "kill" command file
killin:	.ascii	"nn"<cr><lf>		; "nn" -- line number
	.ascii	"delete dk:watch.kil"<cr><lf>
	.even
	killen	=	<. - kilstr> / 2
.iff					; For debugging, comment out actions
kilstr:	.ascii	"!kill "		; Contents of "kill" command file
killin:	.ascii	"nn"<cr><lf>		; "nn" -- line number
	.ascii	"!delete dk:watch.kil"<cr><lf>
	.even
	killen	=	<. - kilstr> / 2
.endc

HEAD	lintab, <line table>
;a table will be built here holding information about each time-sharing line
;this table will be periodically updated by this program
;the format for the table is as follows --
;for each line, the following information is kept:

				;code   meaning
	stat.. = 0		; 0	-1 = logged off
				;	bit 1 set, sub-process
				;	bit 2 set, detached
	exec.. = stat.. + 2	; 1	exec state	
	mem..  = exec.. + 2	; 2	number of 256-word blocks in use
	conn.. = mem..  + 2	; 3	minutes connected
	posn.. = conn.. + 2	; 4	block number (256-word) in memory
	name.. = posn.. + 2	; 5	two-word .rad50 name of program
	ppn..  = name.. + 4	; 6	two-word PPN
	cpu..  = ppn..  + 4	; 7	two-word clock ticks used by job
	prio.. = cpu..  + 4	; 8	current execution priority
	jnam.. = prio.. + 2	; 9	12-byte job name (reserve "namsiz")
	jnum.. = jnam.. + namsiz;10	primary, parent job numbers
	delt.. = jnum.. + 4	;11	two-word cup time since last watch
	idle.. = delt.. + 4	;12	two-word cpu time job is idle
	
	entsiz = idle.. + 4	;	total entry size

	ENDEND

	.end	watch