.TITLE	ACCHEL
	.IDENT	/V7.13/

;********************************************************************
;
; ACCHEL
;
;	THIS MODULE CONTAINS ALL THE SUBROUTINES THAT ARE CALLED BY
;	HELLO TO PERFORM PROCESSING ASSOCIATED WITH THE ACCOUNTING
;	SYSTEM (VERSION 7).
;
;
; VERSION:	V6	DECEMBER 1979
; VERSION:	V7	APRIL 1981
;
;	STEVE THOMPSON	SCHOOL OF CHEMICAL ENGINEERING
;			OLIN HALL
;			CORNELL UNIVERSITY
;			ITHACA NY 14853
;
;	REVISION HISTORY
;	----------------
;
;	SMT718	20-JUL-81	ADDED PAGE COUNT/QMG INTERFACE
;
;	SMT739	12-AUG-81	CHANGED REFERENCES TO $DDEC TO FM.QIO
;
;	SMT743	 9-SEP-81	DO NOT PRINT AND RESET OFFLINE PAGE COUNT
;				WHEN LOGGING ON A BATCH JOB.
;
;	SMT753	 7-OCT-81	CHANGED NAMES OF CONDITIONAL ASSEMBLY
;				PARAMETERS; SEE THE FILES MODIFY.TXT AND
;				CONDEF.MAC FOR DETAILS.
;
;	SMT756	 7-OCT-81	PROHIBIT LOGINS IF THE ACCOUNT BALANCE
;				IS EXACTLY ZERO. THERE WERE SOME OTHER
;				SMALL MODIFICATIONS OF A COSMETIC NATURE
;				ALONG WITH THIS PATCH.
;
;	SMT767	12-OCT-81	REJECT A LOGON IF THERE IS A UAB ALLOCATION
;				ERROR, UNLESS WE ARE LOGGING ON TO A
;				PRIVILEGED ACCOUNT.
;
;	SMT769	12-OCT-81	CHANGED TO CENTRALISED BATCH DEVICE NAME
;
;	SMT776	26-OCT-81	CALLED THE FIRST ACCOUNTING ROUTINE $MONEY
;				RATHER THAN $USESB SO THAT THIS ENTRY POINT
;				CAN BE USED FOR AN INSTALLATION-SPECIFIC
;				ROUTINE.
;
;	SMT804	16-MAR-82	FIX BALANCE FORMATTING IF "UNITS" OPTION
;				IS SELECTED.
;
;	SMT814	12-APR-82	ADDED RSX-11M V4.0 SUPPORT (LOWER CASE
;				MESSAGE TEXT AND SILENT LOGIN SUPPORT)
;
;	SMT821	23-APR-82	CHANGED ENTRY POINT NAMES OF ACCOUNTING
;				SUPPORT ROUTINES (SEE MODIFY.TXT)
;
;*******************************************************************

	.MCALL	EXIT$S,DIR$,GTIM$S,MRKT$S,WTSE$S
	.MCALL	EXST$S

	.IF DF	AA$V40 & A$$CLI
	.MCALL	GCII$S
	.ENDC	; DF AA$V40 & A$$CLI

	ACTDF$	<:>,<=>	; DEFINE ADDITIONAL ACCOUNT FILE ENTRY OFFSETS
	ACCDF$	<:>,<=>	; DEFINE ACCOUNTING CONTROL BLOCK OFFSETS
	BITDF$	<:>,<=>	; DEFINE ACCOUNTING BIT MASKS
	BATDV$		; DEFINE BATCH STREAM DEVICE NAME

CR	=	15		; CARRIAGE RETURN
LF	=	12
BELL	=	7
SPA	=	40

;
; ERROR MESSAGES
;

	.NLIST	BEX

	.IIF DF AA$V40, .ENABL	LC

