.mcall	.MODULE
	.MODULE	HALT,comment=<Halt TSX>,release=V09,version=07

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

;**************************************************************;
;                                                              ;
;   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. ;
;                                                              ;
;**************************************************************;

; HALT is designed to allow an orderly shut-down of TSX.  It monitors all 
; available lines, logging off idle lines.  If a shutdown is really
; desired, it broadcasts warning messages to all users to allow them to
; finish work-in-progress.  Jobs on detached lines (such as WATCH) are left
; to the last minute.  When it exits, it is the only job running, and a
; $SHUTDOWN has been posted.

; A typical application is to set up a privileged account (here called RT11)
; which, instead of running LOGON/lock, runs HALT/lock, followed by OFF.

; If an auto-restart of TSX is desired, it is accomplished by simply writing
; a file, called NOW.TSX, which contains the current date and time.  It is
; the responsibility of START?.COM to look for it and act accordingly.

; This version adapted from WATCH 8.8, HALT.PAS 8.8

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

;b schor	august 29, 1988

;modifications --
;	aug, 1988	Incorporate explicit SENDs to each active line
;	sep, 1988	Bugs removed, tests OK
;	sep, 1988	GTLIN replaced by .TTYIN, coded to end properly
;	sep, 1988	Fixed bug in use of DETSTA (macro modifies r0)
;	sep, 1988	In detached command files, self-delete placed last
;	sep, 1988	1 second delay added after kilidl, allow to complete 
;	nov, 1988	Changes/improvements added for TSX v6.4
;			Queue check implemented
;			Sleep timer logic fixed (minor bug)
;			Sub-processes can check their parents by job number
;	dec, 1988	Auto-restart controlled by "arstrt" conditional
;			Fixed .asciz bug in queue message
;			Add 1 second sleep in tellme to prevent SEND overwrite
;	may, 1989	Psects $CODE and $DATA added
;	may, 1989	WATCH logic changed.  
;	jul, 1989	Sleep redone, parameter now in ticks
;			Short delay after all line kills (TSX is too fast)

;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	.TTYIN			;to get information from user
	.mcall	.GVAL			;used to get system info
	.mcall	.TWAIT			;to sleep
	.mcall	.ENTER, .WRITW, .CLOSE	;for creating detached file
	.mcall	.DATE, .GTIM		;to build NOW.TSX


HEAD	syscon, <system constants>

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

	clk50$	=	40		;50-Hz clock bit in config word
	tsx$	=	100000		;TSX bit in sysgen word

HEAD	offset, <monitor offsets>

	sysgen	=	372		;offset to sysgen features
	config	=	300		;configuration word
	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

	arstrt	=	1		;define to include auto-restart code
.iif ndf	arstrt	arstrt	=	0
.iif ne		arstrt	arstrt	=	1

HEAD	const, <program constants>

	tsx62	=	^d620		;version identification for v6.2
	tsx64	=	^d640		;version identification for v6.4
	mintim	=	2		;minimum, maximum time (minutes) 
	maxtim	=	^d15		;for users to log off
	reptim	=	^d30		;time (seconds) of halt repetition
	namsiz	=	20		;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
	ctrlz	=	32		;^Z, line termination for .TTYIN
	bell	=	7		;ascii bell
	space	=	'   		;ascii space
	comma	=	',		;ascii comma

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

	queue.	=	107		;spool queue query
	tslin.	=	110		;test current line
	send.	=	127		;send message
	detch.	=	132		;detach job
	jstat.	=	144		;determine job status

;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	TSTLIN, <test and return line used by this program>
;	TSTLIN
;returns line number in r0

	.macro	TSTLIN

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

	.endm	TSTLIN

HEAD	JSTAT, <macro to generate TSX job status emts>
;	JSTAT	line-#, sub-function, buffer-address
;examples -- 
;	JSTAT	#1, #0, #stat	;get status of line 1 in variable "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	RDLIN, <get line from terminal>
;use .TTYIN to empty buffer into argument string

	.macro	RDLIN	reply

	PUSH	r1			;save register, use r1 as pointer
	mov	reply, r1		;point to string destination
	REPEAT
		.TTYIN			;get a character
		movb	r0, (r1)+	;save it
	UNTILB	r0, eq, #lf		;until terminator encountered
	ORB	r0, eq, #ctrlz
	clrb	(r1)+			;make asciz
	POP	r1			;restore register

	.endm	RDLIN

