	.TITLE	SUPERWHO
	.ENABL	LC
	.SBTTL	PROLOGUE
	.ident	-030100-
;+
; Abstract:	Superwho
;
; 	This program displays the currently logged-in users
;	and the tasks which they are running.  It updates the
;	screen every few seconds, so that a running commentary
;	on the system activity may be obtained.
;
; Operating procedures:
;
;	MCR>SWH
;
;	or
;
;	PDS> SWH
;
; Limitations:
;
;	This task will currently only run on RSX-11D and IAS
;	V3.0 and later.  It will not run under RSX-11M, but
;	it would probably not be extremely difficult to do so.
;
; Written: ?-?-?, -1.0.0-, Edward Walter
;	Original version at Dr. Hammond's lab at the Duke
;	University Medical Center using only Beehive terminals.
;
; Modified: 10-Aug-1976, -2.0.0-, David Parker
;	Extensive rewrites, made to work on multiple terminals
;
; Modified: 29-Apr-1981, -3.0.0-, Bruce C. Wright
;	Rewrite to use screen output package, modifications for
;	IAS V3.0 and IAS V3.1 from the old RSX-11D version.
; Modified: 07-May-1981, -3.1.0-, Bruce C. Wright
;	Bugs in output changes for -3.0.0-
;-
	.MCALL	QIOW$,CLEF$S,DIR$,MRKT$S,WTSE$S
	.MCALL	GTIM$,GMCR$,EXIT$S
	.MCALL	RDEF$S,QIO$
	.MCALL	SAVE,UNSAVE
;
DSW=0
NUL=0
BS=10
LF=12
FF=14
CR=15
SUB=32
ESC=33
RS=36
SPACE=40
COMMA=54
;
; OFFSETS INTO TASK DESCRIPTOR BLOCK
;
TDBTN1	=	0			;RAD50 TASKNAME 1'ST PART
TDBTN2	=	2			;2'ND PART
TDBPUD	=	4			;TI PUD ADDRESS
TDBPOL	=	6			;TASK POOL USAGE
TDBLEN	=	10			;LENGTH OF A TDB ENTRY IN BYTES
;
LINLEN	=	170.			;TERMINAL BLOCKING BUFFER LENGTH
MAXDIS	=	84.			;MAX LINE LENGTH, 80 CHARS +
					;CR,BS,CR,LF

	.SBTTL	DATA AREA
;
;
COUNT:	.WORD	0
LCOUNT: .WORD	0
PUDADR: .WORD	0
;
; Buffer for the PUD entries.  This buffer is dimensioned by the
; number of lines on the page;  it is used to keep track of which
; terminal is displayed on which line and which UIC the terminal
; is logged into.  If the terminal characteristics change, the
; terminal line is updated;  otherwise, it is left alone.
;
pudtbl:	.blkw	64.		; Just in case there are 64. users.
uictbl:	.blkw	64.		; Just in case there are 64. users.
;
;TERMINAL BLOCKING BUFFER
;
LINBUF:	.WORD	84.
	.BLKB	LINLEN

	.SBTTL	BUFFERS AND SUCH
;
;
ALLPER:	.RAD50	"..."
AC1:	.RAD50	"ACP"
AC2:	.RAD50	"F11"
RDIOST:	.BLKW	2
TRMCHR:	.BYTE	0
	.EVEN
TEMP:	.BLKB	80.
;
ERMSG:	.ASCII	<CR><LF>
	.ASCII	"Unsupported terminal type"
	.ASCII	<CR>
ermsgl	=	.-ermsg
	.even
badtyp:	qiow$	io.wvb,1,1,,,,<ermsg,ermsgl,0,0,0,0>
PRGID:	.WORD	PRGIDE-PRGID-2
	.ascii	"Superwho "
prgide:
	.even
prgid2:	.word	prgd2e-prgid2-2
	.ascii	"Date: "
	.ASCII	"         "
	.ASCII	"Time: "<LF>
prgd2e:	.EVEN
COMSAV:	.BLKB	400
COMEND:	.WORD	0
SLV:	.ASCIZ	"SLV"
PRIV:	.ASCIZ	"PRV"
GEN:	.ASCIZ	"GEN"

	.SBTTL	SET UP TOP LINE OF DISPLAY
;
;
START:	DIR$	#GETMCR		;GET A COMMAND LINE
	mov	#1,r0		; Set the terminal LUN.
	call	$sctyp		; Return the terminal type.
	tst	r2		; Is the terminal supported?
	bne	20$		; J if so.
10$:	dir$	#badtyp		; Report illegal terminal type.
	EXIT$S