ERR1:	.ASCIZ	<CR>/HEL -- Account not initialised/
ERR2:	.ASCIZ	<CR>/HEL -- Account overdrawn/
ERR3:	.ASCIZ	<CR>/HEL -- Master account not found/
ERR4:	.ASCIZ	<CR>/HEL -- Master account has illegal format/
ERR5:	.ASCIZ	<CR>/HEL -- Can't relocate account/
ERR6:	.ASCIZ	<CR>/HEL -- Logging task not installed/
ERR7:	.ASCIZ	<CR>/HEL -- Logging task not active/
ERR8:	.ASCIZ	<CR>/HEL -- Memory allocation failure/
ERR9:	.ASCIZ	<CR>/HEL -- UAB allocation error/

;
; TEXT MESSAGES
;

BAL:	.ASCIZ	<CR>/Balance:  /
PAGSTR:	.ASCIZ	/Pages Printed: /

	.IF DF	AA$BLK

DISK1:	.ASCIZ	/Disk Allocation /
DISK2:	.ASCIZ	/ blocks, av. use /
DISK3:	.ASCIZ	/ blocks/
DISK4:	.ASCIZ	<BELL>/** Please REDUCE your DISK use **/<BELL>

	.ENDC	; DF AA$BLK

BUF:	.BLKB	80.

	.EVEN

$ENTAD::.WORD	0		; ACCOUNT ENTRY ADDRESS FOR $FNAME ROUTINE
LOGNAM:	.RAD50	/LOG.../	; LOGGING TASK NAME
LOGPTR:	.WORD	0		; TCB ADDRESS OF LOGGING TASK
DSRPKT:	.WORD	0		; DSR PACKET ADDRESS
CONWRD:	.WORD	0		; CONNECT TIME ADJUSTMENT FACTOR
CPUWRD:	.WORD	0		; CPU TIME ADJUSTMENT FACTOR
NTERM:	.WORD	0		; TERMINAL NUMBER (BINARY)
NPAGE:	.WORD	0		; NUMBER OF OFFLINE PAGES PRINTED
LUIC:	.WORD	0		; LOGON UIC FOR NON-STANDARD RATE SEARCH
ACNO:	.WORD	0		; ACCOUNT NUMBER
CHWD:	.WORD	0		; CHAIN WORD
CASH:	.WORD	0		; ACCOUNT BALANCE
	.WORD	0		; (2 WORDS)

	.IF DF	AA$BLK

BALL:	.WORD	0,0		; DISK BLOCK ALLOCATION
ABLK:	.WORD	0,0		; AVERAGE DISK USE

	.ENDC	; DF AA$BLK

	.IF DF	AA$V40 & A$$CLI

CLIBUF:	.BLKB	6		; CLI INFORMATION BUFFER

	.ENDC	; DF AA$V40 & A$$CLI

	.PSECT	NSCONN
NSCTAB::.WORD	0		; NON-STANDARD CONNECT RATE TABLE
				; THIS TABLE IS FILLED IN BY
				; EXTENSION AND PATCHING AT
				; TASK BUILD TIME.
	.PSECT	NSCPU
NCPTAB::.WORD	0		; NON-STANDARD CPU RATE TABLE.
				; THIS TABLE IS FILLED IN BY
				; EXTENSION AND PATCHING AT
				; TASK BUILD TIME.
	.PSECT
	.PAGE
;+
; *** $MONEY
;
;	THIS ROUTINE IS CALLED BY HELLO TO VERIFY THAT THERE IS MONEY
;	IN THE ACCOUNT WHICH WE ARE LOGGING ON TO, OR IN THE MASTER
;	ACCOUNT IF THE ACCOUNT IS CHAINED. VARIOUS PIECES OF DATA
;	OBTAINED FROM THE ACCOUNT FILE ARE SAVED TO BE TRANSMITTED
;	TO LOG... WHEN $SNDHL IS CALLED
;
;	INPUTS:
;		R0	ACCOUNT ENTRY ADDRESS SET UP BY HELLO CODE.
;
;-

$MONEY::MOV	A.ACNO(R0),ACNO ; SAVE ACCOUNT NUMBER FOR LATER
	BNE	20$		; IF NE, ACCOUNT WAS SET UP OK
	MOV	#ERR1,R0	; SET UP ERROR MESSAGE PARAMETER
