Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93j-bb - 7,6/ap022/react.x22
There are 2 other files named react.x22 in the archive. Click here to see a list.
TITLE	REACT - PROGRAM TO MANIPULATE THE ACCOUNTING FILE


;COPYRIGHT (C) 1973,1978,1979,1980,1981,1984,1985,1986,1987 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.  ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


; THANKS GIVEN TO C.MORRISON AT THE UNIVERSITY OF TENNESSEE FOR A COPY
; OF HIS EDACT, WHICH PROVIDED INSPIRATION, EXAMPLES.


; VERSION NUMBERS
	REAVER==33		;VERSION NUMBER
	REAMIN==2		;MINOR VERSION NUMBER
	REAEDT==243		;EDIT NUMBER
	REAWHO==0		;WHO EDITED LAST
	%%REAC==:<BYTE(3)REAWHO(9)REAVER(6)REAMIN(18)REAEDT>


	SEARCH	ACTPRM,ORNMAC
	MODULE	(REACT)

;THE OBLIGATORY .EXE FILE COPYRIGHT
COPYRIGHT (c) 1973,1987 DIGITAL EQUIPMENT CORPORATION. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
; LOOSE ENDS
REPEAT 0,<

	1. ASK FOR PSW ON CHANGES BY UNPRIV'ED USERS

	2. FIX UP PROCESSING OF DEFAULTED FIELDS.  FETCH DEFAULT PROFILE
		AND CALL A$PDEF.

	3. SUPPORT NEW SELECT FUNCTIONS .GE. AND .LE. .

	4. TEACH PURGE HOW TO ADD A SELECT BLOCK ON .AEEXP SO THAT WE
		DON'T GET (SO MANY) UNEXPIRED ENTRIES BACK FROM A$QWLD
		THAT WE JUST HAVE TO SKIP OVER.

	5. ADD A /FAST (AND QUIET) SWITCH TO PURGE AND DELETE THAT WILL
		PUT THE SELECT AND WILDCARD BLOCKS IN THE UGCUP$ LIST,
		THUS AVOIDING THE EXTRA IPCF PER DELETE, BUT AT THE
		EXPENSE OF LONGER ACTDAE PROCESSING TIME AND LESS
		INDICATION OF WHAT WENT WRONG ON ERRORS.  (OPTIONAL)

	6. DO PASSWORD DEFAULTING (MUST STUFF DEFAULT PPN [SALT] IN
		PROFILE).

	7. ADD AN UNPRIV'ED TYPEOUT FLAG TO CONTROL WHICH FIELDS GET
		DISPLAYED FOR UNPRIV'ED USERS.
>
;DEBUGGING AID:
;
;SINCE THE .QUPID WORD DOESN'T REALLY EXIST (TO BE .QUTIM+1, MAYBE, SOMEDAY),
;IF YOU DESIRE TO DEBUG REACT WITH A PRIVATE ACTDAE (TO AVOID HAVING TO USE
;THE REAL PROGRAM AND ACCOUNTING FILES, WHICH TENDS TO REQUIRE A STANDALONE
;SYSTEM), THE FOLLOWING MONITOR PATCH CAN BE APPLIED.  IT WORKS FINE FOR US
;AT THE TIME OF THIS RELEASE, BUT NO WARRANTY IS EXPRESSED OR IMPLIED ABOUT
;THE USE OF THIS PATCH IN A MONITOR.  THE '$' CHARACTER REPRESENTS ESCAPE,
;AND THE '^J' SEQUENCE AT THE END OF A LINE MEANS THAT A LINEFEED WAS TYPED
;RATHER THAN A CARRIAGE RETURN.


COMMENT	*

IPCSER$:

GLXINF/PAT$$<ADJSP P,1^J
PUSHJ P,GLXINF+1^J
CAIA^J
AOS -1(P)^J
ADJSP P,-1^J
POPJ P,$0>
GLXINF+24<GLXI90:GLXINF+34<GLXI91:GLXI90-1/JRST GLXI91
GLXI91-2/JRST CPOPJ1
GLXIN0-1/PAT$$<GLXI97:CAIGE P2,5^J
JRST GLXI96#^J
PUSHJ P,GETWR1^J
JRST ECOD4^J
MOVEM T1,-1(P)^J
JUMPN T1,GLXIN0^J
GLXI96:./HRRE T1,U^J
PUSHJ P,GLXI90^J
POPJ P,^J
SKIPN T1,(T1)^J
JRST ECOD5^J
MOVEM T1,-1(P)$1>
GLXI98+1/JRST GLXI97
GLXIN7+1/MOVEI T1,-1(P)
GLXINF+14/CAIG P2,5
$:

"">> TO KEEP MACRO HONEST"

*	;END OF DDT PATCH

;NOTE THAT THIS DDT PATCH APPLIES ONLY TO 7.03.  THIS ALLOWS THE QUEUE. UUO
;TO SEND TO A DEBUGGING PID RATHER THAN THE USUAL SYSTEM COMPONENT.  SEE
;THE REFERENCES TO .QUPID IN REACT AND A$QWLD FOR EXAMPLES OF USE.
SUBTTL	TABLE OF CONTENTS


SUBTTL	REVISION HISTORY

COMMENT	|

200	Rewrite everything. REACT 33(200) and above must be used with
	version 5 format of SYS:ACCT.SYS, now ACT:ACCT.ACT and ACTDAE
	version 2(100) and later. /TARL

201	Add support for context and pid quotas.
	12-Dec-84 /LWS

202	Add sub command mode for setting/clearing "TYPE of ACCESS". Add
	LIST command when in one of the sub command modes. Make sure password
	is set in account if specified by user.
	26-Jan-85 /LWS

203	Add "multiple PPN" insert code. Add code to generate random password.
	28-Jan-85 /LWS

204	Random bug fixes. Add "acks" when functions complete successfully
	so user knows what is going on.	Start fixing up UPDATE code.
	1-Feb-85 /LWS
 
205	Finish making UPDATE code work. Add LOCK/UNLOCK commands. Remove
	alot of IFDIEs, more still to go.
	13-Feb-85 /LWS

206	Add REQUIRE command. Random bug fixes, more clean up.
	7-Mar-85 /LWS

207	Fix device defaulting when specifying "program-to-run".
	5-Apr-85 /LWS

210	Insert support for "distribution box" and "personal name".
	RMS ACCT.ACT changes. /TL

211	Make UPDATE work with RMS. ACCT file is now SYS:ACTDAE.SYS in
	RMS format. Will we ever make up our minds? /LWS

212	Include password block in UG.ADD message. ACTDAE now knows how
	to deal with a password block and a profile block. Also,
	when doing INSERT FOO=BAR, clear .AEFLG, .AEFAI, .AELPC, and
	.AEPNM in FOO's new  profile.
	29-Apr-85 /LWS

213	Add new entry to PRTBTS, PRTBTX. If entered at PRTBTX,
	don't type "-none-" if no bits typed.
	QAR #868073 30-Apr-85 /LWS

214	Get rid of REEnter routine to set version. ACTRMS just needs
	to be loaded before REACT. Don't allow non-alpha to be 1st
	char of username. Allow trailing "]" to be omitted on INSERT
	command.
	13-May-85 /LWS

215	Correct size of FD blocks to be FDXSIZ instead of FDMSIZ.
	23-Jul-85 /DPM

216	Fix up SPOOL and WATCH bit comparison routines to use the correct
	AC when calling GENCMP.
	23-Jul-85 /DPM

217	Add new options to allow a site to prohibit a user from changing
	his password.  Note that the system administrator can always
	change the password.
	23-Jul-85 /DPM

220	Allow REACT to be run by anyone with administrative privs (JP.ADM).
	24-Jul-85 /DPM

221	Massive cleanup.
	10-Aug-85  /DPM

222	Give up on trying to clean the thing up.  Rewrite 95% of it.
	Major changes include:
	  1. Use of wildcarding facilites in ACTDAE.
	  2. A little consistancy in the command syntax.
	  3. Make CHANGE smarter (wildcards, etc.).
	  4. Add HELP command and internal on-line documentation.
	  5. Remove PRINT command (see LIST).
	  6. Give all sub-command modes the same common commands.
	  7. Do nice things with customer-defined commands and
	     profile entries.
	21-Aug-85  /DPM

223	Miscellaneous buggers.  UPDATE still doesn't work.
	 6-Sep-85  /DPM

224	Make UPDATE work.  Selective restore isn't implemented yet although
	the command will accept a wildcarded user-id.  Implement suggestion
	to change name of UPDATE command to VERIFY since the command syntax
	UPDATE/LIST-ONLY doesn't make a whole lot of sense.

225	Update to know about profile format version 6 and the corresponding
	changes to UGCUP$.
	19-Nov-85  /RCB

226	Fix some bugs in SELECT logic.
	24-Nov-85  /RCB

227	Correctly delete extensible blocks rather than truncating them to
	then to two words.  Add the PURGE command that works like the old
	REACT P command in days of old.  Fix off-by-one bug in mail address
	block length computation.
	 2-Dec-85  /DPM

230	Correct deficiencies with INSERT and CHANGE having to do with
	defaulting of profiles and detecting which entries we really did
	modify.
	17-Jan-86  /RCB

231	Fix some bugs with SELECT, wildcard changes, and changes to .AEPCT
	and .AEPRX.
	 7-Mar-86  /RCB

232	Fix up VERIFY for debugging.
	 7-Mar-86  /RCB

233	The special privilege fields (DSKPRI, HPQ, & OPR) could not be modified
	in isolation, since they didn't SETOM @CHGADR.  They do now.
	14-Mar-86  /RCB

234	Add routine PROFSP which will correctly detect null filespec blocks.
	Used by PRGGET routine (program to run).
	18-Aug-86  /DPM

235	Fix more SELECT logic for bit-masked fields.  If the bit mask shows that
	no keywords were typed, don't insert the change block.
	1-Dec-86  /RCB

236	Fix the automatic generation of passwords to finish the syllable rather
	than simply truncating at the requested length.  This way, maybe we can
	restore the original goal of a pronouncable password.
	1-Dec-86  /RCB

237	Change to use new STOPCD macro rather than old $STOP macro.
	2-Dec-86  /RCB

240	Fix bug with VERIFY where an account is missing from the master file at
	EOF.  While both files should probably have had [%,%] records, we still
	shouldn't loop trying to re-insert the last ppn that was in the file.
	Besides, we were using signed comparisons on what RMS considers to be
	unsigned keys, so even if both files had contained [%,%] records, we
	would only have done stupid things if there was a discrepancy with
	the last positive ppn.
	While we're at it, display the right profile when one is missing from
	the working file, and interpret the "NO" answer to "Preserve changes?"
	as meaning not to preserve the deletion.
	10-Feb-87  /RCB

241	Fix bug where short .AEAUX blocks (not even multiples of .AULEN) stay
	short ever after, even if we want to modify the bits of the last str.
	15-May-87  /RCB

242	Fix bug where a user's expiry date is printed incorrectly when
	attempting to delete the profile, and the date is non-infinite.
	18-Aug-87 /JJF SPR:35717

243	Correct problems with inserting PPNs with 1B18 turned on.
	 5-Jan-89  /DPM  (SPR 10-35597)

END REVISION HISTORY	|
SUBTTL	ASSEMBLY PARAMETERS



; ASSEMBLY PARAMETERS
	XP	PDLSIZ,400	;SIZE OF STACK
	XP	ACTFMT,6	;ACCOUNTING FILE FORMAT WE KNOW ABOUT
	XP	CATMAX,^D20	;CATALOG RESPONSE BLOCK LENGTH
	XP	DEFPSZ,^D6	;NUMBER OF CHARACTERS IN GENERATED PASSWORD
	XP	ZZTIME,^D60	;MAXIMUM TIME TO WAIT FOR QUEUE. UUO RESPONSE
	XP	DEFPCI,^D365	;MAXIMUM PASSWORD CHANGE INTERVAL
	XP	PTMHRS,1777B17	;PRIME TIME HOURS
				;WEEKDAYS 08-17
	  XP NPTHRS,<-1^!PTMHRS> ;NON-PRIME TIME HOURS
				;WEEKDAYS 00-07, 18-23; WEEKENDS 00-23
	XP	ALLPRV,-1	;DEFAULT PRIV WORD FOR ALL PRIVS
	XP	REMOPR,2	;REMOTE OPERATOR PROGRAMMER NUMBER
	XP	SYSPRJ,10	;PROJECT ALLOWED SYSTEM OPR PRIVS
	XP	HSTPRJ,30	;PROJECT ALLOWED HOST OPR PRIVS
	XP	GLXPRJ,50	;PROJECT NUMBER FOR GALACTIC WIZARDS
	XP	DEFQTA,^D1000	;DEFAULT QUOTA
	XP	STATBT,0	;DEFAULT STRUCTURE STATUS BITS
	SUBTTL	LOWSEG


	RELOC	0

PDL:	BLOCK	PDLSIZ		;STACK
UNPRIV::BLOCK	1		;NON-ZERO FOR UNPRIV'ED USERS
MONVER::BLOCK	1		;MONITOR VERSION
OLDMON::BLOCK	1		;MONVER INDICATES NO QUEUE. UUO TIMEOUT SUPPORT
FFAPPN::BLOCK	1		;[1,2]
MYPPN::	BLOCK	1		;GETPPN RESULT
ALTRBK::BLOCK	UW$MIN		;ALTERNATE WILDCARD BLOCK
ALTRAK::BLOCK	.AANLW		;ALTERNATE ACK TEXT
ALTRBP::BLOCK	1		;ALTERNATE BYTE POINTER TO ACK TEXT
ALTRPP::BLOCK	2		;ALTERNATE WILD PPN BASE
WILDBK::BLOCK	PAGSIZ		;WORKING WILDCARD BLOCK
WILDAK::BLOCK	.AANLW		;WORKING ACK TEXT
SELPTR:	BLOCK	1		;AOBJN POINTER TO SELCTION BLOCK

ZBEG:!

INSFLG:	BLOCK	1		;NON-ZERO IF DOING INSERT
SELFLG:	BLOCK	1		;NON-ZERO IF BUILDING SELECTION CRITERIA
SELFNC:	BLOCK	1		;SELECT FUNCTION
PARBUF:	BLOCK	PAGSIZ		;SCRATCH BLOCK FOR PARSER
PARBLK:	BLOCK	PAR.SZ		;PARSER BLOCK
HELPBF:	BLOCK	<^D80/5>+1	;TEMPORARY STORAGE FOR 80 CHARACTER HELP BANNER
LISTFL:	BLOCK	1		;LIST FLAG
LSTIFN:	BLOCK	1		;SAVED IFN FOR LIST FILE
PROARG:	BLOCK	2		;PROFILE COMMAND TABLE AND PROMPT
DEFUSR::BLOCK	5		;DEFAULT USER-ID STRING
DEFTX1::BLOCK	5		;DEFAULT TEXT STRING #1
DEFTX2::BLOCK	5		;DEFAULT TEXT STRING #2
DEFTX3::BLOCK	5		;DEFAULT TEXT STRING #3
PPNTXT:	BLOCK	4		;SCRATCH PAD STORAGE FOR ASCIZ PPN
STRNAM:	BLOCK	1		;STRUCTURE NAME FOR CATALOG
AUXBLK:	BLOCK	.AULEN		;AUXACC BLOCK FOR PARSER DEFAULTING
AUXPTR:	BLOCK	1		;AOBJN POINTER TO AUXBLK
AUXTMP:	BLOCK	.AUMAX+.AULEN	;[241] AUXACC STORAGE FOR ADD/REMOVE

WILDBP::BLOCK	1		;WORKING BYTE POINTER TO ACK TEXT
WILDPP::BLOCK	2		;WORKING WILD PPN BASE
DEFSRC:	BLOCK	1		;NON-ZERO IF DEFAULT PROFILE SEARCHING WANTED
DEFPPN:	BLOCK	1		;DEFAULT PPN FOUND FLAG
WLDINS:	BLOCK	1		;NON-ZERO IF WILDCARDED INSERT
PROFAI:	BLOCK	1		;COUNT OF PROCESSED PROFILE FAILURES
PROSUC:	BLOCK	1		;COUNT OF PROCESSED PROFILE SUCCESSES
QUEBLK:	BLOCK	.AEMAX		;GIVE ROOM FOR A PROFILE
  QUEBLN==.-QUEBLK		;UUO BLOCK LENGTH (FOR QINIT)
QUEPTR:	BLOCK	1		;AOBJN POINTER FOR FILLING QUEBLK
RSPBLK:	BLOCK	.AEMAX		;RESPONSE BLOCK
CATACK:	BLOCK	CATMAX		;CATALOG RESPONSE BLOCK
PMRINC:	BLOCK	1		;PROGRAMMER NUMBER INCREMENT FOR INSERT
PMRCNT:	BLOCK	1		;COUNT OF PPN'S TO GENERATE
PMRPRT:	BLOCK	1		;PROMPT FOR USER NAME FLAG ON WILD INSERT
PMRPSW:	BLOCK	1		;PROMPT FOR PASSWORD FLAG ON WILD INSERT
PMRPWD:	BLOCK	1		;DEFAULT PASSWORD IF NON-ZERO
DELASK:	BLOCK	1		;FLAG FOR CONFIRM ON DELETE
EXPDTM:	BLOCK	1		;EXPIRATION DATE/TIME FOR PURGE COMMAND
FDBLK::	BLOCK	FDXSIZ		;RANDOM FD FOR PROFILE ENTRY PROCESSING

SWTTAB:!			;SWITCH STORAGE TABLE
SWTASK:	BLOCK	1		;/ASK
SWTDET:	BLOCK	1		;/DETAIL /FAST
SWTCLR:	BLOCK	1		;/CLEAR
SWTRPT:	BLOCK	1		;/REPORT
SWTUPD:	BLOCK	1		;/UPDATE
SWTLEN==.-SWTTAB		;LENGTH OF TABLE

	FNASIZ==<<<6+1+6+1+3+1+6+1+6>+<5*<6+1>+1>>/5>+1
MASTFN:	BLOCK	FNASIZ		;MASTER FILE NAME
WORKFN:	BLOCK	FNASIZ		;WORKING FILE NAME
TEMPFN:	BLOCK	FNASIZ		;TEMPORARY FILE NAME
MASTFD:	BLOCK	FDXSIZ		;MASTER FILE NAME
WORKFD:	BLOCK	FDXSIZ		;WORKING FILE NAME
TEMPFD:	BLOCK	FDXSIZ		;TEMPORARY FILE NAME
MASTWB:	BLOCK	UW$MIN		;MASTER WILDCARD BLOCK
WORKWB:	BLOCK	UW$MIN		;WORKING FILE WILDCARD BLOCK
TEMPWB:	BLOCK	UW$MIN		;TEMPORARY FILE WILDCARD BLOCK
MASTEF:	BLOCK	1		;MASTER FILE EOF FLAG
WORKEF:	BLOCK	1		;WORKING FILE EOF FLAG
VERRFB:	BLOCK	FOB.SZ		;A FOB FOR READING
VERWFB:	BLOCK	FOB.SZ		;A FOB FOR WRITING
VERALL:	BLOCK	1		;NON-ZERO IF VERIFYING ALL PROFILES
VERDIF:	BLOCK	1		;NON-ZERO IF VERIFY ENCOUNTERED DIFFERENCES
VERABO:	BLOCK	1		;NON-ZERO IF VERIFY ABORTED

ZEND:!
ZSIZ==.-ZBEG

CMDPTR:	BLOCK	1		;ADDRESS OF COMMAND TABLE
CMDKEY:	BLOCK	PB%SIZ		;PARSER BLOCK (KEYWORDS)
CMDHLP:	BLOCK	PB%SIZ		;PARSER BLOCK (HELP)

ENTKPT::BLOCK	1		;ADDRESS OF PROFILE ENTRY TABLE
ENTHPT::BLOCK	1		;ADDRESS OF PROFILE HELP TABLE
ENTKEY::BLOCK	PB%SIZ		;PARSER BLOCK (KEYWORDS)
ENTDEF::BLOCK	PB%SIZ		;PARSER BLOCK ("DEFAULT")
ENTHLP::BLOCK	PB%SIZ		;PARSER BLOCK ("HELP")
ENTRST::BLOCK	PB%SIZ		;PARSER BLOCK ("RESTORE")
ENTSLC::BLOCK	PB%SIZ		;PARSER BLOCK ("SELECT")

CHGCTR::BLOCK	1		;CHANGE TABLE WORD COUNT
CHGPTR::BLOCK	1		;CHANGE TABLE ADDRESS
CHGADR::BLOCK	1		;CHANGE TABLE INDEX FOR CURRENT PROFILE ENTRY
CHGMSK::BLOCK	.AEMIN		;BLOCK OF CHANGE FLAGS
CHGMS2:	BLOCK	.AEMIN		;COPY OF CHGMSK DURING PROUPD
PRSDFV::BLOCK	1		;LOCATION TO TWEAK FOR CG.DFL CALLS

MAICNT:	BLOCK	1		;MAILING ADDRESS BYTE COUNT
MAIPTR:	BLOCK	1		;MAILING ADDRESS BYTE POINTER

TEMP:	BLOCK	.AEMAX		;TEMPORARY PROFILE STORAGE
USER:	BLOCK	.AEMAX		;CURRENT USER'S PROFILE
USER2:	BLOCK	.AEMAX		;DEFAULT USER'S PROFILE
USER0:	BLOCK	.AEMAX		;PROFILE TO SETUP .AEMAP CORRECTLY
PASSHD:	BLOCK	ARG.DA		;PARSER DATA BLOCK HEADER
PASSWD:	BLOCK	.APWLW		;PASSWORD
ROOT:	BLOCK	1		;RANDOM NUMBER GENERATOR SEED
RESPPN:	BLOCK	1		;RESERVED PROFILE BEING INSERTED
DEBUGQ:	BLOCK	1		;DON'T TIME OUT QUEUE. UUOS
ACTPID:	BLOCK	1		;PID TO STUFF INTO .QUPID WHEN DEBUGGING
QUETMP:	BLOCK	2		;BI-WORD FOR QUECHG TO INSERT MASKED VALUES
	RELOC			;BACK TO HISEG

PDLPTR:	IOWD PDLSIZ,PDL		;STACK POINTER

IB:	$BUILD	(IB.SZ)		;SIZE OF INIIALIZATION BLOCK
	  $SET	(IB.PRG,,%%.MOD);PROGRAM NAME
	  $SET	(IB.OUT,,OUTLST);TERMINAL OUTPUT
	  $SET	(IB.FLG,IT.OCT,1);REQUIRE COMMAND TERMINAL
	  $SET	(IB.FLG,IB.NPF,1);NO TIMER TRAPS!!!
	$EOB

LST:	$BUILD	(FOB.SZ)	;SIZE OF FILE OPEN BLOCK
	  $SET	(FOB.CW,FB.BSZ,7);BYTE SIZE IS ASCII
	$EOB			;END OF BLOCK

;FD's for current ACCT file and temp ACCT file for VERIFY command

CURFD:	$BUILD	(FDXSIZ)
	  $SET	(.FDLEN,FD.LEN,FDXSIZ)	;SIZE OF FD
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE FILESPEC
	  $SET	(.FDSTR,,SIXBIT\SYS\)	;"SYS:ACTDAE.SYS"
	  $SET	(.FDNAM,,SIXBIT\ACTDAE\)
	  $SET	(.FDEXT,,SIXBIT\SYS\)
	$EOB

TMPFD:	$BUILD	(FDXSIZ)
	  $SET	(.FDLEN,FD.LEN,FDXSIZ)	;SIZE OF FD
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE FILESPEC
	  $SET	(.FDSTR,,SIXBIT\DSK\)	;"DSK:REACT.TMP"
	  $SET	(.FDNAM,,SIXBIT\REACT\)
	  $SET	(.FDEXT,,SIXBIT\TMP\)
	$EOB


; USER NAME BREAK MASK
NAMBRK:	777777,,777760		;BREAK ON ALL CONTROL
	777554,,001750		;ALLOW * - ? AND 0-9
	400000,,000760		;ALLOW UC A-Z
	400000,,000760		;ALLOW LC A-Z

; PASSWORD BREAK MASK
PSWBRK:	777777,,777760		;BREAK ON ALL CONTROL
	000000,,000000		;ALLOW ALL PUNCTUATION AND DIGITS
	000000,,000000		;ALLOW UC A-Z
	000000,,000000		;ALLOW LC A-Z

; TEXT BREAK MASK FOR UNQUOTED STRINGS
TXTBRK:	777777,,777760		;BREAK ON ALL CONTROL
	777754,,001760		;ALLOW - AND 0-9
	400000,,000760		;ALLOW UC A-Z
	400000,,000760		;ALLOW LC A-Z
;SET TO DEFINE THE TABLE USED TO QUEUE THE CHANGES FOR ACTDAE

DEFINE	AE (NAM,LEN,BITS,RTN),<IFN <LEN>,<EXP .AE'NAM>>

QUETAB:	AEPROF
  QUETBL==.-QUETAB		;LENGTH OF TABLE

	PURGE	AE		;DUMP THE SYMBOL TABLE SPACE
;Tables describing the format of USER. Byte pointers defined where
;appropriate, offsets defined elsewhere.
;
;The use of these values is entirely voluntary, but highly recommended so
;as to provide a single place to change when fiddling with formats.

USRNAM:	POINT	8,.AENAM(U)	 ;INITIAL BPT TO USERNAME
USRNM2:	POINT	8,.AENAM(X)	 ;ALTERNATE NAME (USED DURING BACKUP)
CORPHY:	POINTR	.AECOR(U),AE.NPP ;PHYSICAL CORE LIMIT
CORVRT:	POINTR	.AECOR(U),AE.NVP ;VIRTUAL CORE LIMIT
IPCFS:	POINTR	.AEIPC(U),AE.SND ;IPCF SEND QUOTA
IPCFR:	POINTR	.AEIPC(U),AE.RCV ;     RECEIVE QUOTA
IPCFP:	POINTR	.AEIPC(U),AE.PID ;     MAXIMUM NUMBER OF PIDS
CTXCNQ:	POINTR	.AECTX(U),AE.CNQ ;MAXIMUM NUMBER OF CONTEXTS
CTXCPQ:	POINTR	.AECTX(U),AE.CPQ ;MAXIMUM NUMBER OF IDLE CONTEXT PAGES
SCHED:	POINTR	.AESCD(U),AE.SCD ;SCHEDULAR TYPE


NONE7::	ASCIZ	/-none-/
NONE8::	BYTE(8)	"-","n","o","n","e","-",0
SUBTTL	PROGRAM INITIALIZATION


	LOC	137
	EXP	<%%REAC==:%%REAC>
	RELOC


REACT:	JFCL			;NO CCL
	RESET			;CLEAR THE WORLD'S STATUS
	MOVE	P,PDLPTR	;GET POINTER TO PUSH DOWN LIST
	MOVEI	S1,IB.SZ	;SIZE OF IB
	MOVEI	S2,IB		;POINTER TO INITIALIZATION BLOCK
	PUSHJ	P,I%INIT##	;INITIALIZE GLXLIB
	MOVEI	S1,'REA'	;REACT PREFIX
	MOVEI	S2,0		;NO ERROR SUBROUTINE
	PUSHJ	P,A$ERRI##	;INIT ERROR PROCESSOR
	SETZB	S1,S2		;NO TIMER TRAPS
	PUSHJ	P,P$INIT##	;INITIALIZE PARSER
	MOVE	T1,[%CNDAE]	;GETTAB ARGUMENT
	GETTAB	T1,		;GET MONITOR VERSION
	  SETZ	T1,		;ANCIENT MONITOR
	HRRZS	T1		;STRIP OFF THE SIXBIT STUFF
	MOVEM	T1,MONVER	;SAVE MONITOR VERSION
	CAIGE	T1,703		;IS IT A MONITOR WITH QUEUE. UUO TIMEOUTS?
	SETOM	OLDMON		;NO, FLAG THE DEFICIENCY
	SETOM	UNPRIV		;ASSUME AN UNPRIVILEGED USER
	MOVE	T1,[%LDFFA]	;ARGS
	GETTAB	T1,		;GET FFA PPN
	  MOVE	T1,[1,,2]	;DEFAULT
	MOVEM	T1,FFAPPN	;SAVE FOR LATER PRIV TESTS
	HRROI	T2,.GTPPN	;ARGS
	GETTAB	T2,		;GET OUR PPN
	  SETZ	T2,		;???
	MOVEM	T2,MYPPN	;SAVE FOR LATER USE
	HRROI	T3,.GTPRV	;ARGS
	GETTAB	T3,		;GET OUR PRIV WORD
	  SETZ	T3,		;???
;	CAME	T1,T2		;FULL FILE ACCESS?
	TXNE	T3,JP.ADM	; OR ADMINISTRATIVE PRIVS?
	SETZM	UNPRIV		;ALLOW ACCESS TO PRIV'ED KEYWORDS
	PUSHJ	P,CMDINI	;INITIALIZE COMMAND TABLE
	PUSHJ	P,ENTINI	;INITIALIZE PROFILE ENTRY TABLE
	SETZM	USER0		;CLEAR A WORD
	MOVE	S1,[USER0,,USER0+1] ;TRANSFER WORD
	BLT	S1,USER0+.AEMAX-1	;CLEAR OUT PROTOTYPE PROFILE
	MOVX	S1,FLD(ACTFMT,AE.VRS)!FLD(.AEMIN,AE.LEN) ;GET OVERHEAD WORD
	MOVEM	S1,USER0+.AEVRS	;SET IT UP
	SETOM	USER0+.AEMAP	;START OFF WITH ALL DEFAULTS
	MOVE	S1,[USER0+.AEMAP,,USER0+.AEMAP+1]	;DITTO
	BLT	S1,USER0+.AEMAP+.AMPLW-1	;SMEAR SOME BITS
	MOVEI	T1,USER0	;POINT TO PROFILE TO USE
	MOVEI	T2,USER0	;SOURCE & DESTINATION
	PUSHJ	P,A$PDEF##	;MAKE THE BITS BE CONSISTENT WITH CHGTAB
	MOVEI	S1,SP.ACT	;ACTDAE'S SYSTEM PID INDEX
	$CALL	C%RPRM		;GET ITS PID
	MOVEM	S1,ACTPID	;SAVE FOR .QUPID
	PUSHJ	P,SELINI	;INITIALIZE SELECTION AOBJN POINTER
	JRST	MAIN		;GO ENTER TOP LEVEL COMMAND LOOP
CMDINI:	PUSHJ	P,.SAVE1	;SAVE P1
	HLRZ	S1,CMDDEC	;GET COUNT OF DEC-DEFINED COMMANDS
	HLRZ	S2,CMDCUS##	;GET COUNT OF CUSTOMER-DEFINED COMMANDS
	SKIPN	UNPRIV		;UNPRIV'ED USER?
	JRST	CMDIN1		;NO
	HLRZ	S1,CMDDUP	;GET COUNT OF DEC-DEFINED COMMANDS
	HLRZ	S2,CMDCUP##	;GET COUNT OF CUSTOMER-DEFINED COMMANDS

CMDIN1:	ADDI	S1,1(S2)	;TOTAL THEM UP
	PUSHJ	P,M%GMEM	;GET SOME CORE
	MOVEM	S2,CMDPTR	;SAVE FOR PARSING
	SUBI	S1,1		;DON'T COUNT THE OVERHEAD WORD
	MOVEM	S1,@CMDPTR	;SAVE WORD COUNT TOO
	MOVEI	P1,CMDDUP	;POINT TO DEC-DEFINED UNPRIV'ED TABLE
	SKIPN	UNPRIV		;TEST
	MOVEI	P1,CMDDEC	;POINT TO DEC-DEFINED PRIV'ED TABLE
	PUSHJ	P,CMDIN2	;LOAD WORKING COMMAND TABLE
	MOVEI	P1,CMDCUP##	;POINT TO CUSTOMER-DEFINED UNPRIV'ED TABLE
	SKIPN	UNPRIV		;TEST
	MOVEI	P1,CMDCUS##	;POINT TO CUSTOMER-DEFINED TABLE

CMDIN2:	HLRZ	S1,(P1)		;GET NUMBER OF ENTRIES IN TABLE
	JUMPE	S1,.RETT	;RETURN IF TABLE IS EMPTY
	MOVNS	S1		;NEGATE
	HRL	P1,S1		;GET -LENGTH
	HRRI	P1,1(P1)	;MAKE AN AOBJN POINTER

CMDIN3:	MOVE	S1,CMDPTR	;POINT TO TABLE HEADER
	MOVE	S2,(P1)		;GET KEYWORD ADDRESS
	PUSHJ	P,S%TBAD	;INSERT INTO TABLE
	SKIPT			;CHECK FOR ERRORS
	STOPCD	(CIF,HALT,,<Command table initialization failure>)
	AOBJN	P1,CMDIN3	;LOOP
	MOVE	S1,[CMDKBK,,CMDKEY] ;SET UP BLT
	BLT	S1,CMDKEY+PB%SIZ-1 ;COPY
	MOVE	S1,CMDPTR	;GET TABLE ADDRESS
	MOVEM	S1,CMDKEY+1+.CMDAT ;SAVE
	MOVE	S1,[CMDHBK,,CMDHLP] ;SET UP BLT
	BLT	S1,CMDHLP+PB%SIZ-1 ;COPY
	MOVE	S1,CMDPTR	;GET TABLE ADDRESS
	MOVEM	S1,CMDHLP+1+.CMDAT ;SAVE
	$RETT			;AND RETURN


; DUMMY PARSER DATA BLOCK FOR COMMANDS
CMDKBK:	$KEYDSP	(.)
	BLOCK	PB%SIZ-<.-CMDKBK>


; DUMMY PARSER DATA BLOCK FOR HELP
CMDHBK:	$KEY	(CONFRM,.,<$ALTER(CONFRM)>)
	BLOCK	PB%SIZ-<.-CMDHBK>
SUBTTL	COMMAND PROCESSING -- MAIN - TOP LEVEL DISPATCH


MAIN:	MOVE	P,PDLPTR	;GET STACK POINTER
	SETZM	ZBEG		;CLEAR A WORD
	MOVE	S1,[ZBEG,,ZBEG+1] ;XFER VECTOR
	BLT	S1,ZEND-1	;CLEAR THE ZEROABLE STORAGE
	MOVEI	S1,CMDTAB	;PARSER TABLE
	MOVEI	S2,[ASCIZ \REACT>\] ;PROMPT STRING
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	MAIN		;IF FAILS, TRY AGAIN
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,(S1)		;DISPATCH
	JRST	MAIN		;AND DO IT AGAIN
SUBTTL	COMMAND PROCESSING -- CMDDEC - DEC-DEFINED COMMAND TABLES


; PRIVILEGED ADMINISTRATIVE COMMANDS
CMDDEC:	$STAB
	DSPTAB	(      ,CTRLZ ,\"32,CM%INV)
	DSPTAB	(CHAN00,CHANGE,<CHANGE>)
	DSPTAB	(DELE00,DELETE,<DELETE>)
	DSPTAB	(EXIT00,EXIT  ,<EXIT>)
	DSPTAB	(HELP00,HELP  ,<HELP>)
	DSPTAB	(INSE00,INSERT,<INSERT>)
	DSPTAB	(LIST00,LIST  ,<LIST>)
	DSPTAB	(LOCK00,LOCK  ,<LOCK>)
	DSPTAB	(SELE00,SELECT,<SELECT>)
	DSPTAB	(SHOW00,SHOW  ,<SHOW>)
	DSPTAB	(PURG00,PURGE ,<PURGE>)
	DSPTAB	(LOCK00,UNLOCK,<UNLOCK>)
	DSPTAB	(VERI00,VERIFY,<VERIFY>)
	$ETAB


; UNPRIVILEGED USER COMMANDS
CMDDUP:	$STAB
	DSPTAB	(      ,CTRLZ ,\"32,CM%INV)
	DSPTAB	(CHAN00,CHANGE,<CHANGE>)
	DSPTAB	(EXIT00,EXIT  ,<EXIT>)
	DSPTAB	(HELP00,HELP  ,<HELP>)
	DSPTAB	(LIST00,LIST  ,<LIST>)
	DSPTAB	(SHOW00,SHOW  ,<SHOW>)
	$ETAB


; GENERIC USER-ID PARSER DATA BLOCKS
USR000::$INIT	(USR010)
USR010:	$NOISE	(USR020,<user-id>)
USR020:	$USER	(CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(USR030)>)
USR030:	$QUOTE	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(USR040)>)
USR040:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)


; ACTION ROUTINE CALLED TO DETERMINE IF USER THE THE OPERATOR
; AND SUPPLY THE APPROPRIATE DEFAULTS FOR A USER-ID
USRACT::DMOVE	S1,[ASCIZ /[*,*]/] ;ASSUME OPERATOR
	DMOVEM	S1,DEFUSR	;SAVE FOR PARSER
	MOVE	S2,MYPPN	;FETCH OUR PPN
	CAMN	S2,FFAPPN	;ARE WE THE OPERATOR?
	$RETT			;YES--DONE
	MOVEI	S1,[ITEXT (<[*,^O/S2,RHMASK/]>)] ;ASSUME INDPPN OFF
	MOVE	TF,[%CNSTS]	;GETTAB ARGUMENT
	GETTAB	TF,		;FETCH WORD
	  SETZ	TF,		;SICK MONITOR
	TXNE	TF,ST%IND	;INDPPN TURNED ON?
	MOVEI	S1,[ITEXT (<^U/S2/>)] ;YES
	$TEXT	(<-1,,DEFUSR>,<^I/(S1)/^0>) ;GENERATE DEFAULT STRING
	$RETT			;NO
CMDTAB:	$INIT	(CMDKEY,<$ACTION (USRACT)>)

CHAN00:	$NOISE	(CHAN01,<user-id>)
CHAN01:	$USER	(CONFRM,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(CHAN05)>)
CHAN05:	$QUOTE	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(CHAN10)>)
CHAN10:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)

DELE00:	$NOISE	(DELE01,<user-id>)
DELE01:	$USER	(DELE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(DELE05)>)
DELE05:	$QUOTE	(DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(DELE10)>)
DELE10:	$FIELD	(DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
DELE15:	$SWITCH	(CONFRM,DELE20,<$ALTER (CONFRM)>)
DELE20:	$STAB
	KEYTAB	(1,<ASK>)
	KEYTAB	(0,<NOASK>)
	$ETAB

CONFRM::!
EXIT00:	$CRLF

HELP00:	$NOISE	(CMDHLP,<with>)

INSE00:	$NOISE	(INSE01,<new user-id>)
INSE01:	$USER	(INSE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(INSE05)>)
INSE05:	$QUOTE	(INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE10)>)
INSE10:	$FIELD	(INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
INSE15:	$TOKEN	(INSE20,<=>,<$ALTER (CONFRM)>)
INSE20:	$USER	(CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(INSE25)>)
INSE25:	$QUOTE	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE30)>)
INSE30:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)

LIST00:	$NOISE	(LIST01,<user-id>)
LIST01:	$USER	(LIST15,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(LIST05)>)
LIST05:	$QUOTE	(LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(LIST10)>)
LIST10:	$FIELD	(LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
LIST15:	$NOISE	(LIST20,<to file>)
LIST20:	$OFILE	(LIST25,<listing filespec>,<$DEFAULT (<DSK:ACCT.LST>)>)
LIST25:	$SWITCH	(CONFRM,LIST30,<$ALTER (CONFRM)>)
LIST30:	$STAB
	KEYTAB	(0,<DETAIL>)
	KEYTAB	(1,<FAST>)
	$ETAB

LOCK00:	$NOISE	(CONFRM,<user account file>)

SELE00:	$NOISE	(SELE10,<profile criteria>)
SELE10:	$SWITCH	(CONFRM,SELE20,<$ALTER (CONFRM)>)
SELE20:	$STAB
	KEYTAB	(0,<CLEAR>)
	$ETAB

SHOW00:	$NOISE	(SHOW01,<user-id>)
SHOW01:	$USER	(LIST25,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(SHOW05)>)
SHOW05:	$QUOTE	(LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(SHOW10)>)
SHOW10:	$FIELD	(LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)

PURG00:	$NOISE	(PURG01,<user-id>)
PURG01:	$USER	(CONFRM,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(PURG05)>)
PURG05:	$QUOTE	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(PURG10)>)
PURG10:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)

VERI00:	$NOISE	(VERI05,<file from>)
VERI05:	$FILE	(VERI10,<master file>,$DEFAULT(<DSK:MASTER.SYS>))
VERI10:	$NOISE	(VERI15,<for users>)
VERI15:	$USER	(VERI30,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(VERI20),$DEFAULT(<[*,*]>)>)
VERI20:	$QUOTE	(VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(VERI25)>)
VERI25:	$FIELD	(VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
VERI30:	$SWITCH	(NEXT,VERI35,<$ACTION(SHRSWT),$ALTER(CONFRM)>)
VERI35:	$STAB
	KEYTAB	(<[0,,SWTRPT]>,<NOREPORT>)
	KEYTAB	(<[0,,SWTUPD]>,<NOUPDATE>)
	KEYTAB	(<[1,,SWTRPT]>,<REPORT>)
	KEYTAB	(<[1,,SWTUPD]>,<UPDATE>)
	$ETAB
SUBTTL	CHANGE COMMAND


	XWD	CHGHLP,[ASCIZ /Change profile entries/]
CHANGE:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,PROZCH	;CLEAR OUT CHANGE FLAG TABLE
	PUSHJ	P,PRSWLD	;PARSE A USER ID
	$RETIF			;IF NOT THERE, MERELY RETURN
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,WLDWCK	;CHECK FOR WILDCARDING
	JUMPF	CHANG1		;JUMP IF NOT
	MOVEI	X,USER2		;USER2 WILL CONTAIN THE CHANGED DATA
	MOVE	U,X		;SET UP WORKING PROFILE POINTER
	HLRE	S1,WILDBK+UW$PPM ;GET PROJECT MASK
	CAME	S1,[EXP -1]	;WILD?
	TDZA	S1,S1		;YES--USE SYSTEM DEFAULT PPN
	MOVE	S1,WILDBK+UW$PPN ;GET PPN
	MOVEM	S1,.AEPPN(U)	;STORE IN PROFILE
	SKIPN	UNPRIV		;DON'T DEFAULT PROFILE UNLESS PRIV'ED
	PUSHJ	P,PRODEF	;FETCH DEFAULT PROFILE
	MOVSI	S1,(U)		;GET ADDR
	HRRI	S1,1(U)		;MAKE A BLT POINTER
	SETZM	(U)		;CLEAR FIRST WORD
	BLT	S1,.AEMAX-1(U)	;CLEAR OUT BLOCK
	MOVE	S1,[ACTFMT,,.AEMIN]	;SETUP OVERHEAD WORD
	MOVEM	S1,.AEVRS(U)	;SO EXTENSIBLE BLOCKS WORK
	$TEXT	(,< Enter all data to be changed>)
	MOVEI	S1,ENT000	;COMMAND TABLES
	MOVEI	S2,[ASCIZ /USER>/] ;PROMPT
	SETOM	INSFLG		;ALL CHANGES ARE SIGNIFICANT HERE
	PUSHJ	P,PROFIL	;BUILD PROTOTYPE BLOCK
	SETZM	INSFLG		;NO LONGER DOING SOMETHING STRANGE
	$RETIF			;CHECK FOR ERRORS
	MOVEI	U,USER		;SET UP WORKING PROFILE POINTER

CHANG1:	PUSHJ	P,WLDUSR	;GET FIRST/NEXT POSSIBLY WILDCARDED USER
	JUMPF	CHANG5		;JUMP IF NO MORE PROFILES
	PUSHJ	P,WLDWCK	;CHECK FOR WILDCARDING
	JUMPT	CHANG2		;DON'T PROMPT FOR EACH PROFILE
	PUSHJ	P,PROZCH	;ZERO CHANGE TABLE
	MOVE	S1,[USER,,USER2] ;SET UP BLT
	BLT	S1,USER2+.AEMAX-1 ;COPY
	MOVEI	U,USER		;POINT TO BUFFER TO CHANGE
	MOVEI	X,USER2		;POINT TO ORIGINAL FOR "RESTORE"
	MOVEI	S1,ENT000	;COMMAND TABLES
	MOVEI	S2,[ASCIZ /USER>/] ;PROMPT
	PUSHJ	P,PROFIL	;PROCESS A SINGLE PROFILE
	$RETIF			;CHECK FOR ERRORS
	JRST	CHANG3		;GO PROCESS CHANGES

CHANG2:	PUSHJ	P,PROUPD	;UPDATE WORKING PROFILE
	$RETIF			;CHECK FOR ERRORS
	SETOM	INSFLG		;ALL CHANGES ARE REAL WHEN WILDCARDING

CHANG3:	PUSHJ	P,PROCHG	;PERFORM ALL CHANGES TO PROFILE
	SETZM	INSFLG		;NO LONGER DOING SOMETHING STRANGE
	JUMPF	CHANG4		;CHECK FOR ERRORS
	PUSH	P,S1		;SAVE COUNT OF CHANGES TO THIS PROFILE
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,S2		;GET COUNT BACK
	SKIPN	S2		;SOMETHING HAPPEN?
	WARN	(NCH,<No changes made to ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)
	$TEXT	(,< User ^T/(S1)/ ^Q/USRNAM/ changed>)
	AOS	PROSUC		;COUNT THE SUCCESS
	JRST	CHANG1		;LOOP FOR MORE

CHANG4:	AOS	PROFAI		;COUNT THE FAILURE
	PUSHJ	P,CVTPPD	;CONVERT PPN
	WARN	(CFU,<Change failed for ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)

CHANG5:	MOVEI	S1,[ASCIZ/changed/]
	PJRST	WLDSUM		;GO SUMMARIZE AND RETURN


CHGHLP:	ASCIZ	\
The CHANGE command enables you  to  enter  user  mode  and  modify  user
profiles.  The syntax is:  CHANGE user-id.
\
SUBTTL	DELETE COMMAND -- DELETE - ENTRY POINT


	XWD	DELHLP,[ASCIZ /Delete a profile/]
DELETE:	PUSHJ	P,PRSWLD	;PARSE A USER ID
	$RETIF			;RETURN ON ERRORS
	SETOM	DELASK		;DEFAULT TO /ASK
	PUSHJ	P,P$SWIT##	;CHECK FOR A SWITCH
	JUMPF	DELET1		;NOT YET
	CAIE	S1,0		;/NOASK?
	CAIN	S1,1		;/ASK?
	SKIPA			;YES TO EITHER
	FATAL	(IVS,<Invalid switch specified>)
	MOVEM	S1,DELASK	;SET FLAG ACCORDINGLY

DELET1:	PUSHJ	P,P$CFM##	;NEED EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS

DELET2:	PUSHJ	P,WLDUSR	;GET FIRST/NEXT POSSIBLY WILDCARDED USER
	JUMPF	DELET3		;DONE?
	MOVEI	U,USER		;POINT TO THE USER PROFILE
	PUSHJ	P,DELCHK	;CHECK PARANOIA LEVEL
	PJRST	@DELTAB(S1)	;YES, DISPATCH

DELET3:	MOVEI	S1,[ASCIZ /deleted/]
	PUSHJ	P,WLDSUM	;DISPLAY SUMMARY
	$RETT


DELTAB:	IFIW	DELET2		;"NO"
	IFIW	DELET3		;"QUIT"
	IFIW	DELSHO		;"SHOW"
	IFIW	DELPRO		;"YES"
DELMAX==.-DELTAB		;LENGTH OF TABLE
SUBTTL	DELETE COMMAND -- DELCHK - SEE IF OK TO DELETE PROFILE


DELCHK:	SKIPE	DELASK		;PARANOID?
	JRST	DELCH1		;YES
	MOVEI	S1,3		;SET INDEX FOR "YES"
	$RETT			;AND RETURN

DELCH1:	MOVEI	S2,[ITEXT (<^H/.AEEXP(U)/>)]
	MOVE	S1,.AEEXP(U)	;GET EXPIRATION DATE/TIME
	CAIN	S1,0		;SET?
	MOVEI	S2,[ITEXT (<not set>)]
	CAMN	S1,[-1]		;NEVER?
	MOVEI	S2,[ITEXT (<never>)]
	PUSH	P,S2		;SAVE ITEXT BLOCK ADDRESS
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,S2		;GET ITEXT BACK
	$TEXT	(,<User ^T/(S1)/ ^Q/USRNAM/, expiration date: ^I/(S2)/>)

DELCH2:	MOVEI	S1,DELU00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ /Are you sure? /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	DELCH2		;CHECK FOR ERRORS
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	DELCH2		;TRY AGAIN
	CAILE	S1,DELMAX	;RANGE CHECK RETURNED INDEX
	JRST	DELCH2		;STRANGE ...
	$RETT			;RETURN WITH ANSWER IN S1


DELU00:	$INIT	(DELU10)
DELU10: $KEYDSP (DELU20,<$DEFAULT (<YES>)>)
DELU20:	$STAB
	DSPTAB	(CONFRM,0,<NO>)
	DSPTAB	(CONFRM,1,<QUIT>)
	DSPTAB	(CONFRM,2,<SHOW>)
	DSPTAB	(CONFRM,3,<YES>)
	$ETAB
SUBTTL	DELETE COMMAND -- DELHLP - HELP TEXT


DELHLP:	ASCIZ	\
The DELETE command removes the specified  profile  from  the  accounting
file.  The syntax is:  DELETE user-id /switches.
\
SUBTTL	DELETE COMMAND -- MISCELLANEOUS


; DISPLAY PROFILE ("SHOW")
DELSHO:	PUSHJ	P,TYPUSR	;DISPLAY PROFILE
	PUSHJ	P,DELCH2	;ASK FOR CONFIRMATION AGAIN
	PJRST	@DELTAB(S1)	;DISPATCH IT AGAIN


; DELETE PROFILE ("YES")
DELPRO:	PUSHJ	P,CVTPPD	;CONVERT PPN
	PUSH	P,S1		;SAVE TEXT ADDRESS
	PUSHJ	P,DELUSR	;DELETE THIS PROFILE
	POP	P,S1		;GET PPN TEXT ADDRESS BACK
	JUMPF	DELPR1		;CHECK FOR ERRORS
	AOS	PROSUC		;COUNT THE SUCCESS
	$TEXT	(,< User ^T/(S1)/ ^Q/USRNAM/ deleted>)
	JRST	DELET2		;LOOP

DELPR1:	WARN	(DPF,<Delete of profile failed for ^T/(S1)/>)
	AOS	PROFAI		;COUNT THE FAILURE
	JRST	DELET2		;AND LOOP
SUBTTL	EXIT COMMAND


	XWD	CTZHLP,[ASCIZ /Exit program/]
CTRLZ:	PJRST	EXIT		;SAME AS EXIT COMMAND


CTZHLP:	ASCIZ	\
Control-Z (^Z) is the same as the EXIT  command.   It  stops  the  REACT
program and returns you to monitor command level.
\


	XWD	EXIHLP,[ASCIZ /Exit program/]
EXIT:	MONRT.			;EXIT
	JRST	REACT		;THE FOOL TYPED CONTINUE


EXIHLP:	ASCIZ	\
The EXIT command stops the REACT program  and  returns  you  to  monitor
command level.
\
SUBTTL	HELP COMMAND -- ENTRY POINT


	XWD	HLPHLP,[ASCIZ /Gives information on commands/]
HELP:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	SETZ	P1,		;ASSUME QUICK HELP WANTED
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	SKIPF			;CHECK FOR ERRORS
	MOVE	P1,S1		;COPY DISPATCH ADDRESS
	PUSHJ	P,P$CFM##	;GET CRLF
	JUMPF	HLPERR		;CHECK FOR ERRORS
	JUMPN	P1,HLPCMD	;JUMP IF HELP DESIRED ON A COMMAND
	$TEXT	(<-1,,HELPBF>,<Help for REACT %^V/.JBVER/^0>)
	$TEXT	(,<^T72C /HELPBF/^M^J>)
	MOVE	P1,CMDPTR	;POINT TO WORKING COPY OF COMMAND TABLE
	HLRZ	P2,(P1)		;GET NUMBER OF WORDS IN THE TABLE
	MOVNS	P2		;NEGATE
	HRLZS	P2		;PUT IN LH
	HRRI	P2,1(P1)	;MAKE AN AOBJN POINTER

HELP1:	HLRZ	S1,(P2)		;GET A KEYWORD
	SKIPE	S2,(S1)		;MUST CHECK
	TLNE	S2,(177B6)	;FIRST CHARACTER ZERO AND WORD NOT ALL ZERO?
	TDZA	S2,S2		;NO--MAKE FLAGS ALL ZERO
	HLRZ	S1,1(P1)	;ADJUST TEXT POINTER
	TXNE	S2,CM%NOR!CM%INV ;TEST FLAGS
	JRST	HELP2		;PROBABLY A POINTER OR INVISIBLE
	HRRZ	S2,(P2)		;GET POINTER TO DISPATCH ADDRESS
	HLRZ	S2,(S2)		;GET DISPATCH ADDRESS
	HRRZ	S2,-1(S2)	;GET ONE-LINE HELP TEXT ADDRESS
	$TEXT	(,<^T12L /(S1)/  ^T/(S2)/>)

HELP2:	AOBJN	P2,HELP1	;LOOP THROUGH THE TABLE
	$RETT			;YES--ALL DONE
SUBTTL	HELP COMMAND -- HLPCMD - GIVE HELP FOR A COMMAND


HLPCMD:	MOVE	P2,CMDPTR	;POINT TO WORKING COPY OF COMMAND TABLE
	HLRZ	S1,(P2)		;GET NUMBER OF WORDS IN THE TABLE
	MOVNS	S1		;NEGATE
	HRLZS	S1		;PUT IN LH
	HRRI	S1,1(P2)	;MAKE AN AOBJN POINTER

HLPCM1:	HRRZ	S2,(S1)		;GET A POINTER
	CAME	S2,P1		;MATCH?
	AOBJN	S1,HLPCM1	;LOOP
	JUMPGE	S1,HLPERR	;POINTER RUN OUT?

HLPCM2:	HLRZ	S1,(S1)		;GET ADDRESS OF COMMAND NAME
	HLRZ	S2,(P1)		;GET DISPATCH ADDRESS
	HLRZ	S2,-1(S2)	;AND THE TEXT BLOCK ADDRESS
	$TEXT	(<-1,,HELPBF>,<Help for REACT %^V/.JBVER/ - ^T/(S1)/^0>)
	$TEXT	(,<^T72C /HELPBF/^M^J^T/(S2)/>)
	$RETT			;RETURN
SUBTTL	HELP COMMAND -- HLPERR - ERROR PROCESSING


; HERE WHEN NO HELP IS AVAILABLE.  THIS SITUATION SHOULD NEVER ARISE.
; IF IT DOES, IT INDICATES SOME SORT OF INTERNAL COMMAND PARSING
; PROBLEM EXISTS.  SINCE THE LACK OF HELP TEXT IS HARDLY FATAL, WE'LL
; JUST SPIT OUT A WARNING AND GO AWAY RATHER THAN JUMP OFF TO PRSERR.

HLPERR:	WARN	(NIO,<No information available on the specified topic>,,.RETT)
SUBTTL	HELP COMMAND -- HLPHLP - HELP TEXT


HLPHLP:	ASCIZ	\
The HELP command enables you to obtain  information  about  REACT.   The
valid  keywords  are  any  REACT  command name.  If you do not specify a
command name REACT displays a brief listing of each REACT command on the
terminal.
\
SUBTTL	INSERT COMMAND -- INSERT - ENTRY POINT


	XWD	INSHLP,[ASCIZ /Insert a profile into the accounting file/]
INSERT:	MOVEI	U,USER2		;POINT TO PROTOTYPE PROFILE BLOCK
	PUSHJ	P,PROZPB	;CLEAR IT
	MOVEI	U,USER		;POINT TO WORKING PROFILE BLOCK
	PUSHJ	P,PROZPB	;CLEAR IT
	MOVEI	X,USER2		;SET POINTER TO PROTOTYPE
	SETOM	DEFSRC		;SEARCH FOR DEFAULT PROFILE
	SETOM	DEFPPN		;INIT DEFAULT PPN FLAG
	PUSHJ	P,INSPRS	;PARSE ALL ARGUMENTS
	$RETIF			;CHECK FOR ERRORS

INSER1:	MOVE	S1,WILDBK+UW$PPN ;GET PPN
	MOVEM	S1,.AEPPN(X)	;SAVE IN PROTOTYPE
	PUSHJ	P,INSWLD	;GATHER UP ALL WILDCARD PARAMETERS
	$RETIF			;GIVE UP IF USER ABORTED INSERT
	EXCH	U,X		;SWAP PROFILE POINTERS
	PUSHJ	P,PROCLR	;CLEAR USER SPECIFIC DATA
	EXCH	U,X		;RESTORE PROFILE POINTERS

INSER2:	SETZM	INSFLG		;NOT INSERTING YET (FOR COMPAR)
	PUSHJ	P,INSPPN	;ASK FOR PPN IF NEEDED
	$RETIF			;USER ABORTED INSERT
	PUSHJ	P,INSNAM	;ASK FOR A NAME IF NEEDED
	$RETIF			;USER ABORTED INSERT
	PUSHJ	P,INSPSW	;ASK FOR OR GENERATE A PASSWORD
	$RETIF			;USER ABORTED INSERT
	MOVSI	S1,(X)		;POINT TO PROTOTYPE
	HRRI	S1,(U)		;AND TO WORKING COPY
	BLT	S1,.AEMAX-1(U)	;COPY
	SKIPE	WLDINS		;WILDCARDED INSERT?
	JRST	INSER3		;YES--JUST UPDATE WHAT WE HAVE NOW
	MOVEI	S1,ENT000	;COMMAND TABLES
	MOVEI	S2,[ASCIZ /USER>/] ;PROMPT
	PUSHJ	P,PROFIL	;PROCESS A SINGLE PROFILE
	$RETIF			;CHECK FOR ERRORS

INSER3:	SETOM	INSFLG		;GOING TO INSERT NOW
	PUSHJ	P,CVTPPD	;CONVERT PPN
	PUSH	P,S1		;SAVE TEXT POINTER
	PUSHJ	P,INSQUE	;GO DO THE QUEUE. UUO
	POP	P,S1		;RESTORE PPN TEXT ADDRESS
	JUMPF	INSER4		;JUMP IF FAILED
	MOVEI	T1,[ITEXT (<password ^Q/T2/>)]
	MOVE	T2,[POINT 8,PASSWD] ;BYTE POINTER TO PASSWORD
	SKIPE	PMRPWD		;PASSWORD DEFAULTED?
	MOVEI	T1,[ITEXT (<default password>)]
	$TEXT	(,< User ^T/(S1)/ ^Q/USRNAM/ inserted with ^I/(T1)/>)
	AOS	PROSUC		;COUNT THE SUCCESS
	JRST	INSER5		;ONWARD

INSER4:	FATAL	(INF,<Insert failed for user ^T/(S1)/ ^Q/USRNAM/>,,.+1)
	AOS	PROFAI		;COUNT THE FAILURE

INSER5:	AOS	WILDBK+UW$FND	;COMPENSATE FOR SUMMARY NONSENSE
	MOVEI	S1,[ASCIZ /inserted/]
	SOSG	PMRCNT		;ANY MORE TO DO?
	PJRST	WLDSUM		;DISPLAY SUMMARY AND RETURN
	MOVE	S2,PMRINC	;GET PROGRAMMER INCREMENT
	ADD	S2,.AEPPN(X)	;ADVANCE TO NEXT PPN
	TRNE	S2,400000	;MAKE SURE WE'RE GENERATING A VALID PPN
	WARN	(PNO,<Project number overflow; insertion terminated>,,WLDSUM)
	MOVEM	S2,.AEPPN(X)	;UPDATE
	SETZM	.AENAM(X)	;ZAP THE NAME SO A NEW ONE WILL DEFAULT
	JRST	INSER2		;LOOP BACK
SUBTTL	INSERT COMMAND -- INSQUE - INSERT THE PROFILE

;CALL:
;	U/ PROFILE POINTER

INSQUE:	PUSHJ	P,.SAVE4	;PRESERVE SOME ACS
	PUSHJ	P,QINITA	;SETUP TO ADD AN ENTRY
	MOVX	P4,PD.NMD	;NO-MODIFY BIT
	MOVSI	P3,-QUETBL	;AOBJN POINTER

INSQ.1:	MOVE	S1,QUETAB(P3)	;GET NEXT PROFILE OFFSET
	TDNE	P4,CHGTAB##(S1)	;CAN IT BE MODIFIED?
	JRST	INSQ.3		;NO, SO DON'T
	CAIN	S1,.AEPSW	;IF THE PASSWORD,
	JRST	INSQ.3		;WAIT UNTIL LATER (IT'S IN A DIFFERENT BLOCK)
	CAIE	S1,.AENAM	;IS IT THE NAME?
	JRST	INSQ.2		;NO, DON'T SECOND-GUESS IT
	MOVX	S2,AE.NCH	;NAME-CHANGE BIT
	TDNN	S2,.AEFLG(U)	;IF WE THINK IT SHOULD BE ON,
	SKIPE	RESPPN		;OR IF ACTDAE ALREADY KNOWS THE NAME,
	JRST	INSQ.3		;THEN DON'T SEND A NAME

INSQ.2:	PUSHJ	P,QUECHG	;INSERT QUANTITY INTO THE UUO LIST
	JUMPF	INSQ.4		;HOPE THIS WORKED

INSQ.3:	AOBJN	P3,INSQ.1	;LOOP OVER ALL AVAILABLE PROFILE OFFSETS
	DMOVE	P1,[EXP .AEPSW,<.APWLW,,PASSWD>] ;PASSWORD BLOCK
	PUSHJ	P,QUEINS	;STUFF INTO THE BLOCK
	JUMPF	INSQ.4		;HOPE IT WORKED
	PJRST	QUEUUO		;DO THE UUO AND RETURN THE PROGNOSIS

INSQ.4:	WARN	(ROS,<Ran out of space trying to build the INSERT list>,,.RETF)
SUBTTL	INSERT COMMAND -- INSHLP - HELP TEXT


INSHLP:	ASCIZ	\
The INSERT command enables you to enter user mode and  create  new  user
profiles.  You can supply an optional existing user-id to use as a model
for the new profile.  The syntax is:

	INSERT new-user-id [=existing-user-id]

If  you  omit  the existing-user-id, REACT looks for the default profile
for the project.  If a default project profile  does  not  exist,  REACT
looks for the default profile for the system.
\
SUBTTL	INSERT COMMAND -- INSNAM - NAME PARAMETER


INSNAM:	SKIPE	WILDBK+UW$WST	;IS A NAME NEEDED?
	JRST	INSNA2		;NO
	MOVE	S1,.AEPPN(X)	;GET NEW PPN
	PUSHJ	P,A$CKPP##	;CHECK IF IT'S RESERVED
	JUMPT	INSNA1		;NO, MUST ASK FOR NAME
	$TEXT	(<POINT 8,.AENAM(X),-1>,<^T/(S1)/^0>)
	JRST	INSNA4		;GOT OUR NAME

INSNA1:	SKIPN	PMRPRT		;PROMPT FOR NAME?
	JRST	INSNA2		;NO
	MOVEI	S1,USR000	;COMMAND TABLE
	MOVEI	S2,[ASCIZ /New user name: /]
	PUSHJ	P,PRSCMD	;SCAN A COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,PRSALT	;PARSE A USER-ID
	JUMPF	INSNA1		;TRY AGAIN
	SKIPN	ALTRBK+UW$WST	;WAS A NAME GIVEN?
	WARN	(PGN,<PPN given when a name requested; ^Q/ALTRBP/>,,INSNA1)
	SKIPN	ALTRBK+UW$NAM	;NAME MUST BE NON-ZERO
	JRST	INSNA1		;TRY AGAIN
	PUSHJ	P,WLDACK	;CHECK FOR WILDCARDING
	SKIPF			;SKIP IF NOT
	WARN	(WNI,<Wildcarded name illegal; ^Q/ALTRBP/>,,INSNAM)
	MOVSI	S1,ALTRBK+UW$NAM ;POINT TO NAME JUST PARSED
	HRRI	S1,.AENAM(X)	;AND TO WORKING PROFILE BLOCK
	BLT	S1,.AENAM+.AANLW-1(X) ;COPY
	MOVSI	S1,ALTRBK+UW$NAM ;PONT TO NAME AGAIN
	HRRI	S1,WILDBK+UW$NAM ;AND TO WORKING BLOCK
	BLT	S1,WILDBK+UW$NAM+.AANLW-1 ;COPY

INSNA2:	MOVEI	S1,.AENAM(X)	;POINT TO NAME
	PUSHJ	P,A$CKNM##	;CHECK IT FOR LEGALITY
	JUMPT	INSNA5		;IT'S NOT RESERVED
	CAMN	S1,.AEPPN(X)	;DID INSPPN AGREE WITH THIS?
	JRST	INSNA5		;YES
	MOVEI	S1,.AENAM(X)	;POINT TO NAME AGAIN
	HRLI	S1,(POINT 8,)	;IN CASE OF ERROR
	WARN	(RNI,<Reserved name illegal; ^Q/S1/>,,INSNA3)

INSNA5:	MOVEI	S1,.AENAM(X)	;POINT TO TARGET NAME
	MOVEI	S2,TEMP		;WHERE TO STORE PROFILE
	PUSHJ	P,QUSRIN	;SEE IF THIS PPN EXISTS
	JUMPF	INSNA4		;NO--ALMOST DONE
	PUSH	P,U		;SAVE U
	MOVEI	U,TEMP		;POINT TO TEMPORARY PROFILE BLOCK
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,U		;RESTORE U
	MOVEI	S2,TEMP+.AENAM	;POINT TO NAME
	HRLI	S2,(POINT 8,)	;MAKE A BYTE POINTER
	WARN	(NAE,<Name ^Q/S2/ is already taken by ^T/(S1)/>)

INSNA3:	SKIPE	PMRPRT		;PROMPT FOR NAME?
	SKIPE	WILDBK+UW$WST	;WAS A NAME NEEDED?
	$RETF			;NO--GIVE UP
	JRST	INSNA1		;ELSE TRY AGAIN

INSNA4:	MOVE	S1,NAM+CG.IDX	;GET NAME INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	SETOM	@S1		;MARK NAME AS "CHANGED"
	SETOM	CHGMSK+.AENAM	;IN BOTH PLACES
	$RETT			;RETURN
SUBTTL	INSERT COMMAND -- INSPPN - PPN PARAMETER


INSPPN:	SETZM	RESPPN		;ASSUME NOT RESERVED
	SKIPN	WILDBK+UW$WST	;IS A PPN NEEDED?
	JRST	INSPP3		;NO
	MOVEI	S1,.AENAM(X)	;YES, POINT TO NAME THAT USER TYPED
	PUSHJ	P,A$CKNM##	;SEE IF IT IS RESERVED
	JUMPT	INSPP1		;NO, DON'T SET A PPN FROM IT
	MOVEM	S1,.AEPPN(X)	;YES, SET ITS PPN
	SETOM	RESPPN		;REMEMBER THAT IT'S RESERVED
	JRST	INSPP3		;AND DON'T ASK

INSPP1:	MOVEI	S1,USR000	;COMMAND TABLE
	MOVEI	S2,[ASCIZ /New user PPN: /]
	PUSHJ	P,PRSCMD	;SCAN A COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,PRSALT	;PARSE A USER-ID
	JUMPF	INSPP1		;TRY AGAIN
	SKIPN	ALTRBK+UW$WST	;MUST BE A PPN
	JRST	INSPP2		;GOT ONE
	SKIPE	ALTRBK+UW$NAM	;IS NAME REALLY BLANK?
	WARN	(NGP,<Name given when a PPN requested; ^Q/ALTRBP/>)
	JRST	INSPP1		;TRY AGAIN

INSPP2:	PUSHJ	P,WLDACK	;CHECK FOR WILDCARDING
	SKIPF			;SKIP IF NOT
	WARN	(WPI,<Wildarded PPN illegal; ^Q/ALTRBP/>,,INSPPN)
	MOVE	S1,ALTRBK+UW$PPN ;GET PPN
	MOVEM	S1,WILDBK+UW$PPN ;SAVE IN WORKING BLOCK
	MOVEM	S1,.AEPPN(X)	;SAVE IN PROFILE

INSPP3:	MOVE	S1,.AEPPN(X)	;GET TARGET PPN
	MOVEM	S1,WILDBK+UW$PPN ;SAVE FOR DISPLAY
	SETOM	WILDBK+UW$PPM	;NOT WILDCARDED
	MOVEI	S2,TEMP		;WHERE TO STORE PROFILE
	PUSHJ	P,QPPNIN	;SEE IF THIS PPN EXISTS
	JUMPF	INSPP4		;PPN SHOULD NOT EXIST
	HRRZ	S1,.AEPPN(X)	;GET TARGET PROGRAMMER NUMBER
	HRRZ	S2,TEMP+.AEPPN	;AND RETURNED PROGRAMMER NUMBER
	TRNE	S1,1B18		;POSSIBLY A UNIQUE PPN?
	CAIN	S1,(S2)		;WAS GENERIC ANSWER RETURNED (10,#)?
	CAIA			;THEN TRYING TO INSERT DUPLICATE PPN
	JRST	INSPP4		;ATTEMPT INSERTION
	PUSH	P,U		;SAVE U
	MOVEI	U,TEMP		;POINT TO TEMPORARY PROFILE BLOCK
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,U		;RESTORE U
	MOVEI	S2,TEMP+.AENAM	;POINT TO NAME
	HRLI	S2,(POINT 8,)	;MAKE A BYTE POINTER
	FATAL	(PAE,<PPN ^T/(S1)/ is already taken by ^Q/S2/>,,.RETF)

INSPP4:	SKIPE	WILDBK+UW$WST	;HAVE A NAME?
	JRST	INSPP5		;YES
	EXCH	U,X		;SWAP PROFILE POINTERS
	PUSHJ	P,PRONAM	;DEFAULT NAME
	EXCH	U,X		;RESTORE PROFILE POINTERS

INSPP5:	AOSN	DEFPPN		;BEEN HERE BEFORE?
	SKIPE	.AETIM(X)	;HAVE A PROFILE FOR INPUT?
	$RETT			;YES--DONE
	MOVE	S1,.AEPPN(X)	;GET OUR PPN
	MOVEM	S1,.AEPPN(U)	;SET FOR PRODEF
	PUSHJ	P,PRODEF	;FETCH DEFAULT PROFILE
	MOVEI	T1,(X)		;USER PROFILE
	MOVEI	T2,(U)		;DEFAULT PROFILE
	PUSHJ	P,A$PDEF##	;APPLY THE DEFAULTS
	MOVSI	S1,(X)		;SOURCE
	HRRI	S1,(U)		;WORKING BLOCK
	BLT	S1,.AEMAX-1(U)	;COPY FOR CHANGES
	$RETT			;RETURN
SUBTTL	INSERT COMMAND -- INSPRS - PARSE ALL ARGUMENTS


INSPRS:	PUSHJ	P,PRSWLD	;PARSE A PPN OR NAME
	$RETIF			;CHECK FOR ERRORS
	PUSHJ	P,WLDWCK	;CHECK FOR WILDCARDING
	SKIPF			;SKIP IF NOT
	SETOM	WLDINS		;YES--REMEMBER FOR LATER
	PUSHJ	P,P$CFM##	;EOL?
	JUMPT	INSPR1		;YES
	PUSHJ	P,P$TOK##	;GET "="
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVSI	S2,(ASCIZ/=/)	;MUST BE AN EQUALS SIGN
	CAME	S2,ARG.DA(S1)	;CHECK IT
	JRST	PRSERR		;NO GOOD
	PUSHJ	P,PRSALT	;PARSE A PPN OR NAME
	$RETIF			;CHECK FOR ERRORS
	PUSHJ	P,WLDACK	;CHECK FOR WILDCARDING
	SKIPF			;SKIP IF NOT
	FATAL	(WIU,<Wildcarded input user-id illegal; ^Q/ALTRBP/>)
	PUSHJ	P,ALTUSR	;FETCH INPUT PROFILE
	JUMPF	WLDSUM		;GO REPORT ERROR AND RETURN
	MOVSI	S1,(U)		;POINT TO DEFAULT PROFILE
	HRRI	S1,(X)		;ADDRESS OF PROTOTYPE BLOCK
	BLT	S1,.AEMAX-1(X)	;SET UP PROTOTYPE

INSPR1:	MOVE	S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
	JUMPN	S1,INSPR2	;JUMP IF A NAME
	HLRE	S2,WILDBK+UW$PPM
	CAME	S2,[EXP -1]	;YES--WILD PROJECT NUMBER?
	FATAL	(WPI,<Wildcarded project number illegal on insert; ^Q/WILDBP/>)
	MOVE	S1,WILDBK+UW$PPN ;GET PPN
	MOVEM	S1,.AEPPN(X)	;SAVE IN PROTOTYPE PROFILE BLOCK
	$RETT			;RETURN

INSPR2:	CAIN	S1,1		;WILD NAME?
	FATAL	(WNI,<Wildcarded name illegal on insert; ^Q/WILDBP/>)
	MOVSI	S1,WILDBK+UW$NAM ;POINT TO NAME
	HRRI	S1,.AENAM(X)	;AND TO PROTOTYPE STORAGE
	BLT	S1,.AENAM+.AANLW-1(X) ;COPY
	$RETT			;RETURN
SUBTTL	INSERT COMMAND -- INSPSW - PASSWORD PARAMETER


INSPSW:	SKIPN	PMRPSW		;PROMPT FOR PASSWORD?
	JRST	INSPS1		;NO
	MOVEI	S1,PASS00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ /Password: /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	INSPSW		;TRY AGAIN
	PUSHJ	P,PSWGET	;PARSE A PASSWORD
	$RETT			;RETURN

INSPS1:	SKIPE	PMRPWD		;DEFAULTING PASSWORD?
	JRST	INSPS2		;YES
	PUSHJ	P,PROPSW	;GENERATE A PASSWORD
	SETOM	.AEPCT(X)	;FORCE A PASSWORD CHANGE ON FIRST LOGIN
	MOVX	S1,DF.PCT	;DEFAULT BIT FOR THIS FIELD
	ANDCAM	S1,DF$PCT(X)	;MAKE SURE WE SEND OUR VALUE
	$RETT			;RETURN

INSPS2:	MOVX	S1,DF.PCT	;DEFAULT BIT FOR THIS FIELD
	IORM	S1,DF$PCT(X)	;FORCE FIELD DEFAULTING
	PJRST	PSWDFL		;DEFAULT PASSWORD FIELD AND RETURN
SUBTTL	INSERT COMMAND -- INSWLD - WILDCARD PARAMETER PARSING


INSWLD:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	S1,.AEPPN(X)	;GET INITIAL PPN
	TRNN	S1,-1		;ZERO?
	HRRI	S1,1		;BE MORE REALISTIC
	MOVEM	S1,.AEPPN(X)	;UPDATE
	MOVEI	S1,1		;NICE SMALL NUMBER
	MOVEM	S1,PMRINC	;DEFAULT INCREMENT
	MOVEM	S1,PMRCNT	;DEFAULT COUNT
	SETOM	PMRPRT		;DEFAULT TO PROMPTING FOR NAME
	SKIPL	WLDINS		;DOING WILD INSERT?
	JRST	INSWL6		;GO CHECK OUT PASSWORD DEFAULTING

INSWL1:	MOVEI	S1,PGMR00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Base programmer number: /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,P$NUM##	;FETCH A NUMBER
	JUMPF	INSWL1		;TRY AGAIN
	SKIPLE	S1		;RANGE
	CAILE	S1,377777	; CHECK
	WARN	(BOR,<Base programmer number out of range 1 to 377777>,,INSWL1)
	HRRM	S1,.AEPPN(X)	;SAVE IT
	MOVEI	P1,377777	;GET MAXIMUM PROGRAMMER NUMBER
	SUBI	P1,(S1)		;COMPUTE NUMBER OF PPNS WHICH CAN BE ADDED
	JUMPLE	P1,INSWL3	;DON'T ASK FOR INCREMENT IF AT TOP OF RANGE

INSWL2:	MOVEI	S1,INCR00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Programmer number increment: /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,P$NUM##	;FETCH A NUMBER
	JUMPF	INSWL2		;TRY AGAIN
	SKIPLE	S1		;RANGE
	CAILE	S1,(P1)		; CHECK
	WARN	(IOR,<Increment out of range 1 to ^O/P1/>,,INSWL2)
	MOVEM	S1,PMRINC	;SAVE THE INCREMENT
	MOVEI	S1,(P1)		;GET MAX INCREMENT (MAX # OF PPNS CAN GENERATE)
	IDIV	S1,PMRINC	;COMPUTE MAXIMUM COUNT TO INSERT
	MOVEI	P1,(S1)		;SAVE AWAY

INSWL3:	MOVEI	S1,COUN00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Count of PPN's to insert: /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,P$NUM##	;FETCH A NUMBER
	JUMPF	INSWL3		;TRY AGAIN
	SKIPLE	S1		;RANGE
	CAILE	S1,(P1)		; CHECK
	WARN	(COR,<Count of PPNs out of range 1 to ^D/P1/>,,INSWL3)
	MOVEM	S1,PMRCNT	;SAVE COUNT

INSWL4:	MOVEI	S1,NAME00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Prompt for user name? /]
	PUSHJ	P,PRSCMD	;SCAN A COMMAND
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,P$KEYW##	;FETCH A KEYWORD
	JUMPF	INSWL4		;TRY AGAIN
	MOVEM	S1,PMRPRT	;SAVE PROMPT VALUE

INSWL5:	MOVEI	S1,NAME00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Prompt for password? /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PRSERR		;COMPLAIN IF PROBLEMS
	PUSHJ	P,P$KEYW##	;FETCH A KEYWORD
	JUMPF	INSWL5		;TRY AGAIN
	MOVEM	S1,PMRPSW	;SAVE FLAG
	JUMPN	S1,.RETT	;RETURN IF THE ANSWER WAS "YES"

INSWL6:	$RETT			;RETURN FOR NOW
	MOVEI	S1,NAME00	;COMMAND TABLE
	MOVEI	S2,[ASCIZ/Default password? /]
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PRSERR		;COMPLAIN IF ERRORS
	PUSHJ	P,P$KEYW##	;FETCH A KEYWORD
	JUMPF	INSWL6		;TRY AGAIN
	MOVEM	1,PMRPWD	;SAVE FLAG
	$RETT			;RETURN
SUBTTL	INSERT COMMAND -- MISCELLANEOUS


PGMR00:	$INIT	(PGMR10)
PGMR10:	$NUMBER	(CONFRM,^D8,<octal number>)

COUN00:	$INIT	(COUN10)
COUN10:	$NUMBER	(CONFRM,^D10,<decimal number of PPNs to generate>)

INCR00:	$INIT	(INCR10)
INCR10:	$NUMBER	(CONFRM,^D8,<octal number for increment>)

NAME00:	$INIT	(NAME10)
NAME10:	$KEYDSP	(NAME20,$DEFAULT(<NO>))
NAME20:	$STAB
	DSPTAB	(CONFRM,0,<NO>)
	DSPTAB	(CONFRM,1,<YES>)
	$ETAB
	SUBTTL	LIST AND SHOW COMMANDS


	XWD	SHOHLP,[ASCIZ /Display profile information on the terminal/]
SHOW:	JRST	LIST		;ENTER COMMON CODE

	XWD	LISHLP,[ASCIZ /Write profile information to a file/]
LIST:	PUSHJ	P,PRSWLD	;PARSE A USER-ID
	$RETIF			;CHECK FOR ERRORS
	PUSHJ	P,P$OFIL##	;GET OUTPUT FILESPEC
	JUMPF	LIST1		;MUST BE A SHOW COMMAND
	MOVEM	S1,LST+FOB.FD	;SAVE FD ADDRESS
	MOVEI	S1,FOB.SZ	;FOB SIZE
	MOVEI	S2,LST		;FD ADDRESS
	PUSHJ	P,F%OOPN	;OPEN FILE FOR OUTPUT
	SKIPT			;CHECK FOR ERRORS
	FATAL	(COL,<Can't open listing file ^F/@LST+FOB.FD/; ^E/[-1]/>)
	MOVEM	S1,LSTIFN	;SAVE IFN
	MOVNI	S2,1		;-1 FOR ACTUAL FILESPEC
	PUSHJ	P,F%FD		;GET FILESPEC
	JUMPF	LIST1		;SHOULDN'T FAIL
	LOAD	S2,.FDLEN(S1),FD.LEN ;GET RETURNED FD LENGTH
	HRLZS	S1		;POINT FD IN LH
	HRR	S1,LST+FOB.FD	;AND TO OUR STORAGE
	ADD	S2,LST+FOB.FD	;COMPUTE END OF BLT
	BLT	S1,-1(S2)	;CPY RETURNED FD
	INFO	(LIS,<Listing to ^F/@LST+FOB.FD/>)

LIST1:	MOVEI	S1,0		;DEFAULT TO /DETAIL
	MOVEM	S1,LISTFL	;SAVE INCASE NO SWITCH TYPED
	PUSHJ	P,P$SWIT##	;TRY FOR A SWITCH
	JUMPF	LIST2		;NOT THERE
	CAIE	S1,0		;/DETAIL?
	CAIN	S1,1		;/FAST?
	SKIPA			;SHOULDN'T HAPPEN
	JUMPF	PRSERR		;SHOULDN'T HAPPEN
	MOVEM	S1,LISTFL	;SAVE FLAG

LIST2:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS

LIST3:	PUSHJ	P,WLDUSR	;GET FIRST/NEXT POSSIBLY WILDCARDED USER
	JUMPF	LIST5		;DONE?
	AOS	PROSUC		;COUNT THE PROFILE
	MOVEI	U,USER		;POINT AT THE USER BLOCK
	SKIPN	LISTFL		;QUICK DISPLAY?
	JRST	LIST4		;NO
	PUSHJ	P,CVTPPF	;CONVERT PPN
	$TEXT	(,< ^T/(S1)/ ^Q/USRNAM/>)
	JRST	LIST3		;LOOP

LIST4:	SKIPE	LSTIFN		;OUTPUT TO A FILE?
	$TEXT	(,<^T/FORMFD/^A>) ;YES
	$TEXT	(,<^T/CRLFS/^A>)
	PUSHJ	P,TYPUSR	;DISPLAY THE PROFILE
	JRST	LIST3		;LOOP

LIST5:	SKIPE	S1,LSTIFN	;OUTPUT TO A FILE?
	PUSHJ	P,F%REL		;YES--CLOSE IT NOW
	SETZM	LSTIFN		;ZAP IFN
	MOVEI	S1,[ASCIZ /listed/]
	PUSHJ	P,WLDSUM	;DISPLAY SUMMARY
	$RETT			;AND RETURN
CRLFS:	BYTE	(7).CHCRT,.CHLFD,.CHCRT,.CHLFD,.CHCRT,.CHLFD,0
FORMFD:	BYTE	(7).CHFFD,.CHCRT,0


LISHLP:	ASCIZ	\
The LIST command writes profile information to a disk file.  The  syntax
is:

	LIST user-id filespec/switch 

The default filespec is DSK:ACCT.LST[-].  The switches are:

	/DETAIL	(default) lists all profile information
			
	/FAST	lists only PPNs and user names
	
\


SHOHLP:	ASCIZ	\
The SHOW command displays profile  information  on  the  terminal.   The
syntax is:

	SHOW user-id /switch 

The switches are:

	/DETAIL	(default) lists all profile information

	/FAST	lists only PPNs and user names

\
SUBTTL	LOCK AND UNLOCK COMMANDS


	XWD	UNLHLP,[ASCIZ /Unlock accounting file to allow updates/]
UNLOCK:	MOVNI	S1,1		;UNLOCK ENTRY POINT
	JRST	LOCK1		;ENTER COMMON CODE

	XWD	LOCHLP,[ASCIZ /Lock accounting file against updates/]
LOCK:	SETZ	S1,		;LOCK ENTRY POINT
LOCK1:	PUSH	P,S1		;SAVE FLAG
;.QUFNC and .QUNOD
	MOVE	S1,[QF.RSP!.QUMAE] ;TALK TO ACTDAE
	SETZ	S2,		;CENTRAL SITE
	DMOVEM	S1,QUEBLK+.QUFNC ;SAVE AS FUNCTION CODE
;.QURSP
	MOVE	S1,[.AEMAX,,RSPBLK] ;RESPONSE BLOCK
	MOVEM	S1,QUEBLK+.QURSP
;.QUTIM
	MOVEI	S1,3		;ASSUME STANDARD HEADER OFFSET
	SKIPE	OLDMON		;NON-FANCY UUO?
	JRST	LOCK2		;YES, DON'T BE FANCY
	SKIPE	DEBUGQ		;WANT TO WAIT?
	TDZA	S2,S2		;NO, LOAD ZERO TIME
	MOVEI	S2,ZZTIME	;YES, SET MAX. WAIT TIME
	MOVEM	S2,QUEBLK+3	;SET FOR TIMEOUT
	SKIPE	S2,DEBUGW	;RUNNING PRIVATELY?
	MOVE	S2,ACTPID	;YES, USE THIS PID
	MOVEM	S2,QUEBLK+4	;SET PID OR ZERO
	SKIPE	S2		;DID WE SET A PID?
	AOSA	S1		;YES, BUMP TWICE
	SKIPE	QUEBLK+3	;NO, DID WE SET A TIMEOUT?
	AOS	S1		;YES, BUMP HEADER LENGTH
	STORE	S1,QUEBLK,QF.HLN ;SET HEADER LENGTH FOR UUO
LOCK2:
;.QBAFN
	MOVX	S2,UGLOK$	;ASSUME LOCK
	SKIPE	(P)		;WAS IT?
	MOVX	S2,UGUNL$	;NO, WAS UNLOCK
	TRO	S2,AF.PRV	;MAKE SURE ACTDAE CHECKS OUR PRIVS
	MOVEM	S2,QUEBLK+1(S1)	;SET ACTDAE FUNCTION CODE
	MOVE	S2,[QA.IMM!1B17!.QBAFN] ;SUBFUNCTION CODE
	MOVEM	S2,QUEBLK(S1)	;STORE THE SUBFUNCTION TYPE

	MOVSI	S1,2(S1)	;GET LENGTH OF ARG BLOCK
	HRRI	S1,QUEBLK	;POINT TO THE BLOCK
	POP	P,S2		;GET ENTRY BACK
	QUEUE.	S1,
	  FATAL	(LSF,<Accounting file status change failed; ^T/RSPBLK/>,,.RETF)
	SKIPN	S2
	INFO	(LOK,<Accounting file locked; changes are prohibited>,,.RETT)
	INFO	(UNL,<Accounting file unlocked; changes are permitted>,,.RETT)
LOCHLP:	ASCIZ	\
The LOCK command  instructs  ACTDAE  to  open  the  accounting  file  in
read-only  mode.   When  this  is  done, the accounting file will not be
updated by ACTDAE.  Therefore, users  will  not  be  allowed  to  change
unprivileged  fields  in  their profiles.  A privileged user will not be
allowed to make any changes that would modify the accounting file.  This
command  is used mainly to support the VERIFY command, or in a situation
where you might want to supersede the accounting file.
\

UNLHLP:	ASCIZ	\
The  UNLOCK  command  instructs ACTDAE to re-open the accounting file in
update mode.  This  command  restores  ACTDAE  to  its  normal  mode  of
operation.
\
SUBTTL	PURGE COMMAND


	XWD	DELHLP,[ASCIZ /Purge expired profiles/]
PURGE:	PUSHJ	P,PRSWLD	;PARSE A USER ID
	$RETIF			;RETURN ON ERRORS
	PUSHJ	P,P$CFM##	;NEED EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,I%NOW		;GET CURRENT DATE/TIME
	MOVEM	S1,EXPDTM	;SAVE FOR EXPIRATION DATE/TIME COMPARRISONS

PURGE1:	PUSHJ	P,WLDUSR	;GET FIRST/NEXT POSSIBLY WILDCARDED USER
	JUMPF	PURGE3		;DONE?
	MOVEI	U,USER		;POINT TO THE USER PROFILE
	SKIPLE	S1,.AEEXP(U)	;GET DATE/TIME FROM PROFILE
	CAMLE	S1,EXPDTM	;EXPIRED PPN?
	JRST	PURGE1		;NO
	PUSHJ	P,CVTPPD	;CONVERT PPN
	PUSH	P,S1		;SAVE TEXT ADDRESS
	PUSHJ	P,DELUSR	;DELETE THIS USER
	POP	P,S1		;GET PPN TEXT ADDRESS BACK
	JUMPF	PURGE2		;CHECK FOR ERRORS
	AOS	PROSUC		;COUNT THE SUCCESS
	$TEXT	(,< User ^T/(S1)/ ^Q/USRNAM/ purged>)
	JRST	PURGE1		;LOOP

PURGE2:	WARN	(DPF,<Purge of profile failed for ^T/(S1)/>)
	AOS	PROFAI		;COUNT THE FAILURE
	JRST	PURGE1		;LOOP

PURGE3:	MOVEI	S1,[ASCIZ /purged/]
	PUSHJ	P,WLDSUM	;DISPLAY SUMMARY
	$RETT


PURHLP:	ASCIZ	\
The PURGE command removes the  specified  expired  profile(s)  from  the
accounting file.  The syntax is:  PURGE user-id.
\
SUBTTL	SELECT COMMAND


	XWD	SELHLP,[ASCIZ /Select wildcarding criteria/]
SELECT:	PUSHJ	P,P$SWIT##	;TRY FOR A SWITCH
	SKIPT			;SKIP IF GOT ONE
	MOVNI	S1,1		;ELSE REMEMBER THERE'S NO SWITCH
	PUSH	P,S1		;SAVE
	PUSHJ	P,P$CFM##	;GET EOL
	POP	P,S1		;GET SWITCH VALUE OR FLAG BACK
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,SELINI	;INIT SELECTION STORAGE
	JUMPE	S1,.RETT	;RETURN IF JUST CLEARING SELECTION CRITERIA
	SETOM	SELFLG		;FLAG SELECTION IN PROGRESS
	MOVEI	U,USER		;POINT TO PROFILE BLOCK
	MOVEI	X,(U)		;ALWAYS NEED BOTH SETUP
	MOVSI	S1,(U)		;GET ADDR
	HRRI	S1,1(U)		;MAKE A BLT POINTER
	SETZM	(U)		;CLEAR FIRST WORD
	BLT	S1,.AEMAX-1(U)	;CLEAR OUT BLOCK
	MOVE	S1,[ACTFMT,,.AEMIN]	;INITIALIZE OVERHEAD WORD
	MOVEM	S1,.AEVRS(U)	;SO EXTENSIBLE BLOCKS WILL WORK
	MOVEI	S1,SEL000	;COMMAND TABLE
	MOVEI	S2,[ASCIZ /SELECT>/] ;PROMPT
	PUSHJ	P,PROFIL	;PROCESS AS IF IT WERE A PROFILE
	$RETT			;RETURN
SUBTTL	SELECT COMMAND -- SELCHK - CHECK FOR SELECTION IN PROGRESS


SELCHK:	SKIPN	SELFLG		;SELCTION IN PROGRESS?
	$RETT			;NO
	SETZM	SELFNC		;CLEAR OUT ANY OLD FUNCTION CODE
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	$RETIF			;CHECK FOR ERRORS
	CAIL	S1,400001	;RANGE
	CAILE	S1,400003	; CHECK
	JRST	SELCH1		;NO GOOD
	ANDI	S1,777		;MAKE SURE THERE'S NO JUNK
	LSH	S1,17		;POSITION
	MOVEM	S1,SELFNC	;STORE AS FUNCTION CODE
	$RETT			;AND RETURN

SELCH1:	PUSHJ	P,P$PREV##	;NOT A SELECT KEYWORD
	$RETF			;GIVE UP
SUBTTL	SELECT COMMAND -- SELHLP - HELP TEXT


SELHLP:	ASCIZ	\
Select command
\
SUBTTL	SELECT COMMAND -- SELINI - INITIALIZE SELECTION STORAGE


SELINI:	PUSH	P,S1		;SAVE S1
	MOVSI	S1,WILDBK+UW$SEL ;POINT TO START OF SELECTION DATA
	HRRI	S1,WILDBK+UW$SEL+1 ;MAKE A BLT POINTER
	SETZM	WILDBK+UW$SEL	;CLEAR FIRST WORD
	BLT	S1,WILDBK+PAGSIZ-1 ;CLEAR SELECTION STORAGE

; ***
; REPLACE NEXT INSTUCTION WITH ONES THAT WILL COMPUTE THE NUMBER
; OF AVAILABLE WORDS FOR SELECTION CRITERIA AS FOLLOWS:
;     FREE SPACE = MAX - UUO - UW$DAT - OH
;
; WHERE MAX	- MAXIMUM QUEUE. UUO PACKET LENGTH (^D510)
;	UUO	- QUEUE. UUO FUNCTION WORDS AND SUB-BLOCKS NEEDED
;		  TO SET UP THE WILDCARD CALL
;	UW$DAT	- WILDCARD DATA (PPN, MASK, NAME, ETC.)
;	OH	- MONITOR OVERHEAD WORDS APPENDED TO THE MESSAGE
;
; THIS CAN BE DONE IF VALUES FOR "MAX" AND "OH" ARE GETTABABLE.
; ***

ND	Q.MAX,^D510		;LONGEST NON-PAGE MESSAGE
ND	Q.OH,2+3+9+2+.OHDRS	;NODE+NAME+ACCOUNT+.QBFNC+GALAXY
	Q.UUO==2+1+UW$DAT	;.QBAFN+.QBAET

	MOVSI	S1,Q.OH+Q.UUO-Q.MAX ;MAKE A BAD GUESS FOR NOW
	HRRI	S1,WILDBK+UW$DAT ;MAKE AN AOBJN POINTER
	MOVEM	S1,SELPTR	;SAVE
	PUSHJ	P,PROZQM	;CLEAR OUT THE MODIFY MASKS
	POP	P,S1		;RESTORE S1
	POPJ	P,		;RETURN
SUBTTL	SELECT COMMAND -- MISCELLANEOUS


SEL000:	$INIT	(SEL010)
SEL010:	$KEYDSP	(SEL020,<$ALTER (ENT020)>)
SEL020:	$STAB
	DSPTAB	(ENTSLC,400001,<AND>)
	DSPTAB	(ENTSLC,400003,<NOT>)
	DSPTAB	(ENTSLC,400002,<OR>)
	$ETAB
SUBTTL	VERIFY COMMAND -- VERIFY - ENTRY POINT


	XWD	VERHLP,[ASCIZ /Verify the accounting file from a master file/]
VERIFY:	PUSHJ	P,.SAVE4	;SAVE SOME ACS
	MOVE	S1,[CHGMSK,,CHGMSK+1]	;BLT XFER WORD
	SETOM	CHGMSK			;TO FAKE OUT COMPAR
	BLT	S1,CHGMSK+.AEMIN-1	;ALL MASKABLE WORDS CHANGED IN ALL BITS
	PUSHJ	P,INITIO##	;INIT RMS-10 INTERFACE
	PUSHJ	P,VERPRS	;PARSE ALL ARGUMENTS
	PUSHJ	P,VEROPN	;OPEN ALL NECESSARY FILES
	$RETIF			;GIVE UP ON FAILURES
	MOVEI	U,USER		;MASTER PROFILE
	MOVEI	X,USER2		;WORKING PROFILE
	SETZM	VERABO		;CLEAR ABORTED FLAG
	SETZM	VERDIF		;INIT DIFFERENCE COUNTER
	PUSHJ	P,VERUSR	;VERIFY USER PROFILES
	SKIPE	VERABO		;VERIFICATION ABORTED?
	FATAL	(AUA,<Accounting file verification aborted>,,VERIF1)

VERIF1:	PUSHJ	P,VERCLS	;CLOSE FILES
	SKIPE	SWTUPD		;SKIP IF /NOUPDATE
	SKIPE	VERABO		;ABORTING VERIFY?
	JRST	VERIF2		;YES--DON'T SUPERSEDE WORKING FILE
	MOVEI	S1,TEMPFD	;FD FOR INPUT
	MOVEI	S2,WORKFD	;FD FOR OUTPUT
	PUSHJ	P,VERCPY	;COPY TEMPORARY FILE TO WORKING FILE

VERIF2:	SKIPE	VERABO		;ABORTING VERIFY?
	$RETT			;YES--ALL DONE
	SKIPE	SWTUPD		;SKIP IF /NOUPDATE
	PUSHJ	P,ERSC##	;ERASE (DELETE) TEMPORARY FILE "C"
	MOVE	S1,VERDIF	;ANY DIFFERENCES?
	CAIN	S1,1		;ONLY ONE
	SKIPA	S2,[[ITEXT (<; one difference>)]]
	MOVEI	S2,[ITEXT (<; ^D/S1/ differences>)]
	SKIPN	S1		;UNLESS THERE WERE NONE
	MOVEI	S2,[ITEXT (<; no differences>)]
	$TEXT	(,<^M^J Accounting file verified^I/(S2)/>)
	$RETT			;DONE
SUBTTL	VERIFY COMMAND -- VERASK - ASK USER ABOUT DIFFERENCES


VERASK:	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VERNO		;YES, TREAT AS NOT PRESERVING CHANGES

VERAS1:	MOVEI	S1,DELU00	;PARSE TABLE SAME AS DELETE OPTIONS
	MOVEI	S2,[ASCIZ /Preserve changes? /] ;POINT TO PROMPT STRING
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	VERAS1		;CHECK FOR ERRORS
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	VERAS1		;CHECK FOR ERRORS
	CAILE	S1,VERLEN	;VALID KEYWORD?
	JRST	VERAS1		;NO PROMPT AGAIN
	JRST	@VERTAB(S1)	;YES, DISPATCH
; KEYWORD DISPATCH TABLE
VERTAB:	IFIW	VERNO		;"NO"
	IFIW	VERQUI		;"QUIT"
	IFIW	VERSHO		;"SHOW"
	IFIW	VERYES		;"YES"
VERLEN==.-VERTAB		;LENGTH OF TABLE


; "NO" KEYWORD PROCESSOR
VERNO:	$RETF			;DO NOT INCLUDE CHANGES


; "QUIT" KEYWORD PROCESSOR
VERQUI:	SETOM	VERABO		;FLAG TERMINATION
	$RETF			;RETURN


; "SHOW" KEYWORD PROCESSOR
VERSHO:	$TEXT	(,< Profile from accounting file:>)
	EXCH	U,X		;POINT TO THE WORKING FILE
	PUSHJ	P,TYPUSR	;DISPLAY PROFILE
	EXCH	U,X		;RESTORE
	JRST	VERASK		;LOOP BACK AND ASK AGAIN


; "YES" KEYWORD PROCESSOR
VERYES:	$RETT			;INCLUDE CHANGES
SUBTTL	VERIFY COMMAND -- VERCLS - CLOSE FILES


VERCLS:	PUSHJ	P,CLSA##	;CLOSE FILE "A"
	PUSHJ	P,CLSB##	;CLOSE FILE "B"
	SKIPE	SWTUPD		;SKIP IF /NOUPDATE
	PUSHJ	P,CLSC##	;CLOSE FILE "C"
	$RETT			;YES--DONE
SUBTTL	VERIFY COMMAND -- VERCMP - COMPARE PROFILES


VERCMP:	PUSHJ	P,.SAVE3	;SAVE SOME ACS
	MOVSI	P1,-.AEMIN	;-LENGTH OF STATIC PORTION OF PROFILE

VERCM1:	HRRZ	S1,P1		;GET PROFILE OFFSET
	PUSHJ	P,COMPAR	;GET TRUE IFF SAME
	JUMPF	VERCM6		;SOMETHING CHANGED
	$FALL	VERCM5		;ONWARD

VERCM5:	AOBJN	P1,VERCM1	;LOOP
	$RETT			;RETURN

; HERE WHEN PROFILES DIFFER
VERCM6:	AOS	VERDIF		;FLAG THE DIFFERENCE
	$RETF			;RETURN
SUBTTL	VERIFY COMMAND -- VERCPY - COPY A FILE


; COPY A FILE
; CALL:	MOVE	S1, FD FOR INPUT
;	MOVE	S2, FD FOR OUTPUT
;	PUSHJ	P,VERCPY
VERCPY:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	DMOVE	P1,S1		;COPY ARGUMENTS
	MOVE	S1,[VERRFB,,VERRFB+1] ;ZERO FOB FOR READING
	SETZM	VERRFB
	BLT	S1,VERRFB+FOB.SZ-1
	MOVE	S1,[VERWFB,,VERWFB+1] ;ZERO FOB FOR WRITING
	SETZM	VERWFB
	BLT	S1,VERWFB+FOB.SZ-1
	MOVEM	P1,VERRFB+FOB.FD ;SAVE INPUT FD ADDRESS
	MOVEM	P2,VERWFB+FOB.FD ;SAVE OUTPUT FD ADDRESS
	MOVEI	S1,44		;36-BIT BYTES
	MOVEM	S1,VERRFB+FOB.CW ;SAVE FOR INPUT
	MOVEM	S1,VERWFB+FOB.CW ;SAVE FOR OUTPUT
	SETZB	P1,P2		;ZERO IFNS
	MOVEI	S1,FOB.SZ	;FOB SIZE
	MOVEI	S2,VERRFB	;FOB ADDRESS
	PUSHJ	P,F%IOPN	;OPEN FILE FOR INPUT
	JUMPF	VERCP2		;CHECK FOR ERRORS
	MOVE	P1,S1		;SAVE IFN FOR INPUT
	MOVEI	S1,FOB.SZ	;FOB SIZE
	MOVEI	S2,VERWFB	;FOB ADDRESS
	PUSHJ	P,F%OOPN	;OPEN FILE FOR OUTPUT
	JUMPF	VERCP3		;CHECK FOR ERRORS
	MOVE	P2,S1		;SAVE IFN FOR OUTPUT

; HERE WE CHEAT.  SINCE WE'RE DOING AN IMAGE COPY, THE BYTE SIZE
; IS 36.  GLXFIL WILL GIVE US AN BYTE POINTER TO THE DATA IN ITS
; INTERNAL BUFFER.  WE'LL FIX UP THE ADDRESS (BYTE POINTER SET TO
; ILDB THROUGH THE BUFFER) AND GIVE IT RIGHT BACK TO GLXFIL FOR
; OUTPUT.

VERCP1:	MOVE	S1,P1		;IFN FOR INPUT
	PUSHJ	P,F%IBUF	;READ A BUFFER
	JUMPF	VERCP4		;CHECK FOR ERRORS
	AOS	S2		;POINT TO FIRST DATA WORD
	HRL	S2,S1		;GET NUMBER OF WORDS
	MOVE	S1,P2		;IFN FOR OUTPUT
	PUSHJ	P,F%OBUF	;WRITE A BUFFER
	JUMPF	VERCP5		;CHECK FOR ERRORS
	JRST	VERCP1		;LOOP
; OPEN ERRORS
VERCP2:	SKIPA	S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP3:	MOVE	S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
	WARN	(OPE,<Open error on ^F/(S2)/; ^E/S1/>,,VERCP6)


; I/O ERRORS
VERCP4:	SKIPA	S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP5:	MOVE	S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
	CAIE	S1,EREOF$	;END OF FILE?
	WARN	(IOE,<I/O error on ^D/(S2)/; ^E/S1/>,,VERCP6)
	MOVE	S1,P1		;IFN FOR INPUT
	PUSHJ	P,F%REL		;RELEASE IT
	MOVE	S1,P2		;IFN FOR OUTPUT
	PUSHJ	P,F%REL		;RELEASE IT
	$RETT			;RETURN


; CLOSE FILES ON ERRORS
VERCP6:	SETOM	VERABO		;FLAG ABORT
	SKIPE	S1,P1		;IFN FOR INPUT
	PUSHJ	P,F%RREL	;RELEASE IT
	SKIPE	S1,P2		;IFN FOR OUTPUT
	PUSHJ	P,F%RREL	;RELEASE IT
	$RETF			;RETURN
SUBTTL	VERIFY COMMAND -- VERHLP - HELP TEXT


VERHLP:	ASCIZ	\
The VERIFY command  enables  you  to  maintain  a  master  copy  of  the
accounting  file  in  addition to the working copy on SYS.  You can make
changes to the working copy of the accounting file without shutting down
the entire accounting system.

When you issue  the  VERIFY  command,  REACT  displays  the  differences
between the master accounting file and the working accounting file.  You
can preserve the changes in the working file or discard them.  When  the
update  is  complete,  the  working  copy  of the accounting file on SYS
reflect the changes you made.
\
SUBTTL	VERIFY COMMAND -- VEROPN - OPEN FILES


; FILE "A" - MASTER FILE	(DSK:MASTER.SYS)
; FILE "B" - WORKING FILE	(SYS:ACTDAE.SYS)
; FILE "C" - TEMPORARY FILE	(DSK:###REA.TMP)

VEROPN:	MOVEI	S1,MASTFN	;MASTER FILESPEC
	MOVEI	S2,0		;READ-ONLY
	PUSHJ	P,OPNA##	;OPEN FILE "A"
	SKIPT			;CHECK FOR ERROR
	FATAL	(OPF,<Open failed for ^T/MASTFN/>,,VEROP6)
	MOVE	S1,[MASTWB,,MASTWB+1] ;SET UP BLT
	SETZM	MASTWB		;CLEAR FIRST WORD
	BLT	S1,MASTWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK

	SKIPE	DEBUGW		;DEBUGGING?
	SKIPA	S1,[SIXBIT/DSK/] ;YES
	MOVSI	S1,'SYS'	;NO
	$TEXT	(<-1,,WORKFN>,<^W/S1/:^W/[ACTFIL]/.SYS^0>)
	MOVEI	S1,WORKFN	;WORKING FILESPEC
	MOVEI	S2,0		;READ-ONLY
	PUSHJ	P,OPNB##	;OPEN FILE "B"
	SKIPT			;CHECK FOR ERROR
	FATAL	(OPF,<Open failed for ^T/WORKFN/>,,VEROP5)
	MOVE	S1,[WORKWB,,WORKWB+1] ;SET UP BLT
	SETZM	WORKWB		;CLEAR FIRST WORD
	BLT	S1,WORKWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK

	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VEROP1		;ALMOST DONE
	PJOB	S1,		;GET OUR JOB NUMBER
	$TEXT	(<-1,,TEMPFN>,<DSK:^D3R0/S1/REA.TMP^0>)
	MOVEI	S1,TEMPFN	;TEMP FILE NAME STRING
	MOVEI	S2,1		;ALLOW WRITING
	PUSHJ	P,OPNC##	;OPEN FILE "C"
	SKIPT			;CHECK FOR ERROR
	FATAL	(OPE,<Open failed for ^T/TEMPFN/>,,VEROP3)
	MOVEI	S1,1		;OPTION 1, SET LOAD FLAG
	MOVEI	S2,1		;TURN ON LOAD FLAG FOR TEMP FILE
	PUSHJ	P,OPTC##	;PERFORM THE FUNCTION
	MOVE	S1,[TEMPWB,,TEMPWB+1] ;SET UP BLT
	SETZM	TEMPWB		;CLEAR FIRST WORD
	BLT	S1,TEMPWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK

VEROP1:	$TEXT	(,<>)		;START WITH A BLANK LINE
	MOVEI	S1,4		;OPTION NUMBER
	PUSHJ	P,OPTA##	;GET FILESPEC FOR FILE "A"
	MOVEI	T1,MASTFD	;FD STORAGE
	MOVEI	T2,[ASCIZ /Master file:    /]
	PUSHJ	P,VEROP3	;REPORT FILE
	MOVEI	S1,4		;OPTION NUMBER
	PUSHJ	P,OPTB##	;GET FILESPEC FOR FILE "B"
	MOVEI	T1,WORKFD	;FD STORAGE
	MOVEI	T2,[ASCIZ /Accounting file:/]
	PUSHJ	P,VEROP3	;REPORT FILE
	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VEROP2		;ELSE ALMOST DONE
	MOVEI	S1,4		;OPTION NUMBER
	PUSHJ	P,OPTC##	;GET FILESPEC FOR FILE "C"
	MOVEI	T1,TEMPFD	;FD STORAGE
	MOVEI	T2,[ASCIZ /Temporary file: /]
	PUSHJ	P,VEROP3	;REPORT FILE

VEROP2:	MOVEI	S1,[ASCIZ /Verifying:      /]
	MOVEI	T1,[ASCIZ ./REPORT.]
	SKIPG	SWTRPT		;/REPORT?
	MOVEI	T1,[ASCIZ//]	;NO
	MOVEI	T2,[ASCIZ ./UPDATE.]
	SKIPG	SWTUPD		;/UPDATE?
	MOVEI	T2,[ASCIZ//]	;NO
	$TEXT	(,< ^T/(S1)/ ^Q/WILDBP/ ^T/(T1)/ ^T/(T2)/^M^J>)
	$RETT			;RETURN

VEROP3:	MOVEI	T3,(T1)		;GET START OF FD STORAGE
	HRRI	T1,.FDSTR(T1)	;START OF ACTUAL FILESPEC DATA
	HRLI	T1,.FOFDV(S2)	;MAKE A BLT POINTER
	BLT	T1,FDXSIZ-1(T3)	;COPY FILESPEC
	MOVSI	S1,FDXSIZ	;GET LENGTH,,FILE TYPE (NATIVE)
	MOVEM	S1,.FDLEN(T3)	;SAVE IN FD
	$TEXT	(,< ^T/(T2)/ ^F/(T3)/>) ;REPORT FILE TO USER
	$RETT			;RETURN

VEROP4:	PUSHJ	P,CLSB##	;CLOSE FILE "B"

VEROP5:	PUSHJ	P,CLSA##	;CLOSE	 FILE "A"

VEROP6:	SETOM	VERABO		;FLAG ABORT
	$RETF			;RETURN
SUBTTL	VERIFY COMMAND -- VERPRS - PARSE ARGUMENTS


VERPRS:	SETOM	VERALL		;ASSUME WILL VERIFY ALL PROFILES
	SETZB	S1,S2		;WILDCARD PPN AND MASK FOR [*,*]
	MOVEM	S1,WILDBK+UW$PPN ;SAVE DEFAULT PPN
	MOVEM	S2,WILDBK+UW$PPM ;SAVE DEFAULT MASK
	PUSHJ	P,P$FILE##	;GET POINTER TO FILESPEC
	$RETIF			;RETURN ON ERROR
	MOVEI	S2,.FDNAT	;NATIVE MODE FILESPEC
	STORE	S2,.FDLEN(S1),FD.TYP ;SET IN FD
	$TEXT	(<-1,,MASTFN>,<^F/(S1)/^0>)
	PUSHJ	P,PRSSWT	;PARSE SOME SWITCHES
	$RETIT			;RETURN IF EOL
	PUSHJ	P,PRSWLD	;CAN ONLY BE A USER-ID AT THIS POINT
	$RETIF			;RETURN ON ERROR
	SKIPN	S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
	SKIPE	S2,WILDBK+UW$PPM ;GET PPN MASK
	CAIA			;NEED TO CHECK HARDER
	JRST	VERPR3		;STILL DOING ALL PROFILES, GET SWITCHES
	SETZM	VERALL		;NOT ALL PPNS, ASSUME SELECTIVE
	CAIE	S1,1		;CORRECT ASSUMPTION?
	JRST	VERPR3		;DEFINITELY, LOOK FOR SWITCHES
	MOVEI	TF,.AANLC	;MAXIMUM NUMBER OF CHARACTERS IN A NAME
	MOVE	S1,[POINT 8,WILDBK+UW$NAM] ;WHERE THE NAME WAS STORED
VERPR1:	ILDB	S2,S1		;GET NEXT CHARACTER FROM NAME
	JUMPE	S2,VERPR2	;DONE
	CAIN	S2,"*"		;IF STILL FULLY WILD,
	SOJG	TF,VERPR1	;KEEP LOOKING
	JRST	VERPR3		;SELECTIVE VERIFY GUESS WAS CORRECT
VERPR2:	CAIE	TF,.AANLC	;UNLESS NAME IS NULL,
	SETOM	VERALL		;NAME OF **... IS STILL FINDING ALL PROFILES
VERPR3:	PUSHJ	P,PRSSWX	;MAYBE MORE SWITCHES?
	$RETIF			;NO SWITCHES OR EOL
	MOVEI	S1,1		;GET A "YES"
	SKIPGE	SWTUPD		;/UPDATE?
	MOVEM	S1,SWTUPD	;DEFAULT TO YES
	SKIPGE	SWTRPT		;/REPORT?
	MOVEM	S1,SWTRPT	;DEFAULT TO YES
	$RETT			;RETURN
SUBTTL	VERIFY COMMAND -- VERRPT - REPORT DIFFERENCES IN PROFILE


VERRPT:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	PUSHJ	P,CVTPPD	;CONVERT PPN
	WARN	(DIF,<Difference in profile for ^T/(S1)/ ^Q/USRNAM/>)
	SKIPG	SWTRPT		;/REPORT?
	$RETT			;NO
	MOVE	S1,ENTKPT	;POINT TO PROFILE ENTRY TABLE
	HLRZ	P1,(S1)		;GET NUMBER OF ENTRIES IN TABLE
	MOVNS	P1		;NEGATE
	HRLZS	P1		;PUT IN LH
	HRRI	P1,1(S1)	;MAKE AOBJN POINTER TO FIRST ENTRY

VERRP1:	HRRZ	P2,(P1)		;GET PROFILE ENTRY VECTOR ADDRESS
	SKIPGE	S1,CG.PFL(P2)	;PROFILE OFFSET
	JRST	VERRP2		;THERE IS NONE
	MOVE	S1,CHGTAB##(S1)	;FLAGS
	TXNE	S1,PD.UNP!PD.NMD ;UNPRIV'ED DATA OR INVALID FOR COMPARE?
	JRST	VERRP2		;DON'T BOTHER LOOKING AT IT
	PUSHJ	P,@CG.CMP(P2)	;CALL THE COMPARE ROUTINE FOR THIS ITEM
	JUMPT	VERRP2		;FIELD IS THE SAME
	$TEXT	(,< ^T/@CG.PRM(P2)/: >) ;TYPE OUT HEADER
	$TEXT	(,< Master     file: ^A>)
	MOVEI	S1,(P2)		;VECTOR ADDRESS
	PUSHJ	P,PROTTL	;PRINT DATA
	$TEXT	(,< Accounting file: ^A>)
	EXCH	U,X		;SWAP POINTER
	MOVEI	S1,(P2)		;VECTOR ADDRESS
	PUSHJ	P,PROTTL	;PRINT DATA
	EXCH	U,X		;RESTORE
	$TEXT	(,<>)		;END ENTRY WITH A BLANK LINE

VERRP2:	AOBJN	P1,VERRP1	;LOOP
	$RETT			;RETURN
SUBTTL	VERUSR COMMAND -- VERUSR - VERIFY USER PROFILES


VERUSR:	MOVE	S1,[USER,,USER+1] ;ZERO MASTER BUFFER
	SETZM	USER
	BLT	S1,USER+.AEMAX-1
	MOVE	S1,[USER2,,USER2+1] ;ZERO WORKING FILE BUFFER
	SETZM	USER2
	BLT	S1,USER2+.AEMAX-1
	SKIPE	VERALL		;VERIFYING ALL PROFILES
	JRST	VERUS1		;YES
	MOVE	S1,[WILDBK,,MASTWB] ;SET UP BLT
	BLT	S1,MASTWB+UW$MIN ;COPY
	MOVE	S1,[WILDBK,,WORKWB] ;SET UP BLT
	BLT	S1,WORKWB+UW$MIN ;COPY
	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VERUS1		;DON'T NEED TEMP FILE STUFF
	PUSHJ	P,CLSC##	;CLOSE THE FILE
	MOVEI	S1,WORKFD	;POINT TO WORKING FILE
	MOVEI	S2,TEMPFD	;AND TO TEMPORARY FILE
	PUSHJ	P,VERCPY	;COPY TEMP=WORKING
	MOVEI	S1,TEMPFN	;POINT TO TEMP FILE NAME
	MOVEI	S2,1		;WRITE
	PUSHJ	P,OPNC##	;OPEN FOR WRITING
	JUMPT	VERUS1		;CONTINUE IF NO ERRORS
	SETOM	VERABO		;ABORT THE VERIFY
	FATAL	(OPE,<Open failed for ^T/TEMPFN/>,,.RETF)

VERUS1:	SKIPE	VERABO		;DID SOMEBODY ABORT?
	$RETF			;YES, GIVE UP
	SKIPE	S1,MASTEF	;GET MASTER EOF FLAG
	CAME	S1,WORKEF	;EOF ON WORKING FILE TOO?
	SKIPA	S1,.AEPPN(U)	;GET MASTER FILE PPN
	$RETT			;DONE
	MOVE	S2,.AEPPN(X)	;GET WORKING FILE PPN
	TXC	S1,1B0		;FLIP SIGN BITS
	TXC	S2,1B0		;FOR PROPER COMPARISONS
	CAME	S1,S2		;FILES IN SYNCH?
	JRST	VERUS4		;NO
	PUSHJ	P,VERRDM	;READ PROFILE FROM MASTER FILE
	$RETIF			;RETURN ON I/O ERRORS
	PUSHJ	P,VERRDW	;READ PROFILE FROM WORKING FILE
	$RETIF			;RETURN ON I/O ERRORS

VERUS2:	SKIPE	S1,MASTEF	;GET MASTER EOF FLAG
	CAME	S1,WORKEF	;EOF ON WORKING FILE TOO?
	SKIPA	S1,.AEPPN(U)	;GET MASTER FILE PPN
	$RETT			;DONE
	MOVE	S2,.AEPPN(X)	;GET WORKING FILE PPN
	TXC	S1,1B0		;FLIP SIGN BITS
	TXC	S2,1B0		;FOR PROPER COMPARISONS
	SKIPE	MASTEF		;GET MASTER EOF FLAG
	JRST	VERUS8		;WORKING FILE PROFILE IS NEW
	SKIPE	WORKEF		;GET WORKING EOF FLAG
	JRST	VERUS5		;MASTER PROFILE IS MISSING
	CAMGE	S1,S2		;SAME?
	JRST	VERUS5		;NO
	CAMLE	S1,S2		;CHECK AGAIN
	JRST	VERUS8		;NO
	PUSHJ	P,VERCMP	;COMPARE PROFILES
	JUMPT	VERUS3		;LOOP BACK IF SAME
	PUSHJ	P,VERRPT	;REPORT DIFFERENCES
	PUSHJ	P,VERASK	;INCLUDE CHANGES?
	MOVEI	S1,(X)		;POINT TO CHANGED PROFILE
	SKIPT			;SKIP IF ANSWER WAS "YES"
	MOVEI	S1,(U)		;POINT TO MASTER PROFILE
	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VERUS1		;ELSE LOOP BACK
	PUSHJ	P,VERWTT	;COPY INTO TEMPORARY FILE
	$RETIF			;CHECK FOR ERRORS
	JRST	VERUS1		;LOOP BACK

VERUS3:	MOVEI	S1,(U)		;POINT TO MASTER PROFILE
	SKIPE	SWTUPD		;SKIP IF /NOUPDATE (TF ALWAYS TRUE HERE)
	PUSHJ	P,VERWTT	;COPY INTO TEMPORARY FILE
	$RETIF			;CHECK FOR ERRORS
	PUSHJ	P,CVTPPF	;CONVERT PPN
	$TEXT	(,< ^T/(S1)/ ^Q/USRNAM/>)
	JRST	VERUS1		;LOOP BACK

VERUS4:	CAML	S1,S2		;A NEW PROFILE IN THE MASTER FILE?
	JRST	VERUS7		;NO
VERUS5:	PUSHJ	P,CVTPPD	;CONVERT PPN
	MOVEI	S2,.AENAM(U)	;POINT TO NAME
	HRLI	S2,(POINT 8,)	;8-BIT ASCIZ
	WARN	(PNW,<Profile for ^T/(S1)/ ^Q/S2/ not in working file>)
	AOS	VERDIF		;COUNT THE DIFFERENCE
	SKIPE	SWTRPT		;SKIP IF /NOREPORT
	PUSHJ	P,TYPUSR	;DISPLAY PROFILE
	EXCH	U,X		;DISPLAY CORRECT PROFILE
	PUSHJ	P,VERASK	;INCLUDE CHANGES?
	EXCH	U,X		;RESTORE
	JUMPT	VERUS6		;JUMP IF ANSWER WAS "YES"
	MOVEI	S1,(U)		;POINT TO MASTER PROFILE
	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VERUS6		;ELSE GO READ ANOTHER PROFILE
	PUSHJ	P,VERWTT	;WRITE INTO TEMPORARY FILE
	$RETIF			;CHECK FOR ERRORS
VERUS6:	PUSHJ	P,VERRDM	;READ ANOTHER PROFILE FROM MASTER FILE
	$RETIF			;RETURN ON I/O ERRORS
	JRST	VERUS2		;LOOP BACK

VERUS7:	CAMG	S1,S2		;A NEW PROFILE IN THE WORKING FILE?
	JRST	VERUS1		;NO
VERUS8:	EXCH	U,X		;SWAP
	PUSHJ	P,CVTPPD	;CONVERT PPN
	MOVEI	S2,.AENAM(U)	;POINT TO NAME
	HRLI	S2,(POINT 8,)	;8-BIT ASCIZ
	WARN	(PNM,<Profile for ^T/(S1)/ ^Q/S2/ not in master file>)
	AOS	VERDIF		;COUNT THE DIFFERENCE
	SKIPE	SWTRPT		;SKIP IF /NOREPORT
	PUSHJ	P,TYPUSR	;DISPLAY PROFILE
	EXCH	U,X		;RESTORE
	PUSHJ	P,VERASK	;INCLUDE CHANGES?
	JUMPF	VERUS9		;JUMP IF ANSWER WAS "NO"
	MOVEI	S1,(X)		;POINT TO WORKING PROFILE
	SKIPG	SWTUPD		;SKIP IF /UPDATE
	JRST	VERUS9		;ELSE GO READ ANOTHER PROFILE
	PUSHJ	P,VERWTT	;WRITE INTO TEMPORARY FILE
	$RETIF			;CHECK FOR ERRORS
VERUS9:	PUSHJ	P,VERRDW	;READ ANOTHER PROFILE FROM WORKING FILE
	$RETIF			;RETURN ON I/O ERRORS
	JRST	VERUS2		;LOOP BACK
SUBTTL	VERIFY COMMAND -- MISCELLANEOUS


; READ A PROFILE FROM THE MASTER FILE
VERRDM:	SKIPE	MASTEF		;AT EOF?
	$RETT			;YES
	MOVEI	S1,(U)		;MASTER PROFILE
	MOVEI	S2,MASTWB	;POINT TO MASTER WILDCARD BLOCK
	PUSHJ	P,GETA##	;GET A PROFILE FROM FILE "A"
	$RETIT			;RETURN IF OK
	MOVEI	S1,3		;OPTION NUMBER
	PUSHJ	P,OPTA##	;GET LAST I/O ERROR ON FILE "A"
	MOVEI	S2,MASTFD	;POINT TO FD INCASE OF ERROR
	CAIE	S1,ER$RNF##	;RECORD NOT FOUND?
	JRST	VERIER		;UNEXPECTED ERROR
	SETOM	MASTEF		;THAT'S END-OF-FILE
	$RETT			;RETURN


; READ A PROFILE FROM THE WORKING FILE
VERRDW:	SKIPE	WORKEF		;AT EOF?
	$RETT			;YES
	MOVEI	S1,(X)		;WORKING PROFILE
	MOVEI	S2,WORKWB	;POINT TO WORKING WILDCARD BLOCK
	PUSHJ	P,GETB##	;GET A PROFILE FROM FILE "B"
	$RETIT			;RETURN IF OK
	MOVEI	S1,3		;OPTION NUMBER
	PUSHJ	P,OPTB##	;GET LAST I/O ERROR ON FILE "B"
	MOVEI	S2,WORKFD	;POINT TO FD INCASE OF ERROR
	CAIE	S1,ER$RNF##	;RECORD NOT FOUND?
	JRST	VERIER		;UNEXPECTED ERROR
	SETOM	WORKEF		;THAT'S END-OF-FILE
	$RETT			;RETURN


; UPDATE A PROFILE IN THE TEMPORARY FILE
VERUPT:	PUSHJ	P,UPDC##	;UPDATE THE PROFILE IN FILE "C"
	$RETIT			;RETURN IF OK
	MOVEI	S1,3		;OPTION NUMBER
	PUSHJ	P,OPTC##	;GET LAST I/O ERROR ON FILE "C"
	MOVEI	S2,TEMPFD	;POINT TO FD
	JRST	VERUER		;REPORT UPDATE ERROR AND ABORT


; WRITE A PROFILE INTO THE TEMPORARY FILE
VERWTT:	MOVEI	S2,PUTC##	;ASSUME WRITING A NEW FILE
	SKIPN	VERALL		;SELECTIVE VERIFY?
	MOVEI	S2,UPDC##	;YES--JUST DO AN UPDATE
	PUSHJ	P,(S2)		;STUFF A PROFILE INTO THE TEMP FILE
	$RETIT			;RETURN IF OK
	MOVEI	S1,3		;OPTION NUMBER
	PUSHJ	P,OPTC##	;GET LAST I/O ERROR ON FILE "C"
	MOVEI	S2,TEMPFD	;POINT TO FD
	JRST	VEROER		;REPORT OUTPUT ERROR AND ABORT


; REPORT I/O ERRORS AND ABORT
VERIER:	WARN	(IER,<Input error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VEROER:	WARN	(OER,<Output error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERUER:	WARN	(UER,<Update error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERIOX:	SETOM	VERABO		;LITE THE ABORT FLAG
	$RETF			;RETURN


; DUMMY ROUTINES FOR ACTCHG
UGAUX%::$RETF
SUBTTL	PARSING ROUTINES -- PRSCMD - SCAN A COMMAND


;Call
;	S1/ Parser table
;	S2/ Prompt string
;Return
;	RETT - Command parsed
;	RETF - Otherwise, error message issued.

PRSCMD::MOVEM	S1,PARBLK+PAR.TB	;PARSE TABLE ADDRESS
	MOVEM	S2,PARBLK+PAR.PM	;PROMPT STRING ADDRESS

PRSCM1:	MOVE	S1,[PARBUF,,PARBUF+1]	;SET UP BLT
	SETZM	PARBUF			;CLEAR FIRST WORD
	BLT	S1,PARBUF+PAGSIZ-1	;CLEAR PARSER PAGE
	MOVEI	S1,PARBUF		;SCRATCH AREA FOR PARSING
	MOVEM	S1,PARBLK+PAR.CM
	MOVEI	S2,COM.SZ-1		;SIZE OF SCRATCH HEADER
	STORE	S2,.MSTYP(S1),MS.CNT	;INITIALIZE SCRATCH BLOCK
	SETZM	PARBLK+PAR.SR		;INPUT COMES FROM TTY
	MOVEI	S1,PAR.SZ		;SIZE OF PARSER BLOCK
	MOVEI	S2,PARBLK		;LOCATION OF PARSER BLOCK
	PUSHJ	P,PARSER##		;PARSE A COMMAND
	JUMPF	PRSCM2			;ON ERROR, BITCH.
	MOVEI	S1,COM.SZ+PARBUF	;POINT TO TOKENS
	PUSHJ	P,P$SETU##		;SET UP FOR RETRIEVAL
	$RETIT				;AND RETURN IF ALL IS WELL

PRSCM2:	WARN	(CME,<Command error; ^T/@PRT.EM(S2)/>,,PRSCM1)


; HERE ON FATAL ERRORS
PRSERR::FATAL	(CPF,<Command parse failure>)
SUBTTL	PARSING ROUTINES -- PRSSWT - SWITCHES


PRSSWT:	MOVE	S1,[SWTTAB,,SWTTAB+1] ;SET UP BLT
	SETOM	SWTTAB		;INIT FIRST WORD
	BLT	S1,SWTTAB+SWTLEN-1 ;INIT SWITCH STORAGE

PRSSWX:	PUSHJ	P,P$SWIT##	;GET A SWITCH
	JUMPF	P$CFM##		;NOT THERE--TRY FOR EOL AND RETURN
	HRRZ	S2,(S1)		;GET SWITCH STORAGE ADDRESS
	HLRZ	S1,(S1)		;GET VALUE TO STORE
	MOVEM	S1,(S2)		;SAVE IT
	JRST	PRSSWX		;LOOP BACK FOR MORE
SUBTTL	PARSING ROUTINES -- PRSWLD - USER ID


PRSWLD::MOVEI	T1,WILDBK	;POINT TO WILDCARD BLOCK
	MOVE	T2,[POINT 8,WILDAK] ;BYTE POINTER TO ACK TEXT
	MOVEM	T2,WILDBP	;SAVE FOR SUMMARY
	PUSHJ	P,A$PWLD##	;PARSE A USER-ID
	$RETIF			;CHECK FOR ERRORS
	SETZM	PROFAI		;ZERO FAILURE COUNTER
	SETZM	PROSUC		;ZERO SUCCESS COUNTER
	$RETT			;RETURN


PRSALT::MOVEI	T1,ALTRBK	;POINT TO WILDCARD BLOCK
	MOVE	T2,[POINT 8,ALTRAK] ;BYTE POINTER TO ACK TEXT
	MOVEM	T2,ALTRBP	;SAVE FOR SUMMARY
	PUSHJ	P,A$PWLD##	;PARSE A USER-ID
	$RETIF			;CHECK FOR ERRORS
	$RETT			;RETURN
SUBTTL	UTILITY ROUTINES -- CVTPPD - CONVERT A PPN FOR DETAILED LISTING


; CALL:	MOVE	U, PROFILE BLOCK ADDRESS
;	PUSHJ	P,CVTPPD
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT

CVTPPD:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVEI	P1,[ITEXT (<^O/S1/>)]
	MOVEI	P2,[ITEXT (<^O/S2/>)]
	HLRZ	S1,.AEPPN(U)	;GET PROJECT NUMBER
	HRRZ	S2,.AEPPN(U)	;AND PROGRAMMER NUMBER
	CAIN	S1,-1		;DEFAULT PROJECT?
	MOVEI	P1,[ITEXT (<%>)] ;YES
	CAIN	S2,-1		;DEFAULT PROGRAMMER?
	MOVEI	P2,[ITEXT (<%>)] ;YES
	CAIN	S2,-2		;WILD PROGRAMMER?
	MOVEI	P2,[ITEXT (<#>)] ;YES
	$TEXT	(<-1,,PPNTXT>,<[^I/(P1)/,^I/(P2)/]^0>)
	MOVEI	S1,PPNTXT	;POINT TO TEXT
	POPJ	P,		;AND RETURN
SUBTTL	UTILITY ROUTINES -- CVTPPF - CONVERT A PPN FOR FAST LISTING


; CALL:	MOVE	U, PROFILE BLOCK ADDRESS
;	PUSHJ	P,CVTPPF
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT

CVTPPF:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVEI	P1,[ITEXT (<^O6R /S1/>)]
	MOVEI	P2,[ITEXT (<^O6L /S2/>)]
	HLRZ	S1,.AEPPN(U)	;GET PROJECT NUMBER
	HRRZ	S2,.AEPPN(U)	;AND PROGRAMMER NUMBER
	CAIN	S1,-1		;DEFAULT PROJECT?
	MOVEI	P1,[ITEXT (<     %>)] ;YES
	CAIN	S2,-1		;DEFAULT PROGRAMMER?
	MOVEI	P2,[ITEXT (<%     >)] ;YES
	CAIN	S2,-2		;WILD PROGRAMMER?
	MOVEI	P2,[ITEXT (<#     >)] ;YES
	$TEXT	(<-1,,PPNTXT>,<^I/(P1)/,^I/(P2)/^0>)
	MOVEI	S1,PPNTXT	;POINT TO TEXT
	POPJ	P,		;AND RETURN
SUBTTL	UTILITY ROUTINES -- PRTBTS - BIT TABLE DRIVEN OUTPUT


; PRTBTS - PRINT OUT NAMES OF BITS WHICH ARE ON
; PRTBTX - SAME AS ABOVE, EXCEPT, IF NONE, DON'T TYPE "-NONE-"
; CALL:	MOVE	S1, IOWD TO TABLE OF BYTE POINTERS,,ASCIZ NAMES

PRTBTX::TDZA	S2,S2
PRTBTS::SETOM	S2		;INDICATE ENTRY
	JUMPGE	S1,.POPJ	;RETURN IF TABLE IS EMPTY
	PUSHJ	P,.SAVET	;SAVE T ACS
	SETO	T3,		;COUNT ARGS TYPED OUT

PRTBT1:	HLRZ	T1,1(S1)	;GET POINTER TO BYTE POINTER
	LDB	T2,(T1)		;GET BYTE
	JUMPE	T2,PRTBT2	;NOTHING THERE, IGNORE
	HRRZ	T1,1(S1)	;GET POINTER TO ASCIZ NAME
	AOSE	T3		;INCREMENT NUMBER OF ARGS TYPED OUT
	$TEXT	(,<, ^A>)	;SEPARATE FROM PREVIOUS ARBUMENT
	$TEXT	(,<^T/(T1)/^A>)	;TYPE IT OUT

PRTBT2:	AOBJN	S1,PRTBT1	;LOOP
	SKIPGE	T3		;DID WE TYPE ANYTHING?
	JUMPE	S2,.POPJ	;NO, RETURN IF WE DON'T SAY SO
	SKIPGE	T3		;TYPE ANYTHING?
	$TEXT	(,<-none-^A>)	;NO, INDICATE THE FACT
	$TEXT	(,<>)		;END IT WITH A CRLF
	POPJ	P,		;RETURN
SUBTTL	UTILITY ROUTINES -- TYPUSR - DISPLAY A PROFILE


; HERE TO DUMP A PROFILE ON THE TERMINAL OR TO A FILE
; CALL:	MOVE	U, PROFILE BLOCK ADDRESS
;	PUSHJ	P,TYPUSR

TYPUSR:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVEI	S1,ENTDEC	;POINT TO DEC-DEFINED PROFILE ENTRY TABLE
	PUSHJ	P,TYPUS1	;DISPLAY
	MOVEI	S1,ENTCUS##	;POINT TO CUSTOMER-DEFINED PROFILE ENTRY TABLE

TYPUS1:	HLRZ	P1,(S1)		;GET NUMBER OF ENTRIES IN TABLE
	MOVNS	P1		;NEGATE
	HRLZS	P1		;PUT IN LH
	HRRI	P1,1(S1)	;MAKE AOBJN POINTER TO FIRST ENTRY
	JUMPGE	P1,.RETT	;RETURN IF TABLE IS EMPTY

TYPUS2:	HRRZ	P2,(P1)		;GET A PROFILE ENTRY VECTOR ADDRESS
	MOVE	T1,CG.FLG(P2)	;GET FLAGS
	TXNE	T1,FL.NTY	;NO TYPEOUT?
	JRST	TYPUS3		;SKIP IT
	MOVEI	S1,(P2)		;VECTOR ADDRESS
	PUSHJ	P,PROTTL	;PRINT DATA

TYPUS3:	MOVX	T1,FL.XCR	;BIT TO TEST
	TDNE	T1,CG.FLG(P2)	;WANT AN EXTRA CRLF?
	$TEXT	(,<>)		;YES
	AOBJN	P1,TYPUS2	;AND LOOP
	$RETT			;DONE
SUBTTL	UTILITY ROUTINES -- WLDWCK - CHECK FOR WILDCARDED USER-ID


WLDACK:	MOVE	S1,ALTRBK+UW$WST ;GET WILDCARD SEARCH TYPE
	MOVE	S2,ALTRBK+UW$PPM ;GET POSSIBLE PPN MASK
	JRST	WLDCH1		;ENTER COMMON CODE

WLDWCK:	MOVE	S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
	MOVE	S2,WILDBK+UW$PPM ;GET POSSIBLE PPN MASK

WLDCH1:	CAIN	S1,2		;NON-WILD NAME?
	$RETF			;YES
	CAIE	S1,1		;WILD NAME?
	AOSE	S2		;NO--WILD PPN?
	$RETT			;WILD
	$RETF			;NON-WILD
SUBTTL	UTILITY ROUTINES -- WLDUSR - FETCH A PROFILE


; QUEUE UP A REQUEST TO THE ACCOUNTING DAEMON FOR A PROFILE
WLDUSR::HRRZ	T1,SELPTR	;GET POINTER TO FIRST FREE
	SKIPN	T1		;IF NONE,
	MOVEI	T1,WILDBK+UW$MIN ;ASSUME MINIMAL
	SUBI	T1,WILDBK	 ;COMPUTE WORDS OF SELECTION DATA
	HRLM	T1,WILDBK+UW$TYP ;SAVE MESSAGE LENGTH
	MOVEI	T1,WILDBK	;POINT TO WILDCARD BLOCK
	MOVEI	T2,USER		;POINT TO RESPONSE BLOCK
	SKIPE	T3,DEBUGW	;IF DEBUGGING,
	MOVSI	T3,ACTPID	;TRY TO USE THE ALTERNATE PID
	SKIPN	DEBUGQ		;WANT TIMING?
	HRRI	T3,ZZTIME	;YEP
	SETCM	T4,UNPRIV	;GET PRIV FLAG
	PJRST	A$QWLD##	;RETURN RESULT OF WILDCARD REQUEST

ALTUSR::MOVEI	T1,UW$MIN	;LENGTH OF BLOCK
	HRLM	T1,ALTRBK+UW$TYP ;SAVE IN MESSAGE
	MOVEI	T1,ALTRBK	;POINT TO WILDCARD BLOCK
	MOVEI	T2,USER		;POINT TO RESPONSE BLOCK
	SKIPE	T3,DEBUGW	;IF DEBUGGING,
	MOVSI	T3,ACTPID	;TRY TO USE THE ALTERNATE PID
	SKIPN	DEBUGQ		;WANT TIMING?
	HRRI	T3,ZZTIME	;YEP
	SETCM	T4,UNPRIV	;GET PRIV FLAG
	PJRST	A$QWLD##	;RETURN RESULT OF WILDCARD REQUEST
SUBTTL	UTILITY ROUTINES -- WLDSUM - GENERATE A WILDCARD SUMMARY


WLDSUM:	MOVEI	T1,WILDBK	;POINT TO WILDCARD MESSAGE BLOCK
	MOVE	T2,WILDBP	;GET BYTE POINTER TO ACK TEXT
	MOVE	T3,S1		;GET TEXT
	HRLZ	T4,PROSUC	;GET SUCCESS COUNT
	HRR	T4,PROFAI	;AND FAILURE COUNT
	PUSHJ	P,A$SWLD##	;GENERATE SUMMARY TEXT
	SKIPT			;AT LEAST ONE PROFILE FOUND?
	FATAL	(NSU,<^T/(S1)/>,,.RETF)
	$TEXT	(,<^M^J ^T/(S1)/>)
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROFIL - MAIN LOOP


PROFIL:	DMOVEM	S1,PROARG	;SAVE COMMAND TABLE AND PROMPT

PROFI1:	DMOVE	S1,PROARG	;GET COMMAND TABLE AND PROMPT
	PUSHJ	P,PRSCMD	;SCAN THE COMMAND
	JUMPF	PROFI1		;TRY AGAIN
	SETZM	PRSDFV		;NOT A DEFAULT VALUE YET
	PUSHJ	P,SELCHK	;CHECK FOR SELECTION IN PROGRESS
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PROFI1		;TRY AGAIN
	CAIG	S1,PROLEN	;IS THIS AN ADDRESS OR NUMBER
	JRST	PROFI3		;GO PROCESS A COMMON COMMAND
	MOVE	P1,S1		;COPY PROFILE ENTRY VECTOR ADDRESS
	MOVE	S1,CG.IDX(P1)	;GET PROFILE ENTRY INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	MOVEM	S1,CHGADR	;SAVE FOR SUBROUTINE
	PUSHJ	P,@CG.GET(P1)	;CALL PARSE ROUTINE IN ENTRY
	SKIPE	SELFLG		;SELCTION IN PROGRESS?
	PUSHJ	P,@CG.CHG(P1)	;YES--STORE DATA AWAY
	JRST	PROFI1		;AND ASK FOR ANOTHER KEYWORD

PROFI3:	PUSHJ	P,@PROTAB-1(S1)	;DISPATCH
	JUMPT	PROFI1		;LOOP BACK
	$RETF			;GIVE UP


; KEYWORD DISPATCH TABLE
PROTAB:	IFIW	PRODFL		;"DEFAULT"
	IFIW	PRODON		;"DONE"
	IFIW	PROHEL		;"HELP"
	IFIW	PROQUI		;"QUIT"
	IFIW	PRORES		;"RESTORE"
	IFIW	PROSHO		;"SHOW"
PROLEN==.-PROTAB		;LENGTH OF TABLE
SUBTTL	PROFILE PROCESSING -- PRODFL - COMMON TOPLEVEL "DEFAULT" COMMAND


PRODFL:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	P1,S1		;COPY PROFILE ENTRY VECTOR ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	S1,CG.IDX(P1)	;GET CHANGE BLOCK INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	MOVEM	S1,CHGADR	;SET FOR ROUTINE
	PJRST	@CG.DFL(P1)	;DEFAULT THE FIELD & RETURN

PRODFZ::WARN	(MND,<Entry may not be defaulted>,,.RETT)
SUBTTL	PROFILE PROCESSING -- PRODON - COMMON TOPLEVEL "DONE" COMMAND


PRODON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	JUMPF	PRODO1		;PERHAPS NOT
	$TEXT	(,<>)		;PUT OUT A BLANK LINE
	JRST	PRODO2		;AND FINISH UP

PRODO1:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS

PRODO2:	POP	P,(P)		;POP OFF CALLER
	$RETT			;RETURN TO TOP LEVEL
SUBTTL	PROFILE PROCESSING -- PROHEL - COMMON TOPLEVEL "HELP" COMMAND


PROHEL:	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PRSERR		;FAILED
	CAIG	S1,PROLEN	;IS THIS AN ADDRESS OR NUMBER
	$RETF			;SHOULD NEVER GET HERE
	PUSH	P,S1		;SAVE
	PUSHJ	P,P$CFM##	;GET EOL
	POP	P,S1		;RESTORE
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	S2,CG.HLP(S1)	;GET ADDRESS OF HELP TEXT
	$TEXT	(,<^T/(S2)/>)	;DISPLAY TEXT
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROQUI - COMMON TOPLEVEL "QUIT" COMMAND


PROQUI:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPE	SELFLG		;SELECTION IN PROGRESS?
	JRST	PROQU1		;YES
	PUSHJ	P,PRORE1	;GET ORIGINAL PROFILE (NAME MIGHT HAVE CHANGED)
	PUSHJ	P,CVTPPD	;CONVERT PPN
	INFO	(UPT,<User ^T/(S1)/ ^Q/USRNAM/ profile processing aborted>)
	$RETF			;RETURN

PROQU1:	PUSHJ	P,SELINI	;RESET SELECTION STORAGE
	INFO	(SAB,<Selection aborted>,,.RETF)
SUBTTL	PROFILE PROCESSING -- PRORES - COMMON TOPLEVEL "RESTORE" COMMAND


PRORES:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVNI	P1,1		;ASSUME NO KEYWORD SPECIFIED
	PUSHJ	P,P$KEYW##	;TRY FOR A KEYWORD
	SKIPF			;CHECK FOR ERRORS
	MOVE	P1,S1		;COPY PROFILE ENTRY VECTOR ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	JUMPL	P1,PRORE1	;JUMP IF NO KEYWORD
	MOVE	S1,CG.IDX(P1)	;GET PROFILE ENTRY INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	MOVEM	S1,CHGADR	;SAVE FOR PROFILE SUBROUTINE
	PUSHJ	P,@CG.RES(P1)	;RESTORE DATA
	$RETT			;AND RETURN

PRORE1:	MOVSI	S1,(X)		;POINT TO OLD PROFILE
	HRRI	S1,(U)		;AND TO WORKING COPY
	BLT	S1,.AEMAX-1(U)	;RESTORE ORIGINAL
	PUSHJ	P,PROZCH	;ZERO CHANGE TABLE FLAGS
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROSHO - COMMON TOPLEVEL "SHOW" COMMAND


PROSHO:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVNI	P1,1		;ASSUME NO KEYWORD SPECIFIED
	PUSHJ	P,P$KEYW##	;TRY FOR A KEYWORD
	SKIPF			;GOT ONE
	MOVE	P1,S1		;COPY PROFILE VECTOR ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	JUMPL	P1,ENTSH1	;JUMP IF NO KEYWORD
	MOVEI	S1,(P1)		;VECTOR ADDRESS
	PUSHJ	P,PROPRT	;PRINT DATA
	$RETT			;RETURN

ENTSH1:	PUSHJ	P,TYPUSR	;TYPE THE PROFILE
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROBLK - EXTENSIBLE BLOCKS


; ROUTINE TO TO ADD OR DELETE EXTENSIBLE BLOCKS FROM A
; PROFILE GIVEN A PARSER DATA BLOCK POINTER
; CALL:	MOVE	S1, PARSER DATA BLOCK ADDRESS
;	MOVE	S2, PROFILE OFFSET
;	PUSHJ	P,PROBLK
;
; TRUE RETURN:	BLOCK ADDED OR DELETED
; FALSE RETURN:	NO ROOM IN PROFILE FOR BLOCK

PROBLK::PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,S1		;COPY PARSER DATA BLOCK ADDRESS
	MOVEI	T1,(U)		;PROFILE ADDRESS
	LOAD	T2,ARG.HD(P1),AR.LEN ;GET LENGTH
	SUBI	T2,ARG.DA	;ACCOUNT FOR PARSER OVERHEAD WORDS
	CAIN	T2,1		;DELETING?
	SKIPE	ARG.DA(P1)	;AND IS THERE ANY REAL DATA?
	SKIPA			;SOMETHING VALID
	JRST	PROBL1		;YES
	MOVNS	T2		;NEGATE
	HRLZS	T2		;PUT IN LH
	HRRI	T2,(S2)		;PROFILE OFFSET
	MOVEI	T3,ARG.DA(P1)	;ADDRESS OF DATA
	JRST	PROBL2		;ENTER COMMON CODE

PROBL1:	MOVEI	T2,(S2)		;PROFILE OFFSET
	SETZ	T3,		;ZERO ADDRESS TO DELETE

PROBL2:	MOVEI	T4,0		;CLEAR .AEMAP BIT
	PJRST	A$EBLK		;ADD/DELETE EXTENSIBLE BLOCK AND RETURN
SUBTTL	PROFILE PROCESSING -- PROCHG - PERFORM ALL CHANGES


PROCHG:	PUSHJ	P,.SAVE3	;SAVE SOME ACS
	MOVE	S1,ENTKPT	;POINT TO PROFILE ENTRY TABLE
	HLRZ	P1,(S1)		;GET NUMBER OF ENTRIES IN TABLE
	MOVNS	P1		;NEGATE
	HRLZS	P1		;PUT IN LH
	HRRI	P1,1(S1)	;MAKE AOBJN POINTER TO FIRST ENTRY
	SETZ	P3,		;INIT CHANGE COUNTER
	PUSHJ	P,QINIT		;SETUP TO CHANGE A PROFILE

PROCH1:	HRRZ	P2,(P1)		;GET PROFILE ENTRY VECTOR ADDRESS
	MOVE	S1,CG.IDX(P2)	;AND ITS INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	SKIPN	(S1)		;CHANGING THIS PORTION OF THE PROFILE?
	JRST	PROCH3		;NO
	PUSHJ	P,@CG.CHG(P2)	;EXECUTE THE CHANGE
	JUMPT	PROCH2		;ONWARD IF NO ERRORS
	MOVE	S1,P3		;GET NUMBER OF CHANGES
	$RETF			;AND RETURN

PROCH2:	AOS	P3		;COUNT THE CHANGE

PROCH3:	AOBJN	P1,PROCH1	;LOOP
	SKIPN	S1,P3		;IF NOTHING TO DO,
	$RETT			;SUCCEED VACUOUSLY
	PUSHJ	P,QUEUUO	;DO THE UUO
	MOVE	S1,P3		;GET NUMBER OF CHANGES
	$RET			;PROPAGATE T/F BACK
SUBTTL	PROFILE PROCESSING -- PROCLR - CLEAR USER SPECIFIC DATA


PROCLR:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	S1,[XWD PASSWD,PASSWD+1] ;SET UP BLT
	SETZM	PASSWD		;CLEAR FIRST WORD
	BLT	S1,PASSWD+.APWLW-1 ;ZERO PASSWORD BLOCK
	MOVSI	P1,-CLRLEN	;AOBJN POINTER

PROCL1:	MOVE	S1,CLRTAB(P1)	;GET PROFILE OFFSET
	MOVE	S2,CHGTAB##(S1)	;GET FLAGS
	TXNN	S2,PD.EXT	;EXTENSIBLE BLOCK?
	JRST	PROCL2		;NO
	MOVEI	S2,(S1)		;COPY OFFSET
	ADDI	S2,(U)		;INDEX INTO PROFILE
	SKIPL	(S2)		;DATA AVAILABLE?
	JRST	PROCL3		;NO
	MOVEI	T1,(U)		;PROFILE ADDRESS
	MOVE	T2,S1		;PROFILE OFFSET
	HLL	T2,(S2)		;GET -LENGTH
	MOVEI	T3,0		;ZERO OUT BLOCK ADDRESS
	MOVEI	T4,1		;SET .AEMAP ENTRY
	PUSHJ	P,A$EBLK##	;DELETE BLOCK AND DEFAULT THE FIELD
	JRST	PROCL3		;ONWARD

PROCL2:	ADDI	S1,(U)		;INDEX INTO PROFILE
	LOAD	S2,S2,PD.WRD	;GET WORD COUNT
	SETZM	(S1)		;CLEAR A WORD
	ADDI	S1,1		;ADVANCE POINTER TO NEXT WORD
	SOJG	S2,.-2		;DO ALL WORDS IN BLOCK

PROCL3:	AOBJN	P1,PROCL1	;LOOP BACK
	POPJ	P,		;RETURN

CLRTAB:	EXP	.AEFLG		;PROFILE FLAGS
	EXP	.AEFAI		;LAST PSW VALIDATION FAILURE UDT
	EXP	.AELPC		;LAST PSW CHANGE UDT
	EXP	.AEPNM		;PERSONAL NAME
CLRLEN==.-CLRTAB		;LENGTH OF TABLE
SUBTTL	PROFILE PROCESSING -- PRODEF - FETCH DEFAULT PROFILE


PRODEF:	PUSHJ	P,.SAVE1	;SAVE P1
	SKIPN	P1,.AEPPN(U)	;SAVE PPN INCASE OF ERROR
	JRST	PRODE1		;ONLY TRY FOR THE SYSTEM DEFAULT
	HLLO	S1,P1		;MAKE DEFAULT PPN FOR PROJECT ([10,%])
	MOVEI	S2,(U)		;POINT TO STORAGE
	PUSHJ	P,QPPNIN	;FETCH IT
	JUMPT	PRODE2		;GO REPORT FINDINGS

PRODE1:	MOVNI	S1,1		;GET DEFAULT PPN FOR ALL PROJECTS ([%,%])
	MOVEI	S2,(U)		;POINT TO STORAGE
	PUSHJ	P,QPPNIN	;FETCH IT
	JUMPT	PRODE2		;GO REPORT FINDINGS
	MOVEI	S1,(U)		;NOT FOUND,
	HRLI	S1,USER0	;SO USE AN EMPTY PROFILE
	BLT	S1,.AEMAX-1(U)	;RATHER THAN ACTDAE ERROR MESSAGE
	HLRZ	S2,P1		;PUT PROJECT NUMBER IN RH
	MOVEI	S1,[ITEXT (<project ^O/S2/>)]
	SKIPN	S2		;HAVE A PROJECT?
	MOVEI	S1,[ITEXT (<system-wide>)] ;NO
	WARN	(NDF,<No default ^I/(S1)/ profile found>,,PRODE3)

PRODE2:	PUSHJ	P,CVTPPD	;CONVERT PPN
	INFO	(DPL,<Default profile loaded: ^T/(S1)/>)

PRODE3:	PUSHJ	P,PROCLR	;CLEAR USER SPECIFIC DATA
	MOVEM	P1,.AEPPN(U)	;REPLACE PPN
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROFSP - FETCH A FILESPEC


PROFSP::PUSHJ	P,P$FILE##	;GET FD BLOCK
	$RETIF			;RETURN ON ERRORS
	MOVSI	S2,'...'	;GET PLACE HOLDER VALUE
	CAMN	S2,.FDSTR(S1)	;DEVICE SPECIFIED?
	SETZM	.FDSTR(S1)	;NO, ZERO DEVICE WORD
	LOAD	S2,.FDLEN(S1),FD.LEN ;GET FD LENGTH
	SUBI	S2,ARG.DA	;ACCOUNT FOR OVERHEAD
	MOVNS	S2		;NEGATE
	HRLZS	S2		;PUT IN LH
	HRRI	S2,.FDSTR(S1)	;MAKE AN AOBJN POINTER
	SKIPN	(S2)		;NULL?
	AOBJN	S2,.-1		;SEARCH ENTIRE FD
	JUMPL	S2,.RETT	;RETURN IF SOMETHING TYPED
	MOVEI	S2,ARG.DA+1	;OVERHEAD + ZERO WORD
	STORE	S2,.FDLEN(S1),FD.LEN ;CUTE WAY TO SAY BLOCK IS EMPTY
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PRONAM - GENERATE USER NAME BASED ON PPN


PRONAM:	MOVSI	S1,.AENAM(U)	;POINT TO STORAGE
	HRRI	S1,.AENAM+1(U)	;MAKE A BLT POINTER
	SETZM	.AENAM(U)	;CLEAR FIRST WORD
	BLT	S1,.AENAM+.AANLW-1(U) ;CLEAR ENTIRE BLOCK
	MOVE	S1,.AEPPN(U)	;GET PPN WE'RE HACKING
	PUSHJ	P,A$CKPP##	;MAKE A NAME FOR IT
	SETCAM	TF,RESPPN	;PROFILE IS FOR A RESERVED PPN
	$TEXT	(<POINT 8,.AENAM(U),-1>,<^T/(S1)/^0>)
	POPJ	P,		;DONE
SUBTTL	PROFILE PROCESSING -- PROPSW - DEFAULT A PASSWORD


PROPSW:	PUSHJ	P,.SAVE4	;SAVE SOME ACS
	LOAD	S1,.AEREQ(X),AE.PWL ;GET MINIMUM PASSWORD LENGTH
	CAIN	S1,0		;ZERO ? (NONE SPECIFIED)
	MOVEI	S1,DEFPSZ	;USE DEFAULT
	MOVEI	S2,(S1)		;COPY
	PUSHJ	P,GENPSW	;GENERATE A PASSWORD
	SUBB	S2,S1		;GET COUNT OF CHARACTERS GENERATED
	IDIVI	S2,.APWCW	;GET NUMBER OF WORDS REQUIRED
	SKIPE	T1		;REMAINDER?
	ADDI	S2,1		;YES
	HRL	S2,S1		;MAKE IT #CHRS,,#WORDS
	MOVEI	T1,10		;8-BIT ASCIZ
	MOVE	S1,[.APWLW+ARG.DA,,.CMFLD]
	MOVEM	S1,PASSHD+ARG.HD ;SAVE PARSER DATA BLOCK HEADER WORD
	MOVEI	S1,PASSHD	;POINT TO BLOCK
	PUSHJ	P,PROSTR	;FIX UP STRING AS NECESSARY
	$RETT			;AND RETURN
; ROUTINE TO GENERATE A FULL LENGTH PASSWORD CONTAINING THINGS
; THAT LOOK LIKE SYLLABLES.  THE PASSWORD WILL CONTAIN ALL
; UPPERCASE CHARACTERS.
GENPSW:	MOVEI	P3,.APWLC	;GET MAX PASSWORD SIZE
	MOVE	P4,[POINT 8,PASSWD] ;GET TARGET POINTER
RANPW0:	PUSHJ	P,RANDOM	;GET A RANDOM NUMBER
	MOVEI	T2,STRL
	FSC	T2,233
	FMPR	T2,T1
	FIX	T1,T2
	MOVE	P1,STRPTR(T1)
	SETZ	P2,
RANPW1:	PUSHJ	P,RANDOM	;GET A RANDOM NUMBER
	HLRZ	T2,(P1)
	FSC	T2,233
	FMPR	T2,T1
	FIX	T1,T2
	HRRZ	T2,(P1)
	ADD	T1,T2
	LSH	P2,6
	ADD	P2,(T1)
	AOBJN	P1,RANPW1
	MOVE	T2,P2		;GET SIXBIT RESULT
GENPS3:	LSHC	T1,6		;SHIFT IN A CHARACTER
	ANDI	T1,77		;MASK OUT JUNK
	JUMPE	T1,GENPS4	;LEADING BLANKS?
	ADDI	T1,40		;MAKE ASCII
	IDPB	T1,P4		;STORE
	SOJLE	P3,.POPJ	;COUNT DOWN
	SOS	S1		;COUNT DOWN AGAINST USER LIMIT
GENPS4:	JUMPN	T2,GENPS3	;LOOP BACK IF MORE CHARACTERS
	SKIPLE	S1		;QUIT IF USER LIMIT FOUND
	JUMPN	P3,RANPW0	;LOOP BACK IF PASSWORD INCOMPLETE
	POPJ	P,

RANDOM:	SKIPE	T1,ROOT		;HAVE A SEED?
	JRST	RAN1		;YES
	TIMER	T1,		;GET TIME IN JIFFIES
	FSC	T1,211
	MOVEM	T1,ROOT
RAN1:	FMPR	T1,ROOT
	FADRI	T1,(47.)
	FDVR	T1,ROOT
	FSC	T1,-1
	FSBRM	T1,ROOT
	MOVNS	T1,ROOT
	TLZ	T1,777700
	FSC	T1,203
	POPJ	P,


; TABLE OF CONSONANTS
CON:	'B'
	'C'
	'D'
	'F'
	'G'
	'H'
	'J'
	'K'
	'L'
	'M'
	'N'
	'P'
	'R'
	'S'
	'T'
	'V'
	'W'
	'X'
	'Y'
	'Z'
CONL==.-CON

; TABLE OF VOWELS
VOW:	'A'
	'E'
	'I'
	'O'
	'U'
VOWL==.-VOW

STR45:	XWD	CONL,CON
	XWD	VOWL,VOW
	XWD	CONL,CON
	XWD	VOWL,VOW
	XWD	CONL,CON
STR6:	XWD	CONL,CON
	XWD	VOWL,VOW
	XWD	CONL,CON
	XWD	CONL,CON
	XWD	VOWL,VOW
	XWD	CONL,CON

STRPTR:	XWD	-4,STR45
	XWD	-5,STR45
	XWD	-6,STR6
STRL==.-STRPTR
SUBTTL	PROFILE PROCESSING -- PROSTR - STRING CHECKING


; ROUTINE TO CHECK STRING LENGTHS AND CLEAN UP POSSIBLE JUNK
; LEFT OVER BY THE PARSER.
; CALL:	MOVE	S1, PARSER DATA BLOCK ADDRESS
;	MOVE	S2, MAX # CHRS,,MAX # WORDS
;	MOVE	T1, BYTE SIZE
;	PUSHJ	P,PROSTR

PROSTR::PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	DMOVE	P1,S1		;COPY ARGS
	MOVEI	S1,^D36		;36-BITS PER WORD
	IDIVI	S1,(T1)		;S2 GETS NUMBER OF JUNK BITS
	IMULI	S1,(P2)		;GET MAX. BYTES IN BLOCK
	HRLI	T1,(S1)		;SAVE
	MOVSI	S1,-1		;WILL HANDLE UP TO 18 BIT BYTES
	ROT	S1,(S2)		;GET MASK FOR CLEARING JUNK BITS
	HRRZS	S1		;ISOLATE MASK
	PUSH	P,S1		;SAVE FOR A SECOND
	HRRZ	S2,P2		;GET MAXIMUM WORD COUNT
	LOAD	TF,ARG.HD(P1),AR.LEN ;GET BLOCK LENGTH
	CAILE	TF,ARG.DA(S2)	;IMPOSE LENGTH RESTRICTIONS
	MOVEI	TF,ARG.DA(S2)	;MUST REDUCE
	STORE	TF,ARG.HD(P1),AR.LEN ;REDUCE
	SUBI	TF,ARG.DA	;ACCOUNT FOR GALACTIC OVERHEAD
	MOVEI	S1,ARG.DA(P1)	;POINT TO START OF DATA
	POP	P,S2		;GET MASK BACK
	ANDCAM	S2,(S1)		;CLEAR JUNK BITS
	ADDI	S1,1		;ADVANCE ADDRESS POINTER
	SOJG	TF,.-2		;DO ALL WORDS
	MOVEI	S1,ARG.DA(P1)	;POINT TO START OF DATA
	DPB	T1,[POINT 6,S1,11] ;STORE BYTE SIZE IN BYTE POINTER
	TLO	S1,440000	;FINISH IT
	HLRZ	S2,P2		;GET BYTE COUNT

PROST1:	ILDB	TF,S1		;GET A CHARACTER
	SKIPE	TF		;NUL?
	SOJG	S2,PROST1	;LOOP
	HLRZ	TF,T1		;GET MAX. BYTE COUNT
	SUB	TF,S2		;NUMBER REMAINING TO ZERO
	JUMPE	TF,PROST2	;DON'T PROCEED IF DONE
	SETZ	S2,		;TO CLEAR OUT REMAINDER
	IDPB	S2,S1		;TERMINATE
	SOJG	TF,.-1		;CLEAN OUT REMAINDER OF THE BLOCK

PROST2:	POPJ	P,		;RETURN
SUBTTL	PROFILE PROCESSING -- PROPRT - PRINT PROFILE DATA


; PRINT DATA ABOUT PROFILE ENTRIES
; CALL:	MOVE	S1, ENTRY VECTOR ADDRESS
;	PUSHJ	P,PROPRT/PROTTL

PROPRT:	TDZA	S2,S2		;PRINT DATA
PROTTL:	MOVEI	S2,1		;PRINT TITLE AND DATA
	PUSHJ	P,.SAVET	;SAVE T1-T4
	PUSH	P,[EXP 0]	;SAVE A FLAG
	PUSH	P,S2		;SAVE FLAG
	MOVEI	T1,(U)		;POINT TO PROFILE
	SKIPGE	T2,CG.PFL(S1)	;GET PROFILE OFFSET
	JRST	PROPR1		;FIELD CANNOT BE DEFAULTED
	MOVNI	T3,1		;FLAG
	PUSHJ	P,A$BMAP##	;CHECK STATUS
	JUMPF	PROPR1		;JUMP IF NOT DEFAULTED
	SETOM	-1(P)		;REMEMBER DEFAULTED STATUS
	SKIPA	S2,["*"]	;ASTERISK FOR A DEFAULTED FIELD
PROPR1:	MOVEI	S2," "		;ELSE NON-DEFAULTED FIELD
	$TEXT	(,< ^7/S2/ ^A>)	;DISPLAY FLAG
	POP	P,S2		;GET TITLE FLAG
	SKIPE	S2		;WANT TITLE?
	$TEXT	(,<^T/@CG.PRM(S1)/: ^A>) ;YES
	POP	P,S2		;GET DEFAULTED FLAG
	JUMPE	S2,PROPR2	;JUMP IF NOT
	MOVE	S2,CG.IDX(S1)	;GET PROFILE ENTRY INDEX
	ADD	S2,CHGPTR	;INDEX INTO CHANGE TABLE
	MOVE	S2,(S2)		;GET CHANGE FLAG FOR THIS ENTRY
	JUMPE	S2,PROPR2	;JUMP IF IT'S CHANGED
	$TEXT	(,<-unknown->)	;ELSE SAY WE DON'T KNOW
	$RETT			;RETURN

PROPR2:	PUSHJ	P,@CG.PRT(S1)	;PRINT DATA
	$RETT			;RETURN
SUBTTL	PROFILE PROCESSING -- PROUPD - UPDATE A PROFILE FROM A STATIC BLOCK


PROUPD:	PUSHJ	P,.SAVE3	;SAVE SOME ACS
	MOVE	S1,[CHGMSK,,CHGMS2] ;NEED TO SAVE THIS BECAUSE OF RESTORES
	BLT	S1,CHGMS2+.AEMIN-1 ;SO SAVE IT
	MOVE	S1,ENTKPT	;POINT TO PROFILE ENTRY TABLE
	HLRZ	P1,(S1)		;GET NUMBER OF ENTRIES IN TABLE
	MOVNS	P1		;NEGATE
	HRLZS	P1		;PUT IN LH
	HRRI	P1,1(S1)	;MAKE AOBJN POINTER TO FIRST ENTRY
	SETZ	P3,		;INIT CHANGE COUNTER

PROUP1:	HRRZ	P2,(P1)		;GET PROFILE ENTRY VECTOR ADDRESS
	MOVE	S1,CG.IDX(P2)	;AND ITS INDEX
	ADD	S1,CHGPTR	;INDEX INTO CHANGE TABLE
	SKIPN	(S1)		;CHANGING THIS PORTION OF THE PROFILE?
	JRST	PROUP3		;NO
	PUSHJ	P,@CG.CMP(P2)	;COMPARE INCASE WAS CHANGED BACK TO ORIGINAL
	JUMPT	PROUP3		;NOTHING REALLY CHANGED

PROUP2:	PUSHJ	P,@CG.RES(P2)	;RESTORE DATA
	SETOM	@CHGADR		;RESTORE FLAG TO "CHANGED" STATE
	JUMPT	PROUP3		;ONWARD IF NO ERRORS
	PUSHJ	P,PROUP4	;SETUP RETURN
	$RETF			;AND RETURN FAILURE

PROUP3:	AOBJN	P1,PROUP1	;LOOP

PROUP4:	MOVE	S1,[CHGMS2,,CHGMSK] ;BLT VECTOR
	BLT	S1,CHGMSK+.AEMIN-1 ;RESTORE MASKS
	MOVE	S1,P3		;GET NUMBER OF CHANGES
	$RETT			;AND RETURN
SUBTTL	PROFILE PROCESSING -- PROZCH - ZERO PROFILE ENTRY CHANGE TABLE


PROZCH:	MOVE	S1,CHGPTR	;GET ADDRESS OF CHANGE TABLE
	MOVSI	S2,(S1)		;POINT TO START ADDRESS
	HRRI	S2,1(S1)	;MAKE A BLT POINTER
	SETZM	(S1)		;CLEAR FIRST WORD
	ADD	S1,CHGCTR	;COMPUTE END OF BLT
	BLT	S2,-1(S1)	;ZERO TABLE

PROZQM:	MOVE	S1,[CHGMSK,,CHGMSK+1] ;BLT POINTER
	SETZM	CHGMSK		;CLEAR FIRST WORD OF CHANGE MASKS
	BLT	S1,CHGMSK+.AEMIN-1	;ZERO TABLE
	POPJ	P,		;RETURN
SUBTTL	PROFILE PROCESSING -- PROZPB - ZERO PROFILE BLOCK


PROZPB:	MOVSI	S1,USER0	;POINT TO INIT'ED USER BLOCK
	HRRI	S1,(U)		;AND TO CURRENT BLOCK
	BLT	S1,.AEMAX-1(U)	;RE-INIT PROFILE
	POPJ	P,		;RETURN
SUBTTL	ENTRIES -- TABLE INITIALIZATION


ENTINI:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	HLRZ	S1,ENTDEC	;GET COUNT OF DEC-DEFINED PROFILE ENTRIES
	HLRZ	S2,ENTCUS##	;GET COUNT OF CUSTOMER-DEFINED PROFILE ENTRIES
	ADDI	S1,1(S2)	;TOTAL THEM UP
	PUSHJ	P,M%GMEM	;GET SOME CORE
	MOVEM	S2,ENTKPT	;SAVE FOR PARSING
	MOVEI	S2,-1(S1)	;GET CORRECTED COUNT
	MOVEM	S2,@ENTKPT	;SAVE WORD COUNT TOO
	PUSHJ	P,M%GMEM	;GET MORE CORE
	MOVEM	S2,ENTHPT	;SAVE FOR HELP
	SUBI	S1,1		;GET CORRECTED COUNT
	MOVEM	S1,@ENTHPT	;SAVE WORD COUNT TOO
	PUSHJ	P,M%GMEM	;GET MORE CORE
	MOVEM	S1,CHGCTR	;SAVE CHANGE TABLE WORD COUNT
	MOVEM	S2,CHGPTR	;SAVE CHANGE TABLE ADDRESS
	MOVEI	P1,ENTDEC	;POINT TO DEC-DEFINED TABLE
	PUSHJ	P,ENTIN1	;LOAD WORKING COMMAND TABLE
	MOVEI	P1,ENTCUS##	;POINT TO CUSTOMER-DEFINED TABLE

ENTIN1:	HLRZ	S1,(P1)		;GET NUMBER OF ENTRIES IN TABLE
	JUMPE	S1,.RETT	;RETURN IF TABLE IS EMPTY
	MOVNS	S1		;NEGATE
	HRL	P1,S1		;GET -LENGTH
	HRRI	P1,1(P1)	;MAKE AN AOBJN POINTER

ENTIN2:	HRRZ	P2,(P1)		;GET PROFILE ENTRY VECTOR ADDRESS
	SKIPL	S1,CG.PFL(P2)	;AND PROFILE OFFSET
	SKIPN	UNPRIV		;UNPRIV'ED USER?
	JRST	ENTIN3		;NO
	MOVE	S1,CHGTAB##(S1)	;FLAGS
	TXNN	S1,PD.UNP	;UNPRIV'ED PROFILE DATA?
	JRST	ENTIN4		;NO--STUFF IN HELP TABLE INSTEAD

ENTIN3:	MOVE	S1,ENTKPT	;POINT TO TABLE HEADER
	MOVE	S2,(P1)		;GET KEYWORD ADDRESS
	PUSHJ	P,S%TBAD	;INSERT INTO TABLE
	JUMPT	ENTIN4		;CHECK FOR ERRORS
	CAIN	S1,EREIT$	;ENTRY ALREADY IN TABLE?
	JRST	ENTIN5		;YES--PROBABLY THE NULL KEYWORD
	STOPCD	(EIF,HALT,,<Profile entry table initialization failure>)

ENTIN4:	HLRZ	S2,(P1)		;GET A KEYWORD
	SKIPE	S1,(S2)		;MUST CHECK
	TLNE	S1,(177B6)	;FIRST CHARACTER ZERO AND WORD NO ALL ZERO?
	TDZA	S1,S1		;NO--MAKE FLAGS ALL ZERO
	AOS	S2		;ADJUST TEXT POINTER
	TXNE	S1,CM%INV	;TEST FLAGS
	JRST	ENTIN5		;DON'T INCLUDE
	MOVE	S1,ENTHPT	;POINT TO TABLE HEADER
	HRLZS	S2		;POSITION KEYWORD
	HRR	S2,(P1)		;INCLUDE DATA
	PUSHJ	P,S%TBAD	;INSERT INTO TABLE
	JUMPT	ENTIN5		;CHECK FOR ERRORS
	STOPCD	(HIF,HALT,,<Help table initialization failure>)

ENTIN5:	AOBJN	P1,ENTIN2	;LOOP

; PARSING
	MOVE	S1,[ENTKBK,,ENTKEY] ;SET UP BLT
	BLT	S1,ENTKEY+PB%SIZ-1 ;COPY
	MOVE	S1,ENTKPT	;GET TABLE ADDRESS
	MOVEM	S1,ENTKEY+1+.CMDAT ;SAVE

; "DEFAULT"
	MOVE	S1,[ENTDBK,,ENTDEF] ;SET UP BLT
	BLT	S1,ENTDEF+PB%SIZ-1 ;COPY
	MOVE	S1,ENTKPT	;GET TABLE ADDRESS
	MOVEM	S1,ENTDEF+1+.CMDAT ;SAVE

; "HELP"
	MOVE	S1,[ENTHBK,,ENTHLP] ;SET UP BLT
	BLT	S1,ENTHLP+PB%SIZ-1 ;COPY
	MOVE	S1,ENTHPT	;GET TABLE ADDRESS
	MOVEM	S1,ENTHLP+1+.CMDAT ;SAVE

; "RESTORE"
	MOVE	S1,[ENTRBK,,ENTRST] ;SET UP BLT
	BLT	S1,ENTRST+PB%SIZ-1 ;COPY
	MOVE	S1,ENTKPT	;GET TABLE ADDRESS
	MOVEM	S1,ENTRST+1+.CMDAT ;SAVE

; "SELECT"
	MOVE	S1,[ENTSBK,,ENTSLC] ;SET UP BLT
	BLT	S1,ENTSLC+PB%SIZ-1 ;COPY
	MOVE	S1,ENTKPT	;GET TABLE ADDRESS
	MOVEM	S1,ENTSLC+1+.CMDAT ;SAVE
	$RETT			;RETURN


; PARSER DATA BLOCK FOR PARSING
ENTKBK:	$KEYDSP	(.,<$NEXT(.),$ACTION(ENTAPR),$ALTER(ENT010)>)
	BLOCK	PB%SIZ-<.-ENTKBK>


; PARSER DATA BLOCK FOR "DEFAULT"
ENTDBK:	$KEY	(CONFRM,.,<$ACTION(ENTADF)>)
	BLOCK	PB%SIZ-<.-ENTDBK>


; PARSER DATA BLOCK FOR "HELP"
ENTHBK:	$KEY	(CONFRM,.,<$ACTION(ENTAHL)>)
	BLOCK	PB%SIZ-<.-ENTHBK>


; PARSER DATA BLOCK FOR "SELECT"
ENTSBK:	$KEY	(CONFRM,.,<$ACTION(ENTASL)>)
	BLOCK	PB%SIZ-<.-ENTSBK>


; PARSER DATA BLOCK FOR "RESTORE"
ENTRBK:	$KEY	(CONFRM,.,<$ACTION(ENTARS),$ALTER(CONFRM)>)
SUBTTL	ENTRIES -- KEYWORD TABLES


ENT000:	$INIT	(ENTKEY)
ENT010:	$KEYDSP	(ENTCOM)
ENT020:	$KEYDSP	(ENTSEL)

; DEC-DEFINED ENTRY TYPES
ENTDEC:	$STAB
	KEYTAB	(PPX,<PPN>,CM%NOR)
 	KEYTAB	(NAM,<NAME>)
	KEYTAB	(PDF,<PROFILE-DEFAULT>)
	KEYTAB	(PNM,<PERSONAL-NAME>)
  	KEYTAB	(DST,<DISTRIBUTION-LOCATION>)
	KEYTAB	(MAI,<MAILING-ADDRESS>)

	KEYTAB	(NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
	KEYTAB	(PSW,<PASSWORD>)
	KEYTAB	(EXP,<EXPIRATION-DATE>)
	KEYTAB	(LTI,<LOGIN-TIMES>)
	KEYTAB	(ACC,<ACCESS-TYPES>)
	KEYTAB	(RQL,<REQUIREMENTS>)
	KEYTAB	(SCH,<SCHEDULAR-TYPE>)
	KEYTAB	(PRG,<PROGRAM-TO-RUN>)

	KEYTAB	(NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
	KEYTAB	(CTX,<CONTEXT-QUOTAS>)
	KEYTAB	(COR,<CORE-LIMITS>)
  	KEYTAB	(ENQ,<ENQ-DEQ-QUOTA>)
	KEYTAB	(IPC,<IPCF-QUOTAS>)
	KEYTAB	(PRV,<PRIVILEGES>)
	KEYTAB	(SPO,<SPOOLED-DEVICES>)
	KEYTAB	(WAT,<WATCH-BITS>)

	KEYTAB	(NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
	KEYTAB	(STR,<STRUCTURE-QUOTAS>)

	KEYTAB	(NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
	KEYTAB	(ADM,<ADMINISTRATIVE-DATA>,CM%NOR)
	$ETAB
; DEC AND CUSTOMER COMMON KEYWORDS
ENTCOM:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(ENTC10,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(ENTC20,3,<HELP>)
	DSPTAB	(CONFRM,4,<QUI>,CM%NOR)
	DSPTAB	(CONFRM,4,<QUIT>)
	DSPTAB	(ENTRST,5,<RESTORE>)
	DSPTAB	(ENTC30,6,<SHOW>)
	$ETAB
ENTC10:	$NOISE	(ENTDEF,<entry>)
ENTC20:	$NOISE	(ENTHLP,<with>)
ENTC30:	$CRLF	(<$ALTER(ENTHLP)>)


; DEC AND CUSTOMER SELECTION KEYWORDS
ENTSEL:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
;	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(ENTC10,3,<HELP>)
	DSPTAB	(CONFRM,4,<QUI>,CM%NOR)
	DSPTAB	(CONFRM,4,<QUIT>)
;	DSPTAB	(ENTRST,5,<RESTORE>)
	DSPTAB	(ENTC20,6,<SHOW>)
	$ETAB



; COMMON ENTRY ACTION ROUTINE TO SET THE NEXT PARSER DATA BLOCK
ENTASL:!
ENTAPR:	HRRZ	S1,@CR.RES(S2)	;GET ADDR OF TABLE ENTRY
	HRRZ	S1,CG.PRS(S1)	;GET ADDR OF NEXT PARSE BLOCK
	PUSH	P,S1		;SAVE FOR A SECOND
	LOAD	S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
	PUSHJ	P,P$GPDB##	;GET ADDR WORKING COPY
	POP	P,PB%NXT(S1)	;POINT TO NEXT TABLE FOR PARSING
	$RETT			;AND RETURN


; COMMON ENTRY ACTION ROUTINE FOR "DEFAULT", "HELP", AND "RESTORE"
ENTADF:!
ENTAHL:!
ENTARS:	LOAD	S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
	PUSHJ	P,P$GPDB##	;GET ADDR WORKING COPY
	MOVEI	S2,CONFRM	;TERMINATE
	MOVEM	S2,PB%NXT(S1)	; COMMAND
	$RETT			;AND RETURN

SUBTTL	ENTRIES -- ACC - ACCESS-TYPES


	.ENTRY	(ACC,.AEACC,<Access types>)

ACCPRS:	$NOISE	(CONFRM,<allowed>)
ACC000:	$INIT	(ACC010)
ACC010:	$KEYDSP	(ACC020,<$ALTER(ACC030)>)
ACC020:	$STAB
	DSPTAB	(ACC010,[AE.ROP],<ANF-CTY>)
        DSPTAB	(ACC010,[AE.BAT],<BATCH>)
        DSPTAB	(ACC010,[AE.DST],<DATA-SET>)
	DSPTAB	(ACC010,[AE.FIO],<FILES-ONLY>)
        DSPTAB	(ACC010,[AE.LOC],<LOCAL>)
        DSPTAB	(ACC010,[AE.FAL],<NETWORK-FILE-ACCESS>)
	DSPTAB	(ACC010,[AE.CDR],<PHYSICAL-CARD-READER>)
        DSPTAB	(ACC010,[AE.RMT],<REMOTE>)
        DSPTAB	(ACC010,[AE.SBJ],<SUBJOB-OF-BATCH>)
	$ETAB

ACC030:	$KEYDSP	(ACC040,$ALTER(CONFRM))
ACC040:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(ACC050,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
ACC050:	$KEYDSP	(ACC020)
; GET ROUTINE
ACCGET:	PUSHJ	P,.SAVE1	;SAVE P1

ACCGE1:	MOVEI	S1,ACC000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ\ACCESS-TYPES>\]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

ACCGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	ACCGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAIG	S1,ACCLEN	;ADDRESS OF BIT?
	JRST	ACCGE3		;NO--KEYWORD
	MOVE	S2,(S1)		;YES, GET THE BIT
	IORM	S2,.AEACC(U)	;SET IT	ALWAYS
	SKIPE	P1		;SKIP IF SETTING VALUE
	ANDCAM	S2,.AEACC(U)	;ZERO THE BIT
	SETZ	P1,		;CLEAR "NO" FLAG
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	IORM	S2,CHGMSK+.AEACC ;LIGHT IN THE CHANGE MASK
	JRST	ACCGE2		;AND LOOP

ACCGE3:	PUSHJ	P,@ACCTAB(S1)	;DISPATCH TO KEYWORD PROCESSOR
	JRST	ACCGE2		;AND LOOP BACK


; COMPARE ROUTINE
ACCCMP:	MOVEI	S1,.AEACC	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
ACCCHG:	MOVEI	S1,.AEACC	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
ACCDFL:	MOVX	S1,DF.ACC	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$ACC(U)	;LIGHT IN BIT MAP
	SETOM	PRSDFV		;REMEMBER WE CARE
	SETOM	@CHGADR		;WE CHANGED THIS ENTRY
	SETOM	CHGMSK+.AEACC	;AND THIS FIELD
	$RETT			;WIN


; RESTORE ROUTINE
ACCRES:	MOVE	S1,.AEACC(X)	;GET ORIGINAL ACCESS BITS
	MOVEM	S1,.AEACC(U)	;RESTORE
	MOVX	S1,DF.ACC	;GET .AEACC DEFAULT BIT
	ANDCAM	S1,DF$ACC(U)	;CLEAR IN WORKING PROFILE
	TDNE	S1,DF$ACC(X)	;WAS IT SET IN ORIGINAL?
	IORM	S1,DF$ACC(U)	;YES, FIX IT
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEACC	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
ACCPRT:	MOVE	S1,[IOWD ACCBEN-ACCBIT,ACCBIT] ;POINTER TO LIST OF BITS
	PUSHJ	P,PRTBTS	;TYPE OUT BITS
	$RETT


; HELP TEXT
ACCHLP:	ASCIZ	\
ACCESS-TYPES specifies the types of  access  allowed  to  the  specified
user.   ACCESS refers to any attempt by a user or in behalf of a user to
gain access to the system using a correct  combination  of  user-id  and
password.
\
; BIT STORAGE/DISPLAY TABLE
ACCBIT:	XWD [POINTR .AEACC(U),AE.CDR],[ASCIZ \Card reader\]
	XWD [POINTR .AEACC(U),AE.FAL],[ASCIZ \Network file access\]
	XWD [POINTR .AEACC(U),AE.LOC],[ASCIZ \Local\]
	XWD [POINTR .AEACC(U),AE.ROP],[ASCIZ \ANF CTY\]
	XWD [POINTR .AEACC(U),AE.DST],[ASCIZ \Dataset\]
	XWD [POINTR .AEACC(U),AE.RMT],[ASCIZ \Remote\]
	XWD [POINTR .AEACC(U),AE.SBJ],[ASCIZ \Subjob of batch\]
	XWD [POINTR .AEACC(U),AE.BAT],[ASCIZ \Batch\]
	XWD [POINTR .AEACC(U),AE.FIO],[ASCIZ \Files only\]
ACCBEN:!
; KEYWORD DISPATCH TABLE
ACCTAB:	IFIW	ACCALL		;"ALL"
	IFIW	ACCDEF		;"DEFAULT"
	IFIW	ACCDON		;"DONE"
	IFIW	ACCHLX		;"HELP"
	IFIW	ACCNO		;"NO"
	IFIW	ACCNON		;"NONE"
	IFIW	ACCRES		;"RESTORE"
	IFIW	ACCPRT		;"SHOW"
ACCLEN==.-ACCTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
ACCALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,^-AE.FIO	;ALL ACCESS BITS BUT NOT "FILES ONLY"
	MOVEM	S1,.AEACC(U)	;TURN ON ALL ACCESS METHODS
ACCGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETOM	CHGMSK+.AEACC	;BOTH PLACES
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN


; "DEFAULT" KEYWORD PROCESSOR
ACCDEF:	PUSHJ	P,ACCDFL	;DO DEFAULTING
	PJRST	ACCGO		;FINISH UP


; "DONE" KEYWORD PROCESSOR
ACCDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	ADJSP	P,-1		;WE WILL RETURN ON BEHALF OF CALLER
	MOVEI	S1,.AEACC	;PROFILE OFFSET WE'RE DOING
	PJRST	CMPVAL		;SET CHANGE FLAGS ACCORDINGLY AND RETURN


; "HELP" KEYWORD PROCESSOR
ACCHLX:	PUSHJ	P,P$CFM		;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@ACC+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN


; "NO" KEYWORD PROCESSOR
ACCNO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;RETURN


; "NONE" KEYWORD PROCESSOR
ACCNON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,AE.FIO	;NO ACCESS MEANS "FILES ONLY"
	MOVEM	S1,.AEACC(U)	;SAVE BIT
	PJRST	ACCGO		;GO SET THE MASKS
SUBTTL	ENTRIES -- ADM - ADMINISTRATIVE DATA


	.ENTRY	(ADM,-1,<Administrative data>)


ADMPRS:	$CRLF


; GET ROUTINE
ADMGET:	$RETT


; COMPARE ROUTINE
ADMCMP:	$RETT


; CHANGE ROUTINE
ADMCHG:	$RETF


; DEFAULT ROUTINE
ADMDFL:	PJRST	PRODFZ		;NO CAN DO


; RESTORE ROUTINE
ADMRES:	$RETF


; PRINT ROUTINE
ADMPRT:	MOVE	S1,.AEPAP(U)	;GET LAST CHANGE PPN
	MOVE	S2,.AETIM(U)	;GET LAST CHANGE DATE/TIME
	$TEXT	(,<^M^J	Profile last changed by ^U/S1/ at ^H/S2/>)
	SKIPE	.AEFAI(U)	;ACCOUNT ACCESSED EVER?
	JRST	ADMPR1		;YES
	MOVEI	T1,[ITEXT(<-never->)] ;NO
	JRST	ADMPR2
ADMPR1:	MOVX	S1,AE.FAI	;GET ACCESS FAILURE BIT
	TDNE	S1,.AEFLG(U)	;SUCCESS?
	SKIPA	S1,[[ASCIZ\failed\]] ;NOPE
	MOVEI	S1,[ASCIZ\succeeded\] ;YES
	MOVEI	T1,[ITEXT(<^T/(S1)/ on ^H/.AEFAI(U)/>)]
ADMPR2:	$TEXT	(,<	Last access ^I/(T1)/>)
	SKIPN	.AELPC(U)	;LAST PASSWORD CHANGE?
	SKIPA	T1,[[ITEXT(<-none->)]] ;NO
	MOVEI	T1,[ITEXT(< at ^H/.AELPC(U)/>)] ;YES
	$TEXT	(,<	Last password change ^I/(T1)/>)
	$RETT			;RETURN


; HELP TEXT
ADMHLP:	ASCIZ	\
ADMINISTRATIVE DATA are those quantities maintained  by  the  accounting
system  to  track profile changes.  These values cannot be changed using
REACT, nor can they be defaulted.
\
SUBTTL	ENTRIES -- CTX - CONTEXT-QUOTAS


	.ENTRY	(CTX,.AECTX,<Context-quotas>)

CTXPRS:	$NUMBER	(CTX010,^D10,<saved contexts>,<$PDEFAULT(DEFTX1),$PREFIL(CTXACT)>)
CTX010:	$NUMBER	(CONFRM,^D10,<saved pages>,<$PDEFAULT(DEFTX2)>)

CTXACT:	MOVE	S1,[%CTJCQ]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET DEFAULT CONTEXT QUOTA
	  MOVEI	S1,4		;ANCIENT MONITOR
	$TEXT	(<-1,,DEFTX1>,<^D/S1/^0>)
	MOVE	S1,[%CTJPQ]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET DEFAULT SAVED PAGE QUOTA
	  MOVEI	S1,^D1000	;ANCIENT MONITOR
	$TEXT	(<-1,,DEFTX2>,<^D/S1/^0>)
	$RETT			;RETURN


; GET ROUTINE
CTXGET:	PUSHJ	P,P$NUM##	;GET NUMBER OF CONTEXTS
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T1,S1		;COPY
	MOVEI	T1,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$NUM##	;GET IDLE CONTEXT PAGE LIMIT
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T2,S1		;COPY
	MOVEI	T2,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPN	T1		;UNLIMITED?
	WARN	(NCL,<No context limit>)
	MOVEI	S1,<MASK.(<WID(AE.CNQ)>,35)> ;GET LIMIT
	CAIG	T1,(S1)		;RANGE CHECK
	JRST	CTXGE1		;REASONABLE NUMBER
	WARN	(RCL,<Reducing context limit from ^D/T1/ to ^D/S1/>)
	MOVEI	T1,(S1)		;ADJUST

CTXGE1:	DPB	T1,CTXCNQ	;STORE CONTEXT LIMIT
	SKIPN	T2		;UNLIMITED?
	WARN	(NPL,<No saved page limit>)
	DPB	T2,CTXCPQ	;STORE PAGE LIMIT
	MOVEI	S1,.AECTX	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
CTXCMP:	MOVEI	S1,.AECTX	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
CTXCHG:	MOVEI	S1,.AECTX	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
CTXDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.CTX	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$CTX(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;CHANGED IT
	SETOM	CHGMSK+.AECTX	;WHOLE WORD
	$RETT			;WIN


; RESTORE ROUTINE
CTXRES:	MOVE	S1,.AECTX(X)	;GET OLD CTX VALUES
	MOVEM	S1,.AECTX(U)	;RESTORE
	MOVX	S1,DF.CTX	;CTX DEFAULT BIT
	ANDCAM	S1,DF$CTX(U)	;CLEAR IN WORKING COPY
	TDNE	S1,DF$CTX(X)	;WAS IT CLEAR BEFORE?
	IORM	S1,DF$CTX(U)	;NO, FIX IT
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AECTX	;BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
CTXPRT:	LDB	T1,CTXCNQ
	LDB	T2,CTXCPQ
	$TEXT	(,<Contexts ^D/T1/, Total pages ^D/T2/>)
	$RETT


; HELP TEXT
CTXHLP:	ASCIZ	\
CONTEXT-QUOTAS specify the limits governing the  use  of  job  contexts.
The  context  quota is the number of contexts a user may have at any one
time.  Each logged in job has  at  least  one  (current)  context.   The
maximum  is  511.   A  quota of zero indicates no limit.  The saved page
quota is the number of pages of swapping space a user  may  occupy  with
idle  contexts.   A  quota  of  zero  indicates  no limit.  Refer to the
description of job contexts in the  TOPS-10  Operating  System  Commands
Manual for more information.
\
SUBTTL	ENTRIES -- COR - CORE-LIMITS


	.ENTRY	(COR,.AECOR,<Core Limits>)

CORPRS:	$NUMBER	(COR010,^D10,<physcal page limit>,<$DEFAULT(<512>)>)
COR010:	$NUMBER	(CONFRM,^D10,<virtual page limit>,<$DEFAULT(<512>)>)


; GET ROUTINE
CORGET:	PUSHJ	P,P$NUM##	;GET A NUMBER FROM COMMAND BLOCK
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T1,S1		;COPY
	MOVEI	T1,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$NUM##	;GET THE NEXT NUMBER FROM COMMAND BLOCK
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T2,S1		;COPY
	MOVEI	T2,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	S1,T1		;GET PHYSICAL LIMIT
	PUSHJ	P,CORGE1	;CHECK IT
	DPB	S1,CORPHY	;STORE NEW PHYSICAL LIMIT
	MOVE	S1,T2		;GET VIRTUAL LIMIT
	PUSHJ	P,CORGE2	;CHECK IT
	DPB	S1,CORVRT	;STORE NEW VIRTUAL LIMIT
	MOVEI	S1,.AECOR	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN

CORGE1:	SKIPA	T3,[[ASCIZ /physical/]]
CORGE2:	SKIPA	T3,[[ASCIZ /virtual/]]
	SKIPA	S2,[MASK.(<WID(AE.NPP)>,35)] ;GET PHYSICAL LIMIT
	MOVEI	S2,<MASK.(<WID(AE.NVP)>,35)> ;GET VIRTUAL LIMIT
	CAIG	S1,(S2)		;RANGE CHECK
	POPJ	P,		;REASONABLE NUMBER
	WARN	(RCL,<Reducing ^T/(T3)/ limit from ^D/S1/ to ^D/S2/ pages>)
	MOVEI	S1,(S2)		;ADJUST
	POPJ	P,		;RETURN


; COMPARE ROUTINE
CORCMP:	MOVEI	S1,.AECOR	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
CORCHG:	MOVEI	S1,.AECOR	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
CORDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.COR	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$COR(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;CHANGED THE ENTRY
	SETOM	CHGMSK+.AECOR	;BOTH FIELDS
	$RETT			;WIN


; RESTORE ROUTINE
CORRES:	MOVE	S1,.AECOR(X)	;GET ORIGINAL CORE VALUES
	MOVEM	S1,.AECOR(U)	;RESTORE
	MOVX	S1,DF.COR	;DEFAULT BIT FOR CORE WORD
	ANDCAM	S1,DF$COR(U)	;ASSUME CLEAR IN WORKING COPY
	TDNE	S1,DF$COR(X)	;DOES THIS MATCH THE ORIGINAL?
	IORM	S1,DF$COR(U)	;NO, FIX UP FOR WRONG GUESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AECOR	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
CORPRT:	LDB	T1,CORPHY	;GET PHYSICAL LIMIT
	LDB	T2,CORVRT	;GET VIRTUAL LIMIT
	$TEXT	(,<Physical ^D/T1/, Virtual ^D/T2/>)
	$RETT			;RETURN


; HELP TEXT
CORHLP:	ASCIZ	\
CORE-LIMITS specifies a decimal value for the physical and virtual
page limits.  The maximum number of pages is 16,384.
\
SUBTTL	ENTRIES -- DST - DISTRIBUTION-LOCATION


	.ENTRY	(DST,.AEBOX,<Distribution location>)

DSTPRS:	$QUOTE	(CONFRM,<optionally quoted string>,<$PREFI(P$8BIT##),$ALTER(DST010)>)
DST010:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)


; GET ROUTINE
DSTGET:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,P$QSTR##	;GET A QUOTED STRING
	SKIPT			;CHECK FOR ERRORS
	PUSHJ	P,P$FLD##	;MAYBE JUST A FIELD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	P1,S1		;SAVE STRING ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,(P1)		;POINT TO PARSER DATA BLOCK
	MOVE	S2,[.ADLLC,,.ADLLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
	MOVEI	T1,10		;8-BIT BYTES
	PUSHJ	P,PROSTR	;CHECK STRING LENGTH AND CONTENT
	MOVEI	S1,(P1)		;PARSER DATA BLOCK ADDRESS
	MOVE	S2,DST+CG.PFL	;PROFILE OFFSET
	PUSHJ	P,PROBLK	;ADD/DELETE EXTENSIBLE BLOCK
	SKIPT			;CHECK FOR ERRORS
	WARN	(NRM,<No room in profile for DISTRIBUTION LOCATION>,,DSTRES)
	MOVEI	S1,.AEBOX	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
DSTCMP:	MOVEI	S1,.AEBOX	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
DSTCHG:	MOVEI	S1,.AEBOX	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
DSTDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.BOX	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$BOX(U)	;SET IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEBOX	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
DSTRES:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,.AEBOX(X)	;-LENGTH
	HRRI	T2,.AEBOX	;OFFSET
	SKIPE	T3,.AEBOX(X)	;ORIGINAL OFFSET POINTER
	ADDI	T3,(X)		;INDEX INTO PROFILE
	MOVX	T4,DF.BOX	;DEFAULT BIT FOR FIELD
	TDNN	T4,DF$BOX(X)	;WAS IT DEFAULTED BEFORE?
	TDZA	T4,T4		;NO, CLEAR THE BIT
	MOVEI	T4,1		;YES, SET THE BIT
	PUSHJ	P,A$EBLK##	;RESTORE ORIGINAL DISTRIBUTION LOCATION
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEBOX	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
DSTPRT:	SKIPN	S1,.AEBOX(U)	;GET AOBJN POINTER
	SKIPA	S1,[NONE8]	;THERE IS NONE
	ADDI	S1,(U)		;INDEX INTO PROFILE
	HRLI	S1,(POINT 8,)	;MAKE A BYTE POINTER
	$TEXT	(,<^Q/S1/>)	;DISPLAY
	$RETT


; HELP TEXT
DSTHLP:	ASCIZ	\
DISTRIBUTION-LOCATION specifies text  to  be  displayed  on  the  banner
page(s) of spooled output.  The text indicates where the operator should
distribute the user's output.
\
SUBTTL	ENTRIES -- ENQ - ENQ-DEQ-QUOTA


	.ENTRY	(ENQ,.AEENQ,<ENQ/DEQ quota>)

ENQPRS:	$NUMBER	(CONFRM,^D10,<quota>,<$PDEFAULT(DEFTX1),$PREFIL(ENQACT)>)

ENQACT:	MOVE	S1,[%EQDEQ]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET DEFAULT ENQ/DEQ QUOTA
	  MOVEI	S1,^D511	;SICK MONITOR
	$TEXT	(<-1,,DEFTX1>,<^D/S1/^0>)
	$RETT			;RETURN


; GET ROUTINE
ENQGET:	PUSHJ	P,P$NUM##	;GET A NUMBER FROM
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T1,S1		;COPY
	MOVEI	T1,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	T2,^D511	;GET LIMIT
	CAIG	T1,(T2)		;TOO BIG?
	JRST	ENQGE1		;YES
	WARN	(REL,<Reducing ENQ/DEQ limit from ^D/T1/ to ^D/T2/>)
	MOVEI	T1,(T2)		;ADJUST

ENQGE1:	MOVEM	T1,.AEENQ(U)	;STORE AS NEW ENQ/DEQ QUOTA
	MOVEI	S1,.AEENQ	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
ENQCMP:	MOVEI	S1,.AEENQ	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
ENQCHG:	MOVEI	S1,.AEENQ	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
ENQDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.ENQ	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$ENQ(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED THE ENTRY
	SETOM	CHGMSK+.AEENQ	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
ENQRES:	MOVE	S1,.AEENQ(X)	;GET ORIGINAL ENQ/DEQ QUOTAS
	MOVEM	S1,.AEENQ(U)	;RESTORE
	MOVX	S1,DF.ENQ	;DEFAULT BIT FOR ENQ/DEQ WORD
	ANDCAM	S1,DF$ENQ(U)	;ASSUME CLEAR IN WORKING COPY
	TDNE	S1,DF$ENQ(X)	;DOES THIS MATCH THE ORIGINAL?
	IORM	S1,DF$ENQ(U)	;NO, FIX UP FOR WRONG GUESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEENQ	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
ENQPRT:	MOVE	T1,.AEENQ(U)	;GET ENQ/DEQ QUOTAS
	$TEXT	(,<^D/T1/>)	;DISPLAY
	$RETT


; HELP TEXT
ENQHLP:	ASCIZ	\
ENQ-DEQ-QUOTA  specifies  a  decimal value for the number of outstanding
ENQ locks.  The maximum number is 511.
\
SUBTTL	ENTRIES -- EXP - EXPIRATION-DATE


	.ENTRY	(EXP,.AEEXP,<Expiration date>)

EXPPRS:	$KEYDSP	(EXP010,<$ALTER(EXP020)>)
EXP010:	$STAB
	DSPTAB	(CONFRM,0,<NEVER>)
	DSPTAB	(CONFRM,1,<NOW>)
	$ETAB
EXP020:	$TAD	(CONFRM)


; GET ROUTINE
EXPGET:	PUSHJ	P,P$TIME##	;GET THE TIME FIELD FROM COMMAND BLOCK
	JUMPT	EXPGE1		;IF WE GOT IT, O.K.
	PUSHJ	P,P$KEYW##	;FIND OUT IF KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	JUMPE	S1,EXPGE1	;JUMP IF "NEVER"
	CAIE	S1,1		;ELSE BETTER BE "NOW"
	JRST	PRSERR		;GIVE UP
	PUSHJ	P,I%NOW		;GET CURRENT UDT
EXPGE1:	MOVE	T1,S1		;COPY RESULT
	PUSHJ	P,P$CFM##	;GET CRLF
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEM	T1,.AEEXP(U)	;SAVE EXPIRATION DATE/TIME IN USER BLOCK
	MOVEI	S1,.AEEXP	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
EXPCMP:	MOVEI	S1,.AEEXP	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
EXPCHG:	MOVEI	S1,.AEEXP	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
EXPDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.EXP	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$EXP(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEEXP	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
EXPRES:	MOVE	S1,.AEEXP(X)	;GET ORIGINAL EXPIRATION DATE/TIME
	MOVEM	S1,.AEEXP(U)	;RESTORE
	MOVX	S1,DF.EXP	;DEFAULT BIT FOR EXPIRATION WORD
	ANDCAM	S1,DF$EXP(U)	;ASSUME CLEAR IN WORKING COPY
	TDNE	S1,DF$EXP(X)	;DOES THIS MATCH THE ORIGINAL?
	IORM	S1,DF$EXP(U)	;NO, FIX UP FOR WRONG GUESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEEXP	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
EXPPRT:	PUSHJ	P,I%NOW		;GET CURRENT DATE/TIME
	MOVE	T1,.AEEXP(U)	;GET EXPIRATION DATE
	MOVEI	T2,[ITEXT (<^H/T1/>)] ;ASSUME NORMAL DATE
	CAMG	T1,S1		;EXPIRED?
	MOVEI	T2,[ITEXT (<expired on ^H/T1/>)] ;YES
	SKIPG	T1		;NEVER?
	MOVEI	T2,[ITEXT (<never>)] ;YES
	$TEXT	(,<^I/(T2)/>)	;DISPLAY
	$RETT			;AND RETURN


; HELP TEXT
EXPHLP:	ASCIZ	\
EXPIRATION-DATE specifies the date when LOGINs to this  account  are  no
longer  allowed.  This date is also written into the UFD for all mounted
structures for disk maintenance purposes.
\
SUBTTL	ENTRIES -- IPC - IPCF-QUOTAS


	.ENTRY	(IPC,.AEIPC,<IPCF quotas>)

IPCPRS:	$NUMBER	(IPC010,^D10,<send>,<$PDEFAULT(DEFTX1),$PREFIL(IPCACT)>)
IPC010:	$NUMBER	(IPCF20,^D10,<receive>,<$PDEFAULT(DEFTX2)>)
IPCF20:	$NUMBER	(CONFRM,^D10,<PID quota>,<$PDEFAULT(DEFTX3)>)

; ACTION ROUTINE TO GENERATE DEFAULT QUOTA STRINGS
IPCACT:	MOVE	S1,[%IPCDQ]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET DEFAULT SEND/RECEIVE QUOTA
	  MOVEI	S1,2005		;SICK MONITOR
	LDB	S2,[POINT 9,S1,26] ;GET SEND
	$TEXT	(<-1,,DEFTX1>,<^D/S2/^0>)
	LDB	S2,[POINT 9,S1,35] ;GET RECEIVE
	$TEXT	(<-1,,DEFTX2>,<^D/S2/^0>)
	MOVE	S1,[%IPDPQ]	;GETTAB ARGUMENT
	GETTAB	S1,		;GET DEFAULT PID QUOTA
	  MOVEI	S1,2		;ANCIENT MONITOR
	$TEXT	(<-1,,DEFTX3>,<^D/S1/^0>)
	$RETT			;RETURN


; GET ROUTINE
IPCGET:	PUSHJ	P,P$NUM##	;GET SEND QUOTA
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T1,S1		;COPY
	MOVEI	T1,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$NUM##	;GET THE RECEIVE QUOTA
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T2,S1		;COPY
	MOVEI	T2,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$NUM##	;GET NUMBER OF PIDS
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T3,S1		;COPY
	MOVEI	T3,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,(T1)		;GET SEND QUOTA
	PUSHJ	P,IPCGE1	;CHECK IT
	DPB	S1,IPCFS	;STORE
	MOVEI	S1,(T2)		;GET RECEIVE QUOTA
	PUSHJ	P,IPCGE2	;CHECK IT
	DPB	S1,IPCFR	;STORE
	MOVEI	S1,(T3)		;GET PID QUOTA
	PUSHJ	P,IPCGE3	;CHECK IT
	DPB	S1,IPCFP	;STORE
	MOVEI	S1,.AEIPC	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN

IPCGE1:	MOVEI	T4,[ASCIZ /send/]
	MOVEI	S2,<MASK.(<WID(AE.SND)>,35)> ;GET LIMIT
	JRST	IPCGE4		;GO COMPARE
IPCGE2:	MOVEI	T4,[ASCIZ /receive/]
	MOVEI	S2,<MASK.(<WID(AE.RCV)>,35)> ;GET LIMIT
	JRST	IPCGE4		;GO COMPARE
IPCGE3:	MOVEI	T4,[ASCIZ /PID/]
	MOVEI	S2,<MASK.(<WID(AE.PID)>,35)> ;GET LIMIT
IPCGE4:	CAIGE	S1,(S2)		;TOO BIG?
	POPJ	P,		;NO
	WARN	(RIQ,<Reducing IPCF ^T/(T4)/ quota from ^D/S1/ to ^D/S2/>)
	MOVEI	S1,(S2)		;ADJUST
	POPJ	P,		;RETURN


; COMPARE ROUTINE
IPCCMP:	MOVEI	S1,.AEIPC	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
IPCCHG:	MOVEI	S1,.AEIPC	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
IPCDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.IPC	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$IPC(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEIPC	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
IPCRES:	MOVE	S1,.AEIPC(X)	;GET ORIGINAL IPCF VALUES
	MOVEM	S1,.AEIPC(U)	;RESTORE
	MOVX	S1,DF.IPC	;DEFAULT BIT FOR IPCF WORD
	ANDCAM	S1,DF$IPC(U)	;ASSUME CLEAR IN WORKING COPY
	TDNE	S1,DF$IPC(X)	;DOES THIS MATCH THE ORIGINAL?
	IORM	S1,DF$IPC(U)	;NO, FIX UP FOR WRONG GUESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEIPC	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
IPCPRT:	LDB	T1,IPCFS	;SEND QUOTA
	LDB	T2,IPCFR	;RECEIVE QUOTA
	LDB	T3,IPCFP	;PID QUOTA
	$TEXT	(,<Send ^D/T1/, Receive ^D/T2/, PIDs ^D/T3/>)
	$RETT


; HELP TEXT
IPCHLP:	ASCIZ	\
IPCF-QUOTAS  specifies  a  decimal  value for the SEND, RECEIVE, and PID
quotas.  The maximum value for each quota is 511.
\
SUBTTL	ENTRIES -- LTI - LOGIN-TIMES


	.ENTRY	(LTI,.AELGT,<LOGIN times>)

LTIPRS:	$NOISE	(CONFRM,<allowed>)
LTI000:	$INIT	(LTI010)
LTI010:	$KEYDSP	(LTI020,<$ALTER(LTI060)>)
LTI020:	$STAB
	DSPTAB	(LTI010,-4,<NON>,CM%NOR)
	DSPTAB	(LTI010,-4,<NON-PRIME-TIME>)
	DSPTAB	(LTI010,-3,<PRIME-TIME>)
	DSPTAB	(LTI030,-2,<WEEKDAYS>)
	DSPTAB	(LTI030,-1,<WEEKENDS>)
	$ETAB
LTI030:	$NUMBER	(LTI040,^D10,<starting hour>,<$DEFAULT(<0>)>)
LTI040:	$TOKEN	(LTI050,<:>,<$DEFAULT(<:>)>)
LTI050:	$NUMBER	(LTI010,^D10,<ending hour>,<$DEFAULT(<23>)>)
LTI060:	$KEYDSP	(LTI070,<$ALTER(CONFRM)>)
LTI070:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(LTI080,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
LTI080:	$KEYDSP	(LTI020)
; GET ROUTINE
LTIGET:	PUSHJ	P,.SAVE1	;SAVE P1

LTIGE1:	MOVEI	S1,LTI000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ \LOGIN-TIMES>\]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

LTIGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	LTIGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAILE	S1,LTILEN	;A COMMON KEYWORD?
	HRRES	S1		;NO--MAKE A NEGATIVE INDEX
	PUSHJ	P,@LTITAB(S1)	;DISPATCH
	JRST	LTIGE2		;TRY FOR MORE

; COMPARE ROUTINE
LTICMP:	MOVEI	S1,.AELGT	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
LTICHG:	MOVEI	S1,.AELGT	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
LTIDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.LGT	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$LGT(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AELGT	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
LTIRES:	MOVE	S1,.AELGT(X)	;GET ORIGINAL LOGIN TIMES
	MOVEM	S1,.AELGT(U)	;RESTORE
	MOVX	S1,DF.LGT	;DEFAULT BIT FOR TIMES WORD
	ANDCAM	S1,DF$LGT(U)	;ASSUME CLEAR IN WORKING COPY
	TDNE	S1,DF$LGT(X)	;DOES THIS MATCH THE ORIGINAL?
	IORM	S1,DF$LGT(U)	;NO, FIX UP FOR WRONG GUESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AELGT	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
LTIPRT:	$TEXT	(,<Weekdays ^A>)
	LOAD	S1,.AELGT(U),AE.WDH ;GET WEEKDAY LOGIN TIMES
	SKIPN	S1		;ANY TIMES SET?
	$TEXT	(,<-none- ^A>)	;IF NONE, SAY SO
	SETZB	T1,T4		;CURRENT HOUR, OFFSET FOR ENDING HOUR
	MOVSI	T2,(1B0)	;FLOATING BIT
	SETO	T3,		;STARTING HOUR
LTIPR1:	TDNE	T2,.AELGT(U)	;TEST THE LOGIN TIMES WORD
	JRST	LTIPR2		;JUST ADD IT IN
	MOVEI	S1,-1(T1)	;BACK DOWN TO LAST HOUR WE LOOKED AT
	SKIPL	T3		;IS THERE A STARTING HOUR?
	$TEXT	(,<^D/T3/:^D/S1/ ^A>) ;YES, TYPE IT OUT
	SETO	T3,		;NO STARTING HOUR ANY MORE
	JUMPN	T2,LTIPR3	;IF NOT END OF SEGMENT, JOIN COMMON CODE
	JUMPN	T4,LTIPR4	;IF WE'VE ALREADY BEEN HERE, EXIT
	$TEXT	(,< Weekends ^A>)
	LOAD	S1,.AELGT(U),AE.WEH ;GET WEEKEND TIMES
	SKIPN	S1		;ANY TIMES?
	$TEXT	(,<-none- ^A>)	;NO
	MOVEI	T1,0		;START AT HOUR PAIR ZERO-ONE
	MOVEI	T2,1B24		;BIT FOR WEEKEND HOURS
	MOVEI	T4,1		;WEEKENDS WORK WITH DOUBLE WORD PAIRS
	JRST	LTIPR1		;AND JUMP BACK INTO THAT CODE AGAIN
LTIPR2:	SKIPL	T3		;IS THERE ALREADY A STARTING HOUR?
	JRST	LTIPR3		;YES, JUST KEEP LOOPING
	MOVE	T3,T1      	;NO, INITIALIZE IT
LTIPR3:	LSH	T2,-1		;SHIFT BIT TO THE RIGHT
	CAIL	T1,^D23		;HAVE WE PASSED THE LAST HOUR?
	SETZ	T2,		;CLEAR LOOKING BIT
	ADDI	T1,1(T4)	;LOOK AT NEXT HOUR
	JRST	LTIPR1		;AND LOOP
LTIPR4:	$TEXT	(,<>)		;END LINE
	$RETT


; HELP TEXT
LTIHLP:	ASCIZ	\
LOGIN-TIMES  specifies the time of the day the user is allowed to LOGIN.
Weekdays are divided into 24 one-hour segments.   Weekends  are  divided
into  12  two-hour segments.  Therefore, if a user is permitted to LOGIN
on Saturday at 7:00 AM, the user can actually LOGIN between 6:00 AM  and
7:59 AM.
\
; KEYWORD DISPATCH TABLE
	IFIW	LTINPT		;"NON-PRIME-TIME"
	IFIW	LTIPTM		;"PRIME-TIME"
	IFIW	LTIWDY		;"WEEKDAYS"
	IFIW	LTIWEN		;"WEEKENDS"
LTITAB:	IFIW	LTIALL		;"ALL"
	IFIW	LTIDEF		;"DEFAULT"
	IFIW	LTIDON		;"DONE"
	IFIW	LTIHLX		;"HELP"
	IFIW	LTINO		;"NO"
	IFIW	LTINON		;"NONE"
	IFIW	LTIRES		;"RESTORE"
	IFIW	LTIPRT		;"SHOW"
LTILEN==.-LTITAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
LTIALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVNI	S1,1		;SET ALL HOURS
	PJRST	LTIHRS		;GO SET


; "DEFAULT" KEYWORD PROCESSOR
LTIDEF:	PUSHJ	P,LTIDFL	;DO DEFAULTING
	PJRST	LTIGO		;FINISH UP



; "DONE" KEYWORD PROCESSOR
LTIDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,.AELGT	;OFFSET TO CHECK
	ADJSP	P,-1		;WE CO-RETURN
	PJRST	CMPVAL		;SET CHANGE FLAGS & RETURN


; "HELP" KEYWORD PROCESSOR
LTIHLX:	PUSHJ	P,P$CFM		;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OFER THE CRLF
	MOVEI	S1,@LTI+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN


; "NO" KEYWORD PROCESSOR
LTINO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;RETURN


; "NONE" KEYWORD PROCESSOR
LTINON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVNI	P1,1		;MAKE IT LOOK LIKE "NO ALL"
	MOVNI	S1,1		;GET MASK
	PJRST	LTIHRS		;GO CLEAR
; "NON-PRIME-TIME" KEYWORD PROCESSOR
LTINPT:	SKIPA	S1,[NPTHRS]	;GET NON-PRIME TIME HOURS


; "PRIME-TIME" KEYWORD PROCESSOR
LTIPTM:	MOVX	S1,PTMHRS	;GET PRIME TIME HOURS
LTIHRS:	SKIPE	P1		;SKIP IF SETTING
	ANDCAM	S1,.AELGT(U)	;CLEAR HOURS
	SKIPN	P1		;SKIP IF CLEARING
	IORM	S1,.AELGT(U)	;SET HOURS
	IORM	S1,CHGMSK+.AELGT ;UPDATE CHANGE MASK
LTIGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN

; "WEEKDAY" KEYWORD PROCESSOR
LTIWDY:	PUSHJ	P,LTIRNG	;GET THE RANGE
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	T1,		;CLEAR AN AC
	MOVSI	T2,(1B0)	;BIT 0
	MOVN	T3,S2		;NEGATIVE LSH
	LSH	T2,(T3)		;GET STARTING HOUR BIT

LTIWD1:	IOR	T1,T2		;OR IT IN
	LSH	T2,-1		;MOVE BIT TO NEXT HOUR
	CAMGE	S2,S1		;REACHED END?
	AOJA	S2,LTIWD1	;NO, LOOP
	MOVE	S1,T1		;COPY BIT MASK
	PJRST	LTIHRS		;GO SET/CLEAR HOURS


; "WEEKEND" KEYWORD PROCESSOR
LTIWEN:	PUSHJ	P,LTIRNG	;GET THE RANGE
	$RETIF			;RETURN ON ERRORS
	LSH	S1,-1		;WEEKENDS USE TWO-HOUR PERIODS
	LSH	S2,-1		;SAME FOR UPPER BOUND
	SETZ	T1,		;CLEAR AN AC
	MOVEI	T2,1B24		;STARTING BIT FOR US TO USE
	MOVN	T3,S2		;NEGATIVE LSH
	LSH	T2,(T3)		;STARTING HOUR BIT

LTIWE1:	IOR	T1,T2		;OR IT IN
	LSH	T2,-1		;MOVE BIT TO NEXT HOUR PAIR
	CAMGE	S2,S1		;REACHED END?
	AOJA	S2,LTIWE1	;LOOP
	MOVE	S1,T1		;COPY BIT MASK
	PJRST	LTIHRS		;GO SET/CLEAR HOURS

LTIRNG:	PUSHJ	P,.SAVE1	;WE TRASH P1
	PUSHJ	P,P$NUM##	;GET THE NUMBER
	JUMPF	.RETF		;IF FAILS, MUST NOT BE A RANGE
	MOVE	P1,S1		;SAVE RANGE
	PUSHJ	P,P$TOK##	;GET THE SEPERATOR TOKEN
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$NUM##	;GET THE ENDING RANGE
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	S2,P1		;GET BACK FIRST NUMBER
	CAIGE	S1,^D24		;RANGE CHECK BOTH
	CAIL	S2,^D24		;NUMBERS
	JRST	LTIRN1		;ONE OF THEM IS ILLEGAL
	CAML	S1,S2		;MAKE SURE RANGE IS CORRECT DIRECTION
	JRST	.RETT		;IT'S GOOD, USE IT
LTIRN1:	$TEXT	(,<Illegal range ^D/P1/:^D/S1/, Ignored>)
	JRST	.RETF		;AND RETURN
SUBTTL	ENTRIES -- MAI - MAILING ADDRESS


	.ENTRY	(MAI,.AEMAI,<Mailing address>)

MAIPRS:	$NODNM	(MAI010,,<$FLAGS(CM%PO),$ALTER(MAI010)>)
MAI010:	$USER	(CONFRM,<$ALTER(MAI020)>)
MAI020:	$QUOTE	(CONFRM,,<$PREFI(P$8BIT##),$ALTER(MAI030)>)
MAI030:	$FIELD	(CONFRM,<user name>,<$PREFI(P$8BIT##),$BREAK(TXTBRK)>)


; GET ROUTINE
MAIGET:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVE	S1,[TEMP,,TEMP+1] ;SET UP BLT
	SETZM	TEMP		;CLEAR FIRST WORD
	BLT	S1,TEMP+.AEMAX-1 ;CLEAR TEMPORARY STORAGE
	MOVE	S1,[POINT 8,TEMP+ARG.DA] ;BYTE POINTER FOR STORAGE
	MOVEM	S1,MAIPTR	;SAVE
	MOVEI	S1,<<TEMP-ARG.DA>*.AMLCW> ;ABSOLUTE MAXIMUM CHARACTER COUNT
	MOVEM	S1,MAICNT	;SAVE IT TOO
	PUSHJ	P,P$NODE##	;FETCH OPTIONAL NODE
	JUMPF	MAIGE1		;NOT THERE
	MOVEI	S2,[ITEXT (<^O/S1/>)] ;ASSUME ANF-10 NODE NUMBER
	TLNE	S1,-1		;POSSIBLE NODE NAME?
	MOVEI	S2,[ITEXT (<^W/S1/>)] ;YES
	SKIPE	S1		;REALLY HAVE A NODE SPEC?
	$TEXT	(MAITYO,<^I/(S2)/::^A>) ;STORE NODE NAME/NUMBER

MAIGE1:	PUSHJ	P,P$USER##	;TRY FOR A PPN
	JUMPF	MAIGE2		;NOT THERE
	MOVEI	P1,[ITEXT (<^T/(P2)/>)] ;ITEXT BLOCK TO USE
	PUSH	P,.AEPPN(U)	;SAVE PPN IN PROFILE
	MOVEM	S1,.AEPPN(U)	;STORE TARGET PPN FOR A SECOND
	PUSHJ	P,CVTPPD	;GENERATE PPN STRING
	MOVEI	P2,(S1)		;POINT TO TEXT
	POP	P,.AEPPN(U)	;REPLACE ORIGINAL PPN IN PROFILE
	JRST	MAIGE4		;ONWARD

MAIGE2:	PUSHJ	P,P$QSTR##	;TRY FOR A QUOTED STRING
	JUMPF	MAIGE3		;NOT THERE
	MOVEI	P1,[ITEXT (<"^Q/P2/">)] ;ITEXT BLOCK TO USE
	MOVEI	P2,ARG.DA(S1)	;POINT TO START OF TEXT
	HRLI	P2,(POINT 8,)	;8-BIT ASCIZ
	JRST	MAIGE4		;ONWARD

MAIGE3:	PUSHJ	P,P$FLD##	;MAYBE JUST A FIELD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	P1,[ITEXT (<^Q/P2/>)] ;ITEXT BLOCK TO USE
	MOVEI	P2,ARG.DA(S1)	;POINT TO START OF TEXT
	HRLI	P2,(POINT 8,)	;8-BIT ASCIZ

MAIGE4:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	$TEXT	(MAITYO,<^I/(P1)/^0>) ;STORE USER-ID
	MOVEI	P1,TEMP		;POINT TO THE PSEUDO RETURNED PARSER DATA BLOCK
	MOVEI	S1,<<TEMP-ARG.DA>*.AMLCW> ;ABSOLUTE MAXIMUM CHARACTER COUNT
	SUB	S1,MAICNT	;GET HOW MANY CHARACTERS STORED
	IDIVI	S1,.AMLCW	;COMPUTE WORDS USED
	SKIPE	S2		;REMAINDER?
	ADDI	S1,1		;YES--COUNT ONE MORE
	MOVSI	S1,ARG.DA(S1)	;PUT IN LH
	HRRI	S1,.CMFLD	;FAKE UP RETURNED PARSER HEADER
	MOVEM	S1,ARG.HD(P1)	;SAVE
	MOVEI	S1,(P1)		;POINT TO STRING
	MOVE	S2,[.AMLLC,,.AMLLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
	MOVEI	T1,10		;8-BIT BYTES
	PUSHJ	P,PROSTR	;CHECK STRING LENGTH AND CONTENT
	MOVEI	S1,(P1)		;PARSER DATA BLOCK ADDRESS
	MOVE	S2,MAI+CG.PFL	;PROFILE OFFSET
	PUSHJ	P,PROBLK	;ADD/DELETE EXTENSIBLE BLOCK
	SKIPT			;CHECK FOR ERRORS
	WARN	(NRM,<No room in profile for MAILING-ADDRESS>,,MAIRES)
	MOVEI	S1,.AEMAI	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN

MAITYO:	SOSL	MAICNT		;COUNT CHARACTERS
	IDPB	S1,MAIPTR	;STORE CHARACTER
	$RETT			;RETURN
; COMPARE ROUTINE
MAICMP:	MOVEI	S1,.AEMAI	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
MAICHG:	MOVEI	S1,.AEMAI	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
MAIDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.MAI	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$MAI(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEMAI	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
MAIRES:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,.AEMAI(X)	;-LENGTH
	HRRI	T2,.AEMAI	;OFFSET
	SKIPE	T3,.AEMAI(X)	;ORIGINAL OFFSET POINTER
	ADDI	T3,(X)		;INDEX INTO PROFILE
	MOVX	T4,DF.MAI	;DEFAULT BIT FOR MAIL WORD
	TDNN	T4,DF$MAI(X)	;WAS IT ORIGINALLY DEFAULTED?
	TDZA	T4,T4		;NO, CLEAR THE BIT
	MOVEI	T4,1		;YES, SET THE BIT
	PUSHJ	P,A$EBLK##	;RESTORE ORIGINAL MAILING ADDRESS
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEMAI	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
MAIPRT:	SKIPN	S1,.AEMAI(U)	;GET AOBJN POINTER
	SKIPA	S1,[NONE8]	;THERE IS NONE
	ADDI	S1,(U)		;INDEX INTO PROFILE
	HRLI	S1,(POINT 8,)	;MAKE A BYTE POINTER
	$TEXT	(,<^Q/S1/>)	;DISPLAY
	$RETT


; HELP TEXT
MAIHLP:	ASCIZ	\
MAILING  ADDRESS  specifies  an address for mail forwarding.  This is an
unprivileged entry in a profile, and as such  may  be  modified  by  the
user.
\
SUBTTL	ENTRIES -- NAM - NAME


	.ENTRY	(NAM,.AENAM,<User name>)

NAMPRS:	$QUOTE	(CONFRM,<user name>,<$PREFI(P$8BIT##),$ALTER(NAM010)>)
NAM010:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)


; GET ROUTINE
NAMGET:	SKIPE	RESPPN		;IS THE NAME-PPN CORRESPONDENCE FIXED?
	WARN	(RNC,<Reserved PPN's name cannot be changed>,,.RETT)
	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	PUSHJ	P,P$QSTR##	;GET A QUOTED STRING
	SKIPT			;CHECK FOR ERRORS
	PUSHJ	P,P$FLD##	;MAYBE JUST A FIELD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPN	ARG.DA(S1)	;REALLY HAVE A NAME?
	WARN	(NNG,<No name given; name not changed>,,.RETT)
	MOVEI	P1,ARG.DA(S1)	;COPY ADDRESS
	LOAD	P2,ARG.HD(S1),AR.LEN ;GET BLOCK LENGTH
	MOVE	S1,P1		;POINT TO STRING
	PUSHJ	P,A$CKNM##	;CHECK IT FOR LEGALITY
	JUMPT	NAMGE1		;JUMP IF NAME IS OK
	HRLI	P1,(POINT 8,)	;MAKE A BYTE POINTER
	WARN	(RNI,<Reserved name illegal; ^Q/P1/>,,.RETT)

NAMGE1:	MOVSI	S1,.AENAM(U)	;POINT TO STORAGE
	HRRI	S1,.AENAM+1(U)	;MAKE A BLT POINTER
	SETZM	.AENAM(U)	;CLEAR FIRST WORD
	BLT	S1,.AENAM+.AANLW-1(U) ;CLEAR ENTIRE BLOCK
	CAILE	P2,.AANLW	;ENFORCE CHARACTER MAXIMUM
	MOVEI	P2,.AANLW	;TOO LARGE
	ADDI	P2,.AENAM(U)	;COMPUTE END OF BLT
	MOVSI	S1,(P1)		;POINT TO NAME
	HRRI	S1,.AENAM(U)	;POINT TO STORAGE
	BLT	S1,-1(P2)	;COPY
	MOVE	S1,.AENAM+.AANLW-1(U) ;COPY LAST WORD
	TRZN	S1,7760		;LAST CHARACTER ZERO?
	JRST	NAMGE2		;YES
	MOVEM	S1,.AENAM+.AANLW-1(U) ;TERMINATE STRING
	WARN	(NTT,<NAME text truncated to ^D/[.AANLC]/ characters>)

NAMGE2:	MOVEI	S1,.AENAM	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
NAMCMP:	SKIPE	SELFLG		;HAS IT ALWAYS CHANGED?
	$RETF			;YES, SKIP COMPARES
	PUSHJ	P,.SAVE1	;SAVE P1
	MOVEI	T1,.AENAM(U)	;POINT TO SOURCE NAME
	HRLI	T1,(POINT 8,)	;8-BIT ASCIZ
	MOVEI	T2,.AENAM(X)	;POINT TO OLD NAME
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ
	MOVEI	T3,.AANLC	;CHARACTERS

NAMCM1:	ILDB	S1,T1		;GET A CHARACTER FROM NEW NAME
	CAIL	S1,"A"+40	;CONVERT
	CAILE	S1,"Z"+40	; LOWER
	CAIA			;  CASE TO
	SUBI	S1," "		;   UPPER CASE
	ILDB	S2,T2		;GET A CHARACTER FROM OLD NAME
	CAIL	S2,"A"+40	;CONVERT
	CAILE	S2,"Z"+40	; LOWER
	CAIA			;  CASE TO
	SUBI	S2," "		;   UPPER CASE
	CAIE	S1,(S2)		;MATCH?
	$RETF			;NAMES ARE DIFFERENT
	SOJG	T3,NAMCM1	;YES--LOOP BACK FOR ANOTHER
	$RETT			;RETURN IF POINTER RUNS OUT


; CHANGE ROUTINE
NAMCHG:	MOVEI	S1,.AENAM	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
NAMDFL:	PJRST	PRODFZ		;NO CAN DO


; RESTORE ROUTINE
NAMRES:	MOVSI	S1,.AENAM(X)	;POINT TO OLD NAME
	HRRI	S1,.AENAM(U)	;MAKE A BLT POINTER
	BLT	S1,.AENAM+.AANLW-1(U) ;COPY
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AENAM	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
NAMPRT:	$TEXT	(,<^Q/USRNAM/>)	;8-BIT ASCII NAME
	$RETT			;RETURN


; HELP TEXT
NAMHLP:	ASCIZ	\
NAME specifies the user name for the specified profile.   This  name  is
used  for  accounting  purposes  may  not  be  changed  by the user (see
PERSONAL-NAME).  The user name can consist of any  printable  character.
A  user  name  must  be quoted if it contains any character other than A
through Z and dash.  The maximum length of a name is 39 characters.
\
SUBTTL	ENTRIES -- NUL - NULL-ENTRY


	.ENTRY	(NUL,-1,<>,FL.NTY!FL.XCR)

NULPRS:	$CRLF


; GET ROUTINE
NULGET:	$RETF


; COMPARE ROUTINE
NULCMP:	$RETT


; CHANGE ROUTINE
NULCHG:	$RETF


; DEFAULT ROUTINE
NULDFL:	PJRST	PRODFZ		;NO CAN DO


; RESTORE ROUTINE
NULRES:	$RETF


; PRINT ROUTINE
NULPRT:	$TEXT	(,<>)		;JUST A CRLF
	$RETT


; HELP TEXT
NULHLP:	ASCIZ	//
SUBTTL	ENTRIES -- PDF - PROFILE-DEFAULT


	.ENTRY	(PDF,.AEDEF,<Profile default>)

PDFPRS:	$USER	(CONFRM,<$ALTER(PDF010)>)
PDF010:	$KEYDSP	(PDF020,)
PDF020:	$STAB
	DSPTAB	(CONFRM,0,<NONE>)
	DSPTAB	(CONFRM,1,<PROJECT>)
	$ETAB


; GET ROUTINE
PDFGET:	HRRE	S1,.AEPPN(U)	;GET PROGRAMMER NUMBER
	AOJN	S1,PDFGE1	;CONTINUE IF NOT THE DEFAULT
	PUSH	P,.AEPPN(U)	;SAVE PPN
	MOVE	S1,.AEDEF(U)	;GET DEFAULT PPN
	MOVEM	S1,.AEPPN(U)	;SAVE TEMPORARILY
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,.AEPPN(U)	;RESTORE PPN
	WARN	(MND,<No profile default allowed for ^T/(S1)/>,,PDFRES)

PDFGE1:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,P$USER##	;TRY FOR A PPN
	MOVE	P1,S1		;COPY POSSIBLE PPN
	JUMPT	PDFGE2		;JUMP IF ONE IS SUPPLIED
	PUSHJ	P,P$KEYW##	;TRY FOR A KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAIE	S1,0		;ONLY TWO
	CAIN	S1,1		; OPTIONS
	SKIPA	P1,[EXP <0,,-1>,<0>](S1)
	PJRST	PRSERR		;PARSE ERROR

PDFGE2:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEM	P1,.AEDEF(U)	;SAVE DEFAULT PPN
	MOVEI	S1,.AEDEF	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
PDFCMP:	MOVEI	S1,.AEDEF	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
PDFCHG:	MOVEI	S1,.AEDEF	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
PDFDFL:	PJRST	PRODFZ		;CAN'T DEFAULT THIS ONE


; RESTORE ROUTINE
PDFRES:	MOVE	S1,.AEDEF(X)	;GET ORIGINAL DEFAULT
	MOVEM	S1,.AEDEF(U)	;RESTORE
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEDEF	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
PDFPRT:	SKIPE	S2,.AEDEF(U)	;GET DEFAULT PPN
	JRST	PDFPR1		;DO DISPLAY SOMETHING
	HLRZ	S1,.AEPPN(U)	;GET PROJECT NUMBER
	$TEXT	(,<[^O/S1/,%] or [%,%]>)
	$RETT			;RETURN
PDFPR1:	CAIE	S2,-1		;NO DEFAULTING?
	JRST	PDFPR2		;GO TRANSLATE PPN
	MOVEI	S1,NONE7	;POINT TO "-NONE-"
	JRST	PDFPR3		;AND FINISH UP
PDFPR2:	PUSH	P,.AEPPN(U)	;SAVE PPN
	MOVEM	S2,.AEPPN(U)	;STORE DEFAULT TEMPORARILY
	PUSHJ	P,CVTPPD	;CONVERT PPN
	POP	P,.AEPPN(U)	;RESTORE PPN
PDFPR3:	$TEXT	(,<^T/(S1)/>)	;DISPLAY
	$RETT			;RETURN


; HELP TEXT
PDFHLP:	ASCIZ	\
PROFILE-DEFAULT specifies which profile  will  be  used  for  defaulting
various entries in the user's profile.
\
SUBTTL	ENTRIES -- PNM - PERSONAL-NAME


	.ENTRY	(PNM,.AEPNM,<Personal name>)

PNMPRS:	$QUOTE	(CONFRM,<optionally quoted string>,<$PREFI(P$8BIT##),$ALTER(PNM010)>)
PNM010:	$FIELD	(CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)


; GET ROUTINE
PNMGET:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,P$QSTR##	;GET A QUOTED STRING
	SKIPT			;CHECK FOR ERRORS
	PUSHJ	P,P$FLD##	;MAYBE JUST A FIELD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	P1,S1		;SAVE STRING ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,(P1)		;POINT TO STRING
	MOVE	S2,[.APNLC,,.APNLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
	MOVEI	T1,10		;8-BIT BYTES
	PUSHJ	P,PROSTR	;CHECK STRING LENGTH AND CONTENT
	MOVEI	S1,(P1)		;PARSER DATA BLOCK ADDRESS
	MOVE	S2,PNM+CG.PFL	;PROFILE OFFSET
	PUSHJ	P,PROBLK	;ADD/DELETE EXTENSIBLE BLOCK
	SKIPT			;CHECK FOR ERRORS
	WARN	(NRM,<No room in profile for PERSONAL NAME>,,PNMRES)
	MOVEI	S1,.AEPNM	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
PNMCMP:	MOVEI	S1,.AEPNM	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
PNMCHG:	MOVEI	S1,.AEPNM	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
PNMDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.PNM	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$PNM(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEPNM	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
PNMRES:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,.AEPNM(X)	;-LENGTH
	HRRI	T2,.AEPNM	;OFFSET
	SKIPE	T3,.AEPNM(X)	;ORIGINAL OFFSET POINTER
	ADDI	T3,(X)		;INDEX INTO PROFILE
	MOVX	T4,DF.PNM	;DEFAULT BIT FOR PERSONAL NAME
	TDNN	T4,DF$PNM(X)	;WAS IT ORIGINALLY DEFAULTED?
	TDZA	T4,T4		;NO, BIT TO RESTORE IS ZERO
	MOVEI	T4,1		;YES, BIT TO RESTORE IS ONE
	PUSHJ	P,A$EBLK##	;RESTORE ORIGINAL PERSONAL NAME
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEPNM	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
PNMPRT:	SKIPN	S1,.AEPNM(U)	;GET AOBJN POINTER
	SKIPA	S1,[NONE8]	;THERE IS NONE
	ADDI	S1,(U)		;INDEX INTO PROFILE
	HRLI	S1,(POINT 8,)	;MAKE A BYTE POINTER
	$TEXT	(,<^Q/S1/>)	;DISPLAY
	$RETT


; HELP TEXT
PNMHLP:	ASCIZ	\
PERSONAL-NAME  specifies a name other than the user's offical accounting
name (see NAME).  The personal name, if available, is displayed  on  the
banner page(s) of a user's spooled output.  This is an unprivilged entry
in a profile, and as such may be modified by the user.
\
SUBTTL	ENTRIES -- PPX - PPN


	.ENTRY	(PPX,.AEPPN,<PPN>)

PPXPRS:	$USER	(CONFRM)


; GET ROUTINE
PPXGET:	$RETF


; COMPARE ROUTINE
PPXCMP:	MOVEI	S1,.AEPPN	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
PPXCHG:	$RETF


; DEFAULT ROUTINE
PPXDFL:	PJRST	PRODFZ		;CAN'T DO IT


; RESTORE ROUTINE
PPXRES:	$RETF


; PRINT ROUTINE
PPXPRT:	PUSHJ	P,CVTPPD	;TRANSLATE TO ASCIZ
	$TEXT	(,<^T/(S1)/>)	;DISPLAY
	$RETT			;RETURN


; HELP TEXT
PPXHLP:	ASCIZ	\
PPN specifies the project and programmer number for a profile.  The  PPN
is the primary means of identifying a user.
\
SUBTTL	ENTRIES -- PRG - PROGRAM-TO-RUN

	.ENTRY	(PRG,.AEPGR,<Program to run>)

PRGPRS:	$NOISE	(PRG010,<at LOGIN>)
PRG010:	$FILE	(CONFRM,<filespec>,<$PREFIL(PRGACT)>)

PRGACT:	MOVE	S1,[GJFBLK##,,GJFBLK##+1] ;SET UP TO ZERO BLOCK
	SETZM	GJFBLK##	;CLEAR 1ST WORD
	BLT	S1,GJFBLK##+GJFSIZ-1 ;CLEAR THE REST
	MOVSI	S1,'...'	;GET SOMETHING TO MARK OUR PLACE
	MOVEM	S1,GJFBLK##+.FDSTR ;STORE IT
	$RETT			;RETURN


; GET ROUTINE
PRGGET:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,PROFSP	;FETCH FILESPEC
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	P1,S1		;SAVE FD ADDRESS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,(P1)		;FD (PARSER DATA BLOCK) ADDRESS
	MOVE	S2,PRG+CG.PFL	;PROFILE OFFSET
	PUSHJ	P,PROBLK	;ADD/DELETE EXTENSIBLE BLOCK
	SKIPT			;CHECK FOR ERRORS
	WARN	(NRM,<No room in profile for PROGRAM-TO-RUN>,,PRGRES)
	MOVEI	S1,.AEPGR	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
PRGCMP:	MOVEI	S1,.AEPGR	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
PRGCHG:	MOVEI	S1,.AEPGR	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
PRGDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.PGR	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$PGR(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEPGR	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
PRGRES:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,.AEPGR(X)	;-LENGTH
	HRRI	T2,.AEPGR	;OFFSET
	SKIPE	T3,.AEPGR(X)	;ORIGINAL OFFSET POINTER
	ADDI	T3,(X)		;INDEX INTO PROFILE
	MOVX	T4,DF.PGR	;DEFAULT BIT FOR PROGRAM-TO-RUN
	TDNN	T4,DF$PGR(X)	;WAS IT ORIGINALLY DEFAULTED?
	TDZA	T4,T4		;NO, CLEAR THE BIT
	MOVEI	T4,1		;YES, SET IT
	PUSHJ	P,A$EBLK##	;RESTORE ORIGINAL PROGRAM TO RUN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEPGR	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
PRGPRT:	SKIPE	S1,.AEPGR(U)	;GET AOBJN POINTER TO FILESPEC
	JRST	PRGPR1		;GOT ONE
	$TEXT	(,<-none->)	;NOPE
	$RETT			;RETURN

PRGPR1:	ADDI	S1,(U)		;INDEX INTO PROFILE
	HLRE	S2,S1		;GET -LENGTH OF FILESPEC
	MOVMS	S2		;MAKE POSITIVE
	HRLZM	S2,FDBLK+.FDLEN	;SAVE AS FD LENGTH
	HRLZS	S1		;PUT FILESPEC ADDRESS IN LH
	HRRI	S1,FDBLK+.FDSTR	;MAKE A BLT POINTER
	BLT	S1,FDBLK+.FDPAT+4 ;COPY FOR GLXTXT
	$TEXT	(,<^F/FDBLK/>)	;DISPLAY
	$RETT			;RETURN


PRGHLP:	ASCIZ	\
PROGRAM-TO-RUN  specifies  a  file  specification  of the program to run
after the user logs in.  The file specification  may  include  a  device
name,  program  name,  extension,  and  directory,  including up to five
levels of sub-file directories (SFDs).
\
SUBTTL	ENTRIES -- PRV - PRIVILEGES


	.ENTRY	(PRV,.AEPRV,<Privileges>)

PRVPRS:	$NOISE	(CONFRM,<allowed>)
PRV000:	$INIT	(PRV010)
PRV010::$KEYDSP	(PRV020,<$ALTER(PRV030)>)
PRV020:	$STAB
	DSPTAB	(PRV010,PRVADM,<ADMINISTRATIVE>)
	DSPTAB	(PRV010,PRVCCC,<CPU>)
	DSPTAB	(PRV070,    -3,<DISK-PRIORITY>)
	DSPTAB	(PRV010,PRVENQ,<ENQ-DEQ>)
	DSPTAB	(PRV080,    -2,<HPQ>)
	DSPTAB	(PRV010,PRVIPC,<IPCF>)
	DSPTAB	(PRV010,PRVLCK,<LOCK>)
	DSPTAB	(PRV010,PRVMET,<METER>)
	DSPTAB	(PRV090,    -1,<OPERATOR>)
	DSPTAB	(PRV010,PRVPOK,<POKE>)
	DSPTAB	(PRV010,PRVRTT,<RTTRP>)
	DSPTAB	(PRV010,PRVSPA,<SPY-ALL-CORE>)
	DSPTAB	(PRV010,PRVSPM,<SPY-MONITOR>)
	DSPTAB	(PRV010,PRVTRP,<TRPSET>)
	DSPTAB	(PRV010,PRVNSP,<UNSPOOLING>)
	$ETAB
PRV030:	$KEYDSP	(CPV010##,<$ALTER(PRV040)>)
PRV040:	$KEYDSP	(PRV050,<$ALTER(CONFRM)>)
PRV050:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(PRV060,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
PRV060:	$KEYDSP	(PRV020,<$ALTER(PRV110)>)
PRV070:	$NUMBER	(PRV010,^D10,<Maximum disk priority>,<$DEFAULT(<0>)>)
PRV080:	$NUMBER	(PRV010,^D10,<Maximum CPU priority>,<$DEFAULT(<0>)>)
PRV090:	$KEYDSP	(PRV100,<$PREFIL(PRVACT),$PDEFAULT(DEFTX1)>)
PRV100:	$STAB
	DSPTAB	(PRV010,.OBHOP,<HOST>)
	DSPTAB	(PRV010,.OBNOP,<NONE>)
	DSPTAB	(PRV010,.OBROP,<REMOTE>)
	DSPTAB	(PRV010,.OBSOP,<SYSTEM>)
	$ETAB
PRV110:	$KEYDSP	(CPV010##)


PRVACT:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVE	P1,[ASCIZ /NONE/] ;ASSUME NO PRIVS
	SETZ	P2,		;CLEAR
	HLRZ	S1,.AEPPN(U)	;GET PROJECT NUMBER
	HRRZ	S2,.AEPPN(U)	;GET PROGRAMMER NUMBER
	CAIE	S2,REMOPR	;POSSIBLY A REMOTE OPERATOR?
	JRST	PRVAC1		;NO
	CAILE	S1,100		;RANGE CHECK
	CAILE	S1,177		; POSSIBLE STATION NUMBER
	JRST	PRVAC1		;CAN'T BE A REMOTE OPERATOR
	DMOVE	P1,[ASCIZ /REMOTE/]
	JRST	PRVAC3		;FINISH UP
PRVAC1:	MOVE	S2,.AEPPN(U)	;GET PPN IN QUESTION
	CAIE	S1,HSTPRJ	;ALLOWED HOST PRIVS?
	JRST	PRVAC2		;NO
	MOVE	P1,[ASCIZ /HOST/]
	SETZ	P2,		;CLEAR
	JRST	PRVAC3		;FINISH UP
PRVAC2:	CAIE	S1,SYSPRJ	;SYSTEM PROGRAMMER?
	CAIN	S1,GLXPRJ	;GALAXY PROJECT NUMBER?
	DMOVE	P1,[ASCIZ /SYSTEM/] ;GIVE FULL OPR PRIVS
PRVAC3:	DMOVEM	P1,DEFTX1	;SAVE DEFAULT TEXT
	$RETT			;RETURN
; GET ROUTINE
PRVGET:	PUSHJ	P,.SAVE1	;SAVE P1

PRVGE1:	MOVEI	S1,PRV000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ \PRIVILEGES>\]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

PRVGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	PRVGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAIL	S1,PRVBPT	;ADDRESS OF A
	CAIL	S1,PRVBPE	; BYTE POINTER?
	CAIA			;NO
	JRST	PRVGE3		;NEEDS SPECIAL PROCESSING
	CAIL	S1,CPVBPS##	;ADDRESS OF A CUSTOMER
	CAIL	S1,CPVBPE##	; BYTE POINTER?
	CAIA			;WRONG AGAIN
	JRST	PRVGE3		;YES, GIVE IT SPECIAL ATTENTION
	CAILE	S1,PRVLEN	;A COMMON KEYWORD?
	HRRES	S1		;NO--MAKE A NEGATIVE INDEX
	PUSHJ	P,@PRVTAB(S1)	;DISPATCH
	JRST	PRVGE2		;TRY FOR MORE

PRVGE3:	HLR	S2,(S1)		;GET THE BPT
	MOVEI	S1,1		;GET A BIT
	PUSH	P,U		;SAVE PROFILE ADDRESS
	MOVEI	U,CHGMSK	;FUDGE TO POINT TO BIT MASK
	DPB	S1,(S2)		;LIGHT BIT IN CHANGE/SELECT MASK
	POP	P,U		;RESTORE PROFILE ADDRESS
	SKIPE	P1		;SETTING?
	MOVEI	S1,0		;NO--CLEARING
	DPB	S1,(S2)		;ADD IN THE VALUE
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	JRST	PRVGE2		;AND LOOP


; COMPARE ROUTINE
PRVCMP:	MOVEI	S1,.AEPRV	;PRIMARY PROFILE OFFSET
	PUSHJ	P,COMPAR	;TEST FOR EQUALITY
	$RETIF			;PROPAGATE 'CHANGED' RETURN
	MOVEI	S1,.AEPRX	;FIRST HALF WAS OK,
	PJRST	COMPAR		;RETURN RESULT FROM SECOND OFFSET


; CHANGE ROUTINE
PRVCHG:	MOVEI	S1,.AEPRV	;PROFILE OFFSET
	PUSHJ	P,QUECHG	;CHANGE IT
	MOVEI	S1,.AEPRX	;OTHER PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THAT CHANGE, TOO


; DEFAULT ROUTINE
PRVDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.PRV	;DEFAULT BIT FOR FIRST FIELD
	IORM	S1,DF$PRV(U)	;LIGHT IN PROFILE
	MOVX	S1,DF.PRX	;DEFAULT BIT FOR SECOND FIELD
	IORM	S1,DF$PRX(U)	;LIGHT THAT, TOO
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEPRV	;WHOLE WORD
	SETOM	CHGMSK+.AEPRX	;BOTH WORDS
	$RETT			;WIN


; RESTORE ROUTINE
PRVRES:	MOVE	S1,.AEPRV(X)	;GET OLD PRIV WORD 1
	MOVEM	S1,.AEPRV(U)	;RESTORE OLD PRIV WORD 1
	MOVX	S1,DF.PRV	;PRIV WORD 1 DEFAULT BIT
	ANDCAM	S1,DF$PRV(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$PRV(X)	;RIGHT?
	IORM	S1,DF$PRV(U)	;NO, LIGHT IT AGAIN
	MOVE	S1,.AEPRX(X)	;GET OLD PRIV WORD 2
	MOVEM	S1,.AEPRX(U)	;RESTORE OLD PRIV WORD 2
	MOVX	S1,DF.PRX	;PRIV WORD 2 DEFAULT BIT
	ANDCAM	S1,DF$PRX(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$PRX(X)	;RIGHT?
	IORM	S1,DF$PRX(U)	;NO, LIGHT IT AGAIN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEPRV	;IN BOTH CHANGE MASKS
	SETZM	CHGMSK+.AEPRX	;AS WELL
	$RETT			;AND RETURN


; PRINT ROUTINE
PRVPRT:	SETO	T3,		;COUNT OF SECOND SET OF BITS TYPED
	LDB	S1,PRVDPR	;GET DSKPRI BYTE
	JUMPE	S1,PRVPR1	;BYPASS IF NOTHING
	AOS	T3		;BUMP COUNT OF ARGS
	$TEXT	(,<Disk priority: ^D/S1/^A>)
PRVPR1:	LDB	S1,PRVCPQ	;GET HPQ BYTE
	JUMPE	S1,PRVPR2	;BYPASS IF NOTHING
	AOSE	T3		;INCREMENT COUNT OF ARGS
	$TEXT	(,<, ^A>)	;SEPERATE FROM PREVIOUS ARG
	$TEXT	(,<HPQ: ^D/S1/^A>)
PRVPR2:	LDB	S1,PRVOPP	;GET OPR PRIV BYTE
	JUMPE	S1,PRVPR3	;BYPASS IF NONE
	AOSE	T3		;INCREMENT COUNT OF ARGS
	$TEXT	(,<, ^A>)
	$TEXT	(,<^T/@PRVGLX(S1)/ operator^A>)
PRVPR3:	LOAD	S1,.AEPRV(U),LHMASK ;GET DEC PRIVS
	SKIPL	T3		;IF NOTHING TYPED, DON'T END LINE
	$TEXT	(,<>)		;END LINE
	SKIPE	S1		;DON'T INDENT IF NO BITS
	$TEXT	(,<	^A>)	;INDENT NEXT SET OF TYPEOUT
PRVPR4:	MOVE	S1,[IOWD PRVBPE-PRVBPT,PRVBPT] ;IOWD POINTER TO BITS
	SKIPL	T3		;TYPE ANYTHING?
	PUSHJ	P,PRTBTX	;YES, DON'T TYPE "-NONE-"
	SKIPGE	T3
	PUSHJ	P,PRTBTS	;AND OUTPUT THE FIRST SET OF BITS
	PUSHJ	P,CPVPRT##	;PRINT CUSTOMER PRIV BITS
	$RETT			;RETURN


PRVHLP:	ASCIZ	\
PRIVILEGES specifies the privileged functions allowed to the user.   The
functions  are:   the  ability to set ADMINISTRATIVE, CPU specification,
DISK-PRIORITY, ENQ-DEQ, HPQ, IPCF, LOCK, METER, OPERATOR,  POKE,  RTTRP,
SPY-ALL-CORE, SPY-MONITOR, TRPSET, and UNSPOOLING.  Refer to the TOPS-10
Monitor Calls manual for more information on the use of privileges.
\
; KEYWORD DISPATCH TABLE
	IFIW	PRVDSK		;"DISK-PRIORITY"
	IFIW	PRVHPQ		;"HPQ"
	IFIW	PRVOPR		;"OPERATOR"
PRVTAB:	IFIW	PRVALL		;"ALL"
	IFIW	PRVDEF		;"DEFAULT"
	IFIW	PRVDON		;"DONE"
	IFIW	PRVHLX		;"HELP"
	IFIW	PRVNO		;"NO"
	IFIW	PRVNON		;"NONE"
	IFIW	PRVRES		;"RESTORE"
	IFIW	PRVPRT		;"SHOW"
PRVLEN==.-PRVTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
PRVALL:	PUSHJ	P,P$CFM		;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,ALLPRV	;GET ALL PRIV BITS
	IORM	S1,.AEPRV(U)	;SAVE
	IORM	S1,CHGMSK+.AEPRV ;ALSO SET IN MASK
	MOVEI	S1,.OBSOP	;NOW GET SYSTEM OPERATOR CODE
	DPB	S1,PRVOPP	;SET IT
	MOVX	S1,JP.OPR	;GET OPR PRIVS FIELD
	IORM	S1,CHGMSK+.AEPRX ;SET IN SECOND WORD'S MASK
PRVGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN

; "DEFAULT" KEYWORD PROCESSOR
PRVDEF:	PUSHJ	P,PRVDFL	;DO DEFAULTING
	PJRST	PRVGO		;FINISH UP


; "DONE" KEYWORD PROCESSOR
PRVDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	ADJSP	P,-1		;WE CO-RETURN
	MOVE	T1,@CHGADR	;SAVE PREVIOUS CHANGE FLAG
	MOVEI	S1,.AEPRV	;PRIMARY OFFSET
	PUSHJ	P,CMPVAL	;SET CHANGE FLAGS
	SKIPN	T1		;IF NOT PREVIOUSLY CHANGED,
	SKIPA	T1,@CHGADR	;JUST USE THIS VALUE
	EXCH	T1,@CHGADR	;ELSE REMEMBER NEW FLAG AND RESTORE OLD ONE
	MOVEI	S1,.AEPRX	;SECONDARY OFFSET
	PUSHJ	P,CMPVAL	;SET CHANGE FLAGS FROM IT
	SKIPE	T1		;IF WE CHANGED IT,
	SETOM	@CHGADR		; MAKE SURE WE MARK IT
	POPJ	P,		;RETURN


; "HELP" KEYWORD PROCESSOR
PRVHLX:	PUSHJ	P,P$CFM		;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@PRV+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "NO" KEYWORD PROCESSOR
PRVNO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;AND RETURN


; "NONE" KEYWORD PROCESSOR
PRVNON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,ALLPRV	;GET ALL PRIV BITS
	ANDCAM	S1,.AEPRV(U)	;CLEAR THEM
	IORM	S1,CHGMSK+.AEPRV ;SET IN MASK FOR WORD
	SETZM	.AEPRX(U)	;AND EXTENDED PRIV WORD
	SETOM	CHGMSK+.AEPRX	;CHANGING THIS ONE, TOO
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN
; "DISK-PRIORITY" KEYWORD PROCESSOR
PRVDSK:	PUSHJ	P,P$NUM##	;GET PRIORITY
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPE	P1		;SKIP IF SETTING
	MOVEI	S1,0		;ZERO VALUE
	SETZ	P1,		;CLEAR "NO" FLAG
	SKIPL	S1		;RANGE
	CAILE	S1,3		; CHECK
	WARN	(DOR,<Disk priority ^D/S1/ out of range 0 to 3>,,.RETT)
	DPB	S1,PRVDPR	;SAVE AWAY
	MOVX	S1,JP.DPR	;DISK-PRIORITY MASK
	IORM	S1,CHGMSK+.AEPRV ;SET IN MODIFIED MASK
	SETOM	@CHGADR		;CHANGING PROFILE ENTRY
	$RETT			;AND RETURN


; "HPQ" KEYWORD PROCESSOR
PRVHPQ:	PUSHJ	P,P$NUM##	;GET HPQ
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPE	P1		;SKIP IF SETTING
	MOVEI	S1,0		;ZERO VALUE
	SETZ	P1,		;CLEAR "NO" FLAG
	SKIPL	S1		;RANGE
	CAILE	S1,^D15		; CHECK
	WARN	(HOR,<HPQ ^D/S1/ out of range 0 to 15>,,.RETT)
	DPB	S1,PRVCPQ	;SAVE AWAY
	MOVX	S1,JP.HPQ	;GET HPQ MASK
	IORM	S1,CHGMSK+.AEPRV ;SET IN MODIFY MASK
	SETOM	@CHGADR		;CHANGING PROFILE ENTRY
	$RETT			;AND RETURN


; "OPERATOR" KEYWORD PROCESSOR
PRVOPR:	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPE	P1		;SKIP IF SETTING
	MOVEI	S1,.OBNOP	;ZERO VALUE
	SETZ	P1,		;CELAR "NO" FLAG
	DPB	S1,PRVOPP	;SAVE AWAY
	MOVX	S1,JP.OPR	;OPR PRIVS FIELD
	IORM	S1,CHGMSK+.AEPRX ;SET IN MODIFY MASK
	SETOM	@CHGADR		;CHANGING PROFILE ENTRY
	$RETT			;AND RETURN
; BIT STORAGE/DISPLAY TABLE
PRVBPT:!
PRVADM:	XWD [POINTR .AEPRV(U),JP.ADM],[ASCIZ \Administrative\]
PRVENQ:	XWD [POINTR .AEPRV(U),JP.ENQ],[ASCIZ \ENQ-DEQ\]
PRVIPC:	XWD [POINTR .AEPRV(U),JP.IPC],[ASCIZ \IPCF\]
PRVLCK:	XWD [POINTR .AEPRV(U),JP.LCK],[ASCIZ \LOCK\]
PRVMET:	XWD [POINTR .AEPRV(U),JP.MET],[ASCIZ \METER\]
PRVPOK:	XWD [POINTR .AEPRV(U),JP.POK],[ASCIZ \POKE\]
PRVRTT:	XWD [POINTR .AEPRV(U),JP.RTT],[ASCIZ \RTTRP\]
PRVCCC:	XWD [POINTR .AEPRV(U),JP.CCC],[ASCIZ \CPU\]
PRVSPA:	XWD [POINTR .AEPRV(U),JP.SPA],[ASCIZ \SPY-all-core\]
PRVSPM:	XWD [POINTR .AEPRV(U),JP.SPM],[ASCIZ \SPY-monitor\]
PRVTRP:	XWD [POINTR .AEPRV(U),JP.TRP],[ASCIZ \TRPSET\]
PRVNSP:	XWD [POINTR .AEPRV(U),JP.NSP],[ASCIZ \Unspooling\]
PRVBPE:!

PRVDPR:	POINTR	.AEPRV(U),JP.DPR	;DISK PRIORITY
PRVCPQ:	POINTR	.AEPRV(U),JP.HPQ	;HPQ
PRVOPP:	POINTR	.AEPRX(U),JP.OPR	;OPERATOR


; GALAXY OPERATOR PRIVILEGES
PRVGLX:	[ASCIZ	\None\]
	[ASCIZ	\System\]
	[ASCIZ	\Host\]
	[ASCIZ	\Remote\]
SUBTTL	ENTRIES -- PSW - PASSWORD


	.ENTRY	(PSW,.AEPSW,<Password>,FL.NTY)

PASS00:	$INIT	(PSWPRS)
PSWPRS:	$FIELD	(CONFRM,,<$PREFI(P$7BIT##),$FLAGS(CM%SDH),$BREAK(PSWBRK)>)


; GET ROUTINE
PSWGET:	PUSHJ	P,.SAVE2	;SOME PERM ACS
	PUSHJ	P,P$FLD##	;GET POINTER TO FIELD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETOM	CHGMSK+.AEPSW	;IN BOTH PLACES
	MOVE	P1,S1		;STASH POINTER TO BLOCK
	MOVE	S1,[XWD PASSWD,PASSWD+1] ;CLEAR PASSWORD BLOCK
	SETZM	PASSWD
	BLT	S1,PASSWD+.APWLW-1
	MOVEI	T1,ARG.DA(P1)	;ADDRESS OF TEXT
	HRLI	T1,(POINT 7,)	;MAKE A BYTE POINTER
	MOVE	T2,[POINT 8,PASSWD] ;BYTE POINTER TO STORAGE
	MOVEI	T3,.APWLC	;MAXIMUM LENGTH

PSWGE1:	ILDB	S1,T1		;GET A CHARACTER
	JUMPE	S1,.RETT	;RETURN IF ALL DONE
	CAIL	S1,140		;UPPER CASE?
	SUBI	S1,40		;IT IS NOW
;	SUBI	S1,40		;SIXBIT NOW
	IDPB	S1,T2		;PUT A CHARACTER
	SOJG	T3,PSWGE1	;LOOP THROUGH STRING
	ILDB	S1,T1		;GET NEXT CHARACTER
	SKIPE	S1		;TERMINATING NUL?
	WARN	(PST,<Password truncated to ^D/[.APWLC]/ characters>)
	$RETT


; COMPARE ROUTINE
PSWCMP:	$RETT			;PASSWORD ALWAYS MATCHES


; CHANGE ROUTINE
PSWCHG:	PUSHJ	P,.SAVE2	;PRESERVE SOME ACS
	DMOVE	P1,[EXP .AEPSW,<.APWLW,,PASSWD>] ;POINT TO BLOCK
	PJRST	QUEINS		;STUFF INTO UUO LIST


; DEFAULT ROUTINE
PSWDFL:	PJRST	PRODFZ		;CAN'T DEFAULT THIS ONE


; RESTORE ROUTINE
PSWRES:	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEPSW	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
PSWPRT:	$RETT			;NEVER PRINT IT OUT


; HELP TEXT
PSWHLP:	ASCIZ	\
PASSWORD specifies a password the user must type to gain access  to  the
system.   The  password can consist of any printable characters, and can
be up to 39 characters long.
\
SUBTTL	ENTRIES -- RQL - REQUIRE


	.ENTRY	(RQL,.AEREQ,<Requirements for LOGIN>)

RQLPRS:	$NOISE	(CONFRM,<for LOGIN>)
RQL000:	$INIT	(RQL010)
RQL010:	$KEYDSP	(RQL020,<$ALTER(RQL130)>)
RQL020:	$STAB
	DSPTAB 	(RQL010,-10,<ACCOUNT-STRING>)
	DSPTAB	(RQL060,-7,<CHANGE>)
	DSPTAB	(RQL090,-6,<INTERVAL>)
	DSPTAB	(RQL080,-5,<LENGTH>)
	DSPTAB 	(RQL030,-4,<NAME>)
	DSPTAB 	(RQL030,-3,<PASSWORD>)
	DSPTAB	(RQL100,-2,<PROHIBIT>)
	DSPTAB 	(RQL010,-1,<REMARK-STRING>)
	$ETAB
RQL030:	$NOISE	(RQL040,<under>)
RQL040:	$KEY	(RQL010,RQL050,<$DEFAULT(<BOTH>),$ALTER(RQL130)>)
RQL050:	$STAB
	KEYTAB	(1,<BATCH>)
	KEYTAB	(3,<BOTH>)
	KEYTAB	(2,<TIMESHARING>)
	$ETAB
RQL060:	$NOISE	(RQL070,<of password>)
RQL070:	$FTAD	(RQL010,<$HELP(<future date/time>),$ALTER(RQL010)>)
RQL080:	$NUMBER	(RQL010,^D10,<minimum password length>)
RQL090:	$NUMBER	(RQL010,^D10,<password change interval in days>)
RQL100:	$NOISE	(RQL110,<password changes>)
RQL110:	$KEYDSP	(RQL120,<$DEFAULT (<YES>)>)
RQL120:	$STAB
	 DSPTAB	(CONFRM,0,<NO>)
	 DSPTAB (CONFRM,1,<YES>)
	$ETAB

RQL130:	$KEYDSP	(RQL140,<$ALTER(CONFRM)>)
RQL140:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(RQL150,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
RQL150:	$KEYDSP	(RQL020)
; GET ROUTINE
RQLGET:	PUSHJ	P,.SAVE1	;SAVE P1

RQLGE1:	MOVEI	S1,RQL000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ /REQUIREMENTS>/]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

RQLGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	RQLGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAILE	S1,RQLSIZ	;A COMMON KEYWORD?
	HRRES	S1		;NO--MAKE A NEGATIVE INDEX
	PUSHJ	P,@RQLTAB(S1)	;DISPATCH
	JRST	RQLGE2		;TRY FOR MORE


; COMPARE ROUTINE
RQLCMP:	MOVEI	S1,.AEREQ	;PRIMARY PROFILE OFFSET
	PUSHJ	P,COMPAR	;SEE IF THE SAME
	$RETIF			;PROPAGATE '.NE.' RETURN
	MOVEI	S1,.AEPCT	;OK SO FAR,
	PJRST	COMPAR		;RETURN RESULT FROM SECOND OFFSET


; CHANGE ROUTINE
RQLCHG:	MOVEI	S1,.AEREQ	;WORD TO CHANGE
	PUSHJ	P,QUECHG	;MAYBE QUEUE UP THE CHANGE
	MOVE	S2,.AEPCT(U)	;GET UDT OF CHANGE
	MOVEI	S1,.AEPCT	;GET FORCE PASSWORD CHANGE FUNCTION
	CAME	S2,.AEPCT(X)	;IF A CHANGE,
	PJRST	QUECHG		;QUEUE IT UP AND RETURN
	$RETT			;RETURN HAPPY


; DEFAULT ROUTINE
RQLDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.REQ	;DEFAULT BIT FOR FIRST FIELD
	IORM	S1,DF$REQ(U)	;LIGHT IN PROFILE
	MOVX	S1,DF.PCT	;DEFAULT BIT FOR SECOND FIELD
	IORM	S1,DF$PCT(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEREQ	;WHOLE THING
	SETOM	CHGMSK+.AEPCT	;BOTH WORDS
	$RETT			;WIN


; RESTORE ROUTINE
RQLRES:	MOVE	S1,.AEREQ(X)	;GET ORIGINAL REQUIREMENTS
	MOVEM	S1,.AEREQ(U)	;RESTORE
	MOVX	S1,DF.REQ	;REQUIREMENTS WORD DEFAULT BIT
	ANDCAM	S1,DF$REQ(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$REQ(X)	;RIGHT?
	IORM	S1,DF$REQ(U)	;NO, LIGHT IT AGAIN
	MOVE	S1,.AEPCT(X)	;GET ORIGINAL PSW CHANGE UDT
	MOVEM	S1,.AEPCT(U)	;RESTORE
	MOVX	S1,DF.PCT	;CHANGE TIME WORD DEFAULT BIT
	ANDCAM	S1,DF$PCT(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$PCT(X)	;RIGHT?
	IORM	S1,DF$PCT(U)	;NO, LIGHT IT AGAIN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEPCT	;IN BOTH MASK WORDS
	SETZM	CHGMSK+.AEREQ	;AS WELL
	$RETT			;AND RETURN


; PRINT ROUTINE
RQLPRT:	LDB	T1,[POINTR (.AEREQ(U),AE.ACT)] ;GET ACCOUNT BIT
	LDB	T2,[POINTR (.AEREQ(U),AE.RMK)] ;GET REMARK BIT
	LSH	T2,1		;POSITION
	IOR	T2,T1		;MERGE THE TWO
	MOVE	T1,RQLPRX(T2)	;GET APPROPRIATE TEXT
	$TEXT	(,<^M^J	^T/(T1)/>)
	LDB	T1,[POINTR (.AEREQ(U),AE.NRT)] ;GET NAME UNDER TIMESARING
	LDB	T2,[POINTR (.AEREQ(U),AE.NRB)] ;GET NAME UNDER BATCH
	LSH	T2,1		;POSITION
	IOR	T2,T1		;MERGE THE TWO
	MOVE	T1,RQLPRY(T2)	;GET APPROPRIATE TEXT
	$TEXT	(,<	Name ^T/(T1)/>)
	LDB	T1,[POINTR (.AEREQ(U),AE.PRT)] ;GET PSW UNDER TIMESARING
	LDB	T2,[POINTR (.AEREQ(U),AE.PRB)] ;GET PSW UNDER BATCH
	LSH	T2,1		;POSITION
	IOR	T2,T1		;MERGE THE TWO
	MOVE	T1,RQLPRY(T2)	;GET APPROPRIATE TEXT
	$TEXT	(,<	Password ^T/(T1)/>)
	SKIPN	S1,.AEPCT(U)	;PASSWORD CHANGE DATE?
	SKIPA	T1,[[ITEXT (<not required>)]]
	MOVEI	T1,[ITEXT (<at ^H/.AEPCT(U)/>)]
	CAMN	S1,[EXP -1]	;CHANGE AT NEXT LOGIN?
	MOVEI	T1,[ITEXT (<at next LOGIN>)]
	$TEXT	(,<	Password change ^I/(T1)/>)
	LOAD	S1,.AEREQ(U),AE.PWL ;GET MINIMUM PASSWORD LENGTH
	MOVEI	S2,[ITEXT (<^D/S1/>)]
	SKIPN	S1		;WAS IT SET?
	MOVEI	S2,[ITEXT (<^T/NONE7/>)] ;NO
	$TEXT	(,<	Minimum password length: ^I/(S2)/>)
	LOAD	S1,.AEREQ(U),AE.PCI ;GET PASSWORD CHANGE INTERVAL
	MOVEI	S2,[ITEXT (<Every ^D/S1/ days>)]
	SKIPN	S1		;WAS IT SET?
	MOVEI	S2,[ITEXT (<^T/NONE7/>)] ;NO
	$TEXT	(,<	Password change interval: ^I/(S2)/>)
	LDB	S1,[POINTR (.AEREQ(U),AE.PCP)] ;GET BIT
	MOVE	S1,[[ASCIZ /allowed/]
		    [ASCIZ /prohibited/]](S1)
	$TEXT	(,<	Password changes are ^T/(S1)/>)
	$RETT			;RETURN

RQLPRX:	[ASCIZ	/Account and remark strings are not required/]
	[ASCIZ	/Account string/]
	[ASCIZ	/Remark string/]
	[ASCIZ	/Account and remark strings/]

RQLPRY:	[ASCIZ	/is not required/]
	[ASCIZ	/under timesharing/]
	[ASCIZ	/under batch/]
	[ASCIZ	/under timesharing and batch/]


; HELP TEXT
RQLHLP:	ASCIZ	\
REQUIREMENTS specifies additional information the user  must  supply  in
order to LOGIN.  Options are:  
	
	ACCOUNT-STRING
	CHANGE of password
	INTERVAL of required password changes in days
	LENGTH of minimum password
	NAME under timesharing or batch
	PROHIBIT password changes
	PASSWORD under timesharing or batch
	REMARK-STRING to be stored in the usage files
\
; KEYWORD DISPATCH TABLE
	IFIW	RQLACC		;"ACCOUNT-STRING"
	IFIW	RQLCPW		;"CHANGE-OF-PASSWORD"
	IFIW	RQLINT		;"INTERVAL"
	IFIW	RQLLEN		;"LENGTH"
	IFIW	RQLNAM		;"NAME"
	IFIW	RQLPSW		;"PASSWORD"
	IFIW	RQLPRH		;"PROHIBIT"
	IFIW	RQLREM		;"REMARK-STRING"
RQLTAB:	IFIW	RQLALL		;"ALL"
	IFIW	RQLDEF		;"DEFAULT"
	IFIW	RQLDON		;"DONE"
	IFIW	RQLHLX		;"HELP"
	IFIW	RQLNO		;"NO"
	IFIW	RQLNON		;"NONE"
	IFIW	RQLRES		;"RESTORE"
	IFIW	RQLPRT		;"SHOW"
RQLSIZ==.-RQLTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
RQLALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	SETOM	.AEREQ(U)	;SET ALL REQUIREMENTS
	SETOM	CHGMSK+.AEREQ	;CHANGED WHOLE WORD
	SETOM	.AEPCT(U)	;FORCE CHANGE ON THE NEXT LOGIN
	SETOM	CHGMSK+.AEPCT	;FLAG CHANGE HERE, TOO
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "DEFAULT" KEYWORD PROCESSOR
RQLDEF:	PUSHJ	P,RQLDFL	;DO DEFAULTING
	PJRST	RQLGO1		;FINISH UP


; "DONE" KEYWORD PROCESSOR
RQLDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	T1,@CHGADR	;SAVE CHANGE FLAG
	MOVEI	S1,.AEREQ	;PRIMARY PROFILE OFFSET
	PUSHJ	P,CMPVAL	;SET CHANGE FLAGS
	SKIPN	T1		;IF NOT PREVIOUSLY CHANGED,
	SKIPA	T1,@CHGADR	;JUST USE THIS VALUE
	EXCH	T1,@CHGADR	;ELSE REMEMBER NEW FLAG AND RESTORE OLD ONE
	MOVEI	S1,.AEPCT	;SECONDARY PROFILE OFFSET
	PUSHJ	P,CMPVAL	;SET ITS CHANGE FLAGS
	SKIPE	T1		;IF WE KNOW WE CHANGED SOMETHING,
	SETOM	@CHGADR		; MAKE SURE WE MARK IT
	ADJSP	P,-1		;WE CO-RETURN
	POPJ	P,		;DO SO


; "HELP" KEYWORD PROCESSOR
RQLHLX:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@RQL+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "NO" KEYWORD PROCESSOR
RQLNO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;RETURN


; "NONE" KEYWORD PROCESSOR
RQLNON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	SETZM	.AEREQ(U)	;CLEAR ALL REQUIREMENTS
	SETOM	CHGMSK+.AEREQ	;CHANGED WHOLE WORD
	SETZM	.AEPCT(U)	;CLEAR PASSWORD CHANGE DATE/TIME
	SETOM	CHGMSK+.AEPCT	;NOTE CHANGE HERE, TOO
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN
; "ACCOUNT-STRING" KEYWORD PROCESSOR
RQLACC:	MOVX	S1,AE.ACT	;BIT TO SET
RQLGO:	SKIPE	P1		;SKIP IF SETTING
	ANDCAM	S1,.AEREQ(U)	;CLEAR REQUIREMENTS
	SKIPN	P1		;SKIP IF CLEARING
	IORM	S1,.AEREQ(U)	;SET REQUIREMENTS
	IORM	S1,CHGMSK+.AEREQ ;SET IN CHANGE MASK
RQLGO1:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "CHANGE" KEYWORD PROCESSOR
RQLCPW:	SETZM	.AEPCT(U)	;CLEAR PSW CHANGE DATE/TIME
	PUSHJ	P,P$TIME##	;GET TIME IN UDT FORMAT
	SKIPT			;PERHAPS NOT SPECIFIED
	SETOM	S1		;NEG MEANS LITE THE BIT, NOT A UDT
	SKIPN	P1		;SKIP IF CLEARING PASSWORD CHANGE
	MOVEM	S1,.AEPCT(U)	;SAVE POSSIBLE UDT
	PJRST	RQLGO1		;GO FINISH UP


; "INTERVAL" KEYWORD PROCESSOR
RQLINT:	PUSHJ	P,P$NUM##	;FETCH A NUMBER
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S2,DEFPCI	;MAXIMUM
	SKIPL	S1		;CAN'T BE NEGATIVE
	CAILE	S1,(S2)		;BE REASONABLE
	WARN	(PCI,<Password change interval out of range 0 to ^D/S2/ days>,,.RETT)
	STORE	S1,.AEREQ(U),AE.PCI ;SAVE INTERVAL
	MOVX	S1,AE.PCI	;MASK WE CHANGED
	IORM	S1,CHGMSK+.AEREQ ;NOTE IT
	PJRST	RQLGO1		;MARK CHANGE AND RETURN


; "LENGTH" KEYWORD PROCESSOR
RQLLEN:	PUSHJ	P,P$NUM##	;FETCH A NUMBER
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S2,.APWLC	;MAXIMUM LENGTH
	SKIPL	S1		;CAN'T BE NEGATIVE
	CAILE	S1,(S2)		;RANGE CHECK
	WARN	(RPL,<Required password length out of range 0 to ^D/S2/ characters>,,.RETT)
	STORE	S1,.AEREQ(U),AE.PWL ;SAVE IN PROFILE
	MOVX	S1,AE.PWL	;GET MASK FOR FIELD
	IORM	S1,CHGMSK+.AEREQ ;SET IN CHANGE MASK
	PJRST	RQLGO1		;MARK CHANGE AND RETURN


; "NAME" KEYWORD PROCESSOR
RQLNAM:	MOVEI	T1,3		;DEFAULT TO NAME UNDER TIMESHARING AND BATCH
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	SKIPF			;DEFAULTING?
	MOVE	T1,S1		;NO
	SETZ	S1,		;CLEAR DESTINATION
	TRNE	T1,1		;BATCH?
	TXO	S1,AE.NRB	;YES
	TRNE	T1,2		;TIMESHARING?
	TXO	S1,AE.NRT	;YES
	PJRST	RQLGO		;GO SET/CLEAR BITS


; "PASSWORD" KEYWORD PROCESSOR
RQLPSW:	MOVEI	T1,3		;DEFAULT TO PSW UNDER TIMESHARING AND BATCH
	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	SKIPF			;DEFAULTING?
	MOVE	T1,S1		;NO
	SETZ	S1,		;CLEAR DESTINATION
	TRNE	T1,1		;BATCH?
	TXO	S1,AE.PRB	;YES
	TRNE	T1,2		;TIMESHARING?
	TXO	S1,AE.PRT	;YES
	PJRST	RQLGO		;GO SET/CLEAR BITS


; "PROHIBIT" KEYWORD PROCESSOR
RQLPRH:	PUSHJ	P,P$KEYW##	;GET A KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	T1,S1		;GET KEYWORD VALUE
	MOVX	S1,AE.PCP	;GET PROHIBIT BIT
	SKIPN	P1		;SKIP IF CLEARING
	TRC	T1,1		;ELSE TOGGLE
	MOVE	P1,T1		;UPDATE SET/CLEAR FLAG
	PJRST	RQLGO		;GO TOGGLE BIT AND RETURN


; "REMARK-STRING" KEYWORD PROCESSOR
RQLREM:	MOVX	S1,AE.RMK	;BIT TO SET
	PJRST	RQLGO		;GO SET/CLEAR BIT
SUBTTL	ENTRIES -- SCH - SCHEDULER-TYPE


	.ENTRY	(SCH,.AESCD,<Schedular type>)

SCHPRS:	$NUMBER	(CONFRM,^D10,<Schedular type>)


; GET ROUTINE
SCHGET:	PUSHJ	P,P$NUM##	;GET THE TYPE
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SKIPGE	T1,S1		;COPY
	MOVEI	T1,0		;CAN'T BE NEGATIVE
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVEI	S1,<MASK.(<WID(AE.SCD)>,35)> ;GET LIMIT
	CAILE	T1,(S1)		;RANGE CHECK
	WARN	(SOR,<Scheduler type ^D/T1/ out of range 0 to ^D/S1/>,,.RETT)
	DPB	T1,SCHED	;STORE THE VALUE
	MOVEI	S1,.AESCD	;OFFSET TO CHECK
	PJRST	CMPVLC		;SET CHANGE FLAGS & RETURN


; COMPARE ROUTINE
SCHCMP:	MOVEI	S1,.AESCD	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
SCHCHG:	MOVEI	S1,.AESCD	;FUNCTION TO CHANGE SCHEDULAR TYPE
	JRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
SCHDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.SCD	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$SCD(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AESCD	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
SCHRES:	EXCH	U,X		;SWAP PROFILE POINTERS
	LDB	S1,SCHED	;GET OLD SCHEDULER TYPE
	EXCH	U,X		;SWAP BACK
	DPB	S1,SCHED	;RESTORE OLD SCHEDULER TYPE
	MOVX	S1,DF.SCD	;SCHEDULER WORD DEFAULT BIT
	ANDCAM	S1,DF$SCD(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$SCD(X)	;RIGHT?
	IORM	S1,DF$SCD(U)	;NO, LIGHT IT AGAIN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AESCD	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
SCHPRT:	LDB	S1,SCHED	;GET THE TYPE
	$TEXT	(,<^D/S1/>)	;TYPE IT OUT
	$RETT			;RETURN


; HELP TEXT
SCHHLP:	ASCIZ	\
SCHEDULER-TYPE associates the specified user profile with a  group  that
has  been  assigned  a  scheduler  class.   For  more  information about
assigning scheduler classes, see the SCDSET documentation in the TOPS-10
Software Installation Guide.
\
SUBTTL	ENTRIES -- SPO - SPOOLED-DEVICES


	.ENTRY	(SPO,.AESPL,<Spooled device bits>)

SPOPRS:	$NOISE	(CONFRM,<set by LOGIN>)
SPO000:	$INIT	(SPO010)
SPO010:	$KEYDSP	(SPO020,<$ALTER(SPO030)>)
SPO020:	$STAB
	DSPTAB	(SPO010,[JS.PCP],<CDP>)
	DSPTAB	(SPO010,[JS.PCR],<CDR>)
	DSPTAB	(SPO010,[JS.PLP],<LPT>)
	DSPTAB	(SPO010,[JS.PPL],<PLT>)
	DSPTAB	(SPO010,[JS.PPT],<PTP>)
	$ETAB
SPO030:	$KEYDSP	(SPO040,<$ALTER(CONFRM)>)
SPO040:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(SPO050,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
SPO050:	$KEYDSP	(SPO020)
; GET ROUTINE
SPOGET:	PUSHJ	P,.SAVE1	;SAVE P1

SPOGE1:	MOVEI	S1,SPO000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ /SPOOLED-DEVICES>/]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

SPOGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	SPOGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAIG	S1,SPOLEN	;ADDRESS OF BIT?
	JRST	SPOGE3		;NO--KEYWORD
	MOVE	S2,(S1)		;GET THE BIT
	IORM	S2,.AESPL(U)	;SET IT ALWAYS
	IORM	S2,CHGMSK+.AESPL ;AT LEAST IN THE CHANGE MASK
	SKIPE	P1		;SKIP IF SETTING
	ANDCAM	S2,.AESPL(U)	;ZERO THE BIT
	SETZ	P1,		;CLEAR "NO" FLAG
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	JRST	SPOGE1		;AND LOOP

SPOGE3:	PUSHJ	P,@SPOTAB(S1)	;DISPATCH
	JRST	SPOGE2		;AND LOOP BACK
	$RETT			;YES


; COMPARE ROUTINE
SPOCMP:	MOVEI	S1,.AESPL	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
SPOCHG:	MOVEI	S1,.AESPL	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
SPODFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.SPL	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$SPL(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AESPL	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
SPORES:	MOVE	S1,.AESPL(X)	;GET ORIGINAL SPOOLING BITS
	MOVEM	S1,.AESPL(U)	;RESTORE
	MOVX	S1,DF.SPL	;SPOOLING WORD DEFAULT BIT
	ANDCAM	S1,DF$SPL(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$SPL(X)	;RIGHT?
	IORM	S1,DF$SPL(U)	;NO, LIGHT IT AGAIN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AESPL	;BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
SPOPRT:	MOVE	S1,[IOWD SPOBPE-SPOBPT,SPOBPT] ;POINTER TO TABLE OF BITS
	PUSHJ	P,PRTBTS	;PRINT THE BITS OUT
	$RETT			;AND RETURN


; HELP TEXT
SPOHLP:	ASCIZ	\
SPOOLED-DEVICES  specifies  the  physical devices which are not normally
available to the user.  These devices are said to be spooled because the
monitor  intercepts  I/O to these devices and redirects the data to/from
disk files.
\
; KEYWORD DISPATCH TABLE
SPOTAB:	IFIW	SPOALL		;"ALL"
	IFIW	SPODEF		;"DEFAULT"
	IFIW	SPODON		;"DONE"
	IFIW	SPOHLX		;"HELP"
	IFIW	SPONO		;"NO"
	IFIW	SPONON		;"NONE"
	IFIW	SPORES		;"RESTORE"
	IFIW	SPOPRT		;"SHOW"
SPOLEN==.-SPOTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
SPOALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,JS.PAL	;SPOOL:ALL BITS
	MOVEM	S1,.AESPL(U)	;SET ALL SPOOLING BITS
	MOVEM	S1,CHGMSK+.AESPL ;IN MASK AS WELL
SPOGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "DEFAULT" KEYWORD PROCESSOR
SPODEF:	PUSHJ	P,SPODFL	;DO DEFAULTING
	PJRST	SPOGO		;FINISH UP


; "DONE" KEYWORD PROCESSOR
SPODON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	ADJSP	P,-1		;WE CO-RETURN
	MOVEI	S1,.AESPL	;OFFSET TO CHECK
	PJRST	CMPVAL		;SET CHANGE FLAGS & RETURN


; "HELP" KEYWORD PROCESSOR
SPOHLX:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@SPO+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "NO" KEYWORD PROCESSOR
SPONO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;RETURN


; "NONE" KEYWORD PROCESSOR
SPONON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,JS.PAL	;SPOOL:ALL BITS
	ANDCAM	S1,.AESPL(U)	;CLEAR IN PROFILE ENTRY
	IORM	S1,CHGMSK+.AESPL ;NOTE AS CHANGED IN MASK
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN
; BIT STORAGE/DISPLAY TABLE
SPOBPT:	XWD	[POINTR .AESPL(U),JS.PCP],[ASCIZ \CDP\]
	XWD	[POINTR .AESPL(U),JS.PCR],[ASCIZ \CDR\]
	XWD	[POINTR .AESPL(U),JS.PLP],[ASCIZ \LPT\]
	XWD	[POINTR .AESPL(U),JS.PPL],[ASCIZ \PLT\]
	XWD	[POINTR .AESPL(U),JS.PPT],[ASCIZ \PTP\]
SPOBPE:!
SUBTTL	ENTRIES -- STR - STRUCTURE-QUOTAS


	.ENTRY	(STR,.AEAUX,<Structure quotas>)

STRPRS:	$NOISE	(CONFRM,<set by LOGIN>)
STR000:	$INIT	(STR010)
STR010:	$KEYDSP	(STR020,<$ALTER(STR190)>)
STR020:	$STAB
	DSPTAB	(STR030,-2,<ADD>)
	DSPTAB	(STR170,-1,<REMOVE>)
	$ETAB

STR030:	$NOISE	(STR040,<structure>)
STR040:	$FIELD	(STR050,<structure name>,<$ACTION(STRACT)>)
STR050:	$NOISE	(STR060,<logged in>)
STR060:	$NUMBER	(STR080,^D10,<logged in quota>,<$PREFIL(STRPFF),$PDEFAULT(DEFTX1),$ACTION(STRACF),$ALTER(STR070)>)
STR070:	$KEY	(STR080,STR160,<$ACTION(STRACF)>)
STR080:	$NOISE	(STR090,<logged out>)
STR090:	$NUMBER	(STR110,^D10,<logged out quota>,<$PREFIL(STRPFO),$PDEFAULT(DEFTX1),$ACTION(STRACO),$ALTER(STR100)>)
STR100:	$KEY	(STR110,STR160,<$ACTION(STRACO)>)
STR110:	$NOISE	(STR120,<reserved>)
STR120:	$NUMBER	(STR140,^D10,<reserved quota>,<$PREFIL(STRPFR),$PDEFAULT(DEFTX1),$ACTION(STRACR)>)
STR140:	$SWITCH	(NEXT,STR150,<$PDEFAUL(DEFTX2),$ACTION(SHRSWT),$ALTER(CONFRM)>)
STR150:	$STAB
	KEYTAB	(CREFLG,<CREATE>)
	KEYTAB	(NOCFLG,<NOCREATE>)
	KEYTAB	(NOWFLG,<NOWRITE>)
	KEYTAB	(WRTFLG,<WRITE>)
	$ETAB
STR160:	$STAB
	KEYTAB	(0,<INFINITE>)
	$ETAB
STR170:	$NOISE	(STR180,<structure>)
STR180:	$FIELD	(CONFRM,<structure name>)
STR190:	$KEYDSP	(STR200,<$ALTER(CONFRM)>)
STR200:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
;	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
;	DSPTAB	(STR210,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
STR210:	$KEYDSP	(STR010)

CREFLG:	EXP	0,AU.NCR	;CLEAR NO CREATE
NOCFLG:	EXP	1,AU.NCR	;SET NO CREATE
WRTFLG:	EXP	0,AU.RON	;CLEAR NO WRITE
NOWFLG:	EXP	1,AU.RON	;SET NO WRITE

STRACT:	MOVX	S1,DEFQTA	;DEFAULT QUOTA
	MOVEM	S1,AUXBLK+.AULIN ;FCFS
	SETZM	AUXBLK+.AUOUT	;LOGGED OUT
	SETZM	AUXBLK+.AURES	;RESERVED
	MOVX	S1,STATBT	;DEFAULT STATUS BITS
	MOVEM	S1,AUXBLK+.AUBIT
	PUSH	P,T1		;SAVE T1
	PUSH	P,U		;SAVE U (DON'T KNOW WHAT OPRPAR USES IT FOR)
	MOVEI	U,USER		;POINT TO PROFILE BLOCK
	HRRZ	S1,CR.SIZ(S2)	;GET ADDR OF OF PARSED DATA STORAGE
	HRROI	S1,ARG.DA(S1)	;POINT TO ASCIZ STRUCTURE NAME
	PUSHJ	P,S%SIXB	;CONVERT TO SIXBIT
	MOVE	S1,S2		;COPY TO APPROPRIATE AC
	PUSHJ	P,STRPFL	;SEE IF ALREADY EXISTS IN THE PROFIL
	MOVSI	S1,(T1)		;POINT TO BLOCK
	HRRI	S1,AUXBLK	;MAKE A BLT POINTER
	SKIPF			;REALLY HAVE AN AUXACC BLOCK?
	BLT	S1,AUXBLK+.AULEN-1 ;YES--COPY IT
	SKIPN	S1,AUXBLK+.AUBIT ;GET STATUS BITS
	MOVEI	S2,[ASCIZ \/CREATE /WRITE\]
	TXNE	S1,AU.NCR	;NO-CREATE?
	MOVEI	S2,[ASCIZ \/NOCREATE\]
	TXNE	S1,AU.RON	;NO-WRITE?
	MOVEI	S2,[ASCIZ \/NOWRITE\]
	TXNE	S1,AU.RON	;PERHAPS
	TXNN	S1,AU.NCR	; BOTH?
	SKIPA			;NO
	MOVEI	S2,[ASCIZ \/NOCREATE /NOWRITE\]
	$TEXT	(<-1,,DEFTX2>,<^T/(S2)/^0>)
	POP	P,U		;RESTORE U
	POP	P,T1		;RESTORE T1
	$RETT			;RETURN

; PREFIL ROUTINES
STRPFF:	SKIPA	S1,[.AULIN]	;FCFS OFFSET
STRPFO:	MOVEI	S1,.AUOUT	;LOGGED OUT OFFSET
	SKIPA
STRPFR:	MOVEI	S1,.AURES	;RESERVED OFFSET
	MOVE	S2,AUXBLK(S1)	;GET OLD QUOTA
	SKIPE	AUXBLK+.AUSTR	;NEW STRUCTURE?
	JRST	STRDF1		;NO
	CAIN	S1,.AURES	;RESERVED QUOTA?
	AOSA	S1		;YES--DEFAULT TO PREVIOUS (USUALLY ZERO) VALUE)
	CAIE	S1,.AULIN	;FIRST TIME HERE?
	SKIPA	S2,AUXBLK-1(S1)	;GET PREVIOUS VALUE TYPED
	MOVEI	S2,DEFQTA	;USE DEFAULT QUOTA
STRDF1:	CAMN	S2,[.INFIN]	;INFINITY?
	JRST	STRDF2		;YES
	$TEXT	(<-1,,DEFTX1>,<^D/S2/^0>)
	$RETT			;RETURN
STRDF2:	DMOVE	S1,[ASCIZ /INFINITE/]
	DMOVEM	S1,DEFTX1	;SAVE DEFAULT TEXT
	$RETT			;RETURN

; ACTION ROUTINES
STRACF:	SKIPA	S1,[.AULIN]	;FCFS QUOTA
STRACO:	MOVEI	S1,.AUOUT	;LOGGED OUT
	SKIPA
STRACR:	MOVEI	S1,.AURES	;RESERVED
	PUSH	P,S1		;SAVE OFFSET
	HRRZ	S1,CR.SIZ(S2)	;GET PARSED DATA STORAGE
	LOAD	S2,ARG.HD(S1),AR.TYP ;GET TYPE OF BLOCK
	CAIN	S2,.CMKEY	;KEYWORD ("INFINITE")?
	SKIPA	S2,[.INFIN]	;GET INFINITY
	MOVE	S2,ARG.DA(S1)	;ELSE PICK UP NUMBER
	POP	P,S1		;GET AUXACC BLOCK OFFSET BACK
	MOVEM	S2,AUXBLK(S1)	;SAVE NEW VALUE
	$RETT			;AND RETURN
; GET ROUTINE
STRGET:	PUSHJ	P,.SAVE1	;SAVE P1

STRGE1:	MOVEI	S1,STR000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ \STRUCTURE-QUOTAS>\]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

STRGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	STRGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAILE	S1,STRLEN	;A COMMON KEYWORD?
	HRRES	S1		;NO--MAKE A NEGATIVE INDEX
	PUSHJ	P,@STRTAB(S1)	;DISPATCH
	JUMPF	STRGE1		;TRY AGAIN ON FAILURES
	JRST	STRGE2		;TRY FOR MORE


; COMPARE ROUTINE
STRCMP:	MOVEI	S1,.AEAUX	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
STRCHG:	MOVEI	S1,.AEAUX	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
STRDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.AUX	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$AUX(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEAUX	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
STRRES:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,.AEAUX(X)	;-LENGTH
	HRRI	T2,.AEAUX	;OFFSET
	SKIPE	T3,.AEAUX(X)	;ORIGINAL OFFSET POINTER
	ADDI	T3,(X)		;INDEX INTO PROFILE
	MOVX	T4,DF.AUX	;STRUCTURE QUOTAS DEFAULT BIT
	TDNN	T4,DF$AUX(X)	;WAS IT PREVIOUSLY DEFAULTED?
	TDZA	T4,T4		;NO, RESTORE THE ZERO
	MOVEI	T4,1		;YES, RESTORE THE ONE
	PUSHJ	P,A$EBLK##	;RESTORE ORIGINAL AUXACC DATA
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEAUX	;IN BOTH PLACES
	$RETT			;RETURN


; PRINT ROUTINE
STRPRT:	SKIPN	T1,.AEAUX(U)	;AOBJN POINTER
	SKIPA	S1,[NONE7]	;THERE IS NONE
	MOVEI	S1,STRPR3	;POINT TO HEADER
	$TEXT	(,<^T/(S1)/>)
	JUMPE	T1,.RETT	;RETURN IF NO AUXACC DATA
	ADDI	T1,(U)		;INDEX INTO PROFILE
	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,T1		;COPY AUXACC POINTER
STRPR1:	SKIPN	.AUSTR(P1)	;IS THERE A STRUCTURE THERE?
	JRST	STRPR2		;NO
	MOVEI	T1,[ITEXT (<^D10R /.AULIN(P1)/>)] ;QUOTA IN
	MOVE	S1,.AULIN(P1)	;GET LOGGED IN QUOTA
	CAMN	S1,[.INFIN]	;IS IT INFINITY?
	MOVEI	T1,[ITEXT (<-infinite->)] ;YES
	MOVEI	T2,[ITEXT (<^D10R /.AUOUT(P1)/>)] ;QUOTA OUT
	MOVE	S1,.AUOUT(P1)	;GET LOGGED OUT QUOTA
	CAMN	S1,[.INFIN]	;IS IT INFINITY?
	MOVEI	T2,[ITEXT (<-infinite->)] ;YES
	MOVEI	T3,[ITEXT (<^D10R /.AURES(P1)/>)] ;QUOTA OUT
	MOVE	S1,.AURES(P1)	;GET RESERVED QUOTA
	CAMN	S1,[.INFIN]	;IS IT INFINITY?
	MOVEI	T3,[ITEXT (<-infinite->)] ;YES
	MOVEI	T4,[ASCIZ //]	;ASSUME NO SPECIAL STATUS
	MOVE	S1,.AUBIT(P1)	;GET STATUS BITS
	TXNE	S1,AU.NCR	;NO-CREATE?
	MOVEI	T4,[ASCIZ \/NOCREATE\]
	TXNE	S1,AU.RON	;NO-WRITE?
	MOVEI	T4,[ASCIZ \/NOWRITE\]
	TXNE	S1,AU.RON	;PERHAPS
	TXNN	S1,AU.NCR	; BOTH?
	SKIPA			;NO
	MOVEI	T4,[ASCIZ \/NOCREATE /NOWRITE\]
	$TEXT	(,<	  ^W6L/.AUSTR(P1)/    ^I/(T1)/  ^I/(T2)/  ^I/(T3)/  ^T/(T4)/>)
STRPR2:	ADD	P1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,STRPR1	;AND LOOP
	$RETT			;RETURN

STRPR3:	ASCIZ	\
	Structure    Quota in   Quota  out   Reserved     Status
	---------  -----------  ----------  ----------  ----------\


; HELP TEXT
STRHLP:	ASCIZ	\
STRUCTURE-QUOTAS   specifies  the  structures  which  are  automatically
mounted when a user logs in.  This list of  structures  constitutes  the
job's search list (JSL).
\
; KEYWORD DISPATCH TABLE
	IFIW	STRADD		;"ADD"
	IFIW	STRREM		;"REMOVE"
STRTAB:	IFIW	STRALL		;"ALL"
	IFIW	STRDEF		;"DEFAULT"
	IFIW	STRDON		;"DONE"
	IFIW	STRHLX		;"HELP"
	IFIW	STRNO		;"NO"
	IFIW	STRNON		;"NONE"
	IFIW	STRRES		;"RESTORE"
	IFIW	STRPRT		;"SHOW"
STRLEN==.-STRTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
STRALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	$RETT			;RETURN


; "DEFAULT" KEYWORD PROCESSOR
STRDEF:	PUSHJ	P,STRDFL	;DO DEFAULTING
	PJRST	STRGO		;FINISH UP


; "DONE" KEYWORD PROCESSOR
STRDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	ADJSP	P,-1		;WE CO-RETURN
	MOVEI	S1,.AEAUX	;OFFSET TO CHECK
	PJRST	CMPVAL		;SET CHANGE FLAGS & RETURN


; "HELP" KEYWORD PROCESSOR
STRHLX:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@STR+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;AND RETURN


; "NO" KEYWORD PROCESSOR
STRNO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;RETURN


; "NONE" KEYWORD PROCESSOR
STRNON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	SETZM	AUXPTR		;NO AUXACC DATA TO RESTORE
	PJRST	STRUPD		;UPDATE THE BLOCK IN THE PROFILE
; "ADD" KEYWORD PROCESSOR
STRADD:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	PUSHJ	P,STRCPY	;COPY AUXACC DATA TO STATIC STORAGE
	PUSHJ	P,STRFND	;GET THE STRUCTURE AND POINTER TO BLOCK
	SKIPF			;MAKE SURE IT DIDN'T ALREADY EXIST
	WARN	(SPE,<Superseding previous entry for ^W/S1/>)
	MOVE	P1,T1		;SAVE POINTER
	MOVE	P2,S1		;COPY STR NAME
	PUSHJ	P,STRCAT	;CHECK THE CATALOG
	SKIPT			;CHECK FOR ERRORS
	WARN	(SNC,<Structure ^T/STRNAM/ is not cataloged>,,.RETF)
	PUSHJ	P,STRQTA	;GET A QUOTA
	MOVE	T1,S1		;COPY FCFS
	PUSHJ	P,STRQTA	;GET A QUOTA
	MOVE	T2,S1		;COPY LOGGED OUT
	SETZ	T3,		;ZERO RESERVED QUOTA
	PUSHJ	P,STRQTA	;GET A QUOTA
	MOVE	T3,S1		;COPY RESERVED
	PUSHJ	P,STRSWT	;PARSE SWITCHES
	MOVE	T4,S1		;GET AUXACC BITS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	EXCH	P2,.AUSTR(P1)	;SAVE STRUCTURE NAME IN BLOCK
	MOVEM	T1,.AULIN(P1)	;SAVE FCFS
	MOVEM	T2,.AUOUT(P1)	;SAVE LOGGED OUT
	MOVEM	T3,.AURES(P1)	;SAVE RESERVED
	MOVEM	T4,.AUBIT(P1)	;SAVE STATUS
	MOVSI	T1,-.AULEN	;LENGTH OF AN AUXACC BLOCK
	SKIPN	P2		;IF A NEW ENTRY,
	ADDM	T1,AUXPTR	;ACCOUNT FOR NEW ENTRY
STRUPD:	MOVEI	T1,(U)		;POINT TO PROFILE
	HLLZ	T2,AUXPTR	;GET -LENGTH
	HRRI	T2,.AEAUX	;PROFILE OFFSET
	TLNN	T2,-1		;ANY DATA?
	TDZA	T3,T3		;NO--DELETE AUXACC FROM PROFILE
	MOVEI	T3,AUXTMP	;POINT TO DATA
	MOVEI	T4,0		;CLEAR .AEMAP BIT
	PUSHJ	P,A$EBLK##	;ALLOCATE AND STORE EXTENSIBLE BLOCK
STRGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN
; "REMOVE" KEYWORD PROCESSOR
STRREM:	PUSHJ	P,STRCPY	;COPY AUXACC DATA TO STATIC STORAGE
	PUSHJ	P,STRFND	;GET STRUCTURE NAME AND POINTER TO BLOCK
	JUMPF	.RETT		;IGNORE ERRORS
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
STRRE1:	MOVSI	S1,.AULEN(T1)	;POINT TO NEXT AUXACC BLOCK
	HRRI	S1,(T1)		;MAKE A BLT POINTER
	BLT	S1,.AULEN-1(T1)	;OVERWRITE THE ONE WE'RE DELETING
	ADD	T1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
STRRE2:	AOBJN	T1,STRRE1	;LOOP
	MOVSI	T1,.AULEN	;LENGTH OF AN AUXACC BLOCK
	ADDM	T1,AUXPTR	;ACCOUNT FOR ENTRY DELETED
	PJRST	STRUPD		;GO UPDATE THE PROFILE AND RETURN


; CHECK THE CATALOG FOR A KNOWN STRUCTURE NAME
STRCAT:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,[.QUARG,,QUEBLK] ;POINT TO UUO ARGUMENT BLOCK
	MOVE	S1,[QF.RSP+.QUCAT] ;FLAGS AND FUNCTION CODE
	MOVEM	S1,.QUFNC(P1)
	SETZM	.QUNOD(P1)	;CENTRAL STATION
	MOVE	S1,[CATMAX,,CATACK] ;LENGTH,,RESPONSE BLOCK ADDRESS
	MOVEM	S1,.QURSP(P1)	;SAVE
	SKIPN	DEBUGQ		;DEBUGGING?
	SKIPE	OLDMON		;[241] CAN WE TIMOUT THE UUO?
	JRST	STRCA1		;NO
	MOVEI	S1,ZZTIME	;NUMBER OF SECONDS
	MOVEM	S1,.QUTIM(P1)	;SAVE
	MOVSI	S1,1		;PLUS A
	ADDB	P1,S1		; WORD
	MOVSS	S1		;GET TOTAL LENGTH SO FAR IN RH
	DPB	S1,[POINTR .QUFNC(P1),QF.HLN] ;STORE HEADER LENGTH
STRCA1:	HLRZ	S1,P1		;GET WORD COUNT SO FAR
	ADD	P1,S1		;POINT AT FIRST FREE WORD
	DMOVE	S1,[EXP <1,,.QBVSN>,STRNAM]
	DMOVEM	S1,(P1)
	ADD	P1,[2,,2]	;ADVANCE POINTER
	DMOVE	S1,[EXP <QA.IMM!.QBMFG>,<QB.DSK>]
	DMOVEM	S1,(P1)
	ADD	P1,[2,,2]	;ADVANCE POINTER
	HLRZ	S1,P1		;GET LENGTH OF BLOCK
	SUBB	P1,S1		;SET UP UUO AC
	QUEUE.	S1,		;SEE IF STRUCTURE IS CATALOGED
	  CAIN	S1,QUILF%	;OK IF NO CATALOG KNOWN TO THIS MONITOR
	$RETT			;RETURN
	$RETF			;FAILED


; COPY AUXACC BLOCK TO STATIC STORAGE
STRCPY:	MOVEI	T1,AUXTMP	;POINT TO STATIC BLOCK
	MOVEM	T1,AUXPTR	;SAVE FOR ADD/REMOVE
	MOVE	T1,[AUXTMP,,AUXTMP+1] ;SET UP BLT
	SETZM	AUXTMP		;CLEAR FIRST WORD
	BLT	T1,AUXTMP+.AULEN+.AUMAX-1 ;[241] COPY
	SKIPN	T1,.AEAUX(U)	;GET AOBJN POINTER
	POPJ	P,		;NO DATA
;[241]	HLLM	T1,AUXPTR	;SAVE -LENGTH
	ADDI	T1,(U)		;INDEX INTO PROFILE
	HRLZS	T1		;PUT IN LH
	HRRI	T1,AUXTMP	;MAKE A BLT POINTER
	HLRE	T2,.AEAUX(U)	;GET -LENGTH
	MOVMS	T2		;MAKE POSITIVE
	BLT	T1,AUXTMP-1(T2)	;COPY
	MOVEI	T1,.AULEN-1(T2)	;[241] FOR ROUNDING UP
	IDIVI	T1,.AULEN	;[241] GET NUMBER OF STRS
	IMULI	T1,.AULEN	;[241] MAKE PROPER LENGTH
	MOVNS	T1		;[241] NEGATE FOR AOBJN'ERS
	HRLM	T1,AUXPTR	;[241] UPDATE FOR STRFND AND FRIENDS
	POPJ	P,		;RETURN


; FIND A STRUCTURE IN AUXTMP OR A FREE SLOT
STRFND:	PUSHJ	P,P$FLD##	;GET THE DEVICE NAME
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVE	S2,ARG.DA(S1)	;COPY ASCII NONSENSE
	MOVEM	S2,STRNAM	;SAVE FOR POSTERITY
	HRROI	S1,ARG.DA(S1)	;POINT TO STRING
	PUSHJ	P,S%SIXB	;CONVERT TO SIXBIT
	TRNN	S2,7777		;CHECK FOR A LONG NAME
	SKIPN	S1,S2		;NEED STR NAME IN S1
	PJRST	PRSERR		;WEED OUT NOTHING
	SKIPL	T1,AUXPTR	;GET AOBJN POINTER
	$RETF			;NO AUXACC DATA
STRFN1:	SKIPN	.AUSTR(T1)	;DO WE GO THIS FAR?
	JRST	STRFN2		;HOLE IN BLOCK?
	CAMN	S1,.AUSTR(T1)	;IS THIS THE STRUCTURE WE WANT?
	$RETT			;YES, RETURN
STRFN2:	ADD	T1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	T1,STRFN1	;LOOP
	$RETF			;STRUCTURE NOT FOUND


; FIND A STRUCTURE IN THE PROFILE
STRPFL:	SKIPN	T1,.AEAUX(U)	;GET AOBJN POINTER
	$RETF			;NO DATA
	ADDI	T1,(U)		;INDEX INTO PROFILE
	PJRST	STRFN1		;ENTER COMMON CODE

; GET A QUOTA OR "INFINITE"
STRQTA:	PUSHJ	P,P$NUM##	;GET A QUOTA
	$RETIT			;RETURN IF A NUMBER WAS SPECIFIED
	PUSHJ	P,P$KEYW##	;GET KEYWORD OF INFINITE
	JUMPF	PRSERR		;CHECK FOR ERRORS
	MOVX	S1,.INFIN	;GET QUANTITY OF INFINITY
	$RETT			;RETURN


; PROCESS SWITCHES
STRSWT:	PUSH	P,[EXP 0]	;INIT SWITCH STORAGE FLAGS
STRSW1:	PUSHJ	P,P$SWIT	;GET A SWITCH
	JUMPF	STRSW2		;JUMP IF NONE
	MOVE	S2,(P)		;GET FLAGS SO FAR
	SKIPE	0(S1)		;SKIP IF CLEARING
	IOR	S2,1(S1)	;COPY THE BIT
	SKIPN	0(S1)		;SKIP IF SETTING
	TDZ	S2,1(S1)	;CLEAR
	MOVEM	S2,(P)		;UPDATE
	JRST	STRSW1		;AND LOOP
STRSW2:	POP	P,S1		;GET FLAGS
	POPJ	P,		;AND RETURN
SUBTTL	ENTRIES -- WAT - WATCH-BITS


	.ENTRY	(WAT,.AEWCH,<Watch bits>)

WATPRS:	$NOISE	(CONFRM,<set by LOGIN>)
WAT000:	$INIT	(WAT010)
WAT010:	$KEYDSP	(WAT020,<$ALTER(WAT030)>)
WAT020:	$STAB
	DSPTAB	(WAT010,[JW.WCX],<CONTEXTS>)
	DSPTAB	(WAT010,[JW.WDY],<DAY>)
	DSPTAB	(WAT010,[JW.WFI],<FILES>)
	DSPTAB	(WAT010,[JW.WMT],<MTA>)
	DSPTAB	(WAT010,[JW.WDR],<READ>)
	DSPTAB	(WAT010,[JW.WRN],<RUN>)
	DSPTAB	(WAT010,[JW.WVR],<VERSION>)
	DSPTAB	(WAT010,[JW.WWT],<WAIT>)
	DSPTAB	(WAT010,[JW.WDW],<WRITE>)
	$ETAB
WAT030:	$KEYDSP	(WAT040,<$ALTER(CONFRM)>)
WAT040:	$STAB
	DSPTAB	(      ,2,\"32,CM%INV)
	DSPTAB	(CONFRM,0,<ALL>)
	DSPTAB	(CONFRM,1,<DEFAULT>)
	DSPTAB	(CONFRM,2,<DON>,CM%NOR)
	DSPTAB	(CONFRM,2,<DONE>)
	DSPTAB	(CONFRM,3,<HELP>)
	DSPTAB	(WAT050,4,<NO>)
	DSPTAB	(CONFRM,5,<NONE>)
	DSPTAB	(CONFRM,6,<RESTORE>)
	DSPTAB	(CONFRM,7,<SHOW>)
	$ETAB
WAT050:	$KEYDSP	(WAT020)
; GET ROUTINE
WATGET:	PUSHJ	P,.SAVE1	;SAVE P1

WATGE1:	MOVEI	S1,WAT000	;POINT TO SUB-COMMAND TABLES
	MOVEI	S2,[ASCIZ /WATCH-BITS>/]
	PUSHJ	P,PRSCMD	;PARSE THE COMMAND
	JUMPF	PRSERR		;CHECK FOR ERRORS
	SETZ	P1,		;CLEAR "NO" FLAG

WATGE2:	PUSHJ	P,P$CFM##	;CRLF?
	JUMPT	WATGE1		;YES
	PUSHJ	P,P$KEYW##	;GET KEYWORD
	JUMPF	PRSERR		;CHECK FOR ERRORS
	CAIG	S1,WATLEN	;ADDRESS OF BIT?
	JRST	WATGE3		;NO--KEYWORD
	MOVE	S2,(S1)		;GET THE BIT
	IORM	S2,.AEWCH(U)	;SET IT ALWAYS
	IORM	S2,CHGMSK+.AEWCH ;AT LEAST IN CHANGE BLOCK
	SKIPE	P1		;SKIP IF SETTING
	ANDCAM	S2,.AEWCH(U)	;ZERO THE BIT
	SETZ	P1,		;CLEAR "NO" FLAG
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	JRST	WATGE2		;AND LOOP

WATGE3:	PUSHJ	P,@WATTAB(S1)	;DISPATCH
	JRST	WATGE2		;AND LOOP BACK


; COMPARE ROUTINE
WATCMP:	MOVEI	S1,.AEWCH	;PROFILE OFFSET
	PJRST	COMPAR		;GO COMPARE


; CHANGE ROUTINE
WATCHG:	MOVEI	S1,.AEWCH	;PROFILE OFFSET
	PJRST	QUECHG		;QUEUE UP THE CHANGE


; DEFAULT ROUTINE
WATDFL:	SETOM	PRSDFV		;REMEMBER WE CARE
	MOVX	S1,DF.WCH	;DEFAULT BIT FOR FIELD
	IORM	S1,DF$WCH(U)	;LIGHT IN PROFILE
	SETOM	@CHGADR		;WE CHANGED IT
	SETOM	CHGMSK+.AEWCH	;WHOLE THING
	$RETT			;WIN


; RESTORE ROUTINE
WATRES:	MOVE	S1,.AEWCH(X)	;GET ORIGINAL WATCH BITS
	MOVEM	S1,.AEWCH(U)	;RESTORE
	MOVX	S1,DF.WCH	;WATCH WORD DEFAULT BIT
	ANDCAM	S1,DF$WCH(U)	;ASSUME SHOULD BE OFF
	TDNE	S1,DF$WCH(X)	;RIGHT?
	IORM	S1,DF$WCH(U)	;NO, LIGHT IT AGAIN
	SETZM	@CHGADR		;INDICATE NOT CHANGING PROFILE ENTRY
	SETZM	CHGMSK+.AEWCH	;IN BOTH PLACES
	$RETT			;AND RETURN


; PRINT ROUTINE
WATPRT:	MOVE	S1,[IOWD WATBPE-WATBPT,WATBPT] ;POINTER TO TABLE OF BITS
	PUSHJ	P,PRTBTS	;PRINT THE BITS OUT
	$RETT			;AND RETURN


; HELP TEXT
WATHLP:	ASCIZ	\
WATCH-BITS  specifies  any  of  the  following  watch  bits  that  LOGIN
automatically sets when the user logs in:

	CONTEXTS
	DAY
	FILES 
	MTA
	READ 
	RUN
	VERSION
	WAIT
	WRITE

For more information, see the SET WATCH command in the TOPS-10 Operating
System Commands Manual.
\
; KEYWORD DISPATCH TABLE
WATTAB:	IFIW	WATALL		;"ALL"
	IFIW	WATDEF		;"DEFAULT"
	IFIW	WATDON		;"DONE"
	IFIW	WATHLX		;"HELP"
	IFIW	WATNO		;"NO"
	IFIW	WATNON		;"NONE"
	IFIW	WATRES		;"RESTORE"
	IFIW	WATPRT		;"SHOW"
WATLEN==.-WATTAB		;LENGTH OF TABLE


; "ALL" KEYWORD PROCESSOR
WATALL:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,JW.WAL	;WATCH:ALL BITS
	IORM	S1,.AEWCH(U)	;LIGHT IN PROFILE
	IORM	S1,CHGMSK+.AEWCH ;AND IN CHANGE MASK
WATGO:	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "DEFAULT" KEYWORD PROCESSOR
WATDEF:	PUSHJ	P,WATDFL	;DO DEFAULTING
	PJRST	WATGO		;FINISH UP


; "DONE" KEYWORD PROCESSOR
WATDON:	PUSHJ	P,P$KEYW##	;SEE IF CONTROL-Z
	SKIPT			;IT'S NOT TERMINATED
	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	ADJSP	P,-1		;WE CO-RETURN
	MOVEI	S1,.AEWCH	;OFFSET TO CHECK
	PJRST	CMPVAL		;SET CHANGE FLAGS & RETURN


; "HELP" KEYWORD PROCESSOR
WATHLX:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVEI	S1,@WAT+CG.HLP	;POINT TO HELP TEXT
	$TEXT	(,<^T/(S1)/>)	;GIVE HELP
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN


; "NO" KEYWORD PROCESSOR
WATNO:	MOVNI	P1,1		;SET "NO" FLAG
	$RETT			;$RETT


; "NONE" KEYWORD PROCESSOR
WATNON:	PUSHJ	P,P$CFM##	;GET EOL
	JUMPF	PRSERR		;CHECK FOR ERRORS
	PUSHJ	P,P$PREV##	;BACKUP OVER THE CRLF
	MOVX	S1,JW.WAL	;WATCH:ALL BITS
	ANDCAM	S1,.AEWCH(U)	;CLEAR IN PROFILE
	IORM	S1,CHGMSK+.AEWCH ;NOTE AS CHANGED IN MASK
	SETOM	@CHGADR		;INDICATE CHANGING PROFILE ENTRY
	SETZ	P1,		;CLEAR "NO" FLAG
	$RETT			;RETURN
; BIT STORAGE/DISPLAY TABLE
WATBPT:	XWD	[POINTR .AEWCH(U),JW.WCX],[ASCIZ\Contexts\]
	XWD	[POINTR .AEWCH(U),JW.WDY],[ASCIZ\Day\]
	XWD	[POINTR .AEWCH(U),JW.WFI],[ASCIZ\Files\]
	XWD	[POINTR .AEWCH(U),JW.WMT],[ASCIZ\MTA\]
	XWD	[POINTR .AEWCH(U),JW.WDR],[ASCIZ\Read\]
	XWD	[POINTR .AEWCH(U),JW.WRN],[ASCIZ\Run\]
	XWD	[POINTR .AEWCH(U),JW.WVR],[ASCIZ\Version\]
	XWD	[POINTR .AEWCH(U),JW.WWT],[ASCIZ\Wait\]
	XWD	[POINTR .AEWCH(U),JW.WDW],[ASCIZ\Write\]
WATBPE:!
SUBTTL	Utility routines -- QINIT, setup the QUEUE. block

;QINIT - Setup a modify or delete block
;QINITA - Setup an add block

QINITA:	TDZA	S1,S1		;ADD FUNCTION
QINIT:	MOVEI	S1,AF.AND	;MODIFY OR DELETE
	PUSHJ	P,.SAVE2	;PRESERVE SOME ACS
	MOVE	P2,S1		;SAVE CALL TYPE
	MOVE	P1,[-QUEBLN,,QUEBLK]	;SETUP STORAGE POINTER
	MOVE	S1,[QF.RSP+.QUMAE]	;WANT RESPONSE, TALK TO ACTDAE
	MOVEM	S1,(P1)		;SET IN BLOCK
	AOBJP	P1,.+1		;ADVANCE POINTER
	SETZM	(P1)		;CENTRAL SITE (IGNORED ANYWAY)
	AOBJP	P1,.+1		;ADVANCE POINTER
	MOVE	S1,[.AEMAX,,RSPBLK] ;RESPONSE BLOCK POINTER
	MOVEM	S1,(P1)		;STORE IN BLOCK
	AOBJP	P1,.+1		;ADVANCE POINTER
	SKIPE	OLDMON		;CAN THIS MONITOR DO ANYTHING FANCY?
	JRST	QINIT2		;NO, SKIP THIS NONSENSE
	SKIPE	S1,DEBUGW	;ARE WE RUNNING IT PRIVATE?
	MOVSI	S1,ACTPID	;YES, TALK TO PRIVATE ACTDAE
	SKIPN	DEBUGQ		;DO WE WANT TO TIME THE CONVERSATION?
	HRRI	S1,ZZTIME	;YES, GET LIMIT
	JUMPE	S1,QINIT2	;SKIP NONSENSE IF NEED NO EXTRA HEADER WORDS
	HRRZM	S1,(P1)		;STORE TIME LIMIT
	AOBJP	P1,.+1		;ADVANCE POINTER
	HLRZS	S1		;ISOLATE PID ADDRESS
	SKIPE	S1		;IF WANT A PID,
	SKIPN	S1,(S1)		;AND HAVE ONE,
	JRST	QINIT1		;NO, GO WITH WHAT WE HAVE
	MOVEM	S1,(P1)		;YES, SET FOR UUO
	AOBJP	P1,.+1		;ADVANCE THE COUNTER

QINIT1:	MOVEI	S1,-QUEBLK(P1)	;GET LENGTH OF HEADER IN USE
	STORE	S1,QUEBLK,QF.HLN ;TELL UUO ABOUT EXTRA WORDS

QINIT2:	DMOVE	S1,[EXP QA.IMM!.QBAFN,UGCUP$]	;TELL ACTDAE OF FUNCTION TYPE
	SKIPN	UNPRIV		;HAVE PRIVS?
	TXO	S2,AF.PRV	;YES, INVOKE THEM
	DMOVEM	S1,(P1)		;STUFF INTO BLOCK
	ADD	P1,[2,,2]	;UPDATE POINTER
	MOVE	S1,[QA.IMM+.AEVRS(2)] ;MASKED VALUE COMING
	MOVEM	S1,(P1)		;SET SUB-BLOCK TYPE
	DMOVE	S1,[EXP <FLD(ACTFMT,AE.VRS)>,AE.VRS]
	DMOVEM	S1,1(P1)	;GIVE DATA TO THE BLOCK
	ADD	P1,[3,,3]	;UPDATE POINTER
	MOVEM	P1,QUEPTR	;SAVE FOR QUEINS
	MOVEI	P1,.AEPPN(P2)	;GET DESIRED FUNCTION
	HRROI	P2,.AEPPN(U)	;AND POINT TO PPN
	PJRST	QUEINS		;STORE IN BLOCK AND RETURN
SUBTTL	Utility routines -- DELUSR, delete current profile

;DELUSR - Delete the current profile
;Call:
;	U/ Address of profile to delete

DELUSR:	PUSHJ	P,.SAVE2	;PRESERVE ACS USED BY QUEINS
	PUSHJ	P,QINIT		;SETUP MINIMAL QUEUE. BLOCK
	MOVEI	P1,.AEPPN	;PROFILE OFFSET TO CHANGE
	SETZ	P2,		;CLEARING IT
	PUSHJ	P,QUEINS	;STUFF INTO THE UUO LIST
	$RETIF			;SHOULD NEVER FAIL
	$FALL	QUEUUO		;RETURN AFTER DOING THE UUO
SUBTTL	Utility routines -- QUEUUO, ask ACTDAE to do its thing

;QUEUUO -- Queue up the current request to ACTDAE.
;Expects QINIT(A) to have been called, and QUEPTR to be up to date

QUEUUO:	HRLZ	S1,QUEPTR	;GET FIRST FREE WORD IN LH
	ADD	S1,[-QUEBLK,,QUEBLK] ;MAKE UUO ARG POINTER
	QUEUE.	S1,		;ASK ACTDAE TO DO IT FOR US
	  $RETF			;FAILED
	$RETT			;RETURN HAPPY
SUBTTL	Utility routines -- QUECHG, load up QUEUE. block

;QUECHG - Add a change request to the QUEUE. block
;Call
;	S1/ Profile offset under consideration
;	U/  Address of profile being modified
;Return
;	$RETF	No more room (should never happen) or invalid request
;	$RETT	Change request inserted

QUECHG::PUSHJ	P,.SAVE2	;PRESERVE SOME WORKING ACS
	CAIL	S1,.AEMIN	;VALID OFFSET?
	$RETF			;NO
	MOVE	S2,CHGTAB##(S1)	;YES, GET ITS CONTROL BITS
	DMOVE	P1,S1		;PRESERVE THINGS
	PUSHJ	P,COMPAR	;IS THERE REALLY A CHANGE?
	$RETIT			;DON'T BOTHER ME IF NONE
	TXNE	P2,PD.NMD	;CAN IT BE MODIFIED?
	$RETIF			;NO, GIVE UP
	ADJBP	S1,[POINT 1,.AEMAP(U),0] ;GET B.P. TO DEFAULT BIT
	LDB	S1,S1		;FETCH THE BIT
	JUMPE	S1,QUECH1	;GO ON IF NOT DEFAULTED
	TXNE	P2,PD.CND	;CAN IT BE DEFAULTED?
	$RETF			;NO, GIVE UP
	TRO	P1,AF.DEF	;YES, LIGHT BIT TO REQUEST THAT
	SETZ	P2,		;DATA IS JUNK
	PJRST	QUEINS		;GO INSERT INTO THE QUEUE. BLOCK

QUECH1:	SKIPN	INSFLG		;ALWAYS FULL WORD MASK IN INSERT MODE
	TXNN	P2,PD.MSK	;IS THIS MASKABLE?
	JRST	QUECH2		;NO, GO ON
	MOVEI	S1,(P1)		;YES, COPY OFFSET
	ADDI	S1,(U)		;POINT TO WORD IN PROFILE
	MOVE	S1,(S1)		;FETCH IT
	MOVE	S2,CHGMSK(P1)	;AND ITS CHANGE MASK
	JUMPE	S2,.RETT	;DON'T QUEUE IT IF NOTHING WAS CHANGED
	DMOVEM	S1,QUETMP	;SAVE FOR A BIT
	MOVE	P2,[-2,,QUETMP]	;DO AS LONG IMMEDIATE ARGUMENT
	PJRST	QUEINS		;GO STUFF INTO THE BLOCK

QUECH2:	TXNN	P2,PD.EXT	;IS IT EXTENSIBLE?
	JRST	QUECH3		;NO, JUST A SIMPLE BLOCK
	MOVE	S1,P1		;COPY PROFILE OFFSET
	ADDI	S1,(U)		;ADDRESS OF POINTER WORD
	SKIPE	S1,(S1)		;GET RELATIVE POINTER
	ADDI	S1,(U)		;DE-RELATIVIZE IT
	LOAD	S2,P2,PD.WRD	;GET MAX. LENGTH
	MOVE	P2,S1		;COPY POINTER (FOR ADDRESS)
	HLRES	S1		;ISOLATE -VE LENGTH
	MOVNS	S1		;MAKE POSITIVE
	CAILE	S1,(S2)		;DOES IT FIT?
	MOVE	S1,S2		;NO, RESTRICT IT
	CAIN	S1,1		;IF SMALL,
	MOVNS	S1		;MAKE IT IMMEDIATE
	HRL	P2,S1		;MAKE BLOCK POINTER
	PJRST	QUEINS		;GO STUFF INTO THE UUO LIST

QUECH3:	LOAD	S2,P2,PD.WRD	;GET BLOCK LENGTH
	CAIN	S2,1		;IS IT SHORT?
	MOVNS	S2		;YES, DO IT IN IMMEDIATE MODE
	MOVEI	P2,(P1)		;COPY PROFILE OFFSET
	ADDI	P2,(U)		;MAKE ADDRESS OF FIELD
	HRL	P2,S2		;GET THE LENGTH
	$FALL	QUEINS		;STUFF INTO THE UUO LIST
SUBTTL	Utility routines -- QUEINS to insert info into a QUEUE. block

;QUEINS - Stuff information into a QUEUE. UUO arg block
;Call:
;	P1/ Block type code
;	P2/ length,,addr of indirect data or -length,,addr for immediate data
;Return:
;	$RETF	no more room
;	$RETT	sub-block inserted
;Implicit inputs:
;	QUEPTR is AOBJN storage pointer for the sub-blocks
;	SELFLG to indicate to use QUESEL/SELPTR mechanism instead
;Side effects:
;	QUEPTR is updated to reflect the insertion

QUEINS:	SKIPE	SELFLG		;DOING THIS FOR SELECT?
	JRST	QUESEL		;YES, INSERT INTO A DIFFERENT BLOCK
	MOVE	T4,QUEPTR	;GET AOBJN STORAGE POINTER
	JUMPLE	P2,QUEIN1	;ELSEWHERE FOR IMMEDIATE ARGS
	HLL	P1,P2		;GET LENGTH IN RIGHT AC
	MOVEM	P1,(T4)		;STUFF INTO LIST
	AOBJP	T4,.RETF	;OUT OF ROOM
	HRRZM	P2,(T4)		;STUFF AWAY THE ADDRESS
	AOBJP	T4,.RETF	;EXHAUSTED THE BLOCK
	MOVEM	T4,QUEPTR	;STORE UPDATED POINTER
	$RETT			;DONE

QUEIN1:	HLRE	S1,P2		;COPY -VE LENGTH
	MOVNS	S1		;MAKE POSITIVE
	HRL	P1,S1		;PUT INTO FUNCTION WORD
	TXO	P1,QA.IMM	;TURN ON IMMEDIATE MODE
	MOVEM	P1,(T4)		;STUFF FUNCTION INTO UUO LIST
	AOBJP	T4,.RETF	;GIVE UP IF OUT OF ROOM
QUEIN2:	SKIPE	S2,P2		;ZERO IS ZERO
	MOVE	S2,(P2)		;ELSE FETCH VALUE
	MOVEM	S2,(T4)		;PLUG INTO BLOCK
	AOBJP	T4,.RETF	;GIVE UP IF NO MORE ROOM
	AOBJN	P2,QUEIN2	;LOOP OVER THE ARGS TO INSERT
	MOVEM	T4,QUEPTR	;UPDATE POINTER
	$RETT			;WE WIN
SUBTTL	Utility routines -- QUESEL, insert into select block

;QUESEL - Append to selection criteria
;Call:
;	P1/ Profile offset
;	P2/ (+/-)length,,address
;Return:
;	$RETT	always
;Implicit inputs:
;	SELPTR is AOBJN storage pointer
;	WILDBK is setup to allow selecting
;Side effects:
;	SELPTR & WILDBK are updated to reflect the addition of the select block

QUESEL:	HLRE	TF,P2		;GET LENGTH
	MOVMS	TF		;MAKE POSITIVE
	SKIPN	TF		;DEFAULTING THE LENGTH,
	AOS	TF		;DO SO
	TRNE	P1,AF.DEF	;BUT IF DEFAULTING,
	SETZ	TF,		;THEN WE DON'T NEED THE DATA
	MOVS	T3,TF		;COPY LENGTH TO BETTER PLACE FOR LATER
	AOS	TF		;ACCOUNT FOR THE OVERHEAD WORD
	HRLS	TF		;PUT IN LH TOO
	ADD	TF,SELPTR	;ADD TO EXISTING POINTER
	SKIPL	TF		;SKIP IF ROOM IN BLOCK
	WARN	(NMS,<No more storage available for selection criteria>,,.RETT)

QUESE1:	MOVE	T4,SELPTR	;GET POINTER TO FIRST FREE
	HRLI	P1,1		;GET LENGTH OF OVERHEAD
	ADD	P1,T3		;MAKE BLOCK DESCRIPTOR
	IOR	P1,SELFNC	;INCLUDE THE SELECT FUNCTION
	MOVNS	T3		;GET -LEN,,0
	HLL	P2,T3		;UPDATE LENGTH FOR STUFFING DATA
	MOVEM	P1,(T4)		;STORE FUNCTION TYPE
	AOBJP	T4,.+1		;UPDATE POINTER
	JUMPGE	T3,QUESE3	;DON'T STUFF MORE IF NO DATA

QUESE2:	MOVE	T1,(P2)		;GET A DATA WORD
	MOVEM	T1,(T4)		;INSERT IT
	AOBJP	T4,.+1		;ADVANCE POINTER
	AOBJN	P2,QUESE2	;LOOP OVER DATA

QUESE3:	MOVEM	T4,SELPTR	;UPDATE
	AOS	WILDBK+UW$SEL	;COUNT THE SECTION SUB-BLOCK
	$RETT			;RETURN
SUBTTL	Utility routines -- Compare and Change

;ROUTINE TO COMPARE BASED SOLELY ON PROFILE OFFSET
;CALL:	MOVEI	S1, PROFILE OFFSET
;	MOVEI	U, WORKING PROFILE
;	MOVEI	X, ORIGINAL PROFILE
;RETURN:
;	$RETT		THE SAME
;	$RETF		CHANGED
;IMPLICIT INPUTS:
;	CHGMSK SETUP BY PRS/GET ROUTINES
;SIDE-EFFECTS:
;	CLOBBERS S2

COMPAR::CAIL	S1,.AEMIN	;IS IT VALID?
	$RETT			;NO, THEN WE DIDN'T CHANGE IT
	SKIPN	SELFLG		;DO WE CONSIDER ALL CHANGES SIGNIFICANT?
	SKIPE	INSFLG		;WELL, DO WE?
	$RETF			;YES, IT'S NOT THE SAME
	MOVE	S2,CHGTAB##(S1)	;NO, GET THE BITS
	TXNE	S2,PD.WRD	;IS IT IN THE MIDDLE OF A BLOCK?
	TXNE	S2,PD.NMD	;COULD WE HAVE CHANGED IT?
	$RETT			;YES OR NO, WE DIDN'T TOUCH IT
	PUSHJ	P,.SAVET	;WE NEED MORE ACS TO LOOK HARDER
	TXNE	S2,PD.CND	;IS IT DEFAULTABLE?
	JRST	COMPA1		;NO
	MOVEI	T3,(S1)		;YES, COPY THE OFFSET
	ADJBP	T3,[POINT 1,.AEMAP(U),0] ;POINT TO THE APPROPRIATE BIT
	LDB	T4,T3		;GET CURRENT STATE OF DEFAULT BIT
	TLC	T3,U^!X		;POINT TO ORIGINAL PROFILE
	LDB	T3,T3		;AND GET ORIGINAL DEFAULT BIT
	CAIE	T3,(T4)		;ARE THEY DIFFERENT?
	$RETF			;YES, WE CHANGED SOMETHING
	JUMPN	T3,.RETT	;'DEFAULTED' MEANS IT'S THE SAME (DESPITE VALUE)
COMPA1:	MOVEI	T1,(U)		;COPY WORKING PROFILE ADDRESS
	MOVEI	T2,(X)		;AND ORIGINAL'S ADDRESS
	ADDI	T1,(S1)		;OFFSET TO ENTRY
	ADDI	T2,(S1)		;BOTH CASES
	TXNN	S2,PD.MSK	;IS IT A BIT-MASK?
	JRST	COMPA2		;NO, DON'T TREAT IT AS ONE
	MOVE	T3,(T1)		;YES, GET NEW VALUE
	XOR	T3,(T2)		;SEE WHAT'S CHANGED SINCE ORIGINAL
	AND	T3,CHGMSK(S1)	;ONLY CARE ABOUT WHAT WE THINK WE CHANGED
	JUMPN	T3,.RETF	;DIFFERENT
	$RETT			;THE SAME
COMPA2:	LOAD	T3,S2,PD.WRD	;SOME TYPE OF BLOCK--GET (MAX.) SIZE
	MOVNS	T3		;WANT NEGATED FOR AOBJN POINTERS
	TXNN	S2,PD.EXT	;IS THIS AN EXTENSIBLE BLOCK?
	JRST	COMPA3		;NO, JUST AN ORDINARY BLOCK
	SKIPE	T1,(T1)		;YES, GET BLOCK POINTER
	ADDI	T1,(U)		;DE-RELATIVIZED
	SKIPE	T2,(T2)		;FROM EACH PROFILE
	ADDI	T2,(X)		;DE-RELATIVIZED
	HLRE	T4,T1		;GET WORKING BLOCK'S LENGTH
	CAMGE	T4,T3		;WITHIN LIMITS?
	HRLI	T1,(T3)		;NO, ENFORCE THE LIMIT
	HLRE	T4,T2		;GET ORIGINAL'S LENGTH
	CAMGE	T4,T3		;DID IT FIT?
	HRLI	T2,(T3)		;NO, RESTRICT IT
	JRST	COMPA4		;GO COMPARE BLOCKS
COMPA3:	HRLI	T1,(T3)		;MAKE AOBJN POINTER
	HRLI	T2,(T3)		;FOR BOTH PROFILES
COMPA4:	SKIPGE	T1		;STILL SOME TO FETCH?
	SKIPA	T3,(T1)		;YES, DO SO
	SETZ	T3,		;NO, PAD WITH ZEROS
	SKIPGE	T2		;SIMILAR TREATMENT
	SKIPA	T4,(T2)		;WITH ORIGINAL PROFILE
	SETZ	T4,		;PADDING SHORTER
	CAME	T3,T4		;STILL THE SAME?
	$RETF			;NO, WE CHANGED SOMETHING
	AOBJP	T1,.+1		;ADVANCE WORKING POINTER
	AOBJN	T2,COMPA4	;LOOP WITH ORIGINAL'S POINTER
	JUMPL	T1,COMPA4	;GO UNTIL BOTH POINTERS RUN OUT
	$RETT			;THEY'RE STILL THE SAME

;SETUP CHANGE MASKS

CMPVLC::SETOM	@CHGADR		;ASSUME A CHANGE
	SETOM	CHGMSK(S1)	;PARSE ROUTINE DOES WHOLE WORD
CMPVAL::MOVE	S2,CHGTAB##(S1)	;GET CONTROL BITS
	TXNE	S2,PD.MSK	;IF MASKABLE,
	JRST	CMPVA1		;DON'T DO THIS
	MOVE	S2,@CHGADR	;IF WE THINK WE MIGHT HAVE CHANGED IT,
	MOVEM	S2,CHGMSK(S1)	;ASSUME A FULL WORD CHANGED
CMPVA1:	SKIPN	@CHGADR		;DO WE THINK WE CHANGED IT?
	JRST	CMPVA2		;NO, DON'T TWEAK DEFAULT BIT
	PUSH	P,S1		;SAVE PROFILE OFFSET
	ADJBP	S1,[POINT 1,.AEMAP(U),0] ;POINT TO ITS DEFAULT BIT
	MOVE	S2,PRSDFV	;GET 'SET DEFAULT' FLAG
	DPB	S2,S1		;SET CORRESPONDINGLY IN MAP
	POP	P,S1		;RESTORE OFFSET
CMPVA2:	PUSHJ	P,COMPAR	;CHECK FOR CHANGES
	JUMPF	.RETT		;GUESSED RIGHT, WE'RE DONE
	SETZM	CHGMSK(S1)	;WORD DIDN'T CHANGE
	SETZM	@CHGADR		;NOR DID ENTRY
	POPJ	P,		;RETURN HAPPY
	SUBTTL	Utility routines -- QPPNIN and QUSRIN
;QPPNIN, QPPNNX, QUSRIN and QUSRNX
;Call
;	S1/ PPN to read or pointer to name
;	S2/ Where to put it

QPPNIN:	SKIPA	T1,[QA.IMM!1B17!.UGPPN]
QUSRIN:	MOVE	T1,[.AANLW,,.UGUSR]
	$FALL	QPROF		;NON WILD NAME OR PPN

;COMMON CODE
QPROF:
;.UGPPN OR .UGUSR
	MOVE	T2,S1		;SAVE VALUE
;.QURSP
	HRLI	S2,.AEMAX	;SIZE OF RESPONSE BLOCK
	MOVEM	S2,QUEBLK+.QURSP ;SAVE AS RESPONSE BLOCK
;.QUFNC and .QUNOD
	MOVE	S1,[QF.RSP!.QUMAE] ;FUNCTION CODE
	SETZ	S2,		;NODE
	DMOVEM	S1,QUEBLK+.QUFNC ;SAVE AS FUNCTION
;.QUTIM and .QUPID
	MOVEI	S1,3		;ASSUME A STANDARD HEADER OFFSET
	SKIPE	OLDMON		;NON-FANCY UUO?
	JRST	QPROF1		;YES, SKIP THIS
	SKIPE	DEBUGQ		;WANT TIMING?
	TDZA	S2,S2		;NO
	MOVEI	S2,ZZTIME	;YES
	MOVEM	S2,QUEBLK+3	;SAVE TIME LIMIT
	SKIPE	S2,DEBUGW	;IF RUNNING IN PRIVATE MODE,
	MOVE	S2,ACTPID	;USE THE ALTERNATE PID
	MOVEM	S2,QUEBLK+4	;SAVE FOR UUO
	SKIPE	S2		;IF WE ADDED THE PID,
	AOSA	S1		;ADD TWO HEADER WORDS
	SKIPE	QUEBLK+3	;ELSE, IF WE ADDED THE TIMER,
	AOS	S1		;ADD ONE HEADER WORD
	STORE	S1,QUEBLK,QF.HLN ;SAVE HEADER LENGTH FOR THE UUO
QPROF1:
;SELECT FUNCTION
	DMOVEM	T1,QUEBLK+2(S1)	;STUFF ACTDAE ARGS IN SECOND BLOCK AFTER HEADER
;.QBAFN
	DMOVE	T1,[QA.IMM!1B17!.QBAFN ;SUBFUNCTION
		    EXP UGOUP$]	;  OF OBTAIN PROFILE
	SKIPN	UNPRIV		;HAVE PRIVS?
	TXO	T2,AF.PRV	;YES, USE THEM
	DMOVEM	T1,QUEBLK(S1)	;STASH

	MOVSI	S1,4(S1)	;GET BLOCK LENGTH
	HRRI	S1,QUEBLK	;UUO ARG POINTER
	QUEUE.	S1,		;DO THE QUEUE.
	  $RETF			;FAILED
	$RETT			;SUCCESS
	SUBTTL	Utility routines -- OUTLST - Send a character to the list file
;OUTLST - Character from $TEXT to output file
;Call
;
;Return
;	Always

OUTLST:	SKIPE	S2,LSTIFN	;ARE WE GOING TO A FILE?
	JRST	OUTLS1		;YES
	PUSHJ	P,T%TTY		;NO, JUST OUTPUT THE CHARACTER
	$RETT			;RETURN

OUTLS1:	EXCH	S2,S1		;COPY BYTE
	PUSHJ	P,F%OBYT	;OUTPUT TO THE LST FILE
	$RETT			;AND RETURN
	END	REACT