Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/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	26-Jan-86

	SEARCH	ACTPRM,QSRMAC,ORNMAC
	MODULE	(ACTDAE)

	.REQUIR	ACTRCD		;USAGE RECORDS

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1980,1981,1984,1985,1986.
;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==140	;EDIT NUMBER
	AC.WHO==0	;WHO EDITED LAST
	AC.MIN==0	;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	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,1986. 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
;
;	End of Revision History
;LOOSE ENDS

REPEAT 0,<
	1. THE CODED ERROR ACKS AREN'T FINISHED, DUE TO LACK OF ERROR CODE
	   DEFINITIONS IN ACTSYM.

	2. THE ERROR CODES (TO BE DEFINED BY 1. ABOVE) NEED TO BE PUT INTO
	   THE FAILURE LOG (RATHER THAN THE CURRENT JUNK).

>
	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
	$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

;PSI INTERRUPT BLOCKS

ACTPSI:
IPCPSI:	EXP	IPCTRP
	BLOCK	3

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
	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
	PUSHJ	P,ACTINI	;INITIALIZE THE WORLD

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
	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
	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,ACTCHD	;(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	PRVOPR,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:	$CALL	C%REL		;JRST RELEASE THE MESSAGE
	$RETF
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?
	TXNE	T3,JP.ADM	;ADMINISTRATIVE PRIVS?
	$RETT			;YES

; 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
	PUSHJ	P,CHKOPR	;TEST FOR OPR
	$RETIT			;OWNER IF FFA PRIVS
	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
	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	QUEFLG		;DID THIS COME FROM THE QUEUE UUO
	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 IT 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
	$STOP	(IOF,<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
	$STOP	(AFF,<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

;***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	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
	ANDX	T2,IP.CFC	;SYSTEM SENDER CODE
	LSH	T2,-3		;RIGHT JUSTIFY THE CODE
	CAIE	T2,.IPCCG	;IS IT FROM SYSTEM GOPHER?
	JRST	QUECH7		;NO. CHECK FUNCTION FOR FLAGS
	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:	$CALL	C%REL		;RELEASE OLD CRUFTY MESSAGE
	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	ACTVE1
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	;IF A NULL ACCOUNT, CHECK TO SEE IF VALIDATION IS REQUIRED
	JRST	ACTVE1		;VALIDATION NOT REQUIRED FOR THIS PPN
;	JUMPF	ACTVXT		;VALIDATION IS REQUIRED. NULL ACCOUNT ILLEGAL

ACTVE6:	PUSHJ	P,CHKPRJ	;VALIDATE THE ACCOUNT
;	JUMPF	ACTVXT		;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTVE1:	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"
		PUSHJ P,FIXQUE	;COMPLETE THE MESSAGE
		JRST ACTVE7]	;RELEASE MESSAGE AND SEND RESPONSE
	MOVE	S1,DATADR	;GET DATA ADDRESS
	MOVEI	T1,UGVUP$	;GET VALIDATE ACCOUNT AND RETURN PROFILE CODE
	MOVE	T2,SABADR	;GET MESSAGE PAGE ADDRESS
	CAME	T1,UV$TYP(S1)	;WAS IT?
	JRST	[MOVE	T1,UC$RES(T2)	;NO, GET RESPONSE
		 CAIE	T1,UGFAL$	;FAIL ALREADY?
		 JRST	ACTVE3		;NO
		 JRST	ACTVXT]		;YES
	MOVE	T1,PPN		;YES, GET PPN
	PUSHJ	P,GETPRO	;FETCH PROFILE
	JUMPF	ACTVE3		;IF IT FAILED, HE CAN'T HAVE IT
	MOVEI	T1,UC$PRO(T2)	;GET TARGET ADDRESS
	HRLI	T1,ACOPRO	;GET START OF PROFILE
	BLT	T1,UC$PRE(T2)	;COPY PROFILE
	MOVE	T1,UC$RES(T2)	;GET RESPONSE CODE
	CAIN	T1,UGFAL$	;VALIDATION FAIL?
	JRST	ACTVXT		;YES, GO RETURN
ACTVE3:	MOVEI	T1,UGTRU$	;VALIDATION WAS SUCCESSFUL
	MOVEM	T1,UC$RES(T2)	;STORE THE TRUE RESPONSE
	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:	$CALL	C%REL		;RELEASE THE IPCF RECEIVE PAGE/PACKET

;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	[$CALL C%REL	;WASN'T, RELEASE MESSAGE
		$RETT]		;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	ACTACA		;NO SUCH USER
	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:	TRNN	T1,1B18		;WILD PPN?
	JRST	ACTAC2		;NO
	HRRZ	S1,T1		;GET PROGRAMMER NUMBER
	CAIE	S1,777776	;VALID WILD PROGRAMMER NUMBER?
	CAIN	S1,777777	;..
	TRNA			;IT'S OK
	FATAL	(ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,,.RETF)
ACTAC2:	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:	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/>,,ACTVXX)
	SUBTTL	PROCESSOR FOR "OBTAIN USER PROFILE" QUEUE. FUNCTION

ACTOUP:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	[$CALL C%REL	;WASN'T, RELEASE MESSAGE
		$RETT]		;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	ACTOU1		;NO SUCH USER
	PUSHJ	P,CHKOWN	; OR 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/>,,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)/>,,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>,,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		;ADDITION 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
	CAMN	S1,[-1]		;IS THIS [%,%]?
	JRST	CUP.1		;YES, IT'S OK
	JUMPL	S1,CUP.EI	;INVALID PPN IF NOT POSITIVE
	TRNN	S1,1B18		;POSSIBLE WILD PPN?
	JRST	CUP.1		;NO, PARSE NEXT BLOCK
	HRRZS	S1		;YES, ISOLATE WILD HALF
	CAIE	S1,-1		;IF DEFAULT
	CAIN	S1,-2		;OR WILD
	JRST	CUP.1		;THEN IT'S OK
	JRST	CUP.EI		;INVALID PPN OTHERWISE

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>,,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>,,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>,,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
	SKIPL	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/>,,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>,,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:	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)/>,,ACTVXT)	;RESPOND TO USER AND RETURN
	FATAL	(NSU,<^T/(S1)/>,,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>,,ACTVXT)