20$:	mov	#1,r1		; Indicate that buffering is to be done.
	call	$scbuf		; Set screen package buffer parameter.
	call	$scclr		; Clear screen.
	mov	#prgid,r1	; Get program ID
	mov	(r1)+,r2	; Get string length.
	call	$scout		; Print program ID
	call	$mtype		; Get the machine type.
	mov	r0,r1		; Point to output buffer.
	clr	r2		; Show 0 terminated.
	mov	#1,r0		; Get LUN
	call	$scout		; Print node name.
	mov	#16.,r1		; Get to the X position needed.
	clr	r2		; Get Y position.
	call	$scadr		; Get past the node name.
	mov	#prgid2,r1	; Get program ID
	mov	(r1)+,r2	; Get length.
	call	$scout		; Output buffer.

	.SBTTL	COLLECT TASK DATA
LOOP:	MOV	#.ATLLH,R0
	MOV	#COMSAV,R1
	CLR	COUNT
	MOV	PS.EXP,-(SP)
	BIS	#140,PS.EXP
	CALL	SCNLIS
	MOV	#-1,(R1)+
	CLR	@R1
	CALL	..ENB0

	.SBTTL	GET THE ID OF A LOGGED ON TERMINAL
;
;
	MOV	.PUDBA,R3
TTYPLO:	BIT	#UC.TTY,U.C1(R3) ;DO WE HAVE A TERMINAL
	BNE	LINOUT
SKIP:	ADD	#U.SZ,R3	;NO--SKIP
	CMP	.PUDEA,R3
	BNE	TTYPLO
	JMP	CLEAN		;START OVER IF AT END OF PUD
LINOUT:	BITB	#UT.LG,U.PR(R3)	;IS IT LOGGED ON
	BEQ	SKIP		;NO--SKIP IT
	mov	count,r0	; Get the line number we're on.
	asl	r0		; Multiply by 2.
	cmp	r3,pudtbl(r0)	; Is it the same one as we're on now?
	bne	5$		; J if not, must fix it up again.
	cmp	u.ui(r3),uictbl(r0) ; Is the UIC the same?
	bne	5$		; J if not, need to update.
	jmp	tskdat		; Otherwise, just update tasks.
5$:	CLR	R5
	mov	u.ui(r3),uictbl(r0) ; Set up the tables for next time.
	mov	r3,pudtbl(r0)	; ...
	mov	#linbuf,r4	; Point to the line buffer.
	movb	u.dn(r3),(r4)+	; Output device name.
	movb	u.dn+1(r3),(r4)+ ; ...
	MOVB	U.UN(R3),R1	;ASSEMBLE LINE
	mov	r4,r0		; Point to buffer from r0
	CLR	R2
	CALL	$CBOMG
	movb	#':,(r0)+	; Output a :

	.SBTTL	FIND THE UIC
;
;
	movb	#' ,(r0)+	; Output a space.
	MOVB	#'[,(R0)+
	MOVB	U.UI+1(R3),R1
	BIC	#177400,R1	;CLEAR HIGH ORDER BYTE
	CLR	R2
	CALL	$CBOMG
	MOVB	#COMMA,(R0)+
	MOVB	U.UI(R3),R1
	BIC	#177400,R1	;CLEAR HIGH ORDER BYTE
	CALL	$CBOMG
	MOVB	#'],(R0)+
10$:	cmp	r0,#linbuf+16.	; Have we gotten everything yet?
	bhis	15$		; J if so.
	movb	#' ,(r0)+	; Output another blank.	
	br	10$		; And try again.

	.SBTTL	FIND TYPE OF LOGIN
;
;
15$:	BITB	#UT.SL,U.PR(R3)
	BEQ	20$
	mov	#slv,r4		; Get SLV message
	BR	50$		; And add it to the buffer.
20$:	;bitb	#ut.lg,u.pr(r3)	; ???
	;bne	30$		; ???
30$:	BITB	#UT.PR,U.PR(R3)	; User privileged?
	BEQ	35$		; J if not.
	MOV	#PRIV,r4	; Point to privileged message.
	BR	50$		; And add to buffer.
35$:	MOV	#GEN,r4		; Get GEN message.
50$:	movb	(r4)+,(r0)+	; Output the message.
	bne	50$		; ...
	dec	r0		; Backup over the NUL.
	movb	#' ,(r0)+	; Output ' '
