.TITLE	UIC - CHANGE USER'S UIC
	.IDENT	/Y02.01/
;**-
;	Module name: UIC - CHANGE USER'S UIC
;
;	Version Y02.01	Last edit: 20-MAY-80 13:25
;	Status: Released for test
;
;	Revision history:
;
;		Version X01.00 31-MAR-80 09:44 - 31-MAR-80 13:15
;		Created by: K.J. CROSS
;
;		Version Y01.00 31-MAR-80 13:21 - 31-MAR-80 14:19
;		Modified by: K.J. CROSS
;		RELEASED FOR DISTRIBUTION
;
;		Version X02.00 20-MAY-80 09:47 - 20-MAY-80 10:09
;		Modified by: K.J. CROSS
;		ADDED SY: ASSIGNMENT WHEN ACCOUNT FILE USED
;
;		Version Y02.00 20-MAY-80 10:09 - 20-MAY-80 13:25
;		Modified by: K.J. CROSS
;
;		Version Y02.01 20-MAY-80 13:25 - 20-MAY-80 13:25
;		Modified by: K.J. CROSS
;		SUPPRESS MCR PROMPT AFTER "ASN DD:=SY:"
;
;**-
;
; THIS PROGRAM PERFORMS THE SAME FUNCTION AS THE "SET /UIC" MCR COMMAND.
; IT SETS YOUR UIC TO THE UIC YOU SPECIFY.  HOWEVER, IT ALSO HAS THE
; CAPABILITY TO READ THE SYSTEM ACCOUNT FILE (LB:[0,0]RSX11.SYS) TO
; DETERMINE NAMES OF ACCOUNTS AND SET YOUR UIC TO THOSE NAMES.  FOR
; EXAMPLE:
;
;	>UIC [1,2]	SETS YOUR UIC TO [1,2] (BRACKETS ARE OPTIONAL
;	>UIC 123,321	SETS YOUR UIC TO [123,321]
;	>UIC SYSTEM	LOOKS UP THE ACCOUNT WITH THE LAST NAME "SYSTEM"
;			AND SETS YOU TO THE UIC ASSOCIATED WITH IT.
;			THE PASSWORD CHECKING IS IGNORED.
;			THE SY: DEFINED IN THE ACCOUNT RECORD IS THEN
;			ASSIGNED TO YOUR SY:.
;	>UIC AB/CD	LOOKS UP ACCOUNT "AB" AND VERIFIES THAT IT'S
;			PASSWORD IS "CD", AND SETS YOU TO IT'S UIC.
;
;	>UIC		PRINTS YOUR CURRENT UIC ON THE TERMINAL
;
; WHENEVER AN ACCOUNT NAME IS SPECIFIED, UIC PRINTS THE UIC AND SY: THAT YOU
; HAVE BEEN SET TO.
;
; UIC DOES NOT CHANGE YOUR PRIVILEGE STATUS.  THEREFORE, SETTING YOUR
; UIC TO A PRIVILEGED ACCOUNT DOES NOT MAKE YOU PRIVILEGED IF YOU WEREN'T
; PRIVILEGED BEFORE.
;

;
; SYSTEM MACRO CALLS.
;

	.MCALL	QIO$,DIR$,GMCR$,WTSE$S,OPEN$R,CLOSE$,READ$,GLUN$S,QIOW$
	.MCALL	MRKT$,GET$
	.MCALL	NMBLK$
	.MCALL	SPWN$,STSE$

;
; CONSTANTS
;

LUN1	=	1	; TI LUN
LUN2	=	2	; ACCOUNT FILE LUN
LUN3	=	LUN1	; ANOTHER TI LUN
LUN7	=	LUN1	; ERROR MESSAGE LUN
EFN1	=	1	; EVENT FLAG FOR ALL I/O

;
; LOCAL DATA
;
	.NLIST	BEX

ASSN:	.ASCIZ	%ASN XXNN:=SY:%<33>
	ASNLEN=.-ASSN-1
	DEVNUM=ASSN+6			;ADDRESS OF NN (DEVICE UNIT NUMBER)

	.EVEN

SPWDPB:	SPWN$	MCR...,,,,,EFN1,,,ASSN,ASNLEN,,
STSDPB:	STSE$	EFN1

;
; ERROR MESSAGES
;

	.ENABL	LC

ER1:	.ASCIZ	<15>/UIC -- Syntax error/
ER2:	.ASCIZ	<15>/UIC -- Invalid account/
ER3:	.ASCIZ	<15>/UIC -- Terminal allocated to other user/
ER4:	.ASCIZ	<15>/UIC -- Command input error/

ER6:	.ASCIZ	<15>/UIC -- Failure opening account file/

ER15:	.ASCIZ	<15>/UIC -- Cannot find physical LB:/

ER20:	.ASCIZ	<15>/UIC -- SPAWN directive failed - SY: not assigned/

UICMSG:	.ASCIZ	<15><12>/UIC=/

	.EVEN
PSWDBF:	.WORD	0		; ADDRESS OF PASSWORD BUFFER
GRP:	.WORD	0		; GROUP CODE
MEM:	.WORD	0		; MEMBER CODE
	.BLKB	4		;
UIC:	.ASCII	/000000/	; UIC
NAME:	.BLKB	14.		; LAST NAME AREA IF NAME SPECIFIED VS ACCOUNT
	.EVEN

ODPB:	QIO$	IO.WVB,LUN1,EFN1,,,,<BUF,0,40> ; OUTPUT DPB

FDPB:	QIO$	IO.RVB,LUN2,EFN1,,IOSB,,<$ACTBF,$BFLEN,,,1>
IOSB:	.BLKW	2		; I/O STATUS BLOCK

DEFINM:	NMBLK$			; ALLOCATE DEFAULT FILENAME BLOCK
FNBLEN	=.-DEFINM		; LENGTH OF BOTH DEFAULT FILENAME BLOCK
				; AND FDB'S FILENAME BLOCK

	.EVEN

FILOPN:	.WORD	0		; FILE OPEN FLAG 0-NO, 1-YES
ENTRY:	.WORD	0		; ADDRESS OF ACCOUNT ENTRY
OPNERR:	.WORD	0		; ACCOUNT FILE OPEN ERROR FLAG
NAMFLG:	.WORD	0		; NAME FLAG 0-ACCOUNT, 1-NAME

EXSTAT:	.WORD	EX$SUC		; EXIT STATUS: ASSUME SUCCESS

GMCR:	GMCR$
BUF	=	GMCR+2		; BUFFER FOR TI I/O
	.BLKB	132.-80.+2	; EXPAND BUFFER FOR 132. CHARACTER LINES

MKT:	MRKT$	1,60.,1		; WAIT FOR ONE SECOND

	.SBTTL	ENTRY POINT
;
; GET COMMAND LINE
;
$UICEP:	DIR$	#GMCR		; GET MCR COMMAND LINE
	BCC	10$		; OKAY
	CALL	ERR4		; ERROR, NONE THERE
	JMP	EXIT		;
10$:	MOV	$DSW,R4		; MAKE SURE TERMINATOR IS A
	MOVB	#15,BUF(R4)	; CARRIAGE RETURN
	CLR	FILOPN		; SET FILE NOT OPEN
	CLR	ENTRY		; ZERO ENTRY
	MOV	$TKTCB,R1	; GET OUR TCB
	MOV	T.UCB(R1),R1	; GET OUR TI: UCB ADDRESS
	TST	U.OWN(R1)	; IS TERMINAL ALLOCATED?
	BEQ	20$		; NO
	JMP	ERR3		; YES, ERROR
20$:	MOV	#BUF,R0		; GET BUFFER ADDRESS
;
; GET ACCOUNT
;
30$:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCC	40$		; NOT EOL
	JMP	PRTUIC		; EOL - JUST PRINT THE CURRENT UIC

40$:	TST	R1		; ANY BLANKS SEEN?
	BEQ	30$		; NO, CONTINUE SCAN
	DEC	R0		; BACK UP BUFFER POINTER TO FIRST DIGIT
	CALL	ACCNT		; GET ACCOUNT NUMBER
	BCC	50$		; OKAY
	JMP	ERR1		; NO, SYNTAX ERROR
;
; GET PASSWORD
;
50$:	CLR	PSWDBF		; ASSUME NO PASSWORD
	CMPB	-1(R0),#'/	; PASSWORD COMMING?
	BNE	60$		; NO, SYNTAX ERROR
	MOV	R0,PSWDBF	; SAVE PASSWORD ADDRESS
60$:
;
; OPEN ACCOUNT FILE
;
70$:	TST	NAMFLG		; WAS A NAME SPECIFIED?
	BNE	71$		; IF NE, YES - MUST READ ACCOUNT FILE
	JMP	SETUIC		; IF EQ, NO - DON'T OPEN ACCOUNT FILE

71$:	CALL	$SWSTK,100$	; SWITCH TO SYSTEM STATE
	MOV	$TKTCB,R1	; GET MY TCB ADDRESS
	MOV	T.UCB(R1),R1	; GET TERMINAL UCB ADDRESS
	MOV	$DEVHD,R2	; START AT BEGINNING OF DEVICE TABLE
80$:	CMP	D.NAM(R2),#"LB	; AND LOOK FOR LB:
	BEQ	90$		; EQ- FOUND
	MOV	D.LNK(R2),R2	; NEXT DEVICE
	BNE	80$		; TRY IT!
	CLR	4(SP)		; INDICATE ERROR BY SETTING USER R1=0
	RETURN			; TELL USER STATE
90$:	MOV	D.UCB(R2),R0	; GET UCB ADDR
	MOV	U.RED(R0),R0	; FIND PHYSICAL LB: (IE FIRST REDIRECT)
	MOV	U.DCB(R0),R2	; FIND THE DCB OF PHYSICAL DEVICE
	MOV	D.NAM(R2),4(SP)	; PUT LB DEVICE INTO USER STATE R1
	SUB	D.UCB(R2),R0	; CALC UNIT NUMBER
	MOV	D.UCBL(R2),R1	;
	CALL	$DIV		;
	ADD	D.UNIT(R2),R0	;
	BIC	#177400,R0	; CLEAR UNWANTED BITS
	MOV	R0,6(SP)	; PUT UNIT NUMBER INTO USER STATE R2
	RETURN			; RETURN TO USER STATE
100$:				; REF LABEL
	TST	R1		; DID WE FIND PHYSICAL LB:???
	BNE	110$		; NE- YES
	JMP	ERR15		; NO...ERROR
110$:	CLR	N.FID+F.FNB+$ACTFL ; ASSURE NOT OPEN BY FILE ID.
	MOV	F.DSPT+$ACTFL,R0 ; GET ADDR OF DATASET DESCRIPTOR
	MOV	2(R0),R0	; GET ADDR OF DEVICE STRING
	MOV	R1,(R0)+	; INSERT LB'S DEVICE NAME
	MOV	R2,R1		; SETUP TO CONVERT UNIT NUM TO ASCII
	MOV	#1,R2		; NO ZERO SUPPRESS
	CALL	$CBTMG		; CONVERT AND PLACE IN DEVICE STRING
	CLR	OPNERR		; SET NO OPEN ERROR
	MOV	$TKPS,MKT+M.KTMG ; USE TICKS/SEC TO MARK TIME FOR 1 SEC
120$:	CALL	OPEN		; OPEN ACCOUNT FILE
	BCC	150$		; OPEN SUCCESSFUL
	CMP	OPNERR,#5	; FIVE FAILURES?
	BLT	140$		; NO
130$:	JMP	ERR6		; YES
140$:	DIR$	#MKT		; NO, WAIT ONE SECONDS
	BCS	130$		; ERROR
	WTSE$S	#1		; WAIT FOR TIME
	INC	OPNERR		; INCREMENT TIME TRIED
	BR	120$		; TRY AGAIN
;
; SEARCH FOR ACCOUNT IN FILE
;
150$:	CALL	SEARCH		; SEARCH FOR ACCOUNT NUMBER
	BCC	160$		; OKAY
	JMP	ERR2		; ACCOUNT NOT FOUND

160$:	CALL	UICNVT		; CONVERT GROUP NUMBER
	MOV	R1,GRP		; SAVE BINARY GROUP NUMBER
	CALL	UICNVT		; CONVERT MEMBER NUMBER
	MOV	R1,MEM		; SAVE BINARY MEMBER NUMBER

;
; SET UP DEVICE TO BE USED FOR SY:
;

	MOV	ENTRY,R0	; GET ADDRESS OF ACCOUNT ENTRY
	ADD	#A.SYDV,R0	; POINT TO DEFAULT SYSTEM DEVICE
	MOV	(R0)+,ASSN+4	; STORE IT IN ASSIGN COMMAND
	MOV	(R0)+,ASSN+6	;
	CLOSE$	#$ACTFL		; CLOSE ACCOUNT FILE
	CLR	FILOPN		; SET FILE CLOSED
	DIR$	#SPWDPB		; SPAWN MCR WITH ASSIGN COMMAND LINE
	BCC	170$		; IF CC, NO PROBLEMS
	JMP	ER20		; SYSTEM DOESN'T SUPPORT SPAWNING
170$:	DIR$	#STSDPB		; STOP UNTIL ASSIGN COMPLETES
	MOV	#ASSN,R0	; GET ADDRESS OF ASSIGN STRING
	MOV	#DEVNUM,R1	; GET ADDRESS OF DEVICE UNIT NUMBER
	MOV	R1,R2		; COPY STRING ADDRESS
	CMPB	#'0,(R1)	; ZERO DIGIT?
	BNE	200$		; IF NE, NO - STRING ALL SET
	INC	R1		; BUMP PAST ZERO DIGIT
	CMPB	#'0,(R1)	; ANOTHER ZERO?
	BNE	200$		; IF NE, NO
	INC	R1		; SKIP IT
200$:	MOVB	(R1)+,(R2)+	; COMPRESS STRING
	BNE	200$		; CONTINUE UNTIL WE READ THE NULL
	MOVB	#15,-2(R2)	; TERMINATE LINE WITH <CR>
	CALL	WRIT		; WRITE IT OUT

;
; FINALLY, SET THE UIC.
;

SETUIC:	MOV	$TKTCB,R0	; GET OUR TCB
	MOV	T.UCB(R0),R1	; POINTS TO UCB FOR THIS TERMINAL
5$:	CMP	U.RED(R1),R1	; AT END OF REDIRECT CHAIN?
	BEQ	10$		; IF EQ, YES
	MOV	U.RED(R1),R1	; GET REDIRECT POINTER
	BR	5$		; AND FOLLOW CHAIN
10$:	ADD	#U.UIC,R1	; DEFAULT UIC FOR THIS TERMINAL
	MOVB	MEM,(R1)	; PUT NEW UIC IN TERMINAL UCB
	MOVB	GRP,1(R1)	; ...
	BIT	#FE.MUP,$FMASK	; MULTI-USER PROTECTION IN SYSTEM?
	BEQ	20$		; IF EQ, NO
	BIT	#U2.PRV,U.CW2-U.UIC(R1) ; IS THE USER PRIVILEGED?
	BEQ	20$		; IF EQ, NO
	MOV	(R1),U.LUIC-U.UIC(R1) ; SET LOGON UIC ALSO
20$:	TST	NAMFLG		; DID THE USER USE A NAME?
	BEQ	EXIT2		; IF EQ, NO - NO NEED TO PRINT OUR UIC

;
; OUTPUT THE UIC ON TI:.
;

PRTUIC:	CLR	ODPB+Q.IOPL+4
	MOV	#UICMSG,R0	; GET "UIC="
	CALL	WRIT		; OUTPUT IT
	MOV	#BUF,R0		; SET BUFFER ADDRESS
	MOVB	#'[,(R0)+	; START UIC
	MOV	$TKTCB,R1	; GET OUR TCB
	MOV	T.UCB(R1),R1	; GET TI: UCB
	MOVB	U.UIC(R1),MEM	; GET TI:'S MEMBER NUMBER
	MOVB	U.UIC+1(R1),GRP	; GET TI:'S GROUP NUMBER
	CLR	R1		; PREPARE TO GET GROUP CODE
	BISB	GRP,R1		; PICKUP THE GROUP CODE
	CLR	R2		; SUPPRESS LEADING ZEROES
	CALL	$CBOMG		; CONVERT
	MOVB	#',,(R0)+	; SEPARATE GRP AND MEM
	CLR	R1		; SET TO GET MEMBER CODE
	BISB	MEM,R1		; GET IT ALREADY
	CLR	R2		; SUPPRESS LEADING ZEROES
	CALL	$CBOMG		; CONVERT
	MOVB	#'],(R0)+	; FINISH UIC
	CLRB	(R0)		; TERMINATE MESSAGE STRING
	MOV	#BUF,R0		; SET STARTING ADDRESS
	CLR	ODPB+Q.IOPL+4	; INHIBIT ANOTHER CR-LF
	CALL	WRIT		; OUTPUT THE UIC
	BR	EXIT2		; ALL DONE

	.SBTTL	ERROR PROCESSING
ERR1:	MOV	#ER1,R0		; SYNTAX ERROR
	MOV	#EX$ERR,EXSTAT	; SET EXIT STATUS
	BR	ERROR		;
ERR2:	MOV	#ER2,R0		; INVALID ACCOUNT
	MOV	#EX$ERR,EXSTAT	; SET EXIT STATUS
	BR	ERROR		;
ERR3:	MOV	#ER3,R0		; INVALID PASSWORD
	MOV	#EX$ERR,EXSTAT	; SET EXIT STATUS
	BR	ERROR		;
ERR4:	MOV	#ER4,R0		; COMMAND INPUT ERROR
	MOV	#EX$ERR,EXSTAT	; SET EXIT STATUS
	BR	ERROUT		;
ERR6:	MOV	#ER6,R0		; ACCOUNT FILE OPEN ERROR
	MOV	#EX$SEV,EXSTAT	; SET EXIT STATUS
	BR	ERROR		;
ERR15:	MOV	#ER15,R0	; CAN'T FIND PHYSICAL LB:
	MOV	#EX$SEV,EXSTAT	; SET EXIT STATUS
	BR	ERROR		;
ERR20:	MOV	#ER20,R0	; SPAWN MCR FAILED - NO ASSIGN
	MOV	#EX$WAR,EXSTAT	; SET EXIT STATUS

ERROR:
ERROUT:	MOV	#40,ODPB+Q.IOPL+4 ; SET NORMAL CARRIAGE RETURN
	MOV	R0,R2		; SAVE MESSAGE ADDRESS
	CALL	CLOSE		; CLOSE ACTFIL (IF OPEN) - ELSE USER
	MOV	R2,R0		;    COULD ^S WITH ACTFIL OPEN.
	MOV	#LUN7,ODPB+Q.IOLU ; WRITE THE MESSAGE TO THE ERROR LUN
	CALL	WRIT		; WRITE OUT ERROR MESSAGE

EXIT:	CALL	CLOSE		; CLOSE ACTFIL (IF OPEN)
EXIT2:	MOV	EXSTAT,R0	; GET EXIT STATUS
	JMP	$EXST		; AND EXIT WITH STATUS

	.SBTTL	SUBROUTINES
;+
; *** - WRIT  -  WRITE OUT BUFFER
;
; INPUT:
;	R0 - MESSAGE ADDRESS
;
;-
WRIT:	MOV	R0,R1		; COPY BUFFER ADDRESS
10$:	TSTB	(R1)+		; END OF MESSAGE?
	BNE	10$		; NO, LOOP TILL END
	SUB	R0,R1		; COMPUTE LENGTH
WRIT2:	MOV	#ODPB,R4	; GET OUTPUT DPB ADDRESS
	MOV	R0,Q.IOPL(R4)	; SET BUFFER ADDRESS
	MOV	R1,Q.IOPL+2(R4) ; SET BUFFER LENGTH
	CALLR	QIO		; WRITE IT OUT

;+
; *** - ACCNT  - GET ACCOUNT NUMBER OR USER NAME
;
; INPUT:
;	R0 - BUFFER POINTER
;
; OUTPUT:
;	R0 - UPDATED
;	  GRP - GROUP CODE
;	  MEM - MEMBER CODE
;	  UIC - 6 DIGIT ASCII UIC CODE
;	OR IF NAME SPECIFIED
;	  NAME - 14 CHARACATER NAME OF USER
;	CARRY SET - SYNTAX ERROR
;	CARRY CLEAR - OKAY
;-
ACCNT:	CLR	NAMFLG		; SET NO NAME SPECIFIED
	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	120$		; EOL IS ERROR
	CMPB	R2,#'[		; BRACKET IS OPTIONAL
	BNE	10$		; NOT BRACKET
	MOV	R0,-(SP)	; SAVE BUFFER ADDREES
	DEC	(SP)		; BACK IT UP TO BRACKET
	BR	20$		; SKIP
10$:	DEC	R0		; NO, BACKUP TO FIRST CHARACTER
	MOV	R0,-(SP)	; SAVE BUFFER ADDRESS
20$:	CALL	$GTNUM		; GET GROUP CODE
	MOV	R1,GRP		; STORE IT
	BNE	30$		; NON-ZERO IS GOOD
	MOV	(SP)+,R0	; RESTORE BUFFER POINTER
	BR	70$		; TRY IT AS NAME
30$:	TST	(SP)+		; POP OFF OLD BUFFER ADDRESS
	CMP	R1,#377		; VALID GROUP CODE?
	BHI	120$		; NO
	CMPB	R2,#',		; TERMINATOR?
	BNE	120$		; NO, SYNTAX ERROR
40$:	CALL	$GTNUM		; GET MEMBER CODE
	MOV	R1,MEM		; STORE IT
	CMP	R1,#377		; VALID MEMBER CODE?
	BHI	120$		; NO
	CALL	$NNBLK		; GET TERMINATOR
	BCS	60$		; EOL IS OKAY
	CMPB	R2,#']		; IS IT BRACKET?
	BNE	50$		; NO, ERROR
	CALL	$GNBLK		; YES, GET NEXT
	BCS	60$		; EOL, GOOD
50$:	CMPB	R2,#'/		; PASSWORD COMMING?
	BNE	120$		; NO, ERROR
60$:	MOV	R0,-(SP)	; SAVE BUFFER ADDRESS
	MOV	PC,R2		; SET TO GENERATE LEADING ZEROES
	MOV	#UIC,R0		; POINT TO AREA FOR MEMBER
	MOV	MEM,R1		; RETRIEVE MEMBER CODE
	CALL	$CBOMG		; CONVERT MEMBER TO ASCII
	MOV	#UIC-3,R0	; POINT TO AREA FOR GROUP CODE
	MOV	GRP,R1		; GET GROUP CODE
	CALL	$CBOMG		; CONVERT GROUP TO ASCII
	MOV	(SP)+,R0	; RESTORE BUFFER ADDRESS
	BR	130$		;
70$:	MOV	#NAME,R3	; GET ADDRESS OF NAME AREA
	MOV	#14.,R4		; SET LENGTH OF NAME
80$:	MOVB	#40,(R3)+	; BLANK IT OUT
	DEC	R4		; DONE?
	BGT	80$		; NO, LOOP
	INC	NAMFLG		; YES, SET NAME IS SPECIFIED
	MOV	#14.,R4		; SET LENGTH OF NAME
	MOV	#NAME,R5	; SET ADDRESS
90$:	CALL	$GNBLK		; GET NEXT NON-BLANK CHARACTER
	BCS	130$		; EOL, END
	TST	R1		; ANY BLANKS?
	BNE	100$		; YES, ONLY SLASH IS VALID
	CALL	TSTCHR		; IS IT A VALID CHARACTER?
	BCC	110$		; YES
100$:	CMPB	R2,#'/		; NO, PASSWORD COMMING?
	BEQ	140$		; YES
	BR	120$		; NO
110$:	DEC	R4		; ROOM FOR MORE?
	BLT	120$		; LT- NO,,,ERROR.
	MOVB	R2,(R5)+	; INSERT CHARACTER
	BR	90$		; TRY FOR ANOTHER
120$:	SEC			; ERROR
	BR	140$		;
130$:	CLC			; SET SUCCESS
140$:	RETURN			;

;+
; *** - OPEN  - OPEN FILE
;
;-
OPEN:	OPEN$R	#$ACTFL,,,#FD.RWM	; OPEN FILE
	BCS	10$		; ERROR
	INC	FILOPN		; SET FILE IS OPEN
10$:	RETURN			;


;+
; *** - CLOSE  -  CLOSE FILE
;
;-
CLOSE:	TST	FILOPN		; IS FILE OPEN ?
	BEQ	90$		; NO
	CLOSE$	#$ACTFL		; YES - CLOSE FILE
90$:	RETURN


;+
; *** - QIO  -  ISSUE QIO
;
; INPUT:
;	R4 - DPB ADDRESS
;-
QIO:	DIR$	R4		; ISSUE QIO
	BCS	10$		; ERROR
	MOVB	Q.IOEF(R4),R5	; GET EVENT FLAG TO WAIT ON
	WTSE$S	R5		; AND WAIT
10$:	RETURN			;


;+
; *** - TSTCHR  -  TEST CHARACTER FOR VALID SYMBOL IN NAME.
;		   VALID CHARACTERS ARE A-Z, 0-9, $, ', !, -, AND .
;		   LOWER-CASE CHARS ARE CONVERTED TO UPPER-CASE.
;
; INPUT:
;	R2 - CHARACTER TO BE CHECKED
; OUTPUT:
;	R2 - UNCHANGED UNLESS LOWER-CASE CONVERTED TO UPPER-CASE
;	CARRY CLEAR - GOOD
;	CARRY SET - ERROR
;-
TSTCHR:	CMPB	R2,#'A		; ALPHABETIC?
	BLO	10$		; NO
	CMPB	R2,#'Z		; MAYBE
	BLOS	40$		; YES
10$:	CMPB	R2,#'0		; NUMERIC?
	BLO	20$		; NO
	CMPB	R2,#'9		; MAYBE
	BLOS	40$		; YES
20$:	CMPB	R2,#'$		; NO, DOLLAR?
	BEQ	40$		; YES
	CMPB	R2,#''		; NO, APOSTROPHE?
	BEQ	40$		; YES
	CMPB	R2,#'!		; NO, EXCLAMATION
	BEQ	40$		; YES
	CMPB	R2,#'-		; NO, HYPHEN?
	BEQ	40$		; YES
	CMPB	R2,#'.		; NO, PERIOD?
	BEQ	40$		; YES
	CMPB	R2,#140		; IS IT UPPER CASE?
	BLOS	30$		; NO
	CMPB	R2,#172		; MAYBE
	BLOS	35$		; YES
30$:	SEC			; NO, SET ERROR
	BR	50$		;
35$:	BICB	#40,R2		; CONVERT TO UPPER CASE
40$:	CLC			; SET SUCCESS
50$:	RETURN			;

;+
; **- UICNVT - CONVERT 3 ASCII DIGITS TO BINARY
;
; INPUTS:	R0 = ADDRESS IF 3 ASCII DIGITS
;
; OUTPUTS:	R1 = BINARY VALUE
;		R0 = UPDATED
;		R3 DESTROYED
;
;-

UICNVT:	MOVB	(R0)+,R3	; GET H.O. DIGIT
	SUB	#'0,R3		; CONVERT TO BINARY
	MOV	R3,R1		; SAVE IT
	ASL	R1		; SHIFT FOR NEXT DIGIT
	ASL	R1		; ...
	ASL	R1		; ...
	MOVB	(R0)+,R3	; GET NEXT BYTE
	CALL	10$		; CONVERT IT
	ASL	R1		; SHIFT FOR NEXT DIGIT
	ASL	R1		; ...
	ASL	R1		; ...
	MOVB	(R0)+,R3	; GET LAST BYTE
10$:	SUB	#'0,R3		; CONVERT TO BINARY
	BIS	R3,R1		; SET NEW VALUE
	RETURN			; VALUE IN R1

	.SBTTL	SEARCH - SEARCH FILE FOR ACCOUNT
;+
; *** - SEARCH  -  SEARCH FILE FOR ACCOUNT NUMBER
;
; OUTPUT:
;	R0 - ADDRESS OF ACCOUNT ENTRY
;	CARRY CLEAR - ACCOUNT FOUND
;	CARRY SET - ACCOUNT NOT FOUND
;-
SEARCH:	MOV	#FDPB,R4	; GET FILE DPB ADDRESS
	MOV	#1,Q.IOPL+10(R4) ; SET TO START AT VBN 1
	CLR	Q.IOPL+6(R4)	;
10$:	CALL	QIO		; READ NEXT BLOCK
	MOV	IOSB+2,R2	; GET COUNT OF WORDS READ
	BEQ	90$		; ZERO, NO WORDS READ
	MOV	#$ACTBF,R0	; GET BUFFER ADDRESS
20$:	TST	NAMFLG		; IS NAME SPECIFIED?
	BEQ	50$		; NO
	MOV	R0,ENTRY	; YES, SAVE ENTRY ADDRESS
	MOV	R1,-(SP)	; SAVE BYTES LEFT
	MOV	R2,-(SP)	;
	ADD	#A.LNM,R0	; GET ADDRESS OF LAST NAME
	MOV	#NAME,R1	; GET ADDRESS OF NAME ENTERED
	MOV	#14.,R2		; SET LENGTH OF NAME
30$:	CMPB	(R0)+,(R1)+	; NAMES THE SAME?
	BEQ	40$		; YES
	SEC			; NO
	BR	70$		;
40$:	DEC	R2		; SO FAR
	BGT	30$		; CONTINUE TILL END
	MOV	ENTRY,R0	; RESTORE ENTRY ADDRESS
	BR	60$		; NAME IS THE SAME
50$:	CMP	UIC,A.GRP(R0)	; GROUP CODES MATCH
	BNE	80$		; NO
	CMP	UIC+2,A.GRP+2(R0) ; MAYBE
	BNE	80$		; NO
	CMP	UIC+4,A.MBR+1(R0) ; YES, MEMBER CODES MATCH?
	BNE	80$		; NO
	MOV	R0,ENTRY	; SAVE ENTRY POINTER
	MOV	R1,-(SP)	; SAVE R1 AND R2
	MOV	R2,-(SP)	;
60$:	CALL	TPSWD		; CHECK PASSWORD
70$:	MOV	(SP)+,R2	; RESTORE R1 AND R2
	MOV	(SP)+,R1	;
	MOV	ENTRY,R0	; RESTORE ENTRY POINTER
	BCC	110$		; PASSWORD CHECKS OUT
80$:	ADD	#A.LEN,R0	; POINT TO NEXT ENTRY
	SUB	#A.LEN,R2	; COMPUTE WORDS LEFT IN BUFFER
	BHI	20$		; LOOP, MORE LEFT
90$:	CMPB	#IE.EOF,IOSB	; END OF FILE?
	BEQ	100$		; YES
	TSTB	IOSB		; ANY ERRORS?
	BMI	100$		; YES
	ADD	#$BFLEN/512.,Q.IOPL+10(R4) ; NO, POINT TO NEXT VBN
	ADC	Q.IOPL+6(R4)	;
	BR	10$		; READ IN NEXT BUFFER
100$:	SEC			; ERROR, ACCOUNT NOT FOUND
110$:	RETURN			;

;+
; *** - TPSWD  -  TEST PASSWORD
;
; CARRY SET - INVALID PASSWORD
; CARRY CLEAR - GOOD PASSWORD
;
;-
TPSWD:	TST	PSWDBF		; ANY PASSWORD?
	BEQ	80$		; IF EQ, NO
	MOV	R0,-(SP)	; SAVE R0
	MOV	#6,R0		; LENGTH OF PASSWORD FIELD
	MOV	PSWDBF,R1	; LOCATION OF PASSWORD FIELD
10$:	CMPB	(R1)+,#40	; VALID CHAR?
	BLO	20$		; LO- NO.
	DEC	R0		; DECRM CHAR COUNT
	BGT	10$		; GT- MORE TO DO.
	BR	40$		; NO NEED TO SPACE FILL.
20$:	TSTB	-(R1)		; BACK-UP TO BAD CHAR
30$:	DEC	R0		; ANY MORE TO FILL?
	BMI	40$		; MI- NO.
	MOVB	#40,(R1)+	; SPACE-IT-OUT!
	BR	30$		; TRY AGAIN.
40$:	MOV	(SP)+,R0	; RESTORE R0
	ADD	#A.PSWD,R0	; POINT TO PASSWORD IN FILE
	MOV	PSWDBF,R1	; POINT TO PASSWORD TYPED IN
	MOV	#6.,R2		; SET SIZE OF PASSWORD
50$:				; REF LABEL
	CMPB	(R1),#140	; LOWER CASE?
	BLOS	60$		; NO
	CMPB	(R1),#172	; MAYBE
	BHI	60$		; NO
	BICB	#40,(R1)	; CONVERT TO UPPER CASE
60$:
	CMPB	(R1)+,(R0)+	; NO, MATCH?
	BNE	70$		; NO, ERROR
	DEC	R2		; ALL DONE?
	BGT	50$		; NO, LOOP
	BR	80$		; YES
70$:	SEC			; SET ERROR
80$:	RETURN			;

	.END	$UICEP