10$:	CALL	OUT.PT		; SEND OUT THE MESSAGE
	BR	ERRORX		; AND EXIT
20$:	BIC	#100000,ACNO	; CLEAR MASTER FLAG (IF SET)
	MOV	R0,$ENTAD	; SAVE ACCOUNT ENTRY ADDRESS
	MOV	A.CHWD(R0),CHWD ; SAVE CHAIN WORD FOR LATER
	BEQ	40$		; IF EQ, A/C IS NOT CHAINED
	MOV	#ACCPT1,$ASUBR	; SET ADDRESS OF ACCEPTANCE ROUTINE IN
				; SEARCH FOR THE MASTER ACCOUNT
	CALL	$ASCAN		; LOOK FOR THE MASTER ACCOUNT
	BCC	30$		; IF CC, FOUND IT
	MOV	#ERR3,R0	; SET ERROR MESSAGE ADDRESS
	BR	10$		; PRINT IT AND EXIT
30$:	BIT	#100000,A.ACNO(R0) ; MASTER FLAG SET?
	BNE	40$		; IF NE YES, LEGAL MASTER FOUND
	MOV	#ERR4,R0	; SET ERROR MESSAGE ADDRESS
				; (ILLEGAL MASTER A/C FORMAT)
	BR	10$		; PRINT MESSAGE AND EXIT
40$:	MOV	A.CASH+2(R0),CASH+2 ; SAVE ACCOUNT BALANCE
	MOV	A.CASH(R0),CASH     ;
	BGE	50$		; IF GE, THERE IS MONEY IN THE ACCOUNT
42$:	MOV	#ERR2,R0	; SET UP MESSAGE PARAMETERS
	BR	10$		; SEND OUT ACCOUNT OVERDRAWN MESSAGE
50$:	MOV	CASH,R1		; MAKE SURE BALANCE IS NOT EXACTLY ZERO
	BIS	CASH+2,R1	;
	BEQ	42$		; IF EQ IT WAS, CAN'T LOGON
	MOV	A.PAGE(R0),NPAGE ; SAVE OFFLINE PAGE PRINT COUNT

	.IF DF	AA$BAT

	BEQ	56$		; IF EQ NO PAGES PRINTED OFFLINE
	MOV	$TKTCB,R1	; GET OUR TCB ADDRESS
	MOV	T.UCB(R1),R1	; GET TI: UCB ADDRESS
	MOV	U.DCB(R1),R1	; GET DCB ADDRESS
	CMP	D.NAM(R1),BATDEV ; ARE WE A BATCH JOB?
	BNE	55$		; IF NE NO, COUNT IS OK TO PRINT
	CLR	NPAGE		; LEAVE IT ALONE
	BR	56$		;

	.ENDC	; DF AA$BAT

55$:	CLR	A.PAGE(R0)	; AND ZERO IT
56$:				; REF. LABEL

	.IF DF	AA$BLK

	MOV	A.BALL(R0),BALL ; SAVE DISK BLOCK ALLOCATION
	MOV	A.BALL+2(R0),BALL+2 ;
	MOV	A.ABLK(R0),ABLK ; SAVE AVERAGE DISK USE
	MOV	A.ABLK+2(R0),ABLK+2 ;

	.ENDC	; DF AA$BLK

	TST	CHWD		; ARE WE CHAINED?
	BEQ	60$		; IF EQ NO, NO NEED TO RELOCATE ACCOUNT
	TST	NPAGE		; YES, OFFLINE PAGE COUNT TO ZERO?
	BEQ	59$		; IF EQ NO, IT WAS ALREADY ZERO
	CALL	$AFPUT		; RE-WRITE THIS ACCOUNT RECORD