HEAD	SEND, <macro to send message to another line>
;	SEND	linnum, msg
;where line holds the current line, message is the fwa of the desired message

	.macro	SEND	linnum, msg

	movb	#0, tsxarg		;save default numeric value
	movb	#send., tsxarg+1	;save low byte, emt number
	mov	linnum, tsxarg+2	;save line number
	mov	msg, tsxarg+4		;save message address
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX

	.endm	SEND

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

HEAD	QUELEN, <macro to return queue length>
;	QUELEN	arg			;length returned in variable "arg"
;	QUELEN				;length returned in r0

	.macro	QUELEN	arg

	movb	#1, tsxarg		;save "return queue length" argument
	movb	#queue., tsxarg+1	;save low byte, emt number
	mov	#tsxarg, r0		;point to emt area
	do.tsx				;call on TSX
.iif nb	arg	mov	r0, arg		;return argument if specified

	.endm	QUELEN

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

	.psect	$code

LABEL	halt, <Program start>
	NOTE
	.PRINT	#modnam			;identify module
	NOTE
	INVOKE	istsx			;make sure running TSX
	INVOKE	getver			;get current version
	INVOKE	isprv			;assure running on privileged line
	INVOKE	cntlin			;set maxlin, max valid line number
	INVOKE	getclk			;get 50/60 Hz clock
	INVOKE	kilidl			;kill idle lines
	INVOKE	tellme			;tell me who's active, set busy, queue
	PNOTE	<Do you really want to shut down the system?  >
	RDLIN	#reply			;get answer
	IFB	reply, ne, #'Y
	ANDB	reply, ne, #'y
		.EXIT			;no shutdown, exit instead
	ENDIF
	INVOKE	shutme			;schedule the shutdown
.if ne	arstrt				;if auto-restart code desired,
	PNOTE	<Automatically restart TSX?  >
	RDLIN	#reply			;get answer
	IFB	reply, eq, #'Y		;save response
	ORB	reply, eq, #'y
		mov	#1, gotsx	;set restart flag
	ELSE
		clr	gotsx		;clear restart flag
	ENDIF
.iff					;if no auto-restart wanted,
	clr	gotsx			;inhibit auto-restart
.endc
	IF	busy, ne		;if people still active,
		REPEAT
			PNOTE	<How many minutes for users to finish?  >
			PNOTE	<[>
			TYP.10	#mintim
			PNOTE	< .. >
			TYP.10	#maxtim
			PNOTE	<]  >
			RDLIN	#reply	;get answer
			INVOKE	maknum	;return numeric value
		UNTIL	r0, ge, #mintim
		AND	r0, le, #maxtim
		mov	r0, r1		;convert minutes to seconds
		mul	#^d60, r1
		mov	r1, waitim	;save waiting time
	ENDIF
	WHILE	queue, ne		;while still stuff in queue,
		INVOKE	warnus		;warn about TSX shutting down
		PUSH	slptim		;sleep 30 seconds
		INVOKE	sleep		;wait awhile
		INVOKE	kilidl		;kill idle lines
		INVOKE	tellme		;tell me who's active
	ENDWHILE
	WHILE	busy, ne		;while users still active
	AND	waitim, gt		;and time left on wait clock,
		INVOKE	warnus		;warn about TSX shutting down
		sub	#reptim, waitim	;subtract repetition from wait time
		PUSH	slptim		;sleep 30 seconds
		INVOKE	sleep		;wait awhile
		INVOKE	kilidl		;kill idle lines
		INVOKE	tellme		;tell me who's active
	ENDWHILE
	INVOKE	kilall			;kill all other jobs
	IF	gotsx, ne		;if tsx auto-restart desired,
		INVOKE	setgo		;write date/time file as flag
	ENDIF
	.EXIT				;all done

	.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	<HALT - 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 is privileged>
	TSTLIN				;see which line this is
	mov	r0, hltlin		;save current line
	PNOTE	<HALT running on line >
	TYP.10	hltlin
	PNOTE	<, >
	PUSH	hltlin			;identify this line
	INVOKE	showho
	NOTE
	JSTAT	hltlin, #stat., #status	;get line status
	bit	#prv., status		;see if privilege bit set
	IF 	eq
		NOTE	<HALT - F - This line is not privileged>
		.EXIT
	ENDIF
