.TITLE	UIC
	.IDENT	/MRH001/
;	.PSECT	. ABS.,OVL,RW,LCL,D	;MAX LEN = 000000
;.GLOBL	IO.WVB
;.GLOBL	IS.SUC
;.GLOBL	UC.TTY
;.GLOBL	UF.OFL
;.GLOBL	UT.LG 
;.GLOBL	UT.PR 
;.GLOBL	UT.SL 
;.GLOBL	U.C1  
;.GLOBL	U.DN  
;.GLOBL	U.FB  
;.GLOBL	U.GC  
;.GLOBL	U.PC  
;.GLOBL	U.PR  
;.GLOBL	U.SZ  
;.GLOBL	U.UN  
;.GLOBL	$CBOMG
;.GLOBL	.PUDBA
;.GLOBL	.PUDEA
;	.PSECT	      ,CON,RW,GBL,I	;MAX LEN = 000610
	.MCALL	DIR$,GMCR$,EXIT$,QIOW$
	.MCALL	CLOSE$,OPEN$R,OPEN$A,NBOF$L,GLUN$S
	.MCALL	FDBDF$,FSRSZ$,FDAT$A,FDRC$A,FDOP$A,NMBLK$,GET$R,PUT$
; 
UT.HO=10	;DEFINE HOSTILE BIT FOR PRIVILEGE BYTE
;
START:	DIR$	#GETMCR		;GET MCR COMMAND LINE TO FREE NODE
	MOV	#"TT,R4
	SUB	#14,SP		;MAKE ROOM ON STACK
	MOV	SP,R2		;AND MOVE PTR TO R2
	GLUN$S	#5,R2		;AND GET LUN #5
	MOV	(SP)+,R5	;"TT"
	MOV	(SP)+,R5	; ##
	ADD	#10,SP		;CLEAN STACK
	BIC	#177600,R5	;NOW A NICE TERMINAL NUMBER
	JSR	PC,..FDEV
	MOV	R5,R3		;STORE TT PUD IN R3
	CLRB	(R0)		;SET ZERO SENTINEL BYTE
	MOV	#FDB,R0		;FDB ADDRESS
	MOV	#USENAM,R1	;DATA SET DESC ADDR -> R1
	MOV	#UICDSD,R2	;UIC STRING DESCRIPTOR -> R2
	JSR	PC,.GTDIR	;FILL IN UIC STRING
	OPEN$R	#FDB
	CLR	R2		;FOR LATER
	CMP	#"TT,U.DN(R3)	;IS THIS A TTY ?
	BEQ	13$		;BRANCH IF YES
	CMP	#"BA,U.DN(R3)	;OR A BATCH PSEUDO DEVICE ?
	BEQ	13$
	JMP	NOTTTY		;NO, IGNORE THIS DEVICE
13$:	MOV	#PTR1,R0	;POINT R0 TO START OF MESSAGE LINE
	MOVB	#40,PTR1+3	;CLEAR POSSIBLE DOUBLE DIGIT FROM LAST TIME
	MOVB	#40,PTR1+4	;AND/OR POSSIBLE WHERE USERS IS FLAG
	MOV	U.DN(R3),(R0)+	;ASCII DEVICE NAME TO MESSAGE LINE
	MOVB	U.UN(R3),R1	;OCTAL INIT # IN R1
	CLR	R2		;CLEAR LEADING 0'S
	JSR	PC,$CBOMG	;CONVERT UNIT # TO ASCII
	MOV	#13.,R5		;COUNT TO R5
	MOV	#PTR1A,R0	;POINT TO USER BUFFER
111$:	MOVB	#40,(R0)+	;FILL USER NAME AND DEVICE WITH SPACES
	SOB	R5,111$		;FOR 13 CHARACTERS
	CMP	(R3),#"BA	;FOR BATCH, CAN'T FIND NAME AND DEVICE
	BEQ	333$		;SO SKIP IT
	MOV	#HELBYE,R0	;POINT TO COMMON AREA
	MOVB	U.UN(R3),R5	;UNIT NUMBER IN R5 AGAIN
	MUL	#20.,R5		;MAKE HIM OFFSET INTO DATA AREA
	ADD	R5,R0		;NOW HAVE BUFFER FOR THIS TI
	MOV	HB.USE(R0),R5	;GET RECORD NUMBER IN USER PROFILE FILE
	BEQ	222$		;IF NONE, DON'T FILL IN NAME
	BIT	#UT.LG,U.PR(R3)	;IF NOT LOGGED ON
	BEQ	222$		;DON'T REPORT EITHER
				;READ USER PROFILE FILE
	GET$R	#FDB,#USEBUF,#100,R5
	MOV	USEBUF,R1	;FIRST PART OF USER NAME TO R1
	MOV	#PTR1A,R0	;POINT TO ASCII BUFFER
	JSR	PC,$C5TA	;CONVERT USER NAME
	MOV	USEBUF+2,R1	;2ND 3 LETTERS
	JSR	PC,$C5TA
	MOV	USEBUF+4,R1	;LAST 3
	JSR	PC,$C5TA
	MOVB	#40,(R0)+	;SPACE TO BE NEAT