59$:	MOV	#ACCPT2,$ASUBR	; GET ADDRESS OF ACCEPTANCE ROUTINE FOR
				; RELOCATION OF ORIGINAL ACCOUNT
	CALL	$ASCAN		; LOCATE THE ORIGINAL ACCOUNT (AGAIN)
	BCC	60$		; IF CC GOOD (THERE MAY HAVE BEEN AN I/O ERROR)
	MOV	#ERR5,R0	; GET ADDRESS OF ERROR TEXT
	BR	10$		; ISSUE THE MESSAGE AND TAKE AN ERROR EXIT
60$:	RETURN			; RETURN TO CALLER

;+
; *** ERRORX
;
;	THIS ROUTINE IS CALLED IF AN ERROR IS DETECTED WHICH
;	DOES NOT ALLOW THE LOGON TO CONTINUE. THE ACCOUNT
;	FILE IS CLOSED, WE ARE UNSLAVED AND A SEVERE ERROR
;	EXIT IS TAKEN.
;
;-

ERRORX::CALL	$AFCLS		; MAKE SURE ACCOUNT FILE IS CLOSED
	MOV	$TKTCB,R0	; GET OUR TCB ADDRESS
	MOV	T.UCB(R0),R0	; AND OUR TI: UCB ADDRESS
	BIC	#U2.SLV,U.CW2(R0) ; MAKE SURE TI: IS NOT SLAVED
	EXST$S	#EX$SEV		; EXIT WITH SEVERE ERROR
	EXIT$S			; JUST IN CASE
	.PAGE
;+
; *** ACCPT1	ACCEPTANCE ROUTINE (LOCATE MASTER FROM CHAINED A/C)
;		THIS ROUTINE IS CALLED BY $ASCAN ONLY.
;-

ACCPT1:	MOV	A.ACNO(R0),R1	; GET ACCOUNT NUMBER
	BIC	#100000,R1	; CLEAR MASTER FLAG (IF SET)
	CMP	CHWD,R1		; IS THIS THE MASTER ACCOUNT?
	BEQ	10$		; IF EQ YES
	SEC			; NO, SET CARRY BIT
10$:	RETURN			; RETURN TO $ASCAN


;+
; *** ACCPT2	ACCEPTANCE ROUTINE (LOCATE ORIGINAL ACCOUNT)
;		THIS ROUTINE IS CALLED BY $ASCAN ONLY.
;-

ACCPT2:	MOV	A.ACNO(R0),R1	; GET ACCOUNT NUMBER
	BIC	#100000,R1	; CLEAR MASTER FLAG (IF SET)
	CMP	ACNO,R1		; IS THIS THE ORIGINAL ACCOUNT?
	BEQ	10$		; IF EQ YES
	SEC			; ELSE SET CARRY BIT TO CONTINUE SCAN
10$:	RETURN			; RETURN TO $ASCAN
	.PAGE
;+
; *** $GHLOG
;
;	THIS ROUTINE IS CALLED TO VERIFY THAT THE ACCOUNTING SYSTEM
;	LOGGING TASK LOG... IS INSTALLED AND ACTIVE. IF THESE CHECKS
;	PASS, LOG...'S TCB ADDRESS IS SAVED FOR LATER USE.
;
;-

$GHLOG::
	MOV	#LOGNAM,R3	; GET NAME OF LOGGING TASK
	CALL	$SRSTD		; SEARCH STD FOR IT
	BCC	20$		; OK
	MOV	#ERR6,R0	; SET MESSAGE ADDRESS
10$:	CALL	OUT.PT		; WRITE IT OUT
	JMP	ERRORX		; AND EXIT
20$:	BIT	#TS.EXE,T.STAT(R0) ; GOT IT, BUT IS IT ACTIVE?
	BEQ	30$		; IF EQ YES
	MOV	#ERR7,R0	; SET UP MESSAGE ADDRESS
	BR	10$		; PRINT IT AND EXIT
30$:	MOV	R0,LOGPTR	; SAVE LOG...'S TCB ADDRESS
	RETURN			; RETURN TO CALLER
	.PAGE
;+
; *** $SNDHL
;
;	THIS ROUTINE IS CALLED TO SEND A LOGON REQUEST TO THE ACCOUNTING
;	SYSTEM LOGGING TASK LOG...
;
;-