;
	mov	r0,r4		; Remember buffer address.
	mov	#1,r0		; Get LUN
	clr	r1		; Get X coordinate.
	mov	count,r2	; Get Y coordinate.
	add	#2,r2		; Offset it properly.
	call	$scadr		; Address the screen.
	mov	r4,r2		; Point to buffer address.
	mov	#linbuf,r1	; Point to buffer.
	sub	r1,r2		; Compute length of buffer.
	call	$scout		; Output the buffer.

	.SBTTL	LOOK UP TASK DATA FOR THIS TERMINAL
;
TSKDAT:
;
	MOV	R3,PUDADR	;SAVE THE CURRENT PUD ADDR
	mov	#1,r0		; Get the LUN.
	mov	#19.,r1		; Get the X coordinate.
	mov	count,r2	; get the Y coordinate.
	add	#2,r2		; +2 to offset it from the header.
	call	$sceol		; Clear to end of line.
	mov	#linbuf,r0	; Point to the output buffer.
	MOV	#COMSAV,R3	;ADDRESS OF TASK DATA BUFFER
	MOVB	#'A,TRMCHR	;ASSUME ATL FIRST
;
10$:	TST	(R3)		;END OF TDB LIST
	BEQ	30$		;SKIP IF IT IS
;
	CMP	#-1,(R3)	;END OF ATL DATA
	BNE	15$		;SKIP IF NOT
;
	TST	(R3)+		;POINT TO NEXT TDB
	MOVB	#'M,TRMCHR	;WE ARE NOW IN THE MRL
	BR	10$		;START OVER AGAIN
;
15$:	CMP	TDBPUD(R3),PUDADR ;IS THIS OUR TERMINAL
	BNE	20$		;SKIP IF NOT
	MOVB	#SPACE,(R0)+	;PAD WITH A SPACE
;
	MOV	TDBTN1(R3),R1	;FIRST PART OF TASKNAME
	CALL	$C5TA		;CONVERT TO ASCII
	MOV	TDBTN2(R3),R1	;SECOND HALF OF NAME
	CALL	$C5TA		;CONVERT IT
;
	MOVB	#SPACE,(R0)+	;ANOTHER SPACE
;
	MOV	TDBPOL(R3),R1	;TASK POOL USAGE
	CLR	R2
	CALL	$CBDMG		;DISPLAY AS OCTAL NUMBER
;
	MOVB	TRMCHR,(R0)+	;ATL OR MRL INDICATOR
;
20$:	ADD	#TDBLEN,R3	;NEXT TDB ENTRY
	BR	10$
;
;
30$:	mov	r0,r2		; Get pointer to end of buffer.
	mov	#linbuf,r1	; Get first part of line.
	sub	r1,r2		; Compute length of line.
	cmp	r2,#maxdis	; Over maximum?
	blo	40$		; J if not.
	mov	#maxdis,r2	; Set to the maximum.
40$:	mov	#1,r0		; Set LUN for output.
	call	$scout		; And force the output out.
	INC	COUNT		;COUNT NO. LINES DISPLAYED
	MOV	PUDADR,R3	;RESTORE PUD ADDR
	JMP	SKIP		;SKIP TO NEXT LINE

	.SBTTL	CLEAN UP SCREEN AND UPDATE TIME
;
;
CLEAN:	CMP	COUNT,LCOUNT	;NEED TO BLANK LINES?
	BGE	10$		;NO, BRANCH
	mov	count,r0	; Get the number of tasks.
	mov	r0,r1		; Get into r1
	asl	r0		; Multiply by 2. for word offset.
5$:	clr	pudtbl(r0)	; Clear out extra table entries
	clr	uictbl(r0)	; ...
	add	#2,r0		; Get to next entry
	inc	r1		; Get to next entry ...
	cmp	r1,lcount	; To end of list yet?
	ble	5$		; J if not.
	mov	#1,r0		; Get the LUN.
	clr	r1		; Clear X coordinate.
	mov	count,r2	; Get Y coordinate.
	add	#2,r2		; +2 to offset from the header.
	call	$sceos		; Clear to end of screen.
	mov	lcount,count	; Set the new count.
10$:	MOV	COUNT,LCOUNT	;UPDATE THE LAST COUNTER
;
;
DATDIS:	DIR$	#GETTIM		;GET THE DATE
	mov	#1,r0		; Get the LUN
	mov	#22.,r1		; Get X coordinate.
	clr	r2		; get Y coordinate.
	call	$scadr		; Address the screen.
	mov	#linbuf,r4	; Point to output buffer.
	MOV	TEMP+g.timo,R1	;GET READY TO CONVERT DATE
	MOVB	#'/,TRMCHR	;SET UP SEPARATOR CHAR
	CALL	DATSUB		;DO THE CONVERT
	MOVB	TEMP+g.tida,R1	;PART 2 OF CONVERSION
	CALL	DATSUB		;CONVERT IT
	MOVB	#SPACE,TRMCHR	;CHANGE TERMINATOR TO SPACE
	MOV	TEMP+g.tiyr,R1	;LAST PART
	CALL	DATSUB		;DO IT