ENDPROC

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

PROCED	getclk, <determine if 50 or 60 Hz clock>
	.GVAL	#emtarg, #config	;return configuration word
	bit	r0, #clk50$		;test 50 Hz bit
	IF	ne			;set clock speed, ticks/second
		mov	#^d50, clkspd
	ELSE
		mov	#^d60, clkspd
	ENDIF
	mov	#reptim, r1		;compute repetition time in ticks
	mul	clkspd, r1
	mov	r1, slptim		;save sleep time
	mov	clkspd, r1		;compute delay time
	asr	r1			;1/2 second
	mov	r1, deltim
ENDPROC

PROCED	tellme, <tell me who is still active and queue length>
	clr	busy			;so far, no active user seen
	FOR	line, #1, maxlin
		JSTAT	line, #stat., #status	;find status
		IF	cc			;if active
		AND	line, ne, hltlin	;and not this program,
			bit	#det., status	;check for detached job
			IF	eq		;if not,
				inc	busy	;count active user
			ENDIF
			PNOTE	<Line >
			IF	line, lt, #^d10
				PNOTE	< >
			ENDIF
			TYP.10	line
			PNOTE	<, >
			PUSH	line		;identify user of line
			INVOKE	showho
			PNOTE	<, running >
			JSTAT	line, #name., #status	;get name of routine
			PUSH	<#status, #6>	;set up information for 
			INVOKE	r50asc		;rad50 - ascii output
			NOTE
		ENDIF
	ENDFOR
	IF	versn, ge, #tsx64	;if version >= 6.40,
		QUELEN	queue		;return queue length
		IF	queue, gt
			PNOTE	<Spool queue : >
			TYP.10	queue
			NOTE
		ELSE
			NOTE	<Spooler idle>
		ENDIF
	ELSE
		clr	queue		;assume queue empty
	ENDIF
	PUSH	deltim			;short delay, complete message
	INVOKE	sleep
ENDPROC

PROCED	shutme, <issue $SHUTDOWN>
	PUSH	<#shtnam, #shtdb>	;set up file name conversion
	INVOKE	parse			;parse file name
	.ENTER	#emtarg, #iochan, #shtdb, #1	;open "shutdown" file
	IF	cs
		NOTE	<Cannot open "shutdown" command file>
	ELSE
		.WRITW	#emtarg, #iochan, #shtstr, #shtlen, #0	;write string
		IF	cs
			NOTE	<Error in writing "shutdown" command file>
		ELSE
			.CLOSE	#iochan
.if ne	debug				;for debugging,
			NOTE	<Detaching $SHUTDOWN>
.endc
			DETACH	#shtnam	;detach the file
			IF	cs
				NOTE	<Cannot detach "shutdown" file>
			ELSE
				REPEAT
					DETSTA	r0	;wait for job to end
				UNTIL	cs
			ENDIF
		ENDIF
	ENDIF
ENDPROC