CUP.EF:	FATAL	(IFM,<Illegally formatted message>,,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>,,ACTVXT)

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

CUP.EL:	SKIPE	ACOPRV		;PRIVED USER?
	PJRST	ILLPSW		;YES, GO ADMIT TO BAD PASSWORD
	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/>,,ACTVXT)

CUP.EW:	FATAL	(PLL,<Password length is less than ^D/S1/ characters>,,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"
	CAIE	S1,ER$RNF##	;RECORD NOT FOUND?
	FATAL	(RMS,<Unexpected RMS error ^O6R0/S1/>,,ACTVXT)
CUP.EI:	FATAL	(ILP,<Illegal PPN [^O/PPN,LHMASK/,^O/PPN,RHMASK/]>,,ACTVXT)


;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:	CAMN	T4,.AUSTR(T3)		;FOUND START OF SUBSTRING?
	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
	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
	POPJ	P,			;FAIL IF PROFILE LIST RUNS OUT FIRST
ACTPSW:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	JRST	[$CALL C%REL	;WASN'T, RELEASE MESSAGE
		$RETT]		;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	ACTACA		;NO SUCH USER
	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	C%REL		;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>,,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/>,,ACTVXT)

UNLOCK:	SKIPN	ACTLCK##	;FILE LOCKED?
	FATAL	(FNL,<File not locked>,,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/>,,ACTVXT)

ACTSCD:	SKIPN	QUEFLG		;ONLY DEFINED FROM QUEUE. UUO
	 PJRST	C%REL		;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>,,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	ACTMA4		;JUMP IF NO SUCH USER
	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

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
	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>,,.RETF)
	CAIE	T1,.QBAET	;START OF INTERESTING DATA?
	JRST	MAPLG1		;NOT YET
	MOVEI	P1,UU$MAP(T3)	;POINT TO START OF ACTUAL DATA

MAPLG2:	MOVEM	P1,ACOMAP	;SAVE ADDRESS
	SKIPN	T1,UU$CNT(T3)	;GET COUNT OF MAPPING BLOCKS
	FATAL	(MBZ,<Mapping block count is zero>,,.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/>,,.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/]>,,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
	TXNN	T1,AE.ACT	;IS AN ACCOUNT REQUIRED FOR THIS PPN?
	$RETT			;NO. PRETEND NULL ACCOUNT IS VALID
