Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99l-bb - plrquo.x18
There is 1 other file named plrquo.x18 in the archive. Click here to see a list.
	TITLE	PLRQUO - DECsystem-10 Quota Manager
	SUBTTL	Author:  Spider Boardman/RCB 23-Apr-85

;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1986,1987.
;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.

	SEARCH	QUOPRM,ACTSYM		;QUOTA processor definitions
	QUODEF	(PLRCAT)		;Initialize


;This is the QUOTA application server for OPR/ORION.
SUBTTL	Assembly values

QUOVER==0				;Version # of QUOTA.SYS file

ND	QUETIM,^D60*3			;THREE MINUTE TIMEOUT VALUE

	QUEHDO==QF.RSP!.QUMAE		;COMMON QUEUE. HEADER FOR OLD MONITORS
	QUEHDR==QUEHDO!FLD(.QUTIM+1,QF.HLN) ;COMMON HEADER FOR NEW MONITORS

ND	RSPLEN,^D21			;RESPONSE BLOCK LENGTH FOR MODIFY MSG

ND	.QUCAT,16			;IN CASE NOT YET IN UUOSYM

ND	WILDSZ,UW$DAT+1			;SIZE OF WILDCARD BLOCK

ND	NAMLEN,.AANLC			;MAXIMUM CHARACTERS IN A NAME
	NAMWDS==NAMLEN/4+1		;WORDS TO HOLD ASCIZ8 NAME
SUBTTL	OPR message macros

DEFINE	$ERR(DISP,TEXT,MFLAGS,OFLAGS),<
	$MESG(<DISP>,<TEXT>,<MF.FAT!<MFLAGS>>,<OFLAGS>)
>

DEFINE	$WARN(DISP,TEXT,MFLAGS,OFLAGS),<
	$MESG(<DISP>,<TEXT>,<MF.WRN!<MFLAGS>>,<OFLAGS>)
>

DEFINE	$MESG(DISP,TEXT,MFLAGS,OFLAGS,%L),<
	PUSHJ	P,OPRACK
	LSTOF.
	JRST	%L
	EXP	[ITEXT (< DISP >)]
IFNB<TEXT>,<EXP	[ITEXT (<TEXT>)]>
IFB<TEXT>,<0>
	EXP	<0!<MFLAGS>>
	EXP	<WT.SJI!<OFLAGS>>
%L:!
	LSTON.
IF2,<PURGE %L>
>

	SYN	$MESG,$RESP
SUBTTL	Q$INIT - Set up the Quota Manager application

Q$INIT::SETZM	APLCOD			;NO APPLICATION CODE YET
	DMOVE	S1,[EXP PB.MNS,PIB]	;POINT TO PIB
	$CALL	C%CPID			;GET A PID
	JUMPT	INIT.2			;ONWARD IF GOT IT
	$WTO	(<QUOTA error>,<PID creation error:  ^E/S1/>,,$WTFLG(WT.SJI))
	$RETF				;RETURN

INIT.2:	MOVEI	S1,SP.OPR		;PIDTAB INDEX
	$CALL	C%RPRM			;READ ORION'S PID
	JUMPT	INIT.3			;ORION HAS STARTED
	MOVEI	S1,1			;NOT THERE YET, WAIT A LITTLE
	$CALL	I%SLP			;GIVE IT SOME TIME TO START UP
	JRST	INIT.2			;AND TRY FOR ORION AGAIN

INIT.3:	MOVEI	M,AHLMSG		;APPLICATION HELLO MESSAGE
	PUSHJ	P,SNDOPR		;FIRE IT OFF TO ORION
	MOVEI	S1,[ITEXT (<[SYSTEM]>)]	;ASSUME NOT DEBUGGING
	SKIPE	DEBUGW			;ARE WE?
	MOVEI	S1,[ITEXT (<^U/DEBUGW/>)] ;YES, USE ALTERNATE
	MOVEM	S1,WHOAMI		;FOR LISTING FILES
	MOVE	S1,G$SYSP##		;GET SYSTEM PPN
	MOVEM	S1,QSYFDB+.FDPPN	;SAVE IN QUOTA.SYS FD
	MOVX	S1,%LDSSP		;SYS:.SYS PROTECTION
	GETTAB	S1,			;GET IT
	  MOVX	<157>B8			;DEFAULT
	LSH	S1,^D<8-35>		;RIGHT-JUSTIFY IT
	MOVEM	S1,QSYPRT		;SET FOR ENTERS ON QUOTA.SYS
	MOVX	S1,%LDSPP		;SPOOLED FILE PROTECTION
	GETTAB	S1,			;GET IT
	  MOVX	S1,<077>B8		;DEFAULT
	LSH	S1,^D<8-35>		;RIGHT-JUSTIFY IT
	MOVEM	S1,LISPRT		;SET FOR ENTERS OF LISTING FILES
	$RET				;RETURN

PIB:	$BUILD	(PB.MNS)		;BUILD A SHORT PIB
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;LENGTH OF THIS BLOCK
	  $SET	(PB.SYS,IP.BQT,-1)	;INFINITE SEND & RECEIVE QUOTAS
	  $SET	(PB.SYS,IP.MNP,1)	;INCREMENT PID QUOTA
	$EOB

; APPLICATION HELLO MESSAGE
AHLMSG:	$BUILD	(.OHDRS)		;SIZE OF BLOCK
	  $SET	(.MSTYP,MS.TYP,.OMAHL)	;APPLICATION HELLO CODE
	  $SET	(.MSTYP,MS.CNT,AHLLEN)	;LENGTH
	  $SET	(.OARGC,,1)		;1 ARGUMENT BLOCK
	$EOB				;END OF HEADER

	$BUILD	(ARG.DA)		;SIZE OF BLOCK
	  $SET	(ARG.HD,AR.TYP,.AHNAM)	;BLOCK TYPE
	  $SET	(ARG.HD,AR.LEN,AHNLEN)	;LENGTH OF NAME
	$EOB
	ASCIZ	|QUOTA|			;APPLICATION NAME
AHLLEN==.-AHLMSG			;MESSAGE LENGTH
AHNLEN==AHLLEN-.OHDRS			;APPLICATION NAME LENGTH
SUBTTL	QUOTA application's impure data

APLCOD:	BLOCK	1			;OUR APPLICATION CODE (FROM ORION)
WHOAMI:	BLOCK	1			;ITEXT POINTER FOR LISTING HEADERS
WILDBK:	BLOCK	WILDSZ			;WILDCARD BLOCK
WILDAK:	BLOCK	NAMWDS			;ACK TEXT
CURPPN:	BLOCK	1			;PPN OF OPR THAT ISSUED THIS REQUEST

ZERBEG:!				;START OF ALWAYS ZEROED DATA
MSG:	BLOCK	PAGSIZ+1		;IPCF MESSAGE STORAGE
MSGLEN:	BLOCK	1			;REQUESTED MESSAGE LENGTH
MSGBLK:	BLOCK	1			;POINTER TO CURRENT BLOCK IN MESSAGE
MSGCNT:	BLOCK	1			;COUNT OF MESSAGE BLOCKS TO PROCESS
MSGTXB:	BLOCK	1			;START OF CURRENT BLOCK FOR TXTCHR
MSGTXP:	BLOCK	1			;STORAGE POINTER FOR TXTCHR
MSGTXC:	BLOCK	1			;CHARACTER SPACE REMAINING FOR TXTCHR
MSGTXF:	BLOCK	1			;LISTING FLAG FOR TXTCHR
LSTLPN:	BLOCK	1			;LISTING PAGE NUMBER
LSTLLN:	BLOCK	1			;LISTING PAGE LINE NUMBER
LSTIFN:	BLOCK	1			;IFN OF LISTING FILE
USRDFL:	BLOCK	1			;FLAG FOR WHETHER TO DEFAULT QUOTAS
SETDEF:	BLOCK	1			;FLAG MODIFY/DEFAULT IN EFFECT
USRWLD:	BLOCK	1			;WILDCARDING FLAG/MASK
USRBLK:	BLOCK	NAMWDS			;SPACE FOR A USERNAME
USRBAS:	BLOCK	NAMWDS			;SPACE FOR ANOTHER (FOR WILDCARDING)
STRCNT:	BLOCK	1			;NUMBER OF ENTRIES MATCHED
STRUCT:	BLOCK	1			;CURRENT STRUCTURE TO PROCESS
STRQUO:	BLOCK	1			;STRUCT CAN BE USED FOR QUOTA.SYS
STRAUX:	BLOCK	1			;STRUCT CAN BE USED FOR AUXACC
AUXLIN:	BLOCK	1			;LOGGED-IN QUOTA TO SET
AUXOUT:	BLOCK	1			;LOGGED-OUT QUOTA TO SET
AUXRES:	BLOCK	1			;RESERVED QUOTA TO SET
AUXBTS:	BLOCK	1			;NO-CREATE & NO-WRITE FLAGS
AUXMSK:	BLOCK	1			;MASK FOR MODIFIED VALUES IN ABOVE
AUXAUX:	BLOCK	1			;FLAG FOR AUXACC VS. QUOTA.SYS
AUXMNT:	BLOCK	1			;MODIFIED FLAG FOR ABOVE
FAICNT:	BLOCK	1			;COUNT OF FUNCTION FAILURES
DUPCNT:	BLOCK	1			;COUNT OF DUPLICATION ERRORS
QRDIFN:	BLOCK	1			;IFN FOR READING QUOTA.SYS
QWTIFN:	BLOCK	1			;IFN FOR WRITING QUOTA.SYS
USRPPN:	BLOCK	1			;REAL CURRENT USER PPN
USRDEF:	BLOCK	1			;.AEDEF FOR CURRENT USER
PPNMAX:	BLOCK	1			;MAXIMUM POSSIBLE MATCH PPN FOR WILDCARD
PRVPPN:	BLOCK	1			;VALUE FOR GQSYNT TO CHECK FOR REWINDING
COMPAT:	BLOCK	1			;GQSYNT FLAG TO CARE OR NOT ABOUT AUXACC
QNTPPN:	BLOCK	1			;PPN FROM QUOTA.SYS
QNTLIN:	BLOCK	1			;LOGGED-IN QUOTA FROM QUOTA.SYS
QNTOUT:	BLOCK	1			;LOGGED-OUT QUOTA FROM QUOTA.SYS
QNTRES:	BLOCK	1			;RESERVED QUOTA FROM QUOTA.SYS
CPYENT:	BLOCK	1			;FLAG FOR RDQENT TO COPY TO OUTPUT SIDE
TXTFST:	BLOCK	1			;MEMORY FOR TXTACK & SHOW ROUTINES
DEFPPN:	BLOCK	1			;DEFAULTING PPN ([PROJECT,%])
DEFLIN:	BLOCK	1			;FCFS FOR [%,%]
DEFOUT:	BLOCK	1			;OUT QUOTA FOR [%,%]
DEFRES:	BLOCK	1			;RESERVED QUOTA FOR [%,%]
ZEREND:!				;LAST+1 OF ZEROABLE STORAGE

USER:	BLOCK	.AEMAX			;USER PROFILE BLOCK
USRAUX:	BLOCK	.AUMAX-.AULEN		;MOST OF AUXACC ENTRIES (COPIED)
USRAUL:	BLOCK	.AULEN			;LAST AUXACC ENTRY COPIED
USRAUE:!				;END OF AUXACC DATA
RSPBLK:	BLOCK	RSPLEN			;RESPONSES FOR MODIFY MESSAGES
NOW:	BLOCK	1			;CURRENT UDT
SUBTTL	IPCF interface - send a message to ORION

SNDOPR:	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;POINT TO SCRATCH SAB
	$CALL	.ZCHNK			;CLEAR IT OUT
	MOVX	S2,SI.FLG!SP.OPR	;SENDING BY INDEX TO [SYSTEM]OPERATOR
	MOVEM	S2,G$SAB##+SAB.SI	;SET IT UP
	MOVEI	S1,PIB			;POINT TO OUR PIB
	MOVEM	S1,G$SAB##+SAB.PB	;SO ORION SEES THE APPLICATION PID
	LOAD	S1,.MSTYP(M),MS.CNT	;GET MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE
	MOVEM	M,G$SAB##+SAB.MS	;SAVE MESSAGE ADDRESS
	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;POINT TO SAB
	$CALL	C%SEND			;SEND THE MESSAGE OFF
	$RETIT				;PROPAGATE SUCCESS
	CAXE	S1,ERPWA$		;PID WENT AWAY?
	CAXN	S1,ERNSP$		;OR NO SUCH PID?
	JRST	SNDO.1			;YES, TRY TO RE-INITIALIZE
	$RETF				;NO, GIVE UP

SNDO.1:	CAIN	M,AHLMSG		;WAS THIS FOR A HELLO MESSAGE?
	JRST	SNDO.2			;YES, RECOVER DIFFERENTLY
	PUSH	P,M			;NO, SAVE THE MESSAGE POINTER
	PUSHJ	P,INIT.2		;RE-INIT WHEN ORION COMES BACK UP
	POP	P,M			;RESTORE MESSAGE POINTER
	JRST	SNDOPR			;TRY THIS MESSAGE AGAIN

SNDO.2:	ADJSP	P,-1			;POP OFF JUNK ADDRESS
	PJRST	INIT.2			;AND TRY FOR ORION AGAIN
SUBTTL	IPCF interface -- function table dispatcher

FNCDSP:	MOVE	T1,(S2)			;GET AN ENTRY
	CAIE	S1,(T1)			;DOES IT MATCH?
	AOBJN	S2,FNCDSP		;NO, LOOK SOME MORE
	HLRZ	S2,(S2)			;YES OR DONE, GET PROCESSOR ADDRESS
	PJRST	(S2)			;AND DISPATCH TO IT
SUBTTL	IPCF interface -- Input message pre-processor

; Set up for GETBLK calls
;
; Call:	M/ msg block
;
; return +1 always
;
; Trashes S1

SETINP:	MOVEI	S1,.OHDRS+ARG.HD(M)	;POINT TO FIRST BLOCK IN MESSAGE
	MOVEM	S1,MSGBLK		;SAVE AS CURRENT
	MOVE	S1,.OARGC(M)		;GET ARGUMENT BLOCK COUNT
	MOVEM	S1,MSGCNT		;SAVE IT
	$RETT				;RETURN
SUBTTL	IPCF interface -- Message block processing

; Get the next block of a message
;
; Call:	PUSHJ	P,GETBLK
;	<NON-SKIP>		;End of message
;	<SKIP>			;Next block found
;
; On error return, no ACs are changed
; On success return, T1= type, T2= length, T3= data address
;
; Affects no other ACs

GETBLK:	SOSGE	MSGCNT			;CHECK/DECREMENT BLOCK COUNT
	POPJ	P,			;ERROR RETURN IF NO MORE
	MOVE	T3,MSGBLK		;POINT TO THIS BLOCK'S ADDRESS
	LOAD	T1,ARG.HD(T3),AR.TYP	;GET BLOCK TYPE
	LOAD	T2,ARG.HD(T3),AR.LEN	;AND BLOCK LENGTH
	MOVEI	T3,ARG.DA(T3)		;POINT TO ACTUAL DATA ADDRESS
	ADDM	T2,MSGBLK		;UPDATE BLOCK ADDRESS FOR NEXT CALL
	JRST	.POPJ1			;RETURN SUCCESSFUL
SUBTTL	IPCF interface -- ORION message #200020 (APL ACK)