PROCED	showho, <show who is using a line>
;enter with line number on stack
;if version prior to 6.2, will show PPN
;otherwise, will show job name
	IF	versn, lt, #tsx62	;if earlier version than 6.2,
		PNOTE	<PPN >
		JSTAT	2(sp), #ppn., #status	;identify PPN of this line
		IF	status, lt, #^d10	;output programmer, 
			PNOTE	<  >		;right-justified
		ELSIF	status, lt, #^d100
			PNOTE	< >
		ENDIF
		TYP.10	status			;output programmer
		PNOTE	<, >
		IF	status+2, lt, #^d10	;output project
			PNOTE	<  >
		ELSIF	status+2, lt, #^d100
			PNOTE	< >
		ENDIF
		TYP.10	status+2
	ELSE
		mov	#jname, r0		;pre-clear buffer area
		REPEAT
			clrb	(r0)+				
		UNTIL	r0, his, #<jname+namsiz>
		JSTAT	2(sp), #jname., #jname	;identify name of this line
		mov	#<jname+namsiz>, r0	;make non-return .asciz
		REPEAT
			IFB	-(r0), eq
			ORB	(r0), eq, #space
				movb	#200, (r0)
			ENDIF
		UNTILB	(r0), ne, #200
		ORB	r0, los, #jname
		.PRINT	#jname
	ENDIF
	POP	(sp)			;discard passed argument
ENDPROC

PROCED	warnus, <warn all users about shutdown>
	PUSH	<r1, r2, r3>		;save registers
	mov	waitim, r3		;convert to minutes/seconds
	clr	r2
	div	#^d60, r2
	mov	r2, r1			;send minutes to warning message
	IF	r1, eq, #1		;if single minute,
		movb	#space, @#<shtmid-1>	;make singular
	ELSE
		movb	#'s, @#<shtmid-1>	;make plural
	ENDIF
	mov	#shtim1, r2		;point to minutes
	INVOKE	dec2			;encode into message
	IF	r3, eq			;if no seconds to encode,
		clrb	shtmid		;end string here
	ELSE
		movb	#space, shtmid	;continue message
		mov	#shtim2, r2	;point to seconds
		mov	r3, r1		;encode seconds
		INVOKE	dec2
	ENDIF
	FOR	line, #1, maxlin	;for every line,
		JSTAT	line, #stat., #status
		IF	cc		;if line active
			bit	#<det.!sub.>, status	;only signal primary
			IF	eq
				IF	queue, ne	;if queue active,
					SEND	line, #quemsg	;queue msg
				ELSE			;once queue finished,
					SEND	line, #shtmsg	;shutdown msg
					IFB	shtmid, eq	;no seconds,
						SEND	line, #shtend	;end
					ENDIF
				ENDIF
			ENDIF
		ENDIF
	ENDFOR
	POP	<r3, r2, r1>
ENDPROC

PROCED	sleep, <suspend operations for a while>
;enter with sleep time in ticks on stack

	clr	emtarg+4		;set time in ticks to sleep
	mov	2(sp), emtarg+6		;use ticks passed in by user
	.TWAIT	#emtarg, #emtarg+4	;off to sleep
	POP	(sp)			;discard passed argument
ENDPROC

PROCED	setgo, <output NOW.TSX as "restart TSX" flag>
	.DATE				;get current date
	IF	r0, eq			;if no date,
		NOTE	<How can you run TSX without a date?>
		QUIT			;should never happen!
	ENDIF
	PUSH	r0			;save date
	mov	#nowdat, r2		;point to date-string
	mov	r0, r1			;get date, mmmmdddddyyyyy bit pattern
	ash	#-5, r1			;first isolate day
	bic	#^c37, r1
	INVOKE	dectwo			;decode exactly 2 digits
	mov	(sp), r1		;retrieve date again
	ash	#-^d10, r1		;isolate month
	bic	#^c17, r1
	INVOKE	decmon			;decode month
	POP	r1			;finally, isolate year
	bic	#^c37, r1
	add	#^d72, r1		;years start in 1972
	INVOKE	dectwo
	.GTIM	#emtarg, #emtarg+4	;now get time
	mov	emtarg+4, r4		;get high time
	mov	emtarg+6, r5		;get low time
	mov	#^d60, r3		;seconds/minute
	mul	clkspd, r3		;* ticks/second = ticks/minute
	div	r3, r4			;convert time to hour:min, sec:ticks
	PUSH	r4			;save hour:min
	clr	r4			;compute seconds
	div	clkspd, r4
	mov	r4, r5			;leave seconds in r5
	POP	r4			;and restore hour:min
	mov	r5, r3			;save seconds
	mov	r4, r5			;now get hours, minutes
	clr	r4
	div	#^d60, r4
	mov	#nowtim, r2		;save time string
	mov	r4, r1			;start with hours
	INVOKE	dectwo			;decode exactly 2 digits
	movb	#':, (r2)+		;save separator
	mov	r5, r1			;now minutes
	INVOKE	dectwo
	movb	#':, (r2)+
	mov	r3, r1			;now seconds
	INVOKE	dectwo

	PUSH	<#nownam, #nowdb>	;set up file name conversion
	INVOKE	parse			;parse file name
	.ENTER	#emtarg, #iochan, #nowdb, #1	;open date/time file
	IF	cs
		NOTE	<Cannot open date/time command file>
	ELSE
		.WRITW	#emtarg, #iochan, #nowstr, #nowlen, #0	;write string
		IF	cs
			NOTE	<Error in writing date/time command file>
		ELSE
			.CLOSE	#iochan
		ENDIF
	ENDIF