$SNDHL::			;
	MOV	$TKTCB,R0	; GET OUR TCB ADDRESS
	MOV	T.UCB(R0),R0	; AND OUR UCB ADDRESS
	MOV	U.LUIC(R0),LUIC ; SAVE OUR LOGON UIC
	MOV	U.DCB(R0),R2	; POINT TO OUR DCB
5$:	SUB	D.UCB(R2),R0	; COMPUTE RELATIVE UCB ADDRESS
	MOV	D.UCBL(R2),R1	; GET UCB LENGTH
	CALL	$DIV		; COMPUTE RELATIVE UNIT NUMBER
	ADD	D.UNIT(R2),R0	; COMPUTE ABSOLUTE UNIT NUMBER
	BIC	#177400,R0	; ZAP THE RUBBISH
	MOV	R0,NTERM	; AND SAVE THE UNIT NUMBER

	.IF DF	AA$BAT

	CMP	D.NAM(R2),BATDEV ; VIRTUAL TERMINAL?
	BEQ	6$		; IF EQ YES, CONNECT CHARGE ALWAYS ZERO
				; BUT NON-STANDARD CPU MAY STILL APPLY

	.ENDC	; DF AA$BAT

	MOV	#NSCTAB,R0	; GET ADDRESS OF SPECIAL RATES TABLE
	CALL	SPRATE		; ANY SPECIAL CONNECT RATE?
	MOV	R3,CONWRD	; SAVE NON-STANDARD CONNECT RATE WORD
6$:	MOV	#NCPTAB,R0	; GET ADDRESS OF SPECIAL CPU RATE TABLE
	CALL	SPRATE		; ANY SPECIAL CPU RATE?
	MOV	R3,CPUWRD	; SAVE NON-STANDARD CPU RATE WORD
	CLR	DSRPKT		; SET NO DSR PACKET
	CALL	$SWSTK,20$	; SWITCH STACKS
	MOV	#B.LHEL,R1	; GET LENGTH OF BLOCK NEEDED
	CALL	$ALOCB		;; TRY AND GET A BUFFER
	BCS	10$		;; IF CS THEN COULDN'T GET ONE
	MOV	R0,DSRPKT	;; SAVE PACKET ADDRESS
	MOV	$TKTCB,R5	;; GET OUR TCB ADDRESS
	MOV	R5,B.HTCB(R0)	;; SAVE IT IN THE PACKET
	MOV	T.UCB(R5),R5	;; THEN OUR TI: UCB ADDRESS
	MOV	R5,B.UCB(R0)	;; PUT IT IN THE PACKET
	MOV	U.LUIC(R5),B.UIC(R0) ;; WITH OUR LOGON UIC
	MOV	#<AC.HEL!AC.CMD>,B.TCB(R0) ;; AND HELLO COMMAND MASK
	MOV	ACNO,B.HACN(R0) ;; INSERT ACCOUNT NUMBER
	MOV	CHWD,B.HCHW(R0) ;; INSERT CHAIN WORD
	MOV	CONWRD,B.HSCN(R0) ;; AND SPECIAL CONNECT RATE WORD
	MOV	CPUWRD,B.HSCP(R0) ;; AND SPECIAL CPU RATE WORD
	MOV	R0,R1		;; COPY PACKET ADDRESS TO R1
	MOV	LOGPTR,R0	;; GET LOG...'S TCB ADDRESS
	CALL	$EXRQF		;; QUEUE PACKET AND START LOG...
	CALLR	$STPCT		;; STOP US UNTIL WE GET A REPLY
10$:	RETURN			;; BACK TO USER LEVEL
20$:	MOV	DSRPKT,R5	; DID WE DO IT OK?
	BNE	30$		; IF NE YES, BUT PERHAPS UAB ALLOC. ERROR
	MOV	#ERR8,R0	; SET UP MESSAGE ADDRESS
	CALL	OUT.PT		; TYPE OUT ERROR MESSAGE
	JMP	ERRORX		; JUMP TO EXIT AND CLEAN UP ROUTINE
