;<FOONEX>LOGJS.MAC;21  9-Mar-81 22:54:58, Edit by MMCM
;DSK:<134-TENEX>LOGJS.MAC;20  3-Apr-80 16:33:36, Edit by RKNIGHT
; Made SETACT the same as it was before changes to fact file.
;DSK:<134-TENEX>LOGJS.MAC;18 26-Mar-80 16:48:35, Edit by RKNIGHT
; Fixed change-caused brain damage in SETACT.
;DSK:<134-TENEX>LOGJS.MAC;17 24-Mar-80 15:38:08, Edit by RKNIGHT
; Changed STAD to put in last system date/time.
;DSK:<134-TENEX>LOGJS.MAC;15  5-Mar-80 18:57:38, Edit by RKNIGHT
; Changed SETACT to be able to go to different places.
;DSK:<134-TENEX>LOGJS.MAC;13  5-Mar-80 17:17:02, Edit by RKNIGHT
; Changed CACCT to go to one place to do job stats.
;DSK:<134-TENEX>LOGJS.MAC;11  5-Mar-80 15:52:19, Edit by RKNIGHT
; Added code to zero TTYCHS on login.
;<134-TENEX>LOGJS.MAC;10    21-May-78 15:23:01    EDIT BY PETERS
;<134-TENEX>LOGJS.MAC;9    26-Jul-76 21:50:50    TVEDIT'd by Geoff
; OPER's can now do GTDIR's. No harm because passwords are now encrypted.
; but we still won't let 'em do CRDIR's tho!
;<134-TENEX>LOGJS.MAC;8    18-May-76 17:44:06    TVEDIT'd by Geoff
; GTDIR - wheels only.
;<134-TENEX>LOGJS.MAC;6    11-MAY-76 11:15:23    EDIT BY UNTULIS
;ADDED JOB PAGE FAULT INIT CODE
;<134-TENEX>LOGJS.MAC;4     3-MAY-76 18:22:20    EDIT BY LYNCH
; TOOK OUT OPERATOR CAPABILITY TO DO CRDIR JSYS
;<134-TENEX>LOGJS.MAC;3     3-MAY-76 17:29:32    EDIT BY UNTULIS
;ADDED CODE TO NOT ALLOW CAPABILITIES IF BATCH JOB
;<134-TENEX>LOGJS.MAC;2    11-FEB-76 14:16:01    EDIT BY UNTULIS
;CHANGED OPTT TO LOGDES, ADDDED CODE TO SACTF TO HANDLE
;STRING ACCOUNTS CORRECTLY
;<135-TENEX>LOGJS.MAC;15    12-DEC-75 10:54:44    EDIT BY PLUMMER
; ADD IFN PIESLC AROUND LOGI0B
;<134-TENEX>LOGJS.MAC;14     3-SEP-75 12:54:30    EDIT BY ALLEN
; FIX FOR USE OF NEW LOCK MACRO
;<134-TENEX>LOGJS.MAC;13    29-AUG-75 11:25:18    EDIT BY ALLEN
; FIXES FOR NEW PIE-SLICE CPU MAINTENANCE
;<134-TENEX>LOGJS.MAC;12    28-AUG-75 17:17:11    EDIT BY ALLEN
; UNLOCK DIRLCKS MUST NOW SPECIFICALLY REQUEST RELEASE OF HIQ
;<134-TENEX>LOGJS.MAC;11    19-JUN-75 23:50:05    EDIT BY CLEMENTS
; MOD TO LOGIN TO ALLOW FTPSRV TO SUPPRESS LOGIN DATE UPDATING. FLAG
;  B16 IN AC1 DOES THIS.
;<134-TENEX>LOGJS.MAC;10    11-JUN-75 10:22:15    EDIT BY ALLEN
; MINOR FIX TO LOGIN SO SYSLOD WORKS
;<134-TENEX>LOGJS.MAC;9    28-APR-75 15:07:32    EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;8    28-APR-75 12:37:52    EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;7    28-APR-75 11:36:07    EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;6    22-APR-75 11:05:41    EDIT BY TOMLINSON
; Hashed passwords back into mainstream sources
;<134-TENEX>HLOGJS.MAC;9    17-APR-75 16:05:59    EDIT BY CLEMENTS
; MOVE MAKNFE WHICH GOT STUCK IN STRAIGHTLINE CODE BY ACCIDENT
;<134-TENEX>HLOGJS.MAC;8    16-APR-75 20:48:28    EDIT BY CLEMENTS
;<134-TENEX>HLOGJS.MAC;7    15-APR-75 22:04:21    EDIT BY SYSTEM
;<134-TENEX>HLOGJS.MAC;6    15-APR-75 18:23:36    EDIT BY CLEMENTS
; MORE FIXES IN HASHER AND FRIENDS
;<134-TENEX>HLOGJS.MAC;5    14-APR-75 15:42:07    EDIT BY CLEMENTS
; FIXES IN PASS HASHER
;<134-TENEX>HLOGJS.MAC;4    13-APR-75 21:54:40    EDIT BY CLEMENTS
; IMPLEMENT HASHED PASSWORD SYSTEM
;<134-TENEX>LOGJS.MAC;4    13-APR-75 20:01:31    EDIT BY CLEMENTS
; FIX LONGSTANDING TYPO IN FAIL RETURN OF MAKF02+6
;<134-TENEX>LOGJS.MAC;2    10-APR-75 10:53:02    EDIT BY PLUMMER
; SAVE DDB POINTER IN INDEX AROUND CALLS TO CPYDIR SO GC WILL SEE IT
;<134-TENEX>LOGJS.MAC;1     8-APR-75 18:56:15    EDIT BY CLEMENTS
; SEPARATED FROM JSYS.MAC

	SEARCH STENEX,PROLOG
	TITLE LOGJS
	SWAPCD

EXTERNAL MENTR,MRETN,BUGCHK,BUGHLT,BUGNTE,MSTKOV,JOBPT,CAPENB,CAPMSK

; Error macro definitions