ENDPROC

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

PROCED	kilidl, <kill idle lines>
	FOR	line, maxlin, #1, #-1
		INVOKE	kidl		;kill if idle with no busy subprocess
	ENDFOR
ENDPROC

PROCED	kidl, <inner routine for kilidl>
	JSTAT	line, #stat., #status	;check line status
	IF	cc			;if line active,
	AND	line, ne, hltlin	;and not this program,
		bic	#^c<det.!sub.>, status	;keep detach, subproc bits
		IF	status, eq, #det.	;set up case flag
			mov	#3, status
		ELSIF	status, eq, #sub.
			mov	#2, status
		ELSE
			mov	#1, status
		ENDIF
		CASE	status, <k.main, k.sub, k.det>	;kill appropriately
	k.main:
			JSTAT	line, #name., #status	;get job name
			IF	status, eq, #^rKMO	;if in KMON
			AND	status+2, eq, #^rN  
				IF	versn, ge, #tsx64	;version 6.4?
					JSTAT	line, #jnum., #jnum	;job #
				ELSE
					JSTAT	line, #ppn., #ppn	;ppn
				ENDIF
				INVOKE	bsysub		;see if busy sub
				IF	cs		;none match
					INVOKE	kill	;kill if idle, OK
.if ne	debug
				ELSE
					PNOTE	<Line >
					TYP.10	line
					NOTE	< has busy sub-process>
.endc				
				ENDIF
			ENDIF
		ENDEL
	k.sub:	
			JSTAT	line, #name., #status	;get job name
			IF	status, eq, #^rKMO	;if in KMON
			AND	status+2, eq, #^rN  
				INVOKE	kill	;kill if idle, OK
			ENDIF
		ENDEL
	k.det:
.if ne	debug
			PNOTE	<Line >
			TYP.10	line
			NOTE	< detached, left alone>
.endc
		ENDEL
		ENDCASE
	ENDIF
ENDPROC

PROCED	kilall, <kill all lines>
	FOR	line, #1, maxlin
		JSTAT	line, #stat., #status	;check line status
		IF	cc			;if line active,
		AND	line, ne, hltlin	;and not this program,
			bit	#det., status	;see if real or detached
			IF	eq		;for real line,
				INVOKE	kill	;kill line
			ELSE
.if ne	debug					;for debugging,
				PNOTE	<Kill detached job on line >
				TYP.10	line
				NOTE
.iff						;for real,
				DETKIL	line	;kill detached
.endc
			ENDIF
		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
.if ne	debug				;for debugging,
			PNOTE	<Kill job on line >
			TYP.10	line
			NOTE
.endc					;for real,
			DETACH	#kilnam	;detach the file
			IF	cs
				NOTE	<Cannot detach "kill" file>
			ELSE
				REPEAT
					DETSTA	r0	;wait for job to end
				UNTIL	cs
				PUSH	deltim		;short delay for kill
				INVOKE	sleep
			ENDIF
		ENDIF
	ENDIF
ENDPROC