30$:	MOV	B.UCB(R5),R3	; COPY UCB FIELD AS RETURNED BY LOG...
	MOV	B.UIC(R5),R4	; AND THE LOGON UIC
	CALL	$SWSTK,40$	; SWITCH STACKS
	MOV	R5,R0		;; SET ADDRESS OF BLOCK
	MOV	#B.LHEL,R1	;; AND ITS LENGTH
	CALLR	$DEACB		;; DEALLOCATE IT AND RETURN TO USER LEVEL
40$:	BIT	#1,R3		; UAB ALLOCATION ERROR?
	BEQ	10$		; IF EQ NO, JUST RETURN
	MOV	#ERR9,R0	; SET UP MESSAGE ADDRESS
	CALL	OUT.PT		; AND TYPE IT OUT
	SWAB	R4		; POSITION GROUP CODE IN LOW BYTE
	CMPB	R4,#10		; TRYING TO LOG IN PRIVILEGED?
	BLOS	10$		; IF LOS YES, ALLOW IT
	JMP	ERRORX		; TAKE THE CLEAN ERROR EXIT
	.PAGE
;+
;
; $FINLG
;
;	THIS ROUTINE IS CALLED BY HELLO TO FINISH OFF LOGON PROCESSING
;	AS REQUIRED BY THE ACCOUNTING SYSTEM (VERSION 7)
;	THE ACCOUNT BALANCE AND DISK USAGE PARAMETERS ARE TYPED
;	OUT AT THE USERS' TERMINAL.
;
;
;-

$FINLG::			;

	.IF DF	AA$V40 & A$$CLI

	GCII$S	#CLIBUF,#6	; GET INFO. ON OUR CLI
	BCS	1$		; IF CS, DO A NOISY LOGIN
	BIT	#CP.NIO,CLIBUF+G.CICS ; SILENT LOGIN?
	BEQ	1$		; IF EQ NO
	RETURN			; YES, JUST RETURN
1$:				; REF. LABEL

	.ENDC	; DF AA$V40 & A$$CLI

	MOV	#BUF,R0		; SET BUFFER ADDRESS
	MOVSTR	#BAL		; START IT WITH SOME TEXT
	MOV	#CASH,R1	; POINT R1 TO ACCOUNT BALANCE
	CALL	FM.CHG		; FORMAT THE ACCOUNT BALANCE

	.IF DF	AA$UNI

	CLRB	(R0)		; MAKE IT ASCIZ

	.IFF

	CLRB	-(R0)		; MAKE IT ASCIZ AND LOSE THE LAST DIGIT

	.ENDC	; DF AA$UNI

	MOV	#BUF,R0		; SET UP MESSAGE ADDRESS
	CALL	OUT.PT		; AND PRINT IT

	MOV	#BUF,R0		; SET BUFFER ADDRESS
	MOVSTR	#PAGSTR		; INSERT OFFLINE PAGES COUNT TEXT
	MOV	NPAGE,R1	; GET OFFLINE PAGE COUNT
	BEQ	5$		; IF ZERO, SKIP THE MESSAGE
	CALL	DE.CML		; FORMAT AS ASCII DECIMAL
	CLRB	(R0)		; MAKE IT ASCIZ
	MOV	#BUF,R0		; SET UP MESSAGE ADDRESS
	CALL	OUT.PT		; AND PRINT IT