DEFINE	ERUNLK(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERUNLD##]>

DEFINE	ERR(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERRD##]>

DEFINE	ERABRT(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERABRD##]>

; Make a new fd
; Call:	1:	;STRING POINTER TO DIRECTORY NAME
;	2:	;FLAGS,,PARAMETER BLOCK ADDR.
;	3:	;DEVICE DESIGNATOR IF B17 OF AC2 IS ON
;	4:	;STRING POINTER OF OLD PASSWORD (FOR UN-ENABLED CHANGE)

;	CRDIR

; Return
;	+1	; Error
;	+2	; Success
; In parameter block
;	0	; Pointer to name string
;	1	; Pointer to password string, 0 if none
;	2-N	; Copy of ddb image

.CRDIR::JSYS MENTR
	UMOVE A,2		; BIT
	UMOVE B,3		; DEVICE DESIGNATOR
	PUSHJ P,SETUNT##
	 ERR()
	UMOVE E,2		;FLAGS,,PARAMPTR
	MOVE A,CAPENB
	TRNN A,WHEEL		;MUST HAVE SPECIAL CAPABILITIES,
	TLNN E,577776		;OR BE CHANGING PASSWORD ONLY
	CAIA
	  ERR(CRDIX1)
	UMOVE A,1
	PUSHJ P,CPYFUS##	; Copy directory name string
	 ERR CRDIX3		; No room in jsb
	MOVE B,1(A)
	TLNN B,774000
	ERR CRDIX5		; Null name illegal
	PUSHJ P,DIRLUU##	; Look up the name in directory
	 JRST MAKNFD		; Non-existent, must make a new one
	TLO E,(1B15)		; NAME EXISTS. DON'T TOUCH MAIL FILE.
	PUSH P,A
	MOVE B,DIRINP
	MOVEI B,-1(B)
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE##	; Release free storage used for name
	TLNE E,(1B16)		; Delete wanted?
	 JRST DELDIR		; Yes
	UNLOCK DIRLCK,,HIQ
	POP P,A
	TLNE E,(1B6)
	XCTUU [CAMN A,6(E)]
	JRST CRDIR1
	  ERR(CRDIX2)		; Directory number disagrees

CRDIR1:	PUSHJ P,GETDDB##	; Setup a pointer to the ddb
	BUG(HLT,<CRDIR: GETDDB FAILED WHEN DIRLUU DIDN'T.>)
	MOVE NUM,A		; Save pointer in num

;BACK HERE AFTER CREATING NEW DIRECTORY, FROM MAKNFD BELOW
MAKFD0:	TLNN E,(1B1)
	JRST CRDIR3		; No password change
	MOVE B,CAPENB
	TRNE B,WHEEL
	 JRST MAKF02		;NO CHECK IF SPEC. CAPS. ENABLED
MAKF01:	UMOVE B,4		;GET OLD PASSWORD PTR
	PUSHJ P,CHKPSX		;CHECK PASSWORD
	  ERR(CRDIX1,<CALL CHKPSU>)

MAKF02:	UMOVE A,1(E)		; Get pointer to NEW password
	PUSH P,A		;SAVE THE INITIAL POINTER
	PUSHJ P,CPYFUS		; Copy new password to free storage
MAKF2F:	 ERR CRDIX3,<SUB P,BHC+1	;DISCARD POINTER
		UNLOCK DIRLCK,,HIQ>
; A HAS LOOKUP POINTER TO JSB COPY OF NEW PASSWORD.
	PUSHJ P,SETMSK##	; Store in directory
				; THIS GETS POINTER INTO DIRINP
	POP P,A			;GET BACK THE INITIAL POINTER
	MOVS C,A		;CHECK THE BYTE SIZE
	ANDI C,7700		; ..
	CAIE C,4400		;IS IT 36 BITS?
	JRST MAKFH1		;NO, OLD 7-BIT, PROBABLY
	XCTBU [ILDB C,A]	;36 BITS. GET FIRST HASH WORD
	XCTBU [ILDB D,A]	; AND SECOND
	JRST MAKFH2		;GO STORE THE HASH
MAKFH1:	HRRO B,DIRINP		;COMPRESS THE NEW PASSWORD
	PUSHJ P,HASHPM		;RETURNS HASH IN C,D
	 JRST MAKF2F		;WASN'T ANY JSB SPACE. FAIL.
MAKFH2:	PUSH P,C		;SAVE HASH WDS ON THE STACK FOR A MOMENT
	PUSH P,D		; ..
	MOVEM NUM,DIRSAV	;SAVE IN CASE GC HAPPENS
	MOVEI B,3		;GET A DIRECTORY BLOCK TO HOLD THE HASH
	PUSHJ P,ASGDFR##	; ..
	 ERR(CRDIX4,<MOVE B,DIRINP
		MOVEI B,-1(B)
		MOVEI A,JSBFRE
		PUSHJ P,RELFRE	; Release job storage
		SUB P,BHC##+2	; DISCARD THE NEW HASH DATA
		UNLOCK DIRLCK,,HIQ>)
	POP P,2(A)		;PUT THE NEW HASHED PASSWORD IN THE DIR
	POP P,1(A)		; ..
	MOVE NUM,DIRSAV		;RESTORE DDB POINTER
	HLRZ B,DDBNAM(NUM)	; Get old password pointer
	HRRZS DDBNAM(NUM)	; Zero old pntr
	PUSH P,A
	JUMPE B,MAKFD1
	ADDI B,DIRORG
	PUSHJ P,RELDFR##	; RETURN SPACE OLD PASSWORD WAS IN
MAKFD1:	POP P,A
	SUBI A,DIRORG
	HRLM A,DDBNAM(NUM)	; Store as password
	MOVE B,DIRINP
	MOVEI B,-1(B)
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE		; Release jsb storage

CRDIR3:
	UMOVE A,3(E)		; Get privilege bits
	TLNE E,(1B3)
	MOVEM A,DDBPRV(NUM)
	UMOVE A,4(E)
	TLNE E,(1B4)
	MOVEM A,DDBMOD(NUM)
	SETZM DDBRES(NUM)
	UMOVE A,12(E)		; GET LAST LOGIN
	TLNE E,(1B10)		; WANT TO SET IT?
	 MOVEM A,DDBDAT(NUM)	; YES, SET IT
	UMOVE A,13(E)
	TLNE E,(1B11)
	MOVEM A,DDBGRP(NUM)
	MOVE A,DDBNUM(NUM)
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,SETDIR##
	BUG(HLT,<CRDIR: SETDIR FAILED ON DIRECTORY FOUND IN INDEX.>)
	UMOVE A,2(E)		; GET MAX ALOCATION
	TLNE E,(1B2)		; SET THIS ONE ?
	HRLM A,DIRDSK		; YUP
	UMOVE A,7(E)		; Default file protection
	ANDI A,777777
	TLO A,500000
	TLNE E,(1B7)
	MOVEM A,DIRDPW
	UMOVE A,10(E)
	ANDI A,777777
	TLO A,500000
	TLNE E,(1B8)
	MOVEM A,DIRPRT
	UMOVE A,11(E)
	ANDI A,777777
	TLO A,500000
	TLNE E,(1B9)
	MOVEM A,DIRDBK
	UMOVE A,14(E)
	TLNE E,(1B12)
	MOVEM A,DIRGRP
	UNLOCK DIRLCK,,HIQ
	JUMPG UNIT,CRDIR4	; NO MESSAGE FILE IF NOT DSK:

CRDI3A:	MOVEI B,20
	TLNN E,(1B15)		;IF B15 ON, DON'T CREATE MAILBOX.
	PUSHJ P,ASGJFR##
	 JRST CRDIR4
	PUSH P,A
	HRLI A,(<POINT 7,0,34>)
	HRROI B,[ASCIZ /DSK:</]
	SETZ C,
	SOUT
	PUSH P,A		;SAVE BEGINNING OF NAME
	MOVE B,DIRNUM
	DIRST
	 JRST CRDIR6
	POP P,B			;BEGINNING OF NAME
	PUSH P,A		;MESSAGE FILE NAME STRING PARTIAL PTR
	SETZ A,
	STDIR
	 JFCL
	 JRST CRDIR6
	TRNE A,777776		;DIRECTORY 1, SYSTEM, NON-STD. NO MSG
	TLNE A,(1B0)
	 JRST CRDIR6		;FILES ONLY. NO MSG FILE
	POP P,A
	HRROI B,[ASCIZ />MESSAGE.TXT;1/]
	SETZ C,
	SOUT
	MOVE B,(P)
	HRLI B,(<POINT 7,0,34>)
	MOVSI A,400001
	GTJFN
	 JRST CRDIR5
	MOVE B,[1,,FDBCTL]	;SEE IF IT'S A FRESH FILE
	MOVEI C,C
	GTFDB			;CONTROL WORD TO C
	TLNN C,FDBNXF!FDBDEL	;IF NON-EXISTENT (NEW) OR DELETED,
	JRST CRDI3B		; NO. LEAVE IT ALONE
	HRLI A,FDBCTL		;PUT IT IN STANDARD STATE
	MOVSI B,FDBPRM!FDBNXF!FDBDEL
	MOVSI C,FDBPRM!FDBDEL
	CHFDB
	HRLI A,FDBPRT		;STANDARD PROTECTION FOR MSG FILES
	MOVEI B,777777
	MOVEI C,770404		;IS APPENDABLE BY ALL
	CHFDB
CRDI3B:	HRRZS A
	RLJFN
	 JFCL
	JRST CRDIR5

CRDIR6:	SUB P,BHC##+1
CRDIR5:	POP P,B
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE
CRDIR4:	SETZM NXTDMP##
	JRST SKMRTN##

DELDIR:	PUSH P,DIRNUM		; Remember where we are
	MOVE JFN,-1(P)		; Get directory number to delete

	PUSHJ P,DELALL##	; Try very hard to delete all files
	MOVE A,SYMBOT
	CAME A,SYMTOP		; Did we succeed?
	 JRST [	MOVE A,DIRORG(A)
		TRNE A,700000
		JRST .+1
		POP P,A
		PUSHJ P,MAPDIR##
		UNLOCK(DIRLCK)
		ERR(CRDIX7)]
	POP P,A
	PUSHJ P,MAPDIR		; Return to subindex
	MOVE A,DIRLOC		; Get sym tab loc
	PUSH P,DIRORG(A)	; Save content
DELDI0:	CAMGE A,SYMBOT		; At bottom?
	 JRST DELDI1		; Yes
	MOVE B,DIRORG-1(A)	; No move symbol table up
	MOVEM B,DIRORG+0(A)
	SOJA A,DELDI0

DELDI1:	AOS SYMBOT		; Point to new bottom
	HLRZ B,0(P)		; Get pointer to string
	ADDI B,DIRORG
	PUSHJ P,RELDFR		; Release free storage
	SUB P,[XWD 1,1]
	POP P,A			; Get directory number
	PUSHJ P,HSHLUK##	; Find it in hash table
	 BUG(HLT,<CRDIR: HSHLUK FAILURE FOR EXISTENT USER>)
	MOVSI A,-1
	EXCH A,DIRORG(B)	; Get hash table entry, delete entry
	UNLOCK DIRLCK,,HIQ		; Unlock
	HLRZS A
	PUSH P,A		; Save
	LSH A,-^D12		; Get subindex number
	MOVNS A			; Negate
	PUSHJ P,MAPDIR		; Back to the subdirectory
	MOVEI A,7777
	ANDB A,0(P)		; Extract ddb location
	HLRZ B,DDBNAM+DIRORG(A)	; Get pointer to password
	ADDI B,DIRORG
	CAIE B,DIRORG
	 PUSHJ P,RELDFR		; Release free storage if any
	POP P,B
	ADDI B,DIRORG
	PUSHJ P,RELDFR		; Release free storage for ddb
	UNLOCK DIRLCK,,HIQ
	JRST SKMRTN

MAKNFD:	MOVE A,CAPENB
	TRNN A,WHEEL
	 ERR(CRDIX1,<UNLOCK DIRLCK,,HIQ
		MOVE B,DIRINP
		MOVEI B,-1(B)
		MOVEI A,JSBFRE
		PUSHJ P,RELFRE>)
	MOVE A,SYMBOT
	SUBI A,2
	CAML A,FRETOP
	JRST .+3
	PUSHJ P,XPAND##
	 JRST MAKNFF		; FULL
	MOVEI B,DDBLEN
	PUSHJ P,ASGDFR##	; Assign space for the ddb
	 JRST MAKNFF		;CLEANUP AND GIVE CRDIX4
	MOVEI NUM,(A)		; Point num to the ddb
	SETZM DDBNAM(NUM)	; Clear name pointers
	SETZM DDBNUM(NUM)	; Clear number
	SETZM DDBPRV(NUM)	; Default privileges
	SETZM DDBDAT(NUM)	; CLEAR LAST LOGIN
	SETZM DDBMOD(NUM)	; Default modes
	SETZM DDBGRP(NUM)
	SETZM DDBRES(NUM)
	MOVEM NUM,DIRSAV	;SAVE IN CASE GC HAPPENS
	PUSHJ P,CPYDIR##	; Copy name to directory
	 JRST MAKNFE		;CLEAN UP AND GIVE CRDIX4
	SUBI A,DIRORG		; Convert to relative pointer
	MOVE NUM,DIRSAV		;RESTORE DDB POINTER
	HRRM A,DDBNAM(NUM)	; Save as name
	HRLZ C,A		; Right half yet to be filled in
	SOS B,DIRLOC
	SOS A,SYMBOT
	CAML A,B
	JRST MAKNFZ
	ADDI A,DIRORG
	HRLI A,1(A)
	BLT A,DIRORG-1(B)
MAKNFZ:	MOVEM C,DIRORG(B)
	MOVE B,DIRINP
	MOVEI B,-1(B)
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE
	MOVN A,DIRNUM		; Get subindex number
	IMULI A,10000		; Convert to position in file
	ADD NUM,A		; Of the ddb
	SUBI NUM,DIRORG
	MOVEI A,0
	PUSHJ P,SETDIR		; Look at block 0
	BUG(HLT,<CRDIR: SETDIR FAILED FOR BLOCK 0.>)
	UMOVE A,6(E)
	TLNE E,(1B6)
	JRST FNN01
;FALLS THRU

;FALLS THRU FROM ABOVE
FNN00:	MOVE A,LSTDNO		; HIGHEST ASSIGNED NUMBER
	AOS A			; PLUS 1
	CAIL A,NFDIB*40
	 JRST FNN05		; NO ROOM LEFT
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,HSHLUK		; Is this number available?
	 JRST FNN2		; OK TO USE
	AOS LSTDNO
	JRST FNN00		; No, try another

FNN2:	CAIL A,1
	CAIL A,NFDIB*40
	BUG(HLT,<CRDIR: HSHLUK RETURN INVALID DIRECTORY NUMBER.>)
	CAML A,LSTDNO
	  MOVEM A,LSTDNO
	MOVEM A,DIRORG(B)	; Store directory number in rh
	HRLM NUM,DIRORG(B)	; And ddb location in left
	MOVE B,NUM
	IDIVI B,10000		; Recover block containing ddb
	ADDI B+1,DIRORG
	PUSH P,B+1
	PUSH P,A
	UNLOCK DIRLCK,,HIQ
	MOVN A,B
	PUSHJ P,MAPDIR		; Return to original subindex
	POP P,A
	POP P,NUM
	HRRM A,DDBNUM(NUM)
	MOVE B,DIRLOC
	HRRM A,DIRORG(B)
	HRRZS A			; Retain only directory number
	PUSH P,DIRNUM		; Save current directory number
	PUSH P,A		; And new directory number
	PUSHJ P,MAPDIR		; Map the new directory
	MOVE A,DIRNUM
	CAME A,0(P)		; See if directory looks like
	 JRST CRWIPE		; It already exists
	SETO A,
	CAMN A,DIRLCK
	CAME A,DIRFRE+1
	 JRST CRWIPE
	MOVE A,SYMTOP
	TRNN A,777
	CAMGE A,SYMBOT
	 JRST CRWIPE
	MOVE A,SYMBOT
	CAMGE A,FRETOP
	 JRST CRWIPE
	LOCK DIRLCK,,HIQ		; MATCHES THE LATER UNLOCK
	JRST CRNWIP

CRWIPE:	MOVEI A,25
	MOVEI B,1000
	MOVE C,0(P)
	PUSHJ P,INIBLK##	; Initialize it
CRNWIP:	POP P,DIRNUM		; Set its directory number
	MOVEI A,^D250		; DEFAULT MAX ALOCATION = 250
	HRLM A,DIRDSK
	MOVE A,[500000,,IDRDPW]
	MOVEM A,DIRDPW		; SET DEFAULT PROTECTION
	HRRI A,IDRPRT
	MOVEM A,DIRPRT		; AND DIRECTORY PROTECTION
	MOVEI A,2
	MOVEM A,DIRDBK		; AND DEFAULT BACKUP
	SETZM DIRGRP		; AND GROUPS
	POP P,A
	SETOM DIREXL		; FOR SRI-AI BSYS LOCK STYLE.  WILL GO AWAY SOMEDAY.
	UNLOCK DIRLCK,,HIQ		; Unlock the new directory
	PUSHJ P,MAPDIR		; Restore to mapping current di
	JRST MAKFD0

FNN01:	CAIL A,1
	CAIL A,NFDIB*40
	JRST FNN05
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,HSHLUK
	JRST FNN2
FNN05:	UNLOCK DIRLCK,,HIQ		; Number unavailable, abort
	MOVE B,NUM
	IDIVI B,10000
	MOVEI C,DIRORG(B+1)	; Location in subindex of ddb
	PUSH P,C
	MOVN A,B		; Subindex number
	PUSHJ P,MAPDIR		; Get back to it
	POP P,NUM
	HRRZ B,DDBNAM(NUM)	; Get location of name string
	ADDI B,DIRORG
	PUSHJ P,RELDFR		; Release it
	MOVE B,NUM		; Location of ddb
	PUSHJ P,RELDFR		; Release it
	MOVE B,DIRLOC		; Location where symtab entry was put
FNN03:	CAMG B,SYMBOT		; Something left to move?
	JRST FNN04		; No
	MOVE A,DIRORG-1(B)
	MOVEM A,DIRORG(B)
	SOJA B,FNN03

FNN04:	AOS SYMBOT
	UNLOCK DIRLCK,,HIQ
	ERR(CRDIX6)

MAKNFE:	MOVE B,DIRSAV		;POINTER TO DDB
	CALL RELDFR		;RELEASE SPACE FROM INDEX
MAKNFF:	UNLOCK DIRLCK,,HIQ
	MOVE B,DIRINP
	MOVEI B,-1(B)
	MOVEI A,JSBFRE
	CALL RELFRE		;RELEASE JSB STORAGE USED FOR NAME
	ERR (CRDIX4)

; Get directory info
; Call:	1	; Directory number
;	2	; Pointer to parameter block
;	3	; String pointer for password
;	GTDIR

.GTDIR::JSYS MENTR
;	UMOVE A,1		; DIRNUM & BIT
	UMOVE B,4		; DEVICE DESIGNATOR
	PUSHJ P,SETUNT
	 ERR()
	MOVE B,CAPENB
	TRNN B,WHEEL!OPER
	ERABRT(GTDIX1)		; Not wheel or oper.
	XCTUU [HRRZ A,1]
	PUSHJ P,GETDDB
	 ERABRT(GTDIX2)
	UMOVE E,2
	UMOVE C,3
	JUMPGE C,GTDIR1
	CAML C,[777777000000]
	HRLI C,(<POINT 7,0>)
GTDIR1:	HLRZ B,DDBNAM(A)
	ADDI B,DIRORG
	UMOVEM C,3		; STORE THE STRING POINTER IN AC 3
	MOVEI D,0		; PUT A NULL THERE
	PUSH P,C		; SAVE START OF STRING
	XCTBU [IDPB D,C]	; NULL TO USER SPACE
	POP P,C			; BACK TO BEGINNING OF STRING
	TLZE C,7700		; BUT CHANGE TO 36-BIT DATA, IF ANY
	TLO C,4400		; ..
	UMOVEM C,1(E)		; PUT THAT IN ARG BLOCK
	MOVE D,1(B)		; NOW COPY THE PASSWORD TO USER SPACE
	XCTBU [IDPB D,C]	; FIRST WORD OF HASH
	MOVE D,2(B)		; AND SECOND ONE
	XCTBU [IDPB D,C]	; ..
	MOVEI D,0		; PUT A TERMINATING ZERO WORD THERE
	XCTBU [IDPB D,C]	; EVEN THOUGH IT'S NOT NEEDED.
	MOVE D,DDBPRV(A)
	UMOVEM D,3(E)
	MOVE D,DDBMOD(A)
	UMOVEM D,4(E)
	MOVEI D,0
	UMOVEM D,5(E)
	MOVE D,DDBNUM(A)
	UMOVEM D,6(E)
	MOVE D,DDBDAT(A)
	UMOVEM D,12(E)

GTDIR2:	MOVE D,DDBGRP(A)
	UMOVEM D,13(E)
	MOVE A,DDBNUM(A)
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,MAPDIR
	HLRZ D,DIRDSK		; GIVE USER MAX DISK ALOCATION
	UMOVEM D,2(E)
	MOVE D,DIRDPW
	UMOVEM D,7(E)
	MOVE D,DIRPRT
	UMOVEM D,10(E)
	MOVE D,DIRDBK
	UMOVEM D,11(E)
	MOVE D,DIRGRP
	UMOVEM D,14(E)
	JRST MRETN


; Set time and date
; Call:	1	; Date and time in standard format
;	STAD
; Return
;	+1	; Can't set because not wheel or opr
;	+2	; Ok

.STAD::	JSYS MENTR
	HRRZ B,JOBNO		; IS THIS USER LOGGED IN?
	HRRZ B,JOBDIR##(B)	; ..
	JUMPE B,STAD3		; NO. BETTER RANGE CHECK THE ANSWER
	MOVE B,CAPENB
	TRNE B,WHEEL!OPER
	JRST STAD1		; OK, BY WHEEL OR OPER
STAD3:	SKIPGE TADSEC
	JRST STAD2		; BY ORDINARY USER, BUT NEED DATE/TIME
	MOVEI A,STADX1		; NOT ALLOWED. SET ALREADY.
	JRST ERRD

STAD2:	CAML 1,STADMN		; ORDINARY USER. RANGE CHECK DATE
	CAML 1,STADMX		; MUST BE IN THIS RANGE
	SKIPA			; NO GOOD.
	JRST STAD1		; OK.
	MOVEI A,STADX2		; "RIDICULOUS DATE" ERROR MSG
	JRST ERRD		; AND FAIL.
STAD1:	SETZ C,
	MOVE A,TODCLK##
	IDIVI A,^D1000		; Convert to seconds
	XCTUU [HRRZ B,1]	; Get time
	SUB B,A			; Compute offset
	JUMPGE B,.+3
	ADDI B,^D24*^D3600	; If less than 0, augment
	AOJA C,.-2
	XCTUU [HLRZ A,1]
	SUB A,C
	MOVEM A,TADDAY
	MOVEM B,TADSEC
	NOINT			; MAKE SURE IT GETS LOGGED, SINCE IT
	PUSH P,CAPENB		; REALLY IS BEING CHANGED
	MOVEI A,OPER		; SET CAPABILITY FOR EFACT
	IORM A,CAPENB		; ..
	MOVE A,JOBNO		; This job
	HRRZ B,JOBDIR(A)	; User number
	MOVEM B,LOGBUF+1
	UMOVE B,1		; Tad as given
	MOVEM B,LOGBUF+2
	IORI A,(741B8)		; Tad reset code for fact file
	MOVSM A,LOGBUF
	Gtad
	Movem	A,Logbuf+3	; Stash last known time/date in entry.
	MOVE A,CTRLTT
	DPB A,[POINT 12,LOGBUF,29] ; Tty
	MOVE 1,[XWD -4,LOGBUF]	; Make fact file entry for time set
	EFACT
	 JFCL
	POP P,CAPENB		; RESTORE REAL CAPABILITIES, AND NOW
	OKINT			; SAFE TO ALLOW INTERRUPTS
	JRST SKMRTN

;FOLLOWING IS RANGE OF DATES ACCEPTED IF USER IS NOT A LOGGED-IN WHEEL/OPR
STADMN:	122652,,0		;MIN NON-WHEEL DATE, 29 DEC 74
STADMX:	135424,,0		;MAX DATE IF SUSPICIOUS, 1 JAN 1990

; Read time and date
; Call:	RTAD
; Return
;	+1
;	1	; Current date and time or -1 if not set

.GTAD::	JSYS MENTR
	SKIPGE A+1,TADSEC
IFNDEF RTICLK,<	JRST GTAD1		; Not set>
IFDEF RTICLK,<	JRST [	DATAI 600,B
			CAML B,STADMN	; RANGE CHECK IN CASE PWR FAIL
			CAML B,STADMX
			 SETO B,
			JRST GTAD1]	;RETURN IT FROM CALENDAR CLK>
	MOVE A,TODCLK
	IDIVI A,^D1000
	ADD A,TADSEC
	IDIVI A,^D24*^D3600
	ADD A,TADDAY
	HRL A+1,A
GTAD1:	UMOVEM A+1,1
	JRST MRETN

LS(TADDAY)
LS(TADSEC)



IFDEF RTISW,<

;READ MICROSECOND INTERVAL TIMER

.USEC::	DATAI 610,1
	XCT MJRSTF
>;END IFDEF RTISW


; Set fact switch
;CALL:	1	; MASK OF BITS TO CHANGE
;	2	; New setting
;	SMON
; Traps if process hasn't log privilege
; CHANGED TO REQUIRE WHEEL/OPR INSTEAD OF LOG UNTIL CAPABILITIES ARE
; MORE COMPLETELY IMPLEMENTED

.SMON::JSYS MENTR
	MOVE C,CAPENB
	TRNN C,WHEEL!OPER	; TEMP CHANGED FROM TLNN C,LOG
	ERABRT(EFCTX1)
	ANDCAM 1,FACTSW##
	AND 2,1
	IORM 2,FACTSW
	JRST MRETN

; Read fact switch
; Call:	TMON
; Return
;	+1	; Always
;	1	; The current fact switch setting

.TMON::	JSYS MENTR		;MAKE SLOW JSYS SO AOS CAN'T HURT THE
				; RETURN PC BY CARRYING INTO LH
	TDNE 1,FACTSW
	AOS 0(P)		;SKIP RETURN
	JRST MRETN		;RETURN TO USER.

; Enter fact file
; Call:	LH(1)	; Minus entry size
;	RH(1)	; Location of entry
;	EFACT
; Return
;	+1	; Error
;	+2	; Ok

.EFACT::JSYS MENTR
	MOVE B,CAPENB
	TRNN B,WHEEL!OPER	; TEMP CHANGED FROM TLNN B,LOG
	ERR(EFCTX1)
	MOVE B,FACTSW
	TLNN B,(FACTON)
	JRST SKMRTN		; Fact file not on
	HLRO B,A		; Get size
	CAMG B,[-^D64]
	ERR(EFCTX2)		; Too big
	NOINT
	PUSH P,CAPENB		; Save current caps
	MOVEI A,WHEEL!OPER	; Set bits to ensure access to
	IORM A,CAPENB		; Accounts directory and fact file
	MOVEI C,^D30
EFACT2:	HRROI B,[ASCIZ /DSK:<ACCOUNTS>FACT/]
	MOVSI A,1
	GTJFN
	 JRST EFACT3
	PUSH P,1
	MOVE 2,[XWD 440000,20000]
	OPENF			; Open for append
	JRST EFACT4
EFACT6:	POP P,1
	UMOVE C,1
	UMOVE B,(C)
	HLRE D,C
	MOVNS D
	DPB D,[POINT 6,B,35]
	JRST .+2
EFACT1:	UMOVE B,(C)
	BOUT
	AOBJN C,EFACT1
	CLOSF
	BUG(CHK,<EFACT: CLOSF FAILED TO CLOSE FACT FILE.>)
	POP P,CAPENB		; Restore caps
	JRST SKMRTN

EFACT4:	CAIE A,OPNX9
	SETZ C,
	POP P,1
	RLJFN
	 JFCL
	SOJLE C,EFACT3
	MOVEI A,^D4000
	DISMS
	JRST EFACT2

EFACT3:	HRROI 2,[ASCIZ /DSK:<ACCOUNTS>FACT/]
	MOVSI 1,400001
	GTJFN
	 JRST EFACT9
	MOVEI C,^D30
EFACT8:	PUSH P,1
	MOVE 2,[XWD 440000,20000]
	JSYS 21
	JRST EFACT5
	JRST EFACT6

EFACT5:	CAIE A,OPNX9
	JRST EFACT7
	SOJLE C,EFACT7
	MOVEI A,^D4000
	DISMS
	POP P,1
	JRST EFACT8

EFACT7:	POP P,1
	RLJFN
	JFCL
EFACT9:	POP P,CAPENB		; Restore caps
	ERR(EFCTX3)

; Set account for file
; Call:	1	; Jfn
;	2	; String pointer OR 500000000000+account number
;	SACTF
; Return
;	+1	; Error
;	+2	; Ok

.SACTF::JSYS MENTR
	MOVE JFN,1
	PUSHJ P,CHKJFN##
	 ERR()
	 JFCL
	 ERR(DESX4)
	TEST(NE,ASTF)
	 ERUNLK(DESX7)
	HRRZ A,NLUKD(DEV)
	CAIE A,MDDNAM##
	ERUNLK(SACTX1)
	PUSHJ P,GETFDB##
	 ERUNLK(SACTX4)
	HRLI A,40000
	PUSHJ P,DIRCHK##
	 ERUNLK(SACTX4,<UNLOCK DIRLCK,,HIQ>)
	UNLOCK DIRLCK,,HIQ
	PUSH P,FILACT(JFN)	; Save current contents of this cell
	UMOVE A,2
	TLNN A,777777
	HRLI A,440700

SACTF1:	CAMG A,[577777777777]
	CAMGE A,[500000000000]
	JRST SACTF2		; Pointer
	MOVEM A,FILACT(JFN)
	PUSHJ P,INSACT##
	JRST SACTF3

SACTF2:	MOVE B,MODES##
	HRR B,CAPENB
	TDNN B,[1B1!WHEEL!OPER]
	ERUNLK(SACTX3)		; Alphanumeric accounts not allowed
	PUSHJ P,CPYFUS		; Copy from the user
	 ERUNLK(SACTX2)		; Cannot copy
	HRRZM A,FILACT(JFN)
	HLRE B,A		; GET -(WORD COUNT -1) FROM CPYFUS
	SUBI B,2
	PUSH P,(A)		; SAVE BLOCK HEADER FOR RELFRE
	MOVMM B,(A)		; PLANT COUNT AT HEAD OF STRING STORAGE FOR INSACT
	PUSHJ P,INSACT
	HRRZ B,FILACT(JFN)
	POP P,(B)		; RESTORE BLOCK HEADER FOR RELFRE
	MOVEI A,JSBFRE
	PUSHJ P,RELFRE
SACTF3:	POP P,FILACT(JFN)
	PUSHJ P,UNLCKF##
	JRST SKMRTN

; Get account of file
; Call:	1	; Jfn
;	2	; Core location to put string if any
;	GACTF
; Return
;	+1	; Error
;	+2
;	2	; 500000000000+number of string pointer

.GACTF::JSYS MENTR
	MOVE JFN,1
	PUSHJ P,CHKJFN
	 ERR()
	 JFCL
	 ERR(DESX4)
	TEST(NE,ASTF)
	 ERUNLK(DESX7)
	HRRZ A,NLUKD(DEV)
	CAIE A,MDDNAM
	ERR(GACTX1)
	PUSHJ P,GETFDB
	 ERUNLK(GACTX2)
	SKIPLE B,FDBACT(A)
	JRST GACTF1
	UMOVEM B,2
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,UNLCKF
	AOS (P)
	JRST SKMRTN

GACTF1:	UMOVE E,2
	HRLI E,440700
	UMOVEM E,2
	HRLI E,DIRORG+2(B)
	HRRZ B,DIRORG(B)
	ADDI B,-3(E)
	XCTMU [BLT E,(B)]
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,UNLCKF
	JRST SKMRTN

; Login
; Accepts:	1/ flags,,directory #
;			;flags - b16 means don't update login date
;		2/ string pointer to password
;		3/ account designator
; Returns:
;		+1 failed, error # in 1
;		+2 success


JS LGNPAR,2			;A PARAMETER FOR EXEC0 TO FEED LOGIN
				; SECOND WORD IS LAST LOGIN DATE.
				; IF B0 OF LGNPAR=1, THIS IS A CRJOB
				;  LOGIN, AND REST MAY BE FLAGS.

.LOGIN::JSYS MENTR
	SKIPLE 1,LGNPAR		;DID EXEC0 SAY WE SHOULD FAIL?
	JRST ERRD		;YES. SO FAIL, WITH THAT CODE.
	MOVE A,JOBNO
	MOVEI B,777777
	TDNE B,JOBDIR(A)	; Is this job currently logged in?
	ERR(LGINX5)
	UMOVE A,1
	HLRZ B,A		; Get the flags in LH
	ANDI B,1B34		; Mask to ones allowed at login time
	SKIPL LGNPAR		; CRJOB or ordinary login?
	HRRM B,LGNPAR		; Ordinary. Set up flags
	HRRZS A			; Just the Directory Number
	PUSH P,A		; Save the dir #
	ADD P,BHC+11			; Allocate string space
	UMOVE B,3			; Get account descriptor
	PUSH P,B			; Save it
	CAML B,[500000,,0]		; Check for string or numeric
	CAMLE B,[577777,,-1]
	 JRST .+2			; Is a string
	JRST LOGIN3
	MOVEI A,-12(P)			; Where to put account string
	HRLI A,(<POINT 7,0,35>)		; As per CPYFU1
	MOVEM A,0(P)			; Update designator
	CALL CPYFU1##			; Move from user space
	 BUG(HLT,<LOGIN: Impossible failure of CPYFU1>)
	MOVE B,0(P)			; Account designator
	MOVE A,-12(P)			; Directory #
LOGIN3:	VACCT				; Check validity
	 ERR(LGINX1)			; Nope, doesn't make it
	MOVE A,0(P)			; Designator
IFN PIESLC,<
	ATGRP				; Get pie-slice group name
	 JRST [
		CAIN 1,ACCTX1		; NO WAY TO CHECK?
		 JRST .+1		; ALLOW THE LOGIN
		JRST ERRD]		; FAIL SOME OTHER WAY
>; END OF IFN PIESLC
	EXCH B,-12(P)			; Swap for directory #
	MOVE A,B			; For GETDDB
	PUSHJ P,GETDDB		; Get directory descriptor block
	 ERR(LGINX2)
	MOVE B,DDBGRP(A)
	HLRZ C,FORKN		; C=index of top job fork
	HRRZ C,SYSFK(C)		; Get sys index
IFDEF SYMBLX,<
	MOVE D,CAPMSK
	TLNN D,(1B7)		;ALLOWED SPECIAL GROUP ACCESS?
	 TLZ B,(1B0)		;NO, DISABLE GROUP 0 THEN
>
	MOVEM B,FKGRPS##(C)	; Set user groups - assumes single fork
				; group in job when LOGIN executed
	MOVE B,DDBMOD(A)	; Get mode bits
	MOVEM B,MODES
	TLNE B,(1B0)
	ERR(LGINX2,<UNLOCK DIRLCK,,HIQ>)
	SKIPGE B,LGNPAR		;CRJOB SAY SKIP PASSWORD CHECK?
	TRNN B,1		; IT'S CRJOB. SKIP PASSW CHECK?
	SKIPA			;NOT CRJOB, OR CRJOB NEEDS PASSWORD.
	 JRST LOGI0A		;YES, LOGGING IN AS CREATOR
	PUSHJ P,CHKPSW
	  JRST LOGINE		;PASSWORD WRONG
LOGI0A:	MOVE B,DDBPRV(A)
	PUSH P,A
	MOVE A,CTRLTT		;GET CONTROLLING TTY
	CAIL A,PTYLO		;IS IT PSEUDO TTY ?
	CAILE A,PTYHI
	CAIA			;NO
	TRZ B,740000		;YES, DISABLE WHEEL,OPERATOR,CONF,MAINT
IFDEF SYMBLX,<
	MOVE A,CAPMSK
	TLNN A,(1B7)		;WHEEL NOT ALLOWED?
	 TRZ B,740000		;YES, DISABLE WHEEL, ETC.
>
	HRRM B,CAPMSK
	HLLOS CAPENB

IFN PIESLC,<
	MOVE A,DEFGP##		;IN CASE NO ACCOUNT STUFF
	SKIPN ACTONF		;CAN'T DO IF THIS ON ***SRI-AI***
	SKIPN PIEFLG##	;PIE-SLICE DATA FILE MAPPED?
	 JRST LOGIN2		;NO
	MOVE A,-13(P)			; Get pie-slice name off stack
	CALL GRPLUK##		;LOOK IT UP
	 JRST LOGI0B			; FAILED TO FIND GROUP NAME
LOGIN2:	PUSH P,A		;SAVE GROUP INDEX
	MOVE A,-2(P)			; Get account designator
> ;END PIE-SLICE SCHEDULER CONDITIONAL

IFE PIESLC,<
	MOVE A,-1(P)			; Account designator
> ; END OF IFE PIESLC

	Call	Setact

	 ERR(LGINX1,<UNLOCK DIRLCK,,HIQ>)	; Bad account number

IFN PIESLC,<
	POP P,A
	CALL CHGGRP##		;PUT JOB INTO CORRECT GROUP
	NOINT
	LOCK GRPLOK##		;PREVENT UPDATE OF GROUP CPU TIME
	MOVE A,JOBNO
	SETZM JOBRT##(A)
	SETZM JOBORT##(A)	;RESET RUNTIME
	UNLOCK GRPLOK
	OKINT
	CALL ASGDSH##		;RECOMPUTE DSHARE ENTRIES
> ;END PIE-SLICE SCHEDULER CONDITIONAL

IFE PIESLC,<
	MOVE A,JOBNO
	SETZM JOBRT##(A)
> ;END NON-PIE-SLICE SCHED CONDITIONAL

	POP P,B			; DDB index
	SUB P,BHC+13		; account desig+string+group
	GTAD
	Move	C,Jobno		; Update LLORCA.
	Movem	A,LLORCA##(C)
	MOVE C,DDBDAT(B)	; GET LAST LOGIN DATE
	MOVEM C,LGNPAR+1	; SET LAST LOGIN DATE IN GETAB FOR USER
	PUSH P,C		; SAVE PREVIOUS TAD
	JUMPL A,LOGIN5		; DON'T UPDATE DDB DATE IF NOT NOW KNOWN
	HRRZ C,LGNPAR		; GET FLAGS
	TRNE C,2		; ASKED NOT TO UPDATE LOGIN DATE?
	JRST LOGIN5		; YES. BYPASS UPDATING THE DDB
	MOVEM A,DDBDAT(B)	; OK, UPDATE "LAST LOGIN DATE" IN DDB
LOGIN5:	POP P,A			; GET BACK PREVIOUS LOGIN TAD
	XCTUU [EXCH A,1]	; RETURN LAST LOGIN DATE TO USER AC 1,
	HRLS A			; GET LOGIN DIR,,LOGIN DIR
	MOVE B,JOBNO
	MOVEM A,JOBDIR(B)	; STORE AS CURRENT LOGGED IN USER
	HLRZ C,FORKN		; Top job fork
	HRRZ B,SYSFK(C)		; B=its sys fork index
	MOVEM A,FKDIR##(B)	; Set fork directories.
	TLO B,-1		; B=FKDIR entry for inferiors
	MOVE A,JOBNO		; GET JOB NUMBER
	SETZM JOBPGF##(A)		; CLEAR PAGE AULT COUNT FOR THIS JOB
	Setzm	TTYCHS##(A)	;Zero TTY count.
	MOVEI A,0(C)		; A=job index top job fork
	PUSHJ P,MAPINF##
	 CALL LOGIN1		; Set FKDIR for inferiors, if any.
	UNLOCK DIRLCK,,HIQ
	PUSHJ P,LOGONM##	; Type logon message
	TIME
	MOVEM A,CONSTO
	SETZM CAPENB
	JRST SKMRTN

LOGIN1:	HRRZ C,SYSFK(A)
	MOVEM B,FKDIR(C)	; Set FKDIR of fork
	HRLM A,0(P)
	PUSHJ P, MAPINF
	 CALL LOGIN1
	HLRZ A,0(P)
	POPJ P,

LOGINE:	CALL CHKPSU		; UNLOCK DIRLCK AND DO PSWD THING
	ERR(LGINX4)

IFN PIESLC,<
LOGI0B:	BUG(NTE,<LOGIN: FAILED TO FIND GROUP NAME>)
	MOVE A,[INIGP]		; DEFAULT GROUP NAME
	CALL GRPLUK
	 BUG(CHK,<LOGIN: COULDN'T FIND SYSJOB GROUP INDEX, GROUP INDICES FOULED?>)
	JRST LOGIN2
> ; END IFN PIESLC

; Change account

.CACCT::JSYS MENTR
	MOVE A,JOBNO
	MOVE B,JOBDIR(A)
	TRNN B,777777
	ERR(CACTX2)
	ADD P,BHC+11		; Allocate string space
	JUMPGE P,MSTKOV		; If it overflowed
	UMOVE A,1		; Get account designator
	PUSH P,A
	CAML A,[500000000000]
	CAMLE A,[577777777777]
	 JRST .+3		; Is a string account
	MOVE B,A
	JRST CACCT2
	MOVEI B,-12(P)		; Where to put account string
	HRLI B,(<POINT 7,0,35>)		; As per CPYFU1
	MOVEM B,0(P)		; Patch acct location
	EXCH A,B			; For CPYFU1 too
	CALL CPYFU1
	 BUG(HLT,<CACCT: Impossible failure of CPYFU1>)
	MOVE B,0(P)		; Designator
CACCT2:	SETO A,			; ME
	VACCT			; Verify the pair
	 ERR(CACTX1)
IFN PIESLC,<
	MOVE A,0(P)			; ACCOUNT DESIGNATOR
	ATGRP
	 JRST [
		MOVE A,JOBNO
		MOVE A,PIEGRP##(A)
		IMULI A,NWDGRP
		MOVE B,GRPNM##(A)
		JRST .+1]	; Use old guy...
> ; End IFN PIESLC
	PUSH P,B		; Save the group name
	MOVE A,-1(P)

	CALL SETACT
	 ERR(CACTX1)
	POP P,A
	SUB P,BHC+11		; Release space
	PUSH P,A		; RESAVE GROUP
	CALL LGCJM0##		; Don't print it
	POP P,A			;GET PIE-SLICE GROUP NAME
	UMOVE B,2		; Get user bits
	TLNN B,400000		; Don't change group?
	 JRST CACCT4		; Change it
	MOVE B,CAPENB		; Make sure he's allowed
	TRNE B,WHEEL!OPER
	 JRST CACCT1
CACCT4:
IFN PIESLC,<
	SKIPN ACTONF##
	SKIPN PIEFLG##		;GROUP FILE MAPPED?
	 JRST CACCT1		;NO
	CALL GRPLUK		;LOOK UP
	 JRST .+4
	CALL CHGGRP		;AND PUT HIM IN IT
	CALL ASGDSH		;RECOMPUTE DSHARE ENTRIES
	JRST CACCT1
	BUG(NTE,<CACCT: GRPLUK did't find pie slice index>)
> ; END PIE-SLICE SCHEDULER CONDITIONAL
CACCT1:
	TIME
	MOVEM A,CONSTO
	MOVE A,JOBNO

IFN PIESLC,<
	CALL UPDPIE##		;ACCUMULATE GROUP CPU TIME
	NOINT
	LOCK GRPLOK
	SETZM JOBORT(A)
	SETZM JOBRT(A)
	Setzm	TTYCHS##(A)
	UNLOCK GRPLOK
	OKINT
> ;END PIE-SLICE SCHED CONDITIONAL

IFE PIESLC,<SETZM JOBRT(A)>
	JRST SKMRTN

SETACT:	CAML 1,[500000000000]
	CAMLE 1,[577777777777]
	 JRST .+2			; STRING ACCOUNT
	JRST SETACN			; NUMERIC
	MOVE 2,MODES			; CHECK, EVEN THOUGH SHOULD'T 
	TLNN 2,(1B1)			; BE NECESSARY NOW DAYS
	 RET				; STRING ACCOUNT NOT ALLOWED
	PUSH P,C			; SAVE THESE GUYS
	PUSH P,4
	HRRI 2,ACCTSR			; WHERE TO PUT ACCT STR
	HRLI 2,440700			; NICE POINTER
	TLC A,-1			; DEFAULT POINTER?
	TLCN A,-1
	 HRLI 1,440700			; WAS
	MOVEI 4,^D39			; MAXIMUM # OF CHARS
SETAC1:	ILDB 3,1			; GET A CHAR
	SOSG 4				; COUNT CHARS
	MOVEI 3,0			; END OF LINE
	JUMPE 3,SETAC2			; ?
	IDPB 3,2			; PUT DOWN A BYTE
	JRST SETAC1
SETAC2:	IDPB 3,2			; END WITH NULL
	Subi	B,Acctsr-2		; Get the length.
	HRRZM 2,ACCTSL##		; SAVE LENGTH
	Hrri	A,Acctsr-1
	HRLI 1,(<POINT 7,0,35>)
	POP P,4
	POP P,C
SETACN:	MOVEM A,ACCTPT
	JRST SKPRET##		; RETURN SUCCESS


;PASSWORD CHECK FOR INTERNAL USE
; 1/ directory number
; 2/ password string ptr

PASSWC::MOVEI A,0(A)
	PUSH P,2
	PUSHJ P,GETDDB
	 JRST [	POP P,2
		POPJ P,]
	POP P,2
	PUSHJ P,CHKPSX
	 JRST CHKPSU		; UNLOCK DIRLCK, DO PSWD FAILURE THING
	AOS 0(P)
	UNLOCK DIRLCK,,HIQ
	POPJ P,

CHKPSW:	UMOVE B,2
CHKPSX:	PUSH P,A
	PUSH P,B
IFDEF SYMBLX,<
	SKIPGE B,CTRLTT		;GET CONTROLLING TERMINAL NUMBER
	 JRST CHKPS0
	MOVE B,XTTFLG##(B)	;GET SPECIAL FLAG WORD
	TLNE B,(1B1)		;GOOD GUY?
	 JRST CHKPS1		;YES, WE DON'T NEED PASSWORDS HERE
CHKPS0:
>;IFDEF SYMBLX
	HLRZ B,DDBNAM(A)	; Get pointer to password
	JUMPE B,CHKPS2		;NO PASSWORD
	SKIPN DIRORG+1(B)	; IF PASSWORD IS NULL, HASH IS FORCED TO
	SKIPE DIRORG+1(B)	;  BE ZERO IN BOTH WORDS
	SKIPA			; NOT ZERO HASH.
	JRST CHKPS2		; Null password never matches
	HRLI B,(<POINT 7,0,35>)
	ADDI B,DIRORG
	EXCH B,0(P)		;GET BACK PTR TO USER SUPPLIED PSWD
	PUSHJ P,HASHPW		;CONVERT STRING POINTED TO BY B TO HASH
	  JRST CHKPS2		;JSB IS FULL. PRETEND PASSWORD WRONG.
	MOVE A,-1(P)		;GET BACK ADDRESS OF DDB
	HLRZ B,DDBNAM(A)	;POINT TO THE REAL HASH
	CAMN C,DIRORG+1(B)	;IS IT RIGHT?
	CAME D,DIRORG+2(B)	; ..
	SKIPA			;NO. FAIL.
CHKPS1:	AOS -2(P)		;YES, SKIP RETURN.
CHKPS2:	SUB P,BHC+1		;ADJUST STACK POINTER
	POP P,A
	POPJ P,

; PASSWORD FAILURE ROUTINE CALLED BY ALL CALLERS OF CHKPSX AFTER
; DIRECTORY LOCKS ARE CLEARED

CHKPSU:	UNLOCK DIRLCK,,HIQ		; ENTER HERE TO UNLOCK DIRECTORY FIRST
CHKPSF:	MOVEI A,WHEEL+OPER
	TDNE A,CAPENB		; ENABLED WHEEL/OPERATOR?
	 POPJ P,		; YES. JUST FAIL
	TIME			; NO. GET NOW
	SUB A,CONSTO		; TIME ON CONSOLE
	IDIV A,[^D<1000*60*60>]	; IN HOURS
	ADDI A,1		; GRACE PERIOD
	IMULI A,5		; ALLOW 5 ERRORS PER HOUR
	AOS PASFCT##		; COUNT PASSWORD FAILURES (THIS JOB)
	CAML A,PASFCT		; RATE EXCEEDED?
	 POPJ P,		; NO, JUST FAIL
	HRROI B,[ASCIZ /
EXCESSIVE PASSWORD FAILURE RATE.
/]
	SETZ C,
	MOVEI A,777777
	SKIPL CTRLTT
	 SOUT
	MOVEI A,JB0TTY  	; Get job 0 log tty for this nonsense
	CAIN A,377777		; IS NIL?
	 JRST CHKPS3		; YES, SKIP NOTIFICATION PART
	PUSH P,CAPENB
	MOVEI B,OPER
	MOVEM B,CAPENB		; INSURE ABILITY TO PRINT ON OP CONSOLE
	SETO B,
	SETZ C,
	ODTIM
	HRROI B,[ASCIZ / EXCESSIVE PASSWORD FAILURE RATE IN JOB /]
	SETZ C,
	SOUT
	MOVE B,JOBNO
	MOVEI C,12
	NOUT
	 JFCL
	HRROI B,[ASCIZ /, USER /]
	SETZ C,
	SOUT
	MOVE B,JOBNO
	HRRZ B,JOBDIR(B)	; GET LOGIN DIRECTORY
	JUMPE B,[		; IF NOT LOGGED IN
		HRROI B,[ASCIZ /NOT LOGGED IN /]
		SOUT
		JRST CHKPS4]
	DIRST
	 MOVE A,LOGDES##
;FALL THRU

;FALLS THRU
CHKPS4:	HRROI B,[ASCIZ /
  TERMINAL /]
	SOUT
	SKIPGE B,CTRLTT
	 JRST [	HRROI B,[ASCIZ /DETACHED/]
		SOUT
		JRST CHKPS5]
	MOVEI C,10
	NOUT
	 MOVE A,LOGDES
IFDEF IMPCHN,<
	CAIG B,NVTHI
	CAIGE B,NVTLO
	 JRST CHKPS5		; NOT NVT
	LDB B,PTNETI##		; GET NET UNIT NUMBER OF LINE
	EXCH B,UNIT
	LDB UNIT,PFHST##	; GET HOST NUMBER
	EXCH UNIT,B
	PUSH P,B
	HRROI B,[ASCIZ /, HOST /]
	SETZ C,
	SOUT
	POP P,B
	CVHST
	 NOUT
	  MOVE A,LOGDES
>
CHKPS5:	HRROI B,[ASCIZ /
/]
	SETZ C,
	SOUT
	HRROI B,[ASCIZ /OPERATOR NOTIFIED.
/]
	MOVEI A,777777
	SKIPL CTRLTT
	 SOUT
CHKPS3:	MOVE A,JOBNO
	HRRZ A,JOBPT(A)		; GET FORKX OF TOP FORK
	MOVSI B,400000+PSILOB##
	IORM B,FKINT##(A)	; SET LGOUT PSI BIT
	POP P,CAPENB
	POPJ P,

;ROUTINE TO CONVERT A STRING PASSWORD TO A HASHED PASSWORD.
;FOR MATHEMATICAL TECHNIQUE AND CREDITS, SEE PURDY, CACM AUG 74
;AND KNUTH VOLUME 2 SECTION 4.6.3.
;THIS IS A MODIFICATION OF THE SYSTEM USED BY JOHNSON AND THOMAS
;IN RSEXEC

;HASHPW ACCEPTS STRING POINTER IN B AND RETURNS HASH IN C AND D.
;A NULL PASSWORD IS FORCED TO BE A 2-WORD ZERO RESULT.

;THE FOLLOWING FILESYSTEM AC'S ARE USED HERE -- 
; UNIT = FIRST ARG TO ARITHMETIC ROUTINES. 
; IOS = SECOND ARG
; JFN = RESULT (ALL 3 OF THESE POINT TO A TWO-WORD DATUM)
; NUM = POINTER TO SCRATCH AREA IN JSB STORAGE

HASHPM:	TDZA D,D		;ENTER HERE FOR STRING IN MON SPACE
HASHPW:	SETO D,0		;ENTER HERE TO DO UXCT'S
	TLC B,-1		;CHECK FOR -1 IN LH OF STRING POINTER
	TLCN B,-1		; ..
	HRLI B,440700		;YES. NORMALIZE IT.
	TLZ B,37		;AVOID INDEX AND INDIRECT BITS
	MOVE A,B		;COPY THE STRING POINTER
	SKIPN D			;IF FROM MONITOR SPACE,
	ILDB B,A		;GET FIRST CHAR FROM HERE
	SKIPE D			;IF FROM USER SPACE,
	XCTBU [ILDB B,A]	;SEE IF FIRST CHARACTER IS NULL
	JUMPE B,[SETZB C,D	;RETURN A DOUBLEWORD 0 IF SO
		JRST SKPRET##]	;AND GIVE SUCCESS RETURN
;STRING IS NOT NULL. NOW ASSIGN SOME FREE STORAGE, SAVE AC'S, ETC.
	PUSH P,A		;SAVE THE STRING POINTER A MOMENT
	PUSH P,B		;SAVE FIRST CHARACTER
	PUSH P,D		;SAVE FLAG FOR USER/MON SPACE
	MOVEI B,31		;LENGTH OF FREE AREA NEEDED
	PUSHJ P,ASGJFR		;GET IT FROM JSB AREA
	  JRST [SUB P,BHC##+3	;CAN'T STOP HERE. GIVE FAIL RETURN
		POPJ P,0]	; ..
	POP P,D			;RESTORE USER/MON SPACE FLAG
	AOS -2(P)		;WILL ALWAYS SUCCEED FROM HERE ON.
	POP P,B			;GET BACK CHARACTER
	EXCH A,0(P)		;AND STRING POINTER, SAVE JSB POINTER
	EXCH UNIT,0(P)		;UNIT TO STACK, GET JSB POINTER IN UNIT
	PUSH P,IOS		; SAVE SOME MORE
	PUSH P,JFN		; ..
	PUSH P,NUM		; ..
	MOVE IOS,D		;THE FLAG FOR USER OR MON STRINGS
	MOVE NUM,UNIT		;NOW JSB POINTER WHERE IT WILL RESIDE
	MOVSI C,1(NUM)		;CLEAR OUT THE BLOCK
	HRRI C,2(NUM)		; ..
	SETZM 1(NUM)		; ..
	BLT C,30(NUM)		; ..
	PUSH P,E		; AN AC TO COUNT 39 CHAR'S
	MOVEI E,0		;NO CHAR'S SEEN YET
;FALL THRU

;FALLS THRU
	PUSH P,ZERO##		;TWO WORDS OF ZERO ON THE STACK
	PUSH P,ZERO		; INTO WHICH WILL BE XOR'ED THE TEXT.
	JRST HSHP1A		; ALREADY HAVE FIRST CHARACTER
HPWL1:	SKIPN IOS		;GET NEXT CHAR FROM MON SPACE
	ILDB B,A		;IF FLAG FROM HASHPM ENTRY
	SKIPE IOS		;ELSE FROM USER SPACE
	XCTBU [ILDB B,A]		; GET NEXT STRING CHARACTER
HSHP1A:	JUMPE B,HSHPW1		;JUMP IF END OF STRING
	MOVEI C,(E)		;CHARACTER NUMBER
	IDIVI C,^D10		;GET INDEX INTO SHIFT/XOR TABLES
	XCT HPWTB1(D)		;NOW SHIFT CHARACTER
	XCT HPWTB2(D)		;AND XOR IT ONTO STACK
	CAIGE E,^D39-1		;QUIT AT 39 CHARACTERS
	AOJA E,HPWL1		; MORE TO GO.
HSHPW1:	POP P,D			;NOW HAVE FIRST LEVEL MESS ON STACK
	POP P,C			;GET IT BACK TO AC'S, PUT IT IN JSB FREE
	POP P,E			; RESTORE THIS AC
	MOVEM C,25(NUM)		; STORAGE AREA, AT CINPUT AND
	MOVEM D,26(NUM)		; ..
	MOVEM C,13(NUM)		; AT FF ALSO.
	MOVEM D,14(NUM)		; ..
	MOVEI UNIT,25(NUM)	;MULMPD(CINPUT,CINPUT) TO T3
	MOVEI IOS,(UNIT)	; ..
	MOVEI JFN,7(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,7(NUM)	;MULMPD(T3,CINPUT) TO T2
	MOVEI IOS,25(NUM)
	MOVEI JFN,5(NUM)
	PUSHJ P,MULMPD
	PUSH P,BITS##+^D12	;SLIDE A BIT ALONG TO COMPUTE SUM
HSHPW2:	MOVEI UNIT,13(NUM)	;MULMPD(FF,FF) TO FF
	MOVEI IOS,(UNIT)
	MOVEI JFN,(UNIT)
	PUSHJ P,MULMPD
	MOVE A,HASHN1		;CHECK BIT IN MAGIC CONSTANT
	TDNN A,0(P)		; ..
	JRST HSHPX1		;NOT ON, DON'T ADD IN THIS TERM
	MOVEI JFN,13(NUM)	;MULMPD(FF,CINPUT) TO FF
	MOVEI UNIT,(JFN)
	MOVEI IOS,25(NUM)
	PUSHJ P,MULMPD
HSHPX1:	MOVE A,0(P)
	LSH A,-1		;SLIDE BIT TO RIGHT
	MOVEM A,0(P)
	JUMPN A,HSHPW2		;LOOP UNTIL 24 BITS DONE
;FALL THRU

;FALLS THRU
	POP P,(P)		;DONE. DISCARD FLOATING BIT
	MOVE A,13(NUM)		;FF TO T1
	MOVE B,14(NUM)
	MOVEM A,3(NUM)
	MOVEM B,4(NUM)
	MOVEI UNIT,5(NUM)	;MULMPD(T2,T2) TO FF
	MOVEI IOS,(UNIT)	; P**6
	MOVEI JFN,13(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,13(NUM)	;MULMPD(FF,FF) TO FF
	MOVEI IOS,(UNIT)	; P**12
	MOVEI JFN,(UNIT)
	PUSHJ P,MULMPD
	MOVEI UNIT,13(NUM)	; MULMPD(FF,T3) TO FF
	MOVEI IOS,7(NUM)	; P**14
	MOVEI JFN,13(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,3(NUM)	; MULMPD(T1,FF) TO T0
	MOVEI IOS,13(NUM)	; P**N0
	MOVEI JFN,1(NUM)
	PUSHJ P,MULMPD
HSHPW3:	MOVEI UNIT,1(NUM)	;NOW COMPUTE TERMS OF FINAL SERIES
	MOVEI IOS,HASHA0	;T0=T0*A0
	MOVEI JFN,1(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,3(NUM)	;T1=T1*A1
	MOVEI IOS,HASHA1
	MOVEI JFN,3(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,5(NUM)	;T2=T2*A2
	MOVEI IOS,HASHA2
	MOVEI JFN,5(NUM)
	PUSHJ P,MULMPD
	MOVEI UNIT,7(NUM)	;T3=T3*A3
	MOVEI IOS,HASHA3
	MOVEI JFN,7(NUM)
	PUSHJ P,MULMPD
	MOVE A,HASHA4		;T4=A4
	MOVE B,HASHA4+1
	MOVEM A,11(NUM)
	MOVEM B,12(NUM)
;FALL THRU

;FALLS THRU
;NOW ADD UP THE TERMS OF THE SERIES
	MOVE A,1(NUM)		;FF=T0
	MOVE B,2(NUM)
	MOVEM A,13(NUM)
	MOVEM B,14(NUM)
	MOVEI UNIT,3(NUM)	;FF=FF+T1
	PUSHJ P,ADDMPD
	MOVEI UNIT,5(NUM)	;FF=FF+T2
	PUSHJ P,ADDMPD
	MOVEI UNIT,7(NUM)	;FF=FF+T3
	PUSHJ P,ADDMPD
	MOVEI UNIT,11(NUM)	;FF=FF+T4
	PUSHJ P,ADDMPD
	MOVE A,13(NUM)		;XFRM=FF
	MOVE B,14(NUM)
	MOVEM A,27(NUM)
	MOVEM B,30(NUM)
	MOVEI UNIT,27(NUM)	;XFRM=MODP(XFRM)
	MOVEI JFN,27(NUM)
	PUSHJ P,MODP
	PUSH P,27(NUM)		;SAVE ANSWER ON STACK
	PUSH P,30(NUM)
	MOVEI A,JSBFRE		;PREPARE TO RETURN SCRATCH AREA
	MOVEI B,(NUM)		; ..
	SETZM 1(NUM)		;BUT FIRST CLEAR THE INTERMEDIATE TERMS
	MOVSI C,1(NUM)		;JUST IN CASE SOMEONE COULD SEE THEM
	HRRI C,2(NUM)
	BLT C,30(NUM)		; ..
	PUSHJ P,RELFRE		;RETURN THE BLOCK
	POP P,D			;HERE'S THE ANSWER
	POP P,C			; ..
	POP P,NUM		;RESTORE FILE SYSTEM AC'S
	POP P,JFN
	POP P,IOS
	POP P,UNIT
	POPJ P,0		;AND RETURN HASH IN C,D

;CONSTANTS

HPWTB1:	REPEAT 2,<	JFCL
	LSH B,7
	LSH B,^D14
	LSH B,^D21
	LSH B,^D28
>
HPWTB2:	REPEAT 5,<	XORM B,0(P)>
	REPEAT 5,<	XORM B,-1(P)>

HASHN1:	100,,13			;2**24+11.
PA==^D59
PRIME:	3777,,-1
	377777,,-PA
K270P:	0
	^D64*PA
HASHA0:	127,,533602
	240563,,422132
HASHA1:	053,,542132
	020301,,633454
HASHA2:	311,,555236
	347001,,45671
HASHA3:	123,,106405
	245330,,106744
HASHA4:	155,,226337
	124357,,220100

;THE DOUBLE WORD MULTIPLY ROUTINE
MULMPD:	MOVE A,1(UNIT)
	MUL A,1(IOS)
	MOVEM A,15(NUM)
	MOVEM B,16(NUM)
	MOVE A,0(UNIT)
	MUL A,1(IOS)
	MOVEM A,21(NUM)
	MOVEM B,22(NUM)
	MOVE A,1(UNIT)
	MUL A,0(IOS)
	MOVEM A,17(NUM)
	MOVEM B,20(NUM)
	MOVE A,0(UNIT)
	MUL A,0(IOS)
	MOVEM A,23(NUM)
	MOVEM B,24(NUM)
MLM00:	MOVEI C,0
	MOVE A,20(NUM)
	ADD A,22(NUM)
	TLZE A,(1B0)
	ADDI C,1
	ADD A,15(NUM)
	TLZE A,(1B0)
	ADDI C,1
	MOVEM A,15(NUM)
	MOVE A,C
	ADD A,17(NUM)
	MOVEI C,0
	TLZE A,(1B0)
	ADDI C,1
	ADD A,21(NUM)
	TLZE A,(1B0)
	ADDI C,1
	ADD A,24(NUM)
	TLZE A,(1B0)
	ADDI C,1
	MOVEM A,24(NUM)
	ADDB C,23(NUM)
MLM01:	IOR C,A
	JUMPE C,MULMPX
;FALL THRU

;FALLS THRU. FIRST RECURSION NEEDED IF GET HERE. USE "LH" CELLS OVER
; FOR "LL". ON THIS PASS, LH AND HH WOULD BE 0, BECAUSE K270P IS SMALL.

MLM02:	MOVE A,24(NUM)
	MUL A,K270P+1
	MOVEM A,17(NUM)
	MOVEM B,20(NUM)
	MOVE A,23(NUM)
	MUL A,K270P+1
	MOVEM A,21(NUM)
	MOVEM B,22(NUM)
	ADD B,17(NUM)
	TLZN B,(1B0)
	TDZA C,C
	MOVEI C,1
	MOVEM B,17(NUM)
	ADD C,21(NUM)
	MOVEM C,24(NUM)
	SETZM 23(NUM)
	JUMPE C,MLMRDG		;JUMP UNLESS NEED TO RECURSE AGAIN
;HERE ON SECOND RECURSION. NOW WILL GET JUST A SINGLE WORD ANSWER.
MLMRC2:	MOVE A,24(NUM)
	MUL A,K270P+1
	MOVEM A,21(NUM)
	MOVEM B,22(NUM)
	MOVEI C,0
	ADD B,20(NUM)
	TLZE B,(1B0)
	ADDI C,1
	MOVEM B,20(NUM)
	ADDM C,17(NUM)
	JRST MLMRDG

;MORE OF MULMPD. NOW HAVE ANSWER TO FIRST RECURSION IN 17(NUM), 20(NUM)
MLMRDG:	MOVEI B,0
	MOVE C,20(NUM)
	ADD C,16(NUM)
	TLZE C,(1B0)
	ADDI B,1
	MOVEM C,16(NUM)
	ADD B,17(NUM)
	TLZN B,(1B0)
	TDZA C,C
	MOVEI C,1
	ADD B,15(NUM)
	TLZE B,(1B0)
	ADDI C,1
	MOVEM B,15(NUM)
MLMOVL:	JUMPLE C,MULMPX
	MOVE A,K270P+1
	ADD A,16(NUM)
	TLZN A,(1B0)
	TDZA B,B
	MOVEI B,1
	MOVEM A,16(NUM)
	ADD B,15(NUM)
	TLZE B,(1B0)
	ADDI C,1
	MOVEM B,15(NUM)
	SOJA C,MLMOVL

MULMPX:	MOVE A,15(NUM)
	MOVE B,16(NUM)
	MOVEM A,0(JFN)
	MOVEM B,1(JFN)
	POPJ P,0		;EXIT FROM MULMPD

;DOUBLE WORD ADD MOD P ROUTINE FOR HASHED PASSWORDS

ADDMPD:	MOVE A,1(UNIT)
	MOVEI C,0
	ADD A,14(NUM)
	TLZE A,(1B0)
	ADDI C,1
	MOVEM A,14(NUM)
	MOVE A,0(UNIT)
	ADD A,C
	ADD A,13(NUM)
	TLZN A,(1B0)
	TDZA C,C
	MOVEI C,1
	MOVEM A,13(NUM)
	JUMPE C,ADDMPN
ADDMPR:	MOVE A,K270P+1
	ADD A,14(NUM)
	TLZN A,(1B0)
	TDZA C,C
	MOVEI C,1
	MOVEM A,14(NUM)
	MOVE A,C
	ADD A,13(NUM)
	TLZN A,(1B0)
	TDZA C,C
	MOVEI C,1
	MOVEM A,13(NUM)
	JUMPN C,ADDMPR
ADDMPN:	POPJ P,0

;MODULO P ROUTINE FOR HASHED PASSWORDS

MODP:	MOVE A,0(JFN)
	CAMGE A,PRIME
	POPJ P,0
	PUSH P,E
	MOVE E,0(JFN)
	LSH E,-^D<36-7>
	JUMPN E,MODPOV
MODPNO:	MOVE A,0(JFN)
	CAMLE A,PRIME
	JRST MODPN1
	CAME A,PRIME
	JRST MODPRT
	MOVE A,1(JFN)
	CAML A,PRIME+1
	JRST MODPN1
	JRST MODPRT
MODPRA:	MOVEM A,0(JFN)
	MOVEM B,1(JFN)
MODPRT:	POP P,E
	POPJ P,0

MODPN1:	MOVE A,1(JFN)
	SUB A,PRIME+1
	MOVEI C,0
	TLZE A,(1B0)
	ADDI C,1
	MOVEM A,1(JFN)
	MOVE A,0(JFN)
	SUB A,PRIME
	SUB A,C
	MOVEM A,0(JFN)
	JRST MODPRT

;MORE MOD P ROUTINE

MODPOV:	PUSH P,F
	MOVEI F,1(P)
	PUSH P,0
	PUSH P,0
	MOVEI A,PA
	MUL A,E
	MOVEM A,0(F)
	MOVEM B,1(F)
	PUSH P,JFN
	MOVEI JFN,0(F)
	PUSHJ P,MODP		;NEED TO RECURSE.
	POP P,JFN
	MOVE A,0(JFN)
	TLZ A,774000
	ADD A,0(F)
	MOVEI C,0
	TLZE A,(1B0)
	ADDI C,1
	MOVE B,1(F)
	ADD B,1(JFN)
	TLZE B,(1B0)
	ADDI A,1
	MOVEM B,1(JFN)
	MOVEM A,0(JFN)
	CAMGE A,PRIME
	JRST MODPO1
	PUSH P,JFN
;	MOVEI JFN,0(JFN)
	PUSHJ P,MODP
	POP P,JFN
MODPO1:	POP P,(P)
	POP P,(P)
	POP P,F
	JRST MODPRT

; Connect to directory
; Call:	1	; Directory number (b0 for check of pswd only
;				    b1 proxy conn - change "login" dir
;				    b2 connect fork in 4 as spec'd
;				    by other bits)
;	2	; String pointer to password
;	CNDIR
; Return
;	+1	; Error
;	+2	; Ok

.CNDIR::JSYS MENTR
;	UMOVE A,1		; DIRNUM + BITS
	UMOVE B,3		; DEVICE DESIGNATOR
	PUSHJ P,SETUNT
	 ERR()
	MOVE A,JOBNO
	HRRZ B,JOBDIR(A)	; Get directory of login
	UMOVE A,1
	HLLZ D,A		; D=function bits
	TLZ A,-1
	JUMPL D,CNCHK		; Check only wanted
	CAIN B,0		; Must be logged in to connect
	ERR(CNDIX5)
	TLNE D,(1B2)		; Connecting other fork?
	JRST CNDIRA		; Yes, check handles, etc.
CNDIR0:	MOVE B,FORKX##
	SKIPGE B,FKDIR(B)
	JRST [	TLNE D,(1B1)	; Proxy?
		ERR(CNDIX6)	; Yes, only legal in top fork of group
		MOVE B,FKDIR(B)
		JRST .+1 ]
CNDIR1:	CAIN A,0(B)
	JRST CNDIR5		; Can always connect to login directory
	PUSH P,D		; Save D smashed by GETDDB
	PUSHJ P,GETDDB
	 JRST [	POP P,D
		TLNE D,(1B2)	; Other fork?
		CALL CNDIRR	; Yes, resume forks
		ERR(CNDIX3) ]	; No such directory
	MOVE B,CAPENB
	TRNE B,WHEEL!OPER
	JRST CNDIR2		; Bypass checks for wheels and oprs
	HLRZ B,DDBNAM(A)	; Does this directory have a password
	JUMPE B,CNDIR3		; No
	PUSHJ P,CHKPSW		; Yes, check it
	 JRST CNDIR3		; Wrong password, still ok if access
CNDIR2:	POP P,D			; Restore function flags
	TLNN D,(1B1)		; Correct password - proxy?
	JRST CNDIR4		; No
	JRST CNDIR6		; Yes, reset groups and capabilities

CNDIR3:	POP P,D
	TLNE D,(1B1)		; Proxy?
	JRST CNDIEE		; Yes, password required
	UNLOCK DIRLCK,,HIQ
	UMOVE A,1
	HRRZS A
	MOVEI B,-1		; Need to pick up real dsk unit
	PUSH P,D		; Save flags
	PUSHJ P,SETDIR		; Map the directory
	 JRST CNDIRQ
	MOVSI A,XCTF
	PUSHJ P,DIRCHK		; Do we have the proper access to this
	JRST CNDIRE
	POP P,D
CNDIR4:	UNLOCK DIRLCK,,HIQ
CNDIR5:	UMOVE A,1
	NOINT			; Prevent CFGRP by superiors
	TLNE D,(1B2)		; Other fork?
	JRST [	HRRZ B,0(P)
		JRST CNDI55]	; B=FORKX of top fork in group
	MOVE B,FORKX
	SKIPGE C,FKDIR(B)
	MOVEI B,(C)		; B=FORKX of top fork in group
CNDI55:	HRLM A,FKDIR(B)		; Set connected dir
	MOVE C,JOBNO
	HRRZ E,JOBPT(C)
	CAIN E,0(B)		; Top fork in group=top fork in job?
	HRLM A,JOBDIR(C)	; Yes, change JOBDIR
	TLNE D,(1B1)
	HRRM A,FKDIR(B)		; For proxy change user/login dir
	TLNN D,(1B2)
	 JRST SKMRTN
	CALL CNDIRR		; For other fork connect, resume frozen
	SUB P,BHC+2
	JRST SKMRTN

CNCHK:	HRRZS A
	PUSH P,D
	PUSHJ P,GETDDB
	 ERR(CNDIX3)
	PUSHJ P,CHKPSW
	JRST CNDIRE
	UNLOCK DIRLCK,,HIQ
	JRST SKMRTN

CNDIRQ:	BUG(CHK,<CNDIR - SETDIR FAILED>)
	POP P,D
	TLNE D,(1B2)
	CALL CNDIRR
	MOVEI 1,CNDIX3
	JRST ERRD

CNDIRE:	POP P,D
CNDIEE:	JUMPL D,.+3
	TLNE D,(1B2)
	CALL CNDIRR
	CALL CHKPSU		; UNLOCK DIRLCK AND DO PSWD THING
	MOVEI 1,CNDIX1
	JRST ERRD

CNDIR6:	MOVE B,DDBGRP(A)	; B=user groups
	TLNE D,(1B2)		; Connecting other forks?
	JRST CNDIR9
	MOVE C,FORKX		; Proxy request legal only in top fork
	MOVEM B,FKGRPS(C)
	HRRO B,DDBPRV(A)	; B=user capabilities
	HRRZ C,FORKN
	SETZ A,
	CALL CNDIR8		; Reset capabilities
	JRST CNDIR4

CNDIR7:	HRRZ C,SYSFK(A)		; C=SYSFK index
	SKIPL FKDIR(C)		; Fork top fork in group
	RET			; Yes, return
CNDIRG:	MOVEI C,0(A)
	PUSHJ P,SETLF1##	; map fork's PSB
CNDIR8:	HRRM B,CAPMSK(A)	; Set possible mask
	ANDM B,CAPENB(A)	; Set enabled mask
	MOVEI A,0(C)
	HRLM A,0(P)
	PUSHJ P, MAPINF
	 CALL CNDIR7
	HLRZ A,0(P)
	POPJ P,

CNDIR9:	MOVE C,0(P)		; C=FORKX of top fork in group
	MOVEM B,FKGRPS(C)	; Set group bits
	HRRO B,DDBPRV(A)
	HLRZ A,C		; A=Sys index of top fork in group
	CALL CNDIRG
	JRST CNDIR4

CNDIRR:	MOVE A,-2(P)		; A=index of frozen fork
	CALL RFORK1##
	RET


CNDIRA:	UMOVE A,4		; A=USER FORK
	CALL RLJBFK##		; GET JOB INDEX
CNDIRB:	ERR(FRKHX1)		; NO SUCH FORK
	HRRZ B,SYSFK(A)		; B=FORKX OF FORK
	CAMN B,FORKX		; THIS FORK?
	JRST CNDIRF		; YES, TREAT AS ORDINARY CNDIR
	MOVEI C,0(A)		; C=JOB INDEX OF FORK
	HRRZ E,FORKN		; FIND IMMED INF OF EXECUTING FORK THAT
	CAIA			; IS SUPERIOR TO FORK SPEC'D BY USER
CNDIRC:	MOVEI A,0(C)		; A=FORK
	ADD C,SUPERP##
	LDB C,C			; C=FORK'S SUPERIOR
	CAIN C,0(E)		; SUPERIOR OF FORK IN A = THIS FORK?
	JRST .+3		; YES, FORK IN 1 IS DESIRED FORK
	JUMPN C,CNDIRC
	ERR(FRKHX2)		; ATTEMPT TO MANIPULATE SUPERIOR
	PUSH P,A		; SAVE FORK TO FREEZE
	PUSH P,B		; SAVE FORKX OF FORK SPEC'D BY USER
	PUSH P,D
	NOINT			; PREVENT SUPERIORS FROM INTERFERING
	CALL FFORK1##		; FREEZE FORKS TO PREVENT POSSIBLE
	POP P,D			; RACES WITH CNDIRS, CFGRPS
	POP P,B
	SKIPGE FKDIR(B)
	HRRZ B,FKDIR(B)		; B=FORKX OF TOP FORK IN GROUP
	CAMN B,FORKX		; EXECUTING FORK=TOP FORK IN GROUP?
	JRST CNDIRD		; YES, TREAT AS ORDINARY CNDIR
	MOVSI A,-NUFKS		; FIND JOB FORK INDEX OF TOP FORK
	HRRZ C,SYSFK(A)		; IN GROUP
	CAIN B,0(C)
	JRST .+3
	AOBJN A,.-3
	JRST [	POP P,A		; Can't find fork
		CALL RFORK1	; RESUME FROZEN FORKS
		JRST CNDIRB ]	; ERROR RETURN
	TLZ A,-1		; FOR SKIIF CALL
	CALL SKIIF##		; IS TOP FORK INF TO EXECUTING FORK?
	JRST CNDIRD		; NO, TOP FORK OF GROUP SPEC'D BY USER
				; IS TOP OF EXECUTING FORK'S GROUP
	HRL B,A
	PUSH P,B		; 0(P)=JOB,,SYS INDEX TOP FORK IN GROUP
	MOVE B,FKDIR(B)		; -1(P)=JOB INDEX FORK FROZEN
	UMOVE A,1
	TLZ A,-1
	JRST CNDIR1

CNDIRD:	POP P,A			; A=INDEX OF FROZEN FORK
	PUSH P,D
	CALL RFORK1		; RESUME FROZEN FORKS
	POP P,D
CNDIRF:	TLZ D,(1B2)		; CLEAR B2 FUNCTION
	UMOVE A,1
	TLZ A,-1
	JRST CNDIR0		; RESUME AS ORDINARY CNDIR

; Determine access to a directory and/or file.

; Call:	1/	Flags,,Directory (target)
;		B0: Accept file protection in 2, return file access in 2
;		B1: Accept directory number in 3, do proxy GFACC
;	2/	File protection (numeric) if B0 of AC1 on.
;	3/	Directory number (source) if B1 of AC1 on.
;	GFACC
; Returns
;	+1	Error, error code in 1
;	+2	Success, directory access in 1, file access in 2 if
;		B0 of AC1 on in call

.GFACC::JSYS MENTR
	UMOVE E,1		; Get function bits and target dir
	TLNE E,(1B1)		; Proxy GFACC?
	JRST GFACC1		; Yes
	MOVE A,FORKX		; No, get fork number
	MOVE B,FKGRPS(A)	; Get group word if top of fork group
	SKIPGE A,FKDIR(A)	; Get conn,,login dir if top of fork grp
	JRST .-2		; Not top, FKDIR was fork# of top
	JRST GFACC2

; Doing proxy GFACC -- make sure privileged and find out for whom
GFACC1:	MOVE A,CAPENB		; Wheel or operator enabled?
	TRNN A,WHEEL+OPER
	 ERR(WHELX1)		; No, error
	UMOVE A,3		; User # for whom GFACC is being done
	PUSHJ P,GETDDB		; Get DDB for user
	  ERR(GFACX1)	; Not there
	MOVE B,DDBGRP(A)	; Ok, get groups of this user
	UMOVE A,3		; Get dir # again
	PUSHJ P,USTDIR##	; Unlock index

; Here with A/ connected,,login dir #'s of requestor,
;	    B/ user group membership word of requestor
GFACC2:	PUSH P,A		; Save requestor dir #
	PUSH P,B		; Save user group word
	HRRZ A,E		; Get target dir #
	PUSHJ P,HSHLUK		; Lookup in index
	  ERR(GFACX1,<PUSHJ P,USTDIR>)
	UNLOCK DIRLCK,,HIQ		; Unlock index but remain NOINT
	MOVE C,CAPENB
	TRNE C,WHEEL+OPER	; Wheel or operator?
	TLNE E,(1B1)		; And not doing proxy GFACC?
	JRST GFACC3		; No, do normal stuff
	MOVEI A,77		; Yes, return all access for directory
	MOVEI D,-^D18		; Set shift count to return file access
	JRST GFACC4		; Bypass directory lookup

; Here with A/ target directory number
GFACC3:	SETO B,			; Default disk unit arg
	PUSHJ P,MAPDIR		; Map the directory
	POP P,D			; Get back user group word of requestor
	AND D,DIRGRP		; Find common user and directory groups
	SKIPE D			; User belong to directory group?
	MOVEI D,-6		; Set to right-justify group protection
	POP P,A			; Restore requestor dir #(s)
	HLRZ B,A		; Connected dir if any
	HRRZS A
	CAME A,DIRNUM		; Checking access to own directory?
	CAMN B,DIRNUM		; Or to connected directory?
	MOVEI D,-^D12		; Yes, set to right-justify owner prot.
	MOVE A,DIRPRT		; Get directory protection word
	LSH A,(D)		; Right-justify appropriate field
	ANDI A,77

; Here with A/ directory access,
;	    D/ shift count for right-justifying protection field
GFACC4:	JUMPGE E,GFACC5		; Jump if not also checking file access
	UMOVE B,2		; Get protection word from caller
	TLC B,500000		; Only numeric protections allowed
	TLCE B,-1
	ERR(GFACX2)		; Illegal protection
	LSH B,(D)		; Ok, right-justify appropriate field
	ANDI B,77
	TRNE A,40		; Have access to target directory, and
	TRNN A,20		; Access to open files?
	SETZ B,			; No, return no access to file
	UMOVEM B,2		; Return file access bits
GFACC5:	UMOVEM A,1		; Return directory access bits
	JRST SKMRTN

	END ; OF LOGJS.MAC