PROCED	bsysub, <check if main has busy sub-process>
;return with carry clear if true, carry set if killable process
;on entry, "line" points to current main line
;for version 6.4 and later, "jnum" holds primary job number
;for older versions, "ppn" holds current PPN

	PUSH	r3			;save register
	mov	line, r3		;start line after current line
	inc	r3
	INVOKE	samlin			;check for subsequent busy, same line
	POP	r3			;restore register
ENDPROC

PROCED	samlin, <see if subprocesses match main line>
;on entry, r3 points to current line to test
;on exit, carry set if line "killable" (no matching subprocess), else clear

	IF	r3, gt, maxlin		;if all lines tested,
		sec			;no busy process, "killable"
	ELSE
		JSTAT	r3, #stat., #status	;check current line status
		IF	cs		;if line not active,
			inc	r3	;test next line
			br	samlin	;tail-end recursion
		ELSE
			bit	#sub., status	;see if sub-process
			IF	eq		;if not,
				inc	r3	;test next line
				br	samlin
			ELSIF	versn, ge, #tsx64	;for latest versions,
				JSTAT	r3, #jnum., #status	;get primary
				IF	status, eq, jnum	;if match,
					clc		;exit, subproc exists
				ELSE
					inc	r3	;test next line
					br	samlin
				ENDIF
			ELSE				;otherwise compare ppn
				JSTAT	r3, #ppn., #status	;check ppn
				IF	status, eq, ppn		;if match,
				AND	status+2, eq, ppn+2
					clc		;exit, subproc exists
				ELSE
					inc	r3	;test next line
					br	samlin
				ENDIF
			ENDIF
		ENDIF
	ENDIF
ENDPROC

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

PROCED	maknum, <return number contained in reply string>
;number returned in r0

	PUSH	r1			;register
	mov	#reply, r0		;initialize pointer
	clr	r1			;clear result
	WHILEB	(r0), eq, #space	;skip leading spaces
		inc	r0
	ENDWHILE
	WHILEB	(r0), ge, #'0		;while numeric
	ANDB	(r0), le, #'9
		mul	#^d10, r1	;update number
		PUSHB	(r0)+		;save digit on stack
		bic	#^c177, (sp)	;keep only one char
		add	(sp)+, r1	;accumulate digit
		sub	#'0, r1		;convert from ascii to numeric
	ENDWHILE
	mov	r1, r0			;return in r0
	POP	r1			;restore register
ENDPROC

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	r50asc, <rad-50 ascii output routine>
;enter with fwa of rad50 string, #ascii characters on stack

	PUSH	<r2, r3>		;save registers for counter, pointer
	mov	4+2(sp), r2		;get ascii character count
	mov	4+4(sp), r3		;get rad50 pointer
	WHILE	r2, gt			;while characters remain,
		PUSH	<(r3)+, #3>	;push rad50 word, rad50 count
		INVOKE	r50a		;call recursive output routine
	ENDWHILE
	POP	<r3, r2>		;restore registers
	POP	<(sp), (sp)>		;discard arguments
ENDPROC

PROCED	r50a, <rad50 working recursive procedure>
;r2 holds ascii characters left for output
;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
	.TTYOU	r5
	dec	r2			;count character output
	POP	<r5, r4>		;restore registers
	POP	<(sp), (sp)>		;discard arguments
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	dectwo, <decode exactly two decimal digits>
;number in r1, output string in r2

	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	#'0, (r2)+	;output leading zero
		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	decmon, <decode month into string>
;month in r1, output string in r2

	dec	r1			;make offset-zero
	mul	#3, r1			;three-character month
	add	#montab, r1		;add fwa of month table
	movb	#'-, (r2)+		;output separator
	movb	(r1)+, (r2)+		;output month
	movb	(r1)+, (r2)+
	movb	(r1)+, (r2)+
	movb	#'-, (r2)+		;output separator
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
hltlin:	.word	0			; Line used by this routine
clkspd:	.word	^d60			; Number of ticks/second on clock
slptim:	.word	reptim*^d60		; Sleep time, 30 seconds
deltim:	.word	^d60/2			; Delay time, 1/2 second
busy:	.word	0			; Boolean flag, 1 = some line is busy
queue:	.word	0			; Current queue length
gotsx:	.word	0			; Non-zero if auto-restart desired
waitim:	.word	mintim*^d60		; Seconds to wait until shutdown
status:	.blkw	2			; Line status information
ppn:	.blkw	2			; Holds current ppn
jname:	.blkb	namsiz			; Holds current job name
jnum:	.word	0			; Primary job number
	.word	0			; Parent's job number