INVPPN:	SKIPA	S2,.AEPPN(T1)	;GET PPN FROM PROFILE
INVACC:	MOVE	S2,PPN		;GET PPN FROM LOW CORE
	PUSH	P,S2		;SAVE PPN
	PUSHJ	P,LOGUSR	;LOG THE ERROR
	$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/>,,.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/>,,.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,		;INTERNAL ENTRY POINT
	PUSH	P,TF		;SAVE FLAG
	TRNN	T1,1B18		;WILD PPN?
	JRST	GETP.1		;NO
	HRRZ	S1,T1		;GET PROGRAMMER NUMBER
	CAIE	S1,777776	;VALID WILD PROGRAMMER NUMBER?
	CAIN	S1,777777	;..
	TRNA			;IT'S OK
	JRST	GETP.2		;IT'S NOT
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:	POP	P,TF		;GET ENTRY POINT FLAG
	JUMPN	TF,.RETF	;JUMP IF INTERNAL
	FATAL	(ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,,.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
	$RETIF			;CHECK FOR ERRORS
	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
	$STOP	(WVR,<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
	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>,,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
	$CALL	C%REL		;RELEASE THE PAGE
	$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
	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/>
	$CALL	C%REL
	$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
	EXCH	P1,JOBNUM	;FETCH SENDERS JOB NUMBER, STORE TARGET
	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:	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
	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
	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/>
	$CALL	C%REL
	$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
	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	[$CALL	C%REL	;NO
		POPJ	P,]
	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>
	$CALL	C%REL
	$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
	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
	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
	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
	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
	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:	MDBADR contains the message descriptor block
;	MMSADR contains the message address

ACTCHD:	MOVE	T2,MMSADR	;ADDRESS OF THE MESSAGE
	MOVE	T1,UD$OFF(T2)	;GET DATE/TIME OFFSET IN UNIVERSAL DATE/TIME
	MOVEM	T1,DTMOFS	;STORE FOR LATER ADJUSTMENT
	PUSHJ	P,CHKAJB	;CHECKPOINT ALL STUFF, ADJUSTING FOR NEW TIME
	MOVE	T2,MMSADR	;POINT TO THE MESSAGE AGAIN
	MOVE	T1,UD$PRG(T2)	;GET DAEMONS NAME
	MOVEM	T1,DAENAM	;STORE
	MOVE	T1,UD$VER(T2)	;AND ITS VERSION NUMBER
	MOVEM	T1,DAEVER	;STORE
	MOVM	T1,UD$OFF(T2)	;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
	PUSHJ	P,IPCGEN	;SET UP JOBNUM OF DAEMON
	MOVE	T1,JOBNUM	;GET IT
	PUSHJ	P,SETTNL	;FIGURE OUT WHERE DAEMON IS
	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
	$CALL	C%REL		;DAEMON WOULDN'T KNOW WHAT TO DO WITH AN ACK
	$RETT			;SO DON'T BOTHER SENDING IT ONE
;THE DEFUS LIST FOR DATE/TIME ENTRY

DTMDFS:	USJNO.	(JOBNUM)	;JOB NUMBER MAKING THE ENTRY
	USTAD.	(CURDTM)	;THE DATE/TIME
	USTRM.	(MONTDE)	;DAEMONS TERMINAL DESIGNATOR
	USLNO.	(MONLNO)	;THE LINE NUMBER
	USNOD.	(MONNOD)	;THE NODE NAME
	USPNM.	(DAENAM)	;DAEMONS PROGRAM NAME
	USPVR.	(DAEVER)	;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

DAENAM:	BLOCK	1		;SPACE TO HOLD INFORMATION FROM DAEMON
DAEVER:	BLOCK	1		;...
DAEODT:	BLOCK	1		;...
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
	$CALL	C%REL		;RELEASE THE IPCF MESSAGE
	$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>
	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
	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	;IF 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	[$CALL C%REL	;WASN'T, RELEASE MESSAGE
		$RETT]		;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/>,,.+1)
	PUSHJ	P,FIXQUE	;FINISH UP THE QUEUE UUO RESPONSE
	$CALL	C%REL		;RELEASE THE OLD MESSAGE
	PJRST	RSPSAB		;SEND RESPONSE POINTED TO BY SABADR
;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
	$STOP	(EBO,<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:	$STOP	(CAU,<Cannot append to ^F/USGFD/; ^E/[-1]/>)
	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
	$STOP	(CCU,<Cannot close ^F/USGFD/; ^E/[-1]/>)
	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	QUEFLG		;WAS THE MESSAGE FROM A QUEUE. UUO?
	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,ERRICH##	;AND ASCII INITIAL CHARACTER
	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

	ACNPP%==0
	ACIVA%==1
	ACILP%==2
	ACJNP%==3
	ACJCE%==4

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	QUEFLG		;WAS THE MESSAGE FROM A QUEUE. UUO?
	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
	MOVX	T3,MF.FAT	;TELL QUEUE. IT'S FATAL
	JUMPT	[TXZ T3,MF.FAT	;NOT FATAL IF ERROR ROUTINE RETURNED TRUE
		AOJA T1,ERRQU2]	;INCLUDE HEADER WORD IN LENGTH OF RESPONSE
	MOVEI	T1,2		;MIN IS HEADER WORD + A NULL FOR STRING
ERRQU1:	SKIPN	(T2)		;HAVE WE REACHED THE END OF THE ERROR MESSAGE?
	JRST	ERRQU2		;YES. STORE THE COUNTS IN THE PROPER PLACES
	AOS	T2		;LOOK AT THE NEXT WORD
	AOJA	T1,ERRQU1	;COUNT IT
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:	$TEXT	(<-1,,(T2)>,<ACTILP Illegal ppn ^P/PPN/>)
	$RETF

ERRJNP:	$TEXT	(<-1,,(T2)>,<ACTJNP Job not privileged>)
	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
	$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)
	MOVEI	S1,USRNDN	;SET UP POINTER TO STRING BLOCK
	MOVEM	S1,USRNDA
	MOVEI	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
	MOVEI	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 ^/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