Trailing-Edge
-
PDP-10 Archives
-
bb-bt99m-bb
-
plrquo.x19
There are no other files named plrquo.x19 in the archive.
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
INIT.1: MOVEI S1,SP.OPR ;PIDTAB INDEX
$CALL C%RPRM ;READ ORION'S PID
JUMPT INIT.2 ;ORION HAS STARTED
MOVEI S1,1 ;NOT THERE YET, WAIT A LITTLE
$CALL I%SLP ;GIVE IT SOME TIME TO START UP
JRST INIT.1 ;AND TRY FOR ORION AGAIN
INIT.2: SKIPE PIB+PB.PID ;IF NOT FIRST TIME,
JRST INIT.3 ;DON'T GET ANOTHER PID
DMOVE S1,[EXP PB.MNS,PIB] ;POINT TO PIB
$CALL C%CPID ;GET A PID
JUMPT INIT.3 ;ONWARD IF GOT IT
$WTO (<QUOTA error>,<PID creation error: ^E/S1/>,,$WTFLG(WT.SJI))
$RETF ;RETURN
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
MOVE S1,[.STPRV,,[EXP .STCPS,JP.ADM,JP.ADM]] ;GET UUO ARGS
SETUUO S1, ;TRY TO MAKE SURE OF ADMIN PRIVS
TRN ;HOPE FOR THE BEST
$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.1 ;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.1 ;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!.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