333$:	MOV	#PTRDEV,R0	;POINT TO DEVICE AREA IN LINE
	MOV	U.LBH(R3),R1	;GET DEFAULT DEVICE PUD
	MOVB	U.DN(R1),(R0)+	;FILL IN DEF DEVICE
	MOVB	U.DN+1(R1),(R0)+
	MOVB	U.UN(R1),(R0)
	BISB	#60,(R0)+
222$:	MOV	#PTRCLI,R0	;POINT TO CLI AREA IN LINE
	MOV	U.DACP(R3),R1	;GET RAD-50 CLI NAME
	BEQ	224$		;BR IF NONE (IE BATCH TERM)
	CALL	$C5TA		;CONVERT NAME
	BR	225$		;AND SKIP NEXT
224$:	MOVB	#40,(R0)+	;ERASE PREVIOUS CLI NAME
	MOVB	#40,(R0)+
	MOVB	#40,(R0)+
225$:	CLR	R2		;SUPRESS LEADING 0'S AGAIN
	MOV	#PTR2,R0	;POINT PAST USER NAME
	BITB	#UF.OFL,U.FB(R3) ;IS HE OFF LINE ?
	BNE	OFFLIN		;YES REPORT HE'S OFF-LINE
	BITB	#UT.SL,U.PR(R3) ;OR IS HE SLAVED ?
	BNE	SLAVED		;REPORT THAT INSTEAD
	BITB	#UT.LG,U.PR(R3) ;THEN IS HE LOGGED ON ?
	BEQ	NOTLOG		;IF NOT REPORT IT
	MOVB	#'[,(R0)+	;INITIAL '[' TO BUFFER
	CLR	R1		;SET TO FIGURE GROUP,PROG. CODE
	BISB	U.GC(R3),R1	;GROUP CODE TO R1
	JSR	PC,$CBOMG	;PUT IN OUT BUFFER AS ASCII
	MOVB	#',,(R0)+	;SEPERATING COMMA
	CLR	R1		;NOW FOR PROGRAMMER CODE
	BISB	U.PC(R3),R1
	JSR	PC,$CBOMG	;SAME AS BEFORE
	MOVB	#'],(R0)+	;FINISH UP WITH ']'
5$:	CMP	R0,#PTR2+9.	;TEST ALIGNMENT
	BGE	10$		;ITS OK
	MOVB	#40,(R0)+	;NO FILL WITH SPACES
	BR	5$		;AND TRY AGAIN
10$:	BITB	#UT.PR!UT.HO,U.PR(R3)	;IS HE PRIVILEGED OR HOSTILE ?
	BNE	2$		;BR IF HE IS
	MOV	#13.,R2		;COUNT TO R2
105$:	MOVB	#40,(R0)+	;FILL WITH SPACES
	SOB	R2,105$
	BR	NOTPR		;AND REPORT HIM
2$:	MOVB	#40,(R0)+	;SET TO REPORT HIM AS PRIVILEGED
	MOV	#PRIMES,R4	;ADDRESS OF MESSAGE TO R4
	MOV	#PRILEN,R5	;LENGTH TO R5
	BITB	#UT.HO,U.PR(R3)	;IS HE HOSTILE ?
	BEQ	11$		;SKIP IF NOT
	MOV	#HOSMES,R4	;ELSE CHANGE REPORT MESSAGE
	MOV	#HOSLEN,R5
11$:
1$:	MOVB	(R4)+,(R0)+	;XFER A CHARACTER
	SOB	R5,1$		;LOOP TILL DONE
NOTPR:	JSR	PC,TSTATL	;LOOK FOR TASKS ACTIVE FOR HIM
	JSR	PC,WRTLIN	;WRITE LINE
NOTTTY:
SCRAM:	CLOSE$	#FDB		;CLOSE USER PROF FILE
	DIR$	#EXITDP		;AND EXIT
NOTLOG:	MOV	#NLGMES,R4	;MESSAGE START TO R4
	MOV	#NLGLEN,R5	;LENGTH TO R5
	JSR	PC,FILWRT	;FILL IN AND WRITE MESSAGE
	BR	NOTTTY		;AND TRY NEXT DEVICE
OFFLIN:	MOV	#OFFMES,R4	;MESS START TO R4
	MOV	#OFFLEN,R5	;LENGTH TO R5
	JSR	PC,FILWRT	;FILL IN AND WRITE LINE
	BR	NOTTTY		;AND TRY NEXT PUD
SLAVED:	MOV	#SLAMES,R4	;MESSAGE START TO R4
	MOV	#SLALEN,R5	;LENGTH TO R5
	JSR	PC,FILWRT	;INSERT AND WRITE LINE
	BR	NOTTTY		;AND TRY NEXT PUD
;
;SUB TO INSERT MESSAGE INTO LINE AND DO QIO
;
FILWRT:	MOVB	(R4)+,(R0)+	;XFER A CHARACTER
	SOB	R5,FILWRT	;LOOP TILL DONE
	JSR	PC,WRTLIN	;DO SUB TO WRITE LINE
	RTS	PC		;AND RETURN