;
;
; POSITION THE CURSOR TO THE PROPER PLACE TO DISPLAY THE TIME
;
timdis:	mov	r4,r2		; Get buffer into r2
	mov	#linbuf,r1	; Get beginning of buffer
	sub	r1,r2		; Compute length.
	mov	#1,r0		; Get LUN
	call	$scout		; Output buffer.
	mov	#37.,r1		; Get X coordinate.
	clr	r2		; Get Y coordinate.
	call	$scadr		; Address the screen.
	mov	#linbuf,r4	; Point to buffer again.
;
	MOVB	#':,TRMCHR
	MOV	TEMP+g.tihr,R1
	CALL	DATSUB
	MOV	TEMP+g.timi,R1
	CALL	DATSUB
	MOV	TEMP+g.tisc,R1
	MOVB	#SPACE,TRMCHR
	CALL	DATSUB
;
	MOVB	#CR,(R4)+	;LEAVE A BLANK LINE
	MOVB	#LF,(R4)+
	mov	r4,r2		; Get end of buffer again.
	mov	#linbuf,r1	; Get buffer address again.
	sub	r1,r2		; Compute buffer length.
	mov	#1,r0		; Get LUN
	call	$scout		; Output the data.

	.SBTTL	WAIT AND FIELD ^Z
;
;
WAIT:	mov	#1,r0		; Get the LUN
	call	$scflu		; Flush the buffer if necessary.
	DIR$	#QIORED
	MRKT$S	#5,#2,#2
	WTSE$S	#5
	CLEF$S	#5
	RDEF$S	#2
	TST	@#$dsw		; Mark time done?
	BNE	40$		; J if not
	DIR$	#QIOKIL		; Kill the I/O
41$:	JMP	LOOP		; And report another time.
40$:	CLEF$S	#2
	CMP	RDIOST,#IE.EOF
	BNE	41$
	mov	#1,r0		; Get the LUN
	call	$scclr		; Clear the screen.
	call	$scflu		; Flush the buffer if necessary.
	EXIT$S			; And exit the system.

	.SBTTL	SCAN ATL OR MRL AND COLLECT TASK INFO
;
SCNLIS:
;
	MOV	R0,R2			;ADDRESS OF LISTHED TO R2
;
10$:	MOV	(R2),R2			;NEXT LIST ENTRY
	CMP	R0,R2			;END OF LIST YET
	BEQ	15$			;SKIP IF IT IS
;
	CMP	R1,#COMEND-2		;END OF DATA AREA?
	BLO	20$			;SKIP IF NOT
;
15$:	CLR	(R1)			;MARK END OF LIST
	RETURN
;
; PLACE SELECTED DATA IN BUFFER
;
20$:	MOV	A.TD(R2),R3		;ADDRESS OF STD ENTRY FOR TASK
	BGE	10$			;DONT LOG IF NULL TASK
;
	CMP	S.TN+2(R3),ALLPER	;SKIP DEVICE DRIVERS ALSO
	BEQ	10$
	CMP	S.TN+2(R3),AC1		;IS THIS AN ACP
	BNE	30$
	CMP	S.TN(R3),AC2		;SKIP IF F11
	BEQ	10$
30$:
;
40$:	MOV	S.TN(R3),(R1)+		;FIRST RAD50 HALF OF TASKNAME
	MOV	S.TN+2(R3),(R1)+	;SECOND HALF
	MOV	A.TI(R2),(R1)+		;TI PUD ADDRESS
	MOV	S.PU(R3),(R1)+		;TASK POOL USAGE
	BR	10$			;DO ANOTHER TASK

	.SBTTL	DATSUB ROUTINE
DATSUB:	MOV	#TEMP+40.,R0
	MOV	R0,R2
	CALL	$CBDMG
	SUB	#2,R0
	MOVB	(R0)+,(R4)+
	MOVB	(R0)+,(R4)+
	MOVB	TRMCHR,(R4)+
	RETURN

	.SBTTL	DIRECTIVES
;
QIORED:	QIO$	IO.RLB,1,2,0,RDIOST,,<TEMP,1,0>
QIOKIL:	QIOW$	IO.KIL,1,3,,RDIOST
GETTIM:	GTIM$	TEMP
GETMCR:	GMCR$
IOST:	.BLKW	2
;
	.END	START