5$:				; REF. LABEL

	.IF DF	AA$BLK

	MOV	#BUF,R0		; GET BUFFER ADDRESS
	MOVSTR	#DISK1		; START MESSAGE
	MOV	#BALL,R1	; POINT R1 TO DISK BLOCK ALLOCATION
	CALL	FM.QIO		; FORMAT AS D.P. DECIMAL
	MOVSTR	#DISK2		; CONTINUE MESSAGE
	MOV	#ABLK,R1	; POINT R1 TO AVERAGE DISK BLOCKS
	CALL	FM.QIO		; FORMAT AS D.P. DECIMAL
	MOVSTR	#DISK3		; TERMINATE MESSAGE
				; (IT WILL END WITH NULL BYTE)
	MOV	#BUF,R0		; SET UP TEXT ADDRESS
	CALL	OUT.PT		; TYPE OUT THE MESSAGE
	MOV	BALL,R0		; COPY HIGH ORDER BLOCK ALLOCATION
	MOV	BALL+2,R1	; COPY LOW ORDER BLOCK ALLOCATION
	SUB	ABLK+2,R1	; SUBTRACT AVERAGE USE
	SBC	R0		;
	SUB	ABLK,R0	;
	BGE	10$		; IF GE USE IS LESS THAN ALLOCATION
	MOV	#DISK4,R0	; SET UP WARNING MESSAGE ADDRESS
	CALL	OUT.PT		; AND PRINT IT
	MOV	$TKTCB,R0	; NOW GET OUR TCB ADDRESS
	MOV	T.UCB(R0),R0	; THEN TI: UCB ADDRESS
	BIT	#U2.CRT,U.CW2(R0) ; ARE WE ON A CRT?
	BEQ	10$		; IF EQ NO
	MRKT$S	#1,#1,#2	; YES, PAUSE FOR 1 SEC. SO USER SEES MESSAGE
	BCS	10$		; JUST IN CASE
	WTSE$S	#1		; WAIT FOR INTERVAL TO ELAPSE
10$:				; REF. LABEL

	.ENDC	; DF AA$BLK

	RETURN			; RETURN TO HELLO CODE
	.PAGE
;+
; *** SPRATE - DETERMINE IF NON-STANDARD RATE APPLIES
;
;	THIS ROUTINE IS CALLED BY ROUTINE $SNDHL.
;
;	THIS ROUTINE SCANS A NON-STANDARD RATE TABLE TO SEE
;	IF THERE IS AN ENTRY THAT APPLIES IN THE PRESENT CASE. THE
;	TABLE FORMAT IS DESCRIBED IN THE DOCUMENTATION.
;
;	INPUT:
;		R0	ADDRESS OF NON-STANDARD RATE TABLE
;		NTERM	BINARY PHYSICAL TERMINAL NUMBER
;		LUIC	BINARY LOGON UIC
;
;	OUTPUT:
;		R3	NON-STANDARD RATE DESCRIPTOR (ZERO IF STANDARD
;			RATES APPLY)
;
;-

SPRATE:	CLR	R3		; ASSUME NO SPECIAL RATE FOUND
10$:	MOV	(R0)+,R1	; GET NEXT TERMINAL NUMBER
	BEQ	30$		; IF EQ, END OF TABLE
	BLT	15$		; IF LT, ALL TERMINALS MATCH
	CMP	R1,NTERM	; SAME TERMINAL AS OURS?
	BEQ	15$		; IF EQ YES
	CMP	(R0)+,(R0)+	; POINT TO NEXT ENTRY
	BR	10$		; AND LOOP
15$:	MOV	(R0)+,R1	; GET USER DESCRIPTOR WORD
	BEQ	25$		; IF EQ IT APPLIES TO EVERYONE
	TSTB	R1		; IS TABULATED MEMBER CODE ZERO?
	BEQ	20$		; IF EQ YES, GROUP APPLIES ONLY
	CMP	LUIC,R1		; DOES FULL UIC MATCH?
	BEQ	25$		; IF EQ YES
16$:	TST	(R0)+		; POINT TO NEXT ENTRY
	BR	10$		; AND LOOP
20$:	SWAB	R1		; POSITION GROUP CODE IN LOW BYTE
	CMPB	LUIC+1,R1	; DOES THE GROUP CODE MATCH?
	BNE	16$		; IF NE NO, GO TO NEXT ENTRY
25$:	MOV	(R0)+,R3	; SAVE CHARGE ALTERATION FACTOR
30$:	RETURN			; AND RETURN TO CALLER

	.END