Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99S-BB_1990 - 10,7/acct/actdae.mac
There are 9 other files named actdae.mac in the archive. Click here to see a list.
TITLE	ACTDAE - Accounting Daemon for TOPS10
SUBTTL B.A.HUIZENGA/BAH/Tarl/LWS/DPM/RCB	14-Nov-89

	SEARCH	ACTPRM,QSRMAC,ORNMAC
	MODULE	(ACTDAE)

	.REQUIR	ACTRCD		;USAGE RECORDS

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1988,1990.
; 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.

	AC.VER==2	;VERSION NUMBER
	AC.EDT==162	;EDIT NUMBER
	AC.WHO==0	;WHO EDITED LAST
	AC.MIN==3	;MINOR VERSION NUMBER

	%%.ACV==:<VRSN.	(AC.)>
;AC DEFINITIONS OTHER THAN GLXLIB
DEFADR==15	;CURRENT ADDRESS OF DEFUS DATA ITEM BEING WORKED UPON.
		; NEEDS TO BE PRESERVED OVER DATFIL ROUTINES.
LENGTH==16	;LENGTH OF CURRENT DATA ITEM BEING WORKED UPON.
		; NEEDS TO BE PRESERVED OVER CONVERT ROUTINES.

;CUSTOMER CHANGABLE PARMETERS

IFNDEF	FILPRO,<FILPRO==177>	;USAGE/FAILURE FILE PROTECTION
IFNDEF	FILBSZ,<FILBSZ==^D7>	;USAGE/FAILURE FILE BYTE SIZE FOR NEW FILES
IFNDEF	WTOINT,<WTOINT==^D5>	;INTERVAL TIME (MINUTES) BETWEEN RETRY WTO'S
IFNDEF	RMGINT,<RMGINT==^D120>	;INTERVAL TIME (SECONDS) BETWEEN RMS MESSAGES
IFNDEF	SLPSEC,<SLPSEC==^D15>	;SECONDS TO SLEEP BETWEEN RETRIES
				;SHOULD EVENLY DIVIDE ^D60 OR WTOINT WON'T
				;BE CALCULATED CORRECTLY. MAXIMUM IS ^D60.
IF1,<IFG <SLPSEC-^D60>,<PRINTX ?SLPSEC GREATER THAN ^D60.>>

IFNDEF	CHKINT,<CHKINT==^D10>	;INTERVAL FOR CHECKPOINTING USAGE FILES
				;DONE ON THE FULL MINUTE SO MUST BE
				;EVENLY DIVISIBLE INTO 60. I.E. WITH 15
				;MINUTE INTERVAL, CHECKPOINTING WILL BE
				;DONE AT xx:00, xx:15, xx:30, AND xx:45

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1990. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO


	LOC	137
	EXP	%%.ACV
	RELOC
	SUBTTL	EDIT HISTORY

;1)	Implement Account validation
;2)	Convert to use GLXLIB
;3)	Use extended channels and the new FILOP. for I/O
;4)	Implement Checkpointing for active jobs
;5)	Take action when LOGIN sends LOGIN, SESSION, and ATTACH messages
;6)	When disk space is too low for allocating checkpoint files, limit
;	the number of jobs to be logged in
;7)	Implement Usage file handling code
;10)	Validation routine doesn't do enough checking for whom to validate
;11)	Verify routine didn't handle PPNs less than the first
;	PPN in PROJCT.SYS.  Also, verify couldn't handle more than one
;	block of validation data in PROJCT.SYS
;12)	Make ACTDAE know about ACCT.SYS.  Build a table of first PPNs
;	in every block and search ACCT.SYS for any PPN validation error
;13)	Teach ACTDAE about the 7.01 MOnitor LOGOUT message from [SYSTEM]GOPHER
;14)	Since the 70017 monitor starts up the ACTDAE via FRCLIN, the job
;	must run detached.  Also teach ACTDAE about wild card ppns in ACCT.SYS.
;15)	Write MAKENT routine that generally writes an entry
;	given an entry number and address of DEFUS data.
;16)	Imement the QUEUE. UUO validation function.
;17)	Implement the QUEUE. UUO make an entry function.
;20)	Use PSI for IPCF traffic and begin timer code
;21)	Complete Job checkpoint code and timers for running same.
;22)	Make Session entries for jobs after a reload or ACTDAE restart
;23)	Implement code for closing sessions and the usage file
;24)	Implement device checkpoint files and entries.
;25)	Implement Disk Usage accounting from BACKUP
;26)	ORIONs messages for SET USAGE FILE/BILLING commands changed
;27)	Would you believe ORIONs message changed again
;30)	Wild-card in Account string support missing, add it (req PROJCT V1(2)).
;	Also, could only find first account for wild-card'ed ppns, fix that.
;31)	Space wasted by PHASE/DEPHASE assembly, also bum SKIPT/$RETF pairs.
;32)	$FATAL doesn't type on OPR if detached, define $BOMB that always uses OPR
;33)	LOGIN sends -1 if no Account or Remark specified at LOGIN time
;34)	Physical device name not provided in magtape and DECtape entries
;35)	Bad BLT for text fields for STRUCTURE/MAGTAPE/DECTAPE mount IPCF messages.
;36)	GLXLIB will DETACH if on FRCLIN, remove code from ACTDAE
;37)	Add code and range checks for user defined entries (5000-9999)
;40)	Make system restart a little faster
;41)	Fix problems with finding entries in PROJCT.SYS
;42)	Bad "Make An Entry" messages caused lost free space
;43)	Do case conversion when verifying account if FTCASECONVERT is on.
;	Return account string (may be modified if FTCASECONVERT is on) in IPCF
;	message or in response block of QUEUE. on successful validation.
;44)	Implement /NO-SESSION-ENTRIES on the SET USAGE FILE-CLOSURE command to
;	over-ride the implicit SET USAGE BILLING-CLOSURE that occurs when the
;	file is closed.
;45)	Edit 37 broke Disk Utilization records, fix that.
;46)	Use assembly parameter PRJWPB for PROJCT.SYS instead of 200s
;47)	Implement Default account strings from PROJCT.SYS.  The default is
;	used if asked to verify a null account string and a default exists.
;	The default is returned in the IPCF message or QUEUE. response block.
;50)	Allow PPN entries to cross block boundries in PROJCT.SYS.  This change
;	becomes format version 2.  Implement code such that version 1 PROJCT.SYS
;	still works.  With this change, making PRJWPB larger simply becomes a
;	performance gain.
;51)	Jobs doing QUEUE. UUO to make an entry hang in EW if not privileged or
;	specify an unknown entry type.  Un-stick them.
;52)	Implement QUEUE. UUO subfunctions UGACC$ and UGOUP$
;	for access control requests.
;53)	Complete implementation of Date/Time change
;54)	Assume account string is NOT required if a ppn isn't in ACCT.SYS
;55)	Random fixes from random QARs
;56)	Remove our definition of the job field in the LOGOUT message and
;	use QUASAR's definition from QSRMAC.
;57)	Correct sense of check in ACTLIN so we dont send a bogus error
;	message to the OPR if the PID we send to is gone.
;60)	Check for PROJCT.SYS being created from a zero-length PROJCT.ACT
;	and assume [*,*]=*
;61)	Always call ALLDEV on LOGOUT to insure nnnDEV.BIN gets deleted.
;Start version 2 here, to be shipped with TOPS10 7.03.
;
;This version implements SYS:ACCT.SYS version 5, now ACT:ACCT.ACT (See
;	ACTCIO.MAC). Only ACTDAE should be reading/writing ACCT.ACT.
;	ACTDAE depends on the fact that only it can change the file.
;
;100)	Up the version number to 2. Start massive changes. /Tarl
;
;101)	Add "context limit" and "idle contexts page limit" UGCHG$
;	subfunctions. /LWS
;
;102)	Add new "profile flag" word and last access UDT word. Fix various
;	bugs in ACCTIO from page boundary problems to  miscalculating
;	number of customer defined words and program to run words. /LWS
;
;103)	Add rudimentary "validation failure log" file support. Fix bugs
;	in ACCTIO dealing with page boundaries. /LWS
;
;104)	Add LOCK and UNLOCK user account file functions. /LWS
;
;105)	Rewrite FNDIDX in ACCTIO and add IDXINI. /LWS
;
;106)	Add support for synonym-to-account string translation.  This is
;	useful for sites which frequently change account strings and do
;	not want to inconvience their users by making them change their
;	SWITCH.INIs, control files, or MIC file.  A file called SYN.ACT
;	resides on ACT: and contains one or more lines equating synonym
;	strings with account strings.  The format is synonym=account.
;	Every time we validate an account string, we first check to see
;	if the string in question is a synonym.  If it is, then the
;	string is changed to the appropriate account string.
;
;	For example, the account string for user [10,56] changes on a
;	monthly basis, but the user has "TOPS10-DEVELOPMENT" as his
;	synonym.  The system administrator may change the entry in SYN.ACT
;	for TOPS10-DEVELOPMENT at any time, and the user remains unaffected.
;	After the synonynm translation occurs, the final account string is
;	still checked for legality.
;
;	Note:  This feature is controlled by the setting of SYNONYM, and
;	is normally turned off.
;
;107)	Allow LOGIN, SESSION, and ATTACH messages via QUEUE. UUO  /DPM
;
;110)	Fix bug where error messages were being sent back with various
;	incorrect lengths. Preserve "T" ACs in LOGUSR. /LWS
;
;111)	Username storage was only 1 word. Copying a maxium of 39 8-bit
;	characters there would clobber what ever followed.
;	QAR #868037 /LWS
;
;112)	Rip out the ACCTIO interface and replace with ACTRMS. /TL
;
;113)	Add UGVUP$ function, "validate account string and return user
;	profile. /LWS
;
;114)	Move calls to SCDINI and SCDCLS from ACTRMS to ACTDAE. Add code
;	to support new function UGSCD$. User account file is now
;	SYS:ACTDAE.SYS and  PROJCT.SYS now should reside on SYS:. /LWS
;
;115)	Fix bug where CHKACT was calling GETPRO without PPN in T1. /LWS
;
;116)	Turn on code that supports a password along with profile to
;	insert. REACT now knows how to do it. /LWS
;
;117)	Remove VERSET to set version. ACTRMS must be loaded before ACTDAE. /LWS
;
;120)	Add code to prevent password changes if AE.PCP is set in the
;	profile flag word (.AEFLG).
;	23-Jul-85  /DPM
;
;121)	Implement administrative priveleges.
;	24-Jul-85  /DPM
;
;122)	Let owner obtain his/her own profile and not require a password
;	to change unpriv'ed fields in the profile.  If the PPN or project
;	number (depending of the setting of INDPPN) of the sender matches
;	that of the profile, then access is granted.
;	15-Aug-85  /DPM
;
;123)	Move all PPN and user name wildcarding out of REACT and into ACTDAE
;	(actually ACTRMS).  Support new wildcard message UGWLD$ either from
;	a QUEUE. UUO or direct IPCF.  See ACTSYM for a definition of the
;	message offsets (UW$xxx).
;	26-Aug-85  /DPM
;
;124)	Move CHGTAB and friends into ACTCHG module of ACTLIB.  Make the
;	writing of 8-bit usage/failure files an option.  Set FILBSZ to
;	the desired byte size (default is 7-bit).
;	29-Aug-85  /DPM
;
;125)	Convert all old-style calls for a [next] profile to internal
;	wildcard calls.  Start converting error ACKing to use ACTLIB's
;	error facilities.  Other miscellaneous changes made to conform
;	to changes in the RMS-10 interface module of ACTLIB.
;	 6-Sep-85  /DPM
;
;126)	Convert more error ACKs.  Almost done!
;	13-Sep-85  /DPM
;
;127)	Add support for new accounting function UGMAP$ to map PPNs to user
;	names.
;	16-Sep-85  /DPM
;
;130)	Change format of FAILUR.LOG to record ANF/DECNET/LAT node/line
;	number on a LOGIN failure.
;	15-Oct-85  /CJA
;
;131)	Fix ACTMAP to always update name.  Since user may have supplied
;	a unique abbreviation, he might be interested in the complete
;	name too.
;
;132)	PUSH and POP of .AEPPN isn't enough in ACTMAP.  Copy PPN and
;	name to temporary storage.
;
;133)	Update UGCUP$ for profile format version 6.  This also changes
;	the format of select blocks.  Also start to enable setting
;	ACOPRV via the function code, and turning on the new acking
;	code via the function code bits.  The UG.xxx symbols of the
;	old UGCUP$ are going away sometime.  If possible, we'll make
;	.UGPRV go away too.
;	18-Nov-85  /RCB
;
;134)	Fix some bugs with the defaulting code.
;	24-Nov-85  /RCB
;
;135)	Fix undeserved invalid account string problems.
;	 4-Dec-85  /DPM
;
;136)	Fix some minor bugs in UGCUP$ and UGMAP$.
;	17-Dec-85  /RCB
;
;137)	Fix up some bugs in UGCUP$.
;	13-Jan-86  /RCB
;
;140)	Fix up password change time when changing a password even if the
;	.AEPCT value was orginally defaulted.
;	 7-Mar-86  /RCB
;
;141)	If an attempt is made to insert a profile with a duplicate
;	name, return a meaningful error message instead of the usual
;	"unexpected RMS error xxxxxx" cruft.
;	15-Apr-86  /DPM
;
;142)	Allow * to match null account strings like the documentation
;	and the usage spec claims will work.   Also match double quotes
;	in invalid account error message.
;	17-Apr-86  /DPM
;
;143)	Implement PSI on date/time change so that entrys have correct times
;	and connect time if the system has USAGE FILE CLOSURES set for DAILY.
;	2-Jun-86  /BAH
;
;144)	Make debugging easier by not using a job-wide pid.
;	3-Jul-86  /RCB
;
;145)	Invent a bunch of error codes, and use them in the coded error acks and
;	in the failure file.
;	28-Oct-86  /RCB
;
;146)	Convert to use the new STOPCD macro in GLXMAC, rather than $STOP.
;	1-Dec-86  /RCB
;
;147)	Fix privilege checking for AF.PRV.
;	3-Dec-86  /RCB
;
;150)	Range-check program-supplied job numbers on various usage entries.
;	SPR 10-35687
;	11-Feb-87  /RCB
;
;151)	Fix the (unsupported) NCRYPT algorithm in ALGCUS so that it
;	decrypts correctly (thus matching the original LOGIN routine).
;	SPR 10-35694
;	19-Feb-87  /JJF
;
;152)	Fix selection testing of .AEAUX entries to allow for wildcarded
;	structures as well as wild quotas and bits.
;	15-May-87  /RCB
;
;153)	Set UC$PRF accordingly if UGVUP$ function.
;	SPR 10-36011
;	7-Sep-87  /LWS
;
;154)	Try not to hang jobs in EW for EV.IPC.  Always ACK all [SYSTEM]GOPHER
;	messages, whether we like them or not.
;	29-Sep-87  /RCB
;
;155)	Fix bug in checking for password change allowed.  No change required
;	is not the same as an expired password.
;	16-Jun-88  /RCB
;
;156)	Correct problems with unique (10,#) PPNs.
;	SPR 10-35597
;	 5-Jan-89  /DPM
;
;157)	MAPLGL doesn't fixup PPN/NAME block pointers correctly when
;	processing an IPCF (not QUEUE. UUO) message to map PPNs to
;	names.
;	10-Jan-89  /DPM
;
;160)	Check for fatal RMS errors (ER$BUG and ER$UDF).  When these
;	errors are encountered, send messages to the operator and to
;	the user.
;	30-Aug-89 /KDO
;
;161)	Fix account ownership checking for [1,2].  It shouldn't be able
;	to do so much without admin privs.
;	14-Nov-89  /RCB
;
;162)	Don't start virtual timer traps until after we're done in ACTINI.
;	We thrash too badly while reading the old USEJOB.BIN etc.  Defer
;	going virtual until we start accepting IPCF messages.
;	14-Nov-89  /RCB
;
;	End of Revision History
;LOOSE ENDS

REPEAT 0,<
	NONE
>
	SUBTTL	DEFINITIONS AND DATA STORAGE

;GENERAL DEFINITIONS

ACTLNG==100			;LENGTH OF PUSH DOWN LIST

ND	SYNONYM,0		;DEFAULT SYNONYM TO ACCOUNT STRING TRANSLATION
				; 0 = OFF, 1 = ON
SYNFLG:	EXP	SYNONYM		;SYNONYM FLAG
SYNIFN:	BLOCK	1		;IFN FOR SYNONYM FILE
SYNLIN:	BLOCK	1		;SYNONYM FILE LINE NUMBER
SYNTAB:	BLOCK	1		;POINTER TO SYNONYM TABLE
SYNTMP:	BLOCK	10		;TEMPORARY SYNONYM STRING STORAGE
SYNARG:	BLOCK	1		;SYNONYM-ADDR,,ACCOUNT-STRING-ADDR

ACKEFL:	BLOCK	1		;NON-ZERO IF NEW-STYLE ACKS WANTED
ACKETX:	BLOCK	1		;ADDRESS OF ACK TEXT ON USER ERRORS
ACKITX:	BLOCK	1		;ADDRESS OF ACK ITEXT BLOCK

MVBFLG:	BLOCK	1		;FLAG TO MOVE WHOLE VALIDATION BLOCK
STATE2:	BLOCK 1			;SECOND STATES WORD (CONTAINS VALIDATION FLAG)
ACTDEV:	BLOCK 1			;USUALLY ERSATZ DEVICE ACT:,  DSK: IF DEBUGGING
				; (E.G., .JBOPS CONTAINS NON-ZERO)
PRJDEV:	BLOCK 1			;FOR PROJCT.SYS NOW USE SYS: OR DSK: IF DEBUG
ACNDEV:	BLOCK	1		;DEVICE FOR ACTDAE.SYS (SYS: OR DSK: IF DEBUG)
ACTUSE:	BLOCK 2			;USETI/O BLOCK FOR POSITIONING ANY FILE
ACTPDL:	BLOCK ACTLNG		;PUSH DOWN LIST

ACCTFN:	BLOCK	16		;STORAGE FOR ASCIZ ACCOUNTING FILE NAME

;INITIALIZATION BLOCK

IB:	$BUILD	(IB.SZ)		;INITIALIZATION BLOCK
$SET	(IB.PIB,,PIB)		;ADDRESS OF PID BLOCK
$SET	(IB.PRG,,%%.MOD)	;PROGRAM NAME
$SET	(IB.INT,,ACTPSI)	;INTERRUPT VECTOR BASE
$SET	(IB.FLG,IB.NPF,1)	;DON'T DO VIRTUAL TIMER TRAPS UNTIL ALL SET UP
	$EOB

PIB:	$BUILD	(PB.MXS)	;PID BLOCK
$SET	(PB.HDR,PB.LEN,PB.MXS)	;LENGTH OF THIS BLOCK
$SET	(PB.FLG,IP.JWP,1)	;JOB-WIDE PID
$SET	(PB.FLG,IP.SPF,1)	;BE A SYSTEM PID
$SET	(PB.FLG,IP.SPB,1)	;SEE IF SENDER SET IP.CFP
$SET	(PB.FLG,IP.PSI,1)	;CONNECT THIS PID TO PSI SYSTEM
$SET	(PB.INT,IP.SPI,SP.ACT)	;SPECIAL PID INDEX [SYSTEM]ACCOUNT
$SET	(PB.INT,IP.CHN,<IPCPSI-ACTPSI>)	;CHANNEL
$SET	(PB.SYS,IP.MNP,1)	;ONLY 1 PID ALLOWED FOR THIS JOB
$SET	(PB.SYS,IP.SQT,-1)	;INFINITE SEND QUOTA
$SET	(PB.SYS,IP.RQT,-1)	;INFINITE RECEIVE QUOTA
	$EOB

;IPCF SEND/RECEIVE MESSAGE DEFINITIONS

IPS.BL:	BLOCK SAB.SZ		;IPCF SEND BLOCK
IPR.BL:	BLOCK MDB.SZ		;IPCF RECEIVE BLOCK
MDBADR:	BLOCK 1			;MESSAGE DESCRIPTOR BLOCK OF LAST RECEIVE
MMSADR:	BLOCK 1			;RECEIVE DATA ADDRESS
DATADR:	BLOCK 1			;ADDRESS OF DATA FOR ADTDAE FUNCIONS
SABADR:	BLOCK 1			;ADDRESS OF SEND DATA PAGE
SABFLG:	BLOCK	1		;FLAG TO CHECK IF ACK STILL NEEDED

;PSI INTERRUPT BLOCKS

ACTPSI:
IPCPSI:	EXP	IPCTRP
	BLOCK	3

DTCPSI:	EXP	DTCTRP
	BLOCK	3

DTCTRP:	$BGINT	1,
	PUSHJ	P,ACTCHD	;ADJUST ALL TIMES AND CHECKPOINT
	$DEBRK

IPCTRP:	$BGINT	1,
	$CALL	C%INTR
	$DEBRK
	SUBTTL ERROR CODE GENERATOR

;USAGE:
; DEFINE LOCAL ERROR CODES, ERRA%=0, ERRB%=1, ...
; DEFINE LOCAL LABELS WHICH CORRESPOND TO EACH ERROR CODE.
; FOR EACH ERROR CODE, LABEL PAIR, ERCODE(LABEL,CODE)

ECDMAX==11		;MAXIMUM NUMBER OF ERROR TYPES IN ACTDAE

DEFINE	ERCODE(NAME,CODE)<
	.DIRECTIVE .XTABM
	ERRCOD	(NAME,CODE,\CODE)
	.DIRECTIVE .ITABM>

DEFINE	ERRCOD(NAME,CODE,ACODE)<
	IFG <CODE+1-ECDMAX>,<
		PRINTX %ECOD'ACODE is undefined, define ECDMAX in ACTDAE.MAC to be ACODE+1>
	NAME==ECOD'ACODE>

DEFINE	ERCALC(N)<
.N==0
REPEAT	N,<ERRJSP (\.N)
.N=.N+1>
ECOD:	SUBI	T1,ECOD0+1
	HRRZS	T1
	JRST	ERRPRO>

DEFINE	ERRJSP(N)<
ECOD'N:	JSP	T1,ECOD>


	ERCALC	(ECDMAX)
	SUBTTL	MACROS

;DEFINE A MACRO TO PUT STANDARD ACTDAE HEADER AROUND A MESSAGE TO THE OPERATOR

DEFINE	$WTOXX	(TEXT),<
	$WTO	(<Message from the Accounting System>,<TEXT>,,<$WTFLG(WT.SJI)>)
>


;DEFINE A MACRO TO OUTPUT FATAL ERRORS TO OPERATOR THEN STOP

DEFINE	$BOMB	(TEXT),<
	JRST	[$WTO(<Fatal error in the Accounting System>,<TEXT>)
		 $FATAL(<TEXT>)]
>
	SUBTTL	ACTDAE - PRIMARY MODULE FOR TOPS10 ACCOUNTING DAEMON

ACTDAE:	RESET
	MOVE	P,[IOWD ACTLNG,ACTPDL]	;SET UP OUR PDL
	MOVX	S1,IP.JWP	;[144] JOB-WIDE PID FLAG
	SKIPE	DEBUGW		;[144] IF DEBUGGING,
	ANDCAM	S1,PIB+PB.FLG	;[144] USE ONLY INIT-CLASS PID
	MOVEI	S1,IB.SZ	;LOAD SIZE OF INITIALIZATION BLOCK (IB)
	MOVEI	S2,IB		;LOAD ADDRESS OF IB
	$CALL	I%INIT		;INITIALIZE THE WORLD OF GLXLIB
	$CALL	I%ION		;TURN ON THE PSI SYSTEM
	MOVX	T2,.PCDTC	;DATE/TIME CHANGE PSI CONDITION
	MOVSI	T3,<DTCPSI-ACTPSI>
	SETZM	T4		;NO PRIORITY
	MOVX	T1,<PS.FAC+T2>	;SET UP CALL
	PISYS.	T1,
	$WTOXX	(<Date/time changes will not be adjusted in the USAGE files.
Please report PISYS. error >,^O/T1/)
	PUSHJ	P,ACTINI	;INITIALIZE THE WORLD
	MOVE	S1,[.STTVM,,^D1000] ;SETUP TO ATTEMPT VIRTUAL TIMER TRAPS
	SETUUO	S1,		;EVERY SECOND OF RUN TIME
	  TRN			;BUT I DON'T MIND IF NEVER GO VIRTUAL!

ACTDA1:	$CALL	C%RECV
	JUMPF	ACTDA2		;NO MESSAGES YET. WAIT FOR AN EVENT TO HAPPEN
	MOVEM	S1,MDBADR	;SAVE THE MESSAGE DESCRIPTOR ADDRESS
	MOVE	T1,MDB.MS(S1)	;GET THE ADDRESS OF THE MESSAGE
	ANDX	T1,MD.ADR	;MASK OUT THE ADDRESS
	MOVEM	T1,MMSADR	;SAVE IT FOR LATER
	MOVEM	T1,DATADR	;DATA MESSAGE IF NOT FROM A QUEUE. UUO
	MOVEM	T1,SABADR	;AND IN CASE OF ERROR MESSAGES
	SETZM	SABFLG		;NOT YET ACK'ED
	SETZM	RMGCOD		;NO FATAL RMS ERRORS SO FAR
	PUSHJ	P,QUECHK	;CHECK IF MESSAGE CAME FROM QUEUE.
	JUMPF	[PUSHJ P,IGNORE
		 JRST ACTDA1]
	MOVE	T1,DATADR	;USE DATADR IN CASE IT WAS A QUEUE. MESSAGE
	HRRZ	T1,UV$TYP(T1)	;GET THE IPCF MESSAGE TYPE
	ANDI	T1,AF.FUN	;MASK IT DOWN
	CAILE	T1,IPCMAX	;IS IT A LEGAL MESSAGE?
	SETZ	T1,		;NO, MAKE IT 0 = ILLEGAL
	HLRZ	T2,ACTDSP(T1)	;GET PRIV CHECKING ROUTINE
	SKIPE	T2		;SKIP IF NO CHECKING NEEDED
	PUSHJ	P,(T2)		;CHECK PRIVILEGES
	HRRZ	T2,ACTDSP(T1)	;GET MESSAGE PROCESSOR ROUTINE
	PUSHJ	P,(T2)		;DISPATCH
	SKIPN	SABFLG		;DID WE EVER SEND THE ACK?
	PUSHJ	P,IGNORE	;NO--MAKE SURE
	JRST	ACTDA1

ACTDA2:	PUSHJ	P,CHKIVL	;COMPUTE TIME UNTIL NEXT CHECKPOINT
	$CALL	I%SLP		;AND SLEEP THAT LONG
	JRST	ACTDA1		;GO BACK AND SEE WHAT WOKE US UP
;DISPATCH TABLE FOR ACCOUNT DAEMON EVENTS

ACTDSP:	XWD	PRVOPR,IGNORE	;(0)  ILLEGAL
	XWD	0,ACTVER	;(1)  REQUEST FOR ACCOUNT VALIDATION
	XWD	PRVOPR,ACTLIN	;(2)  USER IS LOGGING IN
	XWD	PRVOPR,ACTSES	;(3)  USER TYPED A SESSION COMMAND
	XWD	PRVOPR,ACTATT	;(4)  USER TYPED AN ATTACH COMMAND
	XWD	PRVOPR,IGNORE	;(5)  SET DATE/TIME MESSAGE FROM DAEMON
	XWD	PRVOPR,IGNORE	;(6)  RESPONSE TO A VALIDATION MESSAGE
	XWD	PRVOPR,USGMAK	;(7)  MAKE A USAGE ENTRY (QUEUE. UUO only)
	XWD	PRVOPR,DOUBC	;(10) DO BILLING CLOSURE
	XWD	PRVOPR,DOUFC	;(11) DO FILE CLOSURE
	XWD	PRVOPR,ACTFDM	;(12) USER FILE STRUCTURE MOUNT MESSAGE
	XWD	PRVOPR,ACTFDD	;(13) USER FILE STRUCTURE DISMOUNT MESSAGE
	XWD	PRVOPR,ACTMGM	;(14) USER MAGTAPE MOUNT MESSAGE
	XWD	PRVOPR,ACTMGD	;(15) USER MAGTAPE DISMOUNT MESSAGE
	XWD	PRVOPR,ACTDTM	;(16) USER DECTAPE MOUNT MESSAGE
	XWD	PRVOPR,ACTDTD	;(17) USER DECTAPE DISMOUNT MESSAGE
	XWD	PRVOPR,ACTSPM	;(20) DISK PACK SPINDLE SPIN-UP MESSAGE
	XWD	PRVOPR,ACTSPD	;(21) DISK PACK SPINDLE SPIN-DOWN MESSAGE
	XWD	PRVOPR,IGNORE	;(22) ACK (SENT FROM ACTDAE, NEVER RECEIVED)
	XWD	PRVOPR,ACTDUE	;(23) DISK USAGE DATA
	XWD	PRVOPR,ACTACC	;(24) ACCESS CONTROL CHECK (QUEUE. UUO only)
	XWD	0,ACTOUP	;(25) OBTAIN USER PROFILE (QUEUE. UUO only)
	XWD	PRVOPR,IGNORE	;(26) UNDEFINED
	XWD	0,ACTOUT	;(27) A LOGOUT UUO WAS DONE
	XWD	0,ACTACC	;(30) ACC BUT RETURN PROFILE (QUEUE. UUO only)
	XWD	0,ACTCUP	;(31) CHANGE USER PROFILE (QUEUE. UUO only)
	XWD	PRVOPR,ACTPSW	;(32) VALIDATE PASSWORD (QUEUE. UUO only)
	XWD	PRVADM,ACTLOK	;(33) LOCK USER ACCOUNT FILE (QUEUE. UUO only)
	XWD	PRVADM,ACTUNL	;(34) UNLOCK USER ACCOUNT FILE (QUEUE. UUO only)
	XWD	PRVOPR,ACTVER	;(35) VALIDATE ACCOUNT AND RETURN PROFILE
	XWD	PRVADM,ACTSCD	;(36) CLOSE AND REOPEN SCDMAP.INI (QUEUE. UUO only)
	XWD	0,ACTWLD	;(37) GET POSSIBLY WILDCARDED PPN/NAME
	XWD	0,ACTMAP	;(40) MAP PPNS/NAMES
IPCMAX==:.-ACTDSP-1


IGNORE:	SKIPE	GFRFLG		;IF THIS CAME FROM [SYSTEM]GOPHER,
	JRST	QUEACK		;RELEASE THE JOB
	SKIPN	SABFLG		;NO. DO WE NEED TO RELEASE THE MSG?
	PUSHJ	P,IPCREL	;YES. DO IT AND REMEMBER IT
	$RETF

IPCREL:	MOVE	S1,MDBADR	;GET THE MDB ADDRESS
	SKIPE	MDB.MS(S1)	;HAS IT ALREADY BEEN RELEASED?
	$CALL	C%REL		;NO. DO IT NOW
	SETOM	SABFLG		;REMEMBER THAT WE CALLED C%REL
	POPJ	P,		;RETURN
SUBTTL	PRIVILEGE CHECKING


PRVADM:	PUSHJ	P,CHKADM	;CHECK ADMINISTRATIVE PRIVS
	JUMPF	NOPRV		;NO ACCESS ALLOWED
	$RETT			;RETURN

PRVOPR:	PUSHJ	P,CHKOPR	;CHECK FOR [1,2] OR JACCT PRIVS
	JUMPF	NOPRV		;NO ACCESS ALLOWED
	$RETT			;RETURN

; CHECK FOR ADMINISTRATIVE PRIVS OR JACCT
CHKADM:	MOVE	T2,MDBADR	;POINT TO MESSAGE DESCRIPTOR
	LOAD	T3,MDB.PV(T2),MD.PJB ;GET JOB NUMBER
	HRLZS	T3		;PUT IN LH
	HRRI	T3,.GTPRV	;INCLUDE GETTAB TABLE
	GETTAB	T3,		;GET PRIV WORD
	  SETZ	T3,		;FAILED?
	MOVE	T4,MDB.PV(T2)	;GET SENDER'S PRIVS
	TXNN	T4,MD.PWH	;JACCT'ED JOB?
	TXNE	T3,JP.ADM	;ADMINISTRATIVE PRIVS?
	$RETT			;YES OR YES, RETURN GOODNESS
	$RETF			;NO TO BOTH, FAIL
				; ([1,2] DOESN'T WIN FOR FREE)

; CHECK FOR [1,2] OR JACCT PRIVS
CHKOPR:	MOVE	T2,MDBADR	;POINT TO MESSAGE DESCRIPTOR
	MOVE	T3,MDB.PV(T2)	;GET SENDER'S PRIVS AND JOB NUMBER
	MOVE	T4,MDB.SD(T2)	;GET SENDER'S PPN
	CAME	T4,MYPPN	;SAME AS US (NORMALLY [1,2])
	TXNE	T3,MD.PWH	;NO--JACCT'ED JOB?
	$RETT			;YES
	$RETF			;NO ACCESS ALLOWED

; CHECK FOR OWNER
CHKOWN:	SKIPE	ACOPRV		;IF PRIV'ED
	$RETT			;THEN AN OWNER
	MOVE	T2,MDBADR	;POINT TO MESSAGE DESCRIPTOR
	MOVE	T3,MDB.SD(T2)	;GET SENDER'S PPN
	CAMN	T3,S1		;IS THIS AN EXACT MATCH?
	$RETT			;YES, HE OWNS IT
	$SAVE	T1		;PRESERVE AN AC
	MOVE	T2,S1		;GET TARGET PPN
	CAMN	T3,MYPPN	;IF [1,2],
	TRCA	T3,1		;THEN FOOL THE CHKACC UUO,
	TRNA			;(NOT [1,2])
	TRC	T2,1		;BUT GIVE THE RIGHT ANSWER
	MOVE	T1,[.ACCPR,,<777>B26+<077>B35] ;SETUP FOR CHKACC
	MOVEI	T4,T1		;POINT TO UUO ARG BLOCK
	CHKACC	T4,		;TRY IT
	  $RETF			;SICK MONITOR
	CAIE	T4,0		;IS HE A WINNER?
	$RETF			;NO
	$RETT			;OR YES


NOPRV:	SKIPN	GFRFLG		;DID THIS COME FROM [SYSTEM]GOPHER?
	JRST	NOPRV1		;NO, JUST IGNORE (CAN'T TRUST USERS DATA)
	PUSHJ	P,M%GPAG	;BUT CAN TRUST THE MONITOR, GET A MESSAGE
	MOVEM	S1,SABADR	;STORE WHERE COMMON ROUTINES CAN FIND IT
	PUSHJ	P,ERROR3	;SAY "JOB NOT PRIVILEGED"
	PUSHJ	P,FIXQUE	;MOVE ACK CODE AND FORMAT THE MESSAGE
	PUSHJ	P,RSPSAB	;SEND RESPONSE FROM SABADR TO THE MONITOR
NOPRV1:	SETZ	T1,		;RETURN FUNCTION = 0 = ILLEGAL
	$RETF			;AND PITCH IT
	SUBTTL	ACTDAE - INITIALIZATION


ACTINI:	MOVEI	S1,'ACT'	;ACTDAE PREFIX
	MOVEI	S2,ERRACK	;ROUTINE TO ACK USER ERRORS
	PUSHJ	P,A$ERRI##	;INIT ERROR PROCESSOR
	PUSHJ	P,ACGTAB	;AREA TO DO ALL THE GENERAL GETTABS
	MOVX	S1,ACTFIL	;GET ACCOUNTING FILE NAME
	$TEXT	(<-1,,ACCTFN>,<^W/ACNDEV/:^W/S1/.SYS^0>) ;GENERATE ACCT FILESPEC
	PUSHJ	P,USGSAU	;APPEND TO USAGE.OUT
	PUSHJ	P,SYSINI	;SYSTEM RESTARTED. DO PRELIMINARY WORK
	PUSHJ	P,ACDINI	;INITIALIZE ALL DISK STUFF
	MOVE	T1,STATE2	;GET STATES WORD
	TXNN	T1,ST%ACV	;ACCOUNT VALIDATION REQUIRED?
	$WTOXX	(<Account validation is not required>)
	PUSHJ	P,SYNFIL	;READ SYNONYM FILE
	SETOM	CHKNDX		;FORCE A CHECKPOINT WHEN IPCF QUEUE IS EMPTY
	POPJ	P,

;ACGTAB - ROUTINE TO DO ALL GENERAL GETTABS AND STORE THE RESULTS FOR
;	LATER USE.

ACGTAB:	SKIPE	.JBOPS		;ARE WE DEBUGGING?
	SKIPA	T1,['   DSK']	;YES. LOOK IN OUR OWN AREA
	MOVEI	T1,'ACT'	;NO. USE ERSATZ DEVICE
	MOVEM	T1,ACTDEV	;SAVE IT
	SKIPE	.JBOPS		;ARE WE DEBUGGING?
	SKIPA	T1,['   DSK']	;YES. LOOK IN OUR OWN AREA
	MOVEI	T1,'SYS'	;NO. USE SYS: FOR PROJCT.SYS
	MOVEM	T1,PRJDEV	;SAVE IT
	MOVSM	T1,ACNDEV	;SETUP FOR ACTDAE.SYS
	MOVX	T1,%CNTIC	;GET NUMBER OF JIFFIES/SECOND ON THIS MACHINE
	GETTAB	T1,
	  MOVEI	T1,^D60		;DEFAULT TO 60
	MOVEM	T1,JIFSEC
	MOVX	T1,%CNST2
	GETTAB	T1,
	  MOVEI	T1,0		;ERROR. DON'T DO VALIDATION.
	MOVEM	T1,STATE2	;SAVE IT
	TXNN	T1,ST%ERT	;IS THERE EBOX/MBOX RUNTIME?
	JRST	ACGTA1		;NO. SKIP KL-ONLY STUFF
	MOVX	T1,%CVETJ	;GET CPU0'S EBOX TICKS/JIFFY
	GETTAB	T1,
	  MOVEI	T1,0
	MOVEM	T1,ETICKS
	MOVX	T1,%CVNTJ	;GET CPU0'S MBOX TICKS/JIFFY
	GETTAB	T1,
	  MOVEI	T1,0
	MOVEM	T1,MTICKS
ACGTA1:	MOVX	T1,%CNSJN	;GET NUMBER OF JOBS FROM MONGEN
	GETTAB	T1,
	  MOVEI	T1,^D201	;ERROR. DEFAULT TO A 200 JOB MONITOR
	MOVEI	T1,-1(T1)	;REMOVE NULL JOB
	MOVEM	T1,JOBMAX	;ONLY ALLOW THIS MANY JOBS TO LOGIN
	GETPPN	T1,		;GET OUR PPN
	  JFCL			;SILLY SKIP
	MOVEM	T1,MYPPN	;STORE FOR JUNK MAIL CHECK
	POPJ	P,
;SYSINI - ROUTINE CALLED AT SYSTEM STARTUP TO MAKE INCOMPLETE SESSION ENTRIES

SYSINI:	$CALL	.SAVE1		;GET A WORKING (AND SAFE) AC
	PUSHJ	P,CPJSAU	;OPEN THE CHECKPOINT FILE
	MOVE	T1,JOBMAX	;GET NUMBER OF JOBS ALLOWED TO LOGIN
	IMULI	T1,CPJIOB	;*BLOCKS PER CHECKPOINT AREA FOR EACH JOB
	ADDI	T1,1+JBOFFS	;ADJUST + ACCOUNT FOR GENERAL BLOCK
	MOVE	T2,CPJCHN	;THE CHANNEL NUMBER
	PUSHJ	P,AUSETO	;CREATE/EXTEND THE FILE, ZEROING AS WE GO
	JUMPT	SYSIN1		;SO FAR SO GOOD
	TXNN	T1,IO.BKT	;OUT OF DISK SPACE
	$BOMB	<ACTECE Error (^O/T1/) while Creating or Extending the checkpoint file>
	PUSHJ	P,CPJCLS	;CLOSE THE FILE
	PUSHJ	P,CPJSAU	;RE-OPEN
	MOVE	T1,USEJOB+.RBSIZ ;AMOUNT THAT GOT CREATED
	ADDI	T1,177		;CONVERT TO BLOCKS
	LSH	T1,-7		;...
	SUBI	T1,JBOFFS	;ACCOUNT FOR THE GENERAL BLOCK
	IDIVI	T1,CPJIOB	;COMPUTE NUMBER OF JOBS THAT CAN BE DESCRIBED
	SKIPG	T1		;HOPE SO
	SETZ	T1,		;WHOOPS?
	MOVEM	T1,JOBMAX	;SAVE AS MAX JOBS WE WILL ALLOW
	$WTOXX	<Disk is too full, only ^D/JOBMAX/ jobs will be allowed to log in>
SYSIN1:	PUSHJ	P,READJG	;READ IN THE FILE HEADER
	PUSHJ	P,DATIM		;SET UP CURRENT DATE/TIME
	SKIPN	USGOSZ		;IF ZERO, THE WE JUST CREATED USAGE.OUT
	PUSHJ	P,MAKUFH	; SO MAKE A USAGE FILE HEADER RECORD
	PUSHJ	P,MAKRES	;MAKE A SYSTEM RESTART ENTRY
	MOVN	P1,CPJGEN+FILMJB ;MAXIMUM NUMBER OF JOBS IN THE FILE
	JUMPE	P1,SYSIN4	;DONE IF JUST CREATED THE FILE
	MOVE	T1,CPJGEN+FILBPJ ;GET NUMBER OF BLOCKS REQUIRED FOR EACH JOB
	MOVE	T2,CPJGEN+FILBPD ;GET NUMBER OF BLOCKS REQUIRED FOR DEVICES
	CAIN	T2,CPDIOB	;BETTER MATCH
	CAIE	T1,CPJIOB	;BETTER MATCH
	$BOMB	<ACTCFF Checkpoint File Format doesn't match this version of ACTDAE>
	HRLZS	P1		;FORM AOBJN
	HRRI	P1,1		;SKIP THE NULL JOB
	SETZM	SYSINC		;CLEAR COUNT OF JOBS STILL AROUND (ACTDAE RESTART)
SYSIN2:	HRRZM	P1,JOBNUM	;STORE JOB NUMBER
	PUSHJ	P,READJP	;READ IN THE CHECKPOINT INFORMATION
	SKIPN	CPJBUF+CJOB	;DO WE HAVE DATA FOR THIS JOB
	JRST	SYSIN3		;NO, TRY THE NEXT JOB
	HRL	T1,P1		;THE JOB NUMBER AGAIN
	HRRI	T1,.GTJLT	;JOB LOGIN TIME
	GETTAB	T1,		;THIS MIGHT BE AN ACTDAE RESTART INSTEAD OF
	  SETZ	T1,		; A SYSTEM RESTART, ONLY SOME WILL GET INCOMPLETE
	JUMPE	T1,SYSIN5	;JOB NOT THERE IF NO LOGIN TIME
	CAMN	T1,CPJBUF+CJLGTM ;THIS JOB STILL AROUND
	JRST	[AOS SYSINC	;YES, COUNT IT TO INDICATE ACTDAE RESTART
		 JRST SYSIN3]	;WILL CATCH THE JOB AT LOGOUT
SYSIN5:	PUSHJ	P,MKISES	;MAKE AN INCOMPLETE SESSION ENTRY
	SKIPE	CPJBUF+CDEVFL	;ANY DEVICES FOR THIS JOB
	PUSHJ	P,SYSIND	;GENERATE DEVICE ENTRIES
	PUSHJ	P,CBJZER	;CLEAR OUT THE JOB INFORMATION
	PUSHJ	P,CPJCOP	;IN BOTH PLACES
	PUSHJ	P,WRITJP	;CLEAN FILE NOW THAT WE ARE DONE WITH THIS JOB
SYSIN3:	AOBJN	P1,SYSIN2	;DO ALL POSSIBLE JOBS
	SETZM	JOBNUM		;JOB NUMBER 0 = SPINDLE  ENTRIES
	SKIPN	SYSINC		;IF ACTDAE RESTART, DONT DO SPINDLES HERE
	PUSHJ	P,SYSIND	;DO THEM NOW
SYSIN4:	PUSHJ	P,CPJCLS	;CLOSE OUT THE FILE NOW
	POPJ	P,		;AND ALL DONE WITH RESTART

SYSINC:	BLOCK	1		;COUNT/FLAG FOR ACTDAE-RESTART RATHER THAN SYSTEM RESTART

SYSIND:	HRROI	T1,INIDVS	;POINT TO ROUTINE
	PUSHJ	P,ALLDEV	;AND CALL IT FOR ALL DEVICES
	POPJ	P,		;AND RETURN

;FOLLOWING CO-ROUTINE CALLED BY ALLDEV FOR EACH DEVICE IN THE jjjDEV.BIN FILE
;P1 = THE DEVICE TYPE INDEX

INIDVS:	PUSHJ	P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
	PUSHJ	P,CBDZER	;CLEAR THE BLOCK
	PUSHJ	P,CPDCOP	;BOTH HALVES
	PUSHJ	P,WRITDP	;ZAP THE DISK AREA
	POPJ	P,		;AND RETURN FOR THE NEXT
;ACDINI - ROUTINE TO DO INITIALIZATION OF DISK (E.G., OPENING THE FILES
;	PROJCT.SYS, USEJOB.BIN, ACTDAE.SYS

ACDINI:	MOVE	T1,STATE2	;GET SECOND STATES WORD
	TXNN	T1,ST%ACV	;IF VALIDATION IS NOT REQUIRED DON'T DO
	JRST	ACDIN1		; PROJCT.SYS INITIALIZATION
	PUSHJ	P,PRJRED	;PROJCT.SYS INITIALIZATION
	SKIPF			;WHOOPS
	PUSHJ	P,BLDPRJ	;VERIFY VERSIONS, SIZES, BUILD TABLES
ACDIN1:	PUSHJ	P,INITIO##	;INIT FILE I/O (RMS-10 INTERFACE)
	SKIPT			;CHECK FOR ERRORS
	STOPCD	(IOF,HALT,,<File I/O interface initialization failure>)
	MOVEI	S1,ACCTFN	;GET FILENAME FOR RMS TO OPEN
	MOVEI	S2,1		;WANT TO WRITE THE FILE
	PUSHJ	P,OPNA##	;OPEN FILE "A" FOR I/O
	SKIPT			;MAKE SURE IT WORKED
	STOPCD	(AFF,HALT,,<Accounting file initialization failure>)
	PUSHJ	P,A$ISCD##	;INITIALIZE CLASS SCHEDULER MAPPING
	PUSHJ	P,CPJSAU	;INITIALIZE THE PRIMARY JOB CHECKPOINT FILE
	POPJ	P,
	SUBTTL	ACTDAE - GENERAL ROUTINES

;AUSETI - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
;	TO THE BLOCK NUMBER STORED IN T1 FOR INPUT
;CALL:	MOVE	T1,BLOCK NUMBER
;	HRL	T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
;	PUSHJ	P,AUSETI
;	ONLY RETURN (TRUE OR FALSE)

AUSETI:	MOVEM	T1,ACTUSE+1	;STORE THE BLOCK #
	HRRI	T2,.FOUSI	;GET THE USETI FUNCTION CODE
	MOVEM	T2,ACTUSE	;STORE IT
	MOVE	T1,[2,,ACTUSE]
	FILOP.	T1,
	  $RETF			;ERROR. GIVE A FALSE RETURN
	$RETT			;GIVE A TRUE RETURN

;AUSETO - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
;	TO THE BLOCK NUMBER STORED IN T1 FOR OUTPUT
;CALL:	MOVE	T1,BLOCK NUMBER
;	HRL	T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
;	PUSHJ	P,AUSETO
;	ONLY RETURN (TRUE OR FALSE)

AUSETO:	MOVEM	T1,ACTUSE+1	;STORE THE BLOCK #
	HRRI	T2,.FOUSO	;GET THE USETO FUNCTION CODE
	MOVEM	T2,ACTUSE	;STORE IT
	MOVE	T1,[2,,ACTUSE]
	FILOP.	T1,
	  $RETF			;ERROR. GIVE A FALSE RETURN
	$RETT			;GIVE A TRUE RETURN
	SUBTTL	ACTQUE - MODULE FOR QUEUE. UUO ROUTINES

;GENERAL DEFINITIONS

MYPPN:	BLOCK 1			;MY PPN FOR PRIV CHECKING
QUECNT:	0			;COUNT OF QUEUE ARGUMENT BLOCKS LEFT
QUEFLG:	0			;SET IF MESSAGE WAS FROM A QUEUE. UUO
QUEBLK:	0			;ADDRESS OF NEXT QUEUE. ARGUMENT BLOCK
QUEEND:	0			;ADDRESS JUST OFF THE END OF QUEUE. BLOCK
GFRFLG:	0			;FLAG FOR [SYSTEM]GOPHER AS THE SENDER
RMGUDT:	0			;UNIVERSAL DATE/TIME OF LAST RMS MESSAGE
RMGCOD:	0			;FATAL RMS ERROR CODE

;***DESCRIPTOR
ACONMD:	EXP -1			;THIS IS A NAME
	EXP ACOUSR		;POINT TO NAME BUFFER
;***

;****DESCRIPTOR
ACOPPD:	EXP 0			;THIS IS A PPN
ACOPPN:	BLOCK 1			;PPN WE ARE TALKING ABOUT
;****

ACOPRV:	BLOCK	1		;INDICATES USER IS PRIVED

VALZER:				;BEGINNING OF BLOCK TO ZERO (MAINTAIN ORDER)
VALBLK:	BLOCK	UV$ACE+1	;REBUILT QUEUE. VALIDATION MESSAGE
VALACT:	BLOCK	1		;FLAG THAT .UGACT BLOCK WAS GIVEN
ACOPSW:	BLOCK	.APWLW		;PASSWORD FOR ACCESS CONTROL
ACOTYP:	BLOCK	1		;TYPE OF ACCESS (0 = REGULAR, NON-0 = SPRINT)
ACOUXP:	BLOCK	1		;INDICATES USERNAME VS PPN BEING USED
ACOUSR:	BLOCK	.AANLW		;NAME WE ARE TALKING ABOUT
ACOPTR:	BLOCK	1		;POINTER TO A WILDCARD BLOCK
ACOWLD:	BLOCK	UW$MIN		;INTERNAL WILDCARD BLOCK
ACOACK:	BLOCK	.AANLW		;WILDCARD ACK BLOCK
ACOMAP:	BLOCK	1		;ADDRESS OF PPN/NAME MAPPING BLOCK
TMPMAP:	BLOCK	UU$LEN		;TEMPORARY MAPPING BLOCK
TMPLEN:	BLOCK	1		;LENGTH OF SUPPLIED NAME
TMPCNT:	BLOCK	1		;NUMBER OF MAPPING BLOCKS SUPPLIED

;***ACTRMS INTERFACE
ACOPRO:	BLOCK	.AEMAX		;BLOCK FOR USER PROFILE
ACODEF:	BLOCK	.AEMAX		;DEFAULT PROFILE STORAGE
ACODWL:	BLOCK	UW$MIN		;WILDCARD BLOCK FOR DEFAULTING
ACOBIT:	BLOCK	.AMPLW		;DEFAULTING BIT MAP
ACOBMP:	BLOCK	1		;POINTER INTO BIT MAP
;***

VALZND==.-1			;LAST WORD TO ZERO FOR VALIDATION REQUESTS

QUEADR:	BLOCK 1			;ADDRESS OF THE REBUILT DEFUS LIST FOR MAKING AN ENTRY
QUELEN:	BLOCK 1			;LENGTH OF THE CONTENTS OF QUEADR
QEXTRA==7			;EXTRA WORDS NEEDED TO COMPLETE AN ENTRY'S
				; INTERNAL DEFUS LIST BUILT AT THE CONTENTS OF
				; QUEADR:.  1) DISPATCH (UGENT$)  2. ENTRY TYPE
				; 3. TERMINATED WITH A ZERO WORD AND 4-7. PROVIDE
				; DEFUS'S FOR ACTDAE VERSION NUMBER AND THE DATE
				; AND TIME THE ENTRY IS MADE. SEE QUEENT ROUTINE.
	SUBTTL	ACTQUE - GENERAL ROUTINES FOR QUEUE. UUO SECTION

;QUECHK - ROUTINE TO CHECK IF MESSAGE IF FROM A QUEUE. UUO.  IF SO, MESSAGE
;	HAS A DIFFERENT FORMAT THAN THE MESSAGES DEFINED IN ACTSYM.MAC.

QUECHK:	SETZM	QUEFLG		;INITALIZE
	SETZM	GFRFLG		;ASSUME NOT FROM GOPHER
	SETZM	QUEBLK		;NO POINTER YET
	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.FG(T1)	;GET THE FLAGS
	TXNE	T2,IP.CFE!IP.CFM ;CHECK FOR ERRORS OR RETURNED MAIL
	$RETF			;PITCH THE MESSAGE
	SETZM	ACOPRV		;ASSUME NO DESIRE FOR PRIVS
	SETZM	ACKEFL		;ASSUME WANTS OLD ERROR ACKS
	MOVE	T2,MDB.SI(T1)	;GET THE SYSTEM INDEX WORD
	TXNN	T2,SI.FLG	;IS THIS FROM A SYSTEM PID?
	JRST	QUECH7		;NO. CHECK FUNCTION FOR FLAGS
	LOAD	T2,T2,SI.IDX	;YES. FETCH THE S-PID INDEX
	CAXE	T2,SP.GFR	;IS IT FROM [SYSTEM]GOPHER?
	JRST	QUECH7		;NO. JUST CHECK FUNCTION FOR FLAGS
	SETOM	GFRFLG		;YES. REMEMBER THAT IT'S FROM GOPHER
	MOVE	T1,MMSADR	;MESSAGE ADDRESS
	MOVE	T2,.MSTYP(T1)
	ANDX	T2,MS.TYP	;MESSAGE TYPE
	CAIE	T2,.IPCQU	;IS THIS FROM A QUEUE. UUO?
	$RETT			;NO. ASSUME ANOTHER FORMAT (E.G., LOGOUT MESSAGE)
	SETOM	QUEFLG		;REMEMBER IT'S A QUEUE. UUO
;	SETZM	QUEBLK		;INDICATE THE START OF NEW MESSAGE
QUECH1:	MOVE	T1,MMSADR	;MESSAGE ADDRESS
	PUSHJ	P,GETBLK	;GET NEXT QUEUE BLOCK
	JUMPF	.POPJ		;NO MORE BLOCKS, ASSUME BAD MESSAGE
	CAIE	T1,.QBFNC	;IS THIS THE FUNCTION BLOCK?
	JRST	QUECH1		;NO. LOOP UNTIL IT'S FOUND
	MOVE	T1,(T3)		;GET THE FUNCTION
	CAIN	T1,.QUVAL	;IS IT A VALIDATION MESSAGE?
	PJRST	QUEVAL		;YES. SET UP THE MESSAGE AND VALIDATE
	CAIE	T1,.QUMAE	;IS IT SOME KIND OF ACCOUNTING MESSAGE?
	$RETF			;NO. ASSUME ILLEGAL MESSAGE
QUECH2:	MOVE	T1,MMSADR	;GET THE NEXT QUEUE. BLOCK
	PUSHJ	P,GETBLK	; FOR ACCOUNTING SUBFUNCTION
	JUMPF	.POPJ		;ILLEGAL ACCOUNTING MESSAGE
	CAIE	T1,.QBAFN	;IS THIS THE RIGHT BLOCK?
	$RETF			;NO. DECLARE IT ILLEGAL ACCOUNTING MESSAGE
	MOVE	T1,(T3)		;GET THE SUBFUNCTION
	PUSHJ	P,QUECH8	;ANALYZE THE FLAGS
	$RETIF			;PROPAGATE FAILURE
	MOVSI	S1,-QUESIZ	;AOBJN POINTER
QUECH3:	HLRZ	S2,QUETAB(S1)	;GET ACCT MSG TYPE CODE
	CAIE	S2,(T1)		;A MATCH?
	AOBJN	S1,QUECH3	;SEARCH THE TABLE
	JUMPGE	S1,.RETF	;NO SUCH BEAST
	HRRZ	S2,QUETAB(S1)	;GET QUEUE. UUO CONVERSION ROUTINE ADDR
	PJRST	(S2)		;DISPATCH

QUECH7:	MOVE	T3,MMSADR	;GET MESSAGE ADDRESS
	LOAD	T1,(T3),MS.TYP	;GET FUNCTION CODE
QUECH8:	TRZE	T1,AF.CEA	;WANT NEW ERROR ACKS?
	SETOM	ACKEFL		;YES, REMEMBER THAT
	TRZN	T1,AF.PRV	;WANT PRIVS?
	JRST	QUECH9		;NO, SKIP IT
	PUSH	P,T1		;SAVE BITS
	PUSHJ	P,PRVADM	;CHECK FOR PRIVS
	POP	P,T1		;RESTORE
	$RETIF			;PROPAGATE FAILURE
	SETOM	ACOPRV		;YES, HE GETS PRIVS
QUECH9:	TRNN	T1,^-AF.FUN	;ANY RESERVED BITS ON?
	$RETT			;NO, HE WINS
	$RETF			;YES, HE LOSES
QUETAB:	UGVAL$,,QUEVLX		;VALIDATION
	UGLGN$,,QUELGN		;LOGIN
	UGSES$,,QUESES		;SESSION
	UGATT$,,QUEATT		;ATTACH
	UGENT$,,QUEENT		;MAKE AN ENTRY
	UGOUP$,,QUEACC		;ACCESS CONTROL
	UGACC$,,QUEACC		;ACCESS CONTROL
	UGCUP$,,QUECUP		;CHANGE USER PROFILE
	UGVRP$,,QUEACC		;CHANGE USER PROFILE
	UGPSW$,,QUEACC		;VERIFY PASSWORD
	UGLOK$,,QUEACC		;LOCK ACCOUNTING FILE
	UGUNL$,,QUEACC		;UNLOCK ACCOUNTING FILE
	UGSCD$,,QUEACC		;REREAD SCDMAP.INI
	UGWLD$,,QUEACC		;GET POSSIBLY WILDCARDED PPN OR NAME
	UGMAP$,,QUEACC		;MAP PPN/NAMES
QUESIZ==.-QUETAB		;LENGTH OF TABLE
; QUEATT - ATTACH MESSAGE
QUEATT:	MOVEI	T1,UA$ACK	;ACK CODE OFFSET
	PJRST	QUECOM		;ENTER COMMON CODE

; QUELGN - LOGIN MESSAGE
QUELGN:	MOVEI	T1,UL$ACK	;ACK CODE OFFSET
	PJRST	QUECOM		;ENTER COMMON CODE

; QUESES - SESSION MESSAGE
QUESES:	MOVEI	T1,US$ACK	;ACK CODE OFFSET
;	PJRST	QUECOM		;ENTER COMMON CODE


; QUECOM - COMMON ROUTINE TO CONVERT QUEUE. UUO MESSAGES TO NORMAL IPCF FORMAT
; CALL:	MOVE	T1, ACK CODE OFFSET IN QUEUE MSG
;	PUSHJ	P,QUECOM
;
; TRUE RETURN:	MESSAGE CONVERTED
; FALSE RETURN:	JUNK MESSAGE

QUECOM:	PUSH	P,T1		;SAVE ACK CODE OFFSET
	PUSHJ	P,GETBLK	;GET THE NEXT QUEUE. BLOCK
	JUMPF	QUECMF		;CHECK FOR ERRORS
	CAIE	T1,.QBAET	;ACCOUNTING ENTRY BLOCK?
	JUMPF	QUECMF		;BAD MESSAGE FORMAT
	MOVE	T1,DATADR	;POINT TO MESSAGE
	MOVE	T1,.MSCOD(T1)	;GET ACK CODE
	EXCH	T1,(P)		;SWAP ACK CODE WITH OFFSET
	ADDI	T1,(T3)		;INDEX INTO MESSAGE
	POP	P,(T1)		;MOVE ACK CODE
	MOVSI	T1,(T3)		;POINT TO DATA PORTION OF MESSAGE
	HRR	T1,DATADR	;AND TO START OF ACTUAL MESSAGE
	ADD	T2,DATADR	;COMPUTE END OF BLT
	BLT	T1,-1(T2)	;SLIDE MSG UP SO IT'S LIKE AN IPCF MSG
	$RETT			;AND RETURN

QUECMF:	POP	P,(P)		;PRUNE STACK
	$RETF			;RETURN
; ACK A QUEUE. UUO
; CALL:	PUSHJ	P,QUEACK
;
; TRUE RETURN:	OLD MESSAGE RELEASED, ACK SENT
; FALSE RETURN:	OLD MESSAGE RELEASED, GLXLIB ERROR CODE IN AC S1

QUEACK:	SKIPN	SABFLG		;STILL NEED TO DO THIS?
	PUSHJ	P,IPCREL	;YES. DO IT AND REMEMBER IT
	MOVE	T1,ACKCOD	;GET ACK CODE
	MOVEM	T1,ACKMSG+.MSCOD ;SAVE
	MOVEI	S1,SAB.SZ	;SEND ARGUMENT BLOCK LENGTH
	MOVEI	S2,IPS.BL	;SEND ARGUMETN BLOCK ADDRESS
	MOVE	T1,MDBADR	;GET MESSAGE DISCRIPTOR BLOCK
	MOVE	T1,MDB.SP(T1)	;SENDER'S PID
	MOVEM	T1,SAB.PD(S2)
	MOVEI	T1,ACKLEN	;LENGTH OF MESSAGE
	MOVEM	T1,SAB.LN(S2)
	MOVEI	T1,ACKMSG	;MESSAGE ADDRESS
	MOVEM	T1,SAB.MS(S2)
	$CALL	C%SEND		;ACK THE USER
	$RETIT			;RETURN IF NO ERRORS
	MOVE	T1,MDBADR	;POINT TO MDB
	$WTOXX	<^I/ACKTXT/>
	$RETF			;GIVE UP

ACKMSG:	$BUILD	(.OHDRS+ARG.SZ)		;SIZE OF MESSAGE
	  $SET	(.MSTYP,MS.CNT,ACKLEN)	;LENGTH OF MESSAGE
	  $SET	(.MSTYP,MS.TYP,.OMTXT)	;TEXT MESSAGE
	  $SET	(.MSFLG,MF.NOM,1)	;NO DATA IN MESSAGE (JUST AN ACK)
	  $SET	(.MSCOD,,0)		;ACK CODE (FILLED IN LATER)
	  $SET	(.OHDRS+ARG.HD,AR.LEN,2);TWO WORDS OF DATA
	  $SET	(.OHDRS+ARG.HD,AR.TYP,.CMTXT) ;TYPE OF DATA (TEXT)
	  $SET	(.OHDRS+ARG.DA,,0)	;NO TEXT
	$EOB				;END OF BLOCK
ACKLEN==.-ACKMSG			;LENGTH OF MESSAGE


ACKTXT:	ITEXT	(<Cannot ACK job ^D/MDB.PV(T1),MD.PJB/ ^U/MDB.SD(T1)/
Error: ^E/S1/>)
;QUEVAL - ROUTINE TO CONVERT A QUEUE. UUO VALIDATION MESSAGE INTO A FORMAT THE
;	ACCOUNT DAEMON AND FRIENDS ALREADY KNOW ABOUT.
;CALL:	MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
;	MMSADR/ADDRESS OF IPCF MESSAGE DATA
;	QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ

QUEVAL:	MOVEI	T1,UGVAL$	;TYPE OF ACCOUNT MESSAGE
	PUSHJ	P,PREVAL	;PREPARE VALIDATION BLOCKS
QUEVA1:	MOVE	T1,MMSADR	;MESSAGE ADDRESS
	PUSHJ	P,GETBLK	;GET THE NEXT QUEUE. BLOCK
	JUMPF	QUEVA3		;END OF BLOCK, BEGIN VALIDATION
	CAIE	T1,.QBOID	;IS IT A PPN?
	JRST	QUEVA2		;NO. SEE IF IT'S AN ACCOUNT BLOCK
	MOVE	T3,(T3)		;GET THE PPN
	MOVEM	T3,VALBLK+UV$PPN ;STORE THE PPN
	JRST	QUEVA1		;LOOK AT NEXT BLOCK
QUEVA2:	CAIE	T1,.QBACT	;IS THIS BLOCK AN ACCOUNT?
	JRST	QUEVA1		;NO. SEE IF WE'RE DONE
	HRLZ	S1,T3		;BLT THE ACCOUNT INTO VALBLK
	HRRI	S1,VALBLK+UV$ACT
	CAILE	T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
	MOVEI	T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
	BLT	S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
	JRST	QUEVA1		;LOOK AT NEXT BLOCK
QUEVA3:	MOVEI	T1,VALBLK
	MOVEM	T1,DATADR	;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
	$RETT

;SUBROUTINE TO PREPARE VALIDATION BLOCKS FOR QUEUE. FUNCTIONS
;CALL:	T1/MESSAGE TYPE TO FILL INTO THE BLOCK

PREVAL:	SETZM	VALZER		;ZERO THE BLOCKS
	MOVE	S1,[VALZER,,VALZER+1]
	BLT	S1,VALZND	;CLEAR THE WHOLE THING
	MOVEM	T1,VALBLK+UV$TYP ;STORE TYPE OF MESSAGE
	POPJ	P,		;AND RETURN
;QUEACC - ROUTINE TO EXTRACT ACCESS CONTROL INFORMATION FROM THE QUEUE. BLOCKS
;CALL:	T1/ FUNCTION CODE
;	MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
;	MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
;	QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ

QUEACC:
	PUSHJ	P,PREVAL	;PREPARE THE INTERNAL BLOCK
QUEACT:	MOVE	T1,MMSADR	;MESSAGE ADDRESS
	PUSHJ	P,GETBLK	;GET THE NEXT QUEUE. BLOCK
	JUMPF	QUEACX		;END OF BLOCK, BEGIN VALIDATION
QUEAC0:	CAIE	T1,.UGTYP	;IS THIS BLOCK THE ACCESS TYPE
	JRST	QUEAC1		;NO, LOOK AT NEXT BLOCK
	MOVE 	T3,(T3)		;GET TYPE ARGUMENT
	MOVEM	T3,ACOTYP	;STORE
	JRST	QUEACT		;LOOK AT THE NEXT BLOCK
QUEAC1:	CAIE	T1,.UGACT	;IS THIS BLOCK AN ACCOUNT?
	JRST	QUEAC2		;NO. SEE IF ITS A PPN BLOCK
	HRLZ	S1,T3		;BLT THE ACCOUNT INTO VALBLK
	HRRI	S1,VALBLK+UV$ACT
	CAILE	T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
	MOVEI	T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
	BLT	S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
	SETOM	VALACT		;NOTE THAT WE GOT HERE
	JRST	QUEACT		;LOOK AT NEXT BLOCK
QUEAC2:	CAIE	T1,.UGPPN	;IS IT A PPN?
	JRST	QUEAC3		;NO. SEE IF IT'S A PASSWORD BLOCK
	MOVEM	T1,ACOUXP	;INDICATE WE GOT A PPN
	MOVE	T3,(T3)		;GET THE PPN
	MOVEM	T3,VALBLK+UV$PPN ;STORE THE PPN
	MOVEM	T3,ACOPPN	;STASH HERE TOO
	JRST	QUEACT		;LOOK AT NEXT BLOCK
QUEAC3:	CAIE	T1,.UGPSW	;IS THIS BLOCK THE PASSWORD
	JRST	QUEAC4		;NO. SEE IF ITS A USERNAME
	HRLZ	S1,T3		;BLT THE PASSWORD INTO ACOPSW
	HRRI	S1,ACOPSW
	CAILE	T2,.APWLW	;MAKE SURE NOT LONGER THAN MAX
	MOVEI	T2,.APWLW	;MAKE MAXIMUM LENGTH IF SO
	BLT	S1,ACOPSW-1(T2)	;COPY THE PASSWORD
	JRST	QUEACT		;LOOK AT NEXT BLOCK
QUEAC4:	CAIE	T1,.UGUSR	;IS THIS BLOCK THE USERNAME
	JRST	QUEACT		;NOPE, IGNORE IT THEN
	MOVEM	T1,ACOUXP	;INDICATE WE GOT A USERNAME
	HRLZ	S1,T3		;BLT THE USERNAME INTO ACOPSW
	HRRI	S1,ACOUSR
	CAILE	T2,.AANLW	;MAKE SURE NOT LONGER THAN MAX
	MOVEI	T2,.AANLW	;MAKE MAXIMUM LENGTH IF SO
	BLT	S1,ACOUSR-1(T2)	;COPY THE NAME
	JRST	QUEACT

QUEACX:	MOVEI	T1,VALBLK
	MOVEM	T1,DATADR	;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
	$RETT
;QUECUP - ROUTINE TO CONVERT A QUEUE. UUO UGCUP$ MESSAGE TO A NORMAL ONE

QUECUP:	MOVE	T2,QUEBLK	;POINTER TO NEXT DATA BLOCK
	SUBI	T2,.OHDRS	;BACK UP BY GALACTIC HEADER
	MOVE	T3,QUECNT	;NUMBER OF ARG BLOCKS REMAINING
	MOVEM	T3,.OARGC(T2)	;SETUP AS IF ORION HAD TOLD US
	HRRM	T1,(T2)		;STORE THE FUNCTION CODE
	MOVE	T3,DATADR	;GET MESSAGE ADDRESS
	MOVE	T3,1(T3)	;GET ACK CODE
	MOVEM	T3,1(T2)	;SAVE HERE
	SETZM	.OFLAG(T2)	;NO FLGS
	MOVEM	T2,DATADR	;SAVE FOR OTHERS
	$RETT			;RETURN
;QUEENT - ROUTINE TO CONVERT A QUEUE. UUO 'MAKE AN ENTRY' MESSAGE INTO A
;	FORMAT THE ACCOUNT DAEMON ALREADY KNOWS ABOUT (FORMAT IS CALLED A
;	DEFUS DATA LIST).
;CALL:	MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
;	MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
;	QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ

QUEENT:	$CALL	.SAVE1
	MOVE	T1,MMSADR	;GET THE TOTAL NUMBER OF QUEUE. BLOCKS
	MOVE	S1,.OARGC(T1)	;REBUILT MESSAGE WILL HAVE 2 WORDS/BLOCK,
	IMULI	S1,2
	ADDI	S1,QEXTRA	;SEE COMMENTS AT QEXTRA DEFINITION FOR EXTRA
				; SPACE NEEDED
	$CALL	M%GMEM		;GET SPACE NEEDED TO BUILD AN INTERNAL DEFUS LIST
	MOVEM	S1,QUELEN	;STORE THE LENGTH FOR RELEASING MEMORY
	MOVEM	S2,QUEADR	;STORE THE ADDRESS
	MOVEM	S2,DATADR
	MOVE	P1,S2
	MOVEI	T1,UGENT$	;"MAKE AN ENTRY" DISPATCH VALUE FOR ACTDSP
	MOVEM	T1,(P1)
	AOS	P1
	MOVE	T1,MMSADR	;GET THE NEXT QUEUE. BLOCK
	PUSHJ	P,GETBLK
	JUMPF	QUEEN3		;ILLEGAL MESSAGE IF NO MORE
	CAIE	T1,.QBAET	;BLOCK TYPE MUST BE ENTRY TYPE BLOCK
	JRST	QUEEN3		;OTHERWISE DECLARE IT AN ILLEGAL MESSAGE
	MOVE	T1,(T3)		;GET THE ENTRY TYPE
	MOVEM	T1,(P1)		;STORE IT
	AOS	P1		;STEP TO THE NEXT WORD
QUEEN1:	MOVE	T1,MMSADR
	PUSHJ	P,GETBLK	;GET THE NEXT QUEUE. BLOCK
	JUMPF	QUEEN2		;NO MORE BLOCKS. FINISH UP AND RETURN
	CAIN	T1,.USTAD	;CURRENT DATE/TIME IS ALWAYS PROVIDED BY ACTDAE
	JRST	QUEEN1		;GO READ NEXT BLOCK
	CAIN	T1,.USAMV	;AS IS THE ACCOUNT DAEMON'S VERSION NUMBER
	JRST	QUEEN1		;READ THE NEXT BLOCK
	TXO	T1,1B0		;HANDLE THE ZERO DEFUS CASE
	MOVEM	T1,(P1)		;STORE THE DEFUS NUMBER
	MOVEM	T3,1(P1)	;THIS IS THE ADDRESS WHERE THE DATA IS FOUND
	ADDI	P1,2		;COUNT THE TWO WORDS JUST FILLED
	JRST	QUEEN1		;READ THE NEXT QUEUE. BLOCK
QUEEN2:	PUSHJ	P,QEXFIL	;PROVIDE THE ACTDAE-ONLY DATA
	SETZM	(P1)		;MUST TERMINATE WITH A ZERO WORD
	$RETT
QUEEN3:	MOVE	S1,QUELEN	;MUST RETURN SPACE WE GOT FOR THE MESSAGE
	MOVE	S2,QUEADR	;...
	$CALL	M%RMEM		;GIVE IT BACK IF THE MESSAGE IS BAD
	$RETF			;AND PITCH THE MESSAGE
;QUEVLX - ROUTINE TO CONVERT VALIDATION MESSAGES
;CALL:	MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
;	MMSADR/ADDRESS OF IPCF MESSAGE DATA
;	QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ

QUEVLX:	MOVEI	T1,UGVAL$	;TYPE OF ACCOUNT MESSAGE
	PUSHJ	P,PREVAL	;PREPARE VALIDATION BLOCKS
	PUSHJ	P,GETBLK	;GET THE NEXT QUEUE. BLOCK
	$RETIF			;CHECK FOR ERRORS
	CAIE	T1,.QBAET	;ACCOUNTING ENTRY BLOCK?
	$RETF			;BAD MESSAGE FORMAT
	HRLZ	T2,T3		;POINT TO VALIDATION BLOCK IN MESSAGE
	HRRI	T2,VALBLK	;MAKE A BLT POINTER
	BLT	T2,VALBLK+UV$ACE ;COPY
	MOVEI	T1,VALBLK	;POINT TO OUR VALIDATION BLOCK
	MOVEM	T1,DATADR	;SAVE ADDRESS
	SETOM	MVBFLG		;REMEMBER TO MOVE THE WHOLE BLOCK
	$RETT			;RETURN
;QEXFIL - ROUTINE TO PROVIDE ACCOUNT-DAEMON-ONLY DATA IN THE INTERNAL DEFUS LIST.

QEXFIL:	MOVEI	T1,.USTAD	;DATE/TIME ENTRY IS MADE IS ALWAYS GIVEN BY ACTDAE
	MOVEM	T1,(P1)		;STORE ITS DEFUS NUMBER
	PUSHJ	P,DATIM		;FILL IN CURRENT DATE AND TIME
	MOVEI	T1,CURDTM	;ADDRESS WHERE THE DATE/TIME WILL BE STORED
	MOVEM	T1,1(P1)
	ADDI	P1,2		;ADJUST P1 FOR NEXT ITEM
	MOVEI	T1,.USAMV	;THE ACCOUNTING MODULE'S VERSION NUMBER
	MOVEM	T1,(P1)		;STORE THE DEFUS NUMBER
	MOVEI	T1,.JBVER	;ADDRESS WHERE IT'S STORED
	MOVEM	T1,1(P1)
	ADDI	P1,2		;ADJUST P1
	POPJ	P,
;GETBLK - ROUTINE TO FIND THE NEXT QUEUE. ARGUMENT BLOCK (MATCHES A$GBLK IN QSRADM.MAC)
;CALL:	T1/ THE MESSAGE ADDRESS
;RETURN	T1/ THE BLOCK TYPE
;	T2/ THE LENGTH OF THE DATA IN THE BLOCK
;	T3/ THE ADDRESS OF THE DATA IN THE BLOCK
;	FALSE IF NO MORE BLOCKS

GETBLK:	SKIPE	S1,QUEBLK	;GET THE BLOCK ADDRESS IF THERE IS ONE
	JRST	GETBL1		;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
	MOVE	S1,.OARGC(T1)	;GET THE MESSAGE BLOCK COUNT
	MOVEM	S1,QUECNT	;AND SAVE IT
	LOAD	S1,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
	ADDI	S1,(T1)		;POINT OFF THE END
	MOVEM	S1,QUEEND	;SAVE FOR LIMIT COMPUTATIONS
	MOVE	S1,MDBADR	;GET DESCRIPTOR BLOCK ADDRESS
	LOAD	T2,MDB.MS(S1),MD.CNT ;GET MESSAGE SIZE
	LOAD	S1,MDB.MS(S1),MD.ADR ;AND ADDRESS
	ADD	S1,T2		;A DIFFERENT IDEA OF THE END
	CAMGE	S1,QUEEND	;IS THIS MORE RESTRICTIVE?
	MOVEM	S1,QUEEND	;YES, DON'T ILL MEM REF
	MOVEI	S1,.OHDRS+ARG.HD(T1)	;IF NOT,,GET THE FIRST ONE
GETBL1:	CAMGE	S1,QUEEND	;DON'T ADVANCE PAST THE END
	SOSGE	QUECNT		;CHECK THE BLOCK COUNT
	$RETF			;NO MORE,,JUST RETURN
	LOAD	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	MOVEI	T3,ARG.DA(S1)	;POINT TO THE ACTUAL DATA
	ADD	S1,T2		;POINT TO THE NEXT BLOCK
	MOVEM	S1,QUEBLK	;SAVE IT FOR THE NEXT TIME AROUND
	CAMG	S1,QUEEND	;BEYOND THE LIMIT?
	SOJA	T2,.RETT	;T2 NOW ONLY REFLECTS DATA LENGTH, GOOD RETURN
	$RETF			;MESSAGE IS BAD

;GETBLF - ROUTINE TO RETURN BLOCK TYPE & FLAGS
;CALL:	LIKE GETBLK
;RETURN:	T1 HAS THE BLOCK TYPE, MASKED DOWN TO A PROFILE ENTRY OFFSET
;		S2 HAS THE SELECTION FLAGS THAT WERE MASKED OFF OF T1

GETBLF:	PUSHJ	P,GETBLK	;GET THE BLOCK INFO
	$RETIF			;PROPAGATE FAILURE
	MOVE	S2,T1		;COPY BLOCK TYPE
	ANDI	T1,AF.OFS	;KEEP ONLY OFFSET HERE
	TRZ	S2,AF.OFS	;AND ONLY BITS HERE
	POPJ	P,		;RETURN GOODNESS


;FNDBLK - ROUTINE TO FIND ANY QUEUE. ARGUMENT BLOCK IN A MESSAGE
;CALL:	T1/ THE MESSAGE ADDRESS
;	T2/ THE TYPE OF BLOCK WE WANT
;RETURN	T1/ THE ADDRESS WHERE THE BLOCK STARTS (OR FALSE IF NOT FOUND)

FNDBLK:	$CALL	.SAVE2		;SAVE P1,P2
	LOAD	P1,.OARGC(T1)	;GET THE MESSAGE ARGUMENT COUNT
	MOVE	P2,T2		;SAVE THE BLOCK TYPE
	MOVEI	S1,.OHDRS(T1)	;POINT TO THE FIRST BLOCK
	LOAD	TF,.MSTYP(T1),MS.CNT	;GET THE MESSAGE LENGTH
	CAXLE	TF,PAGSIZ	;CAN'T BE GREATER THEN A PAGE
	$RETF			;ELSE THATS AN ERROR
	ADD	TF,T1		;POINT TO THE END OF THE MESSAGE
FNDBL1:	LOAD	S2,ARG.HD(S1),AR.TYP	;GET THIS BLOCK TYPE
	CAMN	S2,P2		;IS IT THE BLOCK HE WANTS ???
	JRST	[MOVE T1,S1	;YES, MOVE ADDRESS TO RETURN AC
		 $RETT]		;AND RETURN GOOD
	LOAD	S2,ARG.HD(S1),AR.LEN	;NO,,GET THIS BLOCKS LENGTH
	ADD	S1,S2		;POINT TO THE NEXT BLOCK
	CAIG	TF,0(S1)	;ARE WE STILL IN THE MESSAGE ???
	$RETF			;NO,,RETURN BLOCK NOT FOUND
	SOJG	P1,FNDBL1	;CONTINUE TILL DONE
	$RETF			;NOT FOUND
	SUBTTL	ACTVER - GENERAL DEFINITIONS FOR ACCOUNT VALIDATION MODULE


;ACCOUNT VALIDATION MODULE DEFINITIONS
PPN:	BLOCK 1			;PPN TO BE VALIDATED
PRJCHN:	BLOCK 1			;LH=CHANNEL # FOR PROJCT.SYS, RH=0
PRJBLK:	BLOCK 10		;FILOP. BLOCK FOR PROJCT.SYS
PROJCT:	BLOCK 36		;LOOKUP BLOCK
PRJBUF:	BLOCK PRJWPB		;BUFFER FOR READING PROJCT.SYS IN DUMP MODE
IOLIST:	BLOCK 2			;I/O LIST FOR READING PROJCT.SYS

Z.DATE:	BLOCK 1		;CREATION DATE/TIME OF PROJCT.SYS WHICH TABLE WAS BUILT FOR
Z.TADR:	BLOCK 1		;ADDRESS OF FIRST WORD OF TABLE IN LOW SEGMENT
Z.TLEN:	BLOCK 1		;LENGTH OF TABLE LAST READ (IN WORDS)
BLKNUM:	BLOCK 1		;LOCATION TO SAVE LAST BLOCK NUMBER READ FROM PROJCT.SYS
LSTBLK:	BLOCK 1		;BLOCK NUMBER OF LAST BLOCK WHERE ENTRIES ARE FOUND IN PROJCT.SYS
PRJIOW:	BLOCK 1		;NEGATIVE WORDS PER LOGICAL DISK BLOCK IN PROJCT.SYS
PRJMUL:	BLOCK 1		;MULTIPLIER FOR LOGICAL TO REAL DISK BLOCKS
PRJCON:	BLOCK 1		;CONSTANT FOR COMPUTING PHYS BLOCK FROM LOGICAL BLOCK
PRJVRS:	BLOCK 1		;VERSION NUMBER OF PROJCT.SYS WE ARE READING
ACKCOD:	BLOCK 1		;ACKNOWLEDGMENT CODE USED BY THE REQUESTOR
	SUBTTL	ACTVER - FORMAT OF PROJCT.SYS


BLKOFS==1	;OFFSET INTO THE BLOCK WHERE THE FIRST ENTRY IS
PPNOFS==1	;OFFSET INTO THE ENTRY WHERE PPN CAN BE FOUND
CNTOFS==2	;OFFSET FROM THE PPN WHERE THE CHARACTER COUNT OF THE
		; ACCOUNT STRING CAN BE FOUND
ACTOFS==3	;OFFSET FROM THE PPN WHERE THE ACCOUNT STRING CAN BE FOUND

;FOLLOWING IS THE FORMAT OF THE FIRST BLOCK OF PROJCT.SYS.  THIS BLOCK
;	CONTAINS FILE AND DATA INFORMATION.  THIS TOTAL BLOCK HAS BEEN
;	RESERVED SPECIFICALLY FOR THIS PURPOSE.

A.VERS==0	;(0) VERSION # OF FORMAT.  MUST AGREE WITH ACVERS
A.TLEN==1	;(1) LENGTH OF TABLE IN STORED IN PROJCT.SYS
A.FBLK==2	;(2) BLOCK NUMBER OF TABLE IN FILE
A.WPBL==3	;(3) NUMBER OF WORDS PER LOGICAL DISK BLOCK (PRJWPB)


;***************************************************************
;	This is the format of the first block of PROJCT.SYS
;***************************************************************

;	!=======================================================!
;	!            Version # of PROJCT.SYS format             !
;	!-------------------------------------------------------!
;	!         Length of table stored in PROJCT.SYS          !
;	!-------------------------------------------------------!
;	!          Block number of table in PROJCT.SYS          !
;	!-------------------------------------------------------!
;	!        Number of words per logical disk block         !
;	!=======================================================!

;***************************************************************
;	End of the first block of PROJCT.SYS
;***************************************************************



;***************************************************************
;	Format of table pointed to by third word of first block
;***************************************************************


;	!=======================================================!
;	!          First PPN found in first data block          !
;	!-------------------------------------------------------!
;	!               Block number where PPN is               !
;	!-------------------------------------------------------!
;	!         First PPN found in second data block          !
;	!-------------------------------------------------------!
;	!               Block number where PPN is               !
;	!-------------------------------------------------------!
;	\                                                       \
;	\                                                       \
;	\                                                       \
;	!-------------------------------------------------------!
;	!          First PPN found in last data block           !
;	!-------------------------------------------------------!
;	!               Block number where PPN is               !
;	!=======================================================!


;***************************************************************
;	End of table format
;***************************************************************



;***************************************************************
;	Format of a block of data pointed to by entries in the table
;***************************************************************


;	!=======================================================!
;	!          Number of words used in this block           !
;	!=======================================================!
;	!    Length of PPN entry    !  Length of account entry  !
;	!-------------------------------------------------------!
;	!                          PPN                          !
;	!-------------------------------------------------------!
;	!                    Wild card mask                     !
;	!-------------------------------------------------------!
;	!Character count in account !           Flags           !
;	!-------------------------------------------------------!
;	\                    Account string                     \
;	\                                                       \
;	\                                                       \
;	!-------------------------------------------------------!
;	!             0             !  Length of account entry  !
;	!-------------------------------------------------------!
;	!                          PPN                          !
;	!-------------------------------------------------------!
;	!                    Wild card mask                     !
;	!-------------------------------------------------------!
;	!Character count in account !           Flags           !
;	!-------------------------------------------------------!
;	\                    Account string                     \
;	\                                                       \
;	!=======================================================!
;	!    Length of PPN entry    !  Length of account entry  !
;	!-------------------------------------------------------!
;	!                          PPN                          !
;	!-------------------------------------------------------!
;	!                    Wild card mask                     !
;	!-------------------------------------------------------!
;	!Character count in account !           Flags           !
;	!-------------------------------------------------------!
;	\                    Account string                     \
;	\                                                       \
;	!-------------------------------------------------------!
;	!             0             !  Length of account entry  !
;	!-------------------------------------------------------!
;	!                          PPN                          !
;	!-------------------------------------------------------!
;	!                    Wild card mask                     !
;	!-------------------------------------------------------!
;	!Character count in account !           Flags           !
;	!-------------------------------------------------------!
;	\                    Account string                     \
;	\                                                       \
;	!=======================================================!



;***************************************************************
;	End of format of a block of data
;***************************************************************
	SUBTTL	ACTVER - MAIN VALIDATION ROUTINE

ACTVER:	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	MOVE	T2,DATADR	;GET THE ADDRESS OF THE MESSAGE DATA
	MOVE	T1,UV$ACK(T2)	;GET THE ACK CODE FOR THE REQUESTOR
	MOVEM	T1,ACKCOD	; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
	MOVE	T1,UV$PPN(T2)	;GET THE PPN TO BE VALIDATED
	MOVEM	T1,PPN		;SAVE IT FOR LATER
	JUMPG	T1,ACTVCM	;IS IT A LEGAL PPN?
	PUSHJ	P,ERROR2	;NO.
	JUMPF	ACTVE1		;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTVCM:	MOVE	T1,STATE2	;GET THE SECOND STATES WORD
	TXNN	T1,ST%ACV	;IS VALIDATION REQUIRED?
	JRST	ACTVE1		;NO. GIVE A SUCCESSFUL RETURN
	MOVE	T2,MDBADR	;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
	MOVE	T1,MDB.FG(T2)	;FLAGS OF THE MESSAGE
	TXNE	T1,IP.CFP	;HAS THE SENDER SET THE PRIV BIT?
	JRST	ACTVE5		;YES. ASSUME HE'S TRYING TO BREAK THE SYSTEM
	MOVE	T1,MDB.PV(T2)	;GET THE SENDER'S CPABILITIES
	TXNE	T1,MD.PWH!MD.POP ;IS THE SENDER J.ACCT'D OR A SYSTEM OPERATOR?
	JRST	ACTVE4		;YES. ALLOW ALL KINDS OF VALIDATION
	MOVE	T1,MDB.SD(T2)	;GET THE SENDER'S PPN
	CAMN	T1,PPN		;DOES HE WANT TO VALIDATE FOR HIMSELF?
	JRST	ACTVE4		;YES. ALLOW ONLY THAT
ACTVE5:	PUSHJ	P,ERROR3	;UNPRIVILEGED USER CANNOT VALIDATE FOR OTHER PPNS
	JUMPF	ACTVE8		;[153]
ACTVE4:	MOVE	T1,DATADR	;GET ADDRESS OF DATA
	ADDI	T1,UV$ACT	;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
	LDB	T1,[POINT 7,(T1),6]	;GET THE FIRST CHARACTER OF ACCOUNT
	JUMPN	T1,ACTVE6	;ALWAYS VALIDATE A NON-NULL ACCOUNT
	PUSHJ	P,CHKDEF	;SEE IF DEFAULT EXISTS FOR NULL ACCOUNT, THIS PPN
	JUMPT	ACTVE1		;THERE IS, MUST BE VALID, RETURN IT TO CALLER
	PUSHJ	P,CHKACT	;NO DEFAULT, IS VALIDATION REQUIRED?
	JUMPF	ACTVE1		;NOT REQUIRED

ACTVE6:	PUSHJ	P,CHKPRJ	;VALIDATE THE ACCOUNT
	SKIPF			;[153]
ACTVE1:	SKIPA	T3,[UGTRU$]	;[153] GET SUCCESS CODE
ACTVE8:	MOVEI	T3,UGFAL$	;[153] GET FAILURE CODE
	SKIPE	QUEFLG		;WAS THIS FROM A QUEUE. UUO?
	JRST	[JUMPF ACTVXT
		MOVE T1,VALBLK+UV$TYP ;WHAT DOES HE WANT BACK?
		CAIN T1,UGVRP$	;USER PROFILE?
		SKIPA T1,[-2]	;YES, "ERROR" -2, MOVE USER PROFILE
		SETO T1,	;GET A -1 (NOT REALLY AN ERROR NUMBER)
		AOSN  MVBFLG	;MOVE WHOLE VALIDATION BLOCK?
		MOVNI T1,3	;YES
		PUSHJ P,ERRQUE	;GENERATE NEGATIVE "ERROR"
		JRST	ACTVXT]	;RELEASE OLD MSG AND SEND QUEUE UUO RESPONSE
	MOVE	T2,SABADR	;[153] GET MESSAGE PAGE ADDRESS
	MOVEM	T3,UC$RES(T2)	;[153] SAVE VALIDATION RESPONSE
	MOVE	S1,DATADR	;GET DATA ADDRESS
	MOVEI	T1,UGVUP$	;GET VALIDATE ACCOUNT AND RETURN PROFILE CODE
	CAME	T1,UV$TYP(S1)	;WAS IT?
	JRST	ACTVE3		;[153] NO
	MOVEI	T1,UGFAL$	;[153] YES, ASSUME CANNOT GET PROFILE
	MOVEM	T1,UC$PRF(T2)	;[153]
        MOVE	T1,PPN		;YES, GET PPN
	PUSHJ	P,GETPRO	;FETCH PROFILE
	JUMPF	ACTVE3		;[153]
	MOVEI	T1,UGTRU$	;[153] GET SUCCESS CODE
	MOVEM	T1,UC$PRF(T2)	;[153] SAY THERE'S A PROFILE
	MOVEI	T1,UC$PRO(T2)	;GET TARGET ADDRESS
	HRLI	T1,ACOPRO	;GET START OF PROFILE
	BLT	T1,UC$PRE(T2)	;COPY PROFILE
ACTVE3:	CAIE	T3,UGTRU$	;[153] ACCOUNT VALIDATION SUCCESSFUL?
	JRST	ACTVXT		;[153] NO
	MOVE	T1,DATADR	;INCOMING MESSAGE
	HRLI	T1,UV$ACT(T1)	;ORIGINAL (OR MODIFIED) ACCOUNT STRING
	HRRI	T1,UC$ACT(T2)	;THE RESPONSE FIELD OF THE IPCF MESSAGE
	BLT	T1,UC$ACE(T2)	;RETURN IT TO THE SENDER
	CAIA			;DONE

ACTVXX::PUSHJ	P,UPDDSK	;PASWORD WAS (NOT) VALIDATED, SAVE DATE/TIME
ACTVXT::SKIPE	QUEFLG		;WAS THIS FROM A QUEUE. UUO?
	JRST	[PUSHJ P,FIXQUE	;YES, BUILD THE REST OF THE MESSAGE
		JRST ACTVE7]	;RELEASE MESSAGE AND SEND RESPONSE
	MOVE	T2,SABADR	;GET THE PAGE ADDRESS WE WANT TO SEND
	MOVEI	T1,UGVAC$	;GET THE MESSAGE TYPE
	MOVEM	T1,UC$TYP(T2)
	MOVE	T1,ACKCOD	;GET THE ACK CODE
	MOVEM	T1,UC$ACK(T2)	;STORE IT FOR THE REQUESTOR
ACTVE7:	SKIPN	SABFLG		;STILL NEED TO RELEASE THE MESSAGE?
	PUSHJ	P,IPCREL	;YES. DO IT AND REMEMBER IT

;HERE TO SEND RESPONSE POINTED TO BY SABADR TO THE USER OR THE MONITOR

RSPSAB:	MOVE	T1,MDBADR	;GET THE ADDRESS OF THE MDB
	MOVE	T1,MDB.SP(T1)	;GET THE PID OF THE SENDER
	MOVEM	T1,IPS.BL+SAB.PD;STORE IT IN THE SEND ARGUMENT BLOCK
	MOVEI	T1,1000		;MAXIMUM LENGTH OF MESSAGE
	MOVEM	T1,IPS.BL+SAB.LN
	MOVE	T1,SABADR	;ADDRESS OF DATA
	MOVEM	T1,IPS.BL+SAB.MS
	MOVEI	S1,SAB.SZ	;LENGTH OF SEND ARGUMENT BLOCK
	MOVEI	S2,IPS.BL	;ADDRESS OF SEND ARGUMENT BLOCK
	$CALL	C%SEND		;SEND THE MESSAGE
	JUMPT	.POPJ		;RETURN IF SEND WENT OK
	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.SD(T1)	;SENDER'S PPN
	MOVE	T3,MDB.PV(T1)
	ANDX	T3,MD.PJB	;JOB NUMBER OF SENDER
	$WTOXX	<Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
	MOVE	S1,SABADR	;ADDRESS OF PAGE TO RETURN TO POOL
	$CALL	M%RPAG		;RETURN THE PAGE
	$RETT

;SUBROUTINE TO MAKE THE MESSAGE POINTED TO BY SABADR INTO A QUEUE. UUO RESPONSE

FIXQUE:	MOVE	T2,SABADR	;GET ADDRESS OF MESSAGE TO SEND
	LOAD	T1,.MSTYP(T2),MS.CNT	;GET THE CURRENT WORD COUNT
	ADDI	T1,.OHDRS	;ADD IN THE MESSAGE HEADER LENGTH
	STORE	T1,.MSTYP(T2),MS.CNT
	MOVEI	T1,.OMTXT	;MESSAGE TYPE TO RESPOND TO QUEUE. UUO
	STORE	T1,.MSTYP(T2),MS.TYP
	MOVE	T3,MMSADR	;ADDRESS OF MESSAGE QUEUE. UUO SEND US
	MOVE	T3,.MSCOD(T3)	;GET THE ACK CODE SEND TO US
	MOVEM	T3,.MSCOD(T2)	;MAKE SURE THE RIGHT USER GETS IT
	$RETT


	;ROUTINE TO UPDATE DISK WITH RECORD IN ACOPRO TO INDICATE THAT
	;PASSWORD VALIDATION DID (NOT) SUCCEED.  BE SURE WE GET HERE ONLY
	;IF BUFFER IS VALID, ELSE RMS WILL HAPPILY REPLACE THE CURRENT REC...

UPDDSK:	MOVEI	S1,ACOPRO	;POINT AT THE PROFILE
	PUSHJ	P,UPDA##	;UPDATE FILE "A"
	$RET			;NOT MUCH WE CAN DO
ACTACC:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	IGNORE		;WASN'T. RELEASE MESSAGE AND IGNORE IT
	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	PUSHJ	P,CVTWLD	;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	PUSHJ	P,PROFIL	;FETCH PROFILE
	JUMPF	[SKIPN	S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
		 JRST	ACTACA	;NOT FATAL--NO SUCH USER
		 PJRST	RMGERX]	;FATAL--SEND RESPONSE
	MOVEI	S2,ACOPRO	;POINT TO THE RETURNED PROFILE
	MOVE	S1,.AEPPN(S2)	;GET THE PPN
	MOVEM	S1,ACOPPN	;SAVE IN PPN PLACE
	MOVE	T2,DATADR	;GET THE ADDRESS OF THE MESSAGE DATA
	MOVE	T1,UV$ACK(T2)	;GET THE ACK CODE FOR THE REQUESTOR
	MOVEM	T1,ACKCOD	; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
	MOVE	T1,ACOPPN	;GET THE PPN TO BE VALIDATED
	MOVEM	T1,UV$PPN(T2)	;STORE IT HERE
	MOVEM	T1,PPN		;SAVE IT FOR LATER
	JUMPG	T1,ACTAC1	;IS IT A LEGAL PPN?

ACTACA:	PUSHJ	P,ERROR2	;NO.
	JUMPF	ACTVXT		;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE

ACTAC1:	MOVEI	T1,ACOPRO	;POINT TO PROFILE
	MOVE	S1,ACOTYP	;GET TYPE OF CHECK TO MAKE
	CAIN	S1,UG.SPV	;SPRINT TYPE CHECK?
	SKIPA	T2,[AE.PRB]	;SPRINT, GET PASSWORD FOR BATCH BIT
	MOVX	T2,AE.PRT	;NORMAL, GET PASSWORD FOR TS BIT
	TDNN	T2,.AEREQ(T1)	;SEE IF PASSWORD IS REQUIRED
	PJRST	ACTVCM		;NO, SKIP THIS, GO CHECK ACCOUNT STRING
	MOVEI	S1,ACOPSW	;POINT TO THE PASSWORD
	MOVE	S2,T1		;POINT TO BUFFER
	$CALL	CHKPSW##	;CHECK THE PASSWORD
	MOVEI	S1,ACOPRO	;POINT TO THIS PROFILE
	PUSHJ	P,FIXVLD	;UPDATE VALIDATION STATUS
;	JUMPT	ACTVCM		;PASSWORD MATCHES, CHECK ACCOUNT STRING
	JUMPT	[PUSHJ	P,UPDDSK;UPDATE DISK RECORD
		 JRST	ACTVCM]	;DONE
ILLPSW:	MOVEI	T1,ACPSW%	;CALL WITH PROPER ERROR CODE
	PUSHJ	P,LOGUSR	;LOG INITIAL USER STUFF
	$TEXT	(LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
	PUSHJ	P,FAIOUT	;FORCE BUFFERS OUT
	MOVE	S1,ACOPRO+.AEPPN ;GET PPN
	FATAL	(PSW,<Invalid password for ^U/S1/>,ACPSW%,ACTVXX)
	SUBTTL	PROCESSOR FOR "OBTAIN USER PROFILE" QUEUE. FUNCTION

ACTOUP:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	IGNORE		;WASN'T. RELEASE MESSAGE AND IGNORE IT
	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	PUSHJ	P,CVTWLD	;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)

ACTOU0:	MOVEM	S2,ACOPTR	;SAVE POINTER TO WILDCARD BLOCK
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	PUSHJ	P,PROFIL	;FETCH PROFILE
	MOVEI	S2,ACOPRO	;POINT TO THE RETURNED PROFILE
	MOVE	S1,.AEPPN(S2)	;GET THE PPN
	MOVEM	S1,ACOPPN	;STASH WHERE WE CAN FIND IT
	JUMPF	[SKIPN	S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
		 JRST	ACTOU1	;NOT FATAL--NO SUCH USER
		 PJRST	RMGERX]	;FATAL-SEND RESPONSE
	PUSHJ	P,CHKOWN	;IS OWNER REQUESTING PROFILE?
	JUMPT	ACTOU2		;JUMP IF WE FOUND THE PPN

ACTOU1:	MOVE	T1,ACOPTR	;GET ADDRESS OF WILDCARD BLOCK
	MOVE	T2,[POINT 8,ACOACK] ;AND TO ACK TEXT
	PUSHJ	P,A$WACK##	;GENERATE A WILDCARD ACK
	MOVE	T1,ACOPTR	;GET ADDR AGAIN
	MOVE	T2,[POINT 8,ACOACK] ;BYTE POINTER TO ACK TEXT
	SKIPE	UW$FND(T1)	;WAS AT LEAST ONE PROFILE FOUND?
	FATAL	(NAU,<No additional users matching ^Q/T2/>,ACNAU%,ACTVXT)
	MOVEI	T3,[ASCIZ /found/]
	HLRZ	T4,ACOWLD+UW$FND ;GET COUNT OF PROFILES FOUND
	PUSHJ	P,A$SWLD##	;GENERATE SUMMARY TEXT
	FATAL	(NUS,<^T/(S1)/>,ACNUS%,ACTVXT)

ACTOU2:	MOVEI	S2,ACOPRO	;SET UP POINTER TO PROFILE BLOCK
	MOVX	S1,AE.LOK	;GET FILE IS LOCKED BIT
	SKIPE	ACTLCK##	;IS FILE LOCKED?
	IORM	S1,ACOPRO+.AEFLG ;YES, LITE IN PROFILE
	MOVEI	S1,ACOPRO	;GET ADDRESS OF PROFILE
	PUSHJ	P,A$FSCD##	;GET SCHEDULAR CLASSES FROM SCDMAP
	MOVE	T2,DATADR	;GET THE ADDRESS OF THE MESSAGE DATA
	MOVE	T1,UV$ACK(T2)	;GET THE ACK CODE FOR THE REQUESTOR
	MOVEM	T1,ACKCOD	; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
	MOVE	T1,ACOPPN	;GET PPN WE WERE ASKED FOR
	MOVEM	T1,UV$PPN(T2)	;STASH HERE
	MOVEM	T1,PPN		;SAVE IT FOR LATER
	MOVNI	T1,2		;GET A -2 (NOT REALLY AN ERROR NUMBER)
	PUSHJ	P,ERRPRO	;GENERATE "ERROR" -2 (MOVE ACTDAE.SYS ENTRY)
	PJRST	ACTVXT		;FINISH RESPONSE TO QUEUE. AND RETURN
; CONVERT OLD-STYLE "GET PROFILE" CALL TO NEW-STYLE WILDCARD CALL
CVTWLD:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVEI	P1,ACOWLD	;POINT TO INTERNAL WILDCARD BLOCK
	MOVSI	S1,0(P1)	;START ADDRESS
	HRRI	S1,1(P1)	;MAKE A BLT POINTER
	SETZM	(P1)		;CLEAR FIRST WORD
	BLT	S1,UW$MIN-1(P1)	;CLEAR ENTIRE BLOCK
	MOVSI	S1,UW$MIN	;LENGTH
	MOVEM	S1,UW$TYP(P1)	;SAVE
	MOVE	S1,ACOTYP	;GET TYPE FIELD
	MOVE	S2,ACOUXP	;FIND OUT WHAT WE WERE GIVE
	CAIN	S2,.UGUSR	;USER NAME?
	JRST	CVTWL3		;YES

; PPN
CVTWL1:	SETZM	UW$WST(P1)	;SET WILDCARD SEARCH TYPE TO PPN
	CAIE	S1,UG.NXT	;WANT NEXT PROFILE?
	SKIPA	S1,ACOPPN	;PPN
	TDZA	S1,S1		;WILD PPN
	SKIPA	S2,[EXP -1]	;NON-WILD MASK
	TDZA	S2,S2		;WILD MASK
	TDZA	P2,P2		;NON-WILD PREVIOUS RESULT
	MOVE	P2,ACOPPN	;WILD PREVIOUS RESULT
	JUMPE	P2,CVTWL2	;ONWARD IF STARTING FROM FIRST PPN IN FILE
	TRNN	P2,-1		;ELSE HAVE A PROGRAMMER NUMBER?
	SOS	P2		;NO--BACK OFF ONE

CVTWL2:	MOVEM	S1,UW$PPN(P1)	;SAVE TARGET PPN
	MOVEM	S2,UW$PPM(P1)	;SAVE MASK
	MOVEM	P2,UW$BRE(P1)	;SAVE PREVIOUS RESULT
	JRST	CVTWL5		;FINISH UP

; NAME
CVTWL3:	MOVSI	S2,ACOUSR	;POINT TO NAME
	CAIN	S1,UG.NXT	;WANT NEXT?
	JRST	CVTWL4		;YES
	HRRI	S2,UW$NAM(P1)	;POINT TO STORAGE
	BLT	S2,UW$NAM+.AANLW-1(P1) ;COPY
	MOVEI	S2,2		;CODE
	MOVEM	S2,UW$WST(P1)	;SET WILDCARD SEARCH TYPE NON-WILD NAME
	JRST	CVTWL5		;FINISH UP

CVTWL4:	HRRI	S2,UW$BRE(P1)	;POINT TO STORAGE
	BLT	S2,UW$BRE+.AANLW-1(P1) ;COPY
	MOVSI	S2,(BYTE(8)"*",0) ;FAKING WILDCARD
	MOVEM	S2,UW$NAM(P1)	;SAVE IN MESSAGE
	MOVEI	S2,1		;CODE
	MOVEM	S2,UW$WST(P1)	;SET WILDCARD SEARCH TYPE TO WILD NAME

CVTWL5:	MOVE	S2,P1		;RETURN ADDRESS OF WILDCARD BLOCK
	POPJ	P,		;RETURN
WLDACK:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,[POINT 8,ACOWLD+UW$NAM] ;POINT TO NAME
	MOVE	P2,[POINT 8,ACOACK] ;POINT TO ACK BLOCK
	MOVEI	P3,.AANLC	;NUMBER OF CHARACTERS

WLDAC1:	ILDB	S1,P1		;GET A CHARACTER
	IDPB	S1,P2		;PUT A CHARACTER
	SKIPE	S1		;DONE?
	SOJG	P3,WLDAC1	;LOOP IF MORE CHARACTERS
	POPJ	P,		;RETURN
;ACTCUP - Change a user profile
;Call
;	ACOPRV/ Non-zero if invoking privs
;Return
;	RETF	Unprived or other problem
;	RETT	Change made


ACTCUP:	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	SKIPE	ACTLCK##	;IS THE FILE LOCKED?
	FATAL	(AFL,<Accounting file is locked>,ACAFL%,ACTVXT)
	MOVE	T1,MMSADR	;BASE MESSAGE ADDRESS
	PUSHJ	P,GETBLK	;MAKE SURE WE HAVE A FIRST BLOCK
	JUMPF	CUP.EF		;FORMAT ERROR IF NOT
	SOS	T3		;YES, POINT TO BASE OF BLOCK
	AOS	T1,QUECNT	;AND GET TOTAL COUNT OF BLOCKS
	MOVEM	T1,CUPCNT	;STORE FOR TRANSACTION PROCESSING
	MOVEM	T3,CUPLIS	;REMEMBER START OF LIST
	MOVEM	T3,QUEBLK	;AND RESTORE IT FOR PREPROCESSING
	MOVEI	T1,UGCUP$	;FUNCTION BEING PERFORMED
	PUSHJ	P,PREVAL	;PRESET THE VALIDATION BLOCK
	SETZM	CUPMEM		;ADDITIONAL DYNAMIC MEMORY
	MOVE	S1,[CUPMEM,,CUPMEM+1]
	BLT	S1,CUPZND	;CLEAR IT OUT
	MOVSI	S1,UW$DAT	;LENGTH OF WILD BLOCK WITH NO SELECTIONS
	MOVEM	S1,CUPWLD	;INIT TO NO SELECT BLOCKS
	$FALL	CUP.1		;OK, ENTER PARSE LOOP ON NEXT PAGE
CUP.1:	PUSHJ	P,GETBLF	;GET BLOCK, SEPARATING TYPE & FLAGS
	JUMPF	CUP.3		;TIME TO PROCESS AT END OF LIST
	CAIL	T1,.AEMIN	;IN RANGE?
	JRST	CUP.EF		;FORMAT ERROR IF NOT
	TXNN	S2,AF.SEL	;DOING ANY SELECTION WITH THIS BLOCK?
	JRST	CUP.2		;NO, CHECK MODIFIERS
	LOAD	S1,S2,AF.SEL	;YES, GET THE TYPE CODE
	TXNN	S2,AF.DEF	;MUST BE TESTING THE VALUE
	CAIE	S1,.AFAND	;VIA AN 'AND' SELECT
	JRST	CUP.10		;NO TO EITHER, JUST STORE THE BLOCK
	CAIE	T1,.AEPPN	;SELECTING ON THE PPN?
	JRST	CUP.11		;NO, KEEP LOOKING
	CAIL	T2,1		;YES, IS THE BLOCK
	CAILE	T2,2		; OF A VALID LENGTH?
	JRST	CUP.EF		;NO, COMPLAIN OF FORMAT ERROR
	SKIPE	CUPPPN		;HAVE WE ALREADY SEEN A PPN BLOCK?
	JRST	CUP.EF		;YES, COMPLAIN OF FORMAT ERROR
	MOVEI	S1,-1(T3)	;GET BASE ADDRESS OF BLOCK
	MOVEM	S1,CUPPPN	;STORE FOR PROFILE FETCHING
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.11:	CAIE	T1,.AENAM	;SELECTING ON USERNAME?
	CAIN	T1,.AENAM+1	;OR FORCED NON-WILD?
	CAIA			;YES, CHECK IT
	JRST	CUP.12		;NO, KEEP LOOKING
	SKIPE	CUPNAM		;HAVE WE SEEN A NAME ALREADY?
	JRST	CUP.EF		;YES, COMPLAIN OF FORMAT ERROR
	MOVEI	S1,-1(T3)	;POINT TO BASE ADDRESS
	MOVEM	S1,CUPNAM	;SAVE FOR LATER
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.12:	CAIE	T1,.AEPSW	;SELECTING ON PASSWORD?
	JRST	CUP.10		;NO, JUST ADD TO SELECT BLOCK
	SKIPE	CUPPWD		;YES, IS THIS A DUPLICATE?
	JRST	CUP.EF		;FORMAT ERROR IF SO
	MOVEI	S1,-1(T3)	;POINT TO BASE ADDRESS
	MOVEM	S1,CUPPWD	;SAVE FOR ACCESS CHECKING
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.10:	MOVEI	T1,-1(T3)	;POINT TO BASE ADDRESS OF BLOCK
	AOS	T2		;AND MAKE LENGTH REFLECT REALITY
	PUSHJ	P,CUP.S1	;INSERT INTO SELECTION LIST OF WILDCARD BLOCK
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.SL:	LDB	T2,[POINT 9,(T1),17] ;GET BLOCK LENGTH
	HRRZ	S2,(T1)		;AND FLAGS
CUP.S1:	TXNE	S2,AF.DEF	;IF SELECTING BASED ON .AEMAP,
	MOVEI	T2,1		;FORGET THE VALUE
	SKIPN	S1,CUPSEL	;IS THIS FIRST INSERTION TO THE BLOCK?
	MOVEI	S1,CUPWLD+UW$DAT ;YES, POINT TO START OF SELECTION DATA
	HRLI	S1,(T1)		;MAKE TRANSFER WORD
	HRRZ	S2,S1		;COPY DESTINATION POINTER
	ADD	S2,T2		;POINT ONE BEYOND DESTINATION BLOCK
	MOVEM	S2,CUPSEL	;SAVE FOR NEXT TIME
	BLT	S1,-1(S2)	;MOVE THE DATA
	AOS	CUPWLD+UW$SEL	;UPDATE THE COUNT OF SELECTION BLOCKS
	CAIN	T2,1		;IF SELECTING ON .AEMAP,
	DPB	T2,[POINT 9,-1(S2),17] ;UPDATE BLOCK LENGTH IN LIST
	SUBI	S2,CUPWLD	;GET CURRENT LENGTH OF WILDCARD BLOCK
	HRLM	S2,CUPWLD	;SET LENGTH IN HEADER FOR ACTRMS
	POPJ	P,		;RETURN
CUP.2:	CAIE	T1,.AEDEF	;WANT TO CHANGE THE DEFAULT PPN?
	JRST	CUP.21		;NO, KEEP LOOKING
	CAIL	T2,1		;DEMAND ONE WORD
	CAIL	T2,3		;AND NOT MORE THAN TWO,
	JRST	CUP.EF		;ELSE IS FORMAT ERROR
	TXNE	S2,AF.DEF	;AND NOT BEING DEFAULTED
	JRST	CUP.EF		;ELSE IS FORMAT ERROR
	MOVE	S1,(T3)		;GET VALUE
	MOVEM	S1,CUPDEF	;SAVE FOR LATER
	JRST	CUP.1		;EXAMINE ALL MESSAGE BLOCKS

CUP.21:	CAIE	T1,.AEPPN	;WANT TO CHANGE THE PPN?
	JRST	CUP.22		;NO, KEEP LOOKING
	TXNE	S2,AF.DEF	;CAN'T SET PPN TO DEFAULT
	JRST	CUP.EF		;COMPLAIN OF FORMAT ERROR
	CAIN	T2,1		;MUST BE JUST ONE DATA WORD
	SKIPE	CUPPPM		;SECOND PPN BLOCK FOUND?
	JRST	CUP.EF		;ALSO A FORMAT ERROR
	MOVEI	S1,-1(T3)	;POINT TO BASE OF BLOCK
	MOVEM	S1,CUPPPM	;REMEMBER PPN BEING MODIFIED
	MOVE	S1,(T3)		;GET PPN BEING SET
	SKIPGE	S1,(T3)		;GET PPN BEING SET
	JRST	CUP.EI		;INVALID IF NOT POSITIVE
	JRST	CUP.1		;ELSE LET IT THROUGH

CUP.22:	CAIE	T1,.AENAM	;WANT TO CHANGE THE NAME?
	JRST	CUP.23		;NO, KEEP LOOKING
	SKIPN	CUPNMM		;MUST HAVE ONLY ONE
	TXNE	S2,AF.DEF	;CAN'T SET NAME TO DEFAULT
	JRST	CUP.EF		;FORMAT ERROR IF TRIED
	MOVEI	S1,-1(T3)	;POINT TO BASE OF BLOCK
	MOVEM	S1,CUPNMM	;SAVE NAME MODIFIER BLOCK
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.23:	CAIE	T1,.AEPSW	;CHANGING THE PASSWORD?
	JRST	CUP.24		;NO, KEEP LOOKING
	SKIPN	CUPPWM		;MUST HAVE ONLY ONE
	TXNE	S2,AF.DEF	;CAN'T SET TO DEFAULT
	JRST	CUP.EF		;FORMAT ERROR EITHER WAY
	MOVEI	S1,-1(T3)	;POINT TO BASE OF BLOCK
	MOVEM	S1,CUPPWM	;SAVE PASSWORD MODIFIER ADDRESS
	HRLI	T3,(POINT 8)	;MAKE BYTE POINTER TO SUPPLIED PASSWORD
	IMULI	T2,.APWCW	;CHARACTER COUNT
	CAILE	T2,.APWLC	;TOO MANY?
	MOVEI	T2,.APWLC	;TRUNCATE
	MOVE	T1,[POINT 8,CUPPWB] ;PLACE TO STORE THE PASSWORD
	PUSHJ	P,CUPSTR	;MOVE THE STRING
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.24:	CAIE	T1,.AEVRS	;CHANGING THE VERSION NUMBER?
	JRST	CUP.20		;NO, JUST VALIDATE
	SKIPN	CUPVRS		;MUST HAVE ONLY ONE
	TXNE	S2,AF.DEF	;AND NOT DEFAULTED
	JRST	CUP.EF		;OR IS FORMAT ERROR
	CAIE	T2,2		;MUST HAVE EXACTLY TWO DATA WORDS
	JRST	CUP.EF		;FORMAT ERROR OTHERWISE
	MOVX	S1,AE.VRS	;VERSION MASK
	CAME	S1,1(T3)	;MAKE SURE RIGHT FIELD IS MODIFIED
	JRST	CUP.EF		;FORMAT ERROR IF NOT
	LOAD	S1,(T3),AE.VRS	;GET VALUE TO SET
	CAIE	S1,%AECVN	;IS IT IN PHASE WITH OURS?
	FATAL	(WFV,<Wrong format version specified>,ACWFV%,ACTVXT)
	SETOM	CUPVRS		;WE GOT THE VERSION WORD
	JRST	CUP.1		;PARSE ENTIRE MESSAGE

CUP.20:	MOVE	S1,CHGTAB##(T1)	;GET CONTROL BITS
	SKIPN	ACOPRV		;PRIVED?
	TXNE	S1,PD.UNP	;NO, DO WE NEED TO BE?
	CAIA			;NO, SKIP ON
	JRST	CUP.E3		;YES, GIVE PRIVILEGE ERROR
	TXNE	S1,PD.NMD	;IS IT LEGAL TO MODIFY THIS FIELD AT ALL?
	FATAL	(FNM,<Value at offset ^O/T1/ is not modifiable>,ACFNM%,ACTVXT)
	TXNE	S1,PD.CND	;CAN IT BE DEFAULTED?
	TXNN	S2,AF.DEF	;NO, ARE WE ATTEMPTING IT?
	AOSA	CUPMFC		;NO, COUNT ANOTHER FIELD TO MODIFY
	FATAL	(FND,<Value at offset ^O/T1/ is not defaultable>,ACFND%,ACTVXT)
	LOAD	T4,S1,PD.WRD	;GET MAXIMUM BLOCK LENGTH
	TXNE	S1,PD.MSK	;IF MASKABLE,
	AOS	T4		;ALLOW ANOTHER
	CAILE	T2,(T4)		;IS THE SUPPLIED BLOCK TOO LONG?
	JRST	CUP.EF		;YES, GIVE A FORMAT ERROR
	TXNN	S2,AF.DEF	;UNLESS DEFAULTING,
	JUMPE	T2,CUP.EF	;REQUIRE SOME DATA
	JRST	CUP.1		;OK, PARSE REST OF MESSAGE
CUP.3:	SKIPN	CUPVRS		;DID WE GET A VALID VERSION CHANGE WORD?
	JRST	CUP.EF		;FORMAT ERROR IF NOT
	SKIPN	T1,CUPPPM	;ARE WE TRYING TO CHANGE THE PPN?
	JRST	CUP.31		;NO, DON'T WORRY ABOUT IT
	SKIPN	ACOPRV		;MUST BE PRIVED FOR THESE OPERATIONS
	JRST	CUP.E3		;ERROR IF NOT
	SKIPN	1(T1)		;MODIFYING IT TO ZERO?
	JRST	[SETOM	CUPDEL	;YES, THAT'S HOW WE DELETE THINGS
		 JRST	CUP.31]	;CHECK OTHER FIELDS
	SKIPN	CUPWLD+UW$SEL	;NO, ADDING, MUST HAVE NO SELECT BLOCKS
	SKIPE	CUPPPN		;OF ANY KIND
	JRST	CUP.EF		;FORMAT ERROR IF SO
	SKIPN	CUPNAM		;CHECK OTHER SELECT BLOCKS
	SKIPE	CUPPWD		;FOR ABSENCE
	JRST	CUP.EF		;FORMAT ERROR IF PRESENT
	JRST	CUP.AE		;ALL IS COPASETIC, GO ADD AN ENTRY

CUP.31:	SKIPN	CUPNAM		;WANT TO SELECT BY NAME?
	JRST	CUP.33		;NO, SKIP NAME STUFF, CHECK FOR PPN
	SKIPE	T1,CUPPPN	;YES, WAS A PPN BLOCK ALSO GIVEN?
	PUSHJ	P,CUP.SL	;YES, ADD IT TO THE SELECTION DATA
	SETZM	CUPPPN		;MAKE SURE IT DOESN'T CONFUSE US IN THE FUTURE
	MOVE	T1,CUPNAM	;GET NAME SELECTION BLOCK
	MOVE	S1,(T1)		;GET OVERHEAD WORD
	ANDI	S1,AF.OFS	;KEEP .AENAM OR .AENAM+1
	SUBI	S1,.AENAM-1	;MAKE 1 OR 2
	MOVEM	S1,CUPWLD+UW$WST ;SETUP WILDCARD SEARCH TYPE
	MOVE	T2,[POINT 8,1(T1)] ;POINT TO SUPPLIED NAME
	MOVE	T3,[POINT 8,CUPWLD+UW$NAM] ;POINT TO NAME FIELD OF WILD BLOCK
	LDB	S1,[POINT 9,(T1),17] ;GET WORD LENGTH OF BLOCK
	SUBI	S1,1		;OFFSET FOR OVERHEAD WORD
	IMULI	S1,.APWCW	;TIMES CHARACTER PER WORD
	CAILE	S1,.APWLC	;WITHIN CHARACTER LENGTH LIMIT?
	MOVEI	S1,.APWLC	;NO, TRUNCATE
	MOVE	T4,S1		;KEEP INITIAL SPACE COUNT
	JUMPLE	S1,CUP.EF	;FORMAT ERROR IF NULL NAME

CUP.32:	LDB	S2,T2		;GET A SOURCE BYTE
	DPB	S2,T3		;COPY TO WILDCARD BLOCK
	SKIPE	S2		;DONE IF NULL
	SOJG	S1,CUP.32	;LOOP OVER ALL CHARACTERS IN MESSAGE BLOCK
	SUB	T4,S1		;FIND NUMBER OF CHARACTERS TRANSFERRED
	JUMPE	T4,CUP.EF	;FORMAT ERROR IF NULL NAME
	JRST	CUP.34		;GOT A NAME, SKIP THE PPN CHECKING

CUP.33:	SKIPN	T1,CUPPPN	;MUST HAVE A PPN FOR SELECTION IF NO NAME
	JRST	CUP.EF		;FORMAT ERROR IF NOT
	LDB	T2,[POINT 9,(T1),17] ;GET TOTAL BLOCK LENGTH
	MOVE	S1,1(T1)	;GET PPN FROM MESSAGE
	CAIL	T2,3		;IF MASK WAS SUPPLIED,
	SKIPA	S2,2(T1)	;THEN USE IT,
	SETO	S2,		;ELSE ASSUME NOT WILD
	DMOVEM	S1,CUPWLD+UW$PPN ;SETUP TO SEARCH BASED ON PPN
	$FALL	CUP.34		;CONTINUE ON NEXT PAGE
CUP.34:	SKIPE	ACOPRV		;DO WE HAVE PRIVS?
	JRST	CUP.35		;YES, DON'T NEED TO CHECK HERE
	SKIPE	CUPPWM		;IF MODIFYING PASSWORD,
	SKIPE	CUPPWD		;MUST HAVE OLD ONE
	CAIA			;OK
	JRST	CUP.EP		;PASSWORD ERROR
	MOVEI	S1,2		;GET NON-WILD NAME FLAG
	SKIPE	CUPWLD+UW$WST	;DOING A NAME PARSE?
	MOVEM	S1,CUPWLD+UW$WST ;YES, FORCE NON-WILD
	SKIPN	CUPWLD+UW$WST	;SEARCHING BY NAME?
	JRST	CUP.35		;YES, DONE CHECKING
	SETO	S1,		;NO, GET A -1
	CAME	S1,CUPWLD+UW$PPM ;CHECK FOR NON-WILD PPN MASK
	JRST	CUP.E3		;NOT PRIVILEGED

CUP.35:	SKIPN	T3,CUPPWD	;DO WE HAVE A PASSWORD?
	JRST	CUP.4		;NO, START MODIFYING
	LDB	T2,[POINT 9,(T3),17] ;YES, GET BLOCK LENGTH
	SOS	T2		;WANT ONLY DATA LENGTH
	IMULI	T2,.APWCW	;TIMES CHARACTERS PER WORD
	CAILE	T2,.APWLC	;TOO MANY CHARACTERS?
	MOVEI	T2,.APWLC	;TRUNCATE
	ADD	T3,[POINT 8,1]	;SOURCE BYTE POINTER
	MOVE	T1,[POINT 8,ACOPSW] ;DESTINATION B.P.
	PUSHJ	P,CUPSTR	;COPY THE STRING
	$FALL	CUP.4		;START GETTING/MODIFYING, NEXT PAGE
CUP.4:	SETZM	CUPCHG		;NOTHING CHANGED THIS PASS
	MOVEI	S1,ACOPRO	;PROFILE BLOCK
	MOVEI	S2,CUPWLD	;WILDCARD BLOCK
	PUSHJ	P,PROFIL	;FETCH THE PROFILE IN QUESTION
	JUMPF	CUP.6		;MIGHT BE DONE
	AOS	CUPWLD+UW$FND	;UPDATE COUNT OF ENTRIES MATCHED
	MOVE	S1,ACOPRO+.AEPPN ;GET THIS ENTRY'S PPN
	MOVEM	S1,ACOPPN	;SAVE FOR VARIOUS ROUTINES
	MOVEM	S1,PPN		;HERE TOO (JUST IN CASE)
	SKIPE	CUPDEL		;SUPPOSED TO DELETE THIS ENTRY?
	JRST	CUP.DE		;YES, DO SO
	PUSHJ	P,A$CKPP##	;NO, CHECK FOR RESERVED PPN
	SETCAM	TF,CUPRES	;REMEMBER IF DOING A RESERVED PROFILE
	SKIPN	CUPPWD		;NO, DO WE WANT TO VALIDATE THE PASSWORD?
	JRST	CUP.41		;NO, SKIP IT
	MOVEI	S1,ACOPSW	;POINT TO (OLD) PASSWORD
	MOVEI	S2,ACOPRO	;AND PROFILE BUFFER
	PUSHJ	P,CHKPSW##	;MAKE SURE ITS VALID
	MOVEI	S1,ACOPRO	;POINT TO PROFILE AGAIN
	PUSHJ	P,FIXVLD	;UPDATE VALIDATION TIME IN PROFILE
	JUMPF	CUP.EL		;INVALID LOGIN INFORMATION
	AOS	CUPCHG		;WE CHANGED SOMETHING
	JRST	CUP.42		;DON'T CHECK OWNERSHIP, WE HAVE THE PASSWORD

CUP.41:	MOVE	S1,PPN		;WHO WE'RE TRYING TO HACK
	PUSHJ	P,CHKOWN	;TEST OWNERSHIP IF NOT
	JUMPF	CUP.EI		;ILLEGAL PPN ERROR

CUP.42:	MOVE	S1,CUPLIS	;GET START OF MESSAGE BLOCKS
	MOVEM	S1,QUEBLK	;SAVE FOR GETBLK
	MOVE	S1,CUPCNT	;GET BLOCK COUNT
	MOVEM	S1,QUECNT	;ALSO FOR GETBLK
	$FALL	CUP.5		;ENTER MODIFICATION LOOP, NEXT PAGE
CUP.5:	MOVE	T1,MMSADR	;POINT TO MESSAGE
	PUSHJ	P,GETBLF	;GET BLOCK TYPE AND FLAGS
	JUMPF	CUP.50		;CHECK NEED TO UPDATE AT EOM
	TXNE	S2,AF.SEL	;IF A SELECTION BLOCK,
	JRST	CUP.5		;IGNORE IT (ALREADY CHECKED BY GETA)
	CAIN	T1,.AEVRS	;DOING THE VERSION?
	JRST	CUP.5		;GIMME A BREAK
	MOVSI	T4,-CUPTLN	;SET TO EXAMINE THE CHANGE TABLE
CUP.51:	HLRZ	S1,CUPTAB(T4)	;SEE IF WE CARE
	CAIE	S1,(T1)		;IS THERE A ROUTINE TO PROCESS THIS ENTRY?
	AOBJN	T4,CUP.51	;NOT YET, KEEP LOOKING
	JUMPGE	T4,CUP.52	;NOT AT ALL, HANDLE NORMALLY
	HRRZ	T4,CUPTAB(T4)	;YES, GET ITS ADDRESS
	JRST	(T4)		;LET IT PROCESS THE ENTRY

CUP.52:	MOVE	S1,CHGTAB##(T1)	;GET CONTROL BITS
	TXNE	S1,PD.EXT	;EXTENSIBLE BLOCK?
	JRST	CUP.53		;YES, UPDATE IT
	TXNE	S1,PD.MSK	;NO, MASKABLE WORD?
	TXNE	S2,AF.DEF	;WITH A REAL VALUE?
	JRST	CUP.55		;NO, UPDATE A STATIC BLOCK
	CAIG	T2,1		;IF NO MASK,
	JRST	CUP.55		;TREAT LIKE STATIC BLOCK (FULLWORD CHANGE)
	MOVE	S1,(T3)		;GET VALUE TO SET
	MOVE	T4,1(T3)	;AND CHANGE MASK
	AND	S1,T4		;CHANGE ONLY REQUESTED BITS
	ANDCA	T4,ACOPRO(T1)	;GET BITS TO PRESERVE FROM OLD VALUE
	IOR	S1,T4		;MAKE NEW VALUE WORD
	MOVEM	S1,(T3)		;RESET THE WORD
	SOS	T4,T2		;MEET EXPECTATIONS OF LATER TESTS
	PJRST	CUP.55		;THEN GO HANDLE AS A STATIC BLOCK

CUP.53:	LOAD	T4,S2,AF.DEF	;GET DEFAULTING BIT
	JUMPN	T4,CUP.54	;GO DEFAULT IT IF REQUESTED
	SKIPN	(T3)		;IF THE FIRST WORD IS ZERO,
	CAIE	T2,1		;AND THAT'S ALL THERE IS,
	CAIA			;(NO)
	JRST	CUP.54		;THEN GO DELETE THE BLOCK
	MOVE	S1,ACOPRO(T1)	;NO, GET ITS AOBJN POINTER
	ADDI	S1,ACOPRO	;DE-RELATIVIZE IT
	MOVN	S2,T2		;GET MINUS LENGTH OF MESSAGE BLOCK
	MOVSS	S2		;IN CORRECT HALFWORD
	HRRI	S2,(T3)		;AOBJN POINTER TO MESSAGE DATA
	PUSHJ	P,CUP.CW	;COMPARE THE DATA BLOCKS
	 PUSHJ	P,CUP.CD	;NO CHANGE, CHECK IF DEFAULTED
	  CAIA			;CHANGED OR DEFAULTED
	  JRST	CUP.5		;NO CHANGE AT ALL
	MOVNS	T2		;GET MINUS LENGTH
	MOVSS	T2		;IN CORRECT HALFWORD
	HRRI	T2,(T1)		;ALSO GET ENTRY OFFSET
	MOVEI	T1,ACOPRO	;POINT TO PROFILE
	SETZ	T4,		;CLEARING DEFAULTED BIT
	PUSHJ	P,A$EBLK##	;MODIFY THE PROFILE
	JUMPF	CUP.EE		;NO ROOM
	AOS	CUPCHG		;WE CHANGED SOMETHING
	JRST	CUP.5		;LOOP OVER ALL MESSAGE BLOCKS

CUP.54:	PUSH	P,T4		;SAVE THE DESIRED VALUE
	PUSHJ	P,CUP.CD	;CHECK IF DEFAULTED ALREADY
	  TDZA	S1,S1		;ZERO IF ALREADY DEFAULTED
	MOVEI	S1,1		;ONE IF NOT DEFAULTED (BACKWARDS VALUE OF T4)
	POP	P,T4		;RESTORE REQUESTED SETTING
	CAIE	S1,(T4)		;IF THE OLD STATUS MATCHES THE NEW,
	JUMPN	T4,CUP.5	;NOTHING TO DO IF DEFAULTING
	SKIPN	ACOPRO(T1)	;IF VALUE IS ALREADY ZERO,
	SKIPN	S1		;AND NOT DEFAULTED,
	CAIA			;(NO)
	JUMPE	T4,CUP.5	;THEN NOTHING TO DO IF THAT'S THE DESIRED STATE
	HRROI	T2,(T1)		;NO, MAKE ENTRY DESCRIPTOR
	MOVEI	T1,ACOPRO	;CHANGING THIS PROFILE
	SETZ	T3,		;GIVING NO VALUE
	PUSHJ	P,A$EBLK##	;DELETE OLD BLOCK (SETTING BITMAP AS DESIRED)
	JUMPF	CUP.EE		;NO ROOM (SHOULD NEVER HAPPEN)
	AOS	CUPCHG		;CHANGE HAPPENED
	JRST	CUP.5		;LOOP OVER ALL MESSAGE BLOCKS

CUP.55:	TXNE	S2,AF.DEF	;DEFAULTING?
	JRST	CUP.57		;YES, GO DEFAULT IT
	PUSHJ	P,CUP.CD	;SEE IF DEFAULTED
	  SETZ	T4,		;YES, MUST CHANGE
	LOAD	S1,CHGTAB##(T1),PD.WRD ;NO, GET BLOCK SIZE
	MOVNS	S1		;MAKE MINUS SIZE
	MOVSS	S1		;IN CORRECT HALFWORD
	HRRI	S1,ACOPRO(T1)	;AOBJN POINTER TO CURRENT VALUE
	MOVN	S2,T2		;GET MINUS MESSAGE BLOCK LENGTH
	MOVSS	S2		;IN LH
	HRRI	S2,(T3)		;AOBJN POINTER TO MESSAGE DATA
	JUMPE	T4,CUP.56	;ALWAYS CHANGE IF MUST CLEAR BIT
	PUSHJ	P,CUP.CW	;COMPARE WORD VALUES IN THE BLOCKS
	  JRST	CUP.5		;NO CHANGE HERE
CUP.56:	SKIPGE	S2		;ANYTHING LEFT IN MESSAGE DATA?
	SKIPA	T4,(S2)		;YES, USE IT
	SETZ	T4,		;NO, GET A ZERO
	MOVEM	T4,(S1)		;UPDATE PROFILE
	AOBJP	S2,.+1		;ADVANCE USER POINTER
	AOBJN	S1,CUP.56	;TRANSFER WORDS TO FILL THE BLOCK
	PUSHJ	P,CUP.CD	;CHECK PREVIOUS STATE OF DEFAULT BIT
	  ANDCAM T4,ACOPRO+.AEMAP(S1) ;CLEAR IT IF IT WAS SET
	AOS	CUPCHG		;SOMETHING CHANGED
	JRST	CUP.5		;LOOP OVER ALL MESSAGE BLOCKS

CUP.57:	PUSHJ	P,CUP.CD	;CHECK WHETHER DEFAULTED
	  JRST	CUP.5		;YES, THIS IS NO CHANGE
	IORM	T4,ACOPRO+.AEMAP(S1) ;NO, LIGHT THE BIT
;	LOAD	S1,CHGTAB##(T1),PD.WRD ;GET BLOCK LENGTH
;	MOVEI	S2,ACOPRO(T1)	;AND BLOCK ADDRESS
;	$CALL	.ZCHNK		;CLEAR THE BLOCK
	AOS	CUPCHG		;WE CHANGED IT
	JRST	CUP.5		;LOOP OVER ALL MESSAGE BLOCKS

CUP.NM:	MOVX	S2,AE.NCH	;NAME-CHANGE REQUIRED BIT
	TDNN	S2,ACOPRO+.AEFLG ;IS IT ON?
	SKIPE	ACOPRV		;OR ARE WE PRIVED?
	CAIA			;YES, WE'RE GOLDEN
	JRST	CUP.E3		;NOPE
	MOVN	S2,T2		;GET MINUS LENGTH OF USER ARG
	MOVSS	S2		;IN LH
	HRRI	S2,(T3)		;AOBJN POINTER TO USER DATA
	MOVE	S1,[-.AANLW,,ACOPRO+.AENAM] ;AOBJN POINTER TO PROFILE DATA
	PUSHJ	P,CUP.CW	;WORD-MODE BLOCK COMPARE
	  JRST	CUP.5		;NO CHANGE, DON'T BOTHER ME
	MOVX	S1,AE.NCH	;NAME-CHANGE REQUIRED BIT
	ANDCAM	S1,ACOPRO+.AEFLG ;CLEAR IT NOW
	AOS	CUPCHG		;WE'RE CHANGING THINGS
	MOVE	S1,[ACOPRO+.AENAM,,ACOPRO+.AENAM+1] ;BLT XFER WORD
	SETZM	ACOPRO+.AENAM	;CLEAR A WORD
	BLT	S1,ACOPRO+.AENAM+.AANLW-1 ;START OFF WITH CLEAN BLOCK
	IMULI	T2,.AANCW	;GET NUMBER OF CHARACTERS (MAX.) IN BLOCK
	CAILE	T2,.AANLC	;BEYOND MAXIMUM CHARACTER COUNT?
	MOVEI	T2,.AANLC	;TRUNCATE
	HRLI	T3,(POINT 8)	;AND A BYTE POINTER TO THE DATA
	MOVE	T1,[POINT 8,ACOPRO+.AENAM] ;AND A DESTINATION POINTER
	PUSHJ	P,CUPSTR	;COPY THE STRING
	JRST	CUP.5		;LOOP OVER ALL CHANGE BLOCKS

CUP.PW:	SKIPE	CUPADD		;IF ALREADY DID THIS,
	JRST	CUP.5		;DON'T DO IT AGAIN
	SKIPE	ACOPRV		;IF PRIVED,
	JRST	CUP.P1		;THEN JUST DO IT
	MOVX	S1,AE.PCP	;PASSWORD CHANGE PROHIBITED BIT
	TDNN	S1,ACOPRO+.AEREQ ;TEST IT
	JRST	CUP.P1		;CLEAR, GO CHANGE IT
	SKIPLE	S1,ACOPRO+.AEPCT ;SKIP IF MUST CHANGE PSW NOW
	$CALL	I%NOW		;ELSE, GET CURRENT UDT
	CAML	S1,ACOPRO+.AEPCT ;HAS THE PASSWORD EXPIRED?
	JUMPN	S1,CUP.P1	;CHANGE IT IF REQUIRED (DESPITE AE.PCP)
	FATAL	(PCP,<Password changes are prohibited for ^U/ACOPPN/>,ACPCP%,ACTVXT)

CUP.P1:	SKIPE	ACOPRV		;IGNORE LENGTH IF PRIVED
	JRST	CUP.P2		;YES
	MOVEI	S1,ACOPRO	;THE PROFILE WE'RE MODIFYING
	MOVEI	S2,CUPPWB	;THE PROPOSED NEW PASSWORD
	PUSHJ	P,LENPSW##	;CHECK IT OUT
	JUMPF	CUP.EW		;PASSWORD LENGTH ERROR

CUP.P2:	MOVX	S1,AE.PCP	;CAN THE USER INITIATE PSW CHANGES?
	TDNN	S1,ACOPRO+.AEREQ ;TEST
	JRST	CUP.P3		;YES, DON'T BOTHER TO CHECK IF SAME
REPEAT 0,<
	LOAD	S1,ACOPRO+.AEFLG,AE.PWE ;GET PREVIOUS ENCRYPTION ALGORITHM
	CAME	S1,CURALG##	;IS IT THE SAME AS WHAT WE WILL USE?
	JRST	CUP.P3		;NO, DON'T CHECK FOR MATCH WITH OLD PSW
>
	MOVEI	S1,CUPPWB	;THE PROPOSED NEW PASSWORD
	MOVEI	S2,ACOPRO	;THE PROFILE WE'RE MODIFYING
	PUSHJ	P,CHKPSW##	;SEE IF THIS IS A REAL CHANGE
	JUMPF	CUP.P3		;YES, JUST GO DO IT
	FATAL	(PMC,<Password must change>,ACPMC%,ACTVXT)	;NO

CUP.P3:	MOVEI	S1,CUPPWB	;THE PROPOSED NEW PASSWORD
	MOVEI	S2,ACOPRO	;THE PROFILE WE'RE MODIFYING
	PUSHJ	P,SETPSW##	;CHANGE THE PASSWORD PLEASE
	JUMPF	CUP.EA		;ENCRYPTION FAILURE?
	MOVEI	S1,ACOPRO	;PROFILE BUFFER
	PUSHJ	P,FIXPCR	;FIXUP REQUIRED PROFILE CHANGE
	AOS	CUPCHG		;SOMETHING CHANGED
	JRST	CUP.5		;LOOP OVER ALL CHANGE ENTRIES

CUP.RQ:	PUSH	P,S2		;SAVE FLAGS WORD
	PUSHJ	P,CUP.CD	;CHECK IF DEFAULTED
	  TDZA	T4,T4		;YES
	MOVEI	T4,1		;OR NO
	POP	P,S2		;RESTORE FLAGS
	TXNN	S2,AF.DEF	;SETTING TO DEFAULT?
	TRCA	T4,1		;NO, CHANGE MATCH FLAG
	SKIPA	S1,ACODEF+.AEREQ ;YES, GET DEFAULT
	SKIPA	S1,(T3)		;NO, GET VALUE
	MOVEI	T2,1		;YES, DEMAND A FULL-WORD CHANGE
	CAIL	T2,2		;WAS A MASK GIVEN?
	SKIPA	T1,1(T3)	;YES, FETCH IT
	SETO	T1,		;NO, ASSUME FULLWORD
	AND	S1,T1		;KEEP ONLY BITS TO CHANGE
	ANDCA	T1,ACOPRO+.AEREQ ;FETCH BITS TO LEAVE ALONE
	IOR	S1,T1		;CONSTRUCT NEW WORD
	CAMN	S1,ACOPRO+.AEREQ ;IS THIS A CHANGE?
	JUMPE	T4,CUP.5	;NO CHANGE AT ALL IF VALUES & BITS AGREE
	EXCH	S1,ACOPRO+.AEREQ ;YES, UPDATE, REMEMBERING OLD
	XOR	S1,ACOPRO+.AEREQ ;GET DIFFERENCE MASK
	ANDI	S1,AE.PCI	;ISOLATE CHANGES TO INTERVAL
	JUMPE	S1,CUP.R1	;DON'T UPDATE PCT IF NO CHANGE HERE
	MOVX	S1,AE.PCI	;YES, GET FIELD MASK
	AND	S1,ACOPRO+.AEREQ ;GET NEW CHANGE INTERVAL
	MOVSS	S1		;CORRECT FOR UDT FORMAT
	ADD	S1,ACOPRO+.AELPC ;GET NEW REQUIRED CHANGE TIME
	CAMLE	S1,ACOPRO+.AELPC ;IF USEFUL,
	MOVEM	S1,ACOPRO+.AEPCT ;SET IT IN THE PROFILE

CUP.R1:	AOS	CUPCHG		;WE MADE A CHANGE
	LOAD	T3,S2,AF.DEF	;GET DEFAULTING BIT
	MOVEI	T2,.AEREQ	;THIS IS WHAT WE CHANGED
	MOVEI	T1,ACOPRO	;POINT TO PROFILE
	PUSHJ	P,A$BMAP##	;SET THE BIT AS REQUESTED
	JRST	CUP.5		;LOOP OVER ALL CHANGE BLOCKS

CUP.50:	SKIPN	CUPCHG		;HAS ANYTHING CHANGED?
	JRST	CUP.4		;NO, JUST LOOP OVER ALL MATCHES
	MOVEI	S1,ACOPRO+.AENAM ;YES, POINT TO NAME (MAYBE MODIFIED)
	PUSHJ	P,A$CKNM##	;SEE IF IT'S RESERVED
	XOR	TF,CUPRES	;MAKE TRUE IFF NAME AND PPN AGREE ON RESERVATION
	JUMPF	CUP.EI		;WRONG STATE--SAY ILLEGAL PPN
	SKIPE	CUPRES		;IS PPN RESERVED?
	CAMN	S1,ACOPRO+.AEPPN ;YES, NAME BETTER BE FOR THIS PPN
	CAIA			;IT IS
	JRST	CUP.EI		;WRONG.  SAY ILLEGAL PPN
	MOVE	S1,MDBADR	;YES, GET MDB ADDRESS
	SKIPE	S1,MDB.SD(S1)	;GET SENDER'S PPN
	MOVEM	S1,ACOPRO+.AEPAP ;UPDATE PROFILE CHANGER'S PPN
	$CALL	I%NOW		;GET CURRENT UDT
	MOVEM	S1,ACOPRO+.AETIM ;SET LAST PROFILE CHANGE TIME
	SKIPE	CUPADD		;IS THIS AN UPDATE?
	JRST	CUP.A0		;NO, FINISH UP AN INSERT INSTEAD
	PUSHJ	P,UPDDSK	;UPDATE THE CURRENT RECORD
	JUMPF	CKOPR		;RETURN FAILURES APPROPRIATELY
	JRST	CUP.4		;LOOP OVER ALL MATCHING PROFILES

CUP.DE:	DMOVE	S1,ACOPPD	;POINT TO VANISHING USER BY PPN
	SKIPE	CUPWLD+UW$WST	;ARE WE SEARCHING BY PPN?
	DMOVE	S1,ACONMD	;NO, USE NAME DESCRIPTOR
	PUSHJ	P,DELA##	;DELETE FROM FILE "A"
	JUMPF	CKOPR		;RETURN FAILURES APPROPRIATELY
	JRST	CUP.4		;LOOP OVER ALL MATCHING PROFILES

CUP.6:	SKIPE	S1,RMGCOD	;CHECK FOR FATAL RMS ERRORS
	PJRST	RMGERX		;FATAL--SEND RESPONSE
	MOVEI	T1,CUPWLD	;WILD BLOCK
	MOVE	T2,[POINT 8,ACOACK] ;WILDCARD ACK BLOCK
	PUSHJ	P,A$WACK##	;GENERATE THE ACK TEXT
	MOVEI	T1,CUPWLD	;WILD BLOCK AGAIN
	MOVE	T2,[POINT 8,ACOACK] ;B.P. TO ACK TEXT
	MOVS	T4,UW$FND(T1)	;GET XWD SUCCESS,FAILURE
	MOVEI	T3,[ASCIZ /modified/] ;ASSUME MODIFY DONE
	SKIPE	CUPDEL		;RIGHT ASSUMPTION?
	MOVEI	T3,[ASCIZ /deleted/] ;NO, GET RIGHT TEXT
	MOVE	S1,T3		;SUMMARY ROUTINE USES WRONG AC
	PUSHJ	P,A$SWLD##	;GENERATE THE SUMMARY TEXT
	SKIPF			;SEE IF OK
	INFO	(SUM,<^T/(S1)/>,ACSUM%,ACTVXT)	;RESPOND TO USER AND RETURN
	FATAL	(NSU,<^T/(S1)/>,ACNSU%,ACTVXT)	;GIVE ERROR TO USER

CUPTAB:	.AEPSW,,CUP.PW		;NEED A ROUTINE TO MODIFY THE PASSWORD
	.AENAM,,CUP.NM		;AND THE NAME
	.AEREQ,,CUP.RQ		;AND THE PSW CHANGE INTERVAL
CUPTLN==.-CUPTAB		;LENGTH OF TABLE OF SPECIALS
CUP.AE:	PUSHJ	P,.SAVE2##	;GET SOME BREATHING ROOM
	SETOM	ACOPRO+.AEMAP	;START BY DEFAULTING THINGS
	MOVE	S1,[ACOPRO+.AEMAP,,ACOPRO+.AEMAP+1]
	BLT	S1,ACOPRO+.AEMAP+.AMPLW-1	;TURN ON ALL DEFAULTING BITS
	MOVEI	T1,ACOPRO	;POINT TO PROFILE
	SETZ	T3,		;SETUP TO CLEAR SOME BITS
	MOVSI	P1,-.AEMIN	;HOW FAR INTO THE TABLE TO GO
	MOVX	P2,PD.CND	;CAN-NOT-DEFAULT BIT
CUP.A1:	HRRZ	T2,P1		;COPY ENTRY OFFSET
	TDNE	P2,CHGTAB##(P1)	;CAN THIS ENTRY BE DEFAULTED?
	PUSHJ	P,A$BMAP##	;NO, FLAG IT IN THE BITMAP
	AOBJN	P1,CUP.A1	;LOOP OVER PROFILE ENTRIES
	MOVE	S1,CUPPPM	;ADDRESS OF NEW PPN BLOCK
	MOVE	S1,1(S1)	;GET NEW PPN
	MOVEM	S1,ACOPPN	;SETUP FOR ERROR ROUTINES
	MOVEM	S1,PPN		;LIKEWISE
	MOVEM	S1,ACOPRO+.AEPPN ;AND SET IN PROFILE
	MOVE	S1,[%AECVN,,.AEMIN] ;CURRENT VERSION AND PROFILE SIZE
	MOVEM	S1,ACOPRO+.AEVRS ;INITIALIZE IN PROFILE BUFFER
	MOVE	S1,CUPDEF	;GET DEFAULT PPN
	MOVEM	S1,ACOPRO+.AEDEF ;SET FOR PRODEF
	MOVEI	S1,ACOPRO	;POINT TO PROFILE
	PUSHJ	P,PRODEF	;FETCH DEFAULT PROFILE ENTRIES
	MOVE	S1,PPN		;ENTRY TO BE ADDED
	PUSHJ	P,A$CKPP##	;GET A DEFAULT NAME
	SETCAM	TF,CUPRES	;REMEMBER IF IT'S A RESERVED PPN
	SKIPN	CUPNMM		;IF NONE WAS RECEIVED,
	$TEXT	(<POINT 8,ACOPRO+.AENAM,-1>,<^T/(S1)/^0>) ;DEFAULT IT
	SETOM	CUPADD		;REMEMBER THAT WE WANT TO ADD, NOT MODIFY
	AOS	CUPCHG		;WE DO WANT TO MAKE THE CALL TO ACTRMS
	JRST	CUP.42		;MODIFY THE BLOCK, THEN COME BACK

CUP.A0:	MOVEI	S1,CUPPWB	;THE PROPOSED NEW PASSWORD
	MOVEI	S2,ACOPRO	;THE PROFILE WE'RE MODIFYING
	PUSHJ	P,SETPSW##	;SET THE ENCRYPTED PASSWORD IN THE BLOCK
	JUMPF	CUP.EA		;ENCRYPT FAILED
	SKIPN	CUPPWM		;WERE WE GIVEN A PASSWORD?
	SETOM	ACOPRO+.AEPCT	;NO, REQUIRE ONE UPON FIRST LOGIN
	SKIPN	CUPNMM		;WERE WE GIVEN A NAME?
	SKIPE	CUPRES		;OR DEFAULT NAME NOT CHANGEABLE?
	JRST	CUP.A2		;YES, DON'T NEED TO CREATE ONE
	MOVX	S2,AE.NCH	;NO, GET NAME-CHANGE BIT
	IORM	S2,ACOPRO+.AEFLG ;REQUIRE A NEW NAME UPON FIRST LOGIN

CUP.A2:	SKIPN	CUPPWM		;WERE WE GIVEN A PASSWORD?
	JRST	CUP.A6		;NO, CAN'T DO ANY OF THE FOLLOWING
	MOVE	S1,ACOPRO+.AETIM ;YES, GET LAST PROFILE CHANGE TIME
	MOVEM	S1,ACOPRO+.AELPC ;SET LAST PASSWORD CHANGE TIME
	SKIPE	ACOPRO+.AEPCT	;ALREADY HAVE A REQUIRED CHANGE TIME?
	JRST	CUP.A6		;YES, DON'T INVENT ONE
	LOAD	S1,ACOPRO+.AEREQ,AE.PCI ;NO, GET CHANGE INTERVAL
	JUMPE	S1,CUP.A6	;GIVE UP IF NO REQULAR CHANGES REQUIRED
	MOVSS	S1		;INTERVAL IS SET, CORRECT FOR UDT FORMAT
	ADD	S1,ACOPRO+.AETIM ;OFFSET FROM CURRENT TIME
	MOVEM	S1,ACOPRO+.AEPCT ;THEN SETUP BASED ON CHANGE INTERVAL

CUP.A6:
REPEAT 0,< ;FOLLOWING CODE MIGHT BE CUTE, BUT IT'S NOT USEFUL
	SKIPN	ACOPRO+.AEPNM	;DO WE HAVE A PERSONAL NAME YET?
	SKIPN	CUPNMM		;CAN'T DO THIS IF DEFAULTED NAME
	JRST	CUP.A7		;YES, DON'T DEFAULT ONE
	MOVEI	T1,ACOPRO	;POINT TO PROFILE
	MOVEI	T2,.AEPNM	;OFFSET TO TEST
	SETO	T3,		;CHECKING
	PUSHJ	P,A$BMAP##	;TEST IF DEFAULTED EMPTY
	JUMPF	CUP.A7		;NO, DON'T CHANGE IT
	MOVE	T1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
	SETZ	T2,		;INIT COUNT
	ILDB	T3,T1		;GET CHAR FROM NAME
	SKIPE	T3		;IF NOT AT END,
	AOJA	T2,.-2		;KEEP COUNTING ITS LENGTH
	IDIVI	T2,.AANCW	;MAKE WORD COUNT
	SETCA	T2,		;NEGATE AND ROUND 'UP'
	LDB	T3,[POINT 9,@CUPNMM,17] ;GET LENGTH OF NAME BLOCK
	MOVNI	T3,-1(T3)	;GET MINUS DATA LENGTH
	CAMGE	T2,T3		;IN RANGE?
	MOVE	T2,T3		;NO, LIMIT OURSELVES
	MOVSS	T2		;GET IN RIGHT HALFWORD
	HRRI	T2,.AEPNM	;FIELD WE WANT TO SET
	MOVE	T3,CUPNMM	;POINT TO NAME BLOCK
	AOS	T3		;DATA FOR FETCHING
	MOVEI	T1,ACOPRO	;PROFILE TO MODIFY
	SETZ	T4,		;NOT FROM DEFAULT PROFILE
	PUSHJ	P,A$EBLK##	;TRY TO GIVE THE USER A MIXED-CASE NAME
> ;END OF REPEAT 0

CUP.A7:	MOVEI	S1,ACOPRO	;POINT TO NEW PROFILE
	PUSHJ	P,PUTA##	;FINISH THE CREATE
	JUMPF	CKOPR		;ANALYZE FAILURE OR ACK SUCCESS
	INFO	(INS,<User [^O/PPN,LHMASK/,^O/PPN,RHMASK/] inserted>,ACINS%,ACTVXT)
CUP.EF:	FATAL	(IFM,<Illegally formatted message>,ACIFM%,ACTVXT)

CUP.E3:	PUSHJ	P,ERROR3	;SET THE PRIVILEGE ERROR ACK
	PJRST	ACTVXT		;THEN DELIVER IT

CUP.EA:	MOVE	S1,CURALG##	;GET ALGORITHM INDEX
	FATAL	(EAF,<Encryption algorithm ^O/S1/ failed>,ACEAF%,ACTVXT)

CUP.EP:	FATAL	(MPR,<Missing password required>,ACMPR%,ACTVXT)

CUP.EL:	SKIPE	ACOPRV		;PRIVED USER?
	PJRST	ILLPSW		;YES, GO ADMIT TO BAD PASSWORD
	MOVEI	T1,ACPSW%	;NO, BUT TELL THE TRUTH IN THE ERROR FILE
	PUSHJ	P,LOGUSR	;LOG INITIAL USER STUFF
	$TEXT	(LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
	PUSHJ	P,FAIOUT	;FLUSH THE BUFFERS
	PUSHJ	P,UPDDSK	;RECORD THE VALIDATION FAILURE ON DISK
	PJRST	CUP.EI		;PRETEND IT WAS AN ILLEGAL PPN

CUP.EE:	FATAL	(PTF,<Profile is too full; user ^U/ACOPPN/>,ACPTF%,ACTVXT)

CUP.EW:	FATAL	(PLL,<Password length is less than ^D/S1/ characters>,ACPLL%,ACTVXT)
CUP.CW:	PUSHJ	P,.SAVE4##	;PRESERVE ALL ACS USED
	DMOVE	P3,S1		;COPY POINTERS
CUP.C1:	SKIPGE	P3		;IF STILL A BASE WORD,
	SKIPA	P1,(P3)		;THEN USE IT,
	SETZ	P1,		;ELSE FETCH ZERO
	SKIPGE	P4		;SIMILARLY WITH
	SKIPA	P2,(P4)		;THE MESSAGE DATA
	SETZ	P2,		;FETCH WORD OR ZERO
	CAME	P1,P2		;ARE THEY THE SAME?
	JRST	.POPJ1		;NOPE, FLAG DIFFERENT
	AOBJP	P3,.+1		;ADVANCE POINTER
	AOBJN	P4,CUP.C1	;LOOP OVER ALL WORDS
	JUMPL	P3,CUP.C1	;UNTIL BOTH POINTERS GIVE OUT
	POPJ	P,		;THE BLOCKS ARE THE SAME IF WE GET HERE

CUP.CD:	MOVEI	S1,(T1)		;COPY ENTRY OFFSET
	IDIVI	S1,^D36		;GET WORD & BIT NUMBERS
	MOVNS	S2		;GET SHIFT OFFSET
	MOVSI	T4,(1B0)	;GET BIT TO SHIFT
	LSH	T4,(S2)		;MAKE BIT TO TEST
	TDNN	T4,ACOPRO+.AEMAP(S1) ;IS THIS FIELD ALREADY DEFAULTED?
	AOS	(P)		;SKIP IF NOT
	POPJ	P,		;RETURN RESULT

CUPSTR:	ILDB	S1,T3		;GET A SOURCE BYTE
	JUMPE	S1,.POPJ	;DONE AT END OF ASCIZ
	IDPB	S1,T1		;STUFF A DESTINATION BYTE
	SOJG	T2,CUPSTR	;UNTIL EOS OR FULL BLOCK
	POPJ	P,		;THEN RETURN
CUPMEM:!			;BEGINNING OF UGCUP$-SPECIFIC STORAGE

CUPPWB:	BLOCK	.APWLW		;SPACE FOR A PASSWORD BLOCK
CUPWLD:	BLOCK	PAGSIZ		;SPACE FOR A WILDCARDING BLOCK
CUPSEL:	BLOCK	1		;CURRENT ALLOCATION OF SELECT BLOCKS
CUPADD:	BLOCK	1		;FLAG FOR CALLING PUTA RATHER THAN UPDA
CUPDEF:	BLOCK	1		;MODIFIED VALUE OF .AEDEF
CUPRES:	BLOCK	1		;FLAG FOR INSERTING RESERVED PROFILE
CUPDEL:	BLOCK	1		;FLAG FOR WHETHER ENTRY SHOULD BE DELETED
CUPPPN:	BLOCK	1		;POINTER TO SELECT BLOCK FOR PPN
CUPPPM:	BLOCK	1		;POINTER TO MODIFY BLOCK FOR PPN
CUPNAM:	BLOCK	1		;POINTER TO SELECT BLOCK FOR NAME
CUPNMM:	BLOCK	1		;POINTER TO MODIFY BLOCK FOR NAME
CUPPWD:	BLOCK	1		;POINTER TO SELECT BLOCK FOR PASSWORD
CUPPWM:	BLOCK	1		;POINTER TO MODIFY BLOCK FOR PASSWORD
CUPVRS:	BLOCK	1		;FLAG FOR WHETHER VERSION CHANGE WAS SEEN
CUPMFC:	BLOCK	1		;MODIFIABLE FIELD COUNT
CUPCHG:	BLOCK	1		;FLAG FOR WRITING OUT ACOPRO

CUPZND==.-1			;LAST WORD TO ZERO ON UGCUP$

CUPCNT:	BLOCK	1		;MEMORY OF QUECNT
CUPLIS:	BLOCK	1		;MEMORY OF QUEBLK
CKOPR:	JUMPT	ACTVXT		;JUMP IF OK
	MOVEI	S1,3		;IT DID NOT, SEE WHY
	PUSHJ	P,OPTA##	;GET STATUS OF FILE "A"
	CAIN	S1,ER$DUP##	;WAS THE NAME ALREADY IN USE?
	JRST	[MOVE	S1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
		FATAL	(NAE,<Name already exists; ^Q/S1/>,ACNAE%,ACTVXT)]
	CAIN	S1,ER$RNF##	;RECORD NOT FOUND?
CUP.EI:	FATAL	(ILP,<Illegal PPN [^O/PPN,LHMASK/,^O/PPN,RHMASK/]>,ACILP%,ACTVXT)
	PUSHJ	P,RMGCH1	;CHECK FOR FATAL RMS ERRORS
RMGERX:	FATAL	(RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)


;CHECK FOR FATAL RMS ERRORS.
RMGCHK:	$RETIT			;NO ERRORS--RETURN
	MOVEI	S1,3		;
	PUSHJ	P,OPTA##	;GET STATUS OF FILE "A"
RMGCH1:	CAIE	S1,ER$BUG##	;INTERNAL ERROR?
	CAIN	S1,ER$UDF##	;UNDEFINED STATE?
	TRNA			;YES--TELL THE OPERATOR (MAYBE)
	$RETT			;NO--IGNORE IT
	MOVEM	S1,RMGCOD	;SAVE RMS ERROR CODE
	PUSHJ	P,I%NOW		;GET CURRENT UNIVERSAL DATE/TIME
	SKIPN	RMGUDT		;FIRST TIME THROUGH THIS CODE?
	JRST	RMGCH2		;YES--SEND MESSAGE TO OPERATOR
	MOVE	S2,S1		;NO--CALCULATE TIME SINCE LAST MESSAGE
	SUB	S2,RMGUDT	;
	IMULI	S2,^D24*^D3600	;CONVERT TO SECONDS
	HLRZ	S2,S2		;
	CAIGE	S2,RMGINT	;HAS ENOUGH TIME PASSED?
	JRST	RMGCH3		;NO--DON'T BOTHER THE OPERATOR
RMGCH2:	MOVEM	S1,RMGUDT	;SAVE CURRENT UNIVERSAL DATE/TIME
	MOVEI	S1,4		;
	PUSHJ	P,OPTA##	;GET FILESPEC FOR FILE "A"
	$WTOXX	<Fatal RMS error on ^F/(S2)/; RMS error ^OR0/RMGCOD/>
RMGCH3:	MOVE	S1,RMGCOD	;RESTORE RMS ERROR CODE
	$RETF			;
;FIXUP REQUIRED PASSWORD CHANGE BITS
FIXPCR:	$SAVE	P1			;SAVE AN AC
	MOVE	P1,S1			;SAVE ADDRESS OF RECORD BUFFER
	$CALL	I%NOW			;GET CURRENT UDT
	CAML	S1,.AEPCT(P1)		;PERHAPS A REQUIRED CHANGE?
	SETZM	.AEPCT(P1)		;YES, CLEAR THE UT
	MOVEM	S1,.AELPC(P1)		;SAVE LAST PASSWORD CHANGE
	LOAD	S1,.AEREQ(P1),AE.PCI	;GET CHANGE INTERVAL
	MOVSS	S1			;CORRECT FOR UDT FORMAT
	ADD	S1,.AELPC(P1)		;ADJUST CHANGE TIME BY INTERVAL
	CAMLE	S1,.AELPC(P1)		;IF INTERVAL IS PRESENT,
	MOVEM	S1,.AEPCT(P1)		;SETUP NEW REQUIRED CHANGE TIME
	MOVX	S1,1B<.AEPCT-<<.AEPCT/36>*36>>	;GET DEFAULT BIT
	ANDCAM	S1,.AEMAP+.AEPCT/^D36(P1)	;CLEAR IT, SINCE CHANGED VALUE
	POPJ	P,

;ROUTINE TO HANDLE SELECTION ON .AEAUX

;CALL:	P1/ WILD BLOCK ADDRESS
;	P2/ SELECTION BLOCK ADDRESS
;	P3/ PROFILE BUFFER ADDRESS

UGAUX%::LDB	T1,[POINT 9,(P2),17] 	;NUMBER OF WORDS IN BLOCK
	SOJLE	T1,.RETF		;OFFSET FOR ONLY DATA WORDS
	MOVNS	T1			;MAKE MINUS DATA LENGTH
	MOVSS	T1			;IN LH FOR AOBJN
	HRRI	T1,1(P2)		;POINTER TO REQUESTOR'S DATA
	MOVE	T2,.AEAUX(P3)		;RELATIVE POINTER TO PROFILE DATA
	ADDI	T2,(P3)			;DE-RELATIVIZE IT
UGAUX1:	MOVE	T3,T2			;GET WORKING COPY OF PROFILE POINTER
	MOVE	T4,.AUSTR(T1)		;AND CURRENT NAME TO MATCH
UGAUX2:	CAME	T4,.AUSTR(T3)		;[152] FOUND START OF SUBSTRING?
	CAMN	T4,[-1]			;[152] OR A WILDCARD?
	JRST	UGAUX3			;YES, PROCESS THE LIST
	ADD	T3,[.AULEN-1,,.AULEN-1]	;UPDATE FOR MULTI-WORD ENTRIES
	AOBJN	T3,UGAUX2		;KEEP LOOKING THROUGH SEARCH LIST
	LOAD	T1,(P2),AF.SEL		;GET SELECTION TYPE
	CAIN	T1,.AFNOT		;ONLY SUCCEED
	AOS	(P)			;IF A 'NOT' BLOCK
	POPJ	P,			;RETURN THE DECISION

UGAUX3:	MOVE	T4,T1			;COPY SEARCH POINTER
UGAUX4:	MOVE	T2,(T4)			;GET NEXT SEARCH WORD
	CAMN	T2,[-1]			;IS IT A DON'T CARE?
	JRST	UGAUX5			;YES, IT SUCCEEDS
	SKIPL	T3			;[152] IF NO MORE IN PROFILE,
	TDZA	T1,T1			;[152] ZERO-FILL
	MOVE	T1,(T3)			;NO, FETCH WORD FROM PROFILE
	PUSHJ	P,CMPINS##		;CHECK FOR MATCH
	  POPJ	P,			;PROPAGATE FAILURE
UGAUX5:	AOBJP	T4,.POPJ1		;SUCCEED IF END OF MATCH LIST
	AOBJN	T3,UGAUX4		;KEEP SEARCHING
	JRST	UGAUX4			;[152] EVEN IF PROFILE IS SHORT
ACTPSW:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	IGNORE		;WASN'T. RELEASE MESSAGE AND IGNORE IT
	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	PUSHJ	P,CVTWLD	;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	PUSHJ	P,PROFIL	;FETCH PROFILE
	JUMPF	[SKIPN	S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
		 JRST	ACTACA	;NOT FATAL--NO SUCH USERS
		 PJRST	RMGERX]	;FATAL--SEND RESPONSE
	MOVEI	S2,ACOPRO	;POINT TO THE RETURNED PROFILE
	MOVE	S1,.AEPPN(S2)	;GET THE PPN
	MOVEM	S1,ACOPPN	;SAVE IN PPN PLACE
ACTPS0:	MOVEI	S1,ACOPSW	;POINT AT THE PASSWORD
	MOVEI	S2,ACOPRO	;RECORD HE WANTS TO CHECK
	$CALL	CHKPSW##	;CHECK THE PASSWORD, PLEASE
	MOVEI	S1,ACOPRO	;POINT TO THIS PROFILE
	PUSHJ	P,FIXVLD	;UPDATE VALIDATION STATUS
	JUMPT	ACTPS1		;IT'S GOOD, CONTINUE
	PJRST	ILLPSW		;REPORT INVALID PASSWORD AND RETURN
ACTPS1:	JRST	ACTVXX		;AND RETURN
	SUBTTL	LOCK/UNLOCK USER ACCOUNT FILE

ACTLOK:	TDZA	S1,S1		;INDICATE ENTRY
ACTUNL:	SETOM	S1
	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	PJRST	IGNORE		;WASN'T, RELEASE THE MESSAGE
	MOVE	T1,S1		;SAVE ENTRY INDICATOR
	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	JUMPL	T1,UNLOCK	;JUMP IF UNLOCK FUNCTION
	SKIPN	ACTLCK##	;ALREADY LOCKED?
	JRST	LOCK		;NO, GO DO IT
	FATAL	(FAL,<File already locked>,ACFAL%,ACTVXT)

LOCK:	PUSHJ 	P,CLSA##	;CLOSE FILE "A"
	JUMPF	LOCK.1		;CHECK FOR ERRORS
	MOVEI	S1,ACCTFN	;GET ADDRESS OF FILENAME FOR RMS
	MOVEI	S2,0		;READ-ONLY
	PUSHJ	P,OPNA##	;OPEN FILE "A" FOR INPUT
	JUMPF	LOCK.1		;CAN'T GO OPEN REGULAR (TRY ANYWAY)
	SETOM	ACTLCK##	;FLAG FILE IS LOCKED
	PJRST	ACTVXT		;RETURN

LOCK.1:	MOVEI	S1,3		;OPTION CODE
	PUSHJ	P,OPTA##	;GET STATUS FOR FILE "A"
	PUSH	P,S1		;SAVE ERROR CODE
	MOVEI	S1,ACCTFN	;GET FILENAME ADDRESS
	MOVEI	S2,1		;WANT TO WRITE THE FILE
	PUSHJ	P,OPNA##	;OPEN FILE "A" FOR I/O
	JUMPT	LOCK.2		;GO COMPLAIN ABOUT PREVIOUS ERROR
	MOVEI	S1,3		;UNLESS THIS FAILS TOO--GET OPTION CODE
	PUSHJ	P,OPTA##	;GET STATUS FOR FILE "A"
	MOVEM	S1,(P)		;SAVE
LOCK.2:	POP	P,S1		;GET RMS ERROR CODE BACK
	FATAL	(RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)

UNLOCK:	SKIPN	ACTLCK##	;FILE LOCKED?
	FATAL	(FNL,<File not locked>,ACFNL%,ACTVXT)
	PUSHJ	P,CLSA##	;CLOSE FILE "A"
	JUMPF	UNLO.2		;CHECK FOR ERRORS
	MOVEI	S1,ACCTFN	;GET FILENAME ADDRESS
	MOVEI	S2,1		;WANT TO WRITE THE FILE
	PUSHJ	P,OPNA##	;OPEN FILE "A" FOR I/O
	JUMPF	UNLO.2
        SETZM	ACTLCK##	;FLAG FILE IS NOW UNLOCKED
	PJRST	ACTVXT		;RETURN
UNLO.2:	MOVEI	S1,3		;IT DID NOT, SEE WHY
	PUSHJ	P,OPTA##	;GET STATUS FOR FILE "A"
	FATAL	(RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)

ACTSCD:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	 PJRST	IGNORE		;WASN'T, RELEASE THE MESSAGE
	$CALL	M%GPAG		;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	PUSHJ	P,A$DSCD##	;DELETE SCDMAP.SYS DATA
	SKIPF
	PUSHJ	P,A$ISCD##	;INITIALIZE CLASS SCHEDULER MAPPING
	JUMPT	ACTVXT		;JUMP IF OK
	FATAL	(SMF,<Class scheduler mapping failed>,ACSMF%,ACTVXT)

	;ROUTINE TO UPDATE VALIDATION TIME AND FAILURE BIT

FIXVLD:	$SAVE	P1			;FOR THE BUFFER ADDRESS
	MOVE	P1,S1			;SAVE WHAT WE'RE UPDATING
	SKIPF				;SKIP IF FAILED
	SKIPA	S2,[ANDCAM S1,.AEFLG(P1)] ;GET INSTR TO CLEAR AE.FAI
	MOVE	S2,[IORM   S1,.AEFLG(P1)] ;GET INSTR TO SET AE.FAI
	PUSH	P,TF			;SAVE STATUS ON STACK
	MOVX	S1,AE.FAI		;GET FAILURE TIME VALID BIT
	XCT	S2			;DO THE DESIRED OPERATION
	$CALL	I%NOW			;GET CURRENT UDT
	MOVEM	S1,.AEFAI(P1)		;SAVE IT ALSO
	POP	P,TF			;RESTORE STATUS
	$RET
SUBTTL	ACTMAP - PERFORM USER PPN/NAME MAPPING


ACTMAP:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	PUSHJ	P,M%GPAG	;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	PUSHJ	P,MAPLGL	;CHECK FOR A LEGAL MESSAGE FORMAT
	JUMPF	ACTVXT		;ACK USER ON ERRORS

ACTMA1:	PUSHJ	P,MAPWLD	;BUILD WILDCARD BLOCK
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	MOVEI	S2,(P2)		;POINT TO WILDCARD BLOCK
	PUSHJ	P,GETA##	;FETCH PROFILE FROM FILE "A"
	JUMPF	[PUSHJ	P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
		 JUMPT	ACTMA4	;NOT FATAL--NO SUCH USER
		 PJRST	RMGERX]	;FATAL-SEND RESPONSE
	MOVE	T1,ACOPRO+.AEPPN ;GET PPN
	MOVEM	T1,TMPMAP+UU$PPN ;SAVE
	MOVE	T1,[ACOPRO+.AENAM,,TMPMAP+UU$NAM] ;SET UP BLT
	BLT	T1,TMPMAP+UU$LEN-1 ;SAVE NAME IN TEMPORARY STORAGE
	SKIPE	T1,UW$WST(P2)	;A PPN?
	CAIN	T1,2		;OR NON-WILD NAME?
	JRST	ACTMA3		;YES--NO AMBIGUITY EXISTS
	MOVEI	T1,TMPMAP+UU$NAM ;POINTER TO RETURNED NAME
	HRLI	T1,(POINT 8)	;FOR LOADING
	SETZ	T2,		;TO COUNT CHARACTERS

ACTMA2:	ILDB	T3,T1		;GET NEXT CHARACTER
	SKIPE	T3		;STOP AT END OF NAME
	AOJA	T2,ACTMA2	;LOOP OVER ALL CHARACTERS
	CAMN	T2,TMPLEN	;NAMES OF THE SAME LENGTH?
	JRST	ACTMA3		;YES, THEY ARE IDENTICAL (EXCEPT FOR CASE?)
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	MOVEI	S2,(P2)		;POINT TO WILDCARD BLOCK
	PUSHJ	P,GETA##	;FETCH PROFILE FROM FILE "A"
	JUMPT	ACTMA4		;JUMP IF AMBIGUOUS NAME GIVEN
	PUSHJ	P,RMGCHK	;CHECK FOR FATAL RMS ERRORS
	JUMPF	RMGERX		;FATAL ERROR--SEND RESPONSE

ACTMA3:	MOVSI	T1,TMPMAP	;POINT TO TEMPORARY STORAGE
	HRRI	T1,(P1)		;AND TO DESTINATION
	BLT	T1,UU$LEN-1(P1)	;COPY

ACTMA4:	ADDI	P1,UU$LEN-1	;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,ACTMA1	;ONTO THE NEXT MAPPING BLOCK
	MOVNI	T1,4		;GET A -4 (NOT REALLY AN ERROR NUMBER)
	PUSHJ	P,ERRPRO	;GENERATE "ERROR" -4 (MOVE MAPPING INFO)
	PJRST	ACTVXT		;FINISH RESPONSE TO QUEUE. AND RETURN
; CHECK FOR LEGAL MAPPING MESSAGE FORMAT
MAPLGL:	MOVE	P1,MMSADR	;POINT TO MESSAGE
	MOVEI	T3,(P1)		;INCASE IPCF MESSAGE
	MOVE	T1,UU$ACK(P1)	;GET THE ACK CODE
	MOVEM	T1,ACKCOD	;SAVE
	SKIPN	QUEFLG		;QUEUE UUO?
	JRST	MAPLG2		;NO
	SETZM	QUEBLK		;RESET POINTER TO SCAN FROM BEGINING
	MOVE	T1,MMSADR	;POINT TO MESSAGE

MAPLG1:	PUSHJ	P,GETBLK	;GET A BLOCK
	SKIPT			;CHECK FOR ERRORS
	FATAL	(PEM,<Premature end of mapping message block>,ACPEM%,.RETF)
	CAIE	T1,.QBAET	;START OF INTERESTING DATA?
	JRST	MAPLG1		;NOT YET

MAPLG2:	MOVEI	P1,UU$MAP(T3)	;POINT TO START OF ACTUAL DATA
	MOVEM	P1,ACOMAP	;SAVE ADDRESS
	SKIPN	T1,UU$CNT(T3)	;GET COUNT OF MAPPING BLOCKS
	FATAL	(MBZ,<Mapping block count is zero>,ACMBZ%,.RETF)
	MOVEM	T1,TMPCNT	;SAVE FOR ERRMAP
	MOVNS	T1		;NEGATE
	HRL	P1,T1		;MAKE AN AOBJN POINTER
	MOVE	P2,P1		;COPY MESSAGE POINTER

MAPLG3:	HRRZ	T1,P2		;GET CURRENT MAPPING BLOCK ADDRESS
	SUB	T1,ACOMAP	;COMPUTE OFFSET INTO MESSAGE
	IDIVI	T1,UU$LEN	;GET BLOCK NUMBER
	SKIPN	UU$PPN(P2)	;HAVE A PPN?
	SKIPE	UU$NAM(P2)	;OR A NAME?
	SKIPA			;YES TO EITHER
	FATAL	(MBF,<Mapping block format error; block = ^D/T1/>,ACMBF%,.RETF)
	ADDI	P2,UU$LEN-1	;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P2,MAPLG3	;CHECK THE NEXT BLOCK
	$RETT			;RETURN
; BUILD WILDCARD MESSAGE
MAPWLD:	MOVEI	P2,ACOWLD	;POINT TO INTERNAL WILDCARD BLOCK
	MOVSI	T1,0(P2)	;START ADDRESS
	HRRI	T1,1(P2)	;MAKE A BLT POINTER
	SETZM	(P2)		;CLEAR FIRST WORD
	BLT	T1,UW$MIN-1(P2)	;CLEAR ENTIRE BLOCK
	MOVSI	T1,UW$MIN	;LENGTH
	HRRI	T1,UGWLD$	;FUNCTION CODE
	MOVEM	T1,UW$TYP(P2)	;SAVE
	SKIPN	T1,UU$PPN(P1)	;HAVE A PPN?
	JRST	MAPWL1		;NO--A NAME
	MOVEM	T1,UW$PPN(P2)	;SAVE IN WILDCARD BLOCK
	SETOM	UW$PPM(P2)	;NON-WILD MASK
	POPJ	P,		;RETURN

MAPWL1:	MOVEI	T1,UU$NAM(P1)	;POINT TO NAME
	HRLI	T1,(POINT 8,)	;8-BIT ASCIZ
	MOVEI	T2,UW$NAM(P2)	;POINT TO STORAGE
	HRLI	T2,(POINT 8,)	;8-BIT ASCIZ
	MOVSI	T3,-.AANLC	;LENGTH IN CHARACTERS

MAPWL2:	ILDB	T4,T1		;GET A CHARACTER
	JUMPE	T4,MAPWL4	;DONE?
	IDPB	T4,T2		;PUT A CHARACTER
	TRZE	T3,1B19		;WAS PREVIOUS CHARACTER A QUOTE?
	JRST	MAPWL3		;YES, DON'T DAMAGE THIS ONE
	CAIE	T4,"*"		;NO, CHECK FOR WILDCARD
	CAIN	T4,"?"		;OF EITHER TYPE
	TRO	T3,1B18		;YES, REMEMBER IT
	CAIE	T4,.CHCNV	;OR IS IT THE MAGIC QUOTE CHARACTER?
	JRST	MAPWL3		;NO, DON'T FUDGE FOR IT
	TRO	T3,1B19!1B20	;YES, FLAG FOR NEXT TIME AROUND
	SOS	T3		;DON'T COUNT CHARACTER AGAINST MATCH LENGTH
MAPWL3:	AOBJN	T3,MAPWL2	;LOOP
	MOVEI	T1,2		;CODE
	MOVEM	T1,UW$WST(P2)	;SET WILDCARD SEARCH TYPE TO NON-WILD NAME
	POPJ	P,		;RETURN

MAPWL4:	TRZ	T3,1B20		;JUST IN CASE IT'S STILL ON
	HRRZM	T3,TMPLEN	;SAVE LENGTH OF NAME
	MOVEI	T4,"*"		;MAKE A WILD NAME
	IDPB	T4,T2		;STORE CHARACTER
	MOVEI	T1,1		;CODE
	MOVEM	T1,UW$WST(P2)	;SET WILDCARD SEARCH TYPE TO WILD NAME
	POPJ	P,		;RETURN
SUBTTL	ACTWLD - GET PROFILE FOR POSSIBLY WILDCARDED PPN/NAME


ACTWLD:	PUSHJ	P,M%GPAG	;GET A PAGE FOR THE RESPONSE MESSAGE
	MOVEM	S1,SABADR	;STORE THE ADDRESS OF THE PAGE/PACKET
	MOVE	S2,MMSADR	;POINT TO MESSAGE
	SKIPN	QUEFLG		;FROM A QUEUE. UUO?
	PJRST	ACTOU0		;NO CONVERSION NECESSARY
	SETZM	QUEBLK		;RESET POINTER TO SCAN FROM BEGINING
	MOVE	T1,MMSADR	;POINT TO MESSAGE

ACTWL1:	PUSHJ	P,GETBLK	;GET A BLOCK
	JUMPF	ACTWL2		;CHECK FOR PREMATURE END OF MESSAGE
	CAIE	T1,.QBAET	;START OF INTERESTING DATA?
	JRST	ACTWL1		;NOT YET
	MOVE	S2,T3		;POINT TO DATA
	PJRST	ACTOU0		;GO ENTER COMMON CODE

ACTWL2:	FATAL	(ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,ACILP%,ACTVXT)
	SUBTTL	ACTVER - COMMON SUBROUTINES

;CHKPRJ - ROUTINE TO VERIFY ACCOUNT IN PROJCT.SYS.
;CALL:	PUSHJ	P,CHKPRJ
;	RETURN HERE - NO FATAL ERRORS DETECTED

CHKPRJ:	PUSHJ	P,CHKCOM	;DO COMMON STUFF TO GET POSITIONED
	JUMPF	.POPJ		;WHOOPS, SOME ERROR TO RETURN TO THE USER
	PJRST	VERIFY		;DO VALIDATION

;CHKDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
;CALL:	PUSHJ	P,CHKDEF
;	RETURN HERE - NO FATAL ERROR DETECTED

CHKDEF:	PUSHJ	P,CHKCOM	;DO COMMON STUFF TO GET POSITIONED
	JUMPF	.POPJ		;WHOOPS, SAY NO DEFAULT EXISTS
	PJRST	FNDDEF		;GO FIND DEFAULT AND RETURN

;CHKCOM - PERFORM COMMON POSITIONING FOR CHKPRJ AND CHKDEF

CHKCOM:	PUSHJ	P,PRJRED	;LOOKUP PROJCT.SYS
	JUMPF	.POPJ		;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
	PUSHJ	P,BLDPRJ	;SEE IF WE NEED TO BUILD THE TABLE
	JUMPF	.POPJ		;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
	PJRST	SEARCH		;SEARCH PROJCT.SYS FOR BLOCK CONTAINING PPN

;CHKACT - ROUTINE TO LOOK IN ACTDAE.SYS.
;	AND SEE IF THE USER IS REQUIRED TO HAVE AN ACCOUNT WHEN A NULL ACCOUNT
;	HAS BEEN GIVEN IN THE IPCF MESSAGE.  IF HE IS, GIVE HIM AN INVALID
;	ACCOUNT ERROR MESSAGE.
;CALL:	PUSHJ	P,CHKACT
;	RETURN HERE

CHKACT:	MOVE	T1,PPN		;GET PPN
	PUSHJ	P,GETPRO	;DO COMMON STUFF TO FIND PPN IN ACTDAE.SYS
	JUMPF	.RETT		;ASSUME ACCOUNT STRING IS NOT REQUIRED
	MOVE	T1,.AEREQ(T1)	;GET USER'S REQUIREMENT WORD
	TXNE	T1,AE.ACT	;IS AN ACCOUNT REQUIRED FOR THIS PPN?
	$RETT			;YES--MUST VALIDATE
	$RETF			;NO VALIDATION NECESSARY

INVPPN:	SKIPA	S2,.AEPPN(T1)	;GET PPN FROM PROFILE
INVACC:	MOVE	S2,PPN		;GET PPN FROM LOW CORE
	PUSH	P,S2		;SAVE PPN
	PUSH	P,T1		;SAVE CALLER'S AC
	MOVEI	T1,ACIVA%	;INVALID ACCOUNT STRING ERROR
	PUSHJ	P,LOGUSR	;LOG THE ERROR
	POP	P,T1		;RESTORE AC
	$TEXT	(LOGFAI,<^O6R0/PPN,LHMASK/^O6R0/PPN,RHMASK/>) ;DEPENDENT INFO
	PUSHJ	P,FAIOUT	;WRITE OUT TO THE FAILURE LOG
	POP	P,S2		;GET PPN BACK
	MOVE	S1,DATADR	;GET ADDRESS OF DATA
	ADDI	S1,UV$ACT	;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
	FATAL	(IVA,<Invalid account "^T/(S1)/" for ^U/S2/>,ACIVA%,.RETF)
;BLDPRJ - ROUTINE TO SEE IF PROJCT.SYS HAS DATA AND TO DETERMINE IF
;	THE IN-CORE TABLE NEEDS TO BE REBUILT.  IF NOT, JUST RETURN.
;	OTHERWISE, REBUILD TABLE AND RETURN.
;CALL:	PUSHJ	P,BLDPRJ
;	RETURN HERE ALWAYS.  IF THERE'S AN ERROR, JRST TO AN ERROR ROUTINE

BLDPRJ:	SKIPN	T1,PROJCT+.RBSIZ ;IS THERE DATA IN PROJCT.SYS?
	$BOMB	<ACTNDA No data in PROJCT.SYS -- cannot validate>
	MOVE	T1,PROJCT+.RBTIM ;GET THE CREATION DATE
	EXCH	T1,Z.DATE	;STORE NEW, GET OLD
	CAMN	T1,Z.DATE	;HAS IT CHANGED?
	$RETT			;NO, WE HAVE THE CURRENT FILE IN-CORE
	SETZM	BLKNUM		;FORCE READ OF DISK
	MOVNI	T1,200		;SET LENGTH = 200 WORDS
	MOVEM	T1,PRJIOW	;FOR INITIAL READ OF INFORMATION BLOCK
	MOVEI	T1,1		;READ THE FILE/DATA INFORMATION BLOCK
	MOVEM	T1,PRJMUL	;SET LOG TO PHYS MULTIPLIER TO 1 ALSO
	MOVEM	T1,PRJCON	;CONSTANT TOO SO THAT LOGICAL 1 = PHYSICAL 1
	PUSHJ	P,READ
	SKIPT
	$BOMB	<ACTUXE Unexpected EOF in PROJCT.SYS when reading first block>
	MOVE	T1,PRJBUF+A.VERS ;CHECK THE VERSION NUMBER
	CAIE	T1,1		;WE SPEAK VERSION 1
	CAIN	T1,2		;AND VERSION 2 FORMATS
	CAIA			;ONE OF THE ABOVE
	$BOMB	<ACTVSP Version skew of PROJCT.SYS>
	MOVEM	T1,PRJVRS	;SAVE FOR LATER CHECKS
	MOVEI	T2,2		;CONSTANT = 2 FOR BLOCK CONVERSION
	CAIN	T1,1		;UNLESS VERSION 1 FORMAT
	MOVEI	T2,1		;THEN CONSTANT = 1
	MOVEM	T2,PRJCON	;STORE FOR LATER COMPUTATION
	SKIPN	T1,PRJBUF+A.WPBL ;GET WHAT PROJCT.EXE THINKS IS PRJWPB
	MOVEI	T1,200		;OLD PROJCT.SYS WAS WRITTEN AT 200 WORDS PER
	CAILE	T1,PRJWPB	;ALWAYS OK IF WE KNOW ABOUT LARGER FORMATS
	$BOMB	<ACTPTS PRJWPB too small for whats in PROJCT.SYS>
	MOVNM	T1,PRJIOW	;SAVE - WORD COUNT FOR READING BLOCKS
	LSH	T1,-7		;CONVERT TO REAL DISK BLOCKS PER LOGICAL ONE
	MOVEM	T1,PRJMUL	;SAVE MULTIPLIER FOR LOG TO PHYS CONVERSION

;FALL INTO BUILD TABLE ROUTINE
BLDPR1:	SKIPN	T1,PRJBUF+A.TLEN ;GET LENGTH OF TABLE
	$RETT			;NULL TABLE, ASSUME [*,*]=*
	CAMG	T1,Z.TLEN	;IS THE TABLE LARGER THAN BEFORE?
	JRST	[MOVEM	T1,Z.TLEN
		JRST	BLDPR3]	;NO. DON'T NEED MORE CORE. STORE LENGTH
	SKIPN	S2,Z.TADR	;HAVE WE BUILT THE TABLE BEFORE?
	JRST	BLDPR2		;NO. JRST BUILD IT
	MOVE	S1,Z.TLEN	;THE SIZE OF CORE BLOCK TO GIVE UP
	$CALL	M%RMEM		;GET RID OF THE OLD TABLE
BLDPR2:	MOVEM	T1,Z.TLEN	;STORE LENGTH OF NEW TABLE
	MOVE	S1,T1		;LENGTH OF NEW TABLE
	$CALL	M%GMEM		;GET ENOUGH CORE TO FIT THE NEW TABLE
	MOVEM	S2,Z.TADR	;SAVE THE BEGINNING ADDRESS
BLDPR3:	MOVE	T1,PRJBUF+A.FBLK ;GET BLOCK NUMBER NUMBER OF THE TABLE
	SUBI	T1,1		;BACK OFF TO PREVIOUS BLOCK
	MOVEM	T1,LSTBLK	;AND STORE AS LAST BLOCK CONTAINING DATA
	MOVE	T1,Z.TADR	;READ TABLE INTO LOW SEGMENT
	SUBI	T1,1
	MOVN	T2,Z.TLEN
	HRL	T1,T2
	MOVEM	T1,IOLIST	;SET UP COMMAND LIST FOR READING TABLE
	SETZM	IOLIST+1
	MOVE	T1,PRJBUF+A.FBLK ;GET THE BLOCK # OF THE TABLE
	SUB	T1,PRJCON	;COMPUTE READ DISK BLOCK NUMBER
	IMULI	T1,@PRJMUL	;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
	ADD	T1,PRJCON	;...
	MOVE	T2,PRJCHN	;AND THE CHANNEL (STORED IN LH(PRJCHN))
	PUSHJ	P,AUSETI	;POSITION TO THE BLOCK #
	SKIPT
	$BOMB	<ACTCUJ Cannot USETI to PROJCT.SYS block containing index table>
	MOVEI	T1,.FOINP	;INPUT
	HLL	T1,PRJCHN	;CHANNEL #
	TXO	T1,FO.PRV	;ALLOW FULL FILE ACCESS TO SYS:
	MOVEM	T1,PRJBLK+.FOFNC
	MOVEI	T1,IOLIST	;I/O LIST
	MOVEM	T1,PRJBLK+.FOIOS
	MOVE	T1,[2,,PRJBLK]
	FILOP.	T1,
	  SKIPA			;ERROR
	$RETT			;RETURN OK
	TXNE	T1,IO.EOF	;IS AN END OF FILE?
	$RETF			;YES.
	$BOMB	<ACTRFI Cannot read (^O/T1/) file information block of PROJCT.SYS>
;SEARCH - SEARCH THE TABLE FOR THE GIVEN PPN, READ IT IN
;CALL:	PUSHJ	P,SEARCH
;	ONLY RETURN.  IF ERROR, JRST TO THE ERROR ROUTINE

SEARCH:	MOVE	T4,PPN		;GET THE PPN TO VALIDATE FOR
	MOVE	T2,Z.TLEN	;GET LENGTH OF TABLE
	MOVE	T3,Z.TADR	;INITIALIZE ADDRESS
	HLRZ	T1,1(T3)	;GET POSSIBLE BLOCK NUMBER FOR ENTRY
	CAMLE	T4,(T3)		;IS IT IN THE FIRST BLOCK
SEARC1:	CAMN	T4,(T3)		;SAME AS FIRST PPN IN BLOCK
	JRST	SEARC2		;GO SEARCH THIS BLOCK
	CAMG	T4,(T3)		;IS IT IN PREVIOUS BLOCK
	SOJA	T1,SEARC2	;YES, GO SEARCH THAT BLOCK
	ADDI	T3,2		;DOUBLE WORD ENTRIES
	HLRZ	T1,1(T3)	;GET BLOCK NUMBER FOR THIS ENTRY
	SOS	T2		;BACK OFF THE LENGTH OF THE TABLE
	SOJG	T2,SEARC1	;AND LOOK SOME MORE
	MOVE	T1,LSTBLK	;IF NOT FOUND, MUST BE IN THE LAST BLOCK
SEARC2:	PUSHJ	P,READ		;READ IT IN
	JUMPT	.POPJ
	$BOMB	<ACTUEP Unexpected EOF in PROJCT.SYS when searching for ^P/PPN/>
;VERIFY - ROUTINE TO VALIDATE IF THE GIVEN PPN CAN USE THE GIVEN
;	ACCOUNT STRING
;CALL:	PUSHJ	P,VERIFY
;	ONLY RETURN. IF AN ERROR, JRST TO ERROR ROUTINE

VERIFY:	PUSHJ	P,.SAVE4	;SAVE P1-P4
	MOVEI	P2,BLKOFS	;GET THE WORD # OF FIRST ENTRY
	MOVE	S1,DATADR	;GET ADDRES OF THE VALIDATION MESSAGE
	MOVEI	S1,UV$ACT(S1)	;OFFSET INTO MESSAGE FOR ACCOUNT STRING
	PUSHJ	P,SYNCHK	;CHECK FOR AN ACCOUNT STRING SYNONYM IF ANY
IFN FTCASECONVERT,<		;IF CONVERTING LOWER TO UPPER
	MOVE	T1,DATADR	;GET THE ADDRESS OF THE VALIDATION MESSAGE
	MOVEI	T1,UV$ACT(T1)	;OFFSET INTO MESSAGE FOR ACCOUNT STRNG
	HRLI	T1,(POINT 7,0)	;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
	MOVEI	T2,.AACLC	;NUMBER OF CHARACTERS IN ACCOUNT STRING
VERIF0:	ILDB	T3,T1		;GET A CHARACTER
	JUMPE	T3,VERIF1	;QUIT AT END OF STRING
	CAIG	T3,"Z"+" "	;CHECK IF LOWER CASE LETTER
	CAIGE	T3,"A"+" "	;...
	JRST	VERIF5		;NOT LOWER CASE LETTER
	SUBI	T3," "		;CONVERT TO UPPER CASE
	DPB	T3,T1		;STORE BACK IN ACCOUNT STRING
VERIF5:	SOJG	T2,VERIF0	;CONTINUE FOR ALL CHARACTERS
>
VERIF1:	MOVE	P1,PPN		;GET THE PPN WE'RE VEIFYING FOR AGAIN
	XOR	P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
	AND	P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
	JUMPE	P1,VERIF2	;HAVE WE FOUND A MATCH?
	HLRZ	T1,PRJBUF(P2)	;SET UP TO LOOK AT NEXT PPN ENTRY BY
	ADD	P2,T1		; GETTING RIGHT OFFSET INTO THE BLOCK
	CAMGE	P2,PRJBUF	;ARE THERE ANY MORE ENTRIES?
	JRST	VERIF1		;YES. KEEP SEARCHING
	PUSHJ	P,READNX	;READ NEXT BLOCK LOOKING FOR WILD CARDING
	SKIPT			;CHECK FOR ERRORS
	FATAL	(NAP,<No defined account string for ^U/PPN/>,ACNAP%,.RETF)
	MOVEI	P2,BLKOFS	;GET THE WORD # OF FIRST ENTRY
	JRST	VERIF1		;GO TRY TO FIND ANOTHER MATCH
VERIF2:	MOVE	P3,DATADR	;GET THE ADDRESS OF THE VALIDATION MESSAGE
	MOVEI	P3,UV$ACT(P3)	;OFFSET INTO MESSAGE FOR ACCOUNT STRING
	HRLI	P3,(POINT 7,0)	;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
	HLRZ	T1,PRJBUF+PPNOFS+CNTOFS(P2) ;GET THE CHARACTER COUNT OF ACCOUNT
	MOVNS	T1
	MOVE	T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
VERIF3:	ILDB	T3,T2		;GET A CHARACTER IN THE ENTRY ACCOUNT
	ILDB	T4,P3		;GET A CHARACTER IN THE ARGUMENT ACCOUNT
	CAIN	T3,"*"		;WILDCARD THE REST OF THE USERS ACCOUNT STRING
	$RETT			;YES, DECLARE IT VALID
	CAIN	T3,"?"		;WILDCARD THIS CHARACTER
	MOVE	T3,T4		;YES, INSURE A MATCH
	CAME	T3,T4		;DO THEY MATCH?
	JRST	VERIF4		;NO. PROCEED TO NEXT ENTRY
	AOJN	T1,VERIF3	;YES. CONTINUE COMPARING THE ACCOUNTS
	ILDB	T4,P3		;GET THE NEXT CHARACTER OF THE ARGUMENT. IT
	JUMPE	T4,.RETT	; MUST BE NULL TO BE VALID
VERIF4:	MOVE	P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
	HRRZ	T1,PRJBUF(P2)	;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
	ADD	P2,T1		;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
	CAMGE	P2,PRJBUF	;DOES IT EXIST?
	JRST	VERIF6		;YES, SEE IF STILL WITHIN SAME PPN
	MOVE	T1,PRJVRS	;GET VERSION OF PROJCT.SYS
	CAIN	T1,1		;THIS VERSION 1
	JRST	INVACC		;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
	PUSHJ	P,READNX	;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
	JUMPF	INVACC		;NO NEXT BLOCK, ACCOUNT STRING NOT FOUND
	MOVEI	P2,BLKOFS	;RESTART AT BEGINNING OF NEW DATA BLOCK
VERIF6:	CAMN	P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
	PJRST	VERIF2		;YES. COMPARE THE NEXT ACCOUNT STRING
	JRST	INVACC		;NO. VALIDATION ERROR
;FNDDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
;	FOR THE REQUESTED PPN.  ALREADY KNOW THAT SPECIFIED STRING WAS NULL.
;CALL:	PUSHJ	P,FNDDEF
;	RETURN TRUE WITH UV$ACT FILLED IN WITH THE DEFAULT
;	RETURN FALSE IF NO DEFAULT FOUND

FNDDEF:	PUSHJ	P,.SAVE4	;SAVE P1-P4
	MOVEI	P2,BLKOFS	;GET THE WORD # OF FIRST ENTRY
FNDEF1:	MOVE	P1,PPN		;GET THE PPN WE'RE VEIFYING FOR AGAIN
	XOR	P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
	AND	P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
	JUMPE	P1,FNDEF2	;HAVE WE FOUND A MATCH?
	HLRZ	T1,PRJBUF(P2)	;SET UP TO LOOK AT NEXT PPN ENTRY BY
	ADD	P2,T1		; GETTING RIGHT OFFSET INTO THE BLOCK
	CAMGE	P2,PRJBUF	;ARE THERE ANY MORE ENTRIES?
	JRST	FNDEF1		;YES. KEEP SEARCHING
	PUSHJ	P,READNX	;READ NEXT BLOCK (IF ANY) LOOKING FOR WILD CARDING
	JUMPF	.POPJ		;EOF. PPN DOESN'T EXIST IN PROJCT.SYS
	MOVEI	P2,BLKOFS	;GET THE WORD # OF FIRST ENTRY
	JRST	FNDEF1		;GO TRY TO FIND ANOTHER MATCH
FNDEF2:	MOVE	T1,PRJBUF+PPNOFS+CNTOFS(P2) ;FETCH CHR COUNT AND FLAGS
	TRNN	T1,1B35		;THIS THE DEFAULT
	JRST	FNDEF4		;NO, TRY ANOTHER
	HLRZS	T1		;ISOLATE STRING LENGTH
	MOVE	P3,DATADR	;GET THE ADDRESS OF THE VALIDATION MESSAGE
	MOVEI	P3,UV$ACT(P3)	;OFFSET INTO MESSAGE FOR ACCOUNT STRING
	HRLI	P3,(POINT 7,0)	;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
	MOVE	T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
	SETZM	(P3)		;I KNOW IT IS A NULL ACCOUNT BUT...
	HRLI	T3,(P3)		;ZERO RECEIVING AREA ANYWAY
	HRRI	T3,1(P3)	;...
	BLT	T3,7(P3)	;...
	ILDB	T3,T2		;MOVE DEFAULT ACCOUNT STRING TO RETURN BLOCK
	IDPB	T3,P3		;...
	SOJG	T1,.-2		;...
	$RETT			;GIVE GOOD RETURN
FNDEF4:	MOVE	P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
	HRRZ	T1,PRJBUF(P2)	;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
	ADD	P2,T1		;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
	CAMGE	P2,PRJBUF	;DOES IT EXIST?
	JRST	FNDEF5		;YES, SEE IF STILL WITHIN SAME PPN
	MOVE	T1,PRJVRS	;GET VERSION OF PROJCT.SYS
	CAIN	T1,1		;THIS VERSION 1
	$RETF			;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
	PUSHJ	P,READNX	;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
	JUMPF	.POPJ		;NO NEXT BLOCK, DEFAULT NOT FOUND
	MOVEI	P2,BLKOFS	;RESTART AT BEGINNING OF NEW DATA BLOCK
FNDEF5:	CAMN	P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
	PJRST	FNDEF2		;YES. COMPARE THE NEXT ACCOUNT STRING
	$RETF			;NO DEFAULT EXISTS
;SUBROUTINE TO READ THE NEXT BLOCK OF PROJCT.SYS.
;CALL:	PUSHJ	P,READNX
;	RETURN FALSE IF NO NEXT BLOCK
;	RETURN TRUE IF WITH BLOCK IN PRJBUF

READNX:	MOVE	T1,BLKNUM	;GET BLOCK NUMBER WE ARE LOOKING AT NOW
	ADDI	T1,1		;DOES THE NEXT BLOCK OF THE FILE CONTAIN
	CAMLE	T1,LSTBLK	; DATA?
	$RETF			;NO. THE PPN DOESN'T EXIST IN PROJCT.SYS

		;FALL INTO READ ROUTINE

;READ - ROUTINE TO READ IN A SPECIFIED BLOCK OF PROJCT.SYS.
;CALL:	MOVE	T1,BLOCK #
;	PUSHJ	P,READ
;	  ERROR RETURN.  EOF REACHED.  IF OTHER ERROR JRST TO ERROR ROUTINE.
;	GOOD RETURN

READ:	CAMN	T1,BLKNUM	;ALREADY HAVE THIS BLOCK IN CORE
	$RETT			;YES, GOOD RETURN, AVOID DISK ACTIVITY
	MOVEM	T1,BLKNUM	;SAVE THE BLOCK NUMBER WE ARE GOING TO READ IN
	SUB	T1,PRJCON	;COMPUTE READ DISK BLOCK NUMBER
	IMULI	T1,@PRJMUL	;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
	ADD	T1,PRJCON	;...
	MOVE	T2,PRJCHN
	PUSHJ	P,AUSETI	;POSITION TO BLOCK IN T1
	SKIPT
	$BOMB	<ACTCUB Could not USETI to a block in PROJCT.SYS>
	MOVEI	T1,.FOINP	;INPUT
	HLL	T1,PRJCHN	;GET THE CHANNEL
	TXO	T1,FO.PRV	;ALLOW FULL FILE ACCESS TO SYS:
	MOVEM	T1,PRJBLK+.FOFNC
	MOVEI	T1,IOLIST	;I/O LIST
	MOVEM	T1,PRJBLK+.FOIOS
	HRL	T1,PRJIOW	;GET - NUMBER OF WORDS TO READ
	HRRI	T1,PRJBUF-1	;FORM REST OF IOWD
	MOVEM	T1,IOLIST	;SET UP THE LIST
	SETZM	IOLIST+1
	MOVE	T1,[2,,PRJBLK]
	FILOP.	T1,
	  SKIPA			;ERROR
	$RETT
	TXNN	T1,IO.EOF	;IS IT AND END OF FILE?
	$BOMB	<ACTRBP Cannot READ (^O/T1/) PROJCT.SYS>
	SETZM	BLKNUM		;DON'T WANT TO KEEP BAD DATA AROUND
	$RETF			;INDICATE EOF.
;GETPRO - ROUTINE TO FIND A PPN'S ENTRY IN ACTDAE.SYS
;CALL:	MOVE	T1,PPN
;	PUSHJ	P,GETPRO
;	RETURN HERE--IF TRUE, T1/ADDR OF ACTDAE.SYS ENTRY FOR USER
;		   --IF FALSE, ERROR MESSAGE ALREADY BUILT

GETPRO:	TDZA	TF,TF		;EXTERNAL ENTRY POINT
GETPRX:	MOVEI	TF,1		;INTERNAL ENTRY POINT
	PUSH	P,TF		;SAVE FLAG
GETP.1:	MOVEM	T1,ACOPPN	;PPN TO GET
	PUSH	P,ACOUXP	;SAVE LOC
	MOVEI	S1,.UGPPN	;CODE FOR A PPN
	MOVEM	S1,ACOUXP	;SAVE TEMPORARILY
	PUSHJ	P,CVTWLD	;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
	MOVEI	S1,ACOPRO	;WHERE TO READ THE RECORD
	PUSHJ	P,GETA##	;FETCH PROFILE FROM FILE "A"
	POP	P,ACOUXP	;RESTORE LOC
	JUMPF	GETP.2		;IF FAIL, SAY NO SUCH PPN
	POP	P,(P)		;PHASE STACK
	MOVEI	T1,ACOPRO	;POINT AT BLOCK WHERE PROFILE IS
	$RETT			; AND RETURN
GETP.2:	PUSH	P,S1		;SAVE THE PPN
	PUSHJ	P,RMGCHK	;CHECK FOR FATAL RMS ERRORS
	POP	P,S1		;RESTORE THE PPN
	POP	P,TF		;GET ENTRY POINT FLAG
	JUMPN	TF,.RETF	;JUMP IF INTERNAL
	SKIPE	S2,RMGCOD	;FATAL RMS ERROR?
	FATAL	(RMS,<Unexpected RMS error ^O6R0/S2/>,ACRMS%,.RETF)
	FATAL	(ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,ACILP%,.RETF)
SUBTTL	PROFIL - READ PROFILE AND PERFORM DEFAULTING


; THIS ROUTINE WILL FETCH A PROFILE AND DO DEFAULTING BASED ON
; THE CONTENTS OF .AEDEF AND .AEMAP.
; CALL:	MOVE	S1, ADDRESS OF BUFFER TO RETURN PROFILE
;	MOVE	S2, ADDRESS OF WILDCARD MESSAGE BLOCK
;	PUSHJ	P,PROFIL
;
; TRUE RETURN:	PROFILE READ AND DEFAULTED AS NECESSARY
; FALSE RETURN:	REQUESTED PROFILE OR DEFAULT PROFILE NOT FOUND

PROFIL:	PUSHJ	P,.SAVE4	;SAVE SOME ACS
	MOVE	P1,S1		;SAVE PROFILE BUFFER ADDRESS
	PUSHJ	P,GETA##	;FETCH REQUESTED PROFILE
	JUMPF	[PUSHJ	P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
		 $RETF]		;RETURN FALSE (NO SUCH USER OR FATAL ERROR)
	PUSHJ	P,PROFMT	;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
	JRST	PROFI0		;OK, GO DEFAULT IT

PRODEF:	PUSHJ	P,.SAVE4	;SAVE SOME ACS
	MOVE	P1,S1		;SAVE PROFILE BUFFER ADDRESS

PROFI0:	MOVE	S1,[ACODEF,,ACODEF+1] ;BLT WORD
	SETZM	ACODEF		;CLEAR START OF BLOCK
	BLT	S1,ACODEF+.AEMAX-1 ;START OFF WITH A CLEAN SLATE
	MOVE	S1,.AEDEF(P1)	;GET DEFAULT PPN WORD
	CAIN	S1,-1		;WANT DEFAULTING?
	$RETT			;NO--THAT'S EASY
	MOVSI	S1,-.AMPLW	;-LENGTH OF DEFAULT MAP
	HRRI	S1,.AEMAP(P1)	;MAKE AN AOBJN POINTER
	SKIPN	(S1)		;ANY FIELDS TO DEFAULT?
	AOBJN	S1,.-1		;NO
	JUMPGE	S1,.RETT	;RETURN IF NO DEFAULTING NECESSARY
	PUSHJ	P,PROLOD	;GO LOAD DEFAULT PROFILE
	JUMPF	.RETT		;RETURN IF CAN'T FIND PROFILE FOR DEFAULTING
	$SAVE	<T1,T2>		;DON'T CLOBBER CALLER'S ACS
	MOVE	T1,P1		;COPY USER PROFILE ADDRESS
	MOVEI	T2,ACODEF	;POINT TO DEFAULTING BLOCK
	PJRST	A$PDEF##	;GO APPLY THE DEFAULTS
; READ AND VERIFY ACCOUNTING FILE/PROFILE FORMAT VERSION NUMBER

PROFMT:	HLRZ	S1,.AEVRS(P1)	;GET VERSION
	CAIN	S1,6		;KNOWN FORMAT?
	POPJ	P,		;YES
	STOPCD	(WVR,HALT,,<Wrong accounting file format>)
; DETERMINE DEFAULT PPN AND LOAD THAT PROFILE INTO ACODEF

PROLOD:	MOVE	S1,[ACODWL,,ACODWL+1] ;SET UP BLT
	SETZM	ACODWL		;CLEAR FIRST WORD
	BLT	S1,ACODWL+UW$MIN-1 ;ZERO OUT DEFAULTING WILDCARD BLOCK
	HLLO	S1,.AEPPN(P1)	;ASSUME [10,%] WANTED
	SKIPN	S2,.AEDEF(P1)	;CONVENTIONAL DEFAULTING?
	JRST	PROLO1		;YES
	MOVE	S1,S2		;COPY POSSIBLE PPN
	TLNE	S1,-1		;FULL PPN SPECIFIED?
	JRST	PROLO1		;YES
	HRLZS	S1		;PUT PROJECT NUMBER IN PROPER PLACE
	HRR	S1,.AEPPN(P1)	;LOAD PROGRAMMER NUMBER

PROLO1:	MOVEM	S1,ACODWL+UW$PPN ;SAVE DEFAULT PPN
	SETOM	ACODWL+UW$PPM	;SET MASK
	MOVEI	S1,ACODEF	;PROFILE BUFFER
	MOVEI	S2,ACODWL	;WILDCARD BLOCK ADDRESS
	PUSHJ	P,GETA##	;FETCH DEFAULT PROFILE
	JUMPT	PROLO2		;CONTINUE IF NO ERRORS
	PUSHJ	P,RMGCHK	;CHECK FOR FATAL RMS ERRORS
				; (TELL OPERATOR, BUT KEEP TRYING)
	SKIPE	.AEDEF(P1)	;DOING CONVENTIONAL DEFAULTING?
	$RETF			;NO--CAN'T DO DEFAULTING
	MOVE	S1,ACODWL+UW$PPN ;GET PPN
	AOJE	S1,.RETF	;RETURN IF ALREADY TRIED [%,%]
	MOVNI	S1,1		;ELSE GET PPN OF LAST RESORT
	JRST	PROLO1		;AND TRY ONCE MORE

PROLO2:	PUSHJ	P,PROFMT	;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
	$RETT			;AND RETURN
	SUBTTL	ACTIPC - SECTION TO HANDLE ALL OTHER IPCF MESSAGES


;GENERAL DEFINITIONS FOR ACTIPC MODULE
JOBNUM:	BLOCK 1			;JOB NUMBER OF USER
JOBMAX:	BLOCK 1			;MAXIMUM NUMBER OF JOBS ALLOWED TO BE LOGGED IN
				; (USUALLY THE NUMBER THE RUNNING MONITOR WAS
				; BUILT FOR).  THIS NUMBER WILL ONLY BE LESS
				; IF THE CHECKPOINT FILES CANNOT BE ALLOCATED
				; DUE TO DISK FULL PROBLEMS.  SEE THE DSKLOW ROUTINE
DEVNUM:	BLOCK 1			;nTH DEVICE JUST READ IN A JOB'S DEVICE
				; CHECKPOINT FILE
DEVAVL:	BLOCK 1			;LAST DEVICE SLOT AVAILABLE

DCHRBL:	BLOCK	.DCALT+1	;BLOCK FOR DSKCHR TO FIND ALTERATE PORT
	SUBTTL	ACTIPC - ACTLIN--ROUTINE TO HANDLE LOGIN IPCF MESSAGE

;ACTLIN - ROUTINE TO TAKE ACTION WHEN A USER LOGS IN.  ACTIONS ARE TO
;	INITIALIZE A JOB SLOT IN THE PRIMARY JOB CHECKPOINT FILE AND TRANSFER
;	INFORMATION FROM THE MESSAGE TO THE JOB SLOT.  LOGIN IS BLOCKED UNTIL
;	DATA IS WRITTEN AND AN ACK MESSAGE IS SEND BACK
;CALL:	MMSADR CONTAINS THE ADDRESS OF LOGIN IPCF DATA RECEIVED
;	MDBADR CONTAINS THE ADDRESS OF LOGIN IPCF MESSAGE DESCRIPTOR BLOCK

ACTLIN:	PUSHJ	P,IPCGEN	;FIND THE JOB NUMBER
	MOVE	T1,JOBNUM	;GET IT
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS JOB?
	FATAL	(JCE,<Job capacity exceeded>,ACJCE%,ACTVXT)
	JUMPF	[MOVE	T2,MMSADR
		MOVEM	T2,IPS.BL+SAB.MS	;ADDRESS OF DATA
		JRST	ACTLI1]
	PUSHJ	P,CBJZER	;ZERO THE PRIMARY DATA AREA
	PUSHJ	P,GTTTYS	;GET INITIAL TTY STATISTICS NUMBERS
	PUSHJ	P,CPJCOP	;ZERO AND INCLUDE INIT TTY STATS IN AUX AREA
	PUSHJ	P,CPJLIN	;TRANSFER THE DATA RECEIVED
	HRL	T1,JOBNUM	;GET THE JOB NUMBER
	HRRI	T1,.GTJLT	;JOB LOGIN TIME
	GETTAB	T1,		;GET IT
	  SETZ	T1,		;WHAT!
	MOVEM	T1,CPJBUF+CJLGTM ;RECORD FOR RESTART CHECK
	PUSHJ	P,WRITJP	;WRITE THE PRIMARY JOB SLOT
	SKIPE	QUEFLG		;QUEUE. UUO?
	JRST	[PUSHJ	P,QUEACK ;YES--ACK DIFFERENTLY
		 JUMPF	ACTLI2	;CHECK FOR ERRORS
		 $RETT]		;ELSE RETURN
	MOVE	T2,MMSADR	;USE THE SAME PAGE WE RECEIVED
	MOVEM	T2,IPS.BL+SAB.MS	;ADDRESS OF DATA
	MOVEI	T1,UGTRU$	;INDICATE ALL OK
	MOVEM	T1,UC$RES(T2)
ACTLI1:	MOVE	T1,ACKCOD	;GET THE UNIQUE MESSAGE IDENTIFIER
	MOVEM	T1,UC$ACK(T2)	;PUT IN THE MESSAGE
	MOVEI	T1,UGVAC$	;INDICATE RESPONSE MESSAGE
	MOVEM	T1,UC$TYP(T2)
	MOVE	T1,MDBADR	;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
	MOVE	T1,MDB.SP(T1)	;GET PID OF THE JOB LOGGING IN
	MOVEM	T1,IPS.BL+SAB.PD
	MOVEI	T1,1000		;INDICATE A PAGE IS BEING SENT
	MOVEM	T1,IPS.BL+SAB.LN
	MOVEI	S1,SAB.SZ	;LENGTH OF SEND ARGUMENT BLOCK
	MOVEI	S2,IPS.BL	;ADDRESS OF SEND ARGUMENT BLOCK
	$CALL	C%SEND		;SEND THE MESSAGE, GLXLIB
	JUMPT	.POPJ		;PROPOGATE TRUE RETURN
	CAIN	S1,ERNSP$
	JRST	ACTLI2		;IF NO PID, ASSUME USER CONTROL-C'D OUT OF LOGIN
	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.SD(T1)	;SENDER'S PPN
	MOVE	T3,MDB.PV(T1)
	ANDX	T3,MD.PJB	;JOB NUMBER OF SENDER
	$WTOXX	<Error (^E/S1/) sending a LOGIN response to job ^D/T3/ user ^P/T2/>
ACTLI2:	PUSHJ	P,CBJZER	;ZERO THE JOB SLOT BUFFER OF PRIMARY FILE
	PUSHJ	P,WRITJP	;AND WRITE IT TO ENSURE DATA INTEGRITY
	$RETT
;CPJLIN - ROUTINE TO TAKE DATA FROM THE LOGIN IPCF MESSAGE AND PUT IT INTO CPJBUF.
;	NOTICE THAT THIS ROUTINE ASSUMES THAT PART OF THE LOGIN IPCF MESSAGE
;	HAS THE SAME FORMAT AS CPJBUF.

CPJLIN:	MOVE	T1,DATADR	;GET ADDRESS OF DATA
	MOVE	T2,UL$ACK(T1)	;GET THE SENDER'S UNIQUE MESSAGE IDENTIFIER
	MOVEM	T2,ACKCOD	;AND SAVE IT FOR THE RESPONSE MESSAGE
	HRLI	T2,UL$LIN(T1)
	HRRI	T2,CPJBUF+CLINNO
	BLT	T2,CPJBUF+CTERDE ;MOVE LARGE CHUNK OF DATA
	SETO	T1,		;GET A -1
	CAMN	T1,CPJBUF+CACCT	;WAS THERE ONE SPECIFIED TO LOGIN
	SETZM	CPJBUF+CACCT	;NO, AVOID JUNK IN USAGE.OUT
	CAMN	T1,CPJBUF+CRMRK	;CHECK /REMARK TOO
	SETZM	CPJBUF+CRMRK

;NOW DO ITEMIZED DATA TRANSFER

	MOVE	T1,.JBVER	;ACCOUNT DAEMON VERSION NUMBER
	MOVEM	T1,CPJBUF+CACVER
	MOVE	T1,JOBNUM	;SENDERS JOB NUMBER
	MOVEM	T1,CPJBUF+CJOB
	MOVE	T1,CPJBUF+CSESST
	MOVEM	T1,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE CHECKPOINTING THIS JOB
	POPJ	P,
	SUBTTL	ACTIPC - ACTSES--ROUTINE TO HANDLE SESSION IPCF MESSAGE

;ACTSES - ROUTINE TO TAKE ACTION WHEN A USER TYPES A SESSION COMMAND.  ACTIONS
;	ARE TO MAKE A SESSION ENTRY, COPY THE PRIMARY BUFFER CPJBUF TO CAJBUF,
;	THE AUXILLIARY BUFFER, UPDATE CPJBUF AND WRITE BOTH BUFFERS.
;	LOGIN IS BLOCKED BECAUSE A CHECKPOINT MUST BE MADE.
;CALL:	MDBADR CONTAINS THE MESSAGE DESCRIPTOR BLOCK ADDRESS
;	MMSADR CONTAINS THE ADDRESS OF THE IPCF MESSAGE RECEIVED.

ACTSES:	PUSHJ	P,IPCGEN	;DO GENERAL DATA SETUP
	MOVE	T1,JOBNUM	;GET JOB NUMBER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS JOB?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	PUSHJ	P,CHKJOB	;GATHER ALL THE DATA
	PUSHJ	P,MAKSES	;NOW MAKE THE SESSION ENTRY
	MOVEI	T1,SESDVS	;POINT TO ROUTINE TO MAKE ENTRIES
	SKIPE	CPJBUF+CDEVFL	;ANY DEVICES FOR THIS JOB
	PUSHJ	P,ALLDEV	;CALL IT FOR ALL USER DEVICES
	PUSHJ	P,CPJCOP	;COPY THE PRIMARY DATA TO AUXILLIARY BUFFER
	PUSHJ	P,CPJSES	;COPY NEW DATA TO CPJBUF FROM IPCF MESSAGE
	PUSHJ	P,WRITJP	;WRITE THE BUFFER.
	SKIPE	QUEFLG		;QUEUE. UUO?
	PJRST	QUEACK		;YES--ACK AND RETURN
;	JRST	SNDRSP		;FALL INTO STANDARD RESPONSE STUFF


SNDRSP:	MOVE	T2,MMSADR	;USE THE SAME PAGE WE RECEIVED
	MOVEM	T2,IPS.BL+SAB.MS	;ADDRESS OF DATA
	MOVE	T1,ACKCOD	;GET THE UNIQUE MESSAGE IDENTIFIER
	MOVEM	T1,UC$ACK(T2)
	MOVEI	T1,UGTRU$	;INDICATE ALL OK
	MOVEM	T1,UC$RES(T2)
	MOVEI	T1,UGVAC$	;INDICATE RESPONSE MESSAGE
	MOVEM	T1,UC$TYP(T2)
	MOVE	T1,MDBADR	;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
	MOVE	T1,MDB.SP(T1)	;GET PID OF THE JOB
	MOVEM	T1,IPS.BL+SAB.PD
	MOVEI	T1,1000		;INDICATE A PAGE IS BEING SENT
	MOVEM	T1,IPS.BL+SAB.LN
	MOVEI	S1,SAB.SZ	;LENGTH OF SEND ARGUMENT BLOCK
	MOVEI	S2,IPS.BL	;ADDRESS OF SEND ARGUMENT BLOCK
	$CALL	C%SEND		;SEND THE MESSAGE, GLXLIB
	JUMPT	.POPJ		;PROPOGATE TRUE RETURN
	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.SD(T1)	;SENDER'S PPN
	MOVE	T3,MDB.PV(T1)
	ANDX	T3,MD.PJB	;JOB NUMBER OF SENDER
	$WTOXX	<Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
	$RETT
;CPJSES - ROUTINE TO COPY DATA FROM THE IPCF MESSAGE (SENT BECAUSE OF A
;	SESSION COMMAND TYPED BY A USER) TO THE PRIMARY CHECKPOINT BUFFER (CPJBUF).

CPJSES:	MOVE	T1,.JBVER	;ACCOUNT DAEMON VERSION NUMBER
	MOVEM	T1,CPJBUF+CACVER
	MOVE	T1,DATADR	;ADDRESS OF DATA
	MOVE	T2,US$ACK(T1)	;GET THE UNIQUE MESSAGE IDENTIFIER
	MOVEM	T2,ACKCOD	;AND SAVE IT FOR THE RESPONSE MESSAGE
	MOVE	T2,US$PRG(T1)	;PROGRAM NAME
	MOVEM	T2,CPJBUF+CPGNAM
	MOVE	T2,US$VER(T1)	;PROGRAM VERSION NUMBER
	MOVEM	T2,CPJBUF+CPGVER
	MOVE	T2,US$ACT(T1)	;GET FIRST WORD OF ACCOUNT STRING
	AOJE	T2,CPJSE1	; (SENT AS -1 IS NO CHANGE IN ACCOUNT STRING)
	MOVEI	T2,CPJBUF+CACCT	;NEW ACCOUNT
	HRLI	T2,US$ACT(T1)
	BLT	T2,CPJBUF+CACCT+7
CPJSE1:	MOVE	T2,US$BEG(T1)	;SESSION START DATE/TIME
	MOVEM	T2,CPJBUF+CSESST
	MOVEM	T2,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE NEXT CHECKPOINT
	MOVE	T2,US$RMK(T1)	;GET REMARK
	AOJE	T2,.POPJ	; (SENT AS -1 IF NO CHANGE IN REMARK)
	MOVEI	T2,CPJBUF+CRMRK	;NEW SESSION REMARK
	HRLI	T2,US$RMK(T1)
	BLT	T2,CPJBUF+CRMRK+7
	POPJ	P,

;ROUTINE CALLED FROM ACTSES (VIA ALLDEV) TO MAKE DEVICE SESSION ENTRIES

SESDVS:	PUSHJ	P,@[EXP CHKFSR,CHKMTA,CHKDTA,CHKSPN]-1(P1) ;CHECKPOINT IT
	PUSHJ	P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
	PUSHJ	P,CPDCOP	;MOVE CURRENT DATA TO AUX AREA
	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME
	MOVEM	T1,@[EXP CPDBUF+FSESST,CPDBUF+MSESST,CPDBUF+DSESST,CPDBUF+SCSHIF]-1(P1)
	CAIN	P1,SPNTYP	;NO SPINDLE RECORDS IN JOB FILES
	PUSHJ	P,ACTIDT	;CRASH CAUSE THERES NO ACCOUNT STRING FOR THEM
	MOVE	T2,DATADR	;NEW ACCOUNT STRING IN MESSAGE FROM LOGIN
	MOVE	T1,US$ACT(T2)	;GET FIRST WORD OF ACCOUNT STRING
	AOJE	T1,SESDV1	;SENT AS -1 IF NO CHANGE IN ACCOUNT STRING
	MOVSI	T1,US$ACT(T2)	;SOURCE = NEW ACCOUNT STRING
	HRR	T1,[EXP CPDBUF+FACCT,CPDBUF+MACCT,CPDBUF+DACCT]-1(P1)
	BLT	T1,@[EXP CPDBUF+FACCT+7,CPDBUF+MACCT+7,CPDBUF+DACCT+7]-1(P1)
SESDV1:	PUSHJ	P,WRITDP	;WRITE IT BACK OUT
	POPJ	P,		;RETURN FOR NEXT DEVICE
;ACTATT - ROUTINE TO TAKE ACTION WHEN A USER ATTACHES TO HIS JOB WITH AN
;	ATTACH COMMAND.  ONLY THE NEW LINE NUMBER AND NODE NAME (IF ANY)
;	ARE COPYED TO THE JOB SLOT OF THE PRIMARY JOB CHECKPOINT FILE (CPJBUF).
;	NO SESSION ENTRY IS MADE.  MMSADR AND MDBADR ARE ALREADY SET UP.

ACTATT:	PUSHJ	P,.SAVE1	;SAVE P1
	PUSHJ	P,IPCGEN	;DO GENERAL DATA SETUP
	MOVE	P1,DATADR	;ADDRESS OF THE DATA FROM LOGIN
	MOVE	P1,UA$TJN(P1)	;GET TARGET JOB NUMBER
	CAMLE	P1,JOBMAX	;CAN WE CHECKPOINT THIS JOB?
	FATAL	(JCE,<Job capacity exceeded by job ^D/P1/>,ACJCE%,ACTVXT)
	EXCH	P1,JOBNUM	;FETCH SENDERS JOB NUMBER, STORE TARGET
	CAMLE	P1,JOBMAX	;CAN WE CHECKPOINT THIS JOB?
	FATAL	(JCE,<Job capacity exceeded by job ^D/P1/>,ACJCE%,ACTVXT)
	PUSHJ	P,READJP	;READ IT IN
	PUSHJ	P,CPJATT	;COPY NEW DATA TO CPJBUF FROM IPCF MESSAGE
	PUSHJ	P,DOFDTT	;COMPUTE UNBILLED TTY STATS FOR OLD TERMINAL
	EXCH	P1,JOBNUM	;GET STATS FOR TTY WHERE LOGIN IS NOW
	PUSHJ	P,GTTTYS	; THAT IS WHERE THE TARGET JOB WILL BE
	MOVE	T1,CPJBUF+CTTCMD ;COMMANDS ON THIS TERMINAL
	SUB	T1,SESBLK+CTTCMD ;NUMBER LEFT OUT OF LAST BILLING SESSION
	MOVEM	T1,CAJBUF+CTTCMD ;OFFSET SO WILL BE INCLUDED ON NEXT BILL
	MOVE	T1,CPJBUF+CTTYI  ;INPUT CHARACTER COUNTS
	SUB	T1,SESBLK+CTTYI
	MOVEM	T1,CAJBUF+CTTYI
	MOVE	T1,CPJBUF+CTTYO  ;OUTPUT CHARACTER COUNTS
	SUB	T1,SESBLK+CTTYO
	MOVEM	T1,CAJBUF+CTTYO
	MOVE	T1,CPJBUF+CTTYBR ;BREAK CHARACTER COUNTS
	SUB	T1,SESBLK+CTTYBR
	MOVEM	T1,CAJBUF+CTTYBR
	MOVEM	P1,JOBNUM	;WRITE DATA FOR TARGET JOB
	PUSHJ	P,WRITJP	;WRITE THE BUFFER.
	SKIPN	QUEFLG		;QUEUE. UUO?
	PJRST	SNDRSP		;NO--SEND A RESPONSE AND RETURN
	PJRST	QUEACK		;ACK APPROPRIATELY AND RETURN


;CPJATT - ROUTINE TO COPY DATA FROM THE IPCF MESSAGE (SENT BECAUSE OF A
;	ATTACH COMMAND TYPED BY A USER) TO THE PRIMARY CHECKPOINT BUFFER (CPJBUF).

CPJATT:	MOVE	T1,.JBVER	;ACCOUNT DAEMON VERSION NUMBER
	MOVEM	T1,CPJBUF+CACVER
	MOVE	T1,DATADR	;ADDRESS OF DATA
	MOVE	T2,UA$ACK(T1)	;GET UNIQUE MESSAGE IDENTIFIER
	MOVEM	T2,ACKCOD	;SAVE IT FOR THE RESPONSE MESSAGE
	MOVE	T2,UA$PRG(T1)	;PROGRAM NAME
	MOVEM	T2,CPJBUF+CPGNAM
	MOVE	T2,UA$VER(T1)	;PROGRAM VERSION NUMBER
	MOVEM	T2,CPJBUF+CPGVER
	MOVE	T2,UA$LIN(T1)	;LINE NUMBER
	MOVEM	T2,CPJBUF+CLINNO
	MOVE	T2,UA$NOD(T1)	;NODE NAME
	MOVEM	T2,CPJBUF+CNODE
	MOVE	T2,UA$TDE(T1)	;TERMINAL DESIGNATOR
	MOVEM	T2,CPJBUF+CTERDE
	POPJ	P,
;ACTOUT - ROUTINE TO TAKE ACTION WHEN THE MONITOR SENDS THE ACCOUNT DAEMON A
;	LOGOUT MESSAGE.  NOTE THAT THIS CAN HAPPEN EVEN IF A USER DOES NOT LOG
;	IN (E.G., HE TYPES A ^C BEFORE LOGIN DOES THE LOGIN UUO).

ACTOUT:	SKIPE	GFRFLG		;MUST BE FROM [SYSTEM]GOPHER
	SKIPE	QUEFLG		;AND NOT A USER'S QUEUE. UUO
	JRST	NOPRV		;WRONG. GIVE 'NOT PRIVILEGED' ERROR
	MOVE	T1,DATADR	;MESSAGE ADDRESS
	MOVE	T1,LGO.JB(T1)
	ANDX	T1,LG.JOB	;JOB NUMBER DOING LOGOUT UUO
	HLRZS	T1		;PUT JOB NUMBER IN RIGHT HALF
	MOVEM	T1,JOBNUM	;STORE IT
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS JOB?
	JRST	ACTOT1		;NO, JUST ACK [SYSTEM]GOPHER
	PUSHJ	P,CHKJOB	;GATHER ALL THE DATA
	PUSHJ	P,MAKSES	;CHECKPOINT THE JOB AND MAKE A SESSION ENTRY
	HRROI	T1,LGODVS	;ROUTINE TO MAKE DEVICE ENTRIES
	PUSHJ	P,ALLDEV	;CALL IT FOR ALL DEVICES THAT WE KNOW ABOUT
	PUSHJ	P,CBJZER	;NOW ZERO THE PRIMARY SLOT
	PUSHJ	P,CPJCOP	;COPY TO AUXILLIARY SLOT
	PUSHJ	P,WRITJP	;WRITE ZEROES TO PRIMARY CHECKPOINT FILE
ACTOT1:	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T1,MDB.SP(T1)	;PID OF [SYSTEM]GOPHER
	MOVEM	T1,IPS.BL+SAB.PD ;STORE IT IN THE SEND ARGUMENT BLOCK
	MOVEI	T1,1		;LENGTH OF MESSAGE
	MOVEM	T1,IPS.BL+SAB.LN
	MOVE	T1,MMSADR	;ADDRESS OF DATA
	MOVEM	T1,IPS.BL+SAB.MS
	MOVE	T2,JOBNUM	;JOB NUMBER OF USER LOGGING OUT
	MOVEM	T2,(T1)		;TELL [SYSTEM]GOPHER
	MOVEI	S1,SAB.SZ
	MOVEI	S2,IPS.BL
	$CALL	C%SEND
	JUMPT	.POPJ		;RETURN IF OK
	MOVE	T1,MDBADR	;MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.SD(T1)	;SENDER'S PPN
	MOVE	T3,MDB.PV(T1)
	ANDX	T3,MD.PJB	;JOB NUMBER OF SENDER
	$WTOXX	<Error (^E/S1/) sending LOGOUT response to job ^D/T3/ user ^P/T2/>
	$RETT

;ROUTINE TO MAKE THE ENTRIES FOR THE DEVICES OWNED BY THE JOB LOGGING OUT
;  CAN'T CHECKPOINT HERE CAUSE DEVICES WERE RELEASED BEFORE WE SEE THIS JOB

LGODVS:	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME (ONLY THING TO CHECKPOINT)
	MOVEM	T1,@[EXP CPDBUF+FLSTCK,CPDBUF+MLSTCK,CPDBUF+DLSTCK,CPDBUF+SLSTCK]-1(P1)
	PUSHJ	P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
	PUSHJ	P,CBDZER	;CLEAR THE BLOCK
	PUSHJ	P,CPDCOP	;BOTH HALVES
	PUSHJ	P,WRITDP	;ZAP THE DISK AREA
	POPJ	P,		;AND RETURN FOR THE NEXT
;ACTFDM - Routine called when a mount message for a user file structure
;	is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTFDM:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UF$JOB(T2)	;GET THE JOB NUMBER OF THE USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE IT FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UF$DEV(T2)	;FILE STRUCTURE NAME
	PUSHJ	P,FNDDEV	;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
	JUMPT	ACTFD1		;WHAT, ALREADY FOUND, SOMEONE IS CONFUSED
	PUSHJ	P,CBDZER	;CLEAR OUT THE DEVICE AREA
	PUSHJ	P,CPDCOP	;AND THE SESSION/CSHIFT AREA
	PUSHJ	P,CPDFDM	;COPY MESSAGE DATA TO CPDBUF
	MOVE	T1,DEVAVL
	MOVEM	T1,DEVNUM	;WRITE THE DEVICE AREA
	PUSHJ	P,WRITDP
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	AOS	CPJBUF+CDEVFL	;INCREMENT DEVICE COUNT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTFD1:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
;	JRST	SNDACK		;FALL INTO STANDARD SEND ACK CODE


SNDACK:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVE	T1,.MSFLG(T2)	;FLAGS WORD
	TXNN	T1,MF.ACK	;DID HE WANT AN ACK?
	JRST	IGNORE		;NO. RELEASE MESSAGE AND RETURN
	MOVE	T1,[.MSCOD+1,,UGACK$]
	MOVEM	T1,.MSTYP(T2)
	MOVX	T1,MF.NOM	;JUST ACK THE MESSAGE
	MOVEM	T1,.MSFLG(T1)	;PRESERVE THE CODE IN .MSCOD
	MOVE	T3,MDBADR	;MESSAGE DESCRIPTOR ADDRESS
	MOVE	T1,MDB.SP(T3)	;PID TO SEND TO
	MOVEM	T1,IPS.BL+SAB.PD
	LOAD 	T1,.MSTYP(T2),MS.CNT	;LENGTH OF MESSAGE
	MOVEM	T1,IPS.BL+SAB.LN
	MOVEI	S1,SAB.SZ	;SEND ARGUMENT BLOCK LENGTH
	MOVEI	S2,IPS.BL	;SEND ARUGMENT BLOCK ADDRESS
	$CALL	C%SEND
	JUMPT	.POPJ		;PROPOGATE TRUE RETURN
	$WTOXX	<Error (^E/S1/) sending ACK message>
	$RETT
;CPDFDM - Routine to copy data from user file structure mount message to CPDBUF.

CPDFDM:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVEI	T1,FSRTYP	;DEVICE TYPE
	MOVEM	T1,CPDBUF+DEVTYP
	MOVE	T1,UF$DEV(T2)	;DEVICE NAME
	MOVEM	T1,CPDBUF+DEVICE
	MOVE	T1,UF$JOB(T2)	;JOB NUMBER OF USER
	MOVEM	T1,CPDBUF+FJOB
	MOVE	T1,UF$TRD(T2)	;TERMINAL DESIGNATOR
	MOVEM	T1,CPDBUF+FTERDE
	MOVE	T1,.JBVER	;ACTDAE VERSION NUMBER
	MOVEM	T1,CPDBUF+FACVER
	$CALL	I%NOW		;GET CURRENT DATE/TIME
	MOVEM	S1,CPDBUF+FLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
	MOVEM	S1,CPDBUF+FSESST ;SESSION START DATE/TIME
	MOVE	T1,UF$TNO(T2)	;LINE NUMBER OF USER
	MOVEM	T1,CPDBUF+FLINNO
	MOVE	T1,UF$PNM(T2)	;PROGRAM NAME (PULSAR)
	MOVEM	T1,CPDBUF+FPGNAM
	MOVE	T1,UF$PVR(T2)	;PROGRAM'S VERSION NUMBER
	MOVEM	T1,CPDBUF+FPGVER
	MOVE	T1,UF$NOD(T2)	;NODE NAME OF USER
	MOVEM	T1,CPDBUF+FNODE
	HRLI	T1,UF$ACT(T2)	;ACCOUNT STRING
	HRRI	T1,CPDBUF+FACCT
	BLT	T1,CPDBUF+FACCT+7
	MOVE	T1,UF$PPN(T2)	;USER'S PROJECT PROGRAMMER NUMBER
	MOVEM	T1,CPDBUF+FPPN
	DMOVE	T3,UF$NM1(T2)	;USER'S NAME
	DMOVEM	T3,CPDBUF+FNAME1
	MOVE	T1,UF$STY(T2)	;TYPE OF FILE STRUCTURE
	MOVEM	T1,CPDBUF+FFSTYP
	MOVE	T1,UF$PNO(T2)	;NUMBER OF PACKS IN FILE STRUCTURE
	MOVEM	T1,CPDBUF+FPCKNO
	MOVE	T1,UF$CTY(T2)	;CONTROLLER TYPE
	MOVEM	T1,CPDBUF+FCONTY
	MOVE	T1,UF$DTY(T2)	;DEVICE TYPE
	MOVEM	T1,CPDBUF+FDEVTY
	MOVE	T1,UF$DSP(T2)	;DISPOSITION
	MOVEM	T1,CPDBUF+FDISPO
	HRLI	T1,UF$TXT(T2)	;TEXT TO EXPLAIN DISPOSITION
	HRRI	T1,CPDBUF+FOTEXT
	BLT	T1,CPDBUF+FOTEXT+7
	MOVE	T1,UF$CDT(T2)	;CREATION DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+FCREDT
	MOVE	T1,UF$SDT(T2)	;SCHEDULED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+FSCHDT
	MOVE	T1,UF$VDT(T2)	;SERVICED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+FSERDT
	MOVE	T1,UF$CBR(T2)	;MOUNT COUNT BEFORE REQUEST
	MOVEM	T1,CPDBUF+FMNTCT
	MOVE	T1,UF$ACC(T2)	;ACCESS TYPE
	MOVEM	T1,CPDBUF+FACCES
	POPJ	P,
;ACTFDD - Routine called when a dismount message for a user file structure
;	is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTFDD:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UF$JOB(T2)	;JOB NUMBER OF USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UF$DEV(T2)	;FILE STRUCTURE NAME
	PUSHJ	P,FNDDEV	;FIND THE DEVICE ENTRY
	JUMPF	ACTFD2		;DIDN'T FOUND THE FILE STRUCTURE ENTRY
	PUSHJ	P,CPDFDD	;COPY DATA FROM THE MESSAGE
	$CALL	DATIM		;GET CURRENT DATE/TIME
	PUSHJ	P,CHKFSR	;CHECKPOINT THE DATA
	PUSHJ	P,MAKFSR	;GO MAKE AN ENTRY
	PUSHJ	P,CBDZER	;ZERO THE DEVICE AREA
	PUSHJ	P,CPDCOP	;COPY IN CASE OF AUXILLIARY DATA
	PUSHJ	P,WRITDP	;WRITE IT OUT
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	SOSG	CPJBUF+CDEVFL	;DECREMENT DEVICE COUNT
	PUSHJ	P,CPDDEL	;FILE IS NOW EMPTY, DELETE IT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTFD2:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN


;CPDFDD - Routine to copy data from user file structure dismount message to
;	CPDBUF.

CPDFDD:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVE	T1,UF$SCT(T2)	;MOUNT COUNT AFTER DISMOUNT
	MOVEM	T1,CPDBUF+FDISCT
	POPJ	P,
;ACTMGM - Routine called when a mount message for a user magtape is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTMGM:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UM$JOB(T2)	;GET THE JOB NUMBER OF THE USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE IT FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UM$DEV(T2)	;DEVICE NAME
	PUSHJ	P,FNDDEV	;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
	JUMPT	ACTMG1		;ALREADY FOUND, SOMEONE IS CONFUSED
	PUSHJ	P,CBDZER	;CLEAR OUT THE DEVICE AREA
	PUSHJ	P,CPDCOP	;AND THE SESSION/CSHIFT AREA
	PUSHJ	P,CPDMGM	;COPY MESSAGE DATA TO CPDBUF
	MOVE	T1,DEVAVL
	MOVEM	T1,DEVNUM	;WRITE THE DEVICE AREA
	PUSHJ	P,WRITDP
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	AOS	CPJBUF+CDEVFL	;INCREMENT DEVICE COUNT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTMG1:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN
;CPDMGM - Routine to copy data from user magtape mount message to CPDBUF.

CPDMGM:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVEI	T1,MAGTYP	;DEVICE TYPE
	MOVEM	T1,CPDBUF+DEVTYP
	MOVE	T1,UM$DEV(T2)	;DEVICE NAME
	MOVEM	T1,CPDBUF+DEVICE
	MOVE	T1,UM$JOB(T2)	;JOB NUMBER OF USER
	MOVEM	T1,CPDBUF+MJOB
	MOVE	T1,UM$TRD(T2)	;TERMINAL DESIGNATOR
	MOVEM	T1,CPDBUF+MTERDE
	MOVE	T1,.JBVER	;ACTDAE VERSION NUMBER
	MOVEM	T1,CPDBUF+MACVER
	$CALL	I%NOW		;GET CURRENT DATE/TIME
	MOVEM	S1,CPDBUF+MLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
	MOVEM	S1,CPDBUF+MSESST ;SESSION START DATE/TIME
	MOVE	T1,UM$TNO(T2)	;LINE NUMBER OF USER
	MOVEM	T1,CPDBUF+MLINNO
	MOVE	T1,UM$PNM(T2)	;PROGRAM NAME (PULSAR)
	MOVEM	T1,CPDBUF+MPGNAM
	MOVE	T1,UM$PVR(T2)	;PROGRAM'S VERSION NUMBER
	MOVEM	T1,CPDBUF+MPGVER
	MOVE	T1,UM$NOD(T2)	;NODE NAME OF USER
	MOVEM	T1,CPDBUF+MNODE
	HRLI	T1,UM$ACT(T2)	;ACCOUNT STRING
	HRRI	T1,CPDBUF+MACCT
	BLT	T1,CPDBUF+MACCT+7
	MOVE	T1,UM$PPN(T2)	;USER'S PROJECT PROGRAMMER NUMBER
	MOVEM	T1,CPDBUF+MPPN
	DMOVE	T3,UM$NM1(T2)	;USER'S NAME
	DMOVEM	T3,CPDBUF+MNAME1
	MOVE	T1,UM$CTY(T2)	;CONTROLLER TYPE
	MOVEM	T1,CPDBUF+MCONTY
	MOVE	T1,UM$DSP(T2)	;DISPOSITION
	MOVEM	T1,CPDBUF+MDISPO
	HRLI	T1,UM$TXT(T2)	;TEXT TO EXPLAIN DISPOSITION
	HRRI	T1,CPDBUF+MOTEXT
	BLT	T1,CPDBUF+MOTEXT+7
	MOVE	T1,UM$CDT(T2)	;CREATION DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+MCREDT
	MOVE	T1,UM$SDT(T2)	;SCHEDULED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+MSCHDT
	MOVE	T1,UM$VDT(T2)	;SERVICED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+MSERDT
	MOVE	T1,UM$VID(T2)	;VOLUME ID IN VOL1 LABEL
	MOVEM	T1,CPDBUF+MVOLID
	MOVE	T1,UM$RID(T2)	;REEL ID
	MOVEM	T1,CPDBUF+MRELID
	MOVE	T1,UM$LTY(T2)	;LABEL TYPE
	MOVEM	T1,CPDBUF+MLABEL
	MOVE	T1,UM$LST(T2)	;VOLUME LABEL STATE
	MOVEM	T1,CPDBUF+MSTATE
	MOVE	T1,UM$FSI(T2)	;FILE SET IDENTIFIER
	MOVEM	T1,CPDBUF+MFSTID
	POPJ	P,
;ACTMGD - Routine called when a dismount message for a user magtape is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTMGD:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UM$JOB(T2)	;JOB NUMBER OF USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UM$DEV(T2)	;DEVICE NAME
	PUSHJ	P,FNDDEV	;FIND THE DEVICE ENTRY
	JUMPF	ACTMG2		;DIDN'T FOUND THE MAGTAPE ENTRY
	PUSHJ	P,CPDMGD	;COPY DATA FROM THE MESSAGE
	$CALL	DATIM		;GET CURRENT DATE/TIME
	MOVEM	S1,CPDBUF+MLSTCK ;STORE AS TIME OF LAST CHECKPOINT
	PUSHJ	P,MAKMAG	;GO MAKE AN ENTRY
	PUSHJ	P,CBDZER	;ZERO THE DEVICE AREA
	PUSHJ	P,CPDCOP	;COPY IN CASE OF AUXILLIARY DATA
	PUSHJ	P,WRITDP	;WRITE IT OUT
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	SOSG	CPJBUF+CDEVFL	;DECREMENT DEVICE COUNT
	PUSHJ	P,CPDDEL	;FILE IS NOW EMPTY, DELETE IT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTMG2:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN


;CPDMGD - Routine to copy data from user magtape dismount message to CPDBUF.

CPDMGD:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UM$MRD(T2)	;CHARACTERS READ
	MOVEM	T1,CPDBUF+MMREAD
	MOVE	T1,UM$MWR(T2)	;CHARACTERS WRITTEN
	MOVEM	T1,CPDBUF+MMWRIT
	MOVE	T1,UM$RRD(T2)	;RECORDS READ
	MOVEM	T1,CPDBUF+MRECRD
	MOVE	T1,UM$SRE(T2)	;SOFT READ ERRORS
	MOVEM	T1,CPDBUF+MNOSRE
	MOVE	T1,UM$SWE(T2)	;SOFT WRITE ERRORS
	MOVEM	T1,CPDBUF+MNOSWE
	MOVE	T1,UM$HRE(T2)	;HARD READ ERRORS
	MOVEM	T1,CPDBUF+MNOHRE
	MOVE	T1,UM$HWE(T2)	;HARD WRITE ERRORS
	MOVEM	T1,CPDBUF+MNOHWE
	POPJ	P,
;ACTDTM - Routine called when a mount message for a user DECtape is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTDTM:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UD$JOB(T2)	;GET THE JOB NUMBER OF THE USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE IT FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UD$DEV(T2)	;DEVICE NAME
	PUSHJ	P,FNDDEV	;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
	JUMPT	ACTDT1		;ALREADY HAVE IT, SOMEBODY IS CONFUSED
	PUSHJ	P,CBDZER	;CLEAR OUT THE DEVICE AREA
	PUSHJ	P,CPDCOP	;AND THE SESSION/CSHIFT AREA
	PUSHJ	P,CPDDTM	;COPY MESSAGE DATA TO CPDBUF
	MOVE	T1,DEVAVL
	MOVEM	T1,DEVNUM	;WRITE THE DEVICE AREA
	PUSHJ	P,WRITDP
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	AOS	CPJBUF+CDEVFL	;INCREMENT DEVICE COUNT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTDT1:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN
;CPDDTM - Routine to copy data from user DECtape mount message to CPDBUF.

CPDDTM:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVEI	T1,DECTYP	;DEVICE TYPE
	MOVEM	T1,CPDBUF+DEVTYP
	MOVE	T1,UD$DEV(T2)	;DEVICE NAME
	MOVEM	T1,CPDBUF+DEVICE
	MOVE	T1,UD$JOB(T2)	;JOB NUMBER OF USER
	MOVEM	T1,CPDBUF+DJOB
	MOVE	T1,UD$TRD(T2)	;TERMINAL DESIGNATOR
	MOVEM	T1,CPDBUF+DTERDE
	MOVE	T1,.JBVER	;ACTDAE VERSION NUMBER
	MOVEM	T1,CPDBUF+DACVER
	$CALL	I%NOW		;GET CURRENT DATE/TIME
	MOVEM	S1,CPDBUF+DLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
	MOVEM	S1,CPDBUF+DSESST ;SESSION START DATE/TIME
	MOVE	T1,UD$TNO(T2)	;LINE NUMBER OF USER
	MOVEM	T1,CPDBUF+DLINNO
	MOVE	T1,UD$PNM(T2)	;PROGRAM NAME (PULSAR)
	MOVEM	T1,CPDBUF+DPGNAM
	MOVE	T1,UD$PVR(T2)	;PROGRAM'S VERSION NUMBER
	MOVEM	T1,CPDBUF+DPGVER
	MOVE	T1,UD$NOD(T2)	;NODE NAME OF USER
	MOVEM	T1,CPDBUF+DNODE
	HRLI	T1,UD$ACT(T2)	;ACCOUNT STRING
	HRRI	T1,CPDBUF+DACCT
	BLT	T1,CPDBUF+DACCT+7
	MOVE	T1,UD$PPN(T2)	;USER'S PROJECT PROGRAMMER NUMBER
	MOVEM	T1,CPDBUF+DPPN
	DMOVE	T3,UD$NM1(T2)	;USER'S NAME
	DMOVEM	T3,CPDBUF+DNAME1
	MOVE	T1,UD$DSP(T2)	;DISPOSITION
	MOVEM	T1,CPDBUF+DDISPO
	HRLI	T1,UD$TXT(T2)	;TEXT TO EXPLAIN DISPOSITION
	HRRI	T1,CPDBUF+DOTEXT
	BLT	T1,CPDBUF+DOTEXT+7
	MOVE	T1,UD$CDT(T2)	;CREATION DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+DCREDT
	MOVE	T1,UD$SDT(T2)	;SCHEDULED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+DSCHDT
	MOVE	T1,UD$VDT(T2)	;SERVICED DATE/TIME OF MOUNT REQUEST
	MOVEM	T1,CPDBUF+DSERDT
	MOVE	T1,UD$VID(T2)	;VOLUME ID IN VOL1 LABEL
	MOVEM	T1,CPDBUF+DVOLID
	MOVE	T1,UD$RID(T2)	;REEL ID
	MOVEM	T1,CPDBUF+DRELID
	POPJ	P,
;ACTDTD - Routine called when a dismount message for a user DECtape is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTDTD:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	MOVE	T1,UD$JOB(T2)	;JOB NUMBER OF USER
	CAMLE	T1,JOBMAX	;CAN WE CHECKPOINT THIS USER?
	FATAL	(JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
	MOVEM	T1,JOBNUM	;STORE FOR THE CHECKPOINT FILE NAME
	MOVE	T1,UD$DEV(T2)	;DEVICE NAME
	PUSHJ	P,FNDDEV	;FIND THE DEVICE ENTRY
	JUMPF	ACTDT2		;DIDN'T FOUND THE DECTAPE ENTRY
	PUSHJ	P,CPDDTD	;COPY DATA FROM THE MESSAGE
	$CALL	DATIM		;GET CURRENT DATE/TIME
	PUSHJ	P,CHKDTA	;CHECKPOINT THE DATA
	PUSHJ	P,MAKDEC	;GO MAKE AN ENTRY
	PUSHJ	P,CBDZER	;ZERO THE DEVICE AREA
	PUSHJ	P,CPDCOP	;COPY IN CASE OF AUXILLIARY DATA
	PUSHJ	P,WRITDP	;WRITE IT OUT
	PUSHJ	P,READJP	;READ IN JOB PROPER DATA
	SOSG	CPJBUF+CDEVFL	;DECREMENT DEVICE COUNT
	PUSHJ	P,CPDDEL	;FILE IS NOW EMPTY, DELETE IT
	PUSHJ	P,WRITJP	;AND RE-WRITE THE DATA
ACTDT2:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN


;CPDDTD - Routine to copy data from user DECtape dismount message to CPDBUF.

CPDDTD:	POPJ	P,
;ACTSPM - Routine called when a mount message for a disk spindle is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTSPM:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	SETZM	JOBNUM		;JOB NUMBER 0 IS USED FOR SPINDLES
	MOVE	T1,US$DEV(T2)	;DISK UNIT NAME
	PUSHJ	P,FNDDEV	;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
	JUMPT	ACTSP1		;ALREADY HAVE IT, SOMEONE IS CONFUSED
	PUSHJ	P,CBDZER	;CLEAR OUT THE DEVICE AREA
	PUSHJ	P,CPDCOP	;AND THE SESSION/CSHIFT AREA
	PUSHJ	P,CPDSPM	;COPY MESSAGE DATA TO CPDBUF
	MOVE	T1,DEVAVL
	MOVEM	T1,DEVNUM	;WRITE THE DEVICE AREA
	PUSHJ	P,WRITDP
ACTSP1:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN
;CPDSPM - Routine to copy data from disk spindle mount message to CPDBUF.

CPDSPM:	MOVE	T2,MMSADR	;MESSAGE ADDRESS
	MOVEI	T1,SPNTYP	;DEVICE TYPE
	MOVEM	T1,CPDBUF+DEVTYP
	MOVE	T1,US$DEV(T2)	;DISK UNIT NAME
	MOVEM	T1,CPDBUF+DEVICE
	MOVEM	T1,DCHRBL+.DCNAM	;GET THE ALTERNATE PORT IF IT EXISTS
	MOVE	T1,[.DCALT+1,,DCHRBL]
	DSKCHR	T1,
	  JFCL
	MOVE	T1,DCHRBL+.DCALT	;GET ALTERNATE PORT
	MOVEM	T1,CPDBUF+ALTPRT
	MOVE	T1,US$JOB(T2)	;JOB NUMBER OF PULSAR
	MOVEM	T1,CPDBUF+SJOB
	MOVE	T1,US$TRD(T2)	;TERMINAL DESIGNATOR
	MOVEM	T1,CPDBUF+STERDE
	MOVE	T1,.JBVER	;ACTDAE VERSION NUMBER
	MOVEM	T1,CPDBUF+SACVER
	$CALL	I%NOW		;GET CURRENT DATE/TIME
	MOVEM	S1,CPDBUF+SLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
	MOVEM	S1,CPDBUF+SCSHIF ;USED FOR CONNECT TIME IN CASE OF CSHIFT
	MOVE	T1,US$TNO(T2)	;LINE NUMBER OF PULSAR
	MOVEM	T1,CPDBUF+SLINNO
	MOVE	T1,US$PNM(T2)	;PROGRAM NAME (PULSAR)
	MOVEM	T1,CPDBUF+SPGNAM
	MOVE	T1,US$PVR(T2)	;PROGRAM'S VERSION NUMBER
	MOVEM	T1,CPDBUF+SPGVER
	MOVE	T1,US$NOD(T2)	;NODE NAME OF PULSAR
	MOVEM	T1,CPDBUF+SNODE
	MOVE	T1,US$STY(T2)	;TYPE OF FILE STRUCTURE
	MOVEM	T1,CPDBUF+SFSTYP
	MOVE	T1,US$PNO(T2)	;NUMBER OF PACKS IN FILE STRUCTURE
	MOVEM	T1,CPDBUF+SPCKNO
	MOVE	T1,US$CTY(T2)	;CONTROLLER TYPE
	MOVEM	T1,CPDBUF+SCONTY
	MOVE	T1,US$DTY(T2)	;DEVICE TYPE
	MOVEM	T1,CPDBUF+SDEVTY
	MOVE	T1,US$DTM(T2)	;DATE/TIME PACK WAS SPUN UP
	MOVEM	T1,CPDBUF+SMNTDT
	MOVE	T1,US$DPI(T2)	;DISK PACK IDENTIFIER
	MOVEM	T1,CPDBUF+SPAKID
	MOVE	T1,US$FSN(T2)	;FILE STRUCTURE NAME
	MOVEM	T1,CPDBUF+SFSNAM
	MOVE	T1,US$MTH(T2)	;M OF N COUNT
	MOVEM	T1,CPDBUF+SPKMTH
	POPJ	P,
;ACTSPD - Routine called when a dismount message for a disk spindle is received.
;Call:	MDBADR contains the message descriptor address
;	MMSADR contains the message address

ACTSPD:	MOVE	T2,MMSADR	;ADDRESS OF MESSAGE
	SETZM	JOBNUM		;USE JOB 0 FOR SPINDLE USAGE
	MOVE	T1,US$DEV(T2)	;FILE STRUCTURE NAME
	PUSHJ	P,FNDDEV	;FIND THE DEVICE ENTRY
	JUMPF	ACTSP2		;DIDN'T FOUND THE FILE STRUCTURE ENTRY
	PUSHJ	P,CPDSPD	;COPY DATA FROM THE MESSAGE
	$CALL	DATIM		;GET CURRENT DATE/TIME
	PUSHJ	P,CHKSPN	;CHECKPOINT THE SPINDLE
	PUSHJ	P,MAKSPN	;GO MAKE AN ENTRY
	PUSHJ	P,CBDZER	;ZERO THE DEVICE AREA
	PUSHJ	P,CPDCOP	;COPY IN CASE OF AUXILLIARY DATA
	PUSHJ	P,WRITDP	;WRITE IT OUT
ACTSP2:	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PJRST	SNDACK		;SEND ACK AND RETURN


;CPDSPD - Routine to copy data from disk spindle spin-down message to CPDBUF.

CPDSPD:	POPJ	P,
;ACTCHD - Routine called when the operator has changed the Date/Time
;Call:	DTCPSI+.PSVIS contains the date/time offset

ACTCHD:	MOVE	T1,DTCPSI+.PSVIS;GET DATE/TIME OFFSET
	MOVEM	T1,DTMOFS	;STORE FOR LATER ADJUSTMENT
	PUSHJ	P,CHKAJB	;CHECKPOINT ALL STUFF, ADJUSTING FOR NEW TIME
	MOVM	T1,DTCPSI+.PSVIS;GET OFFSET BETWEEN TIMES
	HLRZM	T1,DAEOFD	;STORE NUMBER OF DAYS
	TLZ	T1,-1		;CLEAR DAYS
	MUL	T1,[^D24*^D60*^D60] ;CONVERT TO SECONDS
	DIV	T1,[1,,0]	;...
	TRNE	T2,1B18		;SHOULD IT BE ROUNDED
	AOS	T1		;YES
	MOVEM	T1,DAEOFS	;STORE OFFSET IN SECONDS
	MOVE	T1,MONJNO	;ACTDAE'S JOB NUMBER
	PUSHJ	P,SETTNL	;FIGURE OUT WHERE WE ARE
	PUSHJ	P,DATIM		;FETCH CURRENT DATE/TIME
	SUB	S1,DTMOFS	;ADJUST CURRENT TIME BY OFFSET
	MOVEM	S1,DAEODT	;STORE AS OLD DATE/TIME
	SETZM	DTMOFS		;BACK TO NORMAL TIME
	MOVEI	T1,.UTTAD	;ENTRY = DATE/TIME CHANGE
	MOVEI	DEFADR,DTMDFS	;POINT TO THE DEFUS LIST
	PUSHJ	P,MAKENT	;MAKE THE ENTRY
	$RETT			;SO DON'T BOTHER SENDING IT ONE
;THE DEFUS LIST FOR DATE/TIME ENTRY

DTMDFS:	USJNO.	(MONJNO)	;OUR JOB NUMBER
	USTAD.	(CURDTM)	;THE DATE/TIME
	USTRM.	(MONTDE)	;OUR TERMINAL DESIGNATOR
	USLNO.	(MONLNO)	;OUR LINE NUMBER
	USNOD.	(MONNOD)	;OUR NODE NAME
	USPNM.	([SIXBIT /ACTDAE/])	;ACTDAES PROGRAM NAME
	USPVR.	(.JBVER)	;AND VERSION NUMBER
	USAMV.	(.JBVER)	;ACTDAE VERSION NUMBER
	USODT.	(DAEODT)	;OLD DATE/TIME
	USOFD.	(DAEOFD)	;OFFSET IN DAYS
	USOFS.	(DAEOFS)	;OFFSET IN SECONDS
	0			;AND A ZERO TO TERMINATE THE LIST

DAEODT:	BLOCK	1		;SPACE TO HOLD INFORMATION
DAEOFD:	BLOCK	1		;...
DAEOFS:	BLOCK	1		;...
;ACTDUE - ROUTINE CALLED UPON RECEIPT OF A DISK USAGE MESSAGE FROM BACKUP
;CALL:	MMSADR CONTAINS THE MESSAGE ADDRESS

;THIS ROUTINE "KNOWS" THE FORMAT OF AN ENTRY TO BE MADE IN USAGE.OUT AND
;	SINCE DISK RECORDS HAVE AND EXTENSIBLE FORMAT (LOTS OF RECORD 3'S)
;	IT FAKES OUT MAKENT TO DO ITS BIDDING.  BEWARE OF THIS IF SOMEONE
;	CHANGES THE NUMBER OR POSITION OF RECORDS IN A DISK USAGE ENTRY.

ACTDUE:	SETZM	MAKDUE		;CLEAR FLAG
	MOVE	T1,MMSADR	;POINT TO RECEIVED MESSAGE
	HRLI	T2,UB$ACN(T1)	;MOVE DATA FROM MESSAGE
	HRRI	T2,DUEBLK	;TO SCRATCH STORAGE
	BLT	T2,DUEBLK+UB$ACT-UB$ACN-1 ;CAUSE DEFUS LIST CANT HANDLE INDEXING
	PUSHJ	P,DATIM		;SET UP CURRENT DATE/TIME
	SOS	@ENTRYS##-1+.UTFLU ;REDUCE ENTRY TO 2 RECORDS
	MOVEI	T1,.UTFLU	;MAKE DISK USAGE ENTRY
	MOVEI	DEFADR,DUELST	;POINT TO THE DEFUS LIST FOR THE FIRST 2 RECORDS
	PUSHJ	P,MAKENT	;AND MAKE THEM
	AOS	@ENTRYS##-1+.UTFLU ;BACK TO 3 RECORDS IN THE ENTRY
	SETOM	MAKDUE		;FLAG WE ONLY WANT THE LAST ON THIS TIME
	MOVE	P1,MMSADR	;POINT TO THE MESSAGE AGAIN
	MOVEI	P1,UB$ACT(P1)	;POINT TO THE FIRST ACCOUNT STRING SECTION
ACTDU1:	SOSGE	DUEBLK+UB$ACN-UB$ACN ;DONE YET?
	JRST	ACTDU2		;YES, CLEAN UP AND RETURN
	HRLI	T1,UB$ACT-UB$ACT(P1) ;PREPARE TO MOVE THE DATA
	HRRI	T1,DU1BLK	;FROM THE MESSAGE TO THE BLOCK
	BLT	T1,DU1BLK+UB$END-UB$ACT-1 ;POINTED TO BY THE DEFUS LIST
	MOVEI	T1,.UTFLU	;MAKE DISK USAGE ENTRY AGAIN (ONLY 3RD RECORD)
	MOVEI	DEFADR,DU1LST	;POINT TO THE DEFUS LIST
	PUSHJ	P,MAKENT	;AND MAKE THE ENTRY
	ADDI	P1,UB$END-UB$ACT ;STEP TO THE NEXT ACCOUNT STRING DATA
	JRST	ACTDU1		;AND MAKE ANY MORE
ACTDU2:	SETZM	MAKDUE		;DONE FAKING OUT MAKENT
	$RETT			;AND RETURN

;DEFUS LIST FOR DISK USAGE ENTRIES

DUELST:
	USJNO.	(DUEBLK+UB$JOB-UB$ACN) ;JOB NUMBER
	USTAD.	(CURDTM)		;CURRENT DATE/TIME
	USTRM.	(DUEBLK+UB$TRD-UB$ACN) ;TERMINAL DESIGNATOR
	USLNO.	(DUEBLK+UB$TNO-UB$ACN) ;TERMINAL NUMBER
	USPNM.	(DUEBLK+UB$PNM-UB$ACN) ;PROGRAM NAME
	USPVR.	(DUEBLK+UB$PVR-UB$ACN) ;PROGRAM VERSION NUMBER
	USAMV.	(.JBVER)		;ACCOUNT DAEMON VERSION NUMBER
	USNOD.	(DUEBLK+UB$NOD-UB$ACN) ;NODE NUMBER
	USNRF.	(DUEBLK+UB$ACN-UB$ACN) ;NUMBER OF RECORDS FOLLOWING
	USTAL.	(DUEBLK+UB$TAU-UB$ACN) ;TOTAL ALLOCATED DISK SPACE
	USTUS.	(DUEBLK+UB$TWU-UB$ACN) ;TOTAL WRITTEN DISK SPACE
	USTNF.	(DUEBLK+UB$TNF-UB$ACN) ;TOTAL NUMBER OF FILES
	USDFS.	(DUEBLK+UB$FSN-UB$ACN) ;FILE STRUCTURE NAME
	USPPN.	(DUEBLK+UB$PPN-UB$ACN) ;PPN
	USSTP.	(DUEBLK+UB$FST-UB$ACN) ;FILE STRUCTURE TYPE
	USKTP.	(DUEBLK+UB$CNT-UB$ACN) ;CONTROLLER TYPE
	USDTP.	(DUEBLK+UB$DVT-UB$ACN) ;DEVICE TYPE
	USLIQ.	(DUEBLK+UB$QIN-UB$ACN) ;LOGGED IN QUOTA
	USLOQ.	(DUEBLK+UB$QOU-UB$ACN) ;LOGGED OUT QUOTA
	USLLG.	(DUEBLK+UB$LLG-UB$ACN) ;DATE/TIME OF LAST LOGIN (OLD FORMAT)
	USLAT.	(DUEBLK+UB$LAT-UB$ACN) ;DATE/TIME OF LAST ACCOUNTING
	USUPF.	(DUEBLK+UB$UPF-UB$ACN) ;UFD WAS PROTECTED FLAG
	USFPF.	(DUEBLK+UB$FPF-UB$ACN) ;SOME FILES WERE PROTECTED FLAG
	USTMA.	(DUEBLK+UB$ABO-UB$ACN) ;ACCOUNT BUFFER OVERFLOW IN IPCF MESSAGE
	USEXP.	(DUEBLK+UB$EXP-UB$ACN) ;EXPIRED PPN FLAG
	USFON.	([ASCII/N/])		;NEVER FILES ONLY
	0				;AND A ZERO TO TERMINATE THE LIST

DU1LST:
	USDFS.	(DUEBLK+UB$FSN-UB$ACN) ;FILE STRUCTURE NAME
	USPPN.	(DUEBLK+UB$PPN-UB$ACN) ;PPN
	USDFT.	(DUEBLK+UB$FST-UB$ACN) ;FILE STRUCTURE TYPE
	USDKT.	(DUEBLK+UB$CNT-UB$ACN) ;CONTROLLER TYPE
	USDDT.	(DUEBLK+UB$DVT-UB$ACN) ;DEVICE TYPE
	USDAC.	(DU1BLK+UB$ACT-UB$ACT) ;ACCOUNT STRING
	USALC.	(DU1BLK+UB$BAL-UB$ACT) ;BLOCKS ALLOCATED
	USUSG.	(DU1BLK+UB$BWR-UB$ACT) ;BLOCKS WRITTEN
	USFIL.	(DU1BLK+UB$NFL-UB$ACT) ;NUMBER OF FILES
	0				;AND A ZERO TO TERMINATE THE LIST

MAKDUE:	BLOCK	1		;FLAG SAYING SECOND (THRU N'TH) CALL TO MAKENT
DUEBLK:	BLOCK	UB$ACT-UB$ACN	;AREA TO HOLD DATA FROM MESSAGE
DU1BLK:	BLOCK	UB$END-UB$ACT	;AREA TO HOLD INDIVIDUAL ACCOUNT RECORDS
	SUBTTL	ACTIPC - GENERAL ROUTINES


;IPCGEN - ROUTINE TO DO ALL GENERAL STORAGE AND COMPUTING NEEDED FOR JOB-SPECIFIC
;	IPCF MESSAGES. MDBADR AND MMSADR CONTAIN ALL THAT IS NECESSARY.

IPCGEN:	MOVE	T1,MDBADR	;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
	MOVE	T2,MDB.PV(T1)	;SENDER'S JOB NUMBER
	ANDX	T2,MD.PJB
	MOVEM	T2,JOBNUM	;SAVE IT
	POPJ	P,
	SUBTTL	ACTCHK - SECTION TO HANDLE JOB AND DEVICE CHECKPOINT FILES

;GENERAL DEFINITIONS FOR CHECKPOINT MODULE

DTMOFS:	BLOCK 1			;DATE/TIME OFFSET. IF NON-ZERO, ADJUST DATA ITEMS
CURDTM:	BLOCK 1			;CURRENT DATE/TIME --FILLED IN BY ROUTINE DATIM
CHKNDX:	BLOCK 1			;INDEX INTO TABLE DESCRIBING CHECKPOINT TIMES

;THE FOLLOWING DEVICE TYPES ARE DEFINED FOR SYMBOLIC REFERENCES BUT SOME
;	TABLES AND DISPATCH VECTORS "KNOW" THE ORDER. DON'T CHANGE THESE.

FSRTYP==1		;INDICATES THE DEVICE AREA IS FOR A FILE STRUCTURE
MAGTYP==2		;INDICATES THE DEVICE AREA IS FOR A MAGTAPE
DECTYP==3		;INDICATES THE DEVICE AREA IS FOR A DECTAPE
SPNTYP==4		;INDICATES THE DEVICE AREA IS FOR A SPINDLE
	SUBTTL	ACTCHK - GENERAL DEFINITIONS FOR CHECKPOINT MODULE

;*********************************************************************
;	JOB CHECKPOINT FILE (PRIMARY AND AUXILLIARY) DEFINITIONS
;*********************************************************************

CPJFIL==1		;BLOCK WHERE GENERAL CHECKPOINT FILE INFORMATION IS STORED
JBOFFS==1		;OFFSET TO ADD TO JOB NUMBER TO FIND WHAT BLOCK JOB'S
			; INFORMATION IS STORED.

;STORAGE FOR PRIMARY JOB CHECKPOINT FILE CALLED USEJOB.BIN
CPJCHN:	BLOCK 1		;CHANNEL NUMBER OF PRIMARY JOB CHECKPOINT FILE
			; # IS POSITIONED WHERE THE FILOP EXPECTS IT (FO.CHN)
CPJBLK:	BLOCK 10	;FILOP. BLOCK USED FOR THE PRIMARY JOB CHECKPOINT FILE
USEJOB:	BLOCK .RBSIZ+1	;LOOKUP BLOCK FOR CPJBLK (USEJOB.BIN)
CPJGEN:	BLOCK 200	;BUFFER WHERE THE CHECKPOINT FILE INFORMATION BLOCK
			; WILL BE READ INTO.

RECLM1:			;WHERE READ DATA ENDS

;*****************************************************************
;* * * * * * * FORMAT OF CPJGEN * * * * * * * *
;*****************************************************************
	PHASE 0
	BLOCK 1			;RESERVE WORD 0 OF THE BLOCK
LASTCH:	BLOCK 1			;DATE/TIME OF THE LAST CHECKPOINT DONE.
FILMJB:	BLOCK 1			;NUMBER OF JOBS THIS FILE WAS BUILT FOR
FILBPJ:	BLOCK 1			;BLOCKS PER JOB IN CHECKPOINT FILE
FILBPD:	BLOCK 1			;BLOCKS PER DEVICE IN jjjDEV.BIN FILE(S)
	DEPHASE
;*****************************************************************
;* * * * * * * END OF CPJGEN FORMAT * * * * * * *
;*****************************************************************

;*****************************************************************
;* * * * * * FORMAT OF CPJBUF AND CAJBUF * * * * * * * *
;*****************************************************************
;	EACH JOB SLOT IN THE CHECKPOINT FILE CONTAINS THE PRIMARY AND AUXILLIARY
;	AREAS.  EACH JOB REQUIRES "N" DISK BLOCKS AS DETERMINED BY THE SIZE OF
;	THE PRIMARY AREA (CBUFLN) * 2.  THE AUXILLIARY AREA (FOR SESSION) BEGINS
;	AFTER THE PRIMARY AREA ROUNDED UP TO NEXT 100 WORD BOUNDRY FOR EXPANSION.
;	WHEN THE NUMBER OF BLOCKS REQUIRED FOR A JOB CHANGES, THE OLD USEJOB.BIN
;	FILE IS INVALID AND MUST BE DELETED BEFORE THE NEW VERSION OF THE ACTDAE
;	CAN BE USED.  TO AVOID LOSING DATA IN THE TRANSITION BETWEEN VERSIONS,
;	SCHEDULE A KSYS FOR THE SYSTEM, ATTACH THE OLD ACTDAE AFTER IT IS COMPLETE,
;	RUN THE OLD VERSION AGAIN (TO GET ACCOUNTING FOR [OPR] JOBS), DELETE
;	THE OLD USEJOB.BIN, PUT THE NEW VERSION ON SYS, AND RELOAD THE MONITOR.
;*****************************************************************

	PHASE 0

;THE FOLLOWING ITEMS ARE UPDATED WITH EACH CHECKPOINT IN THE PRIMARY CHECKPOINT
;	FILE.  THEY ARE ALSO THE MINUEND (PRIMARY CHECKPOINT FILE) AND THE
;	SUBTRAHEND (AUXILLIARY CHECKPOINT FILE) USED WHEN MAKING ANY SESSION
;	ENTRY.  NOTE THAT ANY CONVERSION/CALCULATIONS NEEDED WILL BE DONE
;	WHEN THE SESSION ENTRY IS BEING APPENDED TO THE USAGE FILE

CJOB:	BLOCK 1			;JOB NUMBER OF USER
CRUNTM:	BLOCK 1			;RUNTIME (TEN-MICROSECOND UNITS)
CDREAD:	BLOCK 1			;DISK READS (BLOCKS)
CDWRIT:	BLOCK 1			;DISK WRITES (BLOCKS)
CCTI:	BLOCK 1			;CORE-TIME INTEGRAL (KILO-CORE TICKS)
CVCTI:	BLOCK 1			;VIRTUAL CORE-TIME INTEGRAL (KILO-CORE TICKS)
CEBOX:	BLOCK 1			;EBOX (JIFFIES)
CMBOX:	BLOCK 1			;MBOX (JIFFIES)
CMCALL:	BLOCK 1			;MONITOR CALLS
CTTYI:	BLOCK 1			;TERMINAL INPUT CHARACTERS
CTTYO:	BLOCK 1			;TERMINAL OUTPUT CHARACTERS
CTTYBR:	BLOCK 1			;COUNT OF BREAK CHARACTERS USER TYPED
CTTCMD:	BLOCK 1			;MONITOR COMMAND COUNT
CQUTIM:	BLOCK 1			;TIME IN RUN QUEUE (USED TO CALCULATE RUN QUEUE QUOTIENT)

CEND:			;LENGTH OF VARIABLE DATA ( USED FOR SESBLK )

CACVER:	BLOCK 1			;VERSION OF ACTDAE (%%.ACV)
CLSTCK:	BLOCK 1			;DATE/TIME OF LAST CHECKPOINT
CJLGTM:	BLOCK 1			;LOGIN TIME OF THE JOB (FOR RESTART)
CDEVFL:	BLOCK 1			;FLAG INDICATING A DEVICE CHECKPOINT FILE EXISTS

;THE FOLLOWING ITEMS ARE NOT CHANGED DURING A CHECKPOINT BUT ARE NEEDED TO BE
;	RECORDED HERE IN CASE OF A SYSTEM CRASH SO A INCOMPLETE SESSION
;	ENTRY CAN BE MADE.  NOTE THAT THE FORMAT EXACTLY MATCHES (BEGINNING
;	WITH CLINNO) WITH THE LOGIN IPCF MESSAGE.  IF THEY DO NOT MATCH, THE
;	ROUTINE CALLED CPJLIN, MUST CHANGE FROM DOING THE BLT.

CLINNO:	BLOCK 1			;LINE NUMBER
CPGNAM:	BLOCK 1			;NAME OF PROGRAM (USUALLY LOGIN)
CPGVER:	BLOCK 1			;VERSION OF PROGRAM (USUALLY LOGIN)
CNODE:	BLOCK 1			;NODE NAME OF USER'S LOCATION
CACCT:	BLOCK 10		;ACCOUNT STRING
CSESST:	BLOCK 1			;SESSION START DATE/TIME
CJBTYP:	BLOCK 1			;JOB TYPE
CBTNAM:	BLOCK 1			;BATCH JOB NAME
CBTSEQ:	BLOCK 1			;BATCH SEQUENCE NUMBER
CRMRK:	BLOCK 10		;SESSION REMARK
CCLASS:	BLOCK 1			;SCHEDULING CLASS
CPPN:	BLOCK 1			;PROJECT-PROGRAMMER NUMBER OF USER
CNAME1:	BLOCK 1			;FIRST SIX LETTERS OF USER'S NAME
CNAME2:	BLOCK 1			;LAST SIX LETTERS OF USER'S NAME
CBTRID:	BLOCK 1			;BATCH REQUEST ID
CTERDE:	BLOCK 1			;TERMINAL DESIGNATOR

CBUFLN:			;LENGTH OF THE CHECKPOINT AREAS
	DEPHASE
;*****************************************************************
;* * * * * * END OF CPJBUF AND CAJBUF FORMAT * * * * * * * * *
;*****************************************************************
;*****************************************************************

	RELOC	RECLM1		;ORG OVER DATA DEFINITIONS TO SAVE SPACE

CPJIOB==<<2*CBUFLN>+177>/200	;NUMBER OF DISK BLOCKS PER JOB AREA
CPJIOL==200*CPJIOB		;NUMBER OF WORDS FOR I/O TO THE FILE

CPJBUF:	BLOCK	CPJIOL		;THE BUFFER AREA FOR WORKING ON THE FILE
CAJBUF==CPJBUF+<CPJIOL/2>	;AUXILLIARY AREA STARTS IN THE MIDDLE


;*********************************************************************
;	DEVICE CHECKPOINT FILE (PRIMARY AND AUXILLIARY) DEFINITIONS
;*********************************************************************

DVOFFS==0		;OFFSET TO ADD TO FIND WHAT BLOCK DEVICE INFORMATION BEGINS

;STORAGE FOR PRIMARY DEVICE CHECKPOINT FILE CALLED JJJDEV.BIN WHERE JJJ IS THE JOB NUMBER
CPDCHN:	BLOCK 1		;CHANNEL NUMBER OF PRIMARY DEVICE CHECKPOINT FILE
			; # IS POSITIONED WHERE THE FILOP EXPECTS IT (FO.CHN)
CPDBLK:	BLOCK 10	;FILOP. BLOCK USED FOR THE PRIMARY DEVICE CHECKPOINT FILE
JJJDEV:	BLOCK .RBSIZ+1	;LOOKUP BLOCK FOR CPDBLK (JJJDEV.BIN)
JJJDEL:	BLOCK .RBSIZ+1	;RENAME (DELETE) BLOCK FOR JJJDEV.BIN


RECLM2:			;WHERE READ DATA ENDS



;*****************************************************************
;* * * * * * FORMAT OF CPJBUF AND CADBUF * * * * * * * *
;*****************************************************************
;	EACH DEVICE SLOT IN THE CHECKPOINT FILE CONTAINS THE PRIMARY AND AUXILLIARY
;	AREAS.  EACH DEVICE REQUIRES "N" DISK BLOCKS AS DETERMINED BY THE SIZE OF
;	THE PRIMARY AREA (CDBFLN) * 2.  THE AUXILLIARY AREA (FOR SESSION) BEGINS
;	AFTER THE PRIMARY AREA ROUNDED UP TO NEXT 100 WORD BOUNDRY FOR EXPANSION.
;	WHEN THE NUMBER OF BLOCKS REQUIRED FOR A DEVICE CHANGES, THE OLD JJJDEV.BIN
;	FILE IS INVALID AND MUST BE DELETED BEFORE THE NEW VERSION OF THE ACTDAE
;	CAN BE USED.  TO AVOID LOSING DATA IN THE TRANSITION BETWEEN VERSIONS,
;	SCHEDULE A KSYS FOR THE SYSTEM, ATTACH THE OLD ACTDAE AFTER IT IS COMPLETE,
;	RUN THE OLD VERSION AGAIN (TO GET ACCOUNTING FOR [OPR] DEVICES), DELETE
;	ALL OLD JJJDEV.BIN'S, PUT THE NEW VERSION ON SYS, AND RELOAD THE MONITOR.
;
;	NOTE:  IN THE CASE OF DEVICE CHECKPOINT FILES ONLY -- IF A NEW
;	ACCOUNT DAEMON IS RUN WHICH HAS CHANGED THE NUMBER OF BLOCKS FOR EACH
;	DEVICE, ANY DEVICE CHECKPOINT FILE WHICH HAS AN UNKNOWN FORMAT
;	(FILBPD IN THE CPDFIL BLOCK IS NOT = TO CPDIOB) WILL BE DELETED WITH
;	A WARNING SENT TO THE OPERATOR AND NO USAGE ENTRY WILL BE MADE.
;
;*****************************************************************

;FILE STRUCTURE BLOCK FORMAT

	PHASE 0

DEVTYP:	BLOCK 1			;DEVICE TYPE (SEE FSRTYP DEFINITION AREA)
DEVICE:	BLOCK 1			;DEVICE NAME IN SIXBIT
FJOB:	BLOCK 1			;JOB NUMBER OF USER
FTERDE:	BLOCK 1			;TERMINAL DESIGNATOR
FACVER:	BLOCK 1			;VERSION OF ACTDAE (%%.ACV)
FLSTCK:	BLOCK 1			;DATE/TIME OF LAST CHECKPOINT
FLINNO:	BLOCK 1			;LINE NUMBER
FPGNAM:	BLOCK 1			;NAME OF PROGRAM (USUALLY PULSAR)
FPGVER:	BLOCK 1			;VERSION OF PROGRAM (USUALLY PULSAR)
FNODE:	BLOCK 1			;NODE NAME OF USER'S LOCATION
FACCT:	BLOCK 10		;ACCOUNT STRING
FSESST:	BLOCK 1			;SESSION START DATE/TIME
FPPN:	BLOCK 1			;PROJECT-PROGRAMMER NUMBER OF USER
FNAME1:	BLOCK 1			;FIRST SIX LETTERS OF USER'S NAME
FNAME2:	BLOCK 1			;LAST SIX LETTERS OF USER'S NAME
FFSTYP:	BLOCK 1			;TYPE OF FILE STRUCTURE
FPCKNO:	BLOCK 1			;NUMBER OF PACKS IN FILE STRUCTURE
FCONTY:	BLOCK 1			;CONTROLLER TYPE
FDEVTY:	BLOCK 1			;DEVICE TYPE
FDISPO:	BLOCK 1			;DISPOSITION
FOTEXT:	BLOCK 10		;TEXT TO EXPLAIN DISPOSITION
FCREDT:	BLOCK 1			;CREATION DATE/TIME OF MOUNT REQUEST
FSCHDT:	BLOCK 1			;SCHEDULED DATE/TIME OF MOUNT REQUEST
FSERDT:	BLOCK 1			;SERVICE DATE/TIME OF MOUNT REQUEST
FMNTCT:	BLOCK 1			;MOUNT COUNT BEFORE REQUEST
FDISCT:	BLOCK 1			;MOUNT COUNT AFTER DISMOUNT
FACCES:	BLOCK 1			;ACCESS TYPE
FCONNE:	BLOCK 1			;CONNECT TIME IN SECONDS

FBUFLN:			;LENGTH OF THE CHECKPOINT AREAS
	DEPHASE


;END OF FILE STRUCTURE BLOCK FORMAT
;MAGTAPE BLOCK FORMAT

	PHASE	DEVTYP


MEVTYP:	BLOCK 1			;SEE DEVTYP
MEVICE:	BLOCK 1			;DEVICE NAME IN SIXBIT (REFERENCED BY DEVICE
				; DEFINED IN FILE STRUCTURE BLOCK)
MJOB:	BLOCK 1			;JOB NUMBER OF USER
MTERDE:	BLOCK 1			;TERMINAL DESIGNATOR
MACVER:	BLOCK 1			;VERSION OF ACTDAE (%%.ACV)
MLSTCK:	BLOCK 1			;DATE/TIME OF LAST CHECKPOINT
MLINNO:	BLOCK 1			;LINE NUMBER
MPGNAM:	BLOCK 1			;NAME OF PROGRAM (USUALLY PULSAR)
MPGVER:	BLOCK 1			;VERSION OF PROGRAM (USUALLY PULSAR)
MNODE:	BLOCK 1			;NODE NAME OF USER'S LOCATION
MACCT:	BLOCK 10		;ACCOUNT STRING
MSESST:	BLOCK 1			;SESSION START DATE/TIME
MPPN:	BLOCK 1			;PROJECT-PROGRAMMER NUMBER OF USER
MNAME1:	BLOCK 1			;FIRST SIX LETTERS OF USER'S NAME
MNAME2:	BLOCK 1			;LAST SIX LETTERS OF USER'S NAME
MCONTY:	BLOCK 1			;CONTROLLER TYPE
MDISPO:	BLOCK 1			;DISPOSITION
MOTEXT:	BLOCK 10		;TEXT TO EXPLAIN DISPOSITION
MCREDT:	BLOCK 1			;CREATION DATE/TIME OF MOUNT REQUEST
MSCHDT:	BLOCK 1			;SCHEDULED DATE/TIME OF MOUNT REQUEST
MSERDT:	BLOCK 1			;SERVICE DATE/TIME OF MOUNT REQUEST
MVOLID:	BLOCK 1			;VOLUME ID RECORDED IN VOL1 LABEL
MRELID:	BLOCK 1			;REEL ID VISUAL LABEL OF TAPE
MMREAD:	BLOCK 1			;MAGTAPE READS - THOUSANDS OF CHARS
MMWRIT:	BLOCK 1			;MAGTAPE WRITES - THOUSANDS OF CHARS
MLABEL:	BLOCK 1			;LABEL TYPE
MSTATE:	BLOCK 1			;VOLUME LABEL STATE
MRECRD:	BLOCK 1			;PHYSICAL RECORDS READ
MRECWR:	BLOCK 1			;PHYSICAL RECORDS WRITTEN
MFSTID:	BLOCK 1			;FILE SET IDENTIFIER
MNOSRE:	BLOCK 1			;NUMBER OF SOFT READ ERRORS
MNOSWE:	BLOCK 1			;NUMBER OF SOFT WRITE ERRORS
MNOHRE:	BLOCK 1			;NUMBER OF HARD READ ERRORS
MNOHWE:	BLOCK 1			;NUMBER OF HARD WRITE ERRORS
MCONNE:	BLOCK 1			;CONNECT TIME IN SECONDS

MBUFLN:			;LENGTH OF THE CHECKPOINT AREAS
	DEPHASE


;END OF MAGTAPE BLOCK FORMAT
;DECTAPE BLOCK FORMAT

	PHASE	DEVTYP

DDVTYP:	BLOCK 1			;SEE DEVTYP
DDVICE:	BLOCK 1			;DEVICE NAME IN SIXBIT (REFERENCED BY DEVICE
				; DEFINED IN FILE STRUCTURE BLOCK)
DJOB:	BLOCK 1			;JOB NUMBER OF USER
DTERDE:	BLOCK 1			;TERMINAL DESIGNATOR
DACVER:	BLOCK 1			;VERSION OF ACTDAE (%%.ACV)
DLSTCK:	BLOCK 1			;DATE/TIME OF LAST CHECKPOINT
DLINNO:	BLOCK 1			;LINE NUMBER
DPGNAM:	BLOCK 1			;NAME OF PROGRAM (USUALLY MOUNT)
DPGVER:	BLOCK 1			;VERSION OF PROGRAM (USUALLY MOUNT)
DNODE:	BLOCK 1			;NODE NAME OF USER'S LOCATION
DACCT:	BLOCK 10		;ACCOUNT STRING
DSESST:	BLOCK 1			;SESSION START DATE/TIME
DPPN:	BLOCK 1			;PROJECT-PROGRAMMER NUMBER OF USER
DNAME1:	BLOCK 1			;FIRST SIX LETTERS OF USER'S NAME
DNAME2:	BLOCK 1			;LAST SIX LETTERS OF USER'S NAME
DDISPO:	BLOCK 1			;DISPOSITION
DOTEXT:	BLOCK 10		;TEXT TO EXPLAIN DISPOSITION
DCREDT:	BLOCK 1			;CREATION DATE/TIME OF MOUNT REQUEST
DSCHDT:	BLOCK 1			;SCHEDULED DATE/TIME OF MOUNT REQUEST
DSERDT:	BLOCK 1			;SERVICE DATE/TIME OF MOUNT REQUEST
DVOLID:	BLOCK 1			;VOLUME ID RECORDED IN VOL1 LABEL
DRELID:	BLOCK 1			;REEL ID VISUAL LABEL OF TAPE
DDREAD:	BLOCK 1			;DECTAPE READS - BLOCKS
DDWRIT:	BLOCK 1			;DECTAPE WRITES - BLOCKS
DCONNE:	BLOCK 1			;CONNECT TIME IN SECONDS

DBUFLN:			;LENGTH OF THE CHECKPOINT AREAS

	DEPHASE


;END OF DECTAPE BLOCK FORMAT
;DISK SPINDLE BLOCK FORMAT

	PHASE	DEVTYP

SEVTYP:	BLOCK 1			;SEE DEVTYP
SEVICE:	BLOCK 1			;DISK UNIT NAME IN SIXBIT
ALTPRT:	BLOCK 1			;IF DUAL PORTED, OTHER DISK UNIT NAME
SJOB:	BLOCK 1			;JOB NUMBER OF PULSAR
STERDE:	BLOCK 1			;TERMINAL DESIGNATOR
SACVER:	BLOCK 1			;VERSION OF ACTDAE (%%.ACV)
SLSTCK:	BLOCK 1			;DATE/TIME OF LAST CHECKPOINT
SMNTDT:	BLOCK 1			;DATE/TIME PACK WAS SPUN UP
SLINNO:	BLOCK 1			;LINE NUMBER
SPGNAM:	BLOCK 1			;NAME OF PROGRAM (USUALLY PULSAR)
SPGVER:	BLOCK 1			;VERSION OF PROGRAM (USUALLY PULSAR)
SNODE:	BLOCK 1			;NODE NAME
SCSHIF:	BLOCK 1			;CSHIFT DATE/TIME
SPAKID:	BLOCK 1			;DISK PACK IDENTIFIER
SFSNAM:	BLOCK 1			;FILE STRUCTURE NAME
SFSTYP:	BLOCK 1			;TYPE OF FILE STRUCTURE
SPCKNO:	BLOCK 1			;NUMBER OF PACKS IN FILE STRUCTURE
SPKMTH:	BLOCK 1			;M OF N COUNT
SCONTY:	BLOCK 1			;CONTROLLER TYPE
SDEVTY:	BLOCK 1			;DEVICE TYPE
SCONNE:	BLOCK 1			;CONNECT TIME IN SECONDS

SBUFLN:			;LENGTH OF THE CHECKPOINT AREAS

	DEPHASE


;END OF DISK SPINDLE BLOCK FORMAT


	RELOC	RECLM2		;ORG OVER DATA DEFINITIONS TO SAVE SPACE


;NOW DEFINE THE LENGTH OF A DEVICE CHECKPOINT AREA. FOR SIMPLICITY, THE
;LENGTH IS THE GREATEST LENGTH OF ANY DEVICE BLOCK DEFINED.

CDBFLN==FBUFLN			;INITIALIZE WITH FILE STRUCTURE LENGTH

IFG MBUFLN-CDBFLN, <CDBFLN==MBUFLN>	;IF MAGTAPE LENGTH IS GREATER
IFG DBUFLN-CDBFLN, <CDBFLN==DBUFLN>	;IF DECTAPE LENGTH IS GREATER
IFG SBUFLN-CDBFLN, <CDBFLN==SBUFLN>	;IF SPINDLE LENGTH IS GREATER


CPDIOB==<<2*CDBFLN>+177>/200	;NUMBER OF DISK BLOCKS PER DEVICE AREA
CPDIOL==200*CPDIOB		;NUMBER OF WORDS FOR I/O TO THE FILE

CPDBUF:	BLOCK	CPDIOL		;THE BUFFER AREA FOR WORKING ON THE FILE
CADBUF==CPDBUF+<CPDIOL/2>	;AUXILLIARY AREA STARTS IN THE MIDDLE
	SUBTTL	ACTCHK - MAIN ROUTINES

;CHKAJB - ROUTINE TO CHECKPOINT ALL JOBS CURRENTLY LOGGED IN. ON EXIT, NEXT
;	CHECKPOINT IS SET UP

CHKAJB:	$CALL	.SAVE1		;SAVE A WORKING AC
;	PUSHJ	P,READJG	;READ GENERAL CHECKPOINT BLOCK
				;DON'T REALLY NEED TO READ IT IN
	PUSHJ	P,DATIM		;GET CURRENT DATE/TIME
	MOVEM	S1,CPJGEN+LASTCH ;RECORD AS TIME OF LAST CHECKPOINT
	MOVE	S1,JOBMAX	;MAXIMUM NUMBER OF JOBS ALLOWED
	MOVEM	S1,CPJGEN+FILMJB ;RECORD FOR RESTART
	MOVEI	S1,CPJIOB	;NUMBER OF BLOCKS PER JOB IN CHECKPOINT FILE
	MOVEM	S1,CPJGEN+FILBPJ ;RECORD FOR VERSION CHECK
	MOVEI	S1,CPDIOB	;NUMBER OF BLOCKS PER DEVICE IN jjjDEV.BIN
	MOVEM	S1,CPJGEN+FILBPD ;RECORD FOR VERSION CHECK
	PUSHJ	P,WRITJG	;AND RE-WRITE THE BLOCK
	MOVX	P1,%NSHJB	;GET HIGHEST JOB IN THE SYSTEM
	GETTAB	P1,		;GET IT
ACTCGH:	$BOMB	<ACTCGH Cannot GETTAB Highest job in use>
	CAMLE	P1,JOBMAX	;CAN WE DO THIS MANY?
	MOVE	P1,JOBMAX	;STAY WITHIN THE FILE
	MOVNS	P1		;FORM AOBJN
	HRLZS	P1		;...
	HRRI	P1,1		;SKIP THE NULL JOB
CHKAJ1:	MOVNI	T2,(P1)		;NEGATE JOB NUMBER
	JOBSTS	T2,		;SEE IF A REAL JOB
	  JRST	CHKAJ2		;CAN'T DO IT
	TXNN	T2,JB.ULI	;IS THE JOB LOGGED IN
	JRST	CHKAJ3		;NO, TRY NEXT JOB
	HRRZM	P1,JOBNUM	;JOB NUMBER FOR CHKJOB
	PUSHJ	P,CHKJOB	;CHECKPOINT IT
	SKIPE	CPJBUF+CDEVFL	;ANY DEVICES FOR THIS JOB
	PUSHJ	P,CHJDVS	;CHECKPOINT THE JOBS DEVICES TOO
	JRST	CHKAJ3		;ONWARD
CHKAJ2:	$WTO	(<Accounting error>,<^I/CHKTXT/>,,<$WTFLG(WT.SJI)>)
CHKAJ3:	AOBJN	P1,CHKAJ1	;LOOP FOR ALL JOBS
	SETZM	JOBNUM		;JOB 0'S DEVICES ARE SYSTEM SPINDLES
	PUSHJ	P,CHJDVS	;CHECKPOINT THEM NOW
	PUSHJ	P,NXTCHK	;SET UP FOR NEXT CHECKPOINT
	POPJ	P,		;AND RETURN

CHJDVS:	MOVEI	T1,CHKDVS	;ROUTINE TO DO THE CHECKPOINT
	PUSHJ	P,ALLDEV	;DO THAT FOR ALL DEVICES
	POPJ	P,		;AND RETURN

CHKTXT:	ITEXT	(<Cannot read job status for job ^D/P1,RHMASK/
Job not checkpointed>)
;CHKJOB - ROUTINE TO CHECKPOINT THE JOB CHECKPOINT FILE, USEJOB.BIN ON ACT:.
;	NOTE THAT THIS IS THE PRIMARY CHECKPOINT FILE...THE AUXILIARY FILE
;	WILL NEVER BE CHECKPOINTED.
;CALL:	PUSHJ	P,CHKJOB

CHKJOB:	PUSHJ	P,READJP	;MUST READ IT IN CORE TO PRESERVE THE STATIC INFORMATION
	SKIPE	T1,DTMOFS	;WAS THERE A DATE/TIME CHANGE
	PUSHJ	P,[ADDM T1,CPJBUF+CJLGTM ;ADJUST LOGIN TIME OF JOB
		ADDM T1,CPJBUF+CSESST ;AND SESSION START TIME
		POPJ P,]	;DONE ADJUSTING
	PUSHJ	P,CHKPNT	;CHECKPOINT THE JOB'S DATA
	PUSHJ	P,WRITJP	;GO WRITE IT
	POPJ	P,		;AND RETURN

;ROUTINE TO CHECKPOINT THE DEVICE CHECKPOINT FILE FOR THIS JOB.

CHKDVS:	PUSHJ	P,@[EXP CHKFSR,CHKMTA,CHKDTA,CHKSPN]-1(P1) ;CHECKPOINT IT
	SKIPE	T1,DTMOFS	;WAS THERE A DATE/TIME CHANGE
	PUSHJ	P,@[EXP OFSFSR,OFSMTA,OFSDTA,OFSSPN]-1(P1) ;YES, ADJUST TIMES
	PUSHJ	P,WRITDP	;WRITE IT BACK OUT
	POPJ	P,		;RETURN FOR NEXT DEVICE

OFSFSR:	ADDM	T1,CPDBUF+FSESST ;ADJUST SESSION START TIME
	ADDM	T1,CPDBUF+FCREDT ;CREATION TIME OF REQUEST
	ADDM	T1,CPDBUF+FSCHDT ;SCHEDULED TIME OF REQUEST
	ADDM	T1,CPDBUF+FSERDT ;SERVICED TIME OF REQUEST
	POPJ	P,		;DONE ADJUSTING

OFSMTA:	ADDM	T1,CPDBUF+MSESST ;ADJUST SESSION START TIME
	ADDM	T1,CPDBUF+MCREDT ;CREATION TIME OF REQUEST
	ADDM	T1,CPDBUF+MSCHDT ;SCHEDULED TIME OF REQUEST
	ADDM	T1,CPDBUF+MSERDT ;SERVICED TIME OF REQUEST
	POPJ	P,		;DONE ADJUSTING

OFSDTA:	ADDM	T1,CPDBUF+DSESST ;ADJUST SESSION START TIME
	ADDM	T1,CPDBUF+DCREDT ;CREATION TIME OF REQUEST
	ADDM	T1,CPDBUF+DSCHDT ;SCHEDULED TIME OF REQUEST
	ADDM	T1,CPDBUF+DSERDT ;SERVICED TIME OF REQUEST
	POPJ	P,		;DONE ADJUSTING

OFSSPN:	ADDM	T1,CPDBUF+SCSHIF ;ADJUST SESSION START TIME
	ADDM	T1,CPDBUF+SMNTDT ;SPIN UP DATE/TIME
	POPJ	P,		;DONE ADJUSTING
;SESAJB - ROUTINE TO MAKE SESSION ENTRIES FOR ALL JOBS. CALLED WHEN IT IS
;	TIME TO CLOSE OUT THE USAGE.OUT FILE OR WHEN A CSHIFT OCCURS

SESAJB:	PUSHJ	P,CHKAJB	;FIRST, CHECKPOINT ALL JOB INFORMATION
	$CALL	.SAVE1		;SAVE A WORKING AC
	MOVX	P1,%NSHJB	;GET HIGHEST JOB IN USE RIGHT NOW
	GETTAB	P1,		;GET IT
	  JRST	ACTCGH		;GIVE AN ERROR
	CAMLE	P1,JOBMAX	;CAN WE DO THIS MANY?
	MOVE	P1,JOBMAX	;STAY WITHIN THE FILE
	MOVNS	P1		;FORM AOBJN
	HRLZS	P1		;...
	HRRI	P1,1		;SKIP THE NULL JOB
SESAJ1:	HRRZM	P1,JOBNUM	;STORE JOB NUMBER WE ARE DOING
	PUSHJ	P,READJP	;READ IN THE INFORMATION
	SKIPN	CPJBUF+CJOB	;IS THERE A JOB
	JRST	SESAJ2		;NO, TRY THE NEXT
	PUSHJ	P,MAKSES	;MAKE THE SESSION ENTRY
	PUSHJ	P,CPJCOP	;MOVE PRIMARY DATA TO AUXILLIARY REGION
	MOVE	T1,CPJBUF+CLSTCK ;GET TIME OF LAST CHECKPOINT (=NOW)
	MOVEM	T1,CPJBUF+CSESST ;STORE AS SESSION START TIME
	PUSHJ	P,WRITJP	;AND RE-WRITE THE FILE
	SKIPE	CPJBUF+CDEVFL	;ANY DEVICES FOR THIS JOB
	PUSHJ	P,SESADV	;MAKE SESSION ENTRIES FOR ALL THE JOBS DEVICES TOO
SESAJ2:	AOBJN	P1,SESAJ1	;TRY THE NEXT JOB
	SETZM	JOBNUM		;JOB 0 = SYSTEM SPINDLE INFO
	PUSHJ	P,SESADV	;DO THEM NOW
	PUSHJ	P,NXTCHK	;RESTART CHECKPOINT TIMER IF THIS TOOK A LONG TIME
	POPJ	P,		;AND RETURN

SESADV:	MOVEI	T1,SEADVS	;ROUTINE TO ACTUALLY MAKE THE ENTRIES
	PUSHJ	P,ALLDEV	;DO IT FOR ALL DEVICES
	POPJ	P,		;AND RETURN

;ROUTINE TO MAKE SESSION ENTRIES FOR ALL THE DEVICES OWNED BY A JOB

SEADVS:	PUSHJ	P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
	PUSHJ	P,CPDCOP	;MOVE DATA ALREADY BILLED
	MOVE	T1,@[EXP CPDBUF+FLSTCK,CPDBUF+MLSTCK,CPDBUF+DLSTCK,CPDBUF+SLSTCK]-1(P1)
	MOVEM	T1,@[EXP CPDBUF+FSESST,CPDBUF+MSESST,CPDBUF+DSESST,CPDBUF+SCSHIF]-1(P1)
	PUSHJ	P,WRITDP	;WRITE IT BACK TO THE FILE
	POPJ	P,		;ALL DONE HERE
;READJG - ROUTINE TO READ THE GENERAL CHECKPOINT BLOCK OF THE PRIMARY JOB
;	CHECKPOINT FILE. THE BLOCK NUMBER IS DEFINED BY CPJFIL AND SHOULD
;	ALWAYS BE THE FIRST BLOCK OF THE FILE.

READJG:	MOVEI	T1,CPJFIL	;GET THE BLOCK NUMBER
	MOVE	T2,CPJCHN	; AND THE CHANNEL NUMBER
	PUSHJ	P,AUSETI	;POSITION THE INPUT
	SKIPT
	$BOMB	<ACTCUG Cannot USETI (^O/T1/) to general checkpoint block>
	MOVE	T1,[IOWD 200,CPJGEN]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPJCHN	;CHANNEL NUMBER
	HRRI	T1,.FOINP	;READ
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPJBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPJBLK+.FOIOS
	MOVE	T1,[2,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCRG Cannot READ general checkpoint block>
	$RETT


;WRITJG - ROUTINE TO WRITE THE GENERAL CHECKPOINT BLOCK OF THE PRIMARY JOB
;	CHECKPOINT FILE. THE BLOCK NUMBER IS DEFINED BY CPJFIL AND SHOULD
;	ALWAYS BE THE FIRST BLOCK OF THE FILE.

WRITJG:	MOVEI	T1,CPJFIL	;GET THE BLOCK NUMBER
	MOVE	T2,CPJCHN	; AND THE CHANNEL NUMBER
	PUSHJ	P,AUSETO	;POSITION THE OUTPUT
	SKIPT
	$BOMB	<ACTCUG Cannot USETO to general checkpoint block>
	MOVE	T1,[IOWD 200,CPJGEN]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPJCHN	;CHANNEL NUMBER
	HRRI	T1,.FOOUT	;WRITE
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPJBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPJBLK+.FOIOS
	MOVE	T1,[2,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCWG Cannot WRITE general checkpoint block>
	$RETT
;READJP - ROUTINE TO READ A BLOCK OF THE PRIMARY JOB CHECKPOINT FILE FOR A JOB.
;CALL:	JOBNUM SET TO DESIRED JOB

READJP:	MOVE	T1,JOBNUM	;GET THE DESIRED JOB NUMBER
	SOS	T1		;COMPUTE POSITION IN CHECKPOINT FILE
	IMULI	T1,CPJIOB	;*NUMBER OF BLOCKS PER CHECKPOINT AREA
	ADDI	T1,1+JBOFFS	;ADJUST + FILE OFFSET
	MOVE	T2,CPJCHN	;SET UP THE CHANNEL NUMBER
	PUSHJ	P,AUSETI	;POSITION THE INPUT
	SKIPT
ACTCPC:	$BOMB	<ACTCPC Cannot position checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	MOVE	T1,[IOWD CPJIOL,CPJBUF]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPJCHN	;CHANNEL NUMBER
	HRRI	T1,.FOINP	;READ
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPJBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPJBLK+.FOIOS
	MOVE	T1,[2,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCRP Cannot READ checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	$RETT

;WRITJP - ROUTINE TO WRITE A BLOCK OF THE PRIMARY JOB CHECKPOINT FILE FOR A JOB.
;CALL:	JOBNUM SET TO DESIRED JOB

WRITJP:	MOVE	T1,JOBNUM	;GET THE DESIRED JOB NUMBER
	SOS	T1		;COMPUTE POSITION IN CHECKPOINT FILE
	IMULI	T1,CPJIOB	;*NUMBER OF BLOCKS PER CHECKPOINT AREA
	ADDI	T1,1+JBOFFS	;ADJUST + FILE OFFSET
	MOVE	T2,CPJCHN	;SET UP THE CHANNEL NUMBER
	PUSHJ	P,AUSETO	;POSITION THE OUTPUT
	JUMPF	ACTCPC		;REPORT POSITIONING ERROR
	MOVE	T1,[IOWD CPJIOL,CPJBUF]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPJCHN	;CHANNEL NUMBER
	HRRI	T1,.FOOUT	;WRITE
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPJBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPJBLK+.FOIOS
	MOVE	T1,[2,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCWP Cannot WRITE checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	$RETT
;CBJZER - ROUTINE TO ZERO THE PRIMARY JOB CHECKPOINT FILE JOB SLOT BUFFER
;	(CPJBUF).  THIS IS USED TO INITIALIZE JOB SLOTS AT LOGIN TIME AND
;	TO ENSURE DATA INTEGRITY IN CASE OF ERROR.

CBJZER:	MOVE	T1,[CPJBUF,,CPJBUF+1]
	SETZM	CPJBUF
	BLT	T1,CPJBUF+CBUFLN-1
	POPJ	P,

;CPJCOP - ROUTINE TO COPY THE PRIMARY CHECKPOINT FILE JOB SLOT BUFFER (CPJBUF)
;	TO ITS COUNTERPART OF THE AUXILLIARY JOB CHECKPOINT FILE BUFFER (CAJBUF).
;	THIS IS USED TO ZERO CAJBUF AND TO RETAIN INFORMATION IN CASE OF A SESSION
;	COMMAND EVENT OR CSHIFT COMMAND EVENT.

CPJCOP:	MOVE	T1,[CPJBUF,,CAJBUF]
	BLT	T1,CAJBUF+CBUFLN-1
	POPJ	P,
;READDP - ROUTINE TO READ THE NEXT DEVICE AREA OF THE DEVICE CHECKPOINT FILE
;	ALREADY OPENED.
;CALL:	DEVNUM CONTAINS THE NUMBER OF READS ALREADY DONE (IN OTHER WORDS,
;	NUMBER OF DEVICES ALREADY READ IN)

READDP:	AOS	T1,DEVNUM	;GET NUMBER OF READS DONE
	SOS	T1		;COMPUTE POSITION IN CHECKPOINT FILE
	IMULI	T1,CPDIOB	;*NUMBER OF BLOCKS PER CHECKPOINT AREA
	ADDI	T1,1+DVOFFS	;ADJUST + FILE OFFSET
	MOVE	T2,CPDCHN	;SET UP THE CHANNEL NUMBER
	PUSHJ	P,AUSETI	;POSITION THE INPUT
	JUMPF	ACTPCF
	MOVE	T1,[IOWD CPDIOL,CPDBUF]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPDCHN	;CHANNEL NUMBER
	HRRI	T1,.FOINP	;READ
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPDBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPDBLK+.FOIOS
	MOVE	T1,[2,,CPDBLK]
	FILOP.	T1,
	$BOMB	<ACTRCF Cannot READ device checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	$RETT


ACTPCF:!TXNN	T1,IO.EOF	;IS IT END OF FILE?
	$BOMB	<ACTPCF Cannot position	device checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	PUSHJ	P,CPDSAU	;AND RE-OPEN IT (CLEAR EOF)
	$RETF			;YES.
;WRITDP - ROUTINE TO WRITE A DEVICE AREA OF THE DEVICE CHECKPOINT FILE ALREADY
;	OPENED.
;CALL:	DEVNUM SET TO DESIRED DEVICE COUNT

WRITDP:	MOVE	T1,DEVNUM	;GET THE DESIRED JOB NUMBER
	SOS	T1		;COMPUTE POSITION IN CHECKPOINT FILE
	IMULI	T1,CPDIOB	;*NUMBER OF BLOCKS PER CHECKPOINT AREA
	ADDI	T1,1+DVOFFS	;ADJUST + FILE OFFSET
	MOVE	T2,CPDCHN	;SET UP THE CHANNEL NUMBER
	PUSHJ	P,AUSETO	;POSITION THE OUTPUT
	JUMPF	ACTPCF		;REPORT POSITIONING ERROR
	MOVE	T1,[IOWD CPDIOL,CPDBUF]
	MOVEM	T1,IOLIST	;SET UP THE I/O LIST
	SETZM	IOLIST+1
	MOVE	T1,CPDCHN	;CHANNEL NUMBER
	HRRI	T1,.FOOUT	;WRITE
	TXO	T1,FO.PRV	;FULL FILE ACCESS TO ACT:
	MOVEM	T1,CPDBLK+.FOFNC
	MOVEI	T1,IOLIST
	MOVEM	T1,CPDBLK+.FOIOS
	MOVE	T1,[2,,CPDBLK]
	FILOP.	T1,
	$BOMB	<ACTWCF Cannot WRITE checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
	$RETT
;CBDZER - ROUTINE TO ZERO THE PRIMARY JOB CHECKPOINT FILE JOB SLOT BUFFER
;	(CPJBUF).  THIS IS USED TO INITIALIZE JOB SLOTS AT LOGIN TIME AND
;	TO ENSURE DATA INTEGRITY IN CASE OF ERROR.

CBDZER:	MOVE	T1,[CPDBUF,,CPDBUF+1]
	SETZM	CPDBUF
	BLT	T1,CPDBUF+CDBFLN-1
	POPJ	P,

;CPDCOP - ROUTINE TO COPY THE PRIMARY CHECKPOINT FILE JOB SLOT BUFFER (CPDBUF)
;	TO ITS COUNTERPART OF THE AUXILLIARY JOB CHECKPOINT FILE BUFFER (CADBUF).
;	THIS IS USED TO ZERO CADBUF AND TO RETAIN INFORMATION IN CASE OF A SESSION
;	COMMAND EVENT OR CSHIFT COMMAND EVENT.

CPDCOP:	MOVE	T1,[CPDBUF,,CADBUF]
	BLT	T1,CADBUF+CDBFLN-1
	POPJ	P,
;CHKPNT - ROUTINE CALLED FROM CHKJOB TO CHECKPOINT THE JOB (JOBNUM) AND STORE
;	THE INFORMATION IN CPJBUF AND CPDBUF.
;		CHKPNT IS DRIVEN BY TWO TABLES GENERATED BY THE "TABS" MACRO.
;	THE FIRST TABLE CONTAINS THE ARGUMENT TO GETTAB; THE SECOND CONTAINS
;	AN INSTRUCTION WHICH IS EXECUTED TO STORE THE RESULTS.  NOTE THAT THIS
;	MACRO IS BASED ON GETTAB'S INDEXED BY JOB NUMBER ONLY.

CHKPNT:	MOVSI	T2,-.NMTAB	;MAKE AN AOBJN POINTER
CHKPN1:	MOVE	T1,GTAB1(T2)	;GET AN ARGUMENT
	HRL	T1,JOBNUM	;GET THE JOB NUMBER
	GETTAB	T1,		;DO THE GETTAB
	  SETZ	T1,		;CAN'T
	XCT	GTAB2(T2)	;STORE THE RESULT
	AOBJN	T2,CHKPN1	;AND LOOP

;NOW GET ALL THE NECESSARY INFORMATION THAT CANNOT BE GETTAB'ED.
	HRRZ	T1,JOBNUM	;GET THE JOB NUMBER
	TXO	T1,RN.PCN	;GET THE RUNTIME TO THE NEAREST TEN-MICROSECOND
	RUNTIM	T1,
	MOVEM	T1,CPJBUF+CRUNTM;STORE IT
	PUSHJ	P,GTTTYS	;GET TTY STATISTICS
	PUSHJ	P,DATIM		;GET THE CURRENT DATE/TIME
	MOVEM	S1,CPJBUF+CLSTCK ;STORE AS TIME OF LAST CHECKPOINT
	SKIPE	CPJBUF+CJOB	;IS THE JOB KNOWN TO US
	POPJ	P,		;YES, STATIC INFORMATION IS CORRECT
;HERE WHEN CHECKPOINTING A JOB (SESSION OR LOGOUT ALSO) AND THE JOB ISN'T
;	KNOWN TO THE ACTDAE.  THIS USUALLY HAPPENS FOR JOBS STARTED BY INITIA
;	OR VIA SYSJOB.INI (INCLUDES ACTDAE).

	MOVE	T1,JOBNUM	;THE JOB NUMBER
	MOVEM	T1,CPJBUF+CJOB	;STORE THE JOB NUMBER
	MOVE	T1,[SIXBIT/ACTDAE/] ;OUR NAME
	MOVEM	T1,CPJBUF+CPGNAM ;AS PROGRAM WHO PROVIDED THE DATA
	MOVE	T1,.JBVER	;OUR VERSION NUMBER
	MOVEM	T1,CPJBUF+CPGVER
	MOVEM	T1,CPJBUF+CACVER ;STORE IN BOTH PLACES
	MOVSI	T2,-.NUTAB	;MAKE AN AOBJN POINTER
CHKPN3:	MOVE	T1,GTAB3(T2)	;GET AN ARGUMENT
	HRL	T1,JOBNUM	;GET THE JOB NUMBER
	GETTAB	T1,		;DO THE GETTAB
	  SETZ	T1,		;CAN'T
	XCT	GTAB4(T2)	;STORE THE RESULT
	AOBJN	T2,CHKPN3	;AND LOOP
	MOVE	T1,[.ACTRD,,T2] ;READ ACCT STRING FUNCTION
	MOVEI	T2,2		;NUMBER OF ARGS
	HRRZ	T3,JOBNUM	;THE JOB NUMBER
	MOVEI	T4,CPJBUF+CACCT	;WHERE TO PUT THE ACCOUNT STRING
	SETZM	CPJBUF+CACCT	;INCASE UUO FAILS
	ACCT.	T1,		;ASK FOR IT
	  $WTO	(<Accounting error>,<^I/ACTTXT/>,,<$WTFLG(WT.SJI)>)
	HRRZ	T1,JOBNUM	;THE JOB NUMBER
	PUSHJ	P,SETTNL	;SET TERMINAL, NODE, LINE FOR JOB
	MOVE	T1,MONLNO	;SETTNL LEFT VALUES THERE
	MOVEM	T1,CPJBUF+CLINNO ;SO MOVE THEM INTO THE CHECKPOINT BLOCK
	MOVE	T1,MONNOD	;THE NODE NAME
	MOVEM	T1,CPJBUF+CNODE
	MOVE	T1,MONTDE	;THE TERMINAL DESIGNATOR
	MOVEM	T1,CPJBUF+CTERDE
	POPJ	P,		;AND RETURN

ACTTXT:	ITEXT	(<Cannot read account string while checkpointing
job ^D/JOBNUM/; assuming a null string>)
	SUBTTL	ACTCHK - GETTABS USED FOR CHECKPOINTING

;THE ARGUMENTS TO THE TABS MACRO ARE:
;	1) ARGUMENT TO GETTAB
;	2) INSTRUCTION TO STORE THE RESULT

DEFINE TABS,<
	T	<.GTRCT>,<PUSHJ P,DSKRED>
	T	<.GTWCT>,<PUSHJ P,DSKWRT>
	T	<.GTKCT>,<MOVEM T1,CPJBUF+CCTI>
	T	<.GTVKS>,<MOVEM T1,CPJBUF+CVCTI>
	T	<.GTEBT>,<MOVEM T1,CPJBUF+CEBOX>
	T	<.GTMBT>,<MOVEM T1,CPJBUF+CMBOX>
	T	<.GTUUC>,<MOVEM T1,CPJBUF+CMCALL>
	T	<.GTTRQ>,<MOVEM T1,CPJBUF+CQUTIM>
> ;END DEFINE TABS

DSKRED:	ANDX	T1,RC.TTL	;ISOLATE TOTAL DISK READS
	MOVEM	T1,CPJBUF+CDREAD	;STORE IT
	POPJ	P,

DSKWRT:	ANDX	T1,WC.TTL	;ISOLATE TOTAL DISK WRITES
	MOVEM	T1,CPJBUF+CDWRIT	;STORE IT
	POPJ	P,

;NOW GENERATE THE TABLES

DEFINE T(A,B),<
	EXP	<A>
>

GTAB1:	TABS
	.NMTAB==.-GTAB1

DEFINE T(A,B),<
	EXP	<B>
>

GTAB2:	TABS


;THESE TABLES FOR JOBS LOGGED IN BEFORE THE ACTDAE STARTED (SYSJOB, INITIA)

DEFINE TABS,<
	T	<.GTPPN>,<MOVEM T1,CPJBUF+CPPN>
	T	<.GTNM1>,<MOVEM T1,CPJBUF+CNAME1>
	T	<.GTNM2>,<MOVEM T1,CPJBUF+CNAME2>
	T	<.GTJLT>,<MOVEM T1,CPJBUF+CSESST>
	T	<.GTLIM>,<PUSHJ P,ISBTCH>
	T	<.GTJLT>,<MOVEM T1,CPJBUF+CJLGTM>
> ;END DEFINE TABS

ISBTCH:	TXNE	T1,JB.LBT	;IS THIS A BATCH JOB
	SKIPA	T1,[2]		;YES, GET CODE FOR BATCH
	MOVEI	T1,1		;NO, CODE FOR TIMESHARING JOB
	MOVEM	T1,CPJBUF+CJBTYP ;STORE TYPE
	POPJ	P,		;RETURN FOR MORE GETTABS

;NOW GENERATE THE TABLES

DEFINE T(A,B),<
	EXP	<A>
>

GTAB3:	TABS
	.NUTAB==.-GTAB3

DEFINE T(A,B),<
	EXP	<B>
>

GTAB4:	TABS
;SUBROUTINE TO GET THE CURRENT TTY STATISTICS FOR THE JOB IN JOBNUM
;	FILLS IN THE WORDS IN CPJBUF, DOESN'T DO ANYTHING IF THE JOB IS DETACHED

GTTTYS:	HRRZ	T3,JOBNUM	;GET THE JOB NUMBER
	TRMNO.	T3,		;LINE NUMBER OF JOB
	  POPJ	P,		;ASSUME DETACHED
	MOVEI	T2,.TOBCT	;GET MONITOR COMMANDS IN LEFT HALF AND COUNT OF
	MOVE	T1,[2,,T2]	; BREAK CHARACTERS TYPED BY USER IN RIGHT HALF
	TRMOP.	T1,
	  SETZ	T1,		;CAN'T GET IT
	HLRM	T1,CPJBUF+CTTCMD
	HRRM	T1,CPJBUF+CTTYBR
	MOVEI	T2,.TOICT	;COUNT OF BREAK CHARACTERS TYPED
	MOVE	T1,[2,,T2]
	TRMOP.	T1,
	  SETZ	T1,		;CAN'T GET IT
	MOVEM	T1,CPJBUF+CTTYI
	MOVEI	T2,.TOOCT	;OUTPUT CHARACTERS (INCLUDING FILL)
	MOVE	T1,[2,,T2]
	TRMOP.	T1,
	  SETZ	T1,		;CAN'T GET IT
	MOVEM	T1,CPJBUF+CTTYO
	POPJ	P,		;AND RETURN
;SETTNL - SUBROUTINE TO SET UP TERMINAL DESIGNATOR, NODE NAME AND LINE NUMBER
;	FOR THE JOB IN T1.  STORES VALUES IN MONTDE, MONLNO, AND MONNOD WHICH
;	IS WHERE THE SYSTEM RESTART RECORD WOULD LIKE TO FIND THEM.
;USES T1-T4

SETTNL:	SETZM	MONLNO		;GET RID OF OLD STUFF FIRST
	SETZM	MONNOD		;...
	MOVSI	T4,(ASCIZ/D/)	;ASSUME DETACHED
	TRMNO.	T1,		;GET TERMINAL DESIGNATOR
	  JRST	SETTN1		;DETACHED
	DPB	T1,[POINT 9,MONLNO,35] ;STORE IN CASE NO NETWORKS
	GETLCH	T1		;GET LINE CHARACTERISTICS
	MOVSI	T4,(ASCIZ/T/)	;ASSUME REGULAR TTY
	TXNE	T1,GL.CTY	;THE SYSTEM CTY
	MOVSI	T4,(ASCIZ/C/)	;YES
	TXNE	T1,GL.ITY	;INVISIBLE (PSEUDO) TTY
	MOVSI	T4,(ASCIZ/P/)	;YES
	HRRZS	T1		;GET RID OF GETLCH BITS
	GTNTN.	T1,		;CONVERT TO NODE AND LINE
	  JRST	SETTN1		;NO NETWORKS
	HRRZM	T1,MONLNO	;STORE REAL LINE NUMBER
	HLRZ	T3,T1		;ISOLATE NODE NUMBER
	MOVEI	T2,2		;NUMBER OF ARGUMENTS
	MOVE	T1,[.NDRNN,,T2]	;RETURN NODE NAME FOR NUMBER
	NODE.	T1,		;ASK TODD
	  SKIPA			;FAILED?
	MOVEM	T1,MONNOD	;STORE SIXBIT NODE NAME
SETTN1:	MOVEM	T4,MONTDE	;STORE TERMINAL DESIGNATOR
	POPJ	P,		;AND RETURN
;CHKSPN - Routine to checkpoint a disk spindle data area.  The
;	device data area has already been read into CPDBUF.
;	This routine will also be called whenever a dismount message
;	is received for the device in CPDBUF.

CHKSPN:	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME
	MOVEM	T1,CPDBUF+SLSTCK ;STORE IT IN THE BLOCK
	$RETT


;CHKFSR - Routine to checkpoint a user file structure data area.  The
;	device data area has already been read into CPDBUF.
;	This routine will also be called whenever a dismount message
;	is received for the device in CPDBUF.

CHKFSR:	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME
	MOVEM	T1,CPDBUF+FLSTCK ;STORE IT IN THE BLOCK
	$RETT


;CHKDTA - Routine to checkpoint a user DECtape device data area.  The
;	device data area has already been read into CPDBUF.
;	This routine will also be called whenever a dismount message
;	is received for the device in CPDBUF.

CHKDTA:	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME
	MOVEM	T1,CPDBUF+DLSTCK ;STORE IT IN THE BLOCK
	$RETT
;CHKMTA - Routine to checkpoint a user magtape device data area.  The
;	device data area has already been read into CPDBUF.
;	This routine will also be called whenever a dismount message
;	is received for the device in CPDBUF.

CHKMTA:	MOVE	T1,CURDTM	;GET CURRENT DATE/TIME
	MOVEM	T1,CPDBUF+MLSTCK ;STORE IT IN THE BLOCK
	MOVEI	T2,MTABLK	;ADDRESS OF .TFSTA ARGUMENT BLOCK
	MOVEI	T1,.TFSTA
	MOVEM	T1,.TSFUN(T2)	;READ THE STATISTICS
	MOVE	T1,CPDBUF+DEVICE ;MAGTAPE DEVICE NAME
	MOVEM	T1,.TSDEV(T2)
	MOVE	T1,[.TSHWE+1,,MTABLK]
	TAPOP.	T1,
	  POPJ	P,		;WHAT!
	MOVE	T1,.TSCRD(T2)	;MAGTAPE READS
	MOVEM	T1,CPDBUF+MMREAD
	MOVE	T1,.TSCWR(T2)	;MAGTAPE WRITES
	MOVEM	T1,CPDBUF+MMWRIT
	MOVE	T1,.TSSRE(T2)	;SOFT READ ERRORS
	MOVEM	T1,CPDBUF+MNOSRE
	MOVE	T1,.TSHRE(T2)	;HARD READ ERRORS
	MOVEM	T1,CPDBUF+MNOHRE
	MOVE	T1,.TSSWE(T2)	;SOFT WRITE ERRORS
	MOVEM	T1,CPDBUF+MNOSWE
	MOVE	T1,.TSHWE(T2)	;HARD WRITE ERRORS
	MOVEM	T1,CPDBUF+MNOHWE
	MOVE	T1,.TSREC(T2)	;RECORDS
	MOVEM	T1,CPDBUF+MRECRD
	$RETT

MTABLK:	BLOCK	.TSHWE+1	;BLOCK FOR TAPOP. STATISTICS
;FNDDEV - Routine to fine the device area for the specified job and device.
;	If an empty device area is found, the device count is stored in
;	DEVAVL.
;Call:	JOBNUM contains the job number
;	T1 contains the device name
;Returns false if EOF and the device area has not been found
;Returns true if the device area has been found.  CPDBUF contains the data.

FNDDEV:	$CALL	.SAVE1
	MOVE	P1,T1		;SAVE THE DEVICE NAME
	PUSHJ	P,CPDSAU	;OPEN THE DEVICE CHECKPOINT FILE
	SETZM	DEVNUM		;START WITH THE FIRST DEVICE IN THE FILE
	SETZM	DEVAVL		;INITIALIZE FOR FIRST AVAILABLE SLOT IN THE FILE
FNDDE1:	$CALL	READDP		;READ THE NEXT BLOCK
	JUMPF	[MOVE	T1,DEVNUM	;EOF
		SKIPN	DEVAVL		;IS THERE AN EMPTY DEVICE AREA?
		MOVEM	T1,DEVAVL	;NO. INDICATE THE LAST OF THE FILE
		$RETF]
	CAMN	P1,CPDBUF+DEVICE ;IS THIS THE CORRECT DEVICE?
	$RETT			;YES.
	SKIPE	CPDBUF+DEVICE	;IS THIS AREA AVAILABLE?
	JRST	FNDDE1		;NO. READ IN THE NEXT DEVICE AREA
	MOVE	T1,DEVNUM	;YES.
	SKIPN	DEVAVL		;HAS AN AREA ALREADY BEEN FOUND?
	MOVEM	T1,DEVAVL	;NO. STORE THIS DEVICE AREA COUNT
	JRST	FNDDE1		;AND READ THE NEXT DEVICE AREA

;ALLDEV - ROUTINE TO FIND ALL THE DEVICES FOR A JOB AND CALL A SERVICE FOR
;	EACH ONE AFTER READING THE DATA INTO CPDBUF.
;CALL T1 =  0,,ROUTINE TO SCAN THE FILE
;     T1 = -1,,ROUTINE TO SCAN THEN DELETE THE FILE
;     JOBNUM = THE JOB WE ARE LOOKING AT
;"ROUTINE" GET CALLED FOR EACH DEVICE WITH P1 = THE DEVICE TYPE NUMBER

ALLDEV:	$CALL	.SAVE2		;SAVE SOME ACS
	MOVE	P2,T1		;COPY ROUTINE TO CALL
	PUSHJ	P,CPDSAU	;OPEN THE CORRECT FILE
	SETZM	DEVNUM		;START AT THE BEGINNING OF THE FILE
ALLDV1:	$CALL	READDP		;READ IN A DEVICE AREA
	JUMPF	ALLDV2		;END OF FILE
	SKIPN	CPDBUF+DEVICE	;IS THERE A DEVICE IN THIS AREA
	JRST	ALLDV1		;NO, TRY THE NEXT AREA
	SKIPLE	P1,CPDBUF+DEVTYP ;GET DEVICE TYPE
	CAILE	P1,4		;;;RANGE CHECK IT
ACTIDT:	JRST	[$WTO	(<Accounting error>,<Unknown device type ^O/P1/>,,<$WTFLG(WT.SJI)>)
		 JRST	ALLDV1]	;GET ANOTHER DEVICE
	PUSHJ	P,(P2)		;CALL ROUTINE WITH GOOD "P1"
	JRST	ALLDV1		;AND GET ANOTHER DEVICE
ALLDV2:	MOVE	T1,DEVNUM	;GET DEVICE AFTER EOF
	CAIE	T1,1		;IF FIRST, THEN FILE IS EMPTY, DELETE IT
	SKIPGE	P2		;CALLER WANT FILE TO DISAPPEAR
	PUSHJ	P,CPDDEL	;YES, DELETE IT
	PUSHJ	P,CPDCLS	;CLOSE THE FILE
	POPJ	P,		;AND RETURN
	SUBTTL	ACTCHK - TIME KEEPING ROUTINES

DATIM:	$CALL	I%NOW		;GET THE CURRENT DATE/TIME
	MOVEM	S1,CURDTM	;SAVE IT
	$RETT

;CHKTMR - RETURN NUMBER OF SECONDS INTO THE CURRENT HOUR

CHKTMR:	MSTIME	S1,		;GET MS. PAST MIDNIGHT
	IDIVI	S1,^D1000	;GET SECONDS PAST MIDNIGHT
	IDIVI	S1,^D3600	;S1 = THE HOUR, S2 = SECONDS PAST THE HOUR
	POPJ	P,		;RETURN VALUES

;NXTCHK - COMPUTE THE NEXT CHECKPOINT TIME

NXTCHK:	PUSHJ	P,CHKTMR	;FIND OUT CURRENT TIME IN CHECKPOINT UNITS
	MOVSI	S1,-INTBLN	;NUMBER OF ENTRIES IN THE TABLE
	CAML	S2,INTTBL(S1)	;STOP WHEN WE FIND ONE BEYOND NOW
	AOBJN	S1,.-1		;KEEP LOOKING
	HRRZM	S1,CHKNDX	;SAVE INDEX INTO TABLE
	POPJ	P,		;RETURN

;CHKIVL - COMPUTE THE TIME REMAINING UNTIL A CHECKPOINT IS REQUIRED
;		DOES THE CHECKPOINT IF IT IS TIME TO

CHKIVL:	PUSHJ	P,CHKTMR	;FIND OUT THE CURRENT TIME
	SKIPGE	S1,CHKNDX	;INDEX FOR NEXT COMPUTED TIME
	JRST	CHKIV1		;FORCED ONE AT STARTUP, DO IT NOW
	MOVE	S1,INTTBL(S1)	;AND GET "WHEN" FROM TABLE
	SUB	S1,S2		;S1 = TIME TO DESIRED CHECKPOINT
	CAILE	S1,CHKINT*^D60	;IF TIME .GT. THE CHECKPOINT INTERVAL
	SETO	S1,		;THEN THIS IS WRAP AROUND ON THE HOUR
	JUMPG	S1,.POPJ	;RETURN TIME IF NOT YET TIME TO CHECKPOINT
CHKIV1:	PUSHJ	P,CHKAJB	;CHECKPOINT ALL ACTIVE JOBS
	SKIPN	FAIIFN		;IF NO FAILURE LOG FILE IFN, TRY OF OPEN FILE
	PUSHJ	P,OPNFAI
	JRST	CHKIVL		;RECOMPUTE/RETURN TIME TIL NEXT ONE

;THE TABLE USED FOR DETERMINING WHEN THE NEXT CHECKPOINT WILL OCCUR

INTTBL:
..VAL==0
REPEAT ^D60,<
	..VAL==..VAL+<CHKINT*^D60>
	IFL ..VAL-^D3600,<EXP ..VAL>
>
	EXP	^D3600		;LAST ENTRY AT THE FULL HOUR
INTBLN==.-INTTBL		;NUMBER OF ENTRIES IN THE TABLE
	SUBTTL	ACTUSG - MODULE TO HANDLE USAGE FILES


;GENERAL DEFINITIONS

USGBSZ:	BLOCK	1		;USAGE FILE BYTE SIZE
USGBPT:	BLOCK	1		;USAGE FILE BYTE POINTER
USGOSZ:	BLOCK 1			;SIZE OF USAGE.OUT AT FIRST SIGHT
USGIFN:	BLOCK 1			;GALAXY HANDLE FOR USAGE.OUT
USGPTR:	BLOCK 1			;BYTE POINTER INTO USGBUF FOR THE CURRENT ENTRY
SAVPTR:	BLOCK 1			;TEMPORARY STORAGE FOR USGPTR
USGBUF:	BLOCK ^D200		;BUFFERS WHERE USAGE ENTRIES ARE BUILT BEFORE BEING
				; WRITTEN OUT TO THE USAGE.OUT FILE.
USGBND:				;FIRST WORD OUTSIDE THE BUFFER

NUMBER:	BLOCK 1			;TEMPORARY STORAGE FOR DATA BEING FORMATTED
USGENT:	BLOCK 1			;CURRENT ENTRY BEING WORKED ON
USGERD:	BLOCK 1			;CURRENT RECORD DEFINITION BLOCK FOR "USGENT"
JIFSEC:	BLOCK 1			;NUMBER OF JIFFIES/SECOND ON THIS MACHINE
ETICKS:	BLOCK 1			;NUMBER OF EBOX TICKS/JIFFY
MTICKS:	BLOCK 1			;NUMBER OF MBOX TICKS/JIFFY

FAIIFN:	EXP	0		;VALIDATION FAILURE FILE IFN
FAIPAG:	EXP	0		;ADDRESS OF VALIDATION FAILURE BUFFER
FAIMAX:	EXP	0		;MAXIMUM BYTES IN BUFFER
FAICNT:	EXP	0		;NUMBER OF BYTES THAT CAN FIT
FAIPTR:	EXP	0		;BYTE POINTER INTO BUFFER

USRZER:				;START ZEROING HERE
USRERR:	BLOCK	1		;ERROR CODE
USRJOB:	BLOCK	1		;JOB NUMBER OF OFFENDER
USRPPN:	BLOCK	1		;PPN OF OFFENDER
USRNAM:	BLOCK	2		;12 CHAR SIXBIT NAME OF OFFENDER
USRPRG:	BLOCK	1		;PROGRAM NAME OF OFFENDER

USRARG:	BLOCK	1		;START OF ARG BLOCK FOR NETOP.
USRFLG:	BLOCK	1		;FLAGS RETURNED BY NETOP.
USRUDX:	BLOCK	1		;UDX OF OFFENDER
USRDTY:	BLOCK	1		;DEVTYP OF HIS TTY
USRDCH:	BLOCK	1		;DEVCHR OF HIS TTY
USRNDA:	BLOCK	1		;ADDRESS OF STRING BLOCK CONTAINING HIS NODE
USRLNA:	BLOCK	1		;ADDRESS OF STRING BLOCK CONTAINING HIS LINE

USRTTY:	BLOCK	1		;TTY NAME OF OFFENDER
USRNOD:	BLOCK	1	;ANF NODE NUMBER OF OFFENDER
USRNDN:	BLOCK	<<^D16/4>+1>	;STRING BLOCK FOR NODE NAME OF OFFENDER
USRLIN:	BLOCK	<<^D16/4>+1>	;STRING BLOCK FOR LINE NAME OF OFFENDER

USRAPC:	BLOCK	1		;APC CODE OF OFFENDER
USRZEN==.-1
;USGMAK - ROUTINE TO DO PRELIMINARY SET UP FOR MAKING ANY KIND OF USAGE ENTRY.
;	SO FAR ONLY QUEUE. UUO'S ARE ALLOWED FOR PROGRAMS OTHER THAN THE
;	ACTDAE TO MAKE AN ENTRY.
;CALL:	QUEADR/ ADDRESS OF MAKE AN ENTRY DATA WHICH CONTAINS:
;		0/ USENT$
;		1/ ENTRY TYPE
;		2/ BEGINNING OF DEFUS LIST
;	MDBADR/ MESSAGE DESCRIPTOR BLOCK ADDRESS
;	MMSADR/ MESSAGE DATA ADDRESS

USGMAK:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	IGNORE		;WASN'T. RELEASE MESSAGE AND IGNORE IT
	MOVE	T2,QUEADR	;ADDRESS OF DATA IN THE FORMAT THIS ROUTINE EXPECTS
	MOVE	T1,1(T2)	;ENTRY TYPE
	MOVEI	DEFADR,2(T2)	;BEGINNING ADDRESS OF DEFUS LIST
	PUSHJ	P,MAKENT	;MAKE THE ENTRY IN THE USAGE FILE
	PUSH	P,TF		;SAVE SUCCESS/FAILURE OF MAKENT
	MOVE	S1,QUELEN	;GIVE BACK THE MEMORY USED FOR DEFUS LIST
	MOVE	S2,QUEADR
	$CALL	M%RMEM
	PUSHJ	P,M%GPAG	;GET A PAGE FOR THE RESPONSE
	MOVEM	S1,SABADR	;STORE WHERE COMMON ROUTINES WANT IT
	MOVX	T1,MF.NOM	;NO MESSAGE (YET)
	MOVEM	T1,.MSFLG(S1)	;STORE FLAG SETTINGS
	POP	P,TF		;RESTORE RETURN FROM MAKENT
	SKIPT			;DID MAKENT HONOR THE REQUEST
	FATAL	(IET,<Invalid entry type ^D/USGENT/>,ACIET%,.+1)
	PJRST	ACTVXT		;RELEASE OLD MSG AND SEND QUEUE UUO RESPONSE
;MAKENT - ROUTINE TO BE CALLED WHEN AN ENTRY IS TO BE APPENDED TO USAGE.OUT.
;CALL:	MOVE	T1,ENTRY NUMBER
;	MOVE 	DEFADR,BEGINNING ADDRESS OF DEFUS DATA LIST

MAKENT:	MOVEM	T1,USGENT	;SAVE ENTRY NUMBER DESIRED
	JUMPLE	T1,.RETF	;FIRST ENTRY IS 1
	CAIL	T1,.UTUSR	;SYSTEM OR USER DEFINED ENTRY
	JRST	[SUBI T1,.UTUSR-1 ;USER, CONVERT TO TABLE INDEX
		 CAILE T1,ENTRUL## ;SEE IF DEFINED IN ACTRCD
		 $RETF		;NOPE, GIVE ERROR RETURN
		 MOVE T1,ENTRYU##-1(T1) ;GET RECORD DEFINITION ADDRESS
		 JRST MAKEN1]	;JOIN MAIN CODE AGAIN
	CAILE	T1,ENTRYL##	;SEE IF DEFINED IN ACTRCD
	$RETF			;NOPE, GIVE ERROR RETURN
	MOVE	T1,ENTRYS##-1(T1) ;GET RECORD DEFINITION ADDRESS
MAKEN1:	MOVEM	T1,USGERD	;SAVE FOR DATFIL
	MOVE	S1,USGBPT	;GET BYTE POINTER
	HRRI	S1,USGBUF	;ADD IN ADDRESS
	MOVEM	S1,USGPTR	;STORE IT
	SETZM	USGBUF		;CLEAR THE WORKING BUFFER
	MOVE	S1,[USGBUF,,USGBUF+1]
	BLT	S1,USGBND-1	;CLEAR IT
	PUSHJ	P,PREFIL	;GO PRE-FILL THE ENTRY
	MOVE	T1,USGPTR	;BYTE POINTER AT END
	MOVEM	T1,SAVPTR	;SAVE TO COMPUTE SIZE OF ENTRY
	PUSHJ	P,DATFIL	;NOW FILL IN THE SUPPLIED DATA
	PUSHJ	P,USGAPP	;GO PUT ENTRY INTO THE FILE
	$RETT			;MAKENT SUCCEEDS
;PREFIL - ROUTINE TO PRE-FILL AN ENTRY IN CASE SOME DATA ISN'T PROVIDED BY
;	THE CALLER.
;CALL:	MOVE	T1,ADDRESS OF RECORD LIST
;	USGENT CONTAINS THE ENTRY NUMBER

PREFIL:	$CALL	.SAVE4
	HRRZ	P1,T1
	TXO	P1,<(P2)>	;PUT P2 IN INDEX REGISTER FOR "DOUBLE INDEXING"
	MOVEI	P2,1		;FIRST RECORD SEQUENCE NUMBER
	SKIPE	MAKDUE		;ARE WE MAKING DISK USAGE ENTRIES (2ND HALF)
	MOVEI	P2,3		;YES, GO STRAIGHT TO THE 3RD RECORD
PREFI1:	HRRZ	P3,@P1		;GET ADDRESS OF DATA ITEM LIST
	PUSHJ	P,MAKHDR	;FILL FIRST 20 CHARACTERS
	HLRZ	P4,(P3)		;GET DATA ITEM COUNT -- P4 IS THE LOOP COUNTER
				; OVER RECORD'S DATA LIST
	ADDI	P3,1		;STEP TO BEGINNING OF DATA ITEMS IN LIST
PREFI2:	MOVE	T1,USGPTR	;GET BYTE POINTER TO THE BEGINNING OF THIS
	MOVEM	T1,1(P3)	; DATUM IN USGBUF AND SAVE IT IN THE
				; SECOND WORD OF THIS DATUM'S DESCRIPTOR
	MOVSI	T1,(1B0)	;INDICATE NULL DATA IN T1
	LDB	T3,[POINT 12,(P3),11]	;GET CONVERSION TYPE
	LDB	LENGTH,[POINT 9,(P3),20]	;GET LENGTH OF DATA ITEM
	PUSHJ	P,CONVRT	;FILL
	ADDI	P3,2		;STEP TO NEXT DATA ITEM DESCRIPTOR
	SOJG	P4,PREFI2	;PRE-FILL THE RECORD
	PUSHJ	P,CRLF		;PUT IN CARRIAGE RETURN-LINE FEED
	CAMGE	P2,(P1)		;HAVE ALL RECORDS BEEN PRE-FILLED?
	AOJA	P2,PREFI1	;NO. DO NEXT RECORD
	POPJ	P,


;CRLF - ROUTINE TO OUTPUT A CARRIAGE RETURN-LINE FEED.

CRLF:	MOVEI	T1,.CHCRT	;CARRIAGE RETURN
	IDPB	T1,USGPTR
	MOVEI	T1,.CHLFD	;LINE-FEED
	IDPB	T1,USGPTR
	POPJ	P,
;MAKHED - ROUTINE TO ENTER THE FIRST 20 CHARACTERS OF A RECORD.
;	TO BE SAFE, THE ONLY ROUTINE CALLING THIS ONE IS PREFIL.
;
;CALL:	MOVE	P1,ADJUSTED INDEXED POINTER TO RECORD LIST
;	MOVE	P2,RECORD SEQUENCE #
;	MOVE	P3,ADDRESS OF RECORDS' DATA ITEM LIST

MAKHDR:	MOVE	T1,USGENT	;ENTRY TYPE ADDRESS
	TXO	T1,US%IMM	;INDICATE T1 CONTAINS DATA
	MOVEI	LENGTH,^D4	;LENGTH OF FOUR
	MOVEI	T3,.USDEC	;DECIMAL CONVERSION
	PUSHJ	P,CONVRT
	MOVEI	T1,^D1		;INDICATE TOPS10 OPERATING SYSTEM
	TXO	T1,US%IMM	;INDICATE THAT T1 CONTAINS THE DATA
	MOVEI	LENGTH,^D1	;LENGTH OF 1
	MOVEI	T3,.USDEC	;DECIMAL CONVERSION
	PUSHJ	P,CONVRT
	HRRZ	T1,P2		;RECORD SEQUENCE NUMBER
	TXO	T1,US%IMM	;INDICATE T1 CONTAINS DATA
	MOVEI	LENGTH,^D1	;LENGTH OF 1
	MOVEI	T3,.USDEC	;DECIMAL CONVERSION
	PUSHJ	P,CONVRT
	LDB	T1,[POINT 9,(P3),26]	;DEC REVISION NUMBER
	TXO	T1,US%IMM	;INDICATE T1 CONTAINS DATA
	MOVEI	LENGTH,^D2	;LENGTH OF 2
	MOVEI	T3,.USDEC	;DECIMAL CONVERSION
	PUSHJ	P,CONVRT
	LDB	T1,[POINT 9,(P3),35]	;CUSTOMER REVISION NUMBER
	TXO	T1,US%IMM	;INDICATE THAT T1 CONTAINS DATA
	MOVEI	LENGTH,^D2	;LENGTH OF 2
	MOVEI	T3,.USDEC	;DECIMAL CONVERSION
	PUSHJ	P,CONVRT
	MOVEI	LENGTH,^D10	;NOW DO THE FILLER
	MOVEI	T3,.USSPC	;SPACE CONVERSION
	PUSHJ	P,CONVRT
	POPJ	P,
;DATFIL - ROUTINE TO TAKE GIVEN DATA, CONVERT TO ASCII AND PUT IN ITS PROPER
;	PLACE OF THE USAGE ENTRY IN USGBUF.  NOTE THAT THE ENTRY SHOULD HAVE
;	ALREADY BEEN PRE-FILLED SINCE THE BYTE POINTER OF EACH DATUM IS STORED
;	IN ALL THE DATA ITEM LISTS. SEE PREFIL ROUTINE.  USGENT SHOULD ALREADY
;	CONTAIN THE ENTRY NUMBER.
;	P1 WILL BECOME THE ADJUSTED INDEXED POINTER TO THE ENTRY'S RECORD LIST.
;	P2 WILL CONTAIN THE RECORD SEQUENCE NUMBER CURRENTLY BEING SCANNED.
;	P3 WILL CONTAIN THE ADDRESS OF THE CURRENT RECORD'S DATA LIST.
;	P4 IS THE LOOP COUNTER OVER THE CURRENT RECORD'S DATA LIST.
;	DEFADR CONTAINS THE ADDRESS OF THE DEFUS ITEM IN THE MESSAGE CURRENTLY
;	BEING WORKED UPON.  ALL DATA ITEMS OF ALL RECORDS OF AN ENTRY ARE SCANNED
;	FOR EACH DATUM SUPPLIED IN THE MESSAGE.  THAT WAY A PARTICULAR DATUM
;	CAN APPEAR IN AN ENTRY TWICE BUT ONLY OCCUR ONCE IN THE MESSAGE.
;CALL:	MOVE	DEFADR, ADDRESS OF DATA CONSISTING OF DEFUS FORMATTED DATA (SEE ACTSYM)

DATFIL:	$CALL	.SAVE4
	MOVE	P1,USGERD	;GET ADDRESS OF THIS ENTRY'S RECORD LIST
DATFI1:	SKIPN	(DEFADR)	;IS THERE MORE DATA TO PUT IN THE ENTRY?
	POPJ	P,		;NO. ALL DONE PUTTING ENTRY IN USGBUF
	TXO	P1,<(P2)>	;PUT P2 IN INDEX REG. FOR "DOUBLE INDEXING"
	MOVEI	P2,1		;FIRST RECORD SEQUENCE NUMBER
	SKIPE	MAKDUE		;ARE WE MAKING DISK USAGE ENTRIES (2ND HALF)
	MOVEI	P2,3		;YES, GO STRAIGHT TO THE 3RD RECORD
DATFI2:	HRRZ	P3,@P1		;GET ADDRESS OF THIS RECORD'S DATA ITEM LIST
	HLRZ	P4,(P3)		;RECORD'S DATA ITEM COUNT, P4 IS LOOP COUNTER
				; OVER RECORD'S DATA LIST
	ADDI	P3,1		;STEP TO BEGINNING OF RECORD'S DATA LIST
DATFI3:	LDB	T1,[POINTR (<(DEFADR)>,US%COD)] ;GET THE NUMBER OF DATA ITEM IN THE MESSAGE
	LDB	T2,[POINTR (<(P3)>,US%COD)] ;GET DEFUS NUMBER OF RECORD'S DATA ITEM
	CAMN	T1,T2		;ARE THEY THE SAME?
	PUSHJ	P,PUTDAT	;YES. GO CONVERT DATA AND PUT IN USGBUF
	ADDI	P3,2		;STEP TO NEXT DATA ITEM DESCRIPTOR IN RECORD LIST
	SOJG	P4,DATFI3	;SCAN ALL DATA ITEMS IN THIS RECORD (P2)
	CAMGE	P2,(P1)		;HAVE ALL RECORDS BEEN SCANNED FOR THIS PIECE OF DATA?
	AOJA	P2,DATFI2	;NO. DO NEXT RECORD
	ADDI	DEFADR,2	;ADJUST POINTER TO MESSAGE TO POINT TO NEXT DATUM
	JRST	DATFI1		; AND SCAN OVER ALL RECORDS



;PUTDAT - ROUTINE TO CONVERT AND PUT DATA ITEMS INTO USGBUF BASED ON BYTE
;	POINTER STORED IN SECOND WORD OF RECORD MACRO FOR THE DATUM.
;	SEE DATFIL FOR CORRECT AC SET UP.

PUTDAT:	LDB	T3,[POINTR (<(P3)>,US%TYP)] ;GET CONVERSION TYPE
	LDB	LENGTH,[POINTR (<(P3)>,US%LEN)] ;GET LENGTH OF DATUM
	MOVE	T1,1(DEFADR)	;GET THE SECOND WORD OF THIS DATUM
	MOVE	T2,1(P3)	;GET THE BYTE POINTER INTO USGBUF WHERE DATA STARTS
	MOVEM	T2,USGPTR	;CONVRT USES USGPTR AS THE COMMON BYTE POINTER
	PJRST	CONVRT		;PLACE THE DATA INTO USGBUF AND RETURN TO DATFIL
;CONVRT - ROUTINE TO BE CALLED TO CONVERT AND PUT DATA INTO THE USAGE FILE
;	BLOCK (USGBUF) BASED ON THE BYTE POINTER USGPTR.
;CALL:	MOVE	T1,DATA IF BIT 0=1, OR
;		   ADDRESS OF DATA IF BIT 0=0
;	MOVE	LENGTH,LENGTH OF DATA ITEM
;	MOVE	T3,ITEM CONVERSION TYPE (SEE US%TYP DESCRIPTIONS IN ACCSYM)
;	PUSHJ	P,CONVRT
;	RETURN HERE

CONVRT:	PJRST	@CONVR1(T3)

CONVR1:	OUTASC			;PUT ASCII DATA IN ENTRY
	OUTSIX			;PUT SIXBIT DATA IN ENTRY
	OUTOCT			;PUT OCTAL NUMBER IN ENTRY
	OUTDEC			;PUT DECIMAL NUMBER IN ENTRY
	OUTDTM			;PUT DATE/TIME IN ENTRY (STANDARD FORMAT)
	OUTSPC			;PUT A SPECIAL ITEM IN ENTRY
	OUTVER			;PUT A VERSION NUMBER IN ENTRY (STANDARD FORMAT)
	OUTSPC			;PUT ALL SPACES IN ENTRY
	OUTODT			;PUT OLD FORMAT DATE/TIME
;OUTODT - ROUTINE TO OUTPUT OLD STYLE TOPS-10 DATE/TIME INTO FORMAT
;	"YYYYMMDDHHMMSS" AND PLACE INTO USAGE BUFFER.

OUTODT:	TXZN	T1,US%IMM	;DOES T1 CONTAIN DATA OR AN ADDRESS
	MOVE	T1,(T1)		;ADDRESS, GET DATUM
	JUMPE	T1,OUTZER	;ZERO FILL IF NULL ARGUMENT
	PUSH	P,T1		;SAVE DATE/TIME
	HLRZ	T1,T1		;GET DATE
	PUSHJ	P,OUTDAT	;OUTPUT DATE
	POP	P,T1		;RESTORE DATE/TIME
	HRRZ	T1,T1		;ONLY TIME
	IMULI	T1,^D60*^D1000	;CONVERT MINUTES AFTER TO MILLISECONDS
	PJRST	OUTTIM		;CONVERT TIME

;OUTASC - ROUTINE TO OUTPUT AN ASCIZ STRING INTO THE USAGE BUFFER.
;
;CALL:	SEE CONVRT ROUTINE FOR SETUP AND CALL

OUTASC:	TXZE	T1,US%IMM	;DOES T1 CONTAIN THE DATA?
	SKIPA	T2,[POINT 7,T1]	;YES.
	MOVSI	T2,(POINT 7,(T1)) ;NO.
OUTAS1:	ILDB	T3,T2		;NOW GET A CHARACTER
	JUMPE	T3,OUTSPC	;IF NULL, SPACE FILL THE REST
	CAIGE	T3,40		;VALID ASCII CHARACTER?
	MOVEI	T3,"\"		;NO. PROVIDE ONE
	IDPB	T3,USGPTR	;PUT THE CHARACTER IN THE USAGE BUFFER
	SOJG	LENGTH,OUTAS1	;LOOP BACK FOR NEXT CHARACTER
	POPJ	P,		;PERFECT FIT. RETURN.

;OUT8BT - ROUTINE TO OUTPUT AN 8-BIT ASCIZ STRING INTO THE USAGE BUFFER.
;
;CALL:	SEE CONVRT ROUTINE FOR SETUP AND CALL

OUT8BT:	TXZE	T1,US%IMM	;DOES T1 CONTAIN THE DATA?
	SKIPA	T2,[POINT 8,T1]	;YES.
	MOVSI	T2,(POINT 8,(T1)) ;NO.
OUT8B1:	ILDB	T3,T2		;NOW GET A CHARACTER
	JUMPE	T3,OUTSPC	;IF NULL, SPACE FILL THE REST
	CAIGE	T3,40		;VALID ASCII CHARACTER?
	MOVEI	T3,"\"		;NO. PROVIDE ONE
	IDPB	T3,USGPTR	;PUT THE CHARACTER IN THE USAGE BUFFER
	SOJG	LENGTH,OUT8B1	;LOOP BACK FOR NEXT CHARACTER
	POPJ	P,		;PERFECT FIT. RETURN.

;OUTSIX - ROUTINE TO FORMAT AND OUTPUT A SIXBIT WORD IN THE USAGE FILE.  NOTE THAT
;	THIS ROUTINE WILL ONLY HANDLE ONE WORD OF SIXBIT DATA.  IF MORE THAN THAT
;	IS REQUIRED, AN ASCIZ STRING SHOULD BE USED INSTEAD (SEE OUTASC).
;CALL:	SEE CONVRT ROUTINE FOR SET UP AND CALL

OUTSIX:	TXZN	T1,US%IMM	;DOES T1 CONTAIN THE DATA?
	MOVE	T1,(T1)		;NO. GET THE DATA
	MOVE	T2,[POINT 6,T1]	;MAKE THE BYTE POINTER
OUTSX1:	ILDB	T3,T2		;GET A CHARACTER
	ADDI	T3,40		;CONVERT TO ASCII
	IDPB	T3,USGPTR	;PUT IT IN THE USAGE BUFFER
	SOJG	LENGTH,OUTSX1	;LOOP UNTIL DONE
	POPJ	P,		;EXACT FIT OF SIX CHARACTERS. RETURN

;OUTOCT AND OUTDEC - ROUTINES TO PUT SIGNED NUMBERS INTO THE USAGE BUFFER.
;	SEE CONVRT ROUTINE FOR SETUP AND CALL.

OUTOCT:	SKIPA	T4,[10]		;OCTAL ENTRY
OUTDEC:	MOVEI	T4,^D10		;DECIMAL ENTRY
	TXZN	T1,US%IMM	;IS THE DATA IN T1 OR AN ADDRESS?
	MOVE	T1,(T1)		;IT'S AN ADDRESS. GET THE DATA.
	PJRST	NUMRHT		;CONVERT AND FORMAT THE NUMBER
;NUMRHT -- ROUTINE TO ENTER A NUMBER INTO USGBUF.
;	(NUMBERS ARE ALWAYS RIGHT-JUSTIFIED IN THE USAGE FILE.)
;CALL:	MOVE	LENGTH,THE MAXIMUM LENGTH OF THE DATA ITEM
;	MOVE	T1,NUMBER TO BE PROCESSED
;	MOVE	T4,RADIX USED TO CONVERT
;	PUSHJ	P,NUMRHT
;	RETURN HERE ALWAYS


NUMRHT:	JUMPLE	T1,OUTZER	;IF NUMBER IS ZERO THE FIELD HAS ALREADY BEEN FILLED
	MOVEM	T1,NUMBER	;SAVE NUMBER
	MOVEI	T3,1		;COUNT THE FIRST DIVIDE
	CAIGE	T1,0		;CHECK FOR NEGATIVE NUMBER
	ADDI	T3,1		;ALLOW FOR NEGATIVE SIGN
NUMRH0:	IDIVI	T1,(T4)
	SKIPE	T1
	AOJA	T3,NUMRH0	;T3 IS CHARACTER COUNT OF NUMBER
	MOVE	T1,NUMBER	;GET NUMBER
NUMRH1:	CAMG	T3,LENGTH	;SKIP IF NUMBER WON'T FIT IN FIELD
	JRST	[MOVEM	T1,NUMBER	;STORE ADJUSTED NUMBER
		JRST	NUMRH2]
	IDIVI	T1,(T4)		;THROW AWAY LEAST SIGNIFICANT DIGIT
	SOJA	T3,NUMRH1	;LOOP UNTIL NUMBER CAN FIT
NUMRH2:	SUBI	T3,(LENGTH)	;NUMBER OF CHARACTERS TO SKIP
	SKIPN	T3		;IF ZERO DON'T ADJUST THE BYTE POINTER
	JRST	NUMRH4
	MOVEI	T1,"0"		;FILL WITH ZERO
NUMRH3:	IDPB	T1,USGPTR	;SKIP OVER ALL FILLS
	AOJL	T3,NUMRH3
NUMRH4:	MOVE	T1,NUMBER	;RESTORE THE NUMBER BEFORE WE FALL INTO RDXSTR
;	PJRST	RDXSTR
;FALL INTO RDXSTR


;RDXSTR -- PUT SIGNED NUMBER INTO USGBUF (NOTE THAT NO FILL IS DONE HERE)
;CALL:	MOVE	T1,NUMBER
;	MOVE	T4,RADIX
;	PUSHJ	P,RDXSTR

RDXSTR::JUMPGE	T1,RDXST1	;CHECK FOR NEGATIVE
	MOVE	T2,T1		;SAVE AWAY ARGUMENT
	MOVEI	T1,"-"		;YES--GET MINUS
	IDPB	T1,USGPTR	;PUT IN STRING
	MOVE	T1,T2		;RESTORE NUMBER
RDXST1:	IDIV	T1,T4		;DIVIDE BY RADIX
	MOVMS	T2		;GET MAGNITUDE
	HRLM	T2,(P)		;SAVE REMAINDER
	SKIPE	T1		;SEE IF ANYTHING LEFT
	PUSHJ	P,RDXST1	;YES--LOOP BACK WITH PD LIST
	HLRZ	T1,(P)		;GET BACK A DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	IDPB	T1,USGPTR
	POPJ	P,
;OUTDTM -- ROUTINE TO PROCESS UNIVERSAL DATE AND TIME (GETTAB %CNDTM) INTO
;	FORMAT "YYYYMMDDHHMMSS" AND PLACE INTO USAGE BUFFER.
;CALL:	SEE CONVRT ROUTINE FOR SETUP.

OUTDTM:	TXZN	T1,US%IMM	;DOES T1 CONTAIN DATA OR AN ADDRESS?
	MOVE	T1,(T1)		;T1 CONTAINS AN ADDRESS. GET THE DATA IN T1
	JUMPE	T1,OUTZER	;ZERO FILL IF NULL ARGUMENT
	PUSHJ	P,CNGDAT	;CHANGE DATE/TIME
	PUSH	P,T1		;SAVE TIME
	MOVE	T1,T2		;GET DATE
	PUSHJ	P,OUTDAT	;OUTPUT DATE
	POP	P,T1		;RETURN TIME
	PJRST	OUTTIM		;CONVERT TIME

;OUTDAT -- OUTPUT ACCOUNTING DATE IN FORMAT OF YYYYMMDD
;CALL:	MOVE	T1,DATE RETURNED BY CNGDAT
;	PUSHJ	P,OUTDAT

OUTDAT:	IDIVI	T1,^D31*^D12	;GET YEAR - 1964
	PUSH	P,T2		;SAVE DAYS IN THE YEAR
	MOVEI	LENGTH,^D4	;SET UP LENGTH SINCE JUSTIFICATION IS NECESSARY WITHIN ITEM
	ADDI	T1,^D1964	;ADJUST YEAR
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	PUSHJ	P,OUTDEC	;ENTER NUMBER IN USGBUF
	POP	P,T1		;RETURN DAYS IN YEAR
	IDIVI	T1,^D31		;GET MONTHS
	ADDI	T1,1		;ADJUST MONTH #
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	PUSH	P,T2		;SAVE REMAINDER
	MOVEI	LENGTH,^D2	;FIELD LENGTH
	PUSHJ	P,OUTDEC	;PUT IN USGBUF
	POP	P,T1		;GET DAY NUMBER
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	AOJA	T1,OUTDEC	;FIELD LENGTH SAME AS MONTHS

;OUTTIM -- ACCOUNTING TIME IN FORMAT HHMMSS
;CALL:	MOVE	T1, TIME RETURNED BY CNGDAT (IN MILLISECONDS)
;	PUSHJ	P,OUTTIM

OUTTIM:	IDIV	T1,[^D3600000]	;GET HOURS
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	PUSH	P,T2		;SAVE REMAINDER
	MOVEI	LENGTH,^D2	;FIELD LENGTH
	PUSHJ	P,OUTDEC	;PUT IN USGBUF
	POP	P,T1		;GET THE REST
	IDIVI	T1,^D60000	;GET MINUTES
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	PUSH	P,T2		;SAVE REMAINDER
	MOVEI	LENGTH,2	;FIELD LENGTH
	PUSHJ	P,OUTDEC	;PUT IN USGBUF
	POP	P,T1		;GET THE REST
	IDIVI	T1,^D1000	;GET SECONDS
	TXO	T1,US%IMM	;INDICATE THAT THE DATA IS IN T1
	MOVEI	LENGTH,2	;FIELD LENGTH
	PJRST	OUTDEC		;PUT IN USGBUF
;CNGDAT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL:	MOVE	T1,DATE/TIME
;	PUSHJ	P,CNGDAT
;	RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4

CNGDAT::PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNGDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10		;**** NOTE WELL ****

	ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
				;T1=DAYS SINCE JAN 1, 1501
	IDIVI	T1,400*365+400/4-400/100+400/400
				;SPLIT INTO QUADRACENTURY
	LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS
	IDIVI	T2,<100*365+100/4-100/100>*4+400/400
				;SPLIT INTO CENTURY
	IORI	T3,3		;DISCARD FRACTIONS OF DAY
	IDIVI	T3,4*365+1	;SEPARATE INTO YEARS
	LSH	T4,-2		;T4=NO DAYS THIS YEAR
	LSH	T1,2		;T1=4*NO QUADRACENTURIES
	ADD	T1,T2		;T1=NO CENTURIES
	IMULI	T1,100		;T1=100*NO CENTURIES
	ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	T2,3		;IS THE YEAR A MULT OF 4?
	JRST	CNGDT0		;NO--JUST INDICATE NOT A LEAP YEAR
	IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100
	SKIPN	T3		;IF NOT, THEN LEAP
	TRNN	T2,3		;IS YEAR MULT OF 400?
	TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL
CNGDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG
				;T3 IS 0 IF LEAP YEAR
	;UNDER RADIX 10 **** NOTE WELL ****

CNGDT1:	SUBI	T1,1964		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNGDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNGDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNGDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNGDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNGDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNGDT3	;LOOP THROUGH NOVEMBER

CNGDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
CNGDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNGDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365

	RADIX	8
;OUTVER -- PUT WORD IN VERSION NUMBER FORMAT. (NOTE THAT THIS ROUTINE ALWAYS
;	DOES ITS OWN FORMATTING.)
;CALL:	SEE CONVRT ROUTINE FOR THE SETUP.
;	PUSHJ	P,OUTVER
;	RETURN HERE ALWAYS

OUTVER:	TXZN	T1,US%IMM	;DOES T1 CONTAIN DATA OR AN ADDRESS?
	MOVE	T1,(T1)		;AN ADDRESS.  GET THE DATA
	SKIPN	T1		;IF ZERO JUST DO SPACE FILL
	JRST	OUTSPC
	MOVEI	T4,10		;SET UP RADIX HERE
	MOVEM	T1,NUMBER	;PUT THE VERSION NUMBER IN A SAFE PLACE
	LDB	T1,[POINT 9,NUMBER,11] ;GET MAJOR VERSION
	SKIPE	T1		;IF NON-ZERO,
	PUSHJ	P,RDXSTR	;PUT OCTAL NUMBER IN STRING
	LDB	T1,[POINT 6,NUMBER,17] ;GET MINOR VERSION
	JUMPE	T1,OUTVE2	;IF NON-ZERO,
	SOS	T1		;  PRINT IN MODIFIED
	IDIVI	T1,^D26		;  RADIX 26 ALPHA
	JUMPE	T1,OUTVE1	;  JUMP IF ONE CHAR
	MOVEI	T1,"A"-1(T1)	;  ISSUE FIRST OF TWO
	IDPB	T1,USGPTR		;  CHARACTERS
OUTVE1:	MOVEI	T1,"A"(T2)	;  ISSUE "UNITS"
	IDPB	T1,USGPTR	;  CHARACTER
OUTVE2:	HRRZ	T1,NUMBER	;GET EDIT NUMBER
	JUMPE	T1,OUTVE3	;IF NON-ZERO,
	MOVEI	T2,"("		;  ISSUE
	IDPB	T2,USGPTR	;  AS OCTAL WITHIN
	PUSHJ	P,RDXSTR	;  PARENTHESES
	MOVEI	T1,")"		;  ..
	IDPB	T1,USGPTR
OUTVE3:	LDB	T1,[POINT 3,NUMBER,2] ;GET "WHO" FIELD
	JUMPE	T1,.POPJ	;IF NON-ZERO,
	MOVEI	T2,"-"		;  PRINT -
	IDPB	T2,USGPTR	;  AND THEN
	PJRST	RDXSTR		;  AS OCTAL
;OUTSPC - ROUTINE TO OUTPUT (LENGTH) SPACES INTO THE USAGE BUFFER USGBUF.
;	THIS ROUTINE IS ALSO CALLED BY OTHERS TO FINISH UP ANY SPACE FILL.
;CALL:	SEE CONVRT ROUTINE FOR SET UP AND CALL.

OUTSPC:	JUMPLE	LENGTH,.POPJ	;DON'T DO ANYTHING.
	MOVEI	T1," "		;ASCII SPACE
OUTSP1:	IDPB	T1,USGPTR	;OUTPUT THE CHARACTER IN THE USAGE BUFFER
	SOJG	LENGTH,OUTSP1	;LOOP UNTIL DONE
	POPJ	P,


;OUTZER - ROUTINE TO OUTPUT (LENGTH) ZEROES INTO THE USAGE BUFFER USGBUF.
;CALL:	SEE CONVRT ROUTINE FOR SET UP AND CALL.

OUTZER:	JUMPLE	LENGTH,.POPJ	;DON'T DO ANYTHING
	MOVEI	T1,"0"		;ASCII ZERO
OUTZE1:	IDPB	T1,USGPTR	;OUTPUT THE CHARACTER IN THE USAGE BUFFER
	SOJG	LENGTH,OUTZE1	;LOOP UNTIL DONE
	POPJ	P,
;MAKSES - ROUTINE TO MAKE A SESSION ENTRY FROM THE PRIMARY AND AUXILIARY
;	JOB CHECKPOINT FILES.
;CALL:	JOBNUM CONTAINS THE JOB NUMBER
;	CURDTM CONTAINS THE DATE/TIME FOR THE ENTRY
;	CPJBUF AND CAJBUF CONTAIN THE JOBS INFORMATION
;	PUSHJ	P,MAKSES
;	RETURN HERE

MAKSES:	PUSHJ	P,DODIFF	;GET THE SESSION'S DATA
	MOVEI	T1,.UTSEN	;INDICATE A SESSION ENTRY
	MOVEI	DEFADR,SESSIO	;ADDRESS OF SESSION ENTRY'S DEFUS LIST
	PJRST	MAKENT

;MKISES - ROUTINE TO MAKE AN INCOMPLETE SESSION ENTRY FOR RESTART
;	SAME AS MAKSES EXCEPT DIFFERENT ENTRY CODE

MKISES:	PUSHJ	P,DODIFF	;GET THE SESSION DATA
	MOVEI	T1,.UTCKP	;INDICATE CAME FROM RESTART FILE
	MOVEI	DEFADR,SESSIO	;WHERE THE DEFUS LIST IS
	PJRST	MAKENT		;MAKE THE ENTRY


;DODIFF - ROUTINE TO CALCULATE THE ACTUAL VARIANT DATA OF ANY JOB'S SESSION.
;	TO DO THIS, A DATUM OF THE JOB'S SLOT IN THE AUXILLIARY CHECKPOINT
;	FILE IS SUBTRACTED FROM ITS COUNTERPART IN THE PRIMARY JOB CHECKPOINT
;	FILE.  IN SOME CASES, I.E., CONNECT TIME, CALCULATIONS HAVE TO BE
;	MADE.
;CALL:	A CHECKPOINT OF JOB HAS BEEN DONE (THIS IMPLIES THAT CURDTM, THE
;	CURRENT DATE/TIME HAS BEEN UPDATED), AND THE JOB'S SLOTS OF BOTH
;	CHECKPOINT FILES HAVE ALREADY BEEN READ INTO CPJBUF AND CAJBUF.

DODIFF:	MOVE	T1,CPJBUF+CRUNTM	;RUNTIME
	SUB	T1,CAJBUF+CRUNTM
	IDIVI	T1,^D100		;CONVERT TO MS. FROM 10-US.
	MOVEM	T1,SESBLK+CRUNTM
	MUL	T1,JIFSEC		; RUNTIME/TIME IN RUN QUEUE
	MULI	T1,[^D100000000]	;RQT=(RUNTIME IN JIFFIES * JIFFIES PER SECOND
	MOVE	T2,CPJBUF+CQUTIM	; * 10**11)/1000
	DIV	T1,T2
	MOVEM	T1,SESBLK+CQUTIM
	MOVE	T1,CPJBUF+CLSTCK	;CALCULATE CONNECT TIME
	SUB	T1,CPJBUF+CSESST
	MUL	T1,[^D24*^D60*^D60]
	DIV	T1,[1,,0]
	TRNE	T2,1B18			;SHOULD THE NUMBER BE ROUNDED?
	AOS	T1			;YES.
	MOVEM	T1,SESCCT
	MOVE	T1,CPJBUF+CDREAD	;DISK READS
	SUB	T1,CAJBUF+CDREAD
	MOVEM	T1,SESBLK+CDREAD
	MOVE	T1,CPJBUF+CDWRIT	;DISK WRITES
	SUB	T1,CAJBUF+CDWRIT
	MOVEM	T1,SESBLK+CDWRIT
	MOVE	T1,CPJBUF+CCTI		;CORE-TIME INTEGRAL
	SUB	T1,CAJBUF+CCTI
	IMULI	T1,^D100
	IDIV	T1,JIFSEC
	MOVEM	T1,SESBLK+CCTI
	MOVE	T1,CPJBUF+CVCTI		;VIRTUAL CORE-TIME INTEGRAL
	SUB	T1,CAJBUF+CVCTI
	IMULI	T1,^D100
	IDIV	T1,JIFSEC
	MOVEM	T1,SESBLK+CVCTI
	MOVE	T1,CPJBUF+CEBOX		;EBOX RUNTIME
	SUB	T1,CAJBUF+CEBOX
	MOVEM	T1,SESBLK+CEBOX
	MOVE	T1,CPJBUF+CMBOX		;MBOX RUNTIME
	SUB	T1,CAJBUF+CMBOX
	MOVEM	T1,SESBLK+CMBOX
	MOVE	T1,CPJBUF+CMCALL
	SUB	T1,CAJBUF+CMCALL
	MOVEM	T1,SESBLK+CMCALL
DOFDTT:	MOVE	T1,CPJBUF+CTTCMD	;MONITOR COMMANDS
	SUB	T1,CAJBUF+CTTCMD
	MOVEM	T1,SESBLK+CTTCMD
	MOVE	T1,CPJBUF+CTTYI		;TERMINAL INPUT CHARACTERS
	SUB	T1,CAJBUF+CTTYI
	MOVEM	T1,SESBLK+CTTYI
	MOVE	T1,CPJBUF+CTTYO		;TERMINAL OUTPUT CHARACTERS
	SUB	T1,CAJBUF+CTTYO
	MOVEM	T1,SESBLK+CTTYO
	MOVE	T1,CPJBUF+CTTYBR	;TERMINAL BREAK CHARACTERS USER TYPED
	SUB	T1,CAJBUF+CTTYBR
	MOVEM	T1,SESBLK+CTTYBR
	POPJ	P,
;DEFUS LIST FOR SESSION AND INCOMPLETE SESSION ENTRIES

SESSIO:	USJNO.	(CPJBUF+CJOB)	;JOB NUMBER
	USTAD.	(CURDTM)	;CURRENT DATE/TIME
	USTRM.	(CPJBUF+CTERDE)	;TERMINAL DESIGNATOR
	USLNO.	(CPJBUF+CLINNO)	;LINE NUMBER
	USPNM.	(CPJBUF+CPGNAM)	;NAME OF PROGRAM (USUALLY LOGIN)
	USPVR.	(CPJBUF+CPGVER)	;VERSION OF USPNM.
	USAMV.	(CPJBUF+CACVER)	;VERSION OF ACTDAE
	USNOD.	(CPJBUF+CNODE)	;NODE NAME
	USACT.	(CPJBUF+CACCT)	;ACCOUNT STRING
	USRTM.	(SESBLK+CRUNTM)	;RUNTIME
	USSST.	(CPJBUF+CSESST)	;SESSION START DATE/TIME
	USJTY.	(CPJBUF+CJBTYP)	;JOB TYPE
	USBJN.	(CPJBUF+CBTNAM)	;BATCH JOB NAME
	USBSN.	(CPJBUF+CBTSEQ)	;BATCH SEQUENCE NUMBER
	USCOM.	(CPJBUF+CRMRK)	;SESSION REMARK
	USCCT.	(SESCCT)	;SESSION CONNECT TIME
	USRIN.	(CPJBUF+CBTRID)	;BATCH REQUEST ID
	USDKR.	(SESBLK+CDREAD)	;DISK READS
	USDKW.	(SESBLK+CDWRIT)	;DISK WRITES
	USCTI.	(SESBLK+CCTI)	;CORE-TIME INTEGRAL
	USVTI.	(SESBLK+CVCTI)	;VIRTUAL CORE-TIME INTEGRAL
	USEBX.	(SESBLK+CEBOX)	;EBOX MEGACOUNTS
	USMBX.	(SESBLK+CMBOX)	;MBOX MEGACOUNTS
	USMCL.	(SESBLK+CMCALL)	;MONITOR CALLS
	USMCM.	(SESBLK+CTTCMD)	;MONITOR COMMANDS
	USSCL.	(CPJBUF+CCLASS)	;SCHEDULING CLASS
	USTYI.	(SESBLK+CTTYI)	;TERMINAL INPUT CHARACTERS
	USTYO.	(SESBLK+CTTYO)	;TERMINAL OUTPUT CHARACTERS
	USTYW.	(SESBLK+CTTYBR)	;COUNT OF BREAK CHARACTERS USER TYPED
	USRQQ.	(SESBLK+CQUTIM)	;RUN QUEUE QUOTIENT -- RUNTIME/TIME IN QUEUE
	USPPN.	(CPJBUF+CPPN)	;PROJECT-PROGRAMMER NUMBER
	USNM1.	(CPJBUF+CNAME1)	;USER NAME
	USNM3.	(CPJBUF+CNAME2)	;USER NAME (SECOND WORD)

	0			;AND A ZERO TO TERMINATE THE LIST






SESCCT:	BLOCK 1			;SESSION CONNECT TIME
SESBLK:	BLOCK CEND		;STORAGE FOR CALCULATED VALUES
;MAKFSR - Routine to make a user file structure entry based on the correct
;	data being in CPDBUF.

MAKFSR:	PUSHJ	P,FSRDIF	;CALCULATE ANY DIFFERENCES
	MOVEI	T1,.UTMNT	;ENTRY TYPE
	MOVEI	DEFADR,FILMNT	;DEFUS LIST
	PJRST	MAKENT


;FSRDIF - Routine to calculate data needed to make a user file structure entry.

FSRDIF:	MOVE	T1,CPDBUF+FLSTCK	;CALCULATE CONNECT TIME
	SUB	T1,CPDBUF+FSESST
	MUL	T1,[^D24*^D60*^D60]
	DIV	T1,[1,,0]
	TRNE	T2,1B18		;SHOULD THE NUMBER BE ROUNDED?
	AOS	T1		;YES.
	MOVEM	T1,CPDBUF+FCONNE
	POPJ	P,



;DEFUS LIST FOR USER FILE STRUCTURE ENTRY

FILMNT:	USJNO.	(CPDBUF+FJOB)	;JOB NUMBER
	USTAD.	(CURDTM)	;CURRENT DATE/TIME
	USTRM.	(CPDBUF+FTERDE);TERMINAL DESIGNATOR
	USLNO.	(CPDBUF+FLINNO);LINE NUMBER
	USPNM.	(CPDBUF+FPGNAM);PROGRAM NAME
	USPVR.	(CPDBUF+FPGVER);PROGRAM VERSION NUMBER
	USAMV.	(CPDBUF+FACVER);ACTDAE VERSION NUMBER
	USNOD.	(CPDBUF+FNODE)	;NODE NAME
	USFMA.	(CPDBUF+FACCT)	;ACCOUNT OF USER
	USSSI.	(CPDBUF+DEVICE);FILE STRUCTURE NAME
	USFST.	(CPDBUF+FFSTYP);FILE STRUCTURE TYPE
	USTNP.	(CPDBUF+FPCKNO);NUMBER OF PACKS IN FILE STRUCTURE
	USFCT.	(CPDBUF+FCONTY);CONTROLLER TYPE
	USFDT.	(CPDBUF+FDEVTY);DEVICE TYPE
	USFDS.	(CPDBUF+FDISPO);DISPOSITION
	USFOT.	(CPDBUF+FOTEXT);TEXT TO EXPLAIN DISPOSITION
	USFCD.	(CPDBUF+FCREDT);CREATION DATE/TIME
	USFSD.	(CPDBUF+FSCHDT);SCHEDULED DATE/TIME
	USSRV.	(CPDBUF+FSERDT);SERVICED DATE/TIME
	USMCT.	(CPDBUF+FMNTCT);MOUNT COUNT BEFORE MOUNT
	USDCT.	(CPDBUF+FDISCT);MOUNT COUNT AFTER DISMOUNT
	USATP.	(CPDBUF+FACCES);ACCESS TYPE
	USFCO.	(CPDBUF+FCONNE);CONNECT TIME IN SECONDS
	USPPN.	(CPDBUF+FPPN)	;PROJECT-PROGRAMMER NUMBER OF USER
	USNM1.	(CPDBUF+FNAME1);USER NAME
	USNM3.	(CPDBUF+FNAME2);USER NAME (CONT.)
	0			;TERMINATE LIST WITH A ZERO
;MAKMAG - Routine to make a user magtape entry based on the correct
;	data being in CPDBUF.

MAKMAG:	PUSHJ	P,MAGDIF	;CALCULATE ANY DIFFERENCES
	MOVEI	T1,.UTMMT	;ENTRY TYPE
	MOVEI	DEFADR,MAGMNT	;DEFUS LIST
	PJRST	MAKENT


;MAGDIF - Routine to calculate data needed to make a user magtape entry.

MAGDIF:	MOVE	T1,CPDBUF+MLSTCK	;CALCULATE CONNECT TIME
	SUB	T1,CPDBUF+MSESST
	MUL	T1,[^D24*^D60*^D60]
	DIV	T1,[1,,0]
	TRNE	T2,1B18		;SHOULD THE NUMBER BE ROUNDED?
	AOS	T1		;YES.
	MOVEM	T1,CPDBUF+MCONNE
	MOVE	T1,CPDBUF+MMREAD ;READS
	SUB	T1,CADBUF+MMREAD
	IDIVI	T1,^D1000	;IN THOUSANDS
	MOVEM	T1,MGREAD
	MOVE	T1,CPDBUF+MMWRIT ;WRITES
	SUB	T1,CADBUF+MMWRIT
	IDIVI	T1,^D1000	;IN THOUSANDS
	MOVEM	T1,MGWRIT
	MOVE	T1,CPDBUF+MRECRD ;RECORDS READ
	SUB	T1,CADBUF+MRECRD
	SKIPGE	T1		;COULD BE -1 IF NEVER READ
	SETZ	T1,		;MAKE DATA CONSISTANT
	MOVEM	T1,MRCRED
	MOVE	T1,CPDBUF+MNOSRE ;SOFT READ ERRORS
	SUB	T1,CADBUF+MNOSRE
	MOVEM	T1,MAGSRE
	MOVE	T1,CPDBUF+MNOSWE ;SOFT WRITE ERRORS
	SUB	T1,CADBUF+MNOSWE
	MOVEM	T1,MAGSWE
	MOVE	T1,CPDBUF+MNOHRE ;HARD READ ERRORS
	SUB	T1,CADBUF+MNOHRE
	MOVEM	T1,MAGHRE
	MOVE	T1,CPDBUF+MNOHWE ;HARD WRITE ERRORS
	SUB	T1,CADBUF+MNOHWE
	MOVEM	T1,MAGHWE
	POPJ	P,

;DEFUS LIST FOR USER MAGTAPE ENTRY

MAGMNT:	USJNO.	(CPDBUF+MJOB)	;JOB NUMBER
	USTAD.	(CURDTM)	;DATE/TIME ENTRY IS MADE
	USTRM.	(CPDBUF+MTERDE);TERMINAL DESIGNATOR
	USLNO.	(CPDBUF+MLINNO);LINE NUMBER
	USPNM.	(CPDBUF+MPGNAM);PROGRAM NAME
	USPVR.	(CPDBUF+MPGVER);PROGRAM VERSION NUMBER
	USAMV.	(CPDBUF+MACVER);ACTDAE VERSION NUMBER
	USNOD.	(CPDBUF+MNODE)	;NODE NAME
	USMAC.	(CPDBUF+MACCT)	;USER ACCOUNT STRING
	USVID.	(CPDBUF+MVOLID);VOLUME ID RECORDED IN VOL1 LABEL
	USVSN.	(CPDBUF+MRELID);VISUAL LABEL OF TAPE
	USMRF.	(MGREAD)	;MAGTAPE READS - THOUSANDS OF CHARS
	USMWF.	(MGWRIT)	;MAGTAPE WRITES - THOUSANDS OF CHARS
	USMDS.	(CPDBUF+MDISPO);DISPOSITION
	USMTX.	(CPDBUF+MOTEXT);TEXT TO EXPLAIN DISPOSITION
	USMCD.	(CPDBUF+MCREDT);CREATION DATE/TIME OF REQUEST
	USMSD.	(CPDBUF+MSCHDT);SCHEDULED DATE/TIME OF MOUNT REQUEST
	USMVD.	(CPDBUF+MSERDT);SERVICED DATE/TIME OF MOUNT REQUEST
	USMCO.	(CPDBUF+MCONTY);TYPE OF CONTROLLER
	USMLT.	(CPDBUF+MLABEL);LABEL TYPE
	USMLS.	(CPDBUF+MSTATE);VOLUME LABEL STATE
	USMRD.	(MRCRED)	;RECORDS READ
	USMWR.	(MRCWRI)	;RECORDS WRITTEN
	USFSI.	(CPDBUF+MFSTID);FILE SET IDENTIFIER
	USSRE.	(MAGSRE)	;NUMBER OF SOFT READ ERRORS
	USSWE.	(MAGSWE)	;NUMBER OF SOFT WRITE ERRORS
	USHRE.	(MAGHRE)	;NUMBER OF HARD READ ERRORS
	USHWE.	(MAGHWE)	;NUMBER OF HARD WRITE ERRORS
	USMCN.	(CPDBUF+MCONNE);CONNECT TIME IN SECONDS
	USDVN.	(CPDBUF+MEVICE)	;PHYSICAL DEVICE NAME
	USPPN.	(CPDBUF+MPPN)	;PROJECT PROGRAMMER NUMBER
	USNM1.	(CPDBUF+MNAME1);USER NAME
	USNM3.	(CPDBUF+MNAME2);USER NAME (CONT.)
	0			;TERMINATE LIST WITH A ZERO
;MAKDEC - Routine to make a user DECtape entry based on the correct
;	data being in CPDBUF.

MAKDEC:	PUSHJ	P,DECDIF	;CALCULATE ANY DIFFERENCES
	MOVEI	T1,.UTDMT	;ENTRY TYPE
	MOVEI	DEFADR,DECMNT	;DEFUS LIST
	PJRST	MAKENT


;DECDIF - Routine to calculate data needed to make a user DECtape entry.

DECDIF:	MOVE	T1,CPDBUF+DLSTCK	;CALCULATE CONNECT TIME
	SUB	T1,CPDBUF+DSESST
	MUL	T1,[^D24*^D60*^D60]
	DIV	T1,[1,,0]
	TRNE	T2,1B18		;SHOULD THE NUMBER BE ROUNDED?
	AOS	T1		;YES.
	MOVEM	T1,CPDBUF+DCONNE
	POPJ	P,

;DEFUS LIST FOR USER DECTAPE ENTRY

DECMNT:	USJNO.	(CPDBUF+DJOB)	;JOB NUMBER
	USTAD.	(CURDTM)	;DATE/TIME ENTRY IS MADE
	USTRM.	(CPDBUF+DTERDE);TERMINAL DESIGNATOR
	USLNO.	(CPDBUF+DLINNO);LINE NUMBER
	USPNM.	(CPDBUF+DPGNAM);PROGRAM NAME
	USPVR.	(CPDBUF+DPGVER);PROGRAM VERSION NUMBER
	USAMV.	(CPDBUF+DACVER);ACTDAE VERSION NUMBER
	USNOD.	(CPDBUF+DNODE)	;NODE NAME
	USDAN.	(CPDBUF+DACCT)	;ACCOUNT STRING OF USER
	USDVI.	(CPDBUF+DVOLID);DECTAPE LABEL
	USDRI.	(CPDBUF+DRELID);VISUAL LABEL OF DECTAPE
	USDTR.	(DECRED)	;DECTAPE READS
	USDTW.	(DECWRI)	;DECTAPE WRITES
	USDDS.	(CPDBUF+DDISPO);DISPOSITION
	USDTX.	(CPDBUF+DOTEXT);TEXT TO EXPLAIN DISPOSITION
	USDCE.	(CPDBUF+DCREDT);CREATION DATE/TIME
	USDSQ.	(CPDBUF+DSCHDT);SCHEDULED DATE/TIME
	USDSS.	(CPDBUF+DSERDT);SERVICED DATE/TIME
	USDCN.	(CPDBUF+DCONNE);CONNECT TIME
	USDVN.	(CPDBUF+DDVICE)	;PHYSICAL DEVICE NAME
	USPPN.	(CPDBUF+DPPN)	;PROJECT PROGRAMMER NUMBER
	USNM1.	(CPDBUF+DNAME1);USER NAME
	USNM3.	(CPDBUF+DNAME2);USER NAME (CONT.)
	0			;TERMINATE LIST WITH A ZERO
;MAKSPN - Routine to make a disk spindle entry based on the correct
;	data being in CPDBUF.

MAKSPN:	PUSHJ	P,SPNDIF	;CALCULATE ANY DIFFERENCES
	MOVEI	T1,.UTDSU	;ENTRY TYPE
	MOVEI	DEFADR,DSKMNT	;DEFUS LIST
	PJRST	MAKENT


;SPNDIF - Routine to calculate data needed to make a disk spindle entry.

SPNDIF:	MOVE	T1,CPDBUF+SLSTCK	;CALCULATE CONNECT TIME
	SUB	T1,CPDBUF+SCSHIF
	MUL	T1,[^D24*^D60*^D60]
	DIV	T1,[1,,0]
	TRNE	T2,1B18		;SHOULD THE NUMBER BE ROUNDED?
	AOS	T1		;YES.
	MOVEM	T1,CPDBUF+SCONNE
	POPJ	P,

;DEFUS LIST FOR DISK PACK SPINDLE ENTRY

DSKMNT:	USJNO.	(CPDBUF+SJOB)	;JOB NUMBER
	USTAD.	(CURDTM)	;DATE/TIME ENTRY IS MADE
	USTRM.	(CPDBUF+STERDE);TERMINAL DESIGNATOR
	USLNO.	(CPDBUF+SLINNO);LINE NUMBER
	USPNM.	(CPDBUF+SPGNAM);PROGRAM NAME
	USPVR.	(CPDBUF+SPGVER);PROGRAM VERSION NUMBER
	USAMV.	(CPDBUF+SACVER);ACTDAE VERSION NUMBER
	USNOD.	(CPDBUF+SNODE)	;NODE NAME
	USSFS.	(CPDBUF+SFSNAM);FILE STRUCTURE NAME
	USSFT.	(CPDBUF+SFSTYP);FILE STRUCTURE TYPE
	USSCT.	(CPDBUF+SCONTY);CONTROLLER TYPE
	USSDT.	(CPDBUF+SDEVTY);DEVICE TYPE
	USSID.	(CPDBUF+SPAKID);DISK PACK IDENTIFIER
	USSDU.	(CPDBUF+SEVICE)	;DISK UNIT NAME
	USSNP.	(CPDBUF+SPCKNO);TOTAL NUMBER OF PACKS IN FILE STRUCTURE
	USSMN.	(CPDBUF+SPKMTH);M OF N COUNT
	USDTF.	(CPDBUF+SMNTDT);DATE/TIME PACK WAS FIRST SPUN UP
	USDCC.	(CPDBUF+SCONNE);CONNECT TIME
	0			;TERMINATE LIST WITH A ZERO


;STORAGE FOR CALCULATED VALUES

DECRED:	BLOCK 1			;DECTAPE READS (NOT IMPLEMENTED)
DECWRI:	BLOCK 1			;DECTAPE WRITES (NOT IMPLEMENTED)
MAGHRE:	BLOCK 1			;MAGTAPE HARD READ ERRORS
MAGHWE:	BLOCK 1			;MAGTAPE HARD WRITE ERRORS
MAGSRE:	BLOCK 1			;MAGTAPE SOFT READ ERRORS
MAGSWE:	BLOCK 1			;MAGTAPE SOFT WRITE ERRORS
MGREAD:	BLOCK 1			;MAGTAPE READS
MGWRIT:	BLOCK 1			;MAGTAPE WRITES
MRCRED:	BLOCK 1			;MAGTAPE RECORDS READ
MRCWRI:	BLOCK 1			;MAGTAPE RECORDS WRITTEN (TOPS-20 ONLY)
;MAKUFH - ROUTINE TO MAKE A USAGE FILE HEADER WHEN USAGE.OUT IS INITIALLY CREATED.

MAKUFH:	PUSHJ	P,DOUFHD	;FILL IN A USAGE FILE HEADER
	MOVEI	T1,.UTUSB	;FIRST RECORD OF USAGE.OUT
	MOVEI	DEFADR,UFHLST	;POINT TO THE DEFUS LIST
	PJRST	MAKENT		;MAKE THE ENTRY AND RETURN

;MAKRES - ROUTINE TO MAKE A SYSTEM OR ACTDAE RESTART RECORD

MAKRES:	PUSHJ	P,DOREST	;FILL IN A RESTART RECORD
	MOVEI	T1,.UTRST	;SYSTEM/ACTDAE RESTART
	MOVEI	DEFADR,RESLST	;POINT TO THE DEFUS LIST
	PJRST	MAKENT

;DOREST - FILL IN THE DEFUS ITEMS FOR A SYSTEM RESTART RECORD
;	THE UFH RECORD IS THE SAME FORMAT SO THERE IS ONLY 1
;	ROUTINE TO GATHER THE DATA FOR BOTH OF THEM.

DOUFHD:				;OTHER NAME
DOREST:	MOVSI	T2,-.NXTAB	;MAKE AN AOBJN POINTER
RESTA1:	MOVE	T1,GTAB5(T2)	;GET AN ARGUMENT
	GETTAB	T1,		;DO THE GETTAB
	  SETZ	T1,		;ASSUME 0
	XCT	GTAB6(T2)	;STORE THE RESULT
	AOBJN	T2,RESTA1	;AND LOOP
	PJOB	T1,		;GET OUT JOB NUMBER
	MOVEM	T1,MONJNO	;SAVE IT AWAY
	PUSHJ	P,SETTNL	;SET UP TERMINAL, NODE AND LINE
	POPJ	P,		;AND RETURN

DEFINE TABS,<
	T	<%CNFG0>,<MOVEM T1,MONAME+0>
	T	<%CNFG1>,<MOVEM T1,MONAME+1>
	T	<%CNFG2>,<MOVEM T1,MONAME+2>
	T	<%CNFG3>,<MOVEM T1,MONAME+3>
	T	<%CNFG4>,<MOVEM T1,MONAME+4>
	T	<%CNVER>,<MOVEM T1,MONVER>
	T	<%CCSER+2*0>,<MOVEM T1,MONCPI+0>
	T	<%CCSER+2*1>,<MOVEM T1,MONCPI+1>
	T	<%CCSER+2*2>,<MOVEM T1,MONCPI+2>
	T	<%CCSER+2*3>,<MOVEM T1,MONCPI+3>
	T	<%CCSER+2*4>,<MOVEM T1,MONCPI+4>
	T	<%CCSER+2*5>,<MOVEM T1,MONCPI+5>
	T	<%CNCPU>,<MOVEM T1,MONCPN>
	T	<%CNSUP>,<PUSHJ P,SYSUPT>
> ;END DEFINE TABS

SYSUPT:	PUSH	P,T2		;SAVE LOOP INDEX
	IDIV	T1,JIFSEC	;CONVERT JIFFIES TO SECONDS
	MOVEM	T1,MONUPT	;SAVE UPTIME
	POP	P,T2		;RESTORE AC
	POPJ	P,		;RETURN TO GET ANOTHER

;NOW GENERATE THE TABLES

DEFINE T(A,B),<
	EXP	<A>
>

GTAB5:	TABS
	.NXTAB==.-GTAB5

DEFINE T(A,B),<
	EXP	<B>
>

GTAB6:	TABS

MONJNO:	BLOCK 1			;SPACE FOR ACTDAE JOB NUMBER
MONLNO:	BLOCK 1			;SPACE FOR ACTDAE LINE NUMBER
MONNOD:	BLOCK 1			;SPACE FOR ACTDAE NODE NUMBER
MONTDE:	BLOCK 1			;SPACE FOR ACTDAE TERMINAL DESIGNATOR
MONCPN:	BLOCK 1			;SPACE FOR NUMBER OF CPUS IN CONFIG
MONUPT:	BLOCK 1			;SPACE FOR SYSTEM UPTIME (IN SECONDS)
MONVER:	BLOCK 1			;SPACE FOR MONITOR VERSION NUMBER
MONAME:	BLOCK 10		;SPACE FOR MONITOR NAME IN ASCII
MONCPI:	BLOCK 6			;SPACE FOR CPU0 THROUGH CPU5 APR ID


;THE DEFUS LIST PROPER FOR RESTART AND NEW FILE RECORDS

UFHLST:
RESLST:	USJNO.	(MONJNO)	;OUR JOB NUMBER
	USTAD.	(CURDTM)	;CURRENT DATE/TIME
	USTRM.	(MONTDE)	;OUR TERMINAL DESIGNATOR
	USLNO.	(MONLNO)	;OUR LINE NUMBER
	USPNM.	([SIXBIT/ACTDAE/]) ;PROGRAM MAKING THE ENTRY
	USPVR.	(.JBVER)	;VERSION NUMBER
	USAMV.	(.JBVER)	;VERSION OF THE ACTDAE
	USNOD.	(MONNOD)	;OUR NODE NAME
	USSNM.	(MONAME)	;MONITOR NAME
	USMVR.	(MONVER)	;MONITOR VERSION NUMBER
	USMUP.	(MONUPT)	;SYSTEM UPTIME
	USCPN.	(MONCPN)	;NUMBER OF CPUS FROM MONGEN
	USCP0.	(MONCPI+0)	;APRID OF CPU0
	USCP1.	(MONCPI+1)	;APRID OF CPU1
	USCP2.	(MONCPI+2)	;APRID OF CPU2
	USCP3.	(MONCPI+3)	;APRID OF CPU3
	USCP4.	(MONCPI+4)	;APRID OF CPU4
	USCP5.	(MONCPI+5)	;APRID OF CPU5
	USLCK.	(CPJGEN+LASTCH)	;LAST CHECKPOINT DATE/TIME IS ALWAYS THERE
	0			;AND A ZERO THE TERMINATE THE DEFUS LIST
;DOUBC - CALLED BY QUASAR TO DO BILLING CLOSURE

DOUBC:	PUSHJ	P,SESAJB	;MAKE ENTRIES FOR ALL JOBS
	$WTOXX	<Session entries written for all jobs>
	$RETT			;AND RETURN
;DOUFC - ROUTINE TO CLOSE OUT BILLING SESSION FOR ALL ACTIVE JOBS AND THEN
;	CLOSE/RENAME/RE-OPEN USAGE.OUT. CALLED BY QUASAR (SET USAGE FILE-CLOSURE)

DOUFC:	$CALL	.SAVE1		;SAVE P1 FOR A MOMENT
	MOVE	T1,MMSADR	;GET MESSAGE ADDRESS
	MOVE	P1,.OFLAG(T1)	;GET FLAGS
	TXNN	P1,US.NOS	;DO WE WANT /SOME-SESSION-ENTRIES
	PUSHJ	P,SESAJB	;YES, CLOSE OUT ALL THE SESSIONS
	PUSHJ	P,USGCRN	;CLOSE, RENAME USAGE.OUT
	JUMPF	USGUF2		;GIVE DIFFERENT MESSAGE IF DIDN'T MAKE IT
	$WTOXX	<^F/USGFD/ closed and renamed to ^F/USGRFD/>
USGUF1:	PUSHJ	P,USGSAU	;RE-OPEN THE FILE
	SKIPN	USGOSZ		;DID THE RENAME WORK (NEW FILE SIZE = 0)
	PUSHJ	P,MAKUFH	;YES, MAKE A USAGE FILE HEADER RECORD
	$RETT			;AND RETURN
USGUF2:	$WTOXX	<Cannot rename ^F/USGFD/, continuing with old file>
	JRST	USGUF1		;RESUME
	SUBTTL	ACTIO -  MODULE CONTAINING COMMON INPUT/OUTPUT ROUTINES

;CPJSAU - ROUTINE TO OPEN THE PRIMARY JOB CHECKPOINT FILE, USEJOB.BIN, IN
;	SINGLE ACCESS UPDATE MODE.
;	CPJCHN - CHANNEL NUMBER
;	CPJBLK - FILOP. BLOCK
;	USEJOB - LOOPUP/ENTER BLOCK

CPJSAU:	SKIPN	T1,CPJCHN	;DOES A CHANNEL ALREADY EXIST?
	TXO	T1,FO.ASC	;NO. HAVE THE MONITOR GIVE US ONE.
	TXO	T1,FO.PRV	;GIVE US FULL FILE ACCESS TO ACT:
	HRRI	T1,.FOSAU	;OPEN FOR UPDATE MODE
	MOVEM	T1,CPJBLK+.FOFNC
	MOVEI	T1,.IODMP	;DUMP MODE
	TXO	T1,UU.RRC	;LET TONY KEEP THE RIB UP TO DATE
	MOVEM	T1,CPJBLK+.FOIOS
	HRLZ	T1,ACTDEV
	MOVEM	T1,CPJBLK+.FODEV
	SETZM	CPJBLK+.FOBRH
	SETZM	CPJBLK+.FONBF
	MOVEI	T1,USEJOB	;THIS IS THE EXTENDED LOOKUP BLOCK
	MOVEM	T1,CPJBLK+.FOLEB
	MOVEI	T1,.RBSIZ
	MOVEM	T1,USEJOB+.RBCNT
	SETZM	USEJOB+.RBPPN	;NO PPN SPECIFIED
	SETZM	USEJOB+.RBPRV	;CLEAR DATE/TIME WORD
	SETZM	USEJOB+.RBSIZ	;CLEAR OLD SIZE VALUE
	MOVE	T1,[SIXBIT /USEJOB/]
	MOVEM	T1,USEJOB+.RBNAM
	MOVSI	T1,'BIN'
	MOVEM	T1,USEJOB+.RBEXT
	MOVE	T1,[7,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCOB Cannot OPEN (^O/T1/) ^W/USEJOB+.RBNAM/.^W3/USEJOB+.RBEXT/>
	SKIPE	T1,CPJCHN	;WAS THERE A CHANNEL BEFORE?
	POPJ	P,		;YES. NO NEED TO STORE ONE
	MOVE	T1,CPJBLK+.FOFNC
	ANDX	T1,FO.CHN	;ISOLATE THE CHANNEL NUMBER
	MOVEM	T1,CPJCHN	;CPJCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
	POPJ	P,

;CPJCLS - ROUTINE TO CLOSE THE PRIMARY JOB CHECKPOINT FILE, USEJOB.BIN.
;	CPJCHN - CHANNEL NUMBER (ALREADY IN BIT POSITION)
;	CPJBLK - FILOP. BLOCK

CPJCLS:	MOVE	T1,CPJCHN	;YES.
	TXO	T1,FO.PRV	;ALLOW FULL FILE ACCESS TO ACT:
	HRRI	T1,.FOCLS	;NOW CLOSE THE FILE
	MOVEM	T1,CPJBLK+.FOFNC
	MOVE	T1,[1,,CPJBLK]
	FILOP.	T1,
	$BOMB	<ACTCCP Cannot close (^O/T1/) primary job checkpoint file>
	POPJ	P,
;CPDSAU - ROUTINE TO OPEN A DEVICE CHECKPOINT FILE FOR A JOB, JJJDEV.BIN,
;	WHERE JJJ IS THE JOB NUMBER, IN SINGLE ACCESS UPDATE MODE.
;	JOBNUM - JOB NUMBER
;	CPDCHN - CHANNEL NUMBER
;	CPDBLK - FILOP. BLOCK
;	JJJDEV - LOOPUP/ENTER BLOCK
;CPDDEL - ROUTINE TO DELETE THE DEVICE CHECKPOINT FILE, SAME CALL AS CPDSAU

CPDDEL:	MOVEI	T1,.RBSIZ	;NUMBER OF WORDS IN THE RENAME (DELETE) BLOCK
	MOVEM	T1,JJJDEL+.RBCNT ;SET COUNT (ALSO FLAG FOR DELETE)
	SETZM	JJJDEL+.RBNAM	;CLEAR THE NAME FOR DELETE
	SETZM	JJJDEL+.RBEXT	;AND THE EXTENSION FOR GOOD MEASURE
	SKIPA			;AND ENTER OPEN ROUTINE TO DO THE FILOP.
CPDSAU:	SETZM	JJJDEL+.RBCNT	;OPENING - NOT DELETING
	SKIPN	T1,CPDCHN	;DOES A CHANNEL ALREADY EXIST?
	TXO	T1,FO.ASC	;NO. HAVE THE MONITOR GIVE US ONE.
	TXO	T1,FO.PRV	;GIVE US FULL FILE ACCESS TO ACT:
	HRRI	T1,.FOSAU	;OPEN FOR UPDATE MODE
	SKIPE	JJJDEL+.RBCNT	;IS THIS DELETE
	HRRI	T1,.FODLT	;YES, USE DIFFERENT FUNCTION
	MOVEM	T1,CPDBLK+.FOFNC
	MOVEI	T1,.IODMP	;DUMP MODE
	TXO	T1,UU.RRC	;LET TONY KEEP THE RIB UP TO DATE
	MOVEM	T1,CPDBLK+.FOIOS
	HRLZ	T1,ACTDEV
	MOVEM	T1,CPDBLK+.FODEV
	SETZM	CPDBLK+.FOBRH
	SETZM	CPDBLK+.FONBF
	MOVEI	T1,JJJDEV	;THIS IS THE EXTENDED LOOKUP BLOCK
	SKIPE	JJJDEL+.RBCNT	;IS THIS DELETE
	HRLI	T1,JJJDEL	;THIS IS THE EXTENDED RENAME BLOCK
	MOVEM	T1,CPDBLK+.FOLEB
	SETZM	CPDBLK+.FOPAT	;NO PATH SPECIFIED
	MOVEI	T1,.RBSIZ
	MOVEM	T1,JJJDEV+.RBCNT
	SETZM	JJJDEV+.RBPPN	;NO PPN SPECIFIED
	SETZM	JJJDEV+.RBPRV	;CLEAR DATE/TIME WORD
	SETZM	JJJDEV+.RBSIZ	;CLEAR OLD SIZE VALUE
	MOVE	T1,[SIXBIT /SYSDEV/]
	MOVEM	T1,JJJDEV+.RBNAM
	MOVSI	T1,'BIN'
	MOVEM	T1,JJJDEV+.RBEXT
	SKIPN	JOBNUM		;HERE FOR SYSTEM SPINDLES
	JRST	CPDSA1		;YES, DON'T INSERT JOB NUMBER IN FILE NAME
	MOVE	T1,[POINT 6,JJJDEV+.RBNAM] ;POINT TO THE NAME FIELD
	MOVEM	T1,USGCRY	;SAVE BYTE POINTER
	$TEXT	(USGCRX,<^D3R0/JOBNUM/^0>) ;HAVE GLXLIB FILL IN THE JOB NUMBER
CPDSA1:	MOVE	T1,[7,,CPDBLK]
	FILOP.	T1,
	$BOMB	<ACTOPD Cannot OPEN (^O/T1/) ^W/JJJDEV+.RBNAM/.^W3/JJJDEV+.RBEXT/>
	SKIPE	T1,CPDCHN	;WAS THERE A CHANNEL BEFORE?
	POPJ	P,		;YES. NO NEED TO STORE ONE
	MOVE	T1,CPDBLK+.FOFNC
	ANDX	T1,FO.CHN	;ISOLATE THE CHANNEL NUMBER
	MOVEM	T1,CPDCHN	;CPDCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
	POPJ	P,


;CPDCLS - ROUTINE TO CLOSE A DEVICE CHECKPOINT FILE, JJJDEV.BIN.
;	CPDCHN - CHANNEL NUMBER (ALREADY IN BIT POSITION)
;	CPDBLK - FILOP. BLOCK

CPDCLS:	MOVE	T1,CPDCHN	;YES.
	TXO	T1,FO.PRV	;ALLOW FULL FILE ACCESS TO ACT:
	HRRI	T1,.FOCLS	;NOW CLOSE THE FILE
	MOVEM	T1,CPDBLK+.FOFNC
	MOVE	T1,[1,,CPDBLK]
	FILOP.	T1,
	$BOMB	<ACTCPD Cannot close (^O/T1/) device checkpoint file for job ^D/JOBNUM/>
	POPJ	P,
;PRJRED - ROUTINE TO OPEN THE ACCOUNT VALIDATION FILE, PROJCT.SYS, IN
;	READ MODE.
;	PRJCHN - CHANNEL NUMBER
;	PRJBLK - FILOP. BLOCK
;	PROJCT - LOOKUP/ENTER BLOCK

PRJRED:	SKIPN	T1,PRJCHN	;DOES A CHANNEL ALREADY EXIST?
	TXO	T1,FO.ASC	;NO. HAVE THE MONITOR GIVE US ONE.
	TXO	T1,FO.PRV	;GIVE US FULL FILE ACCESS TO SYS:
	HRRI	T1,.FORED	;MAKE SURE SYS:PROJCT.SYS EXISTS
	MOVEM	T1,PRJBLK+.FOFNC
	MOVEI	T1,.IODMP	;DUMP MODE
	MOVEM	T1,PRJBLK+.FOIOS
	HRLZ	T1,PRJDEV	;PROJCT.SYS NOW ON SYS:
	MOVEM	T1,PRJBLK+.FODEV
	SETZM	PRJBLK+.FOBRH
	SETZM	PRJBLK+.FONBF
	MOVEI	T1,PROJCT	;THIS IS THE EXTENDED LOOKUP BLOCK
	MOVEM	T1,PRJBLK+.FOLEB
	MOVEI	T1,35		; AND IS 35 WORDS LONG
	MOVEM	T1,PROJCT+.RBCNT
	MOVE	T1,[SIXBIT /PROJCT/]
	MOVEM	T1,PROJCT+.RBNAM
	MOVSI	T1,'SYS'
	MOVEM	T1,PROJCT+.RBEXT
	MOVE	T1,[7,,PRJBLK]
	FILOP.	T1,
	$BOMB	<ACTCOJ Cannot OPEN (^O/T1/) ^W/PROJCT+.RBNAM/.^W3/PROJCT+.RBEXT/>
	SKIPE	T1,PRJCHN	;WAS THERE A CHANNEL BEFORE?
	$RETT			;YES. NO NEED TO STORE ONE
	MOVE	T1,PRJBLK+.FOFNC
	ANDX	T1,FO.CHN	;ISOLATE THE CHANNEL NUMBER
	MOVEM	T1,PRJCHN	;PRJCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
	$RETT
;USGSAU - ROUTINE TO OPEN USAGE.OUT IN SINGLE-ACCESS UPDATE MODE USING DUMP MODE I/O.
;	USGIFN - GALAXY HANDLE FOR USAGE.OUT

USGSAU:	PUSHJ	P,.SAVE3	;SAVE P1 - P3
	SETZM	P3		;CLEAR COUNTER
USGSA1:	HRLZ	S1,ACTDEV	;GET THE DEVICE TO OPEN (ACT: OR DSK:)
	MOVEM	S1,USGFD+.FDSTR	;STORE IN FILE OPEN BLOCK
	MOVEI	S1,FOB.SZ	;FOB SIZE
	MOVEI	S2,USGFOB	;FOB ADDRESS
	PUSH	P,[EXP -1]	;STORAGE FOR IFN ON STACK
	$CALL	F%IOPN		;FIRST OPEN THE FILE FOR INPUT
	JUMPF	USGSA2		;FAILED--ASSUME IT DOESN'T EXIST
	MOVEM	S1,(P)		;SAVE IFN
	MOVEI	S2,FI.BSZ	;WANT TO READ BYTE SIZE
	$CALL	F%INFO		;DO IT
	JUMPF	USGSA3		;ASSUME IT'S NOT KNOWN
	CAIE	S1,^D7		;SOMETHING
	CAIN	S1,^D8		; REASONABLE?
	SKIPA			;YES

USGSA2:	MOVEI	S1,FILBSZ	;ELSE USE DEFAULT
	MOVEM	S1,USGBSZ	;SAVE AWAY
	STORE	S1,FAIFOB+FOB.CW,FB.BSZ ;SAVE IN FAILURE FILE FOB
	LSH	S1,^D24		;POSITION
	TLO	S1,440000	;MAKE A PARTIAL BYTE POINTER
	MOVEM	S1,USGBPT	;SAVE

USGSA3:	POP	P,S1		;GET IFN BACK
	SKIPL	S1		;SKIP IF CHANNEL NEVER OPENED
	$CALL	F%RREL		;CLOSE AND RELASE CHANNEL
	MOVEI	S1,FOB.SZ	;SIZE OF THE FOB
	MOVEI	S2,USGFOB	;WHERE IT IS
	$CALL	F%AOPN		;OPEN FILE IN APPEND MODE
	JUMPF	USGSA4		;GET COMPLAIN AND WAIT FOR A WHILE
	MOVEM	S1,USGIFN	;SAVE THE IFN FROM GALAXY
	MOVEI	S2,FI.SIZ	;ASK FOR THE FILE SIZE
	$CALL	F%INFO		;...
	MOVEM	S1,USGOSZ	;SAVE ORIGINAL FILE SIZE
	PUSHJ	P,OPNFAI	;GO OPEN VALIDATION FAILURE LOG FILE
	POPJ	P,		;NOW RETURN

USGSA4:	MOVE	P1,P3		;GET COUNTER
	IDIVI	P1,<^D60/SLPSEC>*WTOINT ;SEE IF TIME FOR A WTO
	SKIPN	P2		;NOT YET
	$WTOXX	(<Couldn't open usage file, ^F/USGFD/^M^JError: ^E/S1/>)
	MOVEI	S1,SLPSEC	;GET TIME TO SLEEP
	SLEEP	S1,		;ZZZZ
	AOJA	P3,USGSA1	;TRY TO OPEN THE FILE AGAIN

;USGAPP - ROUTINE TO APPEND AN ENTRY TO USAGE.OUT.  ENTRY MUST BE IN USGBUF.

USGAPP:	HRRZ	S2,SAVPTR	;HIGHEST BYTE FILLED IN THE ENTRY
	SUBI	S2,USGBUF-1	;COMPUTE LENGTH (WORDS) OF ENTRY
	CAILE	S2,USGBND-USGBUF ;CHECK FOR OVERFLOW
	STOPCD	(EBO,HALT,,<Entry buffer overflow>)
	HRLS	S2		;WANT LENGTH IN LH
	HRRI	S2,USGBUF	;WHERE IT IS
	MOVE	S1,USGIFN	;GALAXY HANDLE
	$CALL	F%OBUF		;OUTPUT THE ENTRY
	SKIPT			;EVERYTHING OK?
ACTATU:	STOPCD	(CAU,HALT,,<Cannot append to usage file>)
	MOVE	S1,USGIFN	;THE HANDLE AGAIN
	$CALL	F%CHKP		;MARK SURE DATA GETS TO FILE
	JUMPF	ACTATU		;GIVE UP IF DIDN'T WORK
	POPJ	P,		;AND RETURN
;USGCRN - ROUTINE TO CLOSE AND RENAME USAGE.OUT

USGCRN:	$CALL	.SAVE1		;SAVE A WORKING AC
	MOVE	S1,USGIFN	;THE HANDLE FOR THE FILE
	$CALL	F%REL		;CLOSE/RELEASE IT
	SKIPT			;DID THAT WORK
	STOPCD	(CCU,HALT,,<Cannot close usage file>)
	HRLZ	S1,ACTDEV	;GET DEVICE OPENED
	MOVEM	S1,USGRFD+.FDSTR ;FILL IN RENAME BLOCK
	DEVPPN	S1,		;FIND PPN ASSOCIATED WITH DEV
	$BOMB	<ACTCFO Cannot find owner of ^W/USGRFD+.FDSTR/>
	MOVEM	S1,USGRFD+.FDPPN ;STORE IT CAUSE GALAXY WANTS IT THERE
	PUSHJ	P,DATIM		;GET CURRENT DATE/TIME
	MOVE	T1,S1		;WANT IT IN T1
	PUSHJ	P,CNGDAT	;CONVERT TO DATE AND TIME
	PUSH	P,T2		;SAVE DATE FOR A SEC
	IDIV	T1,[^D3600000]	;T1 = HOURS PAST MIDNIGHT
	POP	P,T2		;RESTORE DATE
	IDIVI	T2,^D31*^D12	;T2 = YEARS AFTER 1964
	ADDI	T2,^D64		;CONVERT TO 2 DIGIT YEAR (WON'T WORK AFTER 21999)
	IDIVI	T3,^D31		;T3 = MONTH (ALMOST) T4 = DAY (ALMOST)
	AOS	T3		;NOW EXACT
	AOS	T4		;...
	MOVSI	P1,-^D10	;10 TRIES FOR UNIQUE DIGIT
USGCR1:	MOVE	S1,[POINT 6,USGRFD+.FDNAM]
	MOVEM	S1,USGCRY	;STUFF AWAY THE BYTE POINTER
	$TEXT	(USGCRX,<^D2R0/T2/^D2R0/T3/^D2R0/T4/^D2R0/T1/^D1R0/P1,RHMASK/^0>)
	MOVEI	S1,FRB.MZ	;SIZE OF THE RENAME BLOCK
	MOVEI	S2,USGFRB	;ADDRESS OF IT
	$CALL	F%REN		;RENAME USAGE.OUT TO "yymmdd.hhu"
	JUMPT	USGCR2		;IF OK, GO RENAME VALIDATION FAILURE FILE
	CAIN	S1,ERFAE$	;FILE ALREADY EXISTS ERROR
	AOBJN	P1,USGCR1	;YES, DO WE GET ANOTHER CHANCE

USGCR2:	PUSH	P,TF		;SAVE TF
	PUSHJ	P,RENFAI	;RENAME VALIDATION FAILURE LOG FILE
	POP	P,TF		;GET TF BACK
	POPJ	P,		;RETURN PREVIOUS FLAG

USGCRX:	CAIG	S1,"9"		;ONLY DIGITS
	CAIGE	S1,"0"		; IN FILE NAME
	$RETT			;IGNORE IT
	SUBI	S1," "-' '	;CONVERT TO SIXBIT
	IDPB	S1,USGCRY	;STORE CHARACTER IN FILE NAME
	$RETT			;AND RETURN
USGCRY:	BLOCK	1		;PLACE TO HOLD THE POINTER
SUBTTL	ROUTINES TO OPEN, CLOSE AND RENAME VALIDATION FAILURE LOG FILE

;Note: The validation failure log file is opened and renamed at the same
;      time the usage file is opened and renamed. However, if the validation
;      log file can't be opened or renamed, it's not fatal. If the file can't
;      be opened, logging is not done. If the file can't be renamed, the
;      current file open will be appended to if possible.

;OPNFAI - Open validation failure log file, ACT:FAILUR.LOG, or DSK:FAILUR.LOG
;	if debugging. ACTDEV should already be set.

OPNFAI:	SKIPE	FAIIFN		;IFN ALREADY?
	 $RETT			;YES, JUST RETURN
	HRLZ	S1,ACTDEV	;GET THE DEVICE (ACT: OR DSK:)
	MOVEM	S1,FAIFD+.FDSTR	;STORE IT
	MOVEI	S1,FOB.SZ	;GET SIZE OF THE FOB
	MOVEI	S2,FAIFOB	;AND ITS ADDRESS
	$CALL	F%AOPN		;OPEN THE FILE IN APPEND MODE
	JUMPF	OPNF.1		;IF IT FAILED GO COMPLAIN
	MOVEM	S1,FAIIFN	;SAVE THE IFN
	$RETT			;RETURN SUCCESS

OPNF.1:	$WTOXX	(<Validation failure file open error, ^F/FAIFD/^M^JError: ^E/S1/>)
	SETZM	FAIIFN		;MAKE SURE WE DON'T THINK FILE IS OPEN
	$RETT

;RENFAI - Rename the validation failure log file to FAILUR.nnn where nnn
;	is 000 - 999. If FAILUR.000 exists, then FAILUR.001 is used, etc.

RENFAI:	SKIPN	S1,FAIIFN	;FILE OPEN?
	$RETT			;NO, NOTHING TO DO
	$CALL	F%REL		;CLOSE THE FILE
	JUMPF	RENF.1		;IF WE COULDN'T, GO COMPLAIN
	SETZM	FAIIFN		;CLEAR THE IFN WORD
	HRLZ	S1,ACTDEV	;GET THE DEVICE FILE IS OPENED ON
	MOVEM	S1,FAIRFD+.FDSTR ;STORE IT
	DEVPPN	S1,		;GET THE PPN ASSOCIATED
	 MOVE	S1,[1,,7]	;SHOULD NOT HAPPEN
	MOVEM	S1,FAIRFD+.FDPPN ;STORE IT
	PUSHJ	P,.SAVET	;GET SOME SCRATCH ACS
	SETZB	T1,FAIRFD+.FDEXT ;START WITH 000
RENF.0:	CAIL	T1,^D1000	;LESS THAN MAX?
	JRST	RENF.2		;NO, PHEW!
	MOVE	T4,[POINT 6,FAIRFD+.FDEXT] ;GET BP FOR EXTENSION
	PUSH	P,T1		;SAVE COUNT
	IDIVI	T1,^D100	;GET 1ST DIGIT IN T1
	ADDI	T1,'  0'	;MAKE SIXBIT
	IDIVI	T2,^D10		;GET 2ND AND 3RD IN T2 AND T3 RESPECTIVELY
	ADDI	T2,'  0'
	ADDI	T3,'  0'
	IDPB	T1,T4
	IDPB	T2,T4
	IDPB	T3,T4		;STORE THE EXTENSION
	POP	P,T1		;GET COUNT BACK
	MOVEI	S1,FRB.SZ	;GET SIZE OF RENAME BLOCK
	MOVEI	S2,FAIFRB	;GET ADDRESS OF RENAME BLOCK
	$CALL	F%REN		;TRY THE RENAME
	$RETIT			;RETURN IF SUCCESS
	CAIN	S1,ERFAE$	;FILE ALREADY THERE?
	AOJA	T1,RENF.0	;YES, TRY NEXT EXTENSION
	$WTOXX	(<Couldn't rename validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
	PJRST	OPNFAI		;GO OPEN OLD ONE IF WE CAN

RENF.1:	$WTOXX	(<Couldn't close validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
	$RETT			;JUST RETURN AFTER COMPLAINING

RENF.2:	$WTOXX	(<Too many validation failure files^M^JWill continue to write to ^F/FAIFD/>)
	PJRST	OPNFAI		;TRY TO OPEN FAILUR.LOG AGAIN
;LOGFAI - Routine to stuff characters in the buffer for the validation
;	failure log file. This routine is setup to be called by $TEXT macros,
;	i.e. S1 contains char to be logged.

LOGFAI:	SKIPE	FAIPAG		;IS THE LOG PAGE THERE?
	JRST	LOGF.1		;YES, GO DEPOSIT TEXT
	PUSH	P,S1		;NO, SAVE CHAR
	PUSHJ	P,FBFINI	;GET INTIAILIZE PAGE AND BP
	POP	P,S1		;GET CHAR BACK
LOGF.1:	SOSGE	FAICNT		;ROOM LEFT IN BUFFER?
	JRST	LOGF.2		;NO, GO DUMP IT AND CONTINUE
	IDPB	S1,FAIPTR	;YES, STORE CHAR AND EXIT
	POPJ	P,		;RETURN
LOGF.2:	PUSH	P,S1		;SAVE CHAR
	PUSHJ	P,FAIOUT	;DUMP BUFFER
	POP	P,S1		;GET CHAR BACK
	JRST	LOGF.1		;AND PUT IT IN BUFFER

;FBFINI - Routine to get a buffer page for validation failure file and
;	setup byte pointer and char count.

FBFINI:	SKIPE	S1,FAIPAG	;HAVE A PAGE?
	JRST	FBFI.1		;YES, JUST DO BP AND COUNT
	$CALL	M%GPAG		;GET A PAGE
	JUMPF	FBFI.2		;CAN'T GO COMPLAIN
	MOVEM	S1,FAIPAG	;SAVE ADDRESS
FBFI.1:	HLL	S1,USGBPT	;FORM A BYTE POINTER
	MOVEM	S1,FAIPTR	;SAVE IT
	MOVEI	S1,^D36		;BITS PER WORD
	LDB	S2,[POINT 6,USGBPT,11] ;GET CURRENT BYTE SIZE
	IDIVI	S1,(S2)		;GET BYTES PER WORD
	IMULI	S1,PAGSIZ	;AND BYTES PER BUFFER
	MOVEM	S1,FAICNT	;SAVE
	MOVEM	S1,FAIMAX	;SAVE AS MAXIMUM TOO
	POPJ	P,		;RETURN

FBFI.2:	$RETF			;FOR NOW

;FAIOUT - Routine to write whatever is in the buffer to the validation
;	failure log file and checkpoint the file.

FAIOUT:	SKIPE	S1,FAIIFN	;GET THE IFN
	SKIPN	S2,FAIPAG	;GET THE BUFFER ADDRESS
	$RETF			;BOTH HAVE TO BE THERE TO WORK
	MOVN	TF,FAICNT	;GET NEGATIVE FREE CHAR COUNT
	ADD	TF,FAIMAX	;COMPUTE HOW MANY IN BUFFER
	JUMPE	TF,.RETT	;NO BYTES IN BUFFER, JUST RETURN
	HRL	S2,TF		;GET COUNT,,ADDRESS IN S2
	$CALL	F%OBUF		;OUTPUT BUFFER
	JUMPF	FAIO.1		;GO COMPLAIN IF WE CAN'T
	PUSHJ	P,FBFINI	;GET REINIT COUNT AND BP
	MOVE	S1,FAIIFN	;GET IFN AGAIN
	$CALL	F%CHKP		;CHECKPOINT THE FILE
	$RETIT			;RETURN IF OK
	$WTOXX	(<Couldn't checkpoint validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
	$RETF

FAIO.1:	$WTOXX	(<Couldn't output to validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
	$RETF
SUBTTL	FILE PARAMETER BLOCKS FOR GALAXY INTERFACE

;Usage file paramter blocks
USGFOB:	$BUILD	(FOB.SZ)		;BUILD THE FILE OPEN BLOCK
	  $SET	(FOB.FD,,USGFD)		;POINT TO THE FD
	  $SET	(FOB.CW,FB.BSZ,^D36)	;USE FULL WORD MODE
	  $SET	(FOB.AB,,USGFAB)	;POINT TO THE FAB
	$EOB

USGFAB:	$BUILD	(7)			;FILE ATTRIBUTE BLOCK FOR PROT CODE
	  $SET	(0,,7)			;SIZE OF ENTIRE BLOCK
	  $SET	(1,FI.IMM,1)		;IMMEDIATE ARGUMENT
	  $SET	(1,FI.LEN,1)		;LENGTH OF ARGUMENT
	  $SET	(1,FI.ATR,.FIPRO)	;PROTECTION CODE
	  $SET	(2,,<EXP FILPRO>)	;PROTECTION CODE DEFINED IN ACTSYM
	  $SET	(3,FI.LEN,1)		;LENGTH IS ONE WORD
	  $SET	(3,FI.ATR,.FIBSZ)	;THE LOGICAL DATA BYTE SIZE
	  $SET	(4,,USGBSZ)		;DEFINED VALUE
	  $SET	(5,FI.IMM,1)		;IMMEDIATE ARGUMENT
	  $SET	(5,FI.LEN,1)		;LENGTH IS ONE WORD
	  $SET	(5,FI.ATR,.FIDTY)	;THE DATA TYPE
	  $SET	(6,,.RBDAS)		;ASCII
	$EOB

USGFD:	$BUILD	(FDMSIZ)		;BUILD THE FILE DESCRIPTOR BLOCK
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;FILL IN THE LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE MODE FILE SPEC
	  $SET	(.FDNAM,,<SIXBIT/USAGE/>) ;THE FILE NAME
	  $SET	(.FDEXT,,<SIXBIT/OUT/>)	;THE EXTENSION
	$EOB

USGRFD:	$BUILD	(FDMSIZ)		;BUILD A FILE DESCRIPTOR BLOCK FOR RENAME
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;FILL IN THE LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE MODE FILE SPEC
	$EOB

USGFRB:	$BUILD	(FRB.MZ)		;BUILD A FILE RENAME BLOCK
	  $SET	(FRB.SF,,USGFD)		;POINTER TO SOURCE FILE
	  $SET	(FRB.DF,,USGRFD)	;DESTINATION FILE
	$EOB

;Validation failure file parameter blocks
FAIFOB:	$BUILD	(FOB.SZ)		;BUILD THE FILE OPEN BLOCK
	  $SET	(FOB.FD,,FAIFD)		;POINT TO THE FD
	  $SET	(FOB.CW,FB.BSZ,0)	;FILLED IN AT RUNTIME
	  $SET	(FOB.AB,,USGFAB)	;FILE ATTRIBUTE BLOCK
	$EOB

FAIFD:	$BUILD	(FDMSIZ)		;BUILD THE FILE DESCRIPTOR BLOCK
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;FILL IN THE LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE MODE FILE SPEC
	  $SET	(.FDNAM,,<SIXBIT/FAILUR/>) ;THE FILE NAME
	  $SET	(.FDEXT,,<SIXBIT/LOG/>)	;THE EXTENSION
	$EOB

FAIRFD:	$BUILD	(FDMSIZ)		;BUILD A FILE DESCRIPTOR BLOCK FOR RENAME
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;FILL IN THE LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE MODE FILE SPEC
	  $SET	(.FDNAM,,<SIXBIT/FAILUR/>) ;THE FILE NAME
	$EOB

FAIFRB:	$BUILD	(FRB.SZ)		;BUILD A FILE RENAME BLOCK
	  $SET	(FRB.SF,,FAIFD)		;POINTER TO SOURCE FILE
	  $SET	(FRB.DF,,FAIRFD)	;DESTINATION FILE
	  $SET	(FRB.AB,,USGFAB)	;ATTRIBUTE BLOCK
	$EOB
SUBTTL	ERRACK - ROUTINE TO SEND ERROR ACKS TO USERS

	EXTERN	ERRPFX,	ERRTXT

ERRACK:	SKIPE	GFRFLG		;WAS THE MESSAGE FROM [SYSTEM]GOPHER?
	PJRST	ERRAC1		;YES. RETURN MESSAGE IS A DIFFERENT FORMAT
	MOVE	T1,SABADR	;GET THE PAGE ADDRESS
	MOVEI	T2,UGFAL$	;INDICATE THE VALIDATION MODULE HAS AN ERROR
	MOVEM	T2,UC$RES(T1)	;STORE IT IN THE IPCF SEND MESSAGE
	ADDI	T1,UC$ERR	;RELOCATE T1 TO POINT TO WHERE ERROR GOES
	MOVEM	T1,ACKETX	;SAVE ADDRESS
	PUSHJ	P,ERRAC4	;SETUP ACK STUFF
	$TEXT	(<-1,,@ACKETX>,<^I/@ACKITX/^0>)
	POPJ	P,		;RETURN

ERRAC1:	MOVE	T1,SABADR	;GET THE PAGE ADDRESS
	MOVEI	T2,1		;ONE BLOCK FOLLOWING
	STORE	T2,.OARGC(T1)	;STORE AS NUMBER OF BLOCKS
	SETZM	.OFLAG(T1)	;NO FLAGS HAVE BEEN DEFINED YET
	ADDI	T1,.OHDRS+1	;ERROR MESSAGE STARTS HERE
	MOVEM	T1,ACKETX	;SAVE ADDRESS
	PUSHJ	P,ERRAC4	;SET UP ACK STUFF
	$TEXT	(<-1,,@ACKETX>,<^I/@ACKITX/^0>)
	MOVEI	T1,2		;MIN IS HEADER WORD + A NULL FOR STRING
	SKIPE	ACKEFL		;NEW-STYLE ACK?
	SOSA	T2,ACKETX	;YES--ADJUST ADDRESS
	MOVE	T2,ACKETX	;GET TEXT ADDRESS BACK
	MOVE	T3,ERRICH##	;GET INITIAL CHARACTER
	CAIE	T3,"?"		;FATAL ERROR?
	TDZA	T3,T3		;NO
	MOVX	T3,MF.FAT	;LITE THE BIT

ERRAC2:	SKIPN	(T2)		;HAVE WE REACHED THE END OF THE ERROR MESSAGE?
	JRST	ERRAC3		;YES. STORE THE COUNTS IN THE PROPER PLACES
	AOS	T2		;LOOK AT THE NEXT WORD
	AOJA	T1,ERRAC2	;COUNT IT

ERRAC3:	MOVE	T2,SABADR	;GET THE BEGINNING ADDRESS AGAIN
	MOVEM	T3,.MSFLG(T2)	;STORE FLAGS IN THE MESSAGE
	LOAD	T3,.MSTYP(T2),MS.CNT ;GET THE MESSAGE COUNT
	ADD	T3,T1		;ADD IN THE ERROR MESSAGE LENGTH
	STORE	T3,.MSTYP(T2),MS.CNT ;JUST COUNT WHAT WAS ADDED IN THIS ROUTINE
	HRLM	T1,.OHDRS(T2)	;WORD COUNT OF THE ERROR BLOCK
	MOVEI	T1,.CMTXT	;TYPE OF RESPONSE BLOCK
	HRRM	T1,.OHDRS(T2)	;SAVE IN MESSAGE
	JRST	ERRAC5		;GO RESTORE ACS AND RETURN

; SET UP FOR NEW-STYLE ACKS IF NECESSARY
ERRAC4:	MOVE	T1,ERRPFX##	;GET SIXBIT PREFIX
	HRL	T1,ERRDAT##	;AND ERROR CODE
	MOVEM	T1,@ACKETX	;SAVE IN FIRST WORD
	SKIPE	ACKEFL		;WANT NEW-STYLE ACKS?
	AOSA	ACKETX		;YES--ADVANCE POINTER TO NEXT WORD
	SKIPA	T1,[[ITEXT (<^W/ERRPFX/ ^I/@ERRTXT/^0>)]]
	MOVEI	T1,[ITEXT (<^I/@ERRTXT/^0>)]
	MOVEM	T1,ACKITX	;SAVE

ERRAC5:	DMOVE	T1,ERRACS##+0	;RESTORE T1 AND T2
	DMOVE	T3,ERRACS##+2	;RESTORE T3 AND T4
	POPJ	P,		;RETURN
SUBTTL	ERRPRO - OLD USER ERROR ROUTINES


;ERROR CODES

ERCODE	ERROR0,ACNPP%		;(0) NONEXISTENT PPN
ERCODE	ERROR1,ACIVA%		;(1) OBSOLETE
ERCODE	ERROR2,ACILP%		;(2) ILLEGAL PPN
ERCODE	ERROR3,ACJNP%		;(3) JOB NOT PRIVILEGED
ERCODE	ERROR4,ACJCE%		;(4) JOB CAPACITY EXCEEDED

;ERRPRO - ROUTINE TO BE CALLED WHEN AN ERROR OCCURS.  THIS ROUTINE WILL
;	STORE THE ERROR MESSAGE IN AN IPCF MESSAGE. T1 CONTAINS THE ERROR NUMBER.

ERRPRO:	SKIPE	GFRFLG		;WAS THE MESSAGE FROM [SYSTEM]GOPHER?
	PJRST	ERRQUE		;YES. RETURN MESSAGE IS A DIFFERENT FORMAT
	MOVE	T2,SABADR	;GET THE PAGE ADDRESS
	MOVEI	T3,UGFAL$	;INDICATE THE VALIDATION MODULE HAS AN ERROR
	MOVEM	T3,UC$RES(T2)	;STORE IT IN THE IPCF SEND MESSAGE
	ADDI	T2,UC$ERR	;RELOCATE T2 TO POINT TO WHERE ERROR GOES
	PUSHJ	P,@ERRDSP(T1)	;PUT THE MESSAGE INTO THE IPCF PAGE
	MOVEI	T3,UGFAL$^!UGTRU$ ;VALUE TO CONVERT FAILURE TO SUCCESS
	SKIPF			;IF APPROPRIATE,
	XORM	T3,UC$RES-UC$ERR(T2) ;DO SO
	$RETF
;ERRQUE - ROUTINE THAT WILL SET UP AN ERROR MESSAGE IN QUEUE. UUO FORMAT
;
;CALL:	T1/DISPATCH IN ERRDSP

ERRQUE:	MOVE	T2,SABADR	;GET THE PAGE ADDRESS
	MOVEI	T3,1		;ONE BLOCK FOLLOWING
	STORE	T3,.OARGC(T2)	;STORE AS NUMBER OF BLOCKS
	SETZM	.OFLAG(T2)	;NO FLAGS HAVE BEEN DEFINED YET
	ADDI	T2,.OHDRS+1	;ERROR MESSAGE STARTS HERE
	PUSHJ	P,@ERRDSP(T1)	;PUT THE RIGHT MESSAGE IN
	$RETIF			;FATAL HAS ALREADY BEEN SET UP
	SETZ	T3,		;NO FLAGS
	ADDI	T1,1		;INCLUDE HEADER WORD IN LENGTH OF RESPONSE
ERRQU2:	MOVE	T2,SABADR	;GET THE BEGINNING ADDRESS AGAIN
	MOVEM	T3,.MSFLG(T2)	;STORE FLAGS IN THE MESSAGE
	LOAD	T3,.MSTYP(T2),MS.CNT	;GET THE MESSAGE COUNT
	ADD	T3,T1		;ADD IN THE ERROR MESSAGE LENGTH
	STORE	T3,.MSTYP(T2),MS.CNT	;JUST COUNT WHAT WAS ADDED IN THIS ROUTINE
	HRLM	T1,.OHDRS(T2)	;WORD COUNT OF THE ERROR BLOCK
	MOVEI	T1,.CMTXT	;TYPE OF RESPONSE BLOCK
	HRRM	T1,.OHDRS(T2)
	$RETF			;ALL DONE
;ERROR DISPATCH TABLE FOR PUTTING ERROR MESSAGES IN IPCF PAGE

	ERRMAP			;(-4) MOVE MAPPING DATA
	ERRMVB			;(-3) MOVE VALIDATION BLOCK
	ERRMUP			;(-2) MOVE USER PROFILE
	ERRMAS			;(-1) MOVE ACCOUNT STRING TO RESPONSE BLOCK
ERRDSP:	ERRFOO			;(0) OBSOLETE
	ERRFOO			;(1) OBSOLETE
	ERRILP			;(2) ILLEGAL PPN
	ERRJNP			;(3) JOB NOT PRIVILEGED
ERRFOO:	HALT	.

ERRMAP:	HRLZ	T3,ACOMAP	;POINT TO MAPPING BLOCKS
	HRRI	T3,(T2)		;WHERE IT GOES IN THE RESPONSE BLOCK
	MOVE	T1,TMPCNT	;GET BLOCK COUNT
	IMULI	T1,UU$LEN	;LENGTH OF RESPONSE DATA
	ADDI	T1,(T2)		;COMPUTE END OF BLT
	BLT	T3,-1(T1)	;COPY DATA
	SUBI	T1,(T2)		;GET LENGTH AGAIN
	$RETT			;RETURN

ERRMVB:	HRLZ	T1,DATADR	;POINT TO OUR VALIDATION BLOCK
	HRRI	T1,(T2)		;WHERE IT GOES IN THE RESPONSE BLOCK
	BLT	T1,UV$ACE(T2)	;COPY IT
	MOVEI	T1,UV$ACE+1	;GET LENGTH
	$RETT			;AND RETURN

ERRMUP:	PUSH	P,T3		;SAVE T3
	HRLI	T1,ACOPRO	;POINT TO THE PROFILE
	HRRI	T1,(T2)		;WHERE IT GOES IN RESPONSE BLOCK
	HRRZ	T3,ACOPRO+.AEVRS ;GET LENGTH OF THIS PROFILE
	ADDI	T3,(T2)		;COMPUTE END OF BLT
	BLT	T1,-1(T3)	;COPY
	HRRZ	T1,ACOPRO+.AEVRS ;GET LENGTH OF BLOCK WE'RE RETURING
	POP	P,T3		;RESTORE T3
	$RETT			;GOOD RETURN

ERRMAS:	MOVE	T1,DATADR	;WHERE VALIDATION REQUEST MESSAGE LIVES
	HRLI	T1,UV$ACT(T1)	;ORIGINAL (OR MODIFIED) ACCOUNT STRING
	HRRI	T1,(T2)		;WHERE TO PUT IT IN ASSEMBLED MESSAGE
	BLT	T1,7(T2)	;MOVE THE ACCOUNT STRING
	MOVEI	T1,10		;NUMBER OF WORDS FOR RESPONSE BLOCK
	$RETT			;THIS IS NOT REALLY AN ERROR ROUTINE

ERRILP:	FATAL	(ILP,<Illegal ppn ^U/PPN/>,ACILP%,.RETF)

ERRJNP:	PUSHJ	P,LOGUSR	;GET USER INDEPENDENT INFO
	MOVEI	S1,.CHCRT	;JUST APPEND A <CR><LF>
	PUSHJ	P,LOGFAI
	MOVEI	S1,.CHLFD
	PUSHJ	P,LOGFAI
	PUSHJ	P,FAIOUT	;JOB NUMBER ALREADY LOGGED, WRITE FAILURE FILE
	FATAL	(JNP,<Job not privileged>,ACJNP%,.RETF)
;LOGUSR - Routine to get a lot of info about current IPCF sender (user)
;	and log it in the validation failure log file.
;	MDB pointed to by MDBADR is assumed valid.
;	Call with T1=error code

LOGUSR:	PUSHJ	P,.SAVET	;SAVE T1 - T4
	MOVE	S1,[XWD USRZER,USRZER+1] ;ZERO OUR STORAGE
	SETZM	USRZER
	BLT	S1,USRZEN
	MOVEM	T1,USRERR	;SAVE ERROR CODE
	MOVE	S1,MDBADR	;GET MDB ADDRESS
	LOAD 	S1,MDB.PV(S1),MD.PJB ;GET JOB NUMBER OF SENDER
	JUMPE	S1,.RETF	;HMMMM
	MOVEM	S1,USRJOB	;SAVE IT
	HRLZS	S1,S1		;GET JOB NUMBER IN LH
	HRRI	S1,.GTPPN	;GET TABLE NUMBER
	GETTAB	S1,		;GET PPN OF THE GUY DOING IT
	 TRNA			;USE ZEROS
	MOVEM	S1,USRPPN	;STORE IT
	HRLZ	S1,USRJOB	;GET JOB NUMBER AGAIN
	HRRI	S1,.GTPRG	;GET TABLE NUMBER
	GETTAB	S1,		;GET PROGRAM NAME
	 TRNA			;USER BLANKS
	MOVEM	S1,USRPRG	;SAVE IT
	HRLZ	S1,USRJOB	;GET JOB NUMBER
	HRRI	S1,.GTNM1	;GET 1ST WORD OF USERNAME
	GETTAB	S1,
	 TRNA			;USE BLANKS
	MOVEM	S1,USRNAM	;SAVE IT
	HRLZ	S1,USRJOB	;GET JOB NUMBER AGAIN
	HRRI	S1,.GTNM2	;GET 2ND WORD OF USER NAME
	GETTAB	S1,
	 TRNA
	MOVEM	S1,USRNAM+1	;SAVE IT
	HRRZ	S1,USRJOB	;GET JOB NUMBER AGAIN
	TRMNO.	S1,		;GET THE UDX
	 TRNA
	MOVEM	S1,USRUDX	;STORE
	JUMPE	S1,LOGU.1	;IF ERROR, SKIP OTHER THINGS BASED ON UDX
	DEVNAM	S1,		;GET TTY NAME
	 SETZM	S1		;ZERO WILL BE SIXBIT BLANKS
	MOVEM	S1,USRTTY	;SAVE IT
	MOVE	S2,USRUDX	;GET UDX AGAIN
	MOVEI	S1,.TOAPC	;WANT ASYNCH PORT CHARACTERISTIC
	MOVE	TF,[XWD 2,S1]	;GET LENGTH,,ADDR
	TRMOP.	TF,		;GET THE APC CODE
	 TRNA			;ASSUME UNKNOWN
	MOVEM	TF,USRAPC
;Here to get node and line information on the offender
	MOVE	S1,[7,,.NOGDI]	;FUNCTION TO GET TTY INFO
	MOVEM	S1,USRARG	;FROM NETOP. UUO (7.03 AND LATER)
	XMOVEI	S1,USRNDN	;SET UP POINTER TO STRING BLOCK
	MOVEM	S1,USRNDA
	XMOVEI	S1,USRLIN	;POINT TO LINE NAME BLOCK
	MOVEM	S1,USRLNA
	MOVEI	S1,<<^D16/4>+1>	;SIZE OF THOSE STRING BLOCKS
	MOVEM	S1,USRLIN
	MOVEM	S1,USRNDN
	XMOVEI	S1,USRARG
	NETOP.	S1,		;ASK FOR TTY INFO
	  JRST	LOGU.0		;DO IT THE OLD-FASHIONED WAY
	MOVEI	S1,USRNDN	;CRAM INTO 7 BIT
	PUSHJ	P,C8TO7
	MOVEI	S1,USRLIN	;SAME FOR LINE NAME
	PUSHJ	P,C8TO7
	JRST	LOGU.1		;SKIP THE OLD-FASHIONED WAY
LOGU.0:	MOVE	S1,USRUDX	;GET UDX AGAIN
	GTNTN.	S1,		;GET NODE,,LINE NUMBER
	 SETZM	S1
	HLRZM	S1,USRNOD	;SAVE NODE NUMBER
	HRRZS	S1		;ISOLATE LINE NUMBER
	MOVE	S2,[ASCII /TTY/]	;CONSTRUCT LINE NAME
	MOVEM	S2,USRLIN
	MOVE	T1,[POINT 7,USRLIN,20]	;POINT TO START OF NUMBER PART
	PUSHJ	P,COTO7		;AND STUFF IT IN
	MOVE	S2,USRNOD	;GET NODE NUMBER IN RH OF S2
	MOVEI	S1,2		;GET LEGNTH FOR UUO
	MOVE	TF,[XWD .NDRNN,S1] ;GET ARG FOR NODE. UUO
	NODE.	TF,		;GET NODE NAME
	 TRNA			;USE BLANKS
	MOVEM	TF,S1		;STORE NODE NAME IN SIXBIT
	MOVE	T1,[POINT 7,USRNDN]	;POINT TO NODE NAME STORAGE
	PUSHJ	P,C6TO7		;AND STORE IT IN ASCII
;Here to log the data
LOGU.1:	PUSHJ	P,.SAVE1	;SAVE P1
	$TEXT	(LOGFAI,<^O2R0/USRERR/>^A) ;DUMP ERROR CODE
	MOVE	P1,FAIPTR	;TRICK ACTDAE'S USAGE OUTPUT ROUTINES
	EXCH	P1,USGPTR	;MAKE THEM WRITE IN OUR BUFFER
	$CALL	I%NOW		;GET CURRENT UDT
	MOVEI	T1,S1		;POINT T1 AT ARG
	PUSHJ	P,OUTDTM	;OUTPUT DATE/TIME AS "YYYYMMDDHHMMSS"
	EXCH	P1,USGPTR	;PUT USAGE POINTER BACK AND GET OURS
	MOVEM	P1,FAIPTR	;STORE IT FOR LOGFAI
	MOVE	S1,FAICNT	;UPDATE OUR BUFFER COUNT
	SUBI	S1,^D14
	MOVEM	S1,FAICNT
;Log the rest
	$TEXT	(LOGFAI,<^D3R0/USRJOB/^O6R0/USRPPN,LHMASK/^O6R0/USRPPN,RHMASK/^W6L/USRNAM/^W6L/USRNAM+1/^W6L/USRPRG/^W6L/USRTTY/^T20L/USRNDN/^T20L/USRLIN/^O2R0/USRAPC/^A>)
	$RETT
SUBTTL	Convert the user's node and line names to 7 bit ASCII

;C8TO7 - Convert 8 bit string in string block into 7 bit ASCIZ
;	in place
; Call:	MOVEI	S1,address of string block
;	PUSHJ	P,C8TO7

C8TO7:	$SAVE <<S1+2>,<S1+3>,<S1+4>,<S1+5>>	;SAVE ACS USED IN MOVSLJ
	MOVE	S2,S1		;GET ADDRESS OF BLOCK
	HRLI	S2,041000	;MAKE ILDB BYTE POINTER TO NEXT WORD
	MOVE	S1+4,S1		;AND MAKE DESTINATION POINTER TOO
	HRLI	S1+4,(POINT 7,)	;TO OVERWRITE THE BLOCK
	HLRZ	S1,(S1)		;GET NUMBER OF SOURCE BYTES
	MOVEI	S1+3,1(S1)	;ONE EXTRA DESTINATION BYTE FOR 0 FILL
	EXTEND	S1,[MOVSLJ 0
			   0]	;MOVE THE SLUDGE WITH A 0 TERMINATOR
	JFCL
	POPJ	P,

;C6TO7 - CONVERT SIXBIT NAME IN S1 TO ASCIZ STRING
;CALL:	MOVE	T1,[BYTE POINTER]
;	MOVE	S1,SIXBIT
;	PUSHJ	P,C6TO7

C6TO7:	SETZ	S2,
	ROTC	S1,6		;GET A CHARACTER IN S2
	ADDI	S2,40		;CONVERT TO ASCII
	IDPB	S2,T1		;STUFF IT
	JUMPN	S1,C6TO7	;AND CONTINUE IF NOT DONE
	IDPB	S1,T1		;TERMINATE WITH A 0 BYTE (S1 CONTAINS 0)
	POPJ	P,

;COTO7 - CONVERT OCTAL NUMBER IN S1 TO ASCII STRING
;CALL:	MOVE	T1,[BYTE POINTER]
;	MOVE	S1,NUMBER
;	PUSHJ	P,COTO7

COTO7:	IDIVI	S1,^D8
	PUSH	P,S2		;SAVE REMAINDER
	SKIPE	S1		;CONTINUE IF NOT DONE
	PUSHJ	P,COTO7		;RECURSE
	POP	P,S1		;GET A DIGIT
	ADDI	S1,"0"		;CONVERT TO OCTAL
	IDPB	S1,T1		;STUFF IT
	POPJ	P,


SUBTTL	Account string synonyms -- Initialize file


; Initialize ACT:SYN.ACT
; Call:	PUSHJ	P,SYNFIL

SYNFIL:	SKIPN	SYNFLG		;WANT SYNONYMS?
	POPJ	P,		;NOPE
	MOVEI	S1,FOB.MZ	;FOB SIZE
	MOVEI	S2,SYNFOB	;FOB ADDRESS
	$CALL	F%IOPN		;OPEN THE FILE
	JUMPT	SYNFI1		;JUMP IF NO ERRORS
	$WTOXX	(<^E/[-1]/; ^F/SYNFD/>) ;REPORT ERROR
	SETZM	SYNFLG		;CAN'T DO SYNONYMS
	POPJ	P,		;RETURN

SYNFI1:	MOVEM	S1,SYNIFN	;SAVE IFN
	MOVEI	S1,^D100	;START OFF WITH 100 ENTRIES
	$CALL	M%GMEM		;GET CORE
	MOVEM	S1,(S2)		;SAVE FOR S%TBLK
	MOVEM	S2,SYNTAB	;SAVE TABLE ADDRESS
	SETZM	SYNLIN		;INIT LINE NUMBER

SYNFI2:	PUSHJ	P,SYNRED	;READ A SYNONYM
	JUMPF	SYNFI6		;JUMP IF EOF

SYNFI3:	MOVE	S1,SYNTAB	;GET TABLE POINTER
	MOVE	S2,SYNARG	;AND ARGUMENT
	$CALL	S%TBAD		;ADD TO TABLE
	JUMPT	SYNFI2		;LOOP IF OK
	CAIE	S1,EREIT$	;ALREADY IN TABLE?
	JRST	SYNFI4		;NO
	HLRZ	S1,SYNARG	;GET DUPLICATE NAME ADDR
	$WTOXX	(<Duplicate synosym "^T/(S1)/" ignored>)
	JRST	SYNFI2		;ON TO THE NEXT ONE
SYNFI4:	CAIE	S1,ERTBF$	;TABLE FULL?
	JRST	SYNFI5		;NO
	MOVE	TF,SYNTAB	;GET ADDRESS OF TABLE
	HRRZ	TF,@TF		;GET LENGTH
	MOVE	S2,TF		;MAKE A COPY
	LSH	TF,-1		;DIVIDE BY TWO
	MOVE	S1,TF		;GET RESULT
	ADDI	S1,(S2)		;INCREASE TABLE LENGTH BY THIS MUCH
	$CALL	M%GMEM		;GET CORE
	PUSH	P,S1		;SAVE NEW LENGTH
	PUSH	P,S2		;SAVE NEW ADDRESS
	HRLZ	S1,SYNTAB	;POINT TO EXISTING TABLE
	HRR	S1,S2		;MAKE A BLT POINTER
	MOVE	S2,SYNTAB	;GET OLD POINTER AGAIN
	HRRZ	S2,(S2)		;AND LENGTH
	ADD	S2,(P)		;COMPUTE END OF BLT
	BLT	S1,-1(S2)	;COPY OLD TABLE INTO NEW TABLE
	MOVE	S1,-1(P)	;GET NEW TABLE LENGTH
	HRRM	S1,@(P)		;SET IN NEW TABLE
	MOVE	S2,SYNTAB	;POINT TO OLD TABLE
	HRRZ	S1,(S2)		;GET ITS LENGTH
	$CALL	M%RMEM		;RELEASE CORE
	POP	P,SYNTAB	;SET NEW TABLE ADDRESS
	POP	P,(P)		;PHASE STACK
	JRST	SYNFI3		;LOOP BACK AND ADD NEW ENTRY TO TABLE

SYNFI5:	$WTOXX	(<Unexpected error processing synonyms; ^E/[S1]/>)

SYNFI6:	MOVE	S1,SYNIFN	;GET IFN
	$CALL	F%REL		;RELEASE IT
	$RETT			;AND RETURN

; FOB for synonym file
SYNFOB:	$BUILD	FOB.MZ
	 $SET(FOB.FD,,SYNFD)
	 $SET(FOB.CW,FB.BSZ,^D7)
	 $SET(FOB.CW,FB.LSN,1)
	$EOB

; FD for synonym file
SYNFD:	$BUILD	FDMSIZ
	 $SET(.FDLEN,FD.LEN,FDMSIZ)
	 $SET(.FDSTR,,<SIXBIT/ACT/>)
	 $SET(.FDNAM,,<SIXBIT/SYN/>)
	 $SET(.FDEXT,,<SIXBIT/ACT/>)
	$EOB
SUBTTL	Account string synonyms -- Read a line from the file


; Read synonym-string=account-string
; Call:	PUSHJ	P,SYNRED
;
; TRUE return:	SYNARG = synonym-string,,account-string
; FALSE return:	EOF

SYNRED:	PUSHJ	P,SYNSTR	;READ FIRST STRING
	$RETIF			;RETURN IF EOF
	CAIE	S2,"="		;SYN STRING COMING?
	JRST	SYNRE1		;ERROR
	HRLZM	S1,SYNARG	;SAVE SYNONYN
	PUSHJ	P,SYNSTR	;READ SYNONYM
	JUMPF	SYNRE1		;ERROR IF EOF NOW
	CAIE	S2,.CHLFD	;<LF>?
	JRST	SYNRE1		;ERROR
	HRRM	S1,SYNARG	;SAVE ACCOUNT STRING ADDRESS
	AOS	SYNLIN		;COUNT THE LINE
	$RETT			;RETURN

SYNRE1:	$WTOXX	(<Bad format in synonym file following line ^D/SYNLIN/>)
	$RETF			;AND FAIL
SUBTTL	Account string synonyms -- Read a string


; Read an arbitrary ASCII string;CALL:
; Call:	PUSHJ	P,SYNSTR
;
; TRUE return:	S1 = address of string, S2 = break character
; FALSE return:	EOF

SYNSTR:	$SAVE	<P1,P2>		;SAVE SOME ACS
	MOVE	P1,[POINT 7,SYNTMP] ;P1 CONTAINS POINTER TO STORAGE
	MOVEI	P2,0		;P2 COUNTS CHARACTERS
	MOVE	S1,SYNIFN	;GET IFN

SYNST1:	$CALL	F%IBYTE		;GET A CHAR
	JUMPF	SYNST3		;JUMP IF ERRORS
	CAIE	S2,.CHNUL	;NULL
	CAIN	S2,.CHCRT	;OR <CR>
	JRST	SYNST1		;YES--BORING
	CAIE	S2,.CHTAB	;TAB 
	CAIN	S2," "		;OR SPACE?
	JRST	SYNST1		;YES--SKIP THEM TOO
	CAIE	S2,"="		;DELIMITER?
	CAIN	S2,.CHLFD	;<LF>?
	JRST	SYNST2		;YES--FOUND END
	CAIGE	P2,.AACLC	;IF NOT TOO LONG
	IDPB	S2,P1		;STORE CHARACTER
	CAIN	P2,.AACLC	;TOO LONG?
	$WTOXX	(<Truncating long string following line ^D/SYNLIN/>)
 	AOJA	P2,SYNST1	;LOOP

SYNST2:	PUSH	P,S2		;SAVE BREAK CHAR
	MOVEI	S2,0		;MAKE ASCIZ
	IDPB	S2,P1		;STORE
	ADDI	P2,5		;ROUND UP
	IDIVI	P2,5		;TO WORDS
	MOVEI	S1,(P2)		;GET WORDS REQUIRED
	$CALL	M%GMEM		;GO GET THEM
	MOVEI	S1,(S2)		;POINT TO STORAGE
	HRLZI	S2,SYNTMP	;POINT TO START OF STRING
	HRR	S2,S1		;POINT TO DESTINATION
	MOVEI	P1,(S1)		;GET DESTINATION
	ADDI	P1,(P2)		;PLUS SIZE
	BLT	S2,-1(P1)	;MOVE STRING
	POP	P,S2		;RESTORE BREAK CHAR
	$RETT			;AND RETURN

SYNST3:	CAIE	S1,EREOF$	;END OF FILE?
	$WTOXX	(<Unexpected error processing ^F/SYNFD/; ^E/[S1]/>)
	$RETF			;RETURN EOF
SUBTTL	Account string synonyms -- Translate synonym to account string


; This routine wil translate a possible synonynm to a real
; account string.
; Call:	MOVE	S1, address of possible synonym
;	PUSHJ	P,SYNCHK
;
; TRUE return:	Synonym converted to account string if necessary
; FALSE return:	Never

SYNCHK:	SKIPN	SYNFLG		;WANT SYNONYMS?
	$RETT			;NO
	$SAVE	<P1>		;SAVE P1
	MOVEI	P1,(S1)		;SAVE POINTER TO STRING
	MOVEI	S2,(S1)		;COPY POINTER
	MOVE	S1,SYNTAB	;POINT TO TABLE
	$CALL	S%TBLK		;LOOKUP IN TABLE
	TXNN	S2,TL%EXM!TL%ABR ;EXACT OR UNIQUE ABBREVIATION?
	$RETT			;NO--NOTHING TO TRANSLATE
	HRRZ	S1,(S1)		;GET NEW STRING POINTER
	HRLI	S1,(POINT 7,)	;FORM POINTER TO NEW STRING
	HRLI	P1,(POINT 7,)	;FORM POINTER TO USER STRING

SYNCH1:	ILDB	S2,S1		;GET A CHAR
	IDPB	S2,P1		;STORE
	JUMPN	S2,SYNCH1	;LOOP FOR ALL
	$RETT			;AND RETURN
SUBTTL	End


	END	ACTDAE