tsxarg:	.blkw	4			; Argument area for TSX emts
emtarg:	.blkw	10			; Argument area for i/o emts
killdb:	.rad50	/DK HALT  KIL/		; File name for "kill" command
shtdb:	.rad50	/DK HALT  SHT/		; File name for "shutdown" command
nowdb:	.rad50	/SY NOW   TSX/		; File name for date/time
kilnam:	.asciz	"DK:HALT.KIL"		; Ascii file name of "kill" file
shtnam:	.asciz	"DK:HALT.SHT"		; Ascii file name of "shutdown" file
nownam:					; Ascii file name of date/time file
.if eq	debug
	.asciz	"SY:NOW.TSX"		; Real name
.iff			
	.asciz	"DK:NOW.TMP"		; Debugging name
.endc
reply:	.blkb	^d81			; Space for replies
montab:	.ascii	"Jan"			; Month table
	.ascii	"Feb"
	.ascii	"Mar"
	.ascii	"Apr"
	.ascii	"May"
	.ascii	"Jun"
	.ascii	"Jul"
	.ascii	"Aug"
	.ascii	"Sep"
	.ascii	"Oct"
	.ascii	"Nov"
	.ascii	"Dec"
	.even

nowstr:	.ascii	"date "			; Contents of date/time file
nowdat:	.ascii	"01-Jan-72"<cr><lf>
	.ascii	"time "
nowtim:	.asciz	"12:00:00"<cr><lf>
	.even
	nowlen	=	<. - nowstr> / 2


.if eq	debug				; Non-debugging commands to detach
kilstr:	.ascii	"kill "			; Contents of "kill" file
killin:	.asciz	"nn"<cr><lf>		; nn -- line number
	.ascii	"delete dk:halt.kil"<cr><lf>	
	.even
	killen	=	<. - kilstr> / 2

shtstr:	.asciz	"$shutdown"<cr><lf>	; Contents of "shutdown" file
	.ascii	"delete dk:halt.sht"<cr><lf>	
	.even
	shtlen	=	<. - shtstr> / 2

quemsg:	.ascii	<cr><lf><bell>"HALT - I - TSX will shut down soon, "
	.asciz	"after spooler empties"<bell><cr><lf><cr><lf>

shtmsg:	.ascii	<cr><lf><bell>"HALT - I - TSX will shut down in "
shtim1:	.ascii	"xx minutes"
shtmid:	.ascii	" and "
shtim2:	.ascii	"yy seconds"
shtend:	.asciz	<bell><cr><lf><cr><lf>
		.even

.iff					; Debugging commands
kilstr:	.ascii	"!kill "		; Contents of "kill" file
killin:	.asciz	"nn"<cr><lf>		; nn -- line number
	.ascii	"!delete dk:halt.kil"<cr><lf>	
	.even
	killen	=	<. - kilstr> / 2

shtstr:	.asciz	"!$shutdown"<cr><lf>	; Contents of "shutdown" file
	.ascii	"!delete dk:halt.sht"<cr><lf>	
	.even
	shtlen	=	<. - shtstr> / 2

quemsg:	.ascii	<cr><lf><bell>"HALT - I - TSX will not shut down soon, "
	.asciz	"after spooler empties"<bell><cr><lf><cr><lf>

shtmsg:	.ascii	<cr><lf><bell>"HALT - I - Test - TSX will not shut down in "
shtim1:	.ascii	"xx minutes"
shtmid:	.ascii	" and "
shtim2:	.ascii	"yy seconds"
shtend:	.asciz	<bell><cr><lf><cr><lf>
		.even
.endc

	ENDEND

	.end	halt