Q$AACK::
	PUSHJ	P,SETINP		;SETUP TO READ INPUT MESSAGE
	PUSHJ	P,GETBLK		;GET ARGUMENT BLOCK
	  JRST	BADAPA			;BAD APPLICATION MESSAGE
	CAIN	T1,.AHTYP		;APPLICATION CODE?
	CAIE	T2,2			;TWO WORDS?
	JRST	BADAPA			;BAD APPLICATION MESSAGE
	MOVE	S1,(T3)			;GET CODE
	EXCH	S1,APLCOD		;SAVE FOR LATER
	SKIPE	S1			;DID WE ALREADY HAVE A CODE?
	SKIPA	T1,[[ITEXT (<QUOTA re-initializing>)]] ;YES, FLAG RESTART
	MOVEI	T1,[ITEXT (<QUOTA starting>)]	;NO, THIS IS THE FIRST TIME
	PUSHJ	P,PIDHAK		;SEND VIA THE QUOTA PID
	$LOG	(<^I/(T1)/>,<^I/AACKT1/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

BADAPA:	SKIPA	S1,[AACKT2]		;BAD ACK
BADAPL:	MOVEI	S1,AACKT3		;BAD MESSAGE
	PUSHJ	P,PIDHAK		;SEND VIA THE QUOTA PID
	$WTO	(<QUOTA error>,<^I/(S1)/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

AACKT1:	ITEXT	(<Application code = ^O/APLCOD/>)
AACKT2:	ITEXT	(<Bad application hello ack from ORION>)
AACKT3:	ITEXT	(<Bad application message from ORION>)
SUBTTL	IPCF interface -- ORION message #200050 (OPR CMD)

Q$OCMD::
	$CALL	I%NOW			;GET UDT
	MOVEM	S1,NOW			;SAVE
	MOVE	S1,G$COD##		;GET ACK CODE (OPR'S PID)
	$CALL	C%PIDJ			;FIND OUT WHAT JOB SENT THIS
	JUMPF	PRVERR			;ABORT NOW IF PID WENT AWAY
	MOVX	S2,JI.USR		;GET LOGGED-IN DIRECTORY
	$CALL	I%JINF			; ...
	JUMPF	PRVERR			;JOB WENT AWAY?
	MOVEM	S2,CURPPN		;SAVE IN CASE WE WANT TO KNOW
;	CAMN	S2,G$FFAP##		;FFA PPN?
;	JRST	OCMD.1			;YES, THIS OPR WINS
	MOVSI	S2,(S1)			;COPY JOB NUMBER
	HRRI	S2,.GTPRV		;PRIVILEGE WORD GETTAB
	GETTAB	S2,			;ASK THE MONITOR
	  SETZ	S2,			;NOT THERE?
	TXNN	S2,JP.ADM		;SYSTEM ADMINISTRATOR?
	JRST	PRVERR			;NO, DUMP THE MESSAGE
OCMD.1:					;HERE FOR PROPERLY PRIV'ED OPR
	MOVE	S1,[ZERBEG,,ZERBEG+1]	;GET XFER WORD
	SETZM	ZERBEG			;CLEAR FIRST WORD
	BLT	S1,ZEREND-1		;CLEAR OUT PER-COMMAND STORAGE
	SETOM	COMPAT			;WE PROBABLY CARE ABOUT AUXACC
	PUSHJ	P,SETINP		;SETUP TO SCAN THE MESSAGE
	MOVE	S1,MSGBLK		;GET CURRENT BLOCK ADDRESS
	MOVE	T1,MSGCNT		;GET COUNT OF BLOCKS
	MOVE	T2,0(S1)		;GET APPLICATION CODE
	MOVE	T3,1(S1)		;GET NODE (IN CASE OF ERROR)
	SKIPLE	T1			;CHECK BLOCK COUNT
	CAME	T2,APLCOD		;AND MATCHING APPLICATION CODE
	JRST	BADAPL			;APPLICATION MESSAGE SCREWUP
	ADDI	S1,(T1)			;OFFSET TO ARG BLOCK COUNT
	MOVE	S2,(S1)			;GET COUNT
	MOVEM	S2,MSGCNT		;SAVE IT
	ADDI	S1,1			;OFFSET TO FIRST APPLICATION ARG
	MOVEM	S1,MSGBLK		;UPDATE
	PUSHJ	P,GETBLK		;GET INITIAL BLOCK
	  JRST	OPRERR			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;MUST START WITH A KEYWORD
	JRST	OPRERR			;OPR CMD ERROR
	MOVE	S2,CMDPTR		;GET COMMAND KEY POINTER
	MOVE	S1,(T3)			;AND KEYWORD VALUE
	PUSHJ	P,FNCDSP		;DISPATCH BASED ON IT
	SKIPE	S1,LSTIFN		;IF LISTING FILE STILL OPEN,
	$CALL	F%REL			;CLOSE IT OFF
	SKIPE	S1,QWTIFN		;IF STILL WRITING A QUOTA FILE,
	$CALL	F%RREL			;GIVE UP ON IT
	SKIPE	S1,QRDIFN		;IF STILL READING A QUOTA FILE,
	$CALL	F%REL			;GIVE IT UP
	SETZM	LSTIFN			;MAKE SURE THAT
	SETZM	QRDIFN			;THESE WORDS
	SETZM	QWTIFN			;ARE CLEAR
	$RETT				;TELL MAIN TO RETURN THE MESSAGE BLOCK

	;CONTINUED NEXT PAGE
	;CONTINUED FROM PREVIOUS PAGE

; DISPATCH TABLE FOR Q$OCMD

CMDTAB:	XWD	LISTER,	.QTLIS		;LIST
	XWD	MODIFY,	.QTMOD		;MODIFY
	XWD	ADD,	.QTADD		;ADD
	XWD	DELETE,	.QTDEL		;DELETE
	XWD	SHOW,	.QTSHO		;SHOW
CMDNUM==.-CMDTAB
	XWD	OPRERR,	.QTHLP		;HELP (SHOULD NEVER GET HERE)
CMDPTR:	-CMDNUM,,CMDTAB			;TABLE INDEXING POINTER

; GENERIC ERROR MESSAGES

PRVERR:	$ERR	(<QUOTA command error>,<Must be a System Administrator to use QUOTA>)
	$RETT				;RELEASE THE MESSAGE

OPRERR:	$ERR	(<QUOTA command error>,<OPR application table skew>)
	$RETT				;RELEASE THE MESSAGE
SUBTTL	QUOTA switch tables

MODTAB:	XWD	NCREA,	.QTNCR		;/NOCREATE
	XWD	NWRIT,	.QTNWR		;/NOWRITE
	XWD	YCREA,	.QTCRE		;/CREATE
	XWD	YWRIT,	.QTWRT		;/WRITE
	XWD	NMOUN,	.QTNMT		;/NOMOUNT
	XWD	YMOUN,	.QTMNT		;/MOUNT
MODTBL==.-MODTAB
	XWD	OPRERR,	0		;SHOULD NEVER GET THIS FAR
MODPTR:	-MODTBL,,MODTAB			;DISPATCH POINTER


NCREA:	SKIPA	S1,[AU.NCR]		;NO-CREATE BIT
NWRIT:	MOVX	S1,AU.RON		;READ-ONLY BIT
	IORM	S1,AUXBTS		;STORE IN BITS WORD
	IORM	S1,AUXMSK		;AND IN MODIFY MASK
	JRST	.POPJ1			;RETURN SUCCESS

YCREA:	SKIPA	S1,[AU.NCR]		;NO-CREATE BIT
YWRIT:	MOVX	S1,AU.RON		;READ-ONLY BIT
	ANDCAM	S1,AUXBTS		;CLEAR IN BITS WORD
	IORM	S1,AUXMSK		;UPDATE MODIFY MASK
	JRST	.POPJ1			;RETURN SUCCESS

NMOUN:	TDZA	S1,S1			;ZERO FOR QUOTA.SYS
YMOUN:	SETO	S1,			;TRUE FOR AUXACC
	MOVEM	S1,AUXAUX		;SET FOR THOSE WHO CARE
	SETOM	AUXMNT			;IT'S BEEN MODIFIED
	JRST	.POPJ1			;RETURN SUCCESS
SUBTTL	QUOTA block parser

GETQBK:	PUSHJ	P,GETBLK		;GET THE QUOTA BLOCK
	  PJRST	OPRERR			;REQUIRED
GQBK.0:	MOVE	S1,(T3)			;GET THE VALUE
	CAIN	T1,.CMNUM		;IF A NUMERIC VALUE,
	JRST	GQBK.1			;RANGE-TEST IT
	CAIE	T1,.CMKEY		;ELSE, MUST BE A KEYWORD
	PJRST	OPRERR			;ERROR IF NOT
	CAIE	S1,.QTINF		;INFINITE?
	JRST	GQBK.2			;NO, CHECK FOR 'SAME'
	MOVX	S1,.INFIN		;YES, RETURN A LARGE NUMBER
	JRST	.POPJ1			;SUCCEED

GQBK.1:	JUMPGE	S1,.POPJ1		;SUCCEED IF NON-NEGATIVE QUOTA
	$ERR	(<QUOTA specification error>,<Quotas may not be negative>)
	POPJ	P,			;RETURN FAILURE

GQBK.2:	CAIE	S1,.QTSAM		;IF NOT OUR OTHER KEYWORD,
	PJRST	OPRERR			;TABLES ARE ASKEW
	SETO	S1,			;YES, USE -1 FOR SAME
	JRST	.POPJ1			;RETURN SUCCESS
SUBTTL	QUOTA processor -- ADD command

ADD:
	PUSHJ	P,NAMSTR		;PARSE THE USER & STRUCTURE BLOCKS
	  POPJ	P,			;ERROR ALREADY GENERATED
	PUSHJ	P,GETQBK		;READ A QUOTA VALUE
	  POPJ	P,			;ALREADY BARFED
	MOVEM	S1,AUXLIN		;STORE AS FCFS QUOTA
	PUSHJ	P,GETQBK		;GET OTHER QUOTA VALUE
	  POPJ	P,			;ALREADY BARFED
	MOVEM	S1,AUXOUT		;STORE AS OUT QUOTA
	PUSHJ	P,GETBLK		;GET A BLOCK FROM THE MESSAGE
	  PJRST	OPRERR			;FILE SKEW
	CAIE	T1,.CMSWI		;IS IT A SWITCH?
	JRST	ADD.R			;NO, SKIP /RESERVED
	MOVE	S1,(T3)			;YES, GET TYPE
	CAIE	S1,.QTRES		;IS IT /RESERVED?
	JRST	ADD.R			;NO, DON'T PROCESS AS /RESERVED
	PUSHJ	P,GETQBK		;YES, GET THE QUOTA BLOCK (VALUE)
	  POPJ	P,			;PROPAGATE FAILURE
	MOVEM	S1,AUXRES		;SETUP AS RESERVED QUOTA
	PUSHJ	P,GETBLK		;GET A BLOCK FROM THE MESSAGE
	  PJRST	OPRERR			;FILE SKEW
ADD.R:
	CAIN	T1,.CMCFM		;END OF COMMAND?
	JRST	ADD.2			;YES, GO DO IT
	MOVE	S1,(T3)			;GET VALUE
	CAIN	T1,.CMSWI		;MUST BE A SWITCH,
	CAIE	S1,.QTMNT		;AND /MOUNT IN PARTICULAR
	PJRST	OPRERR			;FILE SKEW
	SETOM	AUXAUX			;YES, WE'RE DOING AUXACC
ADD.1:
	PUSHJ	P,GETBLK		;GET NEXT PARSE FIELD
	  PJRST	OPRERR			;FILE SKEW
	CAIN	T1,.CMCFM		;END OF COMMAND?
	JRST	ADD.2			;YES, GO DO IT
	CAIE	T1,.CMSWI		;NO, IS IT A SWITCH?
	PJRST	OPRERR			;FILE SKEW IF NOT
	MOVE	S1,(T3)			;GET SWITCH TYPE
	MOVE	S2,MODPTR		;AND MODE TABLE POINTER
	PUSHJ	P,FNCDSP		;SET UP THE MODE BITS
	  POPJ	P,			;ALREADY WENT THROUGH OPRERR
	JRST	ADD.1			;LOOP OVER SWITCHES
ADD.2:
	PUSHJ	P,STRVAL		;MAKE SURE AUXAUX & STR??? AGREE
	  POPJ	P,			;NO, AND ERROR ALREADY ISSUED
	PUSHJ	P,USRNXT		;TRY TO FIND THE FIRST USER
	  JRST	ADD.6			;CAN'T, CHECK IF OK ANYWAY
ADD.7:	SKIPE	AUXAUX			;DOING THIS FOR QUOTA.SYS?
	JRST	ADD.3			;NO, DON'T OPEN A QUOTA FILE
	PUSHJ	P,QMDINI		;YES, SET UP TO MODIFY QUOTAS
	  TRNA				;EXAMINE THE ERROR IF CAN'T
	JRST	ADD.3			;WE'RE GOLDEN
	SKIPE	QRDIFN			;ARE WE CREATING A QUOTA.SYS?
	  POPJ	P,			;NO, ERROR ALREADY GIVEN
	PUSHJ	P,QWTINI		;YES, TRY TO DO SO
	  POPJ	P,			;ERROR ALREADY GIVEN
	$FALL	ADD.3		;ADD COMMAND CONTINUED NEXT PAGE
				;ADD COMMAND CONTINUED

ADD.3:
	SKIPE	AUXAUX			;ADDING TO AUXACC?
	JRST	ADD.4			;YES, DON'T ADD TO QUOTA.SYS
	PUSHJ	P,GQSYNT		;NO, FIND THE QUOTA.SYS ENTRY
	  TRNA				;PREFER TO HAVE NONE
	JRST	ADD.D			;COMPLAIN OF DUPLICATES
	MOVE	P1,USRPPN		;GET PPN TO WRITE
	MOVE	S2,AUXLIN		;AND ITS FCFS QUOTA
	MOVE	T1,AUXOUT		;AND ITS OUT QUOTA
	MOVE	T2,AUXRES		;AND ITS RESERVED QUOTA
	PUSHJ	P,WTQENT		;WRITE A QUOTA.SYS ENTRY
	  JRST	ADD.E			;FATAL ERROR IF CAN'T
	AOS	STRCNT			;SUCCEEDED ONCE
	JRST	ADD.5			;TRY FOR NEXT
ADD.4:
	PUSHJ	P,STRFND		;FIND SLOT FOR INSERT
	  TRNA				;PREFER NO MATCH
	JRST	ADD.D			;COMPLAIN IF DUPLICATED
	PUSHJ	P,STRADD		;INSERT NEW STRUCTURE
	  JRST	ADD.F			;COMPLAIN IF S/L IS FULL
	PUSHJ	P,USRMOD		;SEND MODIFY MESSAGE TO ACTDAE
	  AOSA	FAICNT			;COUNT FAILURE
	AOS	STRCNT			;OR SUCCESS
ADD.5:
	PUSHJ	P,USRNXT		;GET THE NEXT ENTRY TO ADD
	  JRST	ADD.X			;OK IF NONE
	JRST	ADD.3			;TRY AGAIN

				;ADD COMMAND CONTINUED ON NEXT PAGE
				;ADD COMMAND CONTINUED

ADD.6:
	SKIPN	USRWLD			;IF WILD,
	SKIPE	WILDBK+UW$WST		;OR BY USERNAME,
	JRST	ADD.8			;THEN COMPLAIN (USRNXT FAILED)
	SKIPE	AUXAUX			;NO, IF ADDING TO AUXACC,
	JRST	ADD.8			;STILL MUST FAIL
	MOVE	S1,USRBLK		;OK, GET THE (SINGLE) DESIRED PPN
	MOVEM	S1,USRPPN		;SAVE FOR LATER INSERTION
	JRST	ADD.7			;THEN LET IT SUCCEED

ADD.8:
	$ERR	(<ADD command error>,<No such users>)
	JRST	ADD.N			;AND NONE ADDED

ADD.X:
	SKIPN	AUXAUX			;IF ADDING TO QUOTA.SYS,
	SKIPN	STRCNT			;AND WE CHANGED SOMETHING,
	JRST	ADD.Y			;NO, DON'T CLOSE THE FILES
	PUSHJ	P,CPYFIN		;YES, CLOSE THEM
	  POPJ	P,			;ERROR ALREADY GIVEN
ADD.Y:
	SKIPN	S1,STRCNT		;ANYTHING CHANGED?
	JRST	ADD.N			;NO, SAY THAT
	CAIN	S1,1			;YES, ONLY ONE?
	SKIPA	T1,[[ASCIZ |y|]]	;YES, GET SUFFIX
	MOVEI	T1,[ASCIZ |ies|]	;NO, USE ALTERNATE
	$RESP	(<ADD command>,<^T/TABTXT/^D/STRCNT/ entr^T/(T1)/ added>)
	POPJ	P,			;RETURN

ADD.N:
	$WARN	(<ADD command>,<^T/TABTXT/No entries added>)
	POPJ	P,			;RETURN

ADD.E:
	$ERR	(<ADD command aborted due to file error>)
	POPJ	P,			;RETURN

ADD.D:
	$WARN	(<ADD command>,<^T/TABTXT/User [^O/USRPPN,LHMASK/,^O/USRPPN,RHMASK/] already has an entry for ^W/STRUCT/>)
	AOS	DUPCNT			;COUNT A DUPLICATION
	JRST	ADD.5			;LOOP OVER USERS

ADD.F:
	$WARN	(<ADD command>,<^T/TABTXT/User [^O/USRPPN,LHMASK/,^O/USRPPN,RHMASK/] has no room left for ^W/STRUCT/>)
	AOS	FAICNT			;COUNT UP FAILURE
	JRST	ADD.5			;TRY NEXT USER
SUBTTL	QUOTA processor -- DELETE command

DELETE:
	PUSHJ	P,NAMSTR		;PARSE USER & STRUCTURE BLOCKS
	  POPJ	P,			;ERROR ALREADY GIVEN
	PUSHJ	P,GETBLK		;READ THE CONFIRM BLOCK
	  PJRST	OPRERR			;MUST BE THERE
	CAIE	T1,.CMCFM		;IS WHAT WE EXPECT?
	PJRST	OPRERR			;NO, VERSION SKEW
	SKIPE	STRQUO			;IF COULD BE FOR QUOTA.SYS,
	PUSHJ	P,QMDINI		;TRY TO SETUP FOR QUOTA.SYS MODS
	  JRST	[SKIPE	QRDIFN		;CAN'T CREATE?
		  POPJ	P,		;YES, GIVE UP
		 JRST	.+1]		;NO, TRY ANYWAY
	PUSHJ	P,USRNXT		;SET UP FOR THE FIRST USER
	  JRST	DEL.6			;CAN'T, CHECK FOR QUOTA.SYS
DEL.1:
	PUSHJ	P,STRFND		;FIND THIS STR FOR THIS USER
	  JRST	DEL.4			;CAN'T, CHECK FOR QUOTA.SYS
	PUSHJ	P,STRREM		;DELETE IT
	PUSHJ	P,USRMOD		;SEND ACTDAE THE MODIFY MESSAGE
	  AOSA	FAICNT			;NO, COUNT THE FAILURES
	AOS	STRCNT			;YES, COUNT THE SUCCESSES
DEL.4:
	SKIPE	QRDIFN			;IF QUOTA.SYS,
	SKIPN	WILDBK+UW$WST		;ARE WE DOING BY PPNS?
	JRST	DEL.5			;YES, DEFER QUOTA.SYS UNTIL LATER
	PUSHJ	P,GQSYNT		;NO, GET THIS USER'S QUOTA.SYS ENTRY
	  JRST	DEL.5			;OK IF CAN'T
	SETZM	CPYENT			;DON'T COPY THIS ENTRY (DELETE IT)
	AOS	STRCNT			;WE FOUND ANOTHER
DEL.5:
	PUSHJ	P,USRNXT		;STEP THE WILDCARDING
	  JRST	DEL.6			;DONE WITH AUXACC
	JRST	DEL.1			;LOOP OVER ALL MATCHING AUXACC ENTRIES
DEL.6:
	SKIPE	QRDIFN			;IF HAVE A QUOTA.SYS,
	SKIPE	WILDBK+UW$WST		;DOING THIS BY PPN?
	JRST	DEL.E			;NO, DON'T STEP QUOTA.SYS
	SETZM	COMPAT			;NO LONGER CARE ABOUT AUXACC
DEL.7:
	PUSHJ	P,GQSYNT		;GET NEXT MATCHING QUOTA ENTRY
	  JRST	DEL.E			;DONE
	SETZM	CPYENT			;DON'T COPY IT (DELETE IT)
	AOS	STRCNT			;COUNT THESE DELETIONS
	JRST	DEL.7			;LOOP OVER ALL MATCHING PPNS
DEL.E:
	SKIPN	STRCNT			;DID WE DELETE ANY?
	JRST	DEL.N			;NO, GIVE WARNING
	PUSHJ	P,CPYFIN		;YES, FINISH OFF THE QUOTA FILE
	  JRST	DEL.ER			;OOPS
	MOVE	T1,STRCNT		;GET SUCCESS COUNT
	CAIN	T1,1			;ONLY ONE?
	SKIPA	T1,[[ASCIZ |y|]]	;YES
	MOVEI	T1,[ASCIZ |ies|]	;OR NO
	$RESP	(<DELETE command>,<^T/TABTXT/^D/STRCNT/ entr^T/(T1)/ deleted>)
	POPJ	P,			;WIN

DEL.N:	$WARN	(<DELETE command>,<^T/TABTXT/No entries deleted>)
	POPJ	P,			;RETURN

DEL.ER:	$ERR	(<DELETE command aborted due to file error>)
	POPJ	P,			;RETURN
SUBTTL	QUOTA processor -- MODIFY command

MODIFY:
	PUSHJ	P,NAMBLK		;PARSE USER ARGUMENT
	  POPJ	P,			;ERROR ALREADY GIVEN
	PUSHJ	P,GETBLK		;NEED A BLOCK
	  PJRST	OPRERR			;REQUIRED
	CAIE	T1,.CMSWI		;SWITCH?
	JRST	MOD.ND			;NO, GET STRUCTURE
	MOVE	S1,(T3)			;YES, GET TYPE
	CAIE	S1,.QTDEF		;SETTING DEFAULT?
	JRST	OPRERR			;NO, VERSIONS ARE SKEWED
	SETOM	SETDEF			;NOTE THAT WE'RE DEFAULTING
	SETOM	AUXAUX			;WE'RE DOING AUXACC ONLY
	PUSHJ	P,GETBLK		;GET TERMINATING BLOCK
	  PJRST	OPRERR			;REQUIRED
	CAIE	T1,.CMCFM		;IS IT WHAT WE EXPECT?
	PJRST	OPRERR			;NO, SKEWED VERSIONS
	JRST	MOD.4			;YES, GO DO IT
MOD.ND:
	PUSHJ	P,STRB.1		;PARSE STRUCTURE ARGUMENT
	  POPJ	P,			;ERROR ALREADY GIVEN
	SETOM	AUXLIN			;ASSUME 'SAME' GIVEN
	SETOM	AUXOUT			;FOR BOTH QUOTAS
	SETOM	AUXRES			;I MEAN ALL THREE
	PUSHJ	P,GETBLK		;NEED A BLOCK
	  PJRST	OPRERR			;SKEWED?
	CAIE	T1,.CMNUM		;IS PART OF A QUOTA BLOCK?
	CAIN	T1,.CMKEY		; ?
	TRNA				;YES, KEEP GOING
	JRST	MOD.2			;NO, TRY FOR SWITCHES
	PUSHJ	P,GQBK.0		;PARSE QUOTA BLOCK
	  POPJ	P,			;ERROR ALREADY GIVEN
	MOVEM	S1,AUXLIN		;USE AS FCFS QUOTA
	PUSHJ	P,GETQBK		;GET OTHER QUOTA BLOCK
	  POPJ	P,			;PROPAGATE ERROR
	MOVEM	S1,AUXOUT		;SAVE OUT QUOTA
MOD.1:
	PUSHJ	P,GETBLK		;GET NEXT BLOCK
	  PJRST	OPRERR			;REQUIRED
	CAIE	T1,.CMSWI		;IS IT A SWITCH?
	JRST	MOD.2			;NO, SKIP /RESERVED HANDLING
	MOVE	S1,(T3)			;YES, GET TYPE
	CAIE	S1,.QTRES		;IS IT /RESERVED?
	JRST	MOD.2			;NO, DON'T CHANGE QUOTA
	PUSHJ	P,GETQBK		;YES, GET QUOTA TO SET
	  POPJ	P,			;ALREADY WENT THROUGH OPRERR
	MOVEM	S1,AUXRES		;SAVE QUOTA VALUE
	PUSHJ	P,GETBLK		;GET NEXT BLOCK
	  PJRST	OPRERR			;REQUIRED
MOD.2:
	CAIN	T1,.CMCFM		;END OF COMMAND?
	JRST	MOD.3			;YES, GO DO IT
	CAIE	T1,.CMSWI		;NO, MUST BE SWITCH
	PJRST	OPRERR			;BAD IF NOT
	MOVE	S1,(T3)			;GET SWITCH TYPE
	MOVE	S2,MODPTR		;AND DISPATCH POINTER
	PUSHJ	P,FNCDSP		;PROCESS THE SWITCH
	  POPJ	P,			;ALREADY WENT THROUGH OPRERR
	PUSHJ	P,GETBLK		;GET NEXT BLOCK
	  PJRST	OPRERR			;REQUIRED
	JRST	MOD.2			;LOOP OVER SWITCHES
MOD.3:
	SKIPGE	AUXLIN			;ANY CHANGE
	SKIPL	AUXOUT			;IN EITHER QUOTA?
	JRST	MOD.4			;YES, DO SOMETHING
	SKIPN	AUXMSK			;ANY BITS CHANGED?
	SKIPE	AUXMNT			;OR CHANGING FILES?
	JRST	MOD.4			;YES, DO SOMETHING
	SKIPL	AUXRES			;LAST CHANCE
	JRST	MOD.4			;OK, CHANGE QUOTA
	$WARN	(<Null MODIFY command ignored>)	;SOMEDAY UPDATE QUOTA.SYS FORMAT
	POPJ	P,			;DON'T WASTE MY TIME
MOD.4:
	SKIPN	AUXMNT			;CHANGING FILES?
	JRST	MODBTH			;NO, HANDLE PARALLEL FILES
	SKIPN	STRQUO			;VALID FOR QUOTA.SYS?
	JRST	QUOBAD			;NO, ERROR
	SKIPN	AUXAUX			;TO AUXACC?
	JRST	MDAQFL			;NO, HANDLE AUXACC TO QUOTA.SYS CHANGES
	$FALL	MDQAFL			;YES, HANDLE QUOTA.SYS TO AUXACC

				;MODIFY COMMAND CONTINUED ON NEXT PAGE
				;MODIFY COMMAND CONTINUED

MDQAFL:
	PUSHJ	P,STRVAL		;MAKE SURE WE WANT THIS IN AUXACC
	  POPJ	P,			;ERROR ALREADY ISSUED
	PUSHJ	P,QMDINI		;SETUP TO MODIFY QUOTA.SYS FILE
	  JRST	MOD.NO			;NO CHANGES IF CAN'T
	PUSHJ	P,USRNXT		;FIND FIRST USER TO CHANGE
	  JRST	MOD.NO			;NO CHANGES IF NONE
MDQA.1:
	PUSHJ	P,GQSYNT		;FIND NEXT QUOTA.SYS ENTRY
	  TRNA				;EXAMINE ERRORS
	JRST	MDQA.2			;GO FOR IT
	CAIE	S1,EREOF$		;ONLY EOF & MISSING USER ARE LEGAL
	JUMPN	S1,.POPJ		;OTHERS HAVE ALREADY COMPLAINED
	JRST	MDQA.5			;MISSING USER, TRY NEXT
MDQA.2:
	PUSHJ	P,STRFND		;GET SLOT FOR THIS STRUCTURE
	  TRNA				;PREFER EMPTIES
	JRST	MDQA.D			;COMPLAIN OF DUPLICATES
	PUSHJ	P,STRADD		;INSERT NEW STRUCTURE
	  JRST	MDQA.F			;COMPLAIN IF S/L FULL
	MOVE	S1,QNTLIN		;GET FCFS FROM QUOTA FILE
	SKIPGE	AUXLIN			;IF OPR SAID 'SAME',
	MOVEM	S1,.AULIN(T1)		;PROPAGATE VALUE
	MOVE	S1,QNTOUT		;GET OUT QUOTA FROM SOURCE FILE
	SKIPGE	AUXOUT			;IF OPR SAID 'SAME',
	MOVEM	S1,.AUOUT(T1)		;PROPAGATE IT
	MOVE	S1,QNTRES		;GET RESERVED QUOTA FROM SOURCE FILE
	SKIPGE	AUXRES			;IF OPR SAID 'SAME',
	MOVEM	S1,.AURES(T1)		;PRESERVE IT
	PUSHJ	P,USRMOD		;DO THE CHANGE
	  JRST	[AOS	FAICNT		;COUNT THE ERROR (MSG ALREADY GIVEN)
		 JRST	MDQA.5]		;AND TRY THE NEXT USER
	SETZM	CPYENT			;SUCCEEDED, DELETE FROM QUOTA.SYS
	AOS	STRCNT			;COUNT THE SUCCESS
MDQA.5:
	PUSHJ	P,USRNXT		;GET NEXT ENTRY TO PROCESS
	  JRST	MOD.X			;NO MORE
	JRST	MDQA.1			;PROCESS IT

MDQA.D:
	PUSHJ	P,MOD.D			;COMPLAIN ABOUT DUPLICATE
	JRST	MDQA.5			;AND LOOP
MDQA.F:
	$WARN	(<MODIFY command>,<^T/TABTXT/User [^O/USRPPN,LHMASK/,^O/USRPPN,RHMASK/] has no room left for ^W/STRUCT/>)
	AOS	FAICNT			;COUNT FAILURE
	JRST	MDQA.5			;LOOP

				;MODIFY COMMAND CONTINUED ON NEXT PAGE
				;MODIFY COMMAND CONTINUED

MDAQFL:
	PUSHJ	P,USRNXT		;GET SOME USERS
	  JRST	MOD.NO			;NONE SUCH
	PUSHJ	P,QMDINI		;SETUP TO WRITE QUOTA.SYS
	  TRNA				;ANALYZE FAILURE
	JRST	MDAQ.1			;GO DO MODIFIES
	SKIPE	QRDIFN			;BAD FILE?
	  JRST	MOD.NO			;YES, DON'T TRY IT
	PUSHJ	P,QWTINI		;NO, TRY TO CREATE THE FILE
	  JRST	MOD.NO			;GIVE UP
MDAQ.1:
	PUSHJ	P,STRFND		;IS THIS TRIP WORTH IT?
	  JRST	MDAQ.2			;NO, TRY NEXT USER
	PUSHJ	P,GQSYNT		;YES, POSITION FOR SLOT IN FILE
	  TRNA				;PREFER EMPTIES
	JRST	MDAQ.D			;DUPLICATION ERROR
	PUSHJ	P,STRFND		;GET AUXACC SLOT AGAIN
	  JRST	MDAQ.2			; HUH?!?
	PUSH	P,T1			;SAVE SLOT POINTER
	SKIPGE	S2,AUXLIN		;USE OPR'S VALUE FOR FCFS
	MOVE	S2,.AULIN(T1)		;UNLESS 'SAME'
	MOVE	S1,T1			;COPY POINTER FOR USE
	SKIPGE	T1,AUXOUT		;USR OPR'S VALUE FOR OUT QUOTA
	MOVE	T1,.AUOUT(S1)		;UNLESS 'SAME'
	SKIPGE	T2,AUXRES		;USE OPR'S VALUE FOR RESERVED QUOTA
	MOVE	T2,.AURES(S1)		;UNLESS 'SAME'
	MOVE	P1,USRPPN		;PPN FOR NEW ENTRY
	PUSHJ	P,WTQENT		;WRITE A NEW ENTRY
	  JRST	[AOS	FAICNT		;CAN'T
		 POP	P,T1		;BALANCE STACK
		 JRST	MOD.ER]		;ABORT THROUGH COMMON ERROR EXIT
	POP	P,T1			;RESTORE SLOT POINTER
	PUSHJ	P,STRREM		;COMPRESS THE ENTRY
	PUSHJ	P,USRMOD		;HAVE ACTDAE REMOVE FROM AUXACC
	  AOSA	FAICNT			;COUNT UP FAILURES
	AOS	STRCNT			;AND SUCCESSES
MDAQ.2:
	PUSHJ	P,USRNXT		;GET NEXT USER TO PROCESS
	  JRST	MOD.X			;DONE AT END
	JRST	MDAQ.1			;LOOP OVER ALL ENTRIES
MDAQ.D:
	PUSHJ	P,MOD.D			;COMPLAIN ABOUT DUPLICATION
	JRST	MDAQ.2			;AND TRY NEXT USER

				;MODIFY COMMAND CONTINUED NEXT PAGE
				;MODIFY COMMAND CONTINUED

MODBTH:
	SKIPE	STRQUO			;IF INVALID FOR QUOTA.SYS,
	SKIPE	AUXMSK			;OR BITS ARE BEING TWIDDLED,
	TRNA				;THEN CAN'T USE QUOTA.SYS
	PUSHJ	P,QMDINI		;NO, MUST TRY QUOTA.SYS AS WELL
	  SETOM	AUXAUX			;YES OR CAN'T, JUST DO AUXACC
	PUSHJ	P,USRNXT		;FIND FIRST USER TO PROCESS
	  JRST	MODB.6			;CHECK QUOTA.SYS CASE
MODB.1:
	SKIPN	AUXAUX			;IF DOING ONLY AUXACC,
	SKIPN	WILDBK+UW$WST		;OR CAN LOOP BY PPNS,
	JRST	MODB.2			;DON'T TRY QUOTA.SYS HERE
	PUSHJ	P,GQSYNT		;FIND QUOTA.SYS SLOT
	  JRST	MODB.2			;NOT THERE
	SKIPL	S1,AUXLIN		;IF CHANGING IN QUOTA,
	MOVEM	S1,QNTLIN		;DO SO
	SKIPL	S1,AUXOUT		;IF CHANGING OUT QUOTA,
	MOVEM	S1,QNTOUT		;DO SO
	SKIPL	S1,AUXRES		;IF CHANGING RESERVED QUOTA,
	MOVEM	S1,QNTRES		;DO SO
MODB.2:
	SKIPE	SETDEF			;IF FORCING DEFAULTS,
	JRST	MODB.7			;GO MODIFY THE USER
	PUSHJ	P,STRFND		;FIND STR SLOT FOR THIS USER
	  JRST	MODB.3			;NONE, LOOP ON
	SKIPL	S1,AUXLIN		;IF CHANGING IN QUOTA,
	MOVEM	S1,.AULIN(T1)		;DO SO
	SKIPL	S1,AUXOUT		;IF CHANGING OUT QUOTA,
	MOVEM	S1,.AUOUT(T1)		;DO SO
	SKIPL	S1,AUXRES		;IF CHANGING RESERVED QUOTA,
	MOVEM	S1,.AURES(T1)		;DO SO
	MOVE	S1,AUXMSK		;GET BIT-CHANGE MASK
	ANDCAM	S1,.AUBIT(T1)		;KEEP ONLY UNCHANGED BITS IN RECORD
	AND	S1,AUXBTS		;GET CHANGED BITS VALUES
	IORM	S1,.AUBIT(T1)		;UPDATE USER RECORD
MODB.7:
	PUSHJ	P,USRMOD		;HAVE ACTDAE CHANGE THE AUXACC ENTRY
	  AOSA	FAICNT			;NO CAN DO
	AOS	STRCNT			;COUNT UP THE SUCCESS
MODB.3:
	PUSHJ	P,USRNXT		;GET NEXT USER TO PROCESS
	  TRNA				;DONE WITH AUXACC
	JRST	MODB.1			;LOOP OVER ALL USERS
	SKIPN	AUXAUX			;IF ONLY DOING AUXACC,
	SKIPE	WILDBK+UW$WST		;OR IF QUOTA.SYS ALREADY DONE,
	JRST	MOD.X			;THEN WE'RE DONE HERE
	SETZM	COMPAT			;NO LONGER CARE ABOUT AUXACC
MODB.4:
	PUSHJ	P,GQSYNT		;GET NEXT QUOTA.SYS ENTRY
	  JRST	MOD.X			;NO MORE
	SKIPL	S1,AUXLIN		;IF MODIFYING FCFS QUOTA,
	MOVEM	S1,QNTLIN		;DO SO
	SKIPL	S1,AUXOUT		;SIMILARLY,
	MOVEM	S1,QNTOUT		;UPDATE OUT QUOTA
	SKIPL	S1,AUXRES		;LIKEWISE,
	MOVEM	S1,QNTRES		;DO RESERVED QUOTA
	AOS	STRCNT			;COUNT UP MATCHES
	JRST	MODB.4			;LOOP OVER ALL ENTRIES
MODB.6:
	SKIPN	AUXAUX			;IF ABLE TO DO QUOTA.SYS
	SKIPE	WILDBK+UW$WST		;AND DOING PPNS,
	JRST	MOD.U			;(NO)
	SETZM	COMPAT			;THEN IGNORE AUXACC
	JRST	MODB.4			;AND JUST DO QUOTA.SYS

				;MODIFY COMMAND CONTINUED NEXT PAGE
				;MODIFY COMMAND CONTINUED

MOD.X:
	SKIPE	QWTIFN			;DOING QUOTA.SYS?
	SKIPN	STRCNT			;ANYTHING CHANGED?
	JRST	MOD.Y			;NO OR NO, DON'T FLUSH
	PUSHJ	P,CPYFIN		;YES, CLOSE OFF THE UPDATE
	  JRST	MOD.ER			;COMPLAIN OF FILE ERRORS
MOD.Y:
	SKIPN	S1,STRCNT		;ANYTHING CHANGED?
	JRST	MOD.NO			;NO, GIVE WARNING
	CAIN	S1,1			;YES, ONLY ONE?
	SKIPA	T1,[[ASCIZ |y|]]	;YES, GET THAT SUFFIX
	MOVEI	T1,[ASCIZ |ies|]	;NO, USE ALTERNATE
	$RESP	(<^D/STRCNT/ entr^T/(T1)/ modified>)
	POPJ	P,			;RETURN
MOD.NO:
	$WARN	(<No entries modified>)
	POPJ	P,			;RETURN
MOD.ER:
	$ERR	(<MODIFY command aborted due to file error>)
	POPJ	P,			;RETURN

MOD.D:
	$WARN	(<User [^O/USRPPN,LHMASK/,^O/USRPPN,RHMASK/] already has an entry for structure ^W/STRUCT/>)
	AOS	DUPCNT			;ANOTHER DUPLICATE WAS FOUND
	POPJ	P,			;RETURN TO MODIFY LOOP

MOD.U:
	$WARN	(<MODIFY command>,<^T/TABTXT/No matching user found>)
	POPJ	P,			;RETURN
SUBTTL	QUOTA processor -- SHOW command

SHOW:
	PUSHJ	P,NAMBLK		;PROCESS THE USER ARGUMENT
	  POPJ	P,			;ERROR ALREADY GENERATED
	PUSHJ	P,GETBLK		;READ NEXT COMMAND FIELD
	  PJRST	OPRERR			;FILE SKEW
	CAIE	T1,.CMSWI		;HAVE A SWITCH?
	JRST	SHOW.0			;NO, DON'T PARSE ONE
	MOVE	S1,(T3)			;YES, GET TYPE
	CAIE	S1,.QTMNT		;IS IT /MOUNT?
	PJRST	OPRERR			;NO, SKEWED FILES
	PUSHJ	P,GETBLK		;READ NEXT BLOCK
	  PJRST	OPRERR			;FILE SKEW
	CAIN	T1,.CMCFM		;IS IT WHAT WE EXPECT?
	JRST	SHOW.1			;YES, GO DO IT
	PJRST	OPRERR			;NO, GIVE ERROR
SHOW.0:
	CAIN	T1,.CMCFM		;END OF COMMAND?
	JRST	SHOW.1			;YES, GO DO IT
	PUSHJ	P,STRB.1		;NO, READ THE STRUCTURE BLOCK
	  POPJ	P,			;ERROR ALREADY RETURNED
	PUSHJ	P,GETBLK		;NOW GET CONFIRM BLOCK
	  PJRST	OPRERR			;REQUIRED
	CAIE	T1,.CMCFM		;WHAT WE EXPECTED?
	PJRST	OPRERR			;FILE SKEW
SHOW.1:
	SKIPN	STRQUO			;IF CAN'T USE FOR QUOTA.SYS,
	SKIPN	STRUCT			;AND WE WANT TO,
	TRNA				;(NO, IT'S OK)
	JRST	QUOBAD			;YES, IT'S AN ERROR
	PUSHJ	P,USRNXT		;GET FIRST MATCHING USER
	  JRST	SHOW.6			;SEE IF WE CARE
SHOW.2:
	SKIPN	STRUCT			;DOING AUXACC?
	JRST	SHOW.3			;YES, DON'T OPEN QUOTA FILE
	PUSHJ	P,QRDINI		;YES, TRY TO READ IT
	  JRST	SHOW.F			;NO SUCH FILE?
	SKIPN	WILDBK+UW$WST		;IF DOING PPNS,
	SETZM	COMPAT			;DON'T CARE ABOUT AUXACC
SHOW.3:
	SKIPN	STRUCT			;DOING AUXACC?
	JRST	SHOW.4			;YES, HANDLE DIFFERENTLY
	PUSHJ	P,GQSYNT		;READ NEXT ENTRY
	  JRST	SHOW.Z			;NOT THERE
	PUSHJ	P,SHOQTA		;SHOW QUOTA.SYS ENTRY
	JRST	SHOW.5			;LOOP
SHOW.4:
	PUSHJ	P,SHOAUX		;SHOW AUXACC LIST
SHOW.5:
	SKIPN	COMPAT			;DO WE NEED ACTDAE?
	JRST	SHOW.3			;NO, JUST DISPLAY NEXT
	PUSHJ	P,USRNXT		;YES, GET THE NEXT
	  JRST	SHOW.X			;DONE
	JRST	SHOW.3			;LOOP OVER ALL MATCHING USERS
SHOW.Z:
	SKIPE	WILDBK+UW$WST		;IF NO MATCH FOR PPN,
	JRST	SHOW.5			;USERNAME, LOOP
	JRST	SHOW.X			;PPN, WE'RE DONE
SHOW.6:
	SKIPN	WILDBK+UW$WST		;IF MATCHING ON PPNS,
	SKIPN	STRUCT			;VIA QUOTA.SYS,
	JRST	SHOW.N			;NO, CAN'T DO IT
	JRST	SHOW.2			;YES, GO RIGHT ON AHEAD

				;SHOW COMMAND CONTINTUED NEXT PAGE
				;SHOW COMMAND CONTINUED

SHOW.X:
	SKIPE	STRCNT			;IF ANYTHING FOUND,
	PJRST	OPRFIN			;SEND IT AND RETURN
SHOW.N:
	$WARN	(<SHOW command>,<^T/TABTXT/No matching user found>)
	POPJ	P,			;RETURN
SHOW.F:
	$ERR	(<Can't read ^F/QSYFDB/>,<^T/TABTXT/Reason: ^E/[-1]/>)
	POPJ	P,			;RETURN

				;SHOW COMMAND CONTINUED NEXT PAGE
				;SHOW COMMAND CONTINUED

SHOQTA:
	PUSHJ	P,SHOWHD		;INIT THE MESSAGE
	$TEXT	(TXTCHR,<^T/TABTXT/User:  ^A>)
	SKIPE	STRUCT			;IF USING AUXACC,
	SKIPE	WILDBK+UW$WST		;IN ANY FORM,
	$TEXT	(TXTCHR,<^Q/BASPTR/^M^J^T/TABTXT/^T/TABTXT/^A>)
	$TEXT	(TXTCHR,<^O7R /QNTPPN,LHMASK/,^O10L /QNTPPN,RHMASK/   Quota In:  ^A>)
	MOVE	S1,QNTLIN		;GET FCFS QUOTA
	PUSHJ	P,LISTQT		;SHOW A QUOTA VALUE
	$TEXT	(TXTCHR,<   Out:  ^A>)
	MOVE	S1,QNTOUT		;GET OUT QUOTA
	PUSHJ	P,LISTQT		;SHOW ITS VALUE
IFN FTRESQ,<
	$TEXT	(TXTCHR,<   Reserved:  ^A>)
	MOVE	S1,QNTRES		;GET RESERVED QUOTA
	PUSHJ	P,LISTQT		;SHOW ITS VALUE
>
	$TEXT	(TXTCHR,<>)		;END LINE
	POPJ	P,			;RETURN

SHOAUX:
	SKIPN	USRAUX+.AUSTR		;ANY ENTRIES?
	POPJ	P,			;NO, PRETEND IT DOESN'T EXIST
	PUSHJ	P,SHOWHD		;INIT THE MESSAGE
	$TEXT	(TXTCHR,<^O7R /USRPPN,LHMASK/,^O10L /USRPPN,RHMASK/^Q/BASPTR/^M^J>)
	$TEXT	(TXTCHR,<^T/STRTXT/ ^T10C /QINTXT/   ^T10C /QOUTXT/^A>)
IFN FTRESQ,<
	$TEXT	(TXTCHR,<   ^T10C /RESTXT/^A>)
>
	$TEXT	(TXTCHR,<   ^T10C /BTSTXT/>)
	$TEXT	(TXTCHR,<^T9L-/NILTXT/ ^T10L-/NILTXT/   ^T10L-/NILTXT/^A>)
IFN FTRESQ,<
	$TEXT	(TXTCHR,<   ^T10L-/NILTXT/^A>)
>
	$TEXT	(TXTCHR,<   ^T10L-/NILTXT/>)
	MOVEI	T1,USRAUX		;START OF LIST
SHOA.1:
	PUSHJ	P,SHOA.3		;LIST THE ENTRY
	  JRST	SHOA.1			;MORE TO DO
	POPJ	P,			;DONE
SHOA.3:
	$TEXT	(TXTCHR,<   ^W7L /.AUSTR(T1)/^A>)
	MOVE	S1,.AULIN(T1)		;GET QUOTA-IN
	PUSHJ	P,LISTQT		;SHOW IT
	$TEXT	(TXTCHR,<   ^A>)	;SEPARATION
	MOVE	S1,.AUOUT(T1)		;GET QUOTA-OUT
	PUSHJ	P,LISTQT		;SHOW THAT
IFN FTRESQ,<
	$TEXT	(TXTCHR,<   ^A>)	;SEPARATION SOME MORE
	MOVE	S1,.AURES(T1)		;GET RESERVED QUOTA
	PUSHJ	P,LISTQT		;SHOW THAT
>
	SKIPN	S1,.AUBIT(T1)		;ANY BITS ON?
	JRST	SHOA.2			;SKIP OUT IF NONE
	$TEXT	(TXTCHR,<   ^A>)	;SEPARATION AGAIN
	TXNE	S1,AU.NCR		;NO-CREATE?
	$TEXT	(TXTCHR,</NOCREATE ^A>)	;YES
	TXNE	S1,AU.RON		;OR READ-ONLY?
	$TEXT	(TXTCHR,</NOWRITE^A>)	;YES
SHOA.2:
	$TEXT	(TXTCHR,<>)		;END LINE
	ADDI	T1,.AULEN		;NEXT ENTRY
	CAIGE	T1,USRAUE		;OFF THE END?
	SKIPN	.AUSTR(T1)		;OR NO MORE TO SHOW?
	TRNA				;YES,
	POPJ	P,			;NO, GIVE CONTINUE RETURN
	$TEXT	(TXTCHR,<>)		;EXTRA SEPARATION BETWEEN USERS
	JRST	.POPJ1			;GIVE END OF LIST RETURN

				;SHOW COMMAND CONTINUED NEXT PAGE
				;SHOW COMMAND CONTINUED

SHOWHD:
	MOVEI	S1,[ITEXT (<QUOTA listing>)]	;INITIAL ITEXT BLOCK
	SKIPN	STRCNT			;FIRST TIME HERE?
	PUSHJ	P,TXTACK		;YES, SET UP
	SKIPN	STRCNT			;ANOTHER TEST
	$TEXT	(TXTCHR,<>)		;START OFF WITH A BLANK LINE
	AOS	STRCNT			;COUNT UP THE MATCH
	PUSH	P,MSGTXP		;SAVE OUTPUT POINTER
	PUSHJ	P,@-1(P)		;CALL OUR CALLER
	SKIPLE	MSGTXC			;NEED TO RECYCLE THE BUFFER?
	JRST	SHOWH1			;NO, GET OUT
	POP	P,MSGTXP		;YES, RESTORE POINTER
	PUSHJ	P,OPRFIN		;CLOSE OUT & SEND MESSAGE AS OF ENTRY
	MOVE	S1,TXTFST		;GET INITIAL ITEXT BLOCK AGAIN
	PUSHJ	P,TXTACK		;INITIALIZE THE MESSAGE
	POPJ	P,			;GO THROUGH CALLER'S CODE AGAIN
SHOWH1:
	ADJSP	P,-2			;TRIM JUNK OFF STACK
	POPJ	P,			;RETURN ON CALLER'S BEHALF
SUBTTL	QUOTA processor -- LIST command

LISTER:
	PUSHJ	P,NAMBLK		;PARSE THE USER BLOCK
	  POPJ	P,			;ERROR ALREADY GENERATED
	PUSHJ	P,GETBLK		;GET NEXT BLOCK
	  PJRST	OPRERR			;REQUIRED
	CAIE	T1,.CMDEV		;DEVICE?
	JRST	LIST.1			;NO, TRY OTHER CASE
	PUSHJ	P,STRB.1		;YES, PARSE THE STRUCTURE BLOCK
	  POPJ	P,			;ERROR ALREADY ISSUED
	PUSHJ	P,STRVAL		;MAKE SURE WE CAN USE IT ON QUOTA.SYS
	  POPJ	P,			;COMPLAINED ALREADY
	JRST	LIST.2			;LOOK FOR OUTPUT BLOCK
LIST.1:
	MOVE	S2,(T3)			;GET SWITCH TYPE
	CAIN	T1,.CMSWI		;IF NOT A SWITCH,
	CAXE	S2,.QTMNT		;OR NOT MOUNT,
	PJRST	OPRERR			;SOMETHING'S FOULED UP
	SETOM	AUXAUX			;GOING FOR AUXACC
LIST.2:
	PUSHJ	P,GETBLK		;GET THE FILE BLOCK
	  PJRST	OPRERR			;FILE SKEW
	CAIE	T1,.CMOFI		;OUTPUT FILE?
	PJRST	OPRERR			;SKEW
	MOVSI	S2,(T3)			;SOURCE POINTER
	HRRI	S2,LISFDB+1		;MAKE XFER WORD
	CAXLE	T2,FDXSIZ		;SIZE WITHIN RANGE?
	MOVX	T2,FDXSIZ		;NO, RESTRICT IT
	BLT	S2,LISFDB-1(T2)		;COPY THE BLOCK
	STORE	T2,LISFDB+.FDLEN,FD.LEN	;SETUP THE LENGTH
	MOVE	S1,CURPPN		;GET OPR'S PPN
	MOVEM	S1,LISFOB+FOB.US	;SET FOR IN-YOUR-BEHALF OPERATIONS
	PUSHJ	P,GETBLK		;READ CONFIRM BLOCK
	  PJRST	OPRERR			;SKEW
	CAIE	T1,.CMCFM		;IS IT WHAT WE REQUIRE?
	PJRST	OPRERR			;FILE SKEW
	SKIPE	AUXAUX			;IF DOING AUXACC,
	JRST	LIST.0			;DON'T BOTHER WITH QUOTA.SYS
	PUSHJ	P,QRDINI		;TRY TO READ THE QUOTA FILE
	  JRST	LIST.N			;NO CAN DO
LIST.0:
	PUSHJ	P,USRNXT		;SETUP FOR FIRST USER
	  JRST	LIST.6			;NOT THERE, GO TEST FOR QUOTA.SYS
LIST.5:
	DMOVE	S1,[EXP FOB.SZ,LISFOB]	;POINT TO LISTING-FILE FOB
	$CALL	F%OOPN			;OPEN IT FOR WRITING
	JUMPF	LISOPN			;NO CAN DO
	MOVEM	S1,LSTIFN		;SAVE OUR IFN FOR OUTPUT ROUTINES
	;SETZM	LSTLPN			;NOT INITED YET
	SETOM	MSGTXF			;TELL SHOW ROUTINES ABOUT LISTINGS
	SKIPN	WILDBK+UW$WST		;IF DOING PPNS,
	SKIPE	AUXAUX			;VIA QUOTA.SYS,
	TRNA				;(NO)
	SETZM	COMPAT			;THEN DON'T CARE ABOUT AUXACC
LIST.3:
	SKIPE	AUXAUX			;IF DOING AUXACC,
	JRST	LIST.A			;GO ELSEWHERE
	PUSHJ	P,GQSYNT		;GET NEXT ENTRY
	  JRST	[SKIPN	WILDBK+UW$WST	;IF DOING PPNS,
		 JRST	LIST.7		;ASSUME EOF
		 JRST	LIST.4]		;ELSE, STEP VIA ACTDAE
	PUSHJ	P,LISTNT		;LIST AN ENTRY
	AOS	STRCNT			;COUNT UP ENTRIES FOUND
	JRST	LIST.B			;RE-JOIN WITH AUXACC LINE
LIST.A:
	PUSHJ	P,LISTAX		;LIST A USER FROM AUXACC
LIST.B:
	SKIPN	LSTIFN			;IF FILE ERROR,
	POPJ	P,			;GIVE UP
LIST.4:
	SKIPN	COMPAT			;DO WE NEED ACTDAE?
	JRST	LIST.3			;ELSE, DO OUR OWN WILDCARDS
	PUSHJ	P,USRNXT		;NO, FIND NEXT USER
	  JRST	LIST.7			;NO MORE
	JRST	LIST.3			;LOOP OVER ALL USERS

				;LIST COMMAND CONTINUED NEXT PAGE
				;LIST COMMAND CONTINUED

LIST.7:
	$TEXT	(TXTLST,<>)		;BLANK LINE BEFORE SUMMARY
	SKIPN	S1,STRCNT		;ANYONE FOUND?
	JRST	LIST.8			;NOPE
	CAIN	S1,1			;YES, ONLY ONE?
	SKIPA	T1,[[ASCIZ |y|]]	;YUP
	MOVEI	T1,[ASCIZ |ies|]	;OR NOPE
	$TEXT	(TXTLST,<Total of ^D/STRCNT/ entr^T/(T1)/ listed>)
	JRST	LIST.9			;KEEP ON TRUCKIN'
LIST.8:
	$TEXT	(TXTLST,<No matching entries found>)
LIST.9:
	MOVE	S1,LSTIFN		;GET FILE NAME
	SETO	S2,			;TRUTH IN ADVERTISING
	$CALL	F%FD			;GET REAL FILESPEC
	$TEXT	(<-1,,LISFIL>,<^F/(S1)/^0>) ;SAVE DESCRIPTION FOR OPR
	MOVE	S1,LSTIFN		;GET IFN AGAIN
	$CALL	F%REL			;CLOSE IT OFF
	SETZM	LSTIFN			;NO LONGER OPEN
	$RESP	(<Listing file written to ^T/LISFIL/>)
	POPJ	P,			;RETURN

LIST.6:
	SKIPN	WILDBK+UW$WST		;NO AUXACC ENTRY, DO WE CARE?
	JRST	LIST.5			;NO, CONTINUE
	$ERR	<LIST error>,<^T/TABTXT/No entry found for "^T/USRBLK/">
	POPJ	P,			;YES, GIVE UP

LIST.N:
	$ERR	(<Can't read file ^F/QSYFDB/>,<^T/TABTXT/Reason: ^E/[-1]/>)
	POPJ	P,			;GIVE UP
SUBTTL	QUOTA processor -- LIST command subroutines

LISTHD:
	$TEXT	(TXTLST,<Quota listing for ^A>)
	SKIPN	AUXAUX			;IF QUOTA.SYS,
	$TEXT	(TXTLST,<structure ^W/STRUCT/^A>)
	SKIPE	AUXAUX			;IF FOR AUXACC,
	$TEXT	(TXTLST,<AUXACC^A>)
	$TEXT	(TXTLST,<, generated by ^I/@WHOAMI/QUOTA at ^H18R0/NOW/^A>)
	$TEXT	(TXTLST,<, Page ^D/LSTLPN/>)
	$TEXT	(TXTLST,<>)
	SKIPN	WILDBK+UW$WST		;IF DOING PPNS,
	SKIPE	AUXAUX			;AND NOT AUXACC,
	TRNA				;(FALSE)
	$TEXT	(TXTLST,<^T15C /PPNTXT/^A>)
	SKIPN	AUXAUX			;IF FOR AUXACC
	SKIPE	WILDBK+UW$WST		;ELSE FOR USERNAMES
	$TEXT	(TXTLST,<^T39C /NAMTX1/   ^T15C /NAMTX2/^A>)
	$TEXT	(TXTLST,<   ^A>)
	SKIPE	AUXAUX			;IF AUXACC,
	$TEXT	(TXTLST,<^T/STRTXT/ ^A>)
	$TEXT	(TXTLST,<^T10C /QINTXT/   ^T10C /QOUTXT/^A>)
IFN FTRESQ,<
	$TEXT	(TXTLST,<   ^T10C /RESTXT/^A>)
>
	SKIPE	AUXAUX			;IF AUXACC,
	$TEXT	(TXTLST,<   ^T10C /BTSTXT/^A>)
	$TEXT	(TXTLST,<>)		;END LINE
	SKIPN	AUXAUX			;AUXACC HAS USERNAMES
	SKIPE	WILDBK+UW$WST		;PREPEND JUNK IF USERNAMES
	$TEXT	(TXTLST,<^T39L-/NILTXT/   ^A>)
	$TEXT	(TXTLST,<^T15L-/NILTXT/   ^A>)
	SKIPE	AUXAUX			;IF FOR AUXACC,
	$TEXT	(TXTLST,<^T9L-/NILTXT/ ^A>)
	$TEXT	(TXTLST,<^T10L-/NILTXT/   ^T10L-/NILTXT/^A>)
IFN FTRESQ,<
	$TEXT	(TXTLST,<   ^T10L-/NILTXT/^A>)
>
	SKIPE	AUXAUX			;IF FOR AUXACC,
	$TEXT	(TXTLST,<   ^T10L-/NILTXT/^A>)
	$TEXT	(TXTLST,<>)		;END THE LINE
	$TEXT	(TXTLST,<>)		;ADD EXTRA BLANK LINE
	POPJ	P,			;RETURN TO TXTLST

LISTAX:
	SKIPN	USRAUX+.AUSTR		;REQUIRE ENTRIES
	POPJ	P,			;ELSE IGNORE IT
	$TEXT	(TXTLST,<^Q42L /BASPTR/^O7R /USRPPN,LHMASK/,^O10L /USRPPN,RHMASK/^A>)	;INIT THE LINE
	SKIPA	T1,[USRAUX]		;SKIP INTO THE LOOP
LISTA1:	$TEXT	(TXTLST,<^T60L /NILTXT/^A>)	;SPACE OVER FOR ADDITIONAL STRS
	PUSHJ	P,SHOA.3		;LIST A STRUCTURE
	  JRST	LISTA1			;LOOP OVER ALL STRS IN USER'S S/L
	AOS	STRCNT			;FOUND ANOTHER
	POPJ	P,			;RETURN

LISTNT:
	SKIPE	WILDBK+UW$WST		;IF STEPPING BY USERNAME,
	$TEXT	(TXTLST,<^Q42L /BASPTR/^A>) ;TYPE THE NAME
	$TEXT	(TXTLST,<^O7R  /QNTPPN,LHMASK/,^O10L /QNTPPN,RHMASK/^A>)	;TYPE THE PPN
	MOVE	S1,QNTLIN		;GET FCFS QUOTA
	PUSHJ	P,LISTQT		;DUMP THE QUOTA WORD
	$TEXT	(TXTLST,<   ^A>)	;THREE SPACES TO SEPARATE
	MOVE	S1,QNTOUT		;GET OUT QUOTA
	PUSHJ	P,LISTQT		;DUMP THE QUOTA WORD
IFN FTRESQ,<
	$TEXT	(TXTLST,<   ^A>)	;SEPARATION
	MOVE	S1,QNTRES		;GET RESERVED QUOTA
	PUSHJ	P,LISTQT		;DUMP THE QUOTA WORD
>
	$TEXT	(TXTLST,<>)		;END THE LINE
	POPJ	P,			;RETURN

LISTQT:
	CAXE	S1,.INFIN		;INFINITE?
	JRST	LISTQ1			;NO, GO HANDLE NUMERIC OUTPUT
	$TEXT	(TXTCHR,<^T10L /INFTXT/^A>) ;YES, TYPE THE WORD
	POPJ	P,			;RETURN
LISTQ1:
	$TEXT	(TXTCHR,<^D10R /S1/^A>)	;DUMP THE VALUE IN DECIMAL
	POPJ	P,			;RETURN
SUBTTL	QUOTA processor -- LIST command data

LISFOB:	$BUILD	(FOB.SZ)
	  $SET	(FOB.CW,FB.BSZ,7)	;7-BIT BYTES
	  $SET	(FOB.CW,FB.PHY,1)	;PHYSICAL-ONLY
	  $SET	(FOB.FD,,LISFDB)	;FD BLOCK
	  $SET	(FOB.AB,,LISATB)	;ATTRIBUTES
	$EOB

LISATB:	EXP	3			;ONE VALUE + OVERHEAD
	FI.IMM!FLD(1,FI.LEN)!.FIPRO	;PROTECTION
LISPRT:	077				;FILLED IN WITH SPOOL PROTECTION

LISFDB:	$BUILD	(FDXSIZ)		;MAXIMUM NEEDED SPACE
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE FILESPEC
	$EOB

PPNTXT:	ASCIZ	|User|
NAMTX1:	ASCIZ	|User name|
NAMTX2:	ASCIZ	|PPN|
QINTXT:	ASCIZ	|Quota in|
QOUTXT:	ASCIZ	|Quota out|
RESTXT:	ASCIZ	|Reserved|
INFTXT:	ASCIZ	|-Infinite-|
STRTXT:	ASCIZ	|Structure|
BTSTXT:	ASCIZ	|Status|
NILTXT:	0
TABTXT:	BYTE	(7) .CHTAB

LISFIL:	BLOCK	^D65/5+1		;SPACE ENOUGH FOR A FULL FILESPEC

BASPTR:	POINT 8,USRBAS
SUBTTL	QUOTA processor -- Get next (wildcarded) user from the ACTDAE

USRNXT:	MOVEI	S1,UW$DAT		;LENGTH OF USER-ID DATA IN BLOCK
	HRLM	S1,WILDBK+UW$TYP	;SAVE IN BLOCK
	SETZM	WILDBK+UW$SEL		;NO SELECTION BLOCKS
	MOVEI	T1,WILDBK		;POINT TO WILDCARD BLOCK
	MOVEI	T2,USER			;POINT TO RESPONSE BLOCK
	MOVEI	T3,QUETIM		;MAXIMUM NUMBER OF SECONDS TO WAIT
	MOVEI	T4,1			;INVOKE PRIVS
	PUSHJ	P,A$QWLD##		;QUEUE UP A WILDCARD REQUEST
	JUMPF	.POPJ			;RETURN ON FAILURES

USRFND:	MOVE	S1,[.AEAUX,,.AUMAX]	;XWD OFFSET,MAX. LENGTH
	MOVEI	S2,USRAUX		;WHERE TO MOVE IT
	PUSHJ	P,USRBLT		;COPY PROFILE INFORMATION
	SKIPE	USRDFL			;DOING THIS FOR Q$QOTA?
	JRST	.POPJ1			;YES, DON'T CHANGE NAME OR PPN
	MOVE	S1,USER+.AEPPN		;NO, GET THE PPN
	MOVEM	S1,USRPPN		;SET FOR QUOTA.SYS ROUTINES
	MOVE	S1,[.AENAM,,NAMWDS]	;XWD OFFSET,LENGTH
	MOVEI	S2,USRBAS		;WHERE TO COPY
	PUSHJ	P,USRBLT		;MOVE THE BLOCK
	JRST	.POPJ1			;WIN

USRBLT:	$SAVE	<P1,P2>			;PRESERVE SOME ACS
	HLRZ	P1,S1			;COPY OFFSET
	MOVSI	P2,-EXBLEN		;FOR TABLE INDEXING
	CAME	P1,EXBTAB(P2)		;IS THIS AN EXTENSIBLE BLOCK?
	AOBJN	P2,.-1			;LOOP UNTIL FOUND
	JUMPGE	P2,USRBL1		;JUMP IF STATIC BLOCK
	ANDI	S1,-1			;ISOLATE BLOCK LENGTH
	$CALL	.ZCHNK			;CLEAR OUT DESTINATION AREA
	HRRZ	S1,USER(P1)		;GET OFFSET INTO BLOCK
	HRLI	S2,USER(S1)		;MAKE TRANSFER VECTOR
	HLRE	S1,USER(P1)		;GET MINUS CURRENT LENGTH
	MOVNS	S1			;MAKE POSITIVE
	ADDI	S1,(S2)			;FORM END+1 OF TRANSFER
	BLT	S2,-1(S1)		;COPY DATA
	POPJ	P,			;RETURN TO CALLER

USRBL1:	HRLI	S2,USER(P1)		;SOURCE POINTER
	ANDI	S1,-1			;ISOLATE LENGTH
	ADDI	S1,(S2)			;END+1 OF TRANSFER
	BLT	S2,-1(S1)		;COPY DATA
	POPJ	P,			;RETURN TO CALLER

EXBTAB:	EXTDAT				;LIST OF EXTENSIBLE BLOCK TYPES
	EXBLEN==.-EXBTAB		;LENGTH OF TABLE
SUBTTL	QUOTA processor -- Modify a user profile

USRMOD:
	SETZ	S1,			;START AT TOP OF BLOCK
USRM.1:
	SKIPN	USRAUX+.AUSTR(S1)	;EMPTY SLOT FOUND?
	JRST	USRM.2			;YES, THIS IS THE LENGTH
	ADDI	S1,.AULEN		;NO, POINT TO NEXT
	CAIGE	S1,.AUMAX		;OFF THE END?
	JRST	USRM.1			;NO, KEEP LOOKING
USRM.2:
	HRLI	S1,.AEAUX		;CHANGING AUXACC
	SKIPE	SETDEF			;MODIFYING TO DEFAULT?
	MOVSI	S1,.AEAUX!AF.DEF	;YES, NOTE THAT
	MOVSM	S1,QMDLEN		;SETUP BLOCK TO MODIFY AUXACC
	MOVE	S1,QM.PTR		;GET ARG BLOCK POINTER
	QUEUE.	S1,			;ASK ACTDAE TO MODIFY THE ENTRY
	  TRNA				;ANALYZE ERROR
	JRST	.POPJ1			;RETURN SUCCESS
	CAXN	S1,QUTMO%		;DID WE GET TIMED-OUT?
	JRST	QUETMO			;YES, COMPLAIN ABOUT THAT
	TRNN	S1,QU.RBR		;DID WE GET TEXT?
	JRST	QUEBAD			;NO, TYPE ERROR
	$ERR	(<QUOTA error from ACTDAE during MODIFY>,<^M^J^T/RSPBLK/>)
	POPJ	P,			;FAIL

QUEBAD:
	$ERR	(<QUOTA error from QUEUE. UUO during MODIFY:  ^O/S1/>)
	POPJ	P,			;FAIL

QUETMO:
	CAIN	S1,QUTMO%		;DID THE ACTDAE TIMEOUT?
	$ERR	(<QUOTA error>,<^T/TABTXT/ACTDAE did not respond within ^D/[QUETIM]/ seconds>)
	POPJ	P,			;RETURN FAILURE

SUBTTL	QUOTA processor -- QUEUE. UUO blocks for ACTDAE dialogs

;HERE FOR USRMOD

QM.BLK:	EXP	QUEHDR			;COMMON QUEUE. HEADER
	EXP	0			;(.QUNOD) CENTRAL SITE
	XWD	RSPLEN,RSPBLK		;(.QURSP) RESPONSE BLOCK
	EXP	QUETIM			;(.QUTIM) MAXIMUM TIMEOUT WAIT
	QA.IMM!.QBAFN			;ACCOUNTING FUNCTION
	EXP	AF.PRV!UGCUP$		;CHANGE USER PROFILE
	1,,FLD(.AFAND,AF.SEL)!.AEPPN	;PROFILE FOUND BY PPN
	USER+.AEPPN			;PPN IS IN THE PREVIOUS RECORD
;	QA.IMM!.UGPRV			;PRIVILEGE VALUE
;	EXP	-1			;ENABLED
;	.AUMAX,,.UGCHG			;THE REPLACEMENT FIELD
;	EXP	USRAUX			;COMES FROM HERE
;	QA.IMM!.UGTYP			;TYPE OF MODIFY REQUESTED
;	EXP	UG.AUX			;CHANGE AUXACC RECORD
	QA.IMM!.AEVRS(2)		;VERSION WORD
	FLD(%AECVN,AE.VRS)		;VALUE TO SET IN WORD
	EXP	AE.VRS			;MODIFY MASK
QMDLEN:! 0,,.AEAUX			;VALUE TO MODIFY
	EXP	USRAUX			;IS FOUND HERE
 QM.BLL==.-QM.BLK			;LENGTH FOR MODIFY

QM.PTR:	QM.BLL,,QM.BLK			;POINTER FOR USRMOD


;HERE FOR THE CATALOG

QC.BLK:	FLD(.QUTIM+1,QF.HLN)!.QUCAT	;CATALOG VALIDATION REQUEST
	EXP	0			;CENTRAL SITE
	EXP	0			;NO RESPONSE BUFFER
	EXP	QUETIM			;MAXIMUM WAIT TIME
	1,,.QBVSN			;VOLUME SET NAME
	Z	(T3)			;POINT TO ASCIZ VALUE
	QA.IMM!.QBMFG			;REQUEST-TYPE FLAGS
	QB.DSK				;I ONLY WANT STRUCTURES
 QC.BLL==.-QC.BLK

QC.PTR:	QC.BLL,,QC.BLK
SUBTTL	QUOTA procssor -- USER/NAME block parser

NAMBLK:	PUSHJ	P,GETBLK		;FETCH THE BLOCK
	  PJRST	OPRERR			;FILE SKEW
	PUSHJ	P,P$INIT		;INIT OPRPAR
	MOVEI	T1,WILDBK		;POINT TO WILDCARD BLOCK
	MOVE	T2,[POINT 8,WILDAK]	;BYTE POINTER TO ACK TEXT
	PUSHJ	P,A$PWLD##		;PARSE USER-ID
	JUMPF	OPRERR			;CHECK FOR ERRORS
	SKIPN	WILDBK+UW$WST		;IS THIS FOR USERNAME?
	JRST	NAMB.1			;NO, SETUP FOR PPN
	MOVE	T1,[WILDBK+UW$BUI,,USRBLK] ;YES, GET TRANSFER WORD
	BLT	T1,USRBLK+NAMWDS-1	;COPY FOR LISTER
	JRST	.POPJ1			;RETURN SUCCESS

NAMB.1:	MOVE	T1,WILDBK+UW$PPM	;GET WILDCARD MASK
	SETCAM	T1,USRWLD		;SETUP WILDCARD FLAG
	MOVE	T1,WILDBK+UW$PPN	;GET PPN TYPED
	IOR	T1,USRWLD		;TURN ON WILD PORTIONS
	MOVEM	T1,USRBLK		;SAVE FOR GQSYNT
	SKIPGE	USRWLD			;IF SIGN-BIT IS WILD,
	TXZ	T1,1B0			;MAKE POSITIVE FOR RANGE-CHECKS
	MOVEM	T1,PPNMAX		;SET UPPER LIMIT FOR GQSYNT
	JRST	.POPJ1			;RETURN SUCCESS

NAMSTR:	PUSHJ	P,NAMBLK		;GET THE NAME BLOCK FIRST
	  POPJ	P,			;PROPAGATE FAILURE
	PJRST	STRBLK			;THEN GET THE STRUCTURE BLOCK
; *** NOTE ***
; THE FOLLOWING CROCKS MAY BE REMOVED (ALONG WITH THE CALL TO P$INIT
; FROM NAMBLK) IF PULSAR EVER LOADS WITH THE OPRPAR.  UNTIL THEN, WE
; DUMMY UP A COUPLE OF SUBROUTINES TO SATISFY THE GLOBAL SYMBOL
; REQUESTS CAUSED BY LOADING THE ACTPRS MODULE OF ACTLIB.  OPRPAR IS
; TRUELY DISGUSTING AND OVERLY LARGE.  PULSAR SHOULD AVOID LOADING
; OPRPAR AT ALL COSTS.

WILDAC:	BLOCK	3			;TEMPORARY STORAGE FOR T1, T2 AND T3
P$INIT::DMOVEM	T1,WILDAC		;SAVE T1 AND T2
	MOVEM	T3,WILDAC+2		;SAVE T3
	POPJ	P,			;RETURN
P$USER::MOVEI	S1,.CMUSR		;PPN
	PUSHJ	P,OPRPAR		;CHECK IT OUT
	$RETIF				;GIVE UP
	MOVE	S1,ARG.DA(S2)		;FETCH PPN
	$RETT				;RETURN
P$FLD::	SKIPA	S1,[.CMFLD]		;FIELD
P$QSTR::MOVEI	S1,.CMQST		;QUOTED STRING
	PUSHJ	P,OPRPAR		;CHECK IT OUT
	$RETIF				;GIVE UP
	MOVE	S1,S2			;POINT TO DATA HEADER
	LOAD	S2,ARG.HD(S1),AR.LEN	;GET LENGTH
	$RETT				;RETURN

OPRPAR:	MOVE	TF,S1			;COPY FUNCTION CODE
	MOVE	S1,WILDAC		;COPY BLOCK TYPE
	MOVE	S2,WILDAC+2		;GET BLOCK ADDRESS
	SUBI	S2,ARG.DA		;BACK OFF TO START OF HEADER
	CAIE	TF,(S1)			;WHAT WE'RE LOOKING FOR?
	$RETF				;NO
	$RETT				;RETURN GOODNESS
SUBTTL	QUOTA processor -- Structure block parser

STRBLK:
	PUSHJ	P,GETBLK		;GET FIELD FROM COMMAND
	  PJRST	OPRERR			;FILE SKEW
STRB.1:
	CAIE	T1,.CMDEV		;DEVICE FIELD?
	PJRST	OPRERR			;FILE SKEW
	HRROI	S1,(T3)			;MAKE POINTER TO TEXT
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	JUMPF	OPRERR			;BETTER WORK
	LDB	S1,S1			;GET TERMINATING CHARACTER
	SKIPN	S1			;MUST BE END OF STRING
	TRNE	S2,7777			;STRUCTURES CAN ONLY BE 4 CHARACTERS
	JRST	STRB.2			;BAD STRUCTURE NAME
	JUMPE	S2,STRB.2		;SO IS NULL
	MOVEM	S2,STRUCT		;STORE STRUCTURE NAME
	;SETZM	STRCNT			;FOUND NO MATCHES YET
	MOVE	S1,[1,,S2]		;UUO ARG POINTER
	DSKCHR	S1,UU.PHY		;MAKE SURE IT'S A DISK
	  JRST	STRB.3			;IF SO, IT'S NOT MOUNTED
	LOAD	S1,S1,DC.TYP		;GET ARG TYPE
	CAXN	S1,.DCTFS		;FILE STRUCTURE NAME?
	SETOM	STRQUO			;YES, IT CAN BE USED FOR QUOTA.SYS
STRB.3:
	MOVE	S1,QC.PTR		;POINT TO CATLOG BLOCK
	QUEUE.	S1,			;VALIDATE THE STRUCTURE NAME
	  TRNA				;EXAMINE ERRORS
	JRST	STRB.4			;GO MARK IT VALID
	SKIPN	STRQUO			;VALID FOR QUOTA.SYS?
	JRST	STRB.2			;NO, NOT VALID AT ALL
	CAXE	S1,QUIAL%		;OLD MONITOR?
	CAXN	S1,QUILF%		; ...
STRB.4:	SETOM	STRAUX			;YES, ASSUME VALID FOR AUXACC AS WELL
	JRST	.POPJ1			;RETURN SUCCESS

STRB.2:
	$ERR	(<QUOTA command error>,<^T/TABTXT/Illegal structure name "^T/(T3)/">)
	POPJ	P,			;RETURN FAILURE
SUBTTL	QUOTA processor -- Validate a structure argument

STRVAL:
	SKIPN	STRUCT			;DO WE HAVE ONE?
	JRST	STRV.1			;NO, IT ISN'T VALID
	SKIPN	AUXAUX			;USING IT FOR AUXACC?
	JRST	STRV.2			;NO, CHECK QUOTA.SYS
	SKIPE	STRAUX			;YES, IS IT VALID THERE?
	JRST	.POPJ1			;YES, WIN
	$ERR	<QUOTA command error>,<^T/TABTXT/Foreign structure ^W/STRUCT/ cannot be placed in AUXACC>
	POPJ	P,			;NO, FAIL
STRV.1:
	$ERR	<QUOTA command error>,<^T/TABTXT/Null structure name is not valid>
	POPJ	P,			;GOT HERE WITH STRUCT ZERO?!?
STRV.2:
	SKIPE	STRQUO			;VALID QUOTA.SYS STRUCTURE?
	JRST	.POPJ1			;YES, WIN
QUOBAD:
	$ERR	<QUOTA command error>,<^T/TABTXT/Device ^W/STRUCT/ is not a currently mounted structure>
	POPJ	P,			;ERROR RETURN
SUBTTL	QUOTA processor -- Find a structure in the ACTDAE block

STRFND:
	MOVEI	T1,USRAUX		;POINT TO AUXACC STUFF
	MOVE	S1,STRUCT		;GET THE STRUCTURE TO MATCH ON
STRF.1:
	SKIPN	.AUSTR(T1)		;END OF BLOCK?
	POPJ	P,			;YES, QUIT
	CAMN	S1,.AUSTR(T1)		;NO, DOES IT MATCH?
	JRST	.POPJ1			;YES, WIN
	ADDI	T1,.AULEN		;NO, POINT TO NEXT BLOCK
	CAIGE	T1,USRAUE		;ARE WE OFF THE END?
	JRST	STRF.1			;NO, KEEP LOOKING
	POPJ	P,			;YES, RETURN FAILURE
SUBTTL	QUOTA processor -- Remove a structure from ACTDAE block

STRREM:
	CAIN	T1,USRAUL		;DELETING THE LAST ENTRY?
	JRST	STRR.2			;YES, DON'T BOTHER WITH THE BLT
	MOVSI	S2,.AULEN(T1)		;SOURCE POINTER
	HRRI	S2,(T1)			;MAKE XFER POINTER
	BLT	S2,USRAUL-1		;MOVE UP THE ENTRIES
STRR.2:
	SETZM	USRAUL			;CLEAR LAST ENTRY
	MOVE	S2,[USRAUL,,USRAUL+1]	; (XFER POINTER)
	BLT	S2,USRAUE-1		;BY STANDARD METHOD
	POPJ	P,			;RETURN TO CALLER
SUBTTL	QUOTA processor -- Add a structure to an ACTDAE block

;Call with T1 still set up from STRFND

STRADD:
	CAIL	T1,USRAUE		;OFF THE END?
	  POPJ	P,			;YES, FAIL
	MOVE	S1,STRUCT		;NO, GET STRUCTURE NAME
	MOVEM	S1,.AUSTR(T1)		;SET IN BLOCK
	MOVE	S1,AUXLIN		;LOGGED-IN QUOTA
	MOVEM	S1,.AULIN(T1)		;SET IN BLOCK
	MOVE	S1,AUXOUT		;LOGGED-OUT QUOTA
	MOVEM	S1,.AUOUT(T1)		;SET IN BLOCK
	MOVE	S1,AUXRES		;RESERVED QUOTA
	MOVEM	S1,.AURES(T1)		;SET IN BLOCK
	MOVE	S1,AUXBTS		;STATUS BITS
	MOVEM	S1,.AUBIT(T1)		;SAVE IN BLOCK
	CAIN	T1,USRAUL		;DOING LAST BLOCK?
	JRST	.POPJ1			;YES, NO NEXT TO CLEAR
	SETZM	.AULEN(T1)		;NO, CLEAR NEXT BLOCK
	MOVSI	S1,.AULEN(T1)		;GET SOURCE WORD
	HRRI	S1,.AULEN+1(T1)		;MAKE XFER WORD
	BLT	S1,.AULEN*2-1(T1)	;ENSURE A CLEAN TERMINATION BLOCK
	JRST	.POPJ1			;WIN
SUBTTL	Q$QOTA - Get a user's quota on a particular file structure

;This routine will find a given user's quota on
; a particular file structure.  The quota is obtained
; from the AUXACC file, and perhaps defaulted.
; If there is no exact or default entry in the AUXACC file, the
; file STR:QUOTA.SYS is check for exact or default match
;Call - 
;	S1/ SIXBIT structure name
;	S2/ PPN
;Returns - 
;	FALSE, quotas could not be found
;	TRUE,
;	S1/	reserved quota
;	S2/	First-Come, First-Served quota
;	T1/	Logged out quota

Q$QOTA::
	MOVEM	S1,STRUCT		;SAVE THE STRUCTURE
	MOVEM	S2,USRPPN		;AND THE PPN
	SETZM	USRWLD			;NOT WILD
	SETZM	WILDBK+UW$WST		;PPN, NOT NAME
	MOVEM	S2,WILDBK+UW$PPN	;SET PPN FOR ACTDAE
	SETOM	WILDBK+UW$PPM		;SCAN-STYLE WILDCARD MASK
	SETZM	WILDBK+UW$BRE		;NO PREVIOUS ENTRY
	SETOM	USRDFL			;ALLOW QUOTA DEFAULTING
	SETZM	COMPAT			;WE DON'T CARE ABOUT AUXACC
	PUSHJ	P,USRNXT		;TRY TO INIT THE SEARCH
	  SETZM	USRAUX+.AUSTR		;THIS ONE FAILS
	PUSHJ	P,GAUXNT		;TRY FOR AN AUXACC ENTRY
	  JRST	QOTA.1			;CAN'T, LOOK AT QUOTA.SYS
	MOVE	S2,.AULIN(T1)		;GET IN QUOTA
	MOVE	S1,.AURES(T1)		;GET RESERVED QUOTA
	MOVE	T1,.AUOUT(T1)		;GET OUT QUOTA
	$RETT				;RETURN WINNITUDE
QOTA.1:
	PUSHJ	P,QOTA.2		;CALL SUB-PROCESSOR
	SKIPN	QRDIFN			;ANYTHING TO CLEAN UP?
	POPJ	P,			;NO, JUST PROPAGATE THE T/F
	$SAVE	<TF,S1,S2,T1>		;YES, SAVE RETURN VALUES
	MOVE	S1,QRDIFN		;GET THE IFN TO CLOSE
	SETZM	QRDIFN			;ASSUME IT WILL SUCCEED
	PJRST	F%REL			;RELEASE AND RETURN THE SAVED VALUES
QOTA.2:
	$SAVE	<P1,P2,P3,P4>		;MIGHT NEED THEM
	PUSHJ	P,QRDINI		;TRY TO READ THE QUOTA.SYS
	  $RETF				;PROPAGATE FAILURE
	PUSHJ	P,GQSYNT		;GET THE ENTRY FROM QUOTA.SYS
	  $RETF				;PROPAGATE FAILURE
	$RETT				;AND SUCCESS
SUBTTL	QUOTA processor - Setup to read QUOTA.SYS

QRDINI:	PUSHJ	P,OQSYRD		;TRY TO OPEN IT FOR READING
	  POPJ	P,			;LET CALLER SORT IT OUT
	;MOVE	S1,QRDIFN		;IFN RETURNED IN S1
	$CALL	F%IBYT			;GET FIRST FILE WORD
	JUMPF	QRDERR			;COMPLAIN IF CAN'T
	HLRZ	T1,S2			;GET FILE VERSION NUMBER
	CAIE	T1,QUOVER		;IS IT WHAT WE EXPECT?
	JRST	QUOS.V			;NO, COMPLAIN
	HRRZ	T1,S2			;YES, GET ENTRY LENGTH
	CAIE	T1,4			;IS IT WHAT WE EXPECT?
	JRST	QUOS.L			;NO, COMPLAIN
	SETZM	CPYENT			;DON'T COPY NULL ENTRY
	MOVX	S2,.MINFI		;GET A SMALL NUMBER
	MOVEM	S2,PRVPPN		;STORE AS PREVIOUS PPN VALUE FOR READS
	JRST	.POPJ1			;WIN

;Here if the version # of the file is wrong
QUOS.V:	SETO	S2,			;Get real FD
	$CALL	F%FD			;Find the info
	PUSHJ	P,PIDHAK		;DO WTO FROM QUOTA'S PID
	$WTO (<Error reading ^F/0(S1)/>,<Format version number is ^O/T1/, Expected ^O/[QUOVER]/>,,$WTFLG(WT.SJI))
	PJRST	RETZER			;RETURN ZERO & FAIL

;Here if the entry length is wrong
QUOS.L:	SETO	S2,			;Get real FD
	$CALL	F%FD			;Find the info
	PUSHJ	P,PIDHAK		;DO WTO FROM QUOTA'S PID
	$WTO (<Error reading ^F/0(S1)/>,<Entry length is ^O/T1/, Expected 4>,,$WTFLG(WT.SJI))
	PJRST	RETZER			;RETURN ZERO & FAIL
SUBTTL	QUOTA processor -- Read an entry from QUOTA.SYS

;Assumes that QRDINI has been called (fails if not)
;If non-wild, assumes that no other RDQENTs have been done

GQSYNT:	SKIPN	S1,QRDIFN		;DO WE HAVE A FILE TO READ?
	  POPJ	P,			;NO, FAIL
	SETZM	DEFLIN			;NO DEFAULT ENTRY SEEN
	MOVE	S2,USRPPN		;PPN TO FIND
	HLLOM	S2,DEFPPN		;PROJECT DEFAULT PPN
	SKIPE	USRWLD			;IF WILDCARDING,
	CAMLE	S2,PRVPPN		;DO WE NEED TO BACK UP THE FILE?
	JRST	GQSY.2			;NO, SO DON'T
	SKIPN	COMPAT			;DO WE CARE ABOUT AUXACC?
	JRST	GQSY.2			;NO, USRPPN IS MEANINGLESS
	PUSHJ	P,CPYRST		;YES, RESET THE COPY OPERATION
	  POPJ	P,			;PROPAGATE FAILURE
GQSY.2:
	PUSHJ	P,RDQENT		;GET NEXT ENTRY FROM THE FILE
	  JRST	GQSY.4			;ANALYZE THE FAILURE
	MOVEM	P1,PRVPPN		;THIS IS THE LAST PPN WE FOUND
	SKIPN	USRWLD			;DEFAULT ONLY IF NON-WILD
	SKIPN	USRDFL			;DEFAULTING?
	JRST	GQSY.5			;NO, DON'T DEFAULT QUOTAS
	CAMN	P1,USRPPN		;FOUND OUR ENTRY?
	JRST	GQSY.3			;YES, DELIVER IT
	CAXE	P1,-1			;IS THIS THE MAGIC DEFAULT WORD?
	JRST	GQSY.3			;NO, TRY AGAIN
	MOVEM	S2,DEFLIN		;YES, SAVE LOGGED-IN DEFAULT
	MOVEM	T1,DEFOUT		;AND LOGGED-OUT DEFAULT
	JRST	GQSY.2			;AND LOOP FOR A REAL MATCH
GQSY.3:	CAMLE	P1,DEFPPN		;ARE WE OUT OF RANGE?
	JRST	GQSY.7			;YES, GIVE UP
	CAME	P1,USRPPN		;IS IT WHAT WE WANT?
	CAMN	P1,DEFPPN		;OR AN APPROXIMATION?
	JRST	.POPJ1			;YES, RETURN IT
	JRST	GQSY.2			;NO, LOOP FOR ANOTHER ENTRY
GQSY.4:	CAXN	S1,EREOF$		;IS THIS EOF?
GQSY.7:	SKIPN	S2,DEFLIN		;AND HAVE WE A DEFAULT?
	POPJ	P,			;NO, FAIL
	MOVE	T1,DEFOUT		;YES, GET OUT QUOTA
	SETO	P1,			;AND GET THE RIGHT PPN
	SETZ	S1,			;NO RESERVED QUOTA
	JRST	.POPJ1			;WIN
GQSY.5:
	SKIPN	WILDBK+UW$WST		;DOING A NAME?
	JRST	GQSY.6			;NO, HANDLE PPN
	CAMLE	P1,USRPPN		;MATCH?
	POPJ	P,			;NO, GIVE UP
	CAME	P1,USRPPN		;EXACT MATCH?
	JRST	GQSY.2			;NO, LOOP FOR NEXT
	JRST	.POPJ1			;YES, WIN
GQSY.6:
	MOVE	P2,P1			;COPY PPN FOUND
	IOR	P2,USRWLD		;INCLUDE WILD MASK
	CAMN	P2,USRBLK		;DOES IT WORK?
	JRST	.POPJ1			;YES, RETURN IT
	CAMGE	P1,PPNMAX		;NO, WILL IT EVER?
	JRST	GQSY.2			;MAYBE, LOOK AGAIN
	POPJ	P,			;NO, FAIL
SUBTTL	QUOTA processor - Error informants for QUOTA files

;This routine will tell the operator about the last file error.
;Call - 
;	S1/	IFN
;Returns -
;	FALSE, ALWAYS!

QRDERR:
	MOVE	S1,QRDIFN
	SETO	S2,			;Set to get the real FD
	$CALL	F%FD			;Get addr of this FD
	PUSHJ	P,PIDHAK		;DO WTO FROM QUOTA'S PID
	$WTO	(<Error reading ^F/0(S1)/>,<Reason: ^E/[-1]/>,,$WTFLG(WT.SJI))
	PJRST	RETZER			;RETURN ZERO & FAIL

QWTERR:
	MOVE	S1,QWTIFN
	SETO	S2,			;GET THE REAL FD
	$CALL	F%FD			;FROM GLXFIL
	PUSHJ	P,PIDHAK		;DO WTO FROM QUOTA'S PID
	$WTO	(<Error writing ^F/(S1)/>,<Reason: ^E[-1]>,,$WTFLG(WT.SJI))
	PJRST	RETZER			;RETURN ZERO

LISERR:
	MOVE	S1,LSTIFN		;LISTING FILE
	SETO	S2,			;TRUTH OR CONSEQUENCES
	$CALL	F%FD			;GET REAL FD
	$ERR	(<Error writing ^F/(S1)/>,<^T/TABTXT/Reason: ^E[-1]>)
	$RETF

LISOPN:
	$ERR	(<Error opening listing file ^F/LISFOB+FOB.FD/>,<^T/TABTXT/Reason: ^E/[-1]/>)
	$RETF

OPNERR:
	PUSHJ	P,PIDHAK		;DO WTO FROM QUOTA'S PID
	$WTO	(<Error opening ^F/QSYFDB/>,<Reason: ^E[-1]>,,$WTFLG(WT.SJI))
RETZER:
	SETZ	S1,			;RETURN ZERO IN S1
	$RETF
SUBTTL	QUOTA processor -- Get a quota entry from AUXACC

;Assumes USRNXT has been called.
;Does default-ppn processing.

GAUXNT:
	$SAVE	<P1>			;HOLD STARTING PPN
	MOVE	P1,USER+.AEDEF		;GET USER'S DEFAULT PROFILE POINTER
	MOVEM	P1,USRDEF		;SAVE FOR LATER TESTING
	MOVE	P1,USRPPN		;REMEMBER PPN WE STARTED WITH
GAUX.0:
	PUSHJ	P,STRFND		;FIND THE REQUESTED STRUCTURE
	  TRNA				;NOT HERE, TRY FOR DEFAULTING PPN'S
	JRST	.POPJ1			;FOUND ALREADY
GAUX.1:
	MOVE	S1,P1			;GET PPN OF THIS ENTRY
	CAXE	S1,-1			;IF ALREADY AT END,
	SKIPN	USRDFL			;OR NOT DEFAULTING,
	POPJ	P,			;FAIL
	HRRI	S1,-1			;MAKE PROJECT DEFAULT PPN
	SKIPE	USRDEF			;IF NON-STANDARD DEFAULTING,
	JRST	[CAME	P1,USRPPN		;YES, ONLY DEFAULT ONCE
		 POPJ	P,		;TOO MANY TRIES, GIVE UP
		 MOVE	S1,USRDEF	;GET DEFAULT PROFILE DESIRED
		 CAIN	S1,-1		;WANT NONE AT ALL?
		 POPJ	P,		;YES, DON'T DO IT
		 TLNE	S1,-1		;NO, HAVE AN EXPLICIT PPN?
		 JRST	.+1		;YES, GO CHECK IT
		 MOVS	S1,S1		;NO, PUT PROJECT IN CORRECT HALF
		 HRR	S1,P1		;GET PROGRAMMER NUMBER
		 JRST	.+1]		;CHECK IT OUT
	CAMN	S1,P1			;IF ALREADY TRIED THAT,
	SETO	S1,			;THEN TRY UNIVERSAL DEFAULT
	MOVE	P1,S1			;PRESERVE FROM MARAUDERS
	MOVEM	S1,WILDBK+UW$PPN	;UPDATE THE PPN
	SETOM	WILDBK+UW$PPM		;NOT WILD
	SETZM	WILDBK+UW$WST		;SET WILDCARD SEARCH TYPE TO PPN
	SETZM	WILDBK+UW$BRE		;NO PREVIOUS ENTRY
	PUSHJ	P,USRNXT		;FETCH PROFILE
	  JRST	GAUX.1			;NOT THERE, TRY NEXT DEFAULT
	JRST	GAUX.0			;GOT IT, TRY FOR QUOTAS AGAIN
SUBTTL	QUOTA processor -- Set up to modify a QUOTA.SYS

QMDINI:
	PUSHJ	P,QRDINI		;TRY TO READ FROM QUOTA.SYS
	  POPJ	P,			;PROPAGATE FAILURE
	$FALL	QWTINI			;THEN TRY TO WRITE IT

QWTINI:
	PUSHJ	P,OQSYWT		;OPEN QUOTA.SYS FOR WRITING
	  JRST	OPNERR			;CAN'T
	MOVX	S2,<QUOVER,,4>		;GET FORMAT WORD
	$CALL	F%OBYT			;WRITE IT
	JUMPF	QWTERR			;ERROR IF CAN'T
	JRST	.POPJ1			;WIN

CPYFIN:
	SKIPN	QWTIFN			;WRITING?
	JRST	QRDCLS			;NO, JUST CLOSE INPUT FILE
	SKIPN	QRDIFN			;MODIFYING?
	JRST	CPYF.2			;NO, JUST CREATING
CPYF.1:
	PUSHJ	P,RDQENT		;YES, GET NEXT ENTRY (WRITES LAST)
	  TRNA				;DONE AT EOF
	JRST	CPYF.1			;LOOP UNTIL THEN
	CAXE	S1,EREOF$		;HIT EOF?
	POPJ	P,			;NO, FAIL
CPYF.2:
	MOVE	S1,QWTIFN		;YES, GET OUTPUT IFN
	SETZM	QWTIFN			;NO LONGER WRITING
	$CALL	F%REL			;CLOSE THE FILE
	$RETIF				;GIVE UP IF FAILED
	$FALL	QRDCLS			;AND CLOSE THE INPUT FILE
QRDCLS:
	SKIPN	S1,QRDIFN		;GET INPUT IFN
	JRST	.POPJ1			;DONE ALREADY IF NOT THERE
	$CALL	F%REL			;CLOSE IT OUT
	SETZM	QRDIFN			;NO LONGER OPEN
	JRST	.POPJ1			;RETURN SUCCESS

CPYRST:
	SKIPN	QWTIFN			;DOING A MODIFY?
	JRST	CPYR.1			;NO, JUST RESET THE INPUT
	PUSHJ	P,CPYFIN		;YES, CLOSE OFF THE FILES
	  POPJ	P,			;PROPAGATE ERROR
	PJRST	QMDINI			;AND SET UP FOR MODIFY AGAIN
CPYR.1:
	SKIPN	S1,QRDIFN		;POINT TO INPUT FILE
	JRST	.POPJ1			;SUCCEED VACUOUSLY
	MOVEI	S2,1			;RE-POSITION TO FIRST DATA RECORD
	$CALL	F%POS			;GO THERE
	$RETIF				;FAIL IF CAN'T
	MOVX	S2,.MINFI		;THE INFAMOUS SMALL NUMBER
	MOVEM	S2,PRVPPN		;SO WE ONLY GET HERE ONCE
	JRST	.POPJ1			;WIN IF DID IT
SUBTTL	QUOTA processor -- Open QUOTA.SYS files

OQSYRD:	PUSHJ	P,OQSY.1		;SETUP FOB & FDB
	$CALL	F%IOPN			;LOOKUP THE FILE
	$RETIF				;PROPAGATE FAILURE
	MOVEM	S1,QRDIFN		;SAVE IFN FOR READS
	JRST	.POPJ1			;WIN

OQSYWT:	PUSHJ	P,OQSY.1		;SETUP FOB & FDB
	$CALL	F%OOPN			;ENTER THE FILE
	$RETIF				;PROPAGATE FAILURE
	MOVEM	S1,QWTIFN		;SAVE IFN FOR WRITES
	JRST	.POPJ1			;WIN

OQSY.1:	MOVE	S1,STRUCT		;GET SIXBIT STRUCTURE
	MOVEM	S1,QSYFDB+.FDSTR	;SET FOR OPEN
	DMOVE	S1,[EXP FOB.SZ,QSYFOB]	;POINT TO FILE OPEN BLOCK
	POPJ	P,			;RETURN TO DO RIGHT FLAVOR OF OPEN

QSYFDB:	$BUILD	(FDMSIZ)		;SIZE OF FDB
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;SETUP LENGTH
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	;NATIVE FILE SPEC
	  $SET	(.FDNAM,,'QUOTA ')	;FILENAME
	  $SET	(.FDEXT,,'SYS   ')	;EXTENSION
	$EOB				;END OF FDB

QSYFOB:	$BUILD	(FOB.SZ)		;SIZE OF FOB
	  $SET	(FOB.CW,FB.BSZ,^D36)	;FULLWORD I/O
	  $SET	(FOB.CW,FB.PHY,1)	;PHYSICAL-ONLY
	  $SET	(FOB.FD,,QSYFDB)	;POINT TO OUR FD
	  $SET	(FOB.AB,,QSYATB)	;ATTRIBUTES BLOCK
	$EOB				;END OF FOB

QSYATB:	EXP	3			;ONE VALUE + OVERHEAD
	FI.IMM!FLD(1,FI.LEN)!.FIPRO	;FILE PROTECTION
QSYPRT:	EXP	157			;FILLED IN WITH SYS:.SYS DEFAULT
SUBTTL	QUOTA processor -- Read one entry from QUOTA.SYS

RDQENT:
	SKIPE	QWTIFN			;IF WRITING,
	SKIPN	CPYENT			;AND SUPPOSED TO KEEP THIS ENTRY,
	JRST	RDQE.1			;(NO, DON'T)
	MOVE	P1,QNTPPN		;YES, GET THE PPN
	MOVE	T1,QNTOUT		;THE OUT QUOTA
	MOVE	T2,QNTRES		;AND THE RESERVED QUOTA
	MOVE	S2,QNTLIN		;AND THE IN QUOTA
	PUSHJ	P,WTQENT		;WRITE A QUOTA ENTRY
	  POPJ	P,			;PROPAGATE FAILURE
RDQE.1:
	SETOM	CPYENT			;COPY NEXT ENTRY ANYWAY
	MOVE	S1,QRDIFN		;GET OUR IFN
	$CALL	F%IBYT			;READ A WORD
	JUMPF	RDQE.2			;ANALYZE FAILURE
	MOVE	P1,S2			;SAVE PPN
	$CALL	F%IBYT			;GET NEXT WORD
	JUMPF	QRDERR			;COMPLAIN
	MOVE	T2,S2			;SAVE RESERVED QUOTA
	$CALL	F%IBYT			;GET NEXT WORD
	JUMPF	QRDERR			;COMPLAIN
	MOVE	T1,S2			;SAVE FCFS QUOTA
	$CALL	F%IBYT			;GET NEXT WORD
	JUMPF	QRDERR			;COMPLAIN IF CAN'T
	EXCH	S2,T1			;PUT OUTPUT QUOTA IN RIGHT PLACE
	JUMPE	P1,RDQE.1		;TRIM JUNK ENTRIES
	MOVEM	P1,QNTPPN		;PPN OF THIS QUOTA ENTRY
	MOVEM	S2,QNTLIN		;LOGGED-IN QUOTA
	MOVEM	T1,QNTOUT		;LOGGED-OUT QUOTA
	MOVEM	T2,QNTRES		;RESERVED QUOTA
	MOVE	S1,T2			;MOVE TO RETURN REGISTER
	JRST	.POPJ1			;RETURN SUCCESS
RDQE.2:
	CAXE	S1,EREOF$		;WAS THIS ERROR FOR EOF?
	PJRST	QRDERR			;ERROR IF NOT
	SETZM	CPYENT			;DON'T WANT TO WRITE AGAIN AFTER ALL
	POPJ	P,			;ELSE, JUST FAIL
SUBTTL	QUOTA processor -- Write an entry to QUOTA.SYS

WTQENT:
	MOVE	S1,QWTIFN		;GET OUR IFN
	EXCH	S2,P1			;SAVE IN QUOTA, MOVE PPN
	$CALL	F%OBYT			;WRITE THE PPN
	JUMPF	QWTERR			;ERROR IF CAN'T
	MOVE	S1,QWTIFN		;RESTORE IFN
	MOVE	S2,T2			;RESERVED QUOTA
	$CALL	F%OBYT			;WRITE VALUE
	JUMPF	QWTERR			;ERROR IF CAN'T
	MOVE	S1,QWTIFN		;RESTORE IFN
	MOVE	S2,P1			;GET FCFS QUOTA
	$CALL	F%OBYT			;WRITE TO FILE
	JUMPF	QWTERR			;ERROR IF CAN'T
	MOVE	S1,QWTIFN		;RESTORE IFN
	MOVE	S2,T1			;GET OUT QUOTA
	$CALL	F%OBYT			;WRITE IT OUT
	JUMPF	QWTERR			;ERROR IF CAN'T
	JRST	.POPJ1			;SUCCESS, RECORD WRITTEN
SUBTTL	IPCF interface -- Set up an ACK to an OPR command

;Call:	S1/ address of ITEXT block for the .ORDSP field

TXTACK:	MOVEM	S1,TXTFST		;SAVE FOR MESSAGE CONTINUATION CODE
	PUSHJ	P,OPRSET		;SETUP FOR .ORDSP
	MOVX	S1,WT.SJI!WT.NFO	;SUPPRESS JOB INFO, DON'T FORMAT OUTPUT
	MOVEM	S1,.OFLAG(M)		;SET IN OPR FLAGS OF MESSAGE
	MOVE	S1,TXTFST		;GET OUR ITEXT ADDRESS
	$TEXT	(TXTCHR,< ^I/(S1)/ ^0>)	;DUMP INTO MESSAGE (ASCIZ)
	$FALL	TXTNXT			;SETUP NEXT BLOCK AND RETURN

TXTNXT:
	PUSHJ	P,TXTFIN		;CLOSE OFF THE BLOCK, SETUP ADDR OF NEXT
	AOS	.OARGC(M)		;WE'RE ADDING ANOTHER ARG BLOCK
	MOVE	S1,MSGTXB		;GET ADDRESS FOR NEW BLOCK
	MOVX	S2,.CMTXT		;BLOCK TYPE
	STORE	S2,ARG.HD(S1),AR.TYP	;SAVE IN MESSAGE
	MOVEI	S2,ARG.DA(S1)		;WHERE DATA WILL GO
	TLO	S2,(POINT 7)		;MAKE BYTE POINTER
	MOVEM	S2,MSGTXP		;SAVE FOR TXTCHR
	SUBI	S1,-1(M)		;GET LENGTH OF MESSAGE SO FAR
	SUB	S1,MSGLEN		;-VE WORDS REMAINING
	IMULI	S1,5			;-VE BYTES REMAINING
	MOVNM	S1,MSGTXC		;SAVE CHARACTER COUNT FOR TXTCHR
	POPJ	P,			;RETURN

OPRSET:
	PUSHJ	P,SETMSG		;SETUP FOR A MESSAGE TO ORION
	MOVEI	S1,.OMACS		;OPERATOR ACK
	STORE	S1,.MSTYP(M),MS.TYP	;SET MESSAGE TYPE
	AOS	.OARGC(M)		;STARTING FIRST BLOCK
	MOVEI	S1,.ORDSP		;TYPE OF FIRST ARG BLOCK
	STORE	S1,.OHDRS(M),AR.TYP	;SET TYPE OF BLOCK
	MOVEI	S1,.OHDRS(M)		;START ADDRESS OF BLOCK
	MOVEM	S1,MSGTXB		;SAVE FOR LENGTH CALCULATION
	$CALL	I%NOW			;GET CURRENT DATE-TIME
	MOVE	S2,MSGTXB		;POINT TO ARG BLOCK
	MOVEM	S1,ARG.DA(S2)		;SAVE AS FIRST DATA WORD
	ADD	S2,[POINT 7,ARG.DA+1]	;MAKE TEXT POINTER FOR REMAINING WORDS
	MOVEM	S2,MSGTXP		;SAVE FOR TXTCHR
	MOVE	S1,MSGLEN		;GET REQUESTED LENGTH
	SUBI	S1,.OHDRS+ARG.DA+1	;ACCOUNT FOR OUR OVERHEAD WORDS
	IMULI	S1,5			;COMPUTE CHARACTER COUNT
	MOVEM	S1,MSGTXC		;SAVE FOR TXTCHR
	POPJ	P,			;RETURN TO CALLER
SUBTTL	IPCF interface -- Write characters into IPCF message

;Call:	From $TEXT, with MSGTXC & MSGTXP set up.
;	Light MSGTXF if writing a listing file but using the SHOW routines.

TXTCHR:
	SKIPE	MSGTXF			;DOING A LISTING?
	JRST	TXTLST			;YES
	SOSLE	MSGTXC			;COUNT DOWN (LEAVE ROOM FOR NUL)
	IDPB	S1,MSGTXP		;STORE CHARACTER
	$RETT				;RETURN

TXTLST:
	SKIPN	LSTIFN			;LISTING ERROR?
	$RETT				;YES, NO-OP
	PUSH	P,S2			;NO, SAVE S2
	MOVE	S2,S1			;GET CHARACTER
	SKIPG	LSTLPN			;INITIALIZED YET?
	JRST	TXTLS1			;NO, DO IT NOW
	CAIN	S2,.CHLFD		;LINEFEED?
	AOS	LSTLLN			;YES, INCREMENT LINE NUMBER
	MOVE	S1,LSTLLN		;GET LINE NUMBER
	CAIE	S1,LINPPG		;PAGE FULL?
	JRST	TXTLS2			;NOT YET
TXTLS1:
	PUSH	P,S2			;SAVE CHARACTER TO OUTPUT
	MOVEI	S2,.CHFFD		;GET A FORM FEED
	PUSHJ	P,TXTLSX		;OUTPUT IT
	  JRST	TXTLS4			;GIVE UP ON ERROR
	MOVEI	S2,1			;FIRST LINE
	MOVEM	S2,LSTLLN		;RESET LINE NUMBER
	AOS	LSTLPN			;INCREMENT PAGE NUMBER
	PUSHJ	P,LISTHD		;OUTPUT LISTING HEADER
	POP	P,S2			;RESTORE CHARACTER
	CAIN	S2,.CHLFD		;LINE FEED CAUSE NEW PAGE?
	JRST	TXTLS3			;YES, ALREADY HAVE NEW LINE
TXTLS2:
	PUSHJ	P,TXTLSX		;OUTPUT THE CHARACTER
	  TRN				;IGNORE ERRORS HERE
TXTLS3:
	POP	P,S2			;RESTORE S2
	$RETT				;AND RETURN
TXTLS4:
	POP	P,S2			;RESTORE CHARACTER
	POP	P,S2			;RESTORE ORIGINAL S2
	$RETT				;AND RETURN

TXTLSX:
	MOVE	S1,LSTIFN		;GET OUTPUT IFN
	$CALL	F%OBYT			;OUTPUT CHARACTER
	JUMPT	.POPJ1			;PROPAGATE SUCCESS
	PUSHJ	P,LISERR		;ANNOUNCE OUR LISTING FAILURE
	MOVE	S1,LSTIFN		;GET IFN AGAIN
	$CALL	F%REL			;CLOSE THE FILE
	SETZM	LSTIFN			;NO LONGER OPEN
	POPJ	P,			;RETURN FAILURE
SUBTTL	IPCF interface -- Finish off an OPR command ACK

;Call:	With (M) as a message setup via TXTACK and TXTCHR, and now
;	ready to be sent to the OPR
;
;Return +1 always, with the message overhead words correctly formatted for
;	sending to the OPR via ORION.

TXTDON:
	PUSHJ	P,TXTFIN		;CLOSE OFF THE TEXT BLOCK
	MOVE	S1,MSGTXB		;GET ENDING BLOCK POINTER
	SUBI	S1,(M)			;FIND TOTAL MESSAGE LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;SET IN MESSAGE
	POPJ	P,			;RETURN

TXTFIN:
	MOVEI	S1,.CHNUL		;GET FINAL NUL
	LDB	S2,MSGTXP		;GET LAST CHARACTER STORED
	SKIPE	S2			;IF NOT ALREADY NUL-TERMINATED,
	IDPB	S1,MSGTXP		;ENSURE PROPER MESSAGE TERMINATION
	MOVE	S1,MSGTXB		;GET POINTER TO CURRENT BLOCK
	AOS	S2,MSGTXP		;POINT ONE BEYOND LAST WORD WRITTEN
	HRRZM	S2,MSGTXB		;NEXT BLOCK TO USE IS AT THIS ADDRESS
	SUB	S2,S1			;GET LENGTH IN RH
	STORE	S2,ARG.HD(S1),AR.LEN	;STORE LENGTH IN BLOCK HEADER
	POPJ	P,			;RETURN
SUBTTL	IPCF interface -- Setup for a message

;Setup a message
;
;Call:	PUSHJ	P,SETMSG
;
;Return +1 always, with (M) a message address

SETMSG:	MOVEI	S1,PAGSIZ		;LENGTH
	MOVEM	S1,MSGLEN		;SAVE REQUESTED LENGTH
	MOVEI	M,MSG			;POINT TO OUR MESSAGE BLOCK
	TRNN	M,PAGSIZ-1		;ON A PAGE BOUNDARY?
	AOS	M			;YES, DON'T WANT TO IPCF IT AWAY
	MOVSI	S1,(M)			;SOURCE ADDRESS
	HRRI	S1,1(M)			;MAKE XFER WORD
	SETZM	(M)			;CLEAR FIRST WORD
	BLT	S1,PAGSIZ-1(M)		;SMEAR ZEROS AROUND BLOCK
	MOVE	S1,G$COD##		;GET ACK CODE
	MOVEM	S1,.MSCOD(M)		;SET IN MESSAGE
	POPJ	P,			;RETURN
SUBTTL	IPCF interface -- Send a canned ACK to an OPR

;Call:	only via $MESG macro and its clones
;
;Preserves S1

OPRACK:	PUSH	P,MSGTXF		;SAVE LISTING FLAG
	SETZM	MSGTXF			;THIS ACK IS NOT FOR THE LISTING FILE
	PUSH	P,S1			;SAVE A VALUE
	PUSHJ	P,OPRSET		;DO OPR MESSAGE SETUP
	MOVE	S1,(P)			;GET VALUE OFF THE STACK
	MOVE	S2,-2(P)		;GET RETURN ADDRESS
	MOVE	S2,1(S2)		;GET DISPLAY ITEXT BLOCK
	$TEXT	(TXTCHR,<^I/(S2)/^0>)	;STUFF INTO MESSAGE
	MOVE	S2,-2(P)		;GET RETURN ADDRESS
	SKIPN	S2,2(S2)		;GET TEXT ITEXT BLOCK
	JRST	OPRA.1			;NONE, DON'T BOTHER ME
	PUSH	P,S2			;SAVE ADDRESS
	PUSHJ	P,TXTNXT		;ADVANCE TO NEXT MESSAGE BLOCK
	POP	P,S2			;RESTORE ITEXT ADDRESS
	MOVE	S1,(P)			;GET VALUE (IN CASE REFERENCED)
	$TEXT	(TXTCHR,<^I/(S2)/>)	;STUFF THE STRING
OPRA.1:	MOVE	S2,-2(P)		;GET RETURN ADDRESS AGAIN
	MOVE	S1,3(S2)		;GET MESSAGE FLAGS
	MOVEM	S1,.MSFLG(M)		;SET THEM
	MOVE	S1,4(S2)		;GET OPR FLAGS
	MOVEM	S1,.OFLAG(M)		;SET THEM
	PUSHJ	P,OPRFIN		;BIND OFF & SEND MESSAGE
	POP	P,S1			;RESTORE REGISTER
	POP	P,MSGTXF		;RESTORE LISTING FLAG
	POPJ	P,			;RETURN TO CALLER

OPRFIN:	PUSHJ	P,TXTDON		;BIND OFF THE MESSAGE
	PJRST	SNDOPR			;SEND IT TO ORION
SUBTTL	IPCF interface -- Change default PID for I%WTO

PIDHAK:
	PUSH	P,S1			;SAVE A REGISTER
	PUSH	P,S2			;AND ANOTHER
	MOVEI	S1,PIB			;POINT TO OUR PID BLOCK
	$CALL	C%SPID			;SET QUOTA PID AS DEFAULT FOR I%WTO
	DMOVE	S1,-1(P)		;RESTORE ACS
	ADJSP	P,-2			;FIX STACK
	PUSHJ	P,@(P)			;CALL OUR CALLER
	  TRNA				;NON-SKIP
	AOS	-1(P)			;SKIP RETURN
	ADJSP	P,-1			;TRIM STACK
	$SAVE	<TF,S1,S2>		;SAVE ACS THAT GET CLOBBERED
	SETO	S1,			;DEFAULT-OF-DEFAULTS
	$CALL	C%SPID			;RESTORE DEFAULT TO STANDARD PULSAR PID
	$RET				;RETURN TF, ETC. OF CALLER
	END