;
;SUB TO DO ACTUAL QIO
;
WRTLIN:	SUB	#PTR1,R0	;SUB START OF MESS FROM END
	MOV	R0,QIODPB+Q.IOPL+2	;FILL IN LENGTH IN PAR. LIST
	DIR$	#QIODPB		;DO QIO THING
	BCS	SCRAM		;SCRAM IF DIRECTIVE FAILED
	CMPB	#IS.SUC,IOST	;SUCCESS CODE ?
	BNE	SCRAM		;EXIT TO IF QIO FAILED
	RTS	PC		;ELSE DO RETURN
;
;SUB TO SCAN ATL
;
TSTATL:	MOV	#.ATLLH,R5	;USE R5 FOR SCAN
TSTLOP:	MOV	(R5),R5		;GET NEXT/FIRST ATL ENTRY
	CMP	R5,#.ATLLH	;THROUGH ATL ?
	BNE	1$		;BR IF NOT
	RTS	PC		;RETURN IF DONE
1$:	CMP	A.TI(R5),R3	;SAME TI'S ?
	BNE	TSTLOP		;NO, TRY AGAIN
	MOV	A.TD(R5),R2	;YES, GET STD POINTER
	CMP	S.TN+2(R2),RAD... ;IS IT A HANDLER TASK ?
	BEQ	TSTLOP		;YES IGNORE THEM
	CMP	S.TN+2(R2),RADACP ;IS IT AN "ACP" TASK ?
	BEQ	TSTLOP		;YES IGNORE THEM
	CMP	S.TN(R2),RAD...	;INSTALLED TASK ?
	BNE	2$		;NO, CONTINUE
	CMP	S.TN+2(R2),RADMAS ;IS IT "...MAS" ?
	BEQ	TSTLOP		;YES IGNORE IT
	CMP	S.TN+2(R2),RADUIC ;IS IT "...UIC" (MYSELF) ?
	BEQ	TSTLOP		;YES IGNORE IT
2$:	MOV	S.TN(R2),R1	;FIRST HALF OF NAME TO R1
	JSR	PC,$C5TA	;CONVERT TO ASCII IN BUFFER
	MOV	A.TD(R5),R2	;RESTORE WIPED POINTER
	MOV	S.TN+2(R2),R1	;GET 2ND HALF OF NAME
	JSR	PC,$C5TA	;AND INSERT IT
	MOVB	#40,(R0)+	;FILL IN SO IT LOOKS NICE
	BR	TSTLOP		;AND TRY TRY AGAIN
;
	NBOF$L			;DEFINE NAME BLOCK OFFSETS
USEBUF:	.BLKW	40		;BUFFER TO READ UPF INFO
USENAM:	NMBLK$	PDSUPF,DAT,,SD	;DEFINE FILE NAME FOR USER PROFILE FILE
	FSRSZ$	1
FDB:	FDBDF$			;DEFINE FDB FOR USER PROFILE FILE
	FDAT$A	R.FIX,,64.
	FDRC$A	FD.RAN,USEBUF,64.
	FDOP$A	4,,USENAM,FO.RD!FA.SHR
UICSTR:	.ASCII	/[1,100]/
	UICLEN=.-UICSTR
	.EVEN
UICDSD:	.WORD	UICLEN
	.WORD	UICSTR
;
EXITDP:	EXIT$			;EXIT DPB
GETMCR:	GMCR$			;GET MCR DPB
QIODPB:	QIOW$	IO.WVB,5,5,,IOST,,<PTR1,0,40>
PTR1:	.BLKB	4		;MESS START, BUFFER FOR 'TTXX'
	.ASCII	/ /
PTR1A:	.ASCII	/          /
PTRDEV:	.ASCII	/    /		;ROOM FOR DEF DEVICE
PTRCLI:	.ASCII	/    /		;ROOM FOR CLI
PTR2:	.BLKB	74.		;ROOM FOR REST OF LINE
	.EVEN
IOST:	.BLKW	2		;IO STATUS BUFFER
;
;NOW THE ASCII MESSAGES
;
NLGMES:	.ASCII	/          LOGGED OFF/
	NLGLEN=.-NLGMES
OFFMES:	.ASCII	/          OFFLINE/
	OFFLEN=.-OFFMES
PRIMES:	.ASCII	/PRIVILEGED  /
	PRILEN=.-PRIMES
HOSMES:	.ASCII	/HOSTILE     /
HOSLEN=.-HOSMES
SLAMES:	.ASCII	/          SLAVED/
	SLALEN=.-SLAMES
	.EVEN
RAD...:	.RAD50	/.../		;COMPARE STRING FOR HANDLER TASKS
RADACP:	.RAD50	/ACP/		;COMPARE STRING FOR ACP TASKS
RADMAS:	.RAD50	/MAS/		;COMPARE STRING FOR "...MAS"
RADUIC:	.RAD50	/UIC/		;COMPARE STRING FOR "...UIC" (MYSELF)
MRLRAD:	.RAD50	/MRL/		;RAD 50 STRING FOR MRL
MRLSAV:	.WORD	0		;BUFFER TO SAVE MRL LISTHEAD POINTER
	.END	START