Trailing-Edge
-
PDP-10 Archives
-
BB-BT99T-BB_1990
-
10,7/acct/react.mac
There are 15 other files named react.mac in the archive. Click here to see a list.
TITLE REACT - PROGRAM TO MANIPULATE THE ACCOUNTING FILE
;COPYRIGHT (C) 1973,1978,1979,1980,1981,1984,1985,1986,1987,1990
;BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; THANKS GIVEN TO C.MORRISON AT THE UNIVERSITY OF TENNESSEE FOR A COPY
; OF HIS EDACT, WHICH PROVIDED INSPIRATION, EXAMPLES.
; VERSION NUMBERS
REAVER==33 ;VERSION NUMBER
REAMIN==2 ;MINOR VERSION NUMBER
REAEDT==246 ;EDIT NUMBER
REAWHO==0 ;WHO EDITED LAST
%%REAC==:<BYTE(3)REAWHO(9)REAVER(6)REAMIN(18)REAEDT>
SEARCH ACTPRM,ORNMAC
MODULE (REACT)
;THE OBLIGATORY .EXE FILE COPYRIGHT
COPYRIGHT (c) 1973,1990 DIGITAL EQUIPMENT CORPORATION. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
; LOOSE ENDS
REPEAT 0,<
1. ASK FOR PSW ON CHANGES BY UNPRIV'ED USERS
2. FIX UP PROCESSING OF DEFAULTED FIELDS. FETCH DEFAULT PROFILE
AND CALL A$PDEF.
3. SUPPORT NEW SELECT FUNCTIONS .GE. AND .LE. .
4. TEACH PURGE HOW TO ADD A SELECT BLOCK ON .AEEXP SO THAT WE
DON'T GET (SO MANY) UNEXPIRED ENTRIES BACK FROM A$QWLD
THAT WE JUST HAVE TO SKIP OVER.
5. ADD A /FAST (AND QUIET) SWITCH TO PURGE AND DELETE THAT WILL
PUT THE SELECT AND WILDCARD BLOCKS IN THE UGCUP$ LIST,
THUS AVOIDING THE EXTRA IPCF PER DELETE, BUT AT THE
EXPENSE OF LONGER ACTDAE PROCESSING TIME AND LESS
INDICATION OF WHAT WENT WRONG ON ERRORS. (OPTIONAL)
6. DO PASSWORD DEFAULTING (MUST STUFF DEFAULT PPN [SALT] IN
PROFILE).
7. ADD AN UNPRIV'ED TYPEOUT FLAG TO CONTROL WHICH FIELDS GET
DISPLAYED FOR UNPRIV'ED USERS.
>
SUBTTL TABLE OF CONTENTS
SUBTTL REVISION HISTORY
COMMENT |
200 Rewrite everything. REACT 33(200) and above must be used with
version 5 format of SYS:ACCT.SYS, now ACT:ACCT.ACT and ACTDAE
version 2(100) and later. /TARL
201 Add support for context and pid quotas.
12-Dec-84 /LWS
202 Add sub command mode for setting/clearing "TYPE of ACCESS". Add
LIST command when in one of the sub command modes. Make sure password
is set in account if specified by user.
26-Jan-85 /LWS
203 Add "multiple PPN" insert code. Add code to generate random password.
28-Jan-85 /LWS
204 Random bug fixes. Add "acks" when functions complete successfully
so user knows what is going on. Start fixing up UPDATE code.
1-Feb-85 /LWS
205 Finish making UPDATE code work. Add LOCK/UNLOCK commands. Remove
alot of IFDIEs, more still to go.
13-Feb-85 /LWS
206 Add REQUIRE command. Random bug fixes, more clean up.
7-Mar-85 /LWS
207 Fix device defaulting when specifying "program-to-run".
5-Apr-85 /LWS
210 Insert support for "distribution box" and "personal name".
RMS ACCT.ACT changes. /TL
211 Make UPDATE work with RMS. ACCT file is now SYS:ACTDAE.SYS in
RMS format. Will we ever make up our minds? /LWS
212 Include password block in UG.ADD message. ACTDAE now knows how
to deal with a password block and a profile block. Also,
when doing INSERT FOO=BAR, clear .AEFLG, .AEFAI, .AELPC, and
.AEPNM in FOO's new profile.
29-Apr-85 /LWS
213 Add new entry to PRTBTS, PRTBTX. If entered at PRTBTX,
don't type "-none-" if no bits typed.
QAR #868073 30-Apr-85 /LWS
214 Get rid of REEnter routine to set version. ACTRMS just needs
to be loaded before REACT. Don't allow non-alpha to be 1st
char of username. Allow trailing "]" to be omitted on INSERT
command.
13-May-85 /LWS
215 Correct size of FD blocks to be FDXSIZ instead of FDMSIZ.
23-Jul-85 /DPM
216 Fix up SPOOL and WATCH bit comparison routines to use the correct
AC when calling GENCMP.
23-Jul-85 /DPM
217 Add new options to allow a site to prohibit a user from changing
his password. Note that the system administrator can always
change the password.
23-Jul-85 /DPM
220 Allow REACT to be run by anyone with administrative privs (JP.ADM).
24-Jul-85 /DPM
221 Massive cleanup.
10-Aug-85 /DPM
222 Give up on trying to clean the thing up. Rewrite 95% of it.
Major changes include:
1. Use of wildcarding facilites in ACTDAE.
2. A little consistancy in the command syntax.
3. Make CHANGE smarter (wildcards, etc.).
4. Add HELP command and internal on-line documentation.
5. Remove PRINT command (see LIST).
6. Give all sub-command modes the same common commands.
7. Do nice things with customer-defined commands and
profile entries.
21-Aug-85 /DPM
223 Miscellaneous buggers. UPDATE still doesn't work.
6-Sep-85 /DPM
224 Make UPDATE work. Selective restore isn't implemented yet although
the command will accept a wildcarded user-id. Implement suggestion
to change name of UPDATE command to VERIFY since the command syntax
UPDATE/LIST-ONLY doesn't make a whole lot of sense.
225 Update to know about profile format version 6 and the corresponding
changes to UGCUP$.
19-Nov-85 /RCB
226 Fix some bugs in SELECT logic.
24-Nov-85 /RCB
227 Correctly delete extensible blocks rather than truncating them to
then to two words. Add the PURGE command that works like the old
REACT P command in days of old. Fix off-by-one bug in mail address
block length computation.
2-Dec-85 /DPM
230 Correct deficiencies with INSERT and CHANGE having to do with
defaulting of profiles and detecting which entries we really did
modify.
17-Jan-86 /RCB
231 Fix some bugs with SELECT, wildcard changes, and changes to .AEPCT
and .AEPRX.
7-Mar-86 /RCB
232 Fix up VERIFY for debugging.
7-Mar-86 /RCB
233 The special privilege fields (DSKPRI, HPQ, & OPR) could not be modified
in isolation, since they didn't SETOM @CHGADR. They do now.
14-Mar-86 /RCB
234 Add routine PROFSP which will correctly detect null filespec blocks.
Used by PRGGET routine (program to run).
18-Aug-86 /DPM
235 Fix more SELECT logic for bit-masked fields. If the bit mask shows that
no keywords were typed, don't insert the change block.
1-Dec-86 /RCB
236 Fix the automatic generation of passwords to finish the syllable rather
than simply truncating at the requested length. This way, maybe we can
restore the original goal of a pronouncable password.
1-Dec-86 /RCB
237 Change to use new STOPCD macro rather than old $STOP macro.
2-Dec-86 /RCB
240 Fix bug with VERIFY where an account is missing from the master file at
EOF. While both files should probably have had [%,%] records, we still
shouldn't loop trying to re-insert the last ppn that was in the file.
Besides, we were using signed comparisons on what RMS considers to be
unsigned keys, so even if both files had contained [%,%] records, we
would only have done stupid things if there was a discrepancy with
the last positive ppn.
While we're at it, display the right profile when one is missing from
the working file, and interpret the "NO" answer to "Preserve changes?"
as meaning not to preserve the deletion.
10-Feb-87 /RCB
241 Fix bug where short .AEAUX blocks (not even multiples of .AULEN) stay
short ever after, even if we want to modify the bits of the last str.
15-May-87 /RCB
242 Fix bug where a user's expiry date is printed incorrectly when
attempting to delete the profile, and the date is non-infinite.
18-Aug-87 /JJF SPR:35717
243 Correct problems with inserting PPNs with 1B18 turned on.
5-Jan-89 /DPM (SPR 10-35597)
244 Do not use %CNDAE for checking the monitor version; that is for
use only by DAEMON. Use %CNDVN instead.
29-Nov-89 /DPM
245 Rich tells me that if MX ever gets fixed to handle non-local forwarding
via .AEMAI that it will really want to see "user@node" rather than the
current "node::user", so fix how handle the entry. "node::user" will be
accepted, but converted to "user@node". "user@node" will also be valid
for typein.
246 Non-standard profile defaults cannot be assigned to accounts
where the project numbers differ (i.e. [10,56] cannot have a
profile default of [1,%]). Include CM%WLA in the parse block.
27-Mar-90 /DPM
02-Jan-90 /RCB
END REVISION HISTORY |
SUBTTL ASSEMBLY PARAMETERS
; ASSEMBLY PARAMETERS
XP PDLSIZ,400 ;SIZE OF STACK
XP ACTFMT,6 ;ACCOUNTING FILE FORMAT WE KNOW ABOUT
XP CATMAX,^D20 ;CATALOG RESPONSE BLOCK LENGTH
XP DEFPSZ,^D6 ;NUMBER OF CHARACTERS IN GENERATED PASSWORD
XP ZZTIME,^D60 ;MAXIMUM TIME TO WAIT FOR QUEUE. UUO RESPONSE
XP DEFPCI,^D365 ;MAXIMUM PASSWORD CHANGE INTERVAL
XP PTMHRS,1777B17 ;PRIME TIME HOURS
;WEEKDAYS 08-17
XP NPTHRS,<-1^!PTMHRS> ;NON-PRIME TIME HOURS
;WEEKDAYS 00-07, 18-23; WEEKENDS 00-23
XP ALLPRV,-1 ;DEFAULT PRIV WORD FOR ALL PRIVS
XP REMOPR,2 ;REMOTE OPERATOR PROGRAMMER NUMBER
XP SYSPRJ,10 ;PROJECT ALLOWED SYSTEM OPR PRIVS
XP HSTPRJ,30 ;PROJECT ALLOWED HOST OPR PRIVS
XP GLXPRJ,50 ;PROJECT NUMBER FOR GALACTIC WIZARDS
XP DEFQTA,^D1000 ;DEFAULT QUOTA
XP DEFQTO,DEFQTA ;DEFAULT 'OUT' QUOTA
XP STATBT,0 ;DEFAULT STRUCTURE STATUS BITS
SUBTTL LOWSEG
RELOC 0
PDL: BLOCK PDLSIZ ;STACK
UNPRIV::BLOCK 1 ;NON-ZERO FOR UNPRIV'ED USERS
MONVER::BLOCK 1 ;MONITOR VERSION
OLDMON::BLOCK 1 ;MONVER INDICATES NO QUEUE. UUO TIMEOUT SUPPORT
FFAPPN::BLOCK 1 ;[1,2]
MYPPN:: BLOCK 1 ;GETPPN RESULT
ALTRBK::BLOCK UW$MIN ;ALTERNATE WILDCARD BLOCK
ALTRAK::BLOCK .AANLW ;ALTERNATE ACK TEXT
ALTRBP::BLOCK 1 ;ALTERNATE BYTE POINTER TO ACK TEXT
ALTRPP::BLOCK 2 ;ALTERNATE WILD PPN BASE
WILDBK::BLOCK PAGSIZ ;WORKING WILDCARD BLOCK
WILDAK::BLOCK .AANLW ;WORKING ACK TEXT
SELPTR: BLOCK 1 ;AOBJN POINTER TO SELECTION BLOCK
ZBEG:!
INSFLG: BLOCK 1 ;NON-ZERO IF DOING INSERT
SELFLG: BLOCK 1 ;NON-ZERO IF BUILDING SELECTION CRITERIA
SELFNC: BLOCK 1 ;SELECT FUNCTION
PARBUF: BLOCK PAGSIZ ;SCRATCH BLOCK FOR PARSER
PARBLK: BLOCK PAR.SZ ;PARSER BLOCK
HELPBF: BLOCK <^D80/5>+1 ;TEMPORARY STORAGE FOR 80 CHARACTER HELP BANNER
LISTFL: BLOCK 1 ;LIST FLAG
LSTIFN: BLOCK 1 ;SAVED IFN FOR LIST FILE
PROARG: BLOCK 2 ;PROFILE COMMAND TABLE AND PROMPT
DEFUSR::BLOCK 5 ;DEFAULT USER-ID STRING
DEFTX1::BLOCK 5 ;DEFAULT TEXT STRING #1
DEFTX2::BLOCK 5 ;DEFAULT TEXT STRING #2
DEFTX3::BLOCK 5 ;DEFAULT TEXT STRING #3
PPNTXT: BLOCK 4 ;SCRATCH PAD STORAGE FOR ASCIZ PPN
STRNAM: BLOCK 1 ;STRUCTURE NAME FOR CATALOG
AUXBLK: BLOCK .AULEN ;AUXACC BLOCK FOR PARSER DEFAULTING
AUXPTR: BLOCK 1 ;AOBJN POINTER TO AUXBLK
AUXTMP: BLOCK .AUMAX+.AULEN ;[241] AUXACC STORAGE FOR ADD/REMOVE
WILDBP::BLOCK 1 ;WORKING BYTE POINTER TO ACK TEXT
WILDPP::BLOCK 2 ;WORKING WILD PPN BASE
DEFSRC: BLOCK 1 ;NON-ZERO IF DEFAULT PROFILE SEARCHING WANTED
DEFPPN: BLOCK 1 ;DEFAULT PPN FOUND FLAG
WLDINS: BLOCK 1 ;NON-ZERO IF WILDCARDED INSERT
PROFAI: BLOCK 1 ;COUNT OF PROCESSED PROFILE FAILURES
PROSUC: BLOCK 1 ;COUNT OF PROCESSED PROFILE SUCCESSES
QUEBLK: BLOCK .AEMAX ;GIVE ROOM FOR A PROFILE
QUEBLN==.-QUEBLK ;UUO BLOCK LENGTH (FOR QINIT)
QUEPTR: BLOCK 1 ;AOBJN POINTER FOR FILLING QUEBLK
RSPBLK: BLOCK .AEMAX ;RESPONSE BLOCK
CATACK: BLOCK CATMAX ;CATALOG RESPONSE BLOCK
PMRINC: BLOCK 1 ;PROGRAMMER NUMBER INCREMENT FOR INSERT
PMRCNT: BLOCK 1 ;COUNT OF PPN'S TO GENERATE
PMRPRT: BLOCK 1 ;PROMPT FOR USER NAME FLAG ON WILD INSERT
PMRPSW: BLOCK 1 ;PROMPT FOR PASSWORD FLAG ON WILD INSERT
PMRPWD: BLOCK 1 ;DEFAULT PASSWORD IF NON-ZERO
DELASK: BLOCK 1 ;FLAG FOR CONFIRM ON DELETE
EXPDTM: BLOCK 1 ;EXPIRATION DATE/TIME FOR PURGE COMMAND
FDBLK:: BLOCK FDXSIZ ;RANDOM FD FOR PROFILE ENTRY PROCESSING
SWTTAB:! ;SWITCH STORAGE TABLE
SWTASK: BLOCK 1 ;/ASK
SWTDET: BLOCK 1 ;/DETAIL /FAST
SWTCLR: BLOCK 1 ;/CLEAR
SWTRPT: BLOCK 1 ;/REPORT
SWTUPD: BLOCK 1 ;/UPDATE
SWTLEN==.-SWTTAB ;LENGTH OF TABLE
FNASIZ==<<<6+1+6+1+3+1+6+1+6>+<5*<6+1>+1>>/5>+1
MASTFN: BLOCK FNASIZ ;MASTER FILE NAME
WORKFN: BLOCK FNASIZ ;WORKING FILE NAME
TEMPFN: BLOCK FNASIZ ;TEMPORARY FILE NAME
MASTFD: BLOCK FDXSIZ ;MASTER FILE NAME
WORKFD: BLOCK FDXSIZ ;WORKING FILE NAME
TEMPFD: BLOCK FDXSIZ ;TEMPORARY FILE NAME
MASTWB: BLOCK UW$MIN ;MASTER WILDCARD BLOCK
WORKWB: BLOCK UW$MIN ;WORKING FILE WILDCARD BLOCK
TEMPWB: BLOCK UW$MIN ;TEMPORARY FILE WILDCARD BLOCK
MASTEF: BLOCK 1 ;MASTER FILE EOF FLAG
WORKEF: BLOCK 1 ;WORKING FILE EOF FLAG
VERRFB: BLOCK FOB.SZ ;A FOB FOR READING
VERWFB: BLOCK FOB.SZ ;A FOB FOR WRITING
VERALL: BLOCK 1 ;NON-ZERO IF VERIFYING ALL PROFILES
VERDIF: BLOCK 1 ;NON-ZERO IF VERIFY ENCOUNTERED DIFFERENCES
VERABO: BLOCK 1 ;NON-ZERO IF VERIFY ABORTED
ZEND:!
ZSIZ==.-ZBEG
CMDPTR: BLOCK 1 ;ADDRESS OF COMMAND TABLE
CMDKEY: BLOCK PB%SIZ ;PARSER BLOCK (KEYWORDS)
CMDHLP: BLOCK PB%SIZ ;PARSER BLOCK (HELP)
ENTKPT::BLOCK 1 ;ADDRESS OF PROFILE ENTRY TABLE
ENTHPT::BLOCK 1 ;ADDRESS OF PROFILE HELP TABLE
ENTKEY::BLOCK PB%SIZ ;PARSER BLOCK (KEYWORDS)
ENTDEF::BLOCK PB%SIZ ;PARSER BLOCK ("DEFAULT")
ENTHLP::BLOCK PB%SIZ ;PARSER BLOCK ("HELP")
ENTRST::BLOCK PB%SIZ ;PARSER BLOCK ("RESTORE")
ENTSLC::BLOCK PB%SIZ ;PARSER BLOCK ("SELECT")
CHGCTR::BLOCK 1 ;CHANGE TABLE WORD COUNT
CHGPTR::BLOCK 1 ;CHANGE TABLE ADDRESS
CHGADR::BLOCK 1 ;CHANGE TABLE INDEX FOR CURRENT PROFILE ENTRY
CHGMSK::BLOCK .AEMIN ;BLOCK OF CHANGE FLAGS
CHGMS2: BLOCK .AEMIN ;COPY OF CHGMSK DURING PROUPD
PRSDFV::BLOCK 1 ;LOCATION TO TWEAK FOR CG.DFL CALLS
MAICNT: BLOCK 1 ;MAILING ADDRESS BYTE COUNT
MAIPTR: BLOCK 1 ;MAILING ADDRESS BYTE POINTER
TEMP: BLOCK .AEMAX ;TEMPORARY PROFILE STORAGE
USER: BLOCK .AEMAX ;CURRENT USER'S PROFILE
USER2: BLOCK .AEMAX ;DEFAULT USER'S PROFILE
USER0: BLOCK .AEMAX ;PROFILE TO SETUP .AEMAP CORRECTLY
PASSHD: BLOCK ARG.DA ;PARSER DATA BLOCK HEADER
PASSWD: BLOCK .APWLW ;PASSWORD
ROOT: BLOCK 1 ;RANDOM NUMBER GENERATOR SEED
RESPPN: BLOCK 1 ;RESERVED PROFILE BEING INSERTED
DEBUGQ: BLOCK 1 ;DON'T TIME OUT QUEUE. UUOS
ACTPID: BLOCK 1 ;PID TO STUFF INTO .QUPID WHEN DEBUGGING
QUETMP: BLOCK 2 ;BI-WORD FOR QUECHG TO INSERT MASKED VALUES
RELOC ;BACK TO HISEG
PDLPTR: IOWD PDLSIZ,PDL ;STACK POINTER
IB: $BUILD (IB.SZ) ;SIZE OF INIIALIZATION BLOCK
$SET (IB.PRG,,%%.MOD);PROGRAM NAME
$SET (IB.OUT,,OUTLST);TERMINAL OUTPUT
$SET (IB.FLG,IT.OCT,1);REQUIRE COMMAND TERMINAL
$SET (IB.FLG,IB.NPF,1);NO TIMER TRAPS!!!
$EOB
LST: $BUILD (FOB.SZ) ;SIZE OF FILE OPEN BLOCK
$SET (FOB.CW,FB.BSZ,7);BYTE SIZE IS ASCII
$EOB ;END OF BLOCK
;FD's for current ACCT file and temp ACCT file for VERIFY command
CURFD: $BUILD (FDXSIZ)
$SET (.FDLEN,FD.LEN,FDXSIZ) ;SIZE OF FD
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE FILESPEC
$SET (.FDSTR,,SIXBIT\SYS\) ;"SYS:ACTDAE.SYS"
$SET (.FDNAM,,SIXBIT\ACTDAE\)
$SET (.FDEXT,,SIXBIT\SYS\)
$EOB
TMPFD: $BUILD (FDXSIZ)
$SET (.FDLEN,FD.LEN,FDXSIZ) ;SIZE OF FD
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE FILESPEC
$SET (.FDSTR,,SIXBIT\DSK\) ;"DSK:REACT.TMP"
$SET (.FDNAM,,SIXBIT\REACT\)
$SET (.FDEXT,,SIXBIT\TMP\)
$EOB
; USER NAME BREAK MASK
NAMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777554,,001750 ;ALLOW * - ? AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
; PASSWORD BREAK MASK
PSWBRK: 777777,,777760 ;BREAK ON ALL CONTROL
000000,,000000 ;ALLOW ALL PUNCTUATION AND DIGITS
000000,,000000 ;ALLOW UC A-Z
000000,,000000 ;ALLOW LC A-Z
; TEXT BREAK MASK FOR UNQUOTED STRINGS
TXTBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777754,,001760 ;ALLOW - AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
; ARBITRARY NODE NAME BREAK MASK
NNMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777744,,001760 ;ALLOW - AND . AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
;SET TO DEFINE THE TABLE USED TO QUEUE THE CHANGES FOR ACTDAE
DEFINE AE (NAM,LEN,BITS,RTN),<IFN <LEN>,<EXP .AE'NAM>>
QUETAB: AEPROF
QUETBL==.-QUETAB ;LENGTH OF TABLE
PURGE AE ;DUMP THE SYMBOL TABLE SPACE
;Tables describing the format of USER. Byte pointers defined where
;appropriate, offsets defined elsewhere.
;
;The use of these values is entirely voluntary, but highly recommended so
;as to provide a single place to change when fiddling with formats.
USRNAM: POINT 8,.AENAM(U) ;INITIAL BPT TO USERNAME
USRNM2: POINT 8,.AENAM(X) ;ALTERNATE NAME (USED DURING BACKUP)
CORPHY: POINTR .AECOR(U),AE.NPP ;PHYSICAL CORE LIMIT
CORVRT: POINTR .AECOR(U),AE.NVP ;VIRTUAL CORE LIMIT
IPCFS: POINTR .AEIPC(U),AE.SND ;IPCF SEND QUOTA
IPCFR: POINTR .AEIPC(U),AE.RCV ; RECEIVE QUOTA
IPCFP: POINTR .AEIPC(U),AE.PID ; MAXIMUM NUMBER OF PIDS
CTXCNQ: POINTR .AECTX(U),AE.CNQ ;MAXIMUM NUMBER OF CONTEXTS
CTXCPQ: POINTR .AECTX(U),AE.CPQ ;MAXIMUM NUMBER OF IDLE CONTEXT PAGES
SCHED: POINTR .AESCD(U),AE.SCD ;SCHEDULAR TYPE
NONE7:: ASCIZ /-none-/
NONE8:: BYTE(8) "-","n","o","n","e","-",0
SUBTTL PROGRAM INITIALIZATION
LOC 137
EXP <%%REAC==:%%REAC>
RELOC
REACT: JFCL ;NO CCL
RESET ;CLEAR THE WORLD'S STATUS
MOVE P,PDLPTR ;GET POINTER TO PUSH DOWN LIST
MOVEI S1,IB.SZ ;SIZE OF IB
MOVEI S2,IB ;POINTER TO INITIALIZATION BLOCK
PUSHJ P,I%INIT## ;INITIALIZE GLXLIB
MOVEI S1,'REA' ;REACT PREFIX
MOVEI S2,0 ;NO ERROR SUBROUTINE
PUSHJ P,A$ERRI## ;INIT ERROR PROCESSOR
SETZB S1,S2 ;NO TIMER TRAPS
PUSHJ P,P$INIT## ;INITIALIZE PARSER
MOVE T1,[%CNDVN] ;GETTAB ARGUMENT
GETTAB T1, ;GET MONITOR VERSION
SETZ T1, ;ANCIENT MONITOR
LDB T1,[POINT 9,T1,11] ;GET MONITOR VERSION
MOVEM T1,MONVER ;SAVE MONITOR VERSION
CAIGE T1,703 ;IS IT A MONITOR WITH QUEUE. UUO TIMEOUTS?
SETOM OLDMON ;NO, FLAG THE DEFICIENCY
SETOM UNPRIV ;ASSUME AN UNPRIVILEGED USER
MOVE T1,[%LDFFA] ;ARGS
GETTAB T1, ;GET FFA PPN
MOVE T1,[1,,2] ;DEFAULT
MOVEM T1,FFAPPN ;SAVE FOR LATER PRIV TESTS
HRROI T2,.GTPPN ;ARGS
GETTAB T2, ;GET OUR PPN
SETZ T2, ;???
MOVEM T2,MYPPN ;SAVE FOR LATER USE
HRROI T3,.GTPRV ;ARGS
GETTAB T3, ;GET OUR PRIV WORD
SETZ T3, ;???
; CAME T1,T2 ;FULL FILE ACCESS?
TXNE T3,JP.ADM ; OR ADMINISTRATIVE PRIVS?
SETZM UNPRIV ;ALLOW ACCESS TO PRIV'ED KEYWORDS
PUSHJ P,CMDINI ;INITIALIZE COMMAND TABLE
PUSHJ P,ENTINI ;INITIALIZE PROFILE ENTRY TABLE
SETZM USER0 ;CLEAR A WORD
MOVE S1,[USER0,,USER0+1] ;TRANSFER WORD
BLT S1,USER0+.AEMAX-1 ;CLEAR OUT PROTOTYPE PROFILE
MOVX S1,FLD(ACTFMT,AE.VRS)!FLD(.AEMIN,AE.LEN) ;GET OVERHEAD WORD
MOVEM S1,USER0+.AEVRS ;SET IT UP
SETOM USER0+.AEMAP ;START OFF WITH ALL DEFAULTS
MOVE S1,[USER0+.AEMAP,,USER0+.AEMAP+1] ;DITTO
BLT S1,USER0+.AEMAP+.AMPLW-1 ;SMEAR SOME BITS
MOVEI T1,USER0 ;POINT TO PROFILE TO USE
MOVEI T2,USER0 ;SOURCE & DESTINATION
PUSHJ P,A$PDEF## ;MAKE THE BITS BE CONSISTENT WITH CHGTAB
MOVEI S1,SP.ACT ;ACTDAE'S SYSTEM PID INDEX
$CALL C%RPRM ;GET ITS PID
MOVEM S1,ACTPID ;SAVE FOR .QUPID
PUSHJ P,SELINI ;INITIALIZE SELECTION AOBJN POINTER
JRST MAIN ;GO ENTER TOP LEVEL COMMAND LOOP
CMDINI: PUSHJ P,.SAVE1 ;SAVE P1
HLRZ S1,CMDDEC ;GET COUNT OF DEC-DEFINED COMMANDS
HLRZ S2,CMDCUS## ;GET COUNT OF CUSTOMER-DEFINED COMMANDS
SKIPN UNPRIV ;UNPRIV'ED USER?
JRST CMDIN1 ;NO
HLRZ S1,CMDDUP ;GET COUNT OF DEC-DEFINED COMMANDS
HLRZ S2,CMDCUP## ;GET COUNT OF CUSTOMER-DEFINED COMMANDS
CMDIN1: ADDI S1,1(S2) ;TOTAL THEM UP
PUSHJ P,M%GMEM ;GET SOME CORE
MOVEM S2,CMDPTR ;SAVE FOR PARSING
SUBI S1,1 ;DON'T COUNT THE OVERHEAD WORD
MOVEM S1,@CMDPTR ;SAVE WORD COUNT TOO
MOVEI P1,CMDDUP ;POINT TO DEC-DEFINED UNPRIV'ED TABLE
SKIPN UNPRIV ;TEST
MOVEI P1,CMDDEC ;POINT TO DEC-DEFINED PRIV'ED TABLE
PUSHJ P,CMDIN2 ;LOAD WORKING COMMAND TABLE
MOVEI P1,CMDCUP## ;POINT TO CUSTOMER-DEFINED UNPRIV'ED TABLE
SKIPN UNPRIV ;TEST
MOVEI P1,CMDCUS## ;POINT TO CUSTOMER-DEFINED TABLE
CMDIN2: HLRZ S1,(P1) ;GET NUMBER OF ENTRIES IN TABLE
JUMPE S1,.RETT ;RETURN IF TABLE IS EMPTY
MOVNS S1 ;NEGATE
HRL P1,S1 ;GET -LENGTH
HRRI P1,1(P1) ;MAKE AN AOBJN POINTER
CMDIN3: MOVE S1,CMDPTR ;POINT TO TABLE HEADER
MOVE S2,(P1) ;GET KEYWORD ADDRESS
PUSHJ P,S%TBAD ;INSERT INTO TABLE
SKIPT ;CHECK FOR ERRORS
STOPCD (CIF,HALT,,<Command table initialization failure>)
AOBJN P1,CMDIN3 ;LOOP
MOVE S1,[CMDKBK,,CMDKEY] ;SET UP BLT
BLT S1,CMDKEY+PB%SIZ-1 ;COPY
MOVE S1,CMDPTR ;GET TABLE ADDRESS
MOVEM S1,CMDKEY+1+.CMDAT ;SAVE
MOVE S2,[CMDHBK,,CMDHLP] ;SET UP BLT
BLT S2,CMDHLP+PB%SIZ-1 ;COPY
MOVEM S1,CMDHLP+1+.CMDAT ;UPDATE WITH CORRECT TABLE ADDRESS
$RETT ;AND RETURN
; DUMMY PARSER DATA BLOCK FOR COMMANDS
CMDKBK: $KEYDSP (.)
BLOCK PB%SIZ-<.-CMDKBK>
; DUMMY PARSER DATA BLOCK FOR HELP
CMDHBK: $KEY (CONFRM,.,<$ALTER(CONFRM)>)
BLOCK PB%SIZ-<.-CMDHBK>
SUBTTL COMMAND PROCESSING -- MAIN - TOP LEVEL DISPATCH
MAIN: MOVE P,PDLPTR ;GET STACK POINTER
SETZM ZBEG ;CLEAR A WORD
MOVE S1,[ZBEG,,ZBEG+1] ;XFER VECTOR
BLT S1,ZEND-1 ;CLEAR THE ZEROABLE STORAGE
MOVEI S1,CMDTAB ;PARSER TABLE
MOVEI S2,[ASCIZ \REACT>\] ;PROMPT STRING
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF MAIN ;IF FAILS, TRY AGAIN
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,(S1) ;DISPATCH
JRST MAIN ;AND DO IT AGAIN
SUBTTL COMMAND PROCESSING -- CMDDEC - DEC-DEFINED COMMAND TABLES
; PRIVILEGED ADMINISTRATIVE COMMANDS
CMDDEC: $STAB
DSPTAB ( ,CTRLZ ,\"32,CM%INV)
DSPTAB (CHAN00,CHANGE,<CHANGE>)
DSPTAB (DELE00,DELETE,<DELETE>)
DSPTAB (EXIT00,EXIT ,<EXIT>)
DSPTAB (HELP00,HELP ,<HELP>)
DSPTAB (INSE00,INSERT,<INSERT>)
DSPTAB (LIST00,LIST ,<LIST>)
DSPTAB (LOCK00,LOCK ,<LOCK>)
DSPTAB (SELE00,SELECT,<SELECT>)
DSPTAB (SHOW00,SHOW ,<SHOW>)
DSPTAB (PURG00,PURGE ,<PURGE>)
DSPTAB (LOCK00,UNLOCK,<UNLOCK>)
DSPTAB (VERI00,VERIFY,<VERIFY>)
$ETAB
; UNPRIVILEGED USER COMMANDS
CMDDUP: $STAB
DSPTAB ( ,CTRLZ ,\"32,CM%INV)
DSPTAB (CHAN00,CHANGE,<CHANGE>)
DSPTAB (EXIT00,EXIT ,<EXIT>)
DSPTAB (HELP00,HELP ,<HELP>)
DSPTAB (LIST00,LIST ,<LIST>)
DSPTAB (SHOW00,SHOW ,<SHOW>)
$ETAB
; GENERIC USER-ID PARSER DATA BLOCKS
USR000::$INIT (USR010)
USR010: $NOISE (USR020,<user-id>)
USR020: $USER (CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(USR030)>)
USR030: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(USR040)>)
USR040: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
; ACTION ROUTINE CALLED TO DETERMINE IF USER THE THE OPERATOR
; AND SUPPLY THE APPROPRIATE DEFAULTS FOR A USER-ID
USRACT::DMOVE S1,[ASCIZ /[*,*]/] ;ASSUME OPERATOR
DMOVEM S1,DEFUSR ;SAVE FOR PARSER
MOVE S2,MYPPN ;FETCH OUR PPN
CAMN S2,FFAPPN ;ARE WE THE OPERATOR?
$RETT ;YES--DONE
MOVEI S1,[ITEXT (<[*,^O/S2,RHMASK/]>)] ;ASSUME INDPPN OFF
MOVE TF,[%CNSTS] ;GETTAB ARGUMENT
GETTAB TF, ;FETCH WORD
SETZ TF, ;SICK MONITOR
TXNE TF,ST%IND ;INDPPN TURNED ON?
MOVEI S1,[ITEXT (<^U/S2/>)] ;YES
$TEXT (<-1,,DEFUSR>,<^I/(S1)/^0>) ;GENERATE DEFAULT STRING
$RETT ;NO
CMDTAB: $INIT (CMDKEY,<$ACTION (USRACT)>)
CHAN00: $NOISE (CHAN01,<user-id>)
CHAN01: $USER (CONFRM,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(CHAN05)>)
CHAN05: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(CHAN10)>)
CHAN10: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
DELE00: $NOISE (DELE01,<user-id>)
DELE01: $USER (DELE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(DELE05)>)
DELE05: $QUOTE (DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(DELE10)>)
DELE10: $FIELD (DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
DELE15: $SWITCH (CONFRM,DELE20,<$ALTER (CONFRM)>)
DELE20: $STAB
KEYTAB (1,<ASK>)
KEYTAB (0,<NOASK>)
$ETAB
CONFRM::!
EXIT00: $CRLF
HELP00: $NOISE (CMDHLP,<with>)
INSE00: $NOISE (INSE01,<new user-id>)
INSE01: $USER (INSE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(INSE05)>)
INSE05: $QUOTE (INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE10)>)
INSE10: $FIELD (INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
INSE15: $TOKEN (INSE20,<=>,<$ALTER (CONFRM)>)
INSE20: $USER (CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(INSE25)>)
INSE25: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE30)>)
INSE30: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
LIST00: $NOISE (LIST01,<user-id>)
LIST01: $USER (LIST15,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(LIST05)>)
LIST05: $QUOTE (LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(LIST10)>)
LIST10: $FIELD (LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
LIST15: $NOISE (LIST20,<to file>)
LIST20: $OFILE (LIST25,<listing filespec>,<$DEFAULT (<DSK:ACCT.LST>)>)
LIST25: $SWITCH (CONFRM,LIST30,<$ALTER (CONFRM)>)
LIST30: $STAB
KEYTAB (0,<DETAIL>)
KEYTAB (1,<FAST>)
$ETAB
LOCK00: $NOISE (CONFRM,<user account file>)
SELE00: $NOISE (SELE10,<profile criteria>)
SELE10: $SWITCH (CONFRM,SELE20,<$ALTER (CONFRM)>)
SELE20: $STAB
KEYTAB (0,<CLEAR>)
$ETAB
SHOW00: $NOISE (SHOW01,<user-id>)
SHOW01: $USER (LIST25,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(SHOW05)>)
SHOW05: $QUOTE (LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(SHOW10)>)
SHOW10: $FIELD (LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
PURG00: $NOISE (PURG01,<user-id>)
PURG01: $USER (CONFRM,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(PURG05)>)
PURG05: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(PURG10)>)
PURG10: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
VERI00: $NOISE (VERI05,<file from>)
VERI05: $FILE (VERI10,<master file>,$DEFAULT(<DSK:MASTER.SYS>))
VERI10: $NOISE (VERI15,<for users>)
VERI15: $USER (VERI30,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(VERI20),$DEFAULT(<[*,*]>)>)
VERI20: $QUOTE (VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(VERI25)>)
VERI25: $FIELD (VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
VERI30: $SWITCH (NEXT,VERI35,<$ACTION(SHRSWT),$ALTER(CONFRM)>)
VERI35: $STAB
KEYTAB (<[0,,SWTRPT]>,<NOREPORT>)
KEYTAB (<[0,,SWTUPD]>,<NOUPDATE>)
KEYTAB (<[1,,SWTRPT]>,<REPORT>)
KEYTAB (<[1,,SWTUPD]>,<UPDATE>)
$ETAB
SUBTTL CHANGE COMMAND
XWD CHGHLP,[ASCIZ /Change profile entries/]
CHANGE: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,PROZCH ;CLEAR OUT CHANGE FLAG TABLE
PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;IF NOT THERE, MERELY RETURN
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
JUMPF CHANG1 ;JUMP IF NOT
MOVEI X,USER2 ;USER2 WILL CONTAIN THE CHANGED DATA
MOVE U,X ;SET UP WORKING PROFILE POINTER
HLRE S1,WILDBK+UW$PPM ;GET PROJECT MASK
CAME S1,[EXP -1] ;WILD?
TDZA S1,S1 ;YES--USE SYSTEM DEFAULT PPN
MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(U) ;STORE IN PROFILE
SKIPN UNPRIV ;DON'T DEFAULT PROFILE UNLESS PRIV'ED
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE
MOVSI S1,(U) ;GET ADDR
HRRI S1,1(U) ;MAKE A BLT POINTER
SETZM (U) ;CLEAR FIRST WORD
BLT S1,.AEMAX-1(U) ;CLEAR OUT BLOCK
MOVE S1,[ACTFMT,,.AEMIN] ;SETUP OVERHEAD WORD
MOVEM S1,.AEVRS(U) ;SO EXTENSIBLE BLOCKS WORK
$TEXT (,< Enter all data to be changed>)
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
SETOM INSFLG ;ALL CHANGES ARE SIGNIFICANT HERE
PUSHJ P,PROFIL ;BUILD PROTOTYPE BLOCK
SETZM INSFLG ;NO LONGER DOING SOMETHING STRANGE
$RETIF ;CHECK FOR ERRORS
MOVEI U,USER ;SET UP WORKING PROFILE POINTER
CHANG1: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF CHANG5 ;JUMP IF NO MORE PROFILES
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
JUMPT CHANG2 ;DON'T PROMPT FOR EACH PROFILE
PUSHJ P,PROZCH ;ZERO CHANGE TABLE
MOVE S1,[USER,,USER2] ;SET UP BLT
BLT S1,USER2+.AEMAX-1 ;COPY
MOVEI U,USER ;POINT TO BUFFER TO CHANGE
MOVEI X,USER2 ;POINT TO ORIGINAL FOR "RESTORE"
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS A SINGLE PROFILE
$RETIF ;CHECK FOR ERRORS
JRST CHANG3 ;GO PROCESS CHANGES
CHANG2: PUSHJ P,PROUPD ;UPDATE WORKING PROFILE
$RETIF ;CHECK FOR ERRORS
SETOM INSFLG ;ALL CHANGES ARE REAL WHEN WILDCARDING
CHANG3: PUSHJ P,PROCHG ;PERFORM ALL CHANGES TO PROFILE
SETZM INSFLG ;NO LONGER DOING SOMETHING STRANGE
JUMPF CHANG4 ;CHECK FOR ERRORS
PUSH P,S1 ;SAVE COUNT OF CHANGES TO THIS PROFILE
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,S2 ;GET COUNT BACK
SKIPN S2 ;SOMETHING HAPPEN?
WARN (NCH,<No changes made to ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ changed>)
AOS PROSUC ;COUNT THE SUCCESS
JRST CHANG1 ;LOOP FOR MORE
CHANG4: AOS PROFAI ;COUNT THE FAILURE
PUSHJ P,CVTPPD ;CONVERT PPN
WARN (CFU,<Change failed for ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)
CHANG5: MOVEI S1,[ASCIZ/changed/]
PJRST WLDSUM ;GO SUMMARIZE AND RETURN
CHGHLP: ASCIZ \
The CHANGE command enables you to enter user mode and modify user
profiles. The syntax is: CHANGE user-id.
\
SUBTTL DELETE COMMAND -- DELETE - ENTRY POINT
XWD DELHLP,[ASCIZ /Delete a profile/]
DELETE: PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;RETURN ON ERRORS
SETOM DELASK ;DEFAULT TO /ASK
PUSHJ P,P$SWIT## ;CHECK FOR A SWITCH
JUMPF DELET1 ;NOT YET
CAIE S1,0 ;/NOASK?
CAIN S1,1 ;/ASK?
SKIPA ;YES TO EITHER
FATAL (IVS,<Invalid switch specified>)
MOVEM S1,DELASK ;SET FLAG ACCORDINGLY
DELET1: PUSHJ P,P$CFM## ;NEED EOL
JUMPF PRSERR ;CHECK FOR ERRORS
DELET2: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF DELET3 ;DONE?
MOVEI U,USER ;POINT TO THE USER PROFILE
PUSHJ P,DELCHK ;CHECK PARANOIA LEVEL
PJRST @DELTAB(S1) ;YES, DISPATCH
DELET3: MOVEI S1,[ASCIZ /deleted/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT
DELTAB: IFIW DELET2 ;"NO"
IFIW DELET3 ;"QUIT"
IFIW DELSHO ;"SHOW"
IFIW DELPRO ;"YES"
DELMAX==.-DELTAB ;LENGTH OF TABLE
SUBTTL DELETE COMMAND -- DELCHK - SEE IF OK TO DELETE PROFILE
DELCHK: SKIPE DELASK ;PARANOID?
JRST DELCH1 ;YES
MOVEI S1,3 ;SET INDEX FOR "YES"
$RETT ;AND RETURN
DELCH1: MOVEI S2,[ITEXT (<^H/.AEEXP(U)/>)]
MOVE S1,.AEEXP(U) ;GET EXPIRATION DATE/TIME
CAIN S1,0 ;SET?
MOVEI S2,[ITEXT (<not set>)]
CAMN S1,[-1] ;NEVER?
MOVEI S2,[ITEXT (<never>)]
PUSH P,S2 ;SAVE ITEXT BLOCK ADDRESS
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,S2 ;GET ITEXT BACK
$TEXT (,<User ^T/(S1)/ ^Q/USRNAM/, expiration date: ^I/(S2)/>)
DELCH2: MOVEI S1,DELU00 ;COMMAND TABLE
MOVEI S2,[ASCIZ /Are you sure? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF DELCH2 ;CHECK FOR ERRORS
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF DELCH2 ;TRY AGAIN
CAILE S1,DELMAX ;RANGE CHECK RETURNED INDEX
JRST DELCH2 ;STRANGE ...
$RETT ;RETURN WITH ANSWER IN S1
DELU00: $INIT (DELU10)
DELU10: $KEYDSP (DELU20,<$DEFAULT (<YES>)>)
DELU20: $STAB
DSPTAB (CONFRM,0,<NO>)
DSPTAB (CONFRM,1,<QUIT>)
DSPTAB (CONFRM,2,<SHOW>)
DSPTAB (CONFRM,3,<YES>)
$ETAB
SUBTTL DELETE COMMAND -- DELHLP - HELP TEXT
DELHLP: ASCIZ \
The DELETE command removes the specified profile from the accounting
file. The syntax is: DELETE user-id /switches.
\
SUBTTL DELETE COMMAND -- MISCELLANEOUS
; DISPLAY PROFILE ("SHOW")
DELSHO: PUSHJ P,TYPUSR ;DISPLAY PROFILE
PUSHJ P,DELCH2 ;ASK FOR CONFIRMATION AGAIN
PJRST @DELTAB(S1) ;DISPATCH IT AGAIN
; DELETE PROFILE ("YES")
DELPRO: PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT ADDRESS
PUSHJ P,DELUSR ;DELETE THIS PROFILE
POP P,S1 ;GET PPN TEXT ADDRESS BACK
JUMPF DELPR1 ;CHECK FOR ERRORS
AOS PROSUC ;COUNT THE SUCCESS
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ deleted>)
JRST DELET2 ;LOOP
DELPR1: WARN (DPF,<Delete of profile failed for ^T/(S1)/>)
AOS PROFAI ;COUNT THE FAILURE
JRST DELET2 ;AND LOOP
SUBTTL EXIT COMMAND
XWD CTZHLP,[ASCIZ /Exit program/]
CTRLZ: PJRST EXIT ;SAME AS EXIT COMMAND
CTZHLP: ASCIZ \
Control-Z (^Z) is the same as the EXIT command. It stops the REACT
program and returns you to monitor command level.
\
XWD EXIHLP,[ASCIZ /Exit program/]
EXIT: MONRT. ;EXIT
JRST REACT ;THE FOOL TYPED CONTINUE
EXIHLP: ASCIZ \
The EXIT command stops the REACT program and returns you to monitor
command level.
\
SUBTTL HELP COMMAND -- ENTRY POINT
XWD HLPHLP,[ASCIZ /Gives information on commands/]
HELP: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZ P1, ;ASSUME QUICK HELP WANTED
PUSHJ P,P$KEYW## ;GET A KEYWORD
SKIPF ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY DISPATCH ADDRESS
PUSHJ P,P$CFM## ;GET CRLF
JUMPF HLPERR ;CHECK FOR ERRORS
JUMPN P1,HLPCMD ;JUMP IF HELP DESIRED ON A COMMAND
$TEXT (<-1,,HELPBF>,<Help for REACT %^V/.JBVER/^0>)
$TEXT (,<^T72C /HELPBF/^M^J>)
MOVE P1,CMDPTR ;POINT TO WORKING COPY OF COMMAND TABLE
HLRZ P2,(P1) ;GET NUMBER OF WORDS IN THE TABLE
MOVNS P2 ;NEGATE
HRLZS P2 ;PUT IN LH
HRRI P2,1(P1) ;MAKE AN AOBJN POINTER
HELP1: HLRZ S1,(P2) ;GET A KEYWORD
SKIPE S2,(S1) ;MUST CHECK
TLNE S2,(177B6) ;FIRST CHARACTER ZERO AND WORD NOT ALL ZERO?
TDZA S2,S2 ;NO--MAKE FLAGS ALL ZERO
AOJ S1, ;YES--ADJUST TEXT POINTER
TXNE S2,CM%NOR!CM%INV ;TEST FLAGS
JRST HELP2 ;PROBABLY A POINTER OR INVISIBLE
HRRZ S2,(P2) ;GET POINTER TO DISPATCH ADDRESS
HLRZ S2,(S2) ;GET DISPATCH ADDRESS
HRRZ S2,-1(S2) ;GET ONE-LINE HELP TEXT ADDRESS
$TEXT (,<^T12L /(S1)/ ^T/(S2)/>)
HELP2: AOBJN P2,HELP1 ;LOOP THROUGH THE TABLE
$RETT ;YES--ALL DONE
SUBTTL HELP COMMAND -- HLPCMD - GIVE HELP FOR A COMMAND
HLPCMD: MOVE P2,CMDPTR ;POINT TO WORKING COPY OF COMMAND TABLE
HLRZ S1,(P2) ;GET NUMBER OF WORDS IN THE TABLE
MOVNS S1 ;NEGATE
HRLZS S1 ;PUT IN LH
HRRI S1,1(P2) ;MAKE AN AOBJN POINTER
HLPCM1: HRRZ S2,(S1) ;GET A POINTER
CAME S2,P1 ;MATCH?
AOBJN S1,HLPCM1 ;LOOP
JUMPGE S1,HLPERR ;POINTER RUN OUT?
HLPCM2: HLRZ S1,(S1) ;GET ADDRESS OF COMMAND NAME
SKIPE S2,(S1) ;IF FIRST WORD NON-NULL,
TLNE S2,(177B6) ;BUT FIRST CHARACTER IS,
CAIA ;(NO)
AOJ S1, ;YES--SKIP OVER FLAGS WORD
HLRZ S2,(P1) ;GET DISPATCH ADDRESS
HLRZ S2,-1(S2) ;AND THE TEXT BLOCK ADDRESS
$TEXT (<-1,,HELPBF>,<Help for REACT %^V/.JBVER/ - ^T/(S1)/^0>)
$TEXT (,<^T72C /HELPBF/^M^J^T/(S2)/>)
$RETT ;RETURN
SUBTTL HELP COMMAND -- HLPERR - ERROR PROCESSING
; HERE WHEN NO HELP IS AVAILABLE. THIS SITUATION SHOULD NEVER ARISE.
; IF IT DOES, IT INDICATES SOME SORT OF INTERNAL COMMAND PARSING
; PROBLEM EXISTS. SINCE THE LACK OF HELP TEXT IS HARDLY FATAL, WE'LL
; JUST SPIT OUT A WARNING AND GO AWAY RATHER THAN JUMP OFF TO PRSERR.
HLPERR: WARN (NIO,<No information available on the specified topic>,,.RETT)
SUBTTL HELP COMMAND -- HLPHLP - HELP TEXT
HLPHLP: ASCIZ \
The HELP command enables you to obtain information about REACT. The
valid keywords are any REACT command name. If you do not specify a
command name REACT displays a brief listing of each REACT command on the
terminal.
\
SUBTTL INSERT COMMAND -- INSERT - ENTRY POINT
XWD INSHLP,[ASCIZ /Insert a profile into the accounting file/]
INSERT: MOVEI U,USER2 ;POINT TO PROTOTYPE PROFILE BLOCK
PUSHJ P,PROZPB ;CLEAR IT
MOVEI U,USER ;POINT TO WORKING PROFILE BLOCK
PUSHJ P,PROZPB ;CLEAR IT
MOVEI X,USER2 ;SET POINTER TO PROTOTYPE
SETOM DEFSRC ;SEARCH FOR DEFAULT PROFILE
SETOM DEFPPN ;INIT DEFAULT PPN FLAG
PUSHJ P,INSPRS ;PARSE ALL ARGUMENTS
$RETIF ;CHECK FOR ERRORS
INSER1: MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(X) ;SAVE IN PROTOTYPE
PUSHJ P,INSWLD ;GATHER UP ALL WILDCARD PARAMETERS
$RETIF ;GIVE UP IF USER ABORTED INSERT
EXCH U,X ;SWAP PROFILE POINTERS
PUSHJ P,PROCLR ;CLEAR USER SPECIFIC DATA
EXCH U,X ;RESTORE PROFILE POINTERS
INSER2: SETZM INSFLG ;NOT INSERTING YET (FOR COMPAR)
PUSHJ P,INSPPN ;ASK FOR PPN IF NEEDED
$RETIF ;USER ABORTED INSERT
PUSHJ P,INSNAM ;ASK FOR A NAME IF NEEDED
$RETIF ;USER ABORTED INSERT
PUSHJ P,INSPSW ;ASK FOR OR GENERATE A PASSWORD
$RETIF ;USER ABORTED INSERT
MOVSI S1,(X) ;POINT TO PROTOTYPE
HRRI S1,(U) ;AND TO WORKING COPY
BLT S1,.AEMAX-1(U) ;COPY
SKIPE WLDINS ;WILDCARDED INSERT?
JRST INSER3 ;YES--JUST UPDATE WHAT WE HAVE NOW
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS A SINGLE PROFILE
$RETIF ;CHECK FOR ERRORS
INSER3: SETOM INSFLG ;GOING TO INSERT NOW
PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT POINTER
PUSHJ P,INSQUE ;GO DO THE QUEUE. UUO
POP P,S1 ;RESTORE PPN TEXT ADDRESS
JUMPF INSER4 ;JUMP IF FAILED
MOVEI T1,[ITEXT (<password ^Q/T2/>)]
MOVE T2,[POINT 8,PASSWD] ;BYTE POINTER TO PASSWORD
SKIPE PMRPWD ;PASSWORD DEFAULTED?
MOVEI T1,[ITEXT (<default password>)]
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ inserted with ^I/(T1)/>)
AOS PROSUC ;COUNT THE SUCCESS
JRST INSER5 ;ONWARD
INSER4: FATAL (INF,<Insert failed for user ^T/(S1)/ ^Q/USRNAM/>,,.+1)
AOS PROFAI ;COUNT THE FAILURE
INSER5: AOS WILDBK+UW$FND ;COMPENSATE FOR SUMMARY NONSENSE
MOVEI S1,[ASCIZ /inserted/]
SOSG PMRCNT ;ANY MORE TO DO?
PJRST WLDSUM ;DISPLAY SUMMARY AND RETURN
MOVE S2,PMRINC ;GET PROGRAMMER INCREMENT
ADD S2,.AEPPN(X) ;ADVANCE TO NEXT PPN
TRNE S2,400000 ;MAKE SURE WE'RE GENERATING A VALID PPN
WARN (PNO,<Project number overflow; insertion terminated>,,WLDSUM)
MOVEM S2,.AEPPN(X) ;UPDATE
SETZM .AENAM(X) ;ZAP THE NAME SO A NEW ONE WILL DEFAULT
JRST INSER2 ;LOOP BACK
SUBTTL INSERT COMMAND -- INSQUE - INSERT THE PROFILE
;CALL:
; U/ PROFILE POINTER
INSQUE: PUSHJ P,.SAVE4 ;PRESERVE SOME ACS
PUSHJ P,QINITA ;SETUP TO ADD AN ENTRY
MOVX P4,PD.NMD ;NO-MODIFY BIT
MOVSI P3,-QUETBL ;AOBJN POINTER
INSQ.1: MOVE S1,QUETAB(P3) ;GET NEXT PROFILE OFFSET
TDNE P4,CHGTAB##(S1) ;CAN IT BE MODIFIED?
JRST INSQ.3 ;NO, SO DON'T
CAIN S1,.AEPSW ;IF THE PASSWORD,
JRST INSQ.3 ;WAIT UNTIL LATER (IT'S IN A DIFFERENT BLOCK)
CAIE S1,.AENAM ;IS IT THE NAME?
JRST INSQ.2 ;NO, DON'T SECOND-GUESS IT
MOVX S2,AE.NCH ;NAME-CHANGE BIT
TDNN S2,.AEFLG(U) ;IF WE THINK IT SHOULD BE ON,
SKIPE RESPPN ;OR IF ACTDAE ALREADY KNOWS THE NAME,
JRST INSQ.3 ;THEN DON'T SEND A NAME
INSQ.2: PUSHJ P,QUECHG ;INSERT QUANTITY INTO THE UUO LIST
JUMPF INSQ.4 ;HOPE THIS WORKED
INSQ.3: AOBJN P3,INSQ.1 ;LOOP OVER ALL AVAILABLE PROFILE OFFSETS
DMOVE P1,[EXP .AEPSW,<.APWLW,,PASSWD>] ;PASSWORD BLOCK
PUSHJ P,QUEINS ;STUFF INTO THE BLOCK
JUMPF INSQ.4 ;HOPE IT WORKED
PJRST QUEUUO ;DO THE UUO AND RETURN THE PROGNOSIS
INSQ.4: WARN (ROS,<Ran out of space trying to build the INSERT list>,,.RETF)
SUBTTL INSERT COMMAND -- INSHLP - HELP TEXT
INSHLP: ASCIZ \
The INSERT command enables you to enter user mode and create new user
profiles. You can supply an optional existing user-id to use as a model
for the new profile. The syntax is:
INSERT new-user-id [=existing-user-id]
If you omit the existing-user-id, REACT looks for the default profile
for the project. If a default project profile does not exist, REACT
looks for the default profile for the system.
\
SUBTTL INSERT COMMAND -- INSNAM - NAME PARAMETER
INSNAM: SKIPE WILDBK+UW$WST ;IS A NAME NEEDED?
JRST INSNA2 ;NO
MOVE S1,.AEPPN(X) ;GET NEW PPN
PUSHJ P,A$CKPP## ;CHECK IF IT'S RESERVED
JUMPT INSNA1 ;NO, MUST ASK FOR NAME
$TEXT (<POINT 8,.AENAM(X),-1>,<^T/(S1)/^0>)
JRST INSNA4 ;GOT OUR NAME
INSNA1: SKIPN PMRPRT ;PROMPT FOR NAME?
JRST INSNA2 ;NO
MOVEI S1,USR000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /New user name: /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,PRSALT ;PARSE A USER-ID
JUMPF INSNA1 ;TRY AGAIN
SKIPN ALTRBK+UW$WST ;WAS A NAME GIVEN?
WARN (PGN,<PPN given when a name requested; ^Q/ALTRBP/>,,INSNA1)
SKIPN ALTRBK+UW$NAM ;NAME MUST BE NON-ZERO
JRST INSNA1 ;TRY AGAIN
PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
WARN (WNI,<Wildcarded name illegal; ^Q/ALTRBP/>,,INSNAM)
MOVSI S1,ALTRBK+UW$NAM ;POINT TO NAME JUST PARSED
HRRI S1,.AENAM(X) ;AND TO WORKING PROFILE BLOCK
BLT S1,.AENAM+.AANLW-1(X) ;COPY
MOVSI S1,ALTRBK+UW$NAM ;PONT TO NAME AGAIN
HRRI S1,WILDBK+UW$NAM ;AND TO WORKING BLOCK
BLT S1,WILDBK+UW$NAM+.AANLW-1 ;COPY
INSNA2: MOVEI S1,.AENAM(X) ;POINT TO NAME
PUSHJ P,A$CKNM## ;CHECK IT FOR LEGALITY
JUMPT INSNA5 ;IT'S NOT RESERVED
CAMN S1,.AEPPN(X) ;DID INSPPN AGREE WITH THIS?
JRST INSNA5 ;YES
MOVEI S1,.AENAM(X) ;POINT TO NAME AGAIN
HRLI S1,(POINT 8,) ;IN CASE OF ERROR
WARN (RNI,<Reserved name illegal; ^Q/S1/>,,INSNA3)
INSNA5: MOVEI S1,.AENAM(X) ;POINT TO TARGET NAME
MOVEI S2,TEMP ;WHERE TO STORE PROFILE
PUSHJ P,QUSRIN ;SEE IF THIS PPN EXISTS
JUMPF INSNA4 ;NO--ALMOST DONE
PUSH P,U ;SAVE U
MOVEI U,TEMP ;POINT TO TEMPORARY PROFILE BLOCK
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,U ;RESTORE U
MOVEI S2,TEMP+.AENAM ;POINT TO NAME
HRLI S2,(POINT 8,) ;MAKE A BYTE POINTER
WARN (NAE,<Name ^Q/S2/ is already taken by ^T/(S1)/>)
INSNA3: SKIPE PMRPRT ;PROMPT FOR NAME?
SKIPE WILDBK+UW$WST ;WAS A NAME NEEDED?
$RETF ;NO--GIVE UP
JRST INSNA1 ;ELSE TRY AGAIN
INSNA4: MOVE S1,NAM+CG.IDX ;GET NAME INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SETOM @S1 ;MARK NAME AS "CHANGED"
SETOM CHGMSK+.AENAM ;IN BOTH PLACES
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPPN - PPN PARAMETER
INSPPN: SETZM RESPPN ;ASSUME NOT RESERVED
SKIPN WILDBK+UW$WST ;IS A PPN NEEDED?
JRST INSPP3 ;NO
MOVEI S1,.AENAM(X) ;YES, POINT TO NAME THAT USER TYPED
PUSHJ P,A$CKNM## ;SEE IF IT IS RESERVED
JUMPT INSPP1 ;NO, DON'T SET A PPN FROM IT
MOVEM S1,.AEPPN(X) ;YES, SET ITS PPN
SETOM RESPPN ;REMEMBER THAT IT'S RESERVED
JRST INSPP3 ;AND DON'T ASK
INSPP1: MOVEI S1,USR000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /New user PPN: /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,PRSALT ;PARSE A USER-ID
JUMPF INSPP1 ;TRY AGAIN
SKIPN ALTRBK+UW$WST ;MUST BE A PPN
JRST INSPP2 ;GOT ONE
SKIPE ALTRBK+UW$NAM ;IS NAME REALLY BLANK?
WARN (NGP,<Name given when a PPN requested; ^Q/ALTRBP/>)
JRST INSPP1 ;TRY AGAIN
INSPP2: PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
WARN (WPI,<Wildarded PPN illegal; ^Q/ALTRBP/>,,INSPPN)
MOVE S1,ALTRBK+UW$PPN ;GET PPN
MOVEM S1,WILDBK+UW$PPN ;SAVE IN WORKING BLOCK
MOVEM S1,.AEPPN(X) ;SAVE IN PROFILE
INSPP3: MOVE S1,.AEPPN(X) ;GET TARGET PPN
MOVEM S1,WILDBK+UW$PPN ;SAVE FOR DISPLAY
SETOM WILDBK+UW$PPM ;NOT WILDCARDED
MOVEI S2,TEMP ;WHERE TO STORE PROFILE
PUSHJ P,QPPNIN ;SEE IF THIS PPN EXISTS
JUMPF INSPP4 ;PPN SHOULD NOT EXIST
HRRZ S1,.AEPPN(X) ;GET TARGET PROGRAMMER NUMBER
HRRZ S2,TEMP+.AEPPN ;AND RETURNED PROGRAMMER NUMBER
TRNE S1,1B18 ;POSSIBLY A UNIQUE PPN?
CAIN S1,(S2) ;WAS GENERIC ANSWER RETURNED (10,#)?
CAIA ;THEN TRYING TO INSERT DUPLICATE PPN
JRST INSPP4 ;ATTEMPT INSERTION
PUSH P,U ;SAVE U
MOVEI U,TEMP ;POINT TO TEMPORARY PROFILE BLOCK
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,U ;RESTORE U
MOVEI S2,TEMP+.AENAM ;POINT TO NAME
HRLI S2,(POINT 8,) ;MAKE A BYTE POINTER
FATAL (PAE,<PPN ^T/(S1)/ is already taken by ^Q/S2/>,,.RETF)
INSPP4: SKIPE WILDBK+UW$WST ;HAVE A NAME?
JRST INSPP5 ;YES
EXCH U,X ;SWAP PROFILE POINTERS
PUSHJ P,PRONAM ;DEFAULT NAME
EXCH U,X ;RESTORE PROFILE POINTERS
INSPP5: AOSN DEFPPN ;BEEN HERE BEFORE?
SKIPE .AETIM(X) ;HAVE A PROFILE FOR INPUT?
$RETT ;YES--DONE
MOVE S1,.AEPPN(X) ;GET OUR PPN
MOVEM S1,.AEPPN(U) ;SET FOR PRODEF
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE
MOVEI T1,(X) ;USER PROFILE
MOVEI T2,(U) ;DEFAULT PROFILE
PUSHJ P,A$PDEF## ;APPLY THE DEFAULTS
MOVSI S1,(X) ;SOURCE
HRRI S1,(U) ;WORKING BLOCK
BLT S1,.AEMAX-1(U) ;COPY FOR CHANGES
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPRS - PARSE ALL ARGUMENTS
INSPRS: PUSHJ P,PRSWLD ;PARSE A PPN OR NAME
$RETIF ;CHECK FOR ERRORS
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
SETOM WLDINS ;YES--REMEMBER FOR LATER
PUSHJ P,P$CFM## ;EOL?
JUMPT INSPR1 ;YES
PUSHJ P,P$TOK## ;GET "="
JUMPF PRSERR ;CHECK FOR ERRORS
MOVSI S2,(ASCIZ/=/) ;MUST BE AN EQUALS SIGN
CAME S2,ARG.DA(S1) ;CHECK IT
JRST PRSERR ;NO GOOD
PUSHJ P,PRSALT ;PARSE A PPN OR NAME
$RETIF ;CHECK FOR ERRORS
PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
FATAL (WIU,<Wildcarded input user-id illegal; ^Q/ALTRBP/>)
PUSHJ P,ALTUSR ;FETCH INPUT PROFILE
JUMPF WLDSUM ;GO REPORT ERROR AND RETURN
MOVSI S1,(U) ;POINT TO DEFAULT PROFILE
HRRI S1,(X) ;ADDRESS OF PROTOTYPE BLOCK
BLT S1,.AEMAX-1(X) ;SET UP PROTOTYPE
INSPR1: MOVE S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
JUMPN S1,INSPR2 ;JUMP IF A NAME
HLRE S2,WILDBK+UW$PPM
CAME S2,[EXP -1] ;YES--WILD PROJECT NUMBER?
FATAL (WPI,<Wildcarded project number illegal on insert; ^Q/WILDBP/>)
MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(X) ;SAVE IN PROTOTYPE PROFILE BLOCK
$RETT ;RETURN
INSPR2: CAIN S1,1 ;WILD NAME?
FATAL (WNI,<Wildcarded name illegal on insert; ^Q/WILDBP/>)
MOVSI S1,WILDBK+UW$NAM ;POINT TO NAME
HRRI S1,.AENAM(X) ;AND TO PROTOTYPE STORAGE
BLT S1,.AENAM+.AANLW-1(X) ;COPY
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPSW - PASSWORD PARAMETER
INSPSW: SKIPN PMRPSW ;PROMPT FOR PASSWORD?
JRST INSPS1 ;NO
MOVEI S1,PASS00 ;COMMAND TABLE
MOVEI S2,[ASCIZ /Password: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF INSPSW ;TRY AGAIN
PUSHJ P,PSWGET ;PARSE A PASSWORD
$RETT ;RETURN
INSPS1: SKIPE PMRPWD ;DEFAULTING PASSWORD?
JRST INSPS2 ;YES
PUSHJ P,PROPSW ;GENERATE A PASSWORD
SETOM .AEPCT(X) ;FORCE A PASSWORD CHANGE ON FIRST LOGIN
MOVX S1,DF.PCT ;DEFAULT BIT FOR THIS FIELD
ANDCAM S1,DF$PCT(X) ;MAKE SURE WE SEND OUR VALUE
$RETT ;RETURN
INSPS2: MOVX S1,DF.PCT ;DEFAULT BIT FOR THIS FIELD
IORM S1,DF$PCT(X) ;FORCE FIELD DEFAULTING
PJRST PSWDFL ;DEFAULT PASSWORD FIELD AND RETURN
SUBTTL INSERT COMMAND -- INSWLD - WILDCARD PARAMETER PARSING
INSWLD: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,.AEPPN(X) ;GET INITIAL PPN
TRNN S1,-1 ;ZERO?
HRRI S1,1 ;BE MORE REALISTIC
MOVEM S1,.AEPPN(X) ;UPDATE
MOVEI S1,1 ;NICE SMALL NUMBER
MOVEM S1,PMRINC ;DEFAULT INCREMENT
MOVEM S1,PMRCNT ;DEFAULT COUNT
SETOM PMRPRT ;DEFAULT TO PROMPTING FOR NAME
SKIPL WLDINS ;DOING WILD INSERT?
JRST INSWL6 ;GO CHECK OUT PASSWORD DEFAULTING
INSWL1: MOVEI S1,PGMR00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Base programmer number: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL1 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,377777 ; CHECK
WARN (BOR,<Base programmer number out of range 1 to 377777>,,INSWL1)
HRRM S1,.AEPPN(X) ;SAVE IT
MOVEI P1,377777 ;GET MAXIMUM PROGRAMMER NUMBER
SUBI P1,(S1) ;COMPUTE NUMBER OF PPNS WHICH CAN BE ADDED
JUMPLE P1,INSWL3 ;DON'T ASK FOR INCREMENT IF AT TOP OF RANGE
INSWL2: MOVEI S1,INCR00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Programmer number increment: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL2 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,(P1) ; CHECK
WARN (IOR,<Increment out of range 1 to ^O/P1/>,,INSWL2)
MOVEM S1,PMRINC ;SAVE THE INCREMENT
MOVEI S1,(P1) ;GET MAX INCREMENT (MAX # OF PPNS CAN GENERATE)
IDIV S1,PMRINC ;COMPUTE MAXIMUM COUNT TO INSERT
MOVEI P1,(S1) ;SAVE AWAY
INSWL3: MOVEI S1,COUN00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Count of PPN's to insert: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL3 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,(P1) ; CHECK
WARN (COR,<Count of PPNs out of range 1 to ^D/P1/>,,INSWL3)
MOVEM S1,PMRCNT ;SAVE COUNT
INSWL4: MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Prompt for user name? /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL4 ;TRY AGAIN
MOVEM S1,PMRPRT ;SAVE PROMPT VALUE
INSWL5: MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Prompt for password? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL5 ;TRY AGAIN
MOVEM S1,PMRPSW ;SAVE FLAG
JUMPN S1,.RETT ;RETURN IF THE ANSWER WAS "YES"
INSWL6: $RETT ;RETURN FOR NOW
MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Default password? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF ERRORS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL6 ;TRY AGAIN
MOVEM 1,PMRPWD ;SAVE FLAG
$RETT ;RETURN
SUBTTL INSERT COMMAND -- MISCELLANEOUS
PGMR00: $INIT (PGMR10)
PGMR10: $NUMBER (CONFRM,^D8,<octal number>)
COUN00: $INIT (COUN10)
COUN10: $NUMBER (CONFRM,^D10,<decimal number of PPNs to generate>)
INCR00: $INIT (INCR10)
INCR10: $NUMBER (CONFRM,^D8,<octal number for increment>)
NAME00: $INIT (NAME10)
NAME10: $KEYDSP (NAME20,$DEFAULT(<NO>))
NAME20: $STAB
DSPTAB (CONFRM,0,<NO>)
DSPTAB (CONFRM,1,<YES>)
$ETAB
SUBTTL LIST AND SHOW COMMANDS
XWD SHOHLP,[ASCIZ /Display profile information on the terminal/]
SHOW: JRST LIST ;ENTER COMMON CODE
XWD LISHLP,[ASCIZ /Write profile information to a file/]
LIST: PUSHJ P,PRSWLD ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
PUSHJ P,P$OFIL## ;GET OUTPUT FILESPEC
JUMPF LIST1 ;MUST BE A SHOW COMMAND
MOVEM S1,LST+FOB.FD ;SAVE FD ADDRESS
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,LST ;FD ADDRESS
PUSHJ P,F%OOPN ;OPEN FILE FOR OUTPUT
SKIPT ;CHECK FOR ERRORS
FATAL (COL,<Can't open listing file ^F/@LST+FOB.FD/; ^E/[-1]/>)
MOVEM S1,LSTIFN ;SAVE IFN
MOVNI S2,1 ;-1 FOR ACTUAL FILESPEC
PUSHJ P,F%FD ;GET FILESPEC
JUMPF LIST1 ;SHOULDN'T FAIL
LOAD S2,.FDLEN(S1),FD.LEN ;GET RETURNED FD LENGTH
HRLZS S1 ;POINT FD IN LH
HRR S1,LST+FOB.FD ;AND TO OUR STORAGE
ADD S2,LST+FOB.FD ;COMPUTE END OF BLT
BLT S1,-1(S2) ;CPY RETURNED FD
INFO (LIS,<Listing to ^F/@LST+FOB.FD/>)
LIST1: MOVEI S1,0 ;DEFAULT TO /DETAIL
MOVEM S1,LISTFL ;SAVE INCASE NO SWITCH TYPED
PUSHJ P,P$SWIT## ;TRY FOR A SWITCH
JUMPF LIST2 ;NOT THERE
CAIE S1,0 ;/DETAIL?
CAIN S1,1 ;/FAST?
SKIPA ;SHOULDN'T HAPPEN
JUMPF PRSERR ;SHOULDN'T HAPPEN
MOVEM S1,LISTFL ;SAVE FLAG
LIST2: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
LIST3: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF LIST5 ;DONE?
AOS PROSUC ;COUNT THE PROFILE
MOVEI U,USER ;POINT AT THE USER BLOCK
SKIPN LISTFL ;QUICK DISPLAY?
JRST LIST4 ;NO
PUSHJ P,CVTPPF ;CONVERT PPN
$TEXT (,< ^T/(S1)/ ^Q/USRNAM/>)
JRST LIST3 ;LOOP
LIST4: SKIPE LSTIFN ;OUTPUT TO A FILE?
$TEXT (,<^T/FORMFD/^A>) ;YES
$TEXT (,<^T/CRLFS/^A>)
PUSHJ P,TYPUSR ;DISPLAY THE PROFILE
JRST LIST3 ;LOOP
LIST5: SKIPE S1,LSTIFN ;OUTPUT TO A FILE?
PUSHJ P,F%REL ;YES--CLOSE IT NOW
SETZM LSTIFN ;ZAP IFN
MOVEI S1,[ASCIZ /listed/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT ;AND RETURN
CRLFS: BYTE (7).CHCRT,.CHLFD,.CHCRT,.CHLFD,.CHCRT,.CHLFD,0
FORMFD: BYTE (7).CHFFD,.CHCRT,0
LISHLP: ASCIZ \
The LIST command writes profile information to a disk file. The syntax
is:
LIST user-id filespec/switch
The default filespec is DSK:ACCT.LST[-]. The switches are:
/DETAIL (default) lists all profile information
/FAST lists only PPNs and user names
\
SHOHLP: ASCIZ \
The SHOW command displays profile information on the terminal. The
syntax is:
SHOW user-id /switch
The switches are:
/DETAIL (default) lists all profile information
/FAST lists only PPNs and user names
\
SUBTTL LOCK AND UNLOCK COMMANDS
XWD UNLHLP,[ASCIZ /Unlock accounting file to allow updates/]
UNLOCK: MOVNI S1,1 ;UNLOCK ENTRY POINT
JRST LOCK1 ;ENTER COMMON CODE
XWD LOCHLP,[ASCIZ /Lock accounting file against updates/]
LOCK: SETZ S1, ;LOCK ENTRY POINT
LOCK1: PUSH P,S1 ;SAVE FLAG
;.QUFNC and .QUNOD
MOVE S1,[QF.RSP!.QUMAE] ;TALK TO ACTDAE
SETZ S2, ;CENTRAL SITE
DMOVEM S1,QUEBLK+.QUFNC ;SAVE AS FUNCTION CODE
;.QURSP
MOVE S1,[.AEMAX,,RSPBLK] ;RESPONSE BLOCK
MOVEM S1,QUEBLK+.QURSP
;.QUTIM
MOVEI S1,3 ;ASSUME STANDARD HEADER OFFSET
SKIPE OLDMON ;NON-FANCY UUO?
JRST LOCK2 ;YES, DON'T BE FANCY
SKIPE DEBUGQ ;WANT TO WAIT?
TDZA S2,S2 ;NO, LOAD ZERO TIME
MOVEI S2,ZZTIME ;YES, SET MAX. WAIT TIME
MOVEM S2,QUEBLK+3 ;SET FOR TIMEOUT
SKIPE S2,DEBUGW ;RUNNING PRIVATELY?
MOVE S2,ACTPID ;YES, USE THIS PID
MOVEM S2,QUEBLK+4 ;SET PID OR ZERO
SKIPE S2 ;DID WE SET A PID?
AOSA S1 ;YES, BUMP TWICE
SKIPE QUEBLK+3 ;NO, DID WE SET A TIMEOUT?
AOS S1 ;YES, BUMP HEADER LENGTH
STORE S1,QUEBLK,QF.HLN ;SET HEADER LENGTH FOR UUO
LOCK2:
;.QBAFN
MOVX S2,UGLOK$ ;ASSUME LOCK
SKIPE (P) ;WAS IT?
MOVX S2,UGUNL$ ;NO, WAS UNLOCK
TRO S2,AF.PRV ;MAKE SURE ACTDAE CHECKS OUR PRIVS
MOVEM S2,QUEBLK+1(S1) ;SET ACTDAE FUNCTION CODE
MOVE S2,[QA.IMM!1B17!.QBAFN] ;SUBFUNCTION CODE
MOVEM S2,QUEBLK(S1) ;STORE THE SUBFUNCTION TYPE
MOVSI S1,2(S1) ;GET LENGTH OF ARG BLOCK
HRRI S1,QUEBLK ;POINT TO THE BLOCK
POP P,S2 ;GET ENTRY BACK
QUEUE. S1,
FATAL (LSF,<Accounting file status change failed; ^T/RSPBLK/>,,.RETF)
SKIPN S2
INFO (LOK,<Accounting file locked; changes are prohibited>,,.RETT)
INFO (UNL,<Accounting file unlocked; changes are permitted>,,.RETT)
LOCHLP: ASCIZ \
The LOCK command instructs ACTDAE to open the accounting file in
read-only mode. When this is done, the accounting file will not be
updated by ACTDAE. Therefore, users will not be allowed to change
unprivileged fields in their profiles. A privileged user will not be
allowed to make any changes that would modify the accounting file. This
command is used mainly to support the VERIFY command, or in a situation
where you might want to supersede the accounting file.
\
UNLHLP: ASCIZ \
The UNLOCK command instructs ACTDAE to re-open the accounting file in
update mode. This command restores ACTDAE to its normal mode of
operation.
\
SUBTTL PURGE COMMAND
XWD DELHLP,[ASCIZ /Purge expired profiles/]
PURGE: PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;RETURN ON ERRORS
PUSHJ P,P$CFM## ;NEED EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,EXPDTM ;SAVE FOR EXPIRATION DATE/TIME COMPARRISONS
PURGE1: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF PURGE3 ;DONE?
MOVEI U,USER ;POINT TO THE USER PROFILE
SKIPLE S1,.AEEXP(U) ;GET DATE/TIME FROM PROFILE
CAMLE S1,EXPDTM ;EXPIRED PPN?
JRST PURGE1 ;NO
PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT ADDRESS
PUSHJ P,DELUSR ;DELETE THIS USER
POP P,S1 ;GET PPN TEXT ADDRESS BACK
JUMPF PURGE2 ;CHECK FOR ERRORS
AOS PROSUC ;COUNT THE SUCCESS
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ purged>)
JRST PURGE1 ;LOOP
PURGE2: WARN (DPF,<Purge of profile failed for ^T/(S1)/>)
AOS PROFAI ;COUNT THE FAILURE
JRST PURGE1 ;LOOP
PURGE3: MOVEI S1,[ASCIZ /purged/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT
PURHLP: ASCIZ \
The PURGE command removes the specified expired profile(s) from the
accounting file. The syntax is: PURGE user-id.
\
SUBTTL SELECT COMMAND
XWD SELHLP,[ASCIZ /Select wildcarding criteria/]
SELECT: PUSHJ P,P$SWIT## ;TRY FOR A SWITCH
SKIPT ;SKIP IF GOT ONE
MOVNI S1,1 ;ELSE REMEMBER THERE'S NO SWITCH
PUSH P,S1 ;SAVE
PUSHJ P,P$CFM## ;GET EOL
POP P,S1 ;GET SWITCH VALUE OR FLAG BACK
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,SELINI ;INIT SELECTION STORAGE
JUMPE S1,.RETT ;RETURN IF JUST CLEARING SELECTION CRITERIA
SETOM SELFLG ;FLAG SELECTION IN PROGRESS
MOVEI U,USER ;POINT TO PROFILE BLOCK
MOVEI X,(U) ;ALWAYS NEED BOTH SETUP
MOVSI S1,(U) ;GET ADDR
HRRI S1,1(U) ;MAKE A BLT POINTER
SETZM (U) ;CLEAR FIRST WORD
BLT S1,.AEMAX-1(U) ;CLEAR OUT BLOCK
MOVE S1,[ACTFMT,,.AEMIN] ;INITIALIZE OVERHEAD WORD
MOVEM S1,.AEVRS(U) ;SO EXTENSIBLE BLOCKS WILL WORK
MOVEI S1,SEL000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /SELECT>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS AS IF IT WERE A PROFILE
$RETT ;RETURN
SUBTTL SELECT COMMAND -- SELCHK - CHECK FOR SELECTION IN PROGRESS
SELCHK: SKIPN SELFLG ;SELCTION IN PROGRESS?
$RETT ;NO
SETZM SELFNC ;CLEAR OUT ANY OLD FUNCTION CODE
PUSHJ P,P$KEYW## ;GET A KEYWORD
$RETIF ;CHECK FOR ERRORS
CAIL S1,400001 ;RANGE
CAILE S1,400003 ; CHECK
JRST SELCH1 ;NO GOOD
ANDI S1,777 ;MAKE SURE THERE'S NO JUNK
LSH S1,17 ;POSITION
MOVEM S1,SELFNC ;STORE AS FUNCTION CODE
$RETT ;AND RETURN
SELCH1: PUSHJ P,P$PREV## ;NOT A SELECT KEYWORD
$RETF ;GIVE UP
SUBTTL SELECT COMMAND -- SELHLP - HELP TEXT
SELHLP: ASCIZ \
Select command
\
SUBTTL SELECT COMMAND -- SELINI - INITIALIZE SELECTION STORAGE
SELINI: PUSH P,S1 ;SAVE S1
MOVSI S1,WILDBK+UW$SEL ;POINT TO START OF SELECTION DATA
HRRI S1,WILDBK+UW$SEL+1 ;MAKE A BLT POINTER
SETZM WILDBK+UW$SEL ;CLEAR FIRST WORD
BLT S1,WILDBK+PAGSIZ-1 ;CLEAR SELECTION STORAGE
; ***
; REPLACE NEXT INSTUCTION WITH ONES THAT WILL COMPUTE THE NUMBER
; OF AVAILABLE WORDS FOR SELECTION CRITERIA AS FOLLOWS:
; FREE SPACE = MAX - UUO - UW$DAT - OH
;
; WHERE MAX - MAXIMUM QUEUE. UUO PACKET LENGTH (^D510)
; UUO - QUEUE. UUO FUNCTION WORDS AND SUB-BLOCKS NEEDED
; TO SET UP THE WILDCARD CALL
; UW$DAT - WILDCARD DATA (PPN, MASK, NAME, ETC.)
; OH - MONITOR OVERHEAD WORDS APPENDED TO THE MESSAGE
;
; THIS CAN BE DONE IF VALUES FOR "MAX" AND "OH" ARE GETTABABLE.
; ***
ND Q.MAX,^D510 ;LONGEST NON-PAGE MESSAGE
ND Q.OH,2+3+9+2+.OHDRS ;NODE+NAME+ACCOUNT+.QBFNC+GALAXY
Q.UUO==2+1+UW$DAT ;.QBAFN+.QBAET
MOVSI S1,Q.OH+Q.UUO-Q.MAX ;MAKE A BAD GUESS FOR NOW
HRRI S1,WILDBK+UW$DAT ;MAKE AN AOBJN POINTER
MOVEM S1,SELPTR ;SAVE
PUSHJ P,PROZQM ;CLEAR OUT THE MODIFY MASKS
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
SUBTTL SELECT COMMAND -- MISCELLANEOUS
SEL000: $INIT (SEL010)
SEL010: $KEYDSP (SEL020,<$ALTER (ENT020)>)
SEL020: $STAB
DSPTAB (ENTSLC,400001,<AND>)
DSPTAB (ENTSLC,400003,<NOT>)
DSPTAB (ENTSLC,400002,<OR>)
$ETAB
SUBTTL VERIFY COMMAND -- VERIFY - ENTRY POINT
XWD VERHLP,[ASCIZ /Verify the accounting file from a master file/]
VERIFY: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE S1,[CHGMSK,,CHGMSK+1] ;BLT XFER WORD
SETOM CHGMSK ;TO FAKE OUT COMPAR
BLT S1,CHGMSK+.AEMIN-1 ;ALL MASKABLE WORDS CHANGED IN ALL BITS
PUSHJ P,INITIO## ;INIT RMS-10 INTERFACE
PUSHJ P,VERPRS ;PARSE ALL ARGUMENTS
PUSHJ P,VEROPN ;OPEN ALL NECESSARY FILES
$RETIF ;GIVE UP ON FAILURES
MOVEI U,USER ;MASTER PROFILE
MOVEI X,USER2 ;WORKING PROFILE
SETZM VERABO ;CLEAR ABORTED FLAG
SETZM VERDIF ;INIT DIFFERENCE COUNTER
PUSHJ P,VERUSR ;VERIFY USER PROFILES
SKIPE VERABO ;VERIFICATION ABORTED?
FATAL (AUA,<Accounting file verification aborted>,,VERIF1)
VERIF1: PUSHJ P,VERCLS ;CLOSE FILES
SKIPE SWTUPD ;SKIP IF /NOUPDATE
SKIPE VERABO ;ABORTING VERIFY?
JRST VERIF2 ;YES--DON'T SUPERSEDE WORKING FILE
MOVEI S1,TEMPFD ;FD FOR INPUT
MOVEI S2,WORKFD ;FD FOR OUTPUT
PUSHJ P,VERCPY ;COPY TEMPORARY FILE TO WORKING FILE
VERIF2: SKIPE SWTUPD ;SKIP IF /NOUPDATE
PUSHJ P,ERSC## ;ERASE (DELETE) TEMPORARY FILE "C"
SKIPE VERABO ;ABORTING VERIFY?
$RETT ;YES--ALL DONE
MOVE S1,VERDIF ;ANY DIFFERENCES?
CAIN S1,1 ;ONLY ONE
SKIPA S2,[[ITEXT (<; one difference>)]]
MOVEI S2,[ITEXT (<; ^D/S1/ differences>)]
SKIPN S1 ;UNLESS THERE WERE NONE
MOVEI S2,[ITEXT (<; no differences>)]
$TEXT (,<^M^J Accounting file verified^I/(S2)/>)
$RETT ;DONE
SUBTTL VERIFY COMMAND -- VERASK - ASK USER ABOUT DIFFERENCES
VERASK: SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERNO ;YES, TREAT AS NOT PRESERVING CHANGES
VERAS1: MOVEI S1,DELU00 ;PARSE TABLE SAME AS DELETE OPTIONS
MOVEI S2,[ASCIZ /Preserve changes? /] ;POINT TO PROMPT STRING
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF VERAS1 ;CHECK FOR ERRORS
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF VERAS1 ;CHECK FOR ERRORS
CAILE S1,VERLEN ;VALID KEYWORD?
JRST VERAS1 ;NO PROMPT AGAIN
JRST @VERTAB(S1) ;YES, DISPATCH
; KEYWORD DISPATCH TABLE
VERTAB: IFIW VERNO ;"NO"
IFIW VERQUI ;"QUIT"
IFIW VERSHO ;"SHOW"
IFIW VERYES ;"YES"
VERLEN==.-VERTAB ;LENGTH OF TABLE
; "NO" KEYWORD PROCESSOR
VERNO: $RETF ;DO NOT INCLUDE CHANGES
; "QUIT" KEYWORD PROCESSOR
VERQUI: SETOM VERABO ;FLAG TERMINATION
$RETF ;RETURN
; "SHOW" KEYWORD PROCESSOR
VERSHO: $TEXT (,< Profile from accounting file:>)
EXCH U,X ;POINT TO THE WORKING FILE
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;RESTORE
JRST VERASK ;LOOP BACK AND ASK AGAIN
; "YES" KEYWORD PROCESSOR
VERYES: $RETT ;INCLUDE CHANGES
SUBTTL VERIFY COMMAND -- VERCLS - CLOSE FILES
VERCLS: PUSHJ P,CLSA## ;CLOSE FILE "A"
PUSHJ P,CLSB## ;CLOSE FILE "B"
SKIPE SWTUPD ;SKIP IF /NOUPDATE
PUSHJ P,CLSC## ;CLOSE FILE "C"
$RETT ;YES--DONE
SUBTTL VERIFY COMMAND -- VERCMP - COMPARE PROFILES
VERCMP: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVSI P1,-QUETBL ;AOBJN LIMIT FOR QUETAB
VERUP1: MOVE S1,QUETAB(P1) ;GET THE PROFILE ENTRY
MOVE S2,CHGTAB##(S1) ;GET BITS FOR THIS OFFSET
TXNN S2,PD.NMD ;IF CAN'T MODIFY
TXNN S2,PD.UNP ;OR IF PRIV'ED
JRST VERUP0 ;THEN SKIP THIS ONE
TXNN S2,PD.EXT ;IF NOT EXTENSIBLE,
JRST VERUP2 ;GO HANDLE IT ELSEWHERE
MOVEI T1,(U) ;WHICH PROFILE TO MODIFY
MOVEI T3,(S1) ;OFFSET TO CHANGE
ADDI T3,(X) ;WHENCE TO FETCH
SKIPE T3,(T3) ;IF THERE,
ADDI T3,(X) ;DE-RELATIVIZE IT
HLLZ T2,T3 ;COPY LH
HRRI T2,(S1) ;INCLUDE PROFILE OFFSET IN CORRECT PLACE
ADJBP S1,[POINT 1,.AEMAP(X),0] ;POINT TO ITS 'DEFAULTED' BIT
LDB T4,S1 ;GET THAT, AS WELL
PUSHJ P,A$EBLK## ;UPDATE MASTER ENTRY FROM WORKING COPY
JRST VERUP0 ;LOOP OVER ALL UNPRIV'ED ENTRIES
VERUP2: LOAD S2,S2,PD.WRD ;GET LENGTH OF ENTRY
MOVNS S2 ;MAKE SUITABLE FOR AOBJN
HRLI S1,(S2) ;MAKE RELATIVE POINTER FOR LOOPING
MOVX P2,<IFIW (S1)> ;LH OF INDIRECTION
MOVE P3,P2 ;IN BOTH INDIRECT WORDS
HRRI P2,(U) ;POINTER FOR MASTER
HRRI P3,(X) ;POINTER FOR WORKING COPY
VERUP3: MOVE S2,@P3 ;GET WORKING VALUE
MOVEM S2,@P2 ;UPDATE IN MASTER ENTRY
AOBJN S1,VERUP3 ;LOOP OVER ALL WORDS IN ENTRY
VERUP0: AOBJN P1,VERUP1 ;LOOP OVER ALL PROFILE ENTRIES
VERCM0: MOVSI P1,-.AEMIN ;-LENGTH OF STATIC PORTION OF PROFILE
VERCM1: HRRZ S1,P1 ;GET PROFILE OFFSET
PUSHJ P,COMPAR ;GET TRUE IFF SAME
JUMPF VERCM6 ;SOMETHING CHANGED
$FALL VERCM5 ;ONWARD
VERCM5: AOBJN P1,VERCM1 ;LOOP
$RETT ;RETURN
; HERE WHEN PROFILES DIFFER
VERCM6: AOS VERDIF ;FLAG THE DIFFERENCE
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERCPY - COPY A FILE
; COPY A FILE
; CALL: MOVE S1, FD FOR INPUT
; MOVE S2, FD FOR OUTPUT
; PUSHJ P,VERCPY
VERCPY: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY ARGUMENTS
MOVE S1,[VERRFB,,VERRFB+1] ;ZERO FOB FOR READING
SETZM VERRFB
BLT S1,VERRFB+FOB.SZ-1
MOVE S1,[VERWFB,,VERWFB+1] ;ZERO FOB FOR WRITING
SETZM VERWFB
BLT S1,VERWFB+FOB.SZ-1
MOVEM P1,VERRFB+FOB.FD ;SAVE INPUT FD ADDRESS
MOVEM P2,VERWFB+FOB.FD ;SAVE OUTPUT FD ADDRESS
MOVEI S1,44 ;36-BIT BYTES
MOVEM S1,VERRFB+FOB.CW ;SAVE FOR INPUT
MOVEM S1,VERWFB+FOB.CW ;SAVE FOR OUTPUT
SETZB P1,P2 ;ZERO IFNS
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,VERRFB ;FOB ADDRESS
PUSHJ P,F%IOPN ;OPEN FILE FOR INPUT
JUMPF VERCP2 ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE IFN FOR INPUT
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,VERWFB ;FOB ADDRESS
PUSHJ P,F%OOPN ;OPEN FILE FOR OUTPUT
JUMPF VERCP3 ;CHECK FOR ERRORS
MOVE P2,S1 ;SAVE IFN FOR OUTPUT
; HERE WE CHEAT. SINCE WE'RE DOING AN IMAGE COPY, THE BYTE SIZE
; IS 36. GLXFIL WILL GIVE US AN BYTE POINTER TO THE DATA IN ITS
; INTERNAL BUFFER. WE'LL FIX UP THE ADDRESS (BYTE POINTER SET TO
; ILDB THROUGH THE BUFFER) AND GIVE IT RIGHT BACK TO GLXFIL FOR
; OUTPUT.
VERCP1: MOVE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%IBUF ;READ A BUFFER
JUMPF VERCP4 ;CHECK FOR ERRORS
AOS S2 ;POINT TO FIRST DATA WORD
HRL S2,S1 ;GET NUMBER OF WORDS
MOVE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%OBUF ;WRITE A BUFFER
JUMPF VERCP5 ;CHECK FOR ERRORS
JRST VERCP1 ;LOOP
; OPEN ERRORS
VERCP2: SKIPA S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP3: MOVE S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
WARN (OPE,<Open error on ^F/(S2)/; ^E/S1/>,,VERCP6)
; I/O ERRORS
VERCP4: SKIPA S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP5: MOVE S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
CAIE S1,EREOF$ ;END OF FILE?
WARN (IOE,<I/O error on ^D/(S2)/; ^E/S1/>,,VERCP6)
MOVE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%REL ;RELEASE IT
MOVE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%REL ;RELEASE IT
$RETT ;RETURN
; CLOSE FILES ON ERRORS
VERCP6: SETOM VERABO ;FLAG ABORT
SKIPE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%RREL ;RELEASE IT
SKIPE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%RREL ;RELEASE IT
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERHLP - HELP TEXT
VERHLP: ASCIZ \
The VERIFY command enables you to maintain a master copy of the
accounting file in addition to the working copy on SYS. You can make
changes to the working copy of the accounting file without shutting down
the entire accounting system.
When you issue the VERIFY command, REACT displays the differences
between the master accounting file and the working accounting file. You
can preserve the changes in the working file or discard them. When the
update is complete, the working copy of the accounting file on SYS
reflect the changes you made.
\
SUBTTL VERIFY COMMAND -- VEROPN - OPEN FILES
; FILE "A" - MASTER FILE (DSK:MASTER.SYS)
; FILE "B" - WORKING FILE (SYS:ACTDAE.SYS)
; FILE "C" - TEMPORARY FILE (DSK:###REA.TMP)
VEROPN: MOVEI S1,MASTFN ;MASTER FILESPEC
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNA## ;OPEN FILE "A"
SKIPT ;CHECK FOR ERROR
FATAL (OPF,<Open failed for ^T/MASTFN/>,,VEROP6)
MOVE S1,[MASTWB,,MASTWB+1] ;SET UP BLT
SETZM MASTWB ;CLEAR FIRST WORD
BLT S1,MASTWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
SKIPE DEBUGW ;DEBUGGING?
SKIPA S1,[SIXBIT/DSK/] ;YES
MOVSI S1,'SYS' ;NO
$TEXT (<-1,,WORKFN>,<^W/S1/:^W/[ACTFIL]/.SYS^0>)
MOVEI S1,WORKFN ;WORKING FILESPEC
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNB## ;OPEN FILE "B"
SKIPT ;CHECK FOR ERROR
FATAL (OPF,<Open failed for ^T/WORKFN/>,,VEROP5)
MOVE S1,[WORKWB,,WORKWB+1] ;SET UP BLT
SETZM WORKWB ;CLEAR FIRST WORD
BLT S1,WORKWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VEROP1 ;ALMOST DONE
PJOB S1, ;GET OUR JOB NUMBER
$TEXT (<-1,,TEMPFN>,<DSK:^D3R0/S1/REA.TMP^0>)
MOVEI S1,TEMPFN ;TEMP FILE NAME STRING
MOVEI S2,1 ;ALLOW WRITING
PUSHJ P,OPNC## ;OPEN FILE "C"
SKIPT ;CHECK FOR ERROR
FATAL (OPE,<Open failed for ^T/TEMPFN/>,,VEROP3)
MOVEI S1,1 ;OPTION 1, SET LOAD FLAG
MOVEI S2,1 ;TURN ON LOAD FLAG FOR TEMP FILE
PUSHJ P,OPTC## ;PERFORM THE FUNCTION
MOVE S1,[TEMPWB,,TEMPWB+1] ;SET UP BLT
SETZM TEMPWB ;CLEAR FIRST WORD
BLT S1,TEMPWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
VEROP1: $TEXT (,<>) ;START WITH A BLANK LINE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTA## ;GET FILESPEC FOR FILE "A"
MOVEI T1,MASTFD ;FD STORAGE
MOVEI T2,[ASCIZ /Master file: /]
PUSHJ P,VEROP3 ;REPORT FILE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTB## ;GET FILESPEC FOR FILE "B"
MOVEI T1,WORKFD ;FD STORAGE
MOVEI T2,[ASCIZ /Accounting file:/]
PUSHJ P,VEROP3 ;REPORT FILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VEROP2 ;ELSE ALMOST DONE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET FILESPEC FOR FILE "C"
MOVEI T1,TEMPFD ;FD STORAGE
MOVEI T2,[ASCIZ /Temporary file: /]
PUSHJ P,VEROP3 ;REPORT FILE
VEROP2: MOVEI S1,[ASCIZ /Verifying: /]
MOVEI T1,[ASCIZ ./REPORT.]
SKIPG SWTRPT ;/REPORT?
MOVEI T1,[ASCIZ//] ;NO
MOVEI T2,[ASCIZ ./UPDATE.]
SKIPG SWTUPD ;/UPDATE?
MOVEI T2,[ASCIZ//] ;NO
$TEXT (,< ^T/(S1)/ ^Q/WILDBP/ ^T/(T1)/ ^T/(T2)/^M^J>)
$RETT ;RETURN
VEROP3: MOVEI T3,(T1) ;GET START OF FD STORAGE
HRRI T1,.FDSTR(T1) ;START OF ACTUAL FILESPEC DATA
HRLI T1,.FOFDV(S2) ;MAKE A BLT POINTER
BLT T1,FDXSIZ-1(T3) ;COPY FILESPEC
MOVSI S1,FDXSIZ ;GET LENGTH,,FILE TYPE (NATIVE)
MOVEM S1,.FDLEN(T3) ;SAVE IN FD
$TEXT (,< ^T/(T2)/ ^F/(T3)/>) ;REPORT FILE TO USER
$RETT ;RETURN
VEROP4: PUSHJ P,CLSB## ;CLOSE FILE "B"
VEROP5: PUSHJ P,CLSA## ;CLOSE FILE "A"
VEROP6: SETOM VERABO ;FLAG ABORT
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERPRS - PARSE ARGUMENTS
VERPRS: SETOM VERALL ;ASSUME WILL VERIFY ALL PROFILES
SETZB S1,S2 ;WILDCARD PPN AND MASK FOR [*,*]
MOVEM S1,WILDBK+UW$PPN ;SAVE DEFAULT PPN
MOVEM S2,WILDBK+UW$PPM ;SAVE DEFAULT MASK
PUSHJ P,P$FILE## ;GET POINTER TO FILESPEC
$RETIF ;RETURN ON ERROR
MOVEI S2,.FDNAT ;NATIVE MODE FILESPEC
STORE S2,.FDLEN(S1),FD.TYP ;SET IN FD
$TEXT (<-1,,MASTFN>,<^F/(S1)/^0>)
PUSHJ P,PRSSWT ;PARSE SOME SWITCHES
$RETIT ;RETURN IF EOL
PUSHJ P,PRSWLD ;CAN ONLY BE A USER-ID AT THIS POINT
$RETIF ;RETURN ON ERROR
SKIPN S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
SKIPE S2,WILDBK+UW$PPM ;GET PPN MASK
CAIA ;NEED TO CHECK HARDER
JRST VERPR3 ;STILL DOING ALL PROFILES, GET SWITCHES
SETZM VERALL ;NOT ALL PPNS, ASSUME SELECTIVE
CAIE S1,1 ;CORRECT ASSUMPTION?
JRST VERPR3 ;DEFINITELY, LOOK FOR SWITCHES
MOVEI TF,.AANLC ;MAXIMUM NUMBER OF CHARACTERS IN A NAME
MOVE S1,[POINT 8,WILDBK+UW$NAM] ;WHERE THE NAME WAS STORED
VERPR1: ILDB S2,S1 ;GET NEXT CHARACTER FROM NAME
JUMPE S2,VERPR2 ;DONE
CAIN S2,"*" ;IF STILL FULLY WILD,
SOJG TF,VERPR1 ;KEEP LOOKING
JRST VERPR3 ;SELECTIVE VERIFY GUESS WAS CORRECT
VERPR2: CAIE TF,.AANLC ;UNLESS NAME IS NULL,
SETOM VERALL ;NAME OF **... IS STILL FINDING ALL PROFILES
VERPR3: PUSHJ P,PRSSWX ;MAYBE MORE SWITCHES?
$RETIF ;NO SWITCHES OR EOL
MOVEI S1,1 ;GET A "YES"
SKIPGE SWTUPD ;/UPDATE?
MOVEM S1,SWTUPD ;DEFAULT TO YES
SKIPGE SWTRPT ;/REPORT?
MOVEM S1,SWTRPT ;DEFAULT TO YES
$RETT ;RETURN
SUBTTL VERIFY COMMAND -- VERRPT - REPORT DIFFERENCES IN PROFILE
VERRPT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,CVTPPD ;CONVERT PPN
WARN (DIF,<Difference in profile for ^T/(S1)/ ^Q/USRNAM/>)
SKIPG SWTRPT ;/REPORT?
$RETT ;NO
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
VERRP1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
SKIPGE S1,CG.PFL(P2) ;PROFILE OFFSET
JRST VERRP2 ;THERE IS NONE
MOVE S1,CHGTAB##(S1) ;FLAGS
TXNE S1,PD.UNP!PD.NMD ;UNPRIV'ED DATA OR INVALID FOR COMPARE?
JRST VERRP2 ;DON'T BOTHER LOOKING AT IT
PUSHJ P,@CG.CMP(P2) ;CALL THE COMPARE ROUTINE FOR THIS ITEM
JUMPT VERRP2 ;FIELD IS THE SAME
$TEXT (,< ^T/@CG.PRM(P2)/: >) ;TYPE OUT HEADER
$TEXT (,< Master file: ^A>)
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
$TEXT (,< Accounting file: ^A>)
EXCH U,X ;SWAP POINTER
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
EXCH U,X ;RESTORE
$TEXT (,<>) ;END ENTRY WITH A BLANK LINE
VERRP2: AOBJN P1,VERRP1 ;LOOP
$RETT ;RETURN
SUBTTL VERUSR COMMAND -- VERUSR - VERIFY USER PROFILES
VERUSR: MOVE S1,[USER,,USER+1] ;ZERO MASTER BUFFER
SETZM USER
BLT S1,USER+.AEMAX-1
MOVE S1,[USER2,,USER2+1] ;ZERO WORKING FILE BUFFER
SETZM USER2
BLT S1,USER2+.AEMAX-1
SKIPE VERALL ;VERIFYING ALL PROFILES
JRST VERUS1 ;YES
MOVE S1,[WILDBK,,MASTWB] ;SET UP BLT
BLT S1,MASTWB+UW$MIN ;COPY
MOVE S1,[WILDBK,,WORKWB] ;SET UP BLT
BLT S1,WORKWB+UW$MIN ;COPY
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS1 ;DON'T NEED TEMP FILE STUFF
PUSHJ P,CLSC## ;CLOSE THE FILE
MOVEI S1,WORKFD ;POINT TO WORKING FILE
MOVEI S2,TEMPFD ;AND TO TEMPORARY FILE
PUSHJ P,VERCPY ;COPY TEMP=WORKING
MOVEI S1,TEMPFN ;POINT TO TEMP FILE NAME
MOVEI S2,1 ;WRITE
PUSHJ P,OPNC## ;OPEN FOR WRITING
JUMPT VERUS1 ;CONTINUE IF NO ERRORS
SETOM VERABO ;ABORT THE VERIFY
FATAL (OPE,<Open failed for ^T/TEMPFN/>,,.RETF)
VERUS1: SKIPE VERABO ;DID SOMEBODY ABORT?
$RETF ;YES, GIVE UP
SKIPE S1,MASTEF ;GET MASTER EOF FLAG
CAME S1,WORKEF ;EOF ON WORKING FILE TOO?
SKIPA S1,.AEPPN(U) ;GET MASTER FILE PPN
$RETT ;DONE
MOVE S2,.AEPPN(X) ;GET WORKING FILE PPN
TXC S1,1B0 ;FLIP SIGN BITS
TXC S2,1B0 ;FOR PROPER COMPARISONS
CAME S1,S2 ;FILES IN SYNCH?
JRST VERUS4 ;NO
PUSHJ P,VERRDM ;READ PROFILE FROM MASTER FILE
$RETIF ;RETURN ON I/O ERRORS
PUSHJ P,VERRDW ;READ PROFILE FROM WORKING FILE
$RETIF ;RETURN ON I/O ERRORS
VERUS2: SKIPE S1,MASTEF ;GET MASTER EOF FLAG
CAME S1,WORKEF ;EOF ON WORKING FILE TOO?
SKIPA S1,.AEPPN(U) ;GET MASTER FILE PPN
$RETT ;DONE
MOVE S2,.AEPPN(X) ;GET WORKING FILE PPN
TXC S1,1B0 ;FLIP SIGN BITS
TXC S2,1B0 ;FOR PROPER COMPARISONS
SKIPE MASTEF ;GET MASTER EOF FLAG
JRST VERUS8 ;WORKING FILE PROFILE IS NEW
SKIPE WORKEF ;GET WORKING EOF FLAG
JRST VERUS5 ;MASTER PROFILE IS MISSING
CAMGE S1,S2 ;SAME?
JRST VERUS5 ;NO
CAMLE S1,S2 ;CHECK AGAIN
JRST VERUS8 ;NO
PUSHJ P,VERCMP ;COMPARE PROFILES
JUMPT VERUS3 ;LOOP BACK IF SAME
PUSHJ P,VERRPT ;REPORT DIFFERENCES
PUSHJ P,VERASK ;INCLUDE CHANGES?
MOVEI S1,(X) ;POINT TO CHANGED PROFILE
SKIPT ;SKIP IF ANSWER WAS "YES"
MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS1 ;ELSE LOOP BACK
PUSHJ P,VERWTT ;COPY INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
JRST VERUS1 ;LOOP BACK
VERUS3: MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPE SWTUPD ;SKIP IF /NOUPDATE (TF ALWAYS TRUE HERE)
PUSHJ P,VERWTT ;COPY INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
PUSHJ P,CVTPPF ;CONVERT PPN
$TEXT (,< ^T/(S1)/ ^Q/USRNAM/>)
JRST VERUS1 ;LOOP BACK
VERUS4: CAML S1,S2 ;A NEW PROFILE IN THE MASTER FILE?
JRST VERUS7 ;NO
VERUS5: PUSHJ P,CVTPPD ;CONVERT PPN
MOVEI S2,.AENAM(U) ;POINT TO NAME
HRLI S2,(POINT 8,) ;8-BIT ASCIZ
WARN (PNW,<Profile for ^T/(S1)/ ^Q/S2/ not in working file>)
AOS VERDIF ;COUNT THE DIFFERENCE
SKIPE SWTRPT ;SKIP IF /NOREPORT
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;DISPLAY CORRECT PROFILE
PUSHJ P,VERASK ;INCLUDE CHANGES?
EXCH U,X ;RESTORE
JUMPT VERUS6 ;JUMP IF ANSWER WAS "YES"
MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS6 ;ELSE GO READ ANOTHER PROFILE
PUSHJ P,VERWTT ;WRITE INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
VERUS6: PUSHJ P,VERRDM ;READ ANOTHER PROFILE FROM MASTER FILE
$RETIF ;RETURN ON I/O ERRORS
JRST VERUS2 ;LOOP BACK
VERUS7: CAMG S1,S2 ;A NEW PROFILE IN THE WORKING FILE?
JRST VERUS1 ;NO
VERUS8: EXCH U,X ;SWAP
PUSHJ P,CVTPPD ;CONVERT PPN
MOVEI S2,.AENAM(U) ;POINT TO NAME
HRLI S2,(POINT 8,) ;8-BIT ASCIZ
WARN (PNM,<Profile for ^T/(S1)/ ^Q/S2/ not in master file>)
AOS VERDIF ;COUNT THE DIFFERENCE
SKIPE SWTRPT ;SKIP IF /NOREPORT
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;RESTORE
PUSHJ P,VERASK ;INCLUDE CHANGES?
JUMPF VERUS9 ;JUMP IF ANSWER WAS "NO"
MOVEI S1,(X) ;POINT TO WORKING PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS9 ;ELSE GO READ ANOTHER PROFILE
PUSHJ P,VERWTT ;WRITE INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
VERUS9: PUSHJ P,VERRDW ;READ ANOTHER PROFILE FROM WORKING FILE
$RETIF ;RETURN ON I/O ERRORS
JRST VERUS2 ;LOOP BACK
SUBTTL VERIFY COMMAND -- MISCELLANEOUS
; READ A PROFILE FROM THE MASTER FILE
VERRDM: SKIPE MASTEF ;AT EOF?
$RETT ;YES
MOVEI S1,(U) ;MASTER PROFILE
MOVEI S2,MASTWB ;POINT TO MASTER WILDCARD BLOCK
PUSHJ P,GETA## ;GET A PROFILE FROM FILE "A"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTA## ;GET LAST I/O ERROR ON FILE "A"
MOVEI S2,MASTFD ;POINT TO FD INCASE OF ERROR
CAIE S1,ER$RNF## ;RECORD NOT FOUND?
JRST VERIER ;UNEXPECTED ERROR
SETOM MASTEF ;THAT'S END-OF-FILE
$RETT ;RETURN
; READ A PROFILE FROM THE WORKING FILE
VERRDW: SKIPE WORKEF ;AT EOF?
$RETT ;YES
MOVEI S1,(X) ;WORKING PROFILE
MOVEI S2,WORKWB ;POINT TO WORKING WILDCARD BLOCK
PUSHJ P,GETB## ;GET A PROFILE FROM FILE "B"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTB## ;GET LAST I/O ERROR ON FILE "B"
MOVEI S2,WORKFD ;POINT TO FD INCASE OF ERROR
CAIE S1,ER$RNF## ;RECORD NOT FOUND?
JRST VERIER ;UNEXPECTED ERROR
SETOM WORKEF ;THAT'S END-OF-FILE
$RETT ;RETURN
; UPDATE A PROFILE IN THE TEMPORARY FILE
VERUPT: PUSHJ P,UPDC## ;UPDATE THE PROFILE IN FILE "C"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET LAST I/O ERROR ON FILE "C"
MOVEI S2,TEMPFD ;POINT TO FD
JRST VERUER ;REPORT UPDATE ERROR AND ABORT
; WRITE A PROFILE INTO THE TEMPORARY FILE
VERWTT: MOVEI S2,PUTC## ;ASSUME WRITING A NEW FILE
SKIPN VERALL ;SELECTIVE VERIFY?
MOVEI S2,UPDC## ;YES--JUST DO AN UPDATE
PUSHJ P,(S2) ;STUFF A PROFILE INTO THE TEMP FILE
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET LAST I/O ERROR ON FILE "C"
MOVEI S2,TEMPFD ;POINT TO FD
JRST VEROER ;REPORT OUTPUT ERROR AND ABORT
; REPORT I/O ERRORS AND ABORT
VERIER: WARN (IER,<Input error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VEROER: WARN (OER,<Output error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERUER: WARN (UER,<Update error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERIOX: SETOM VERABO ;LITE THE ABORT FLAG
$RETF ;RETURN
; DUMMY ROUTINES FOR ACTCHG
UGAUX%::$RETF
SUBTTL PARSING ROUTINES -- PRSCMD - SCAN A COMMAND
;Call
; S1/ Parser table
; S2/ Prompt string
;Return
; RETT - Command parsed
; RETF - Otherwise, error message issued.
PRSCMD::MOVEM S1,PARBLK+PAR.TB ;PARSE TABLE ADDRESS
MOVEM S2,PARBLK+PAR.PM ;PROMPT STRING ADDRESS
PRSCM1: MOVE S1,[PARBUF,,PARBUF+1] ;SET UP BLT
SETZM PARBUF ;CLEAR FIRST WORD
BLT S1,PARBUF+PAGSIZ-1 ;CLEAR PARSER PAGE
MOVEI S1,PARBUF ;SCRATCH AREA FOR PARSING
MOVEM S1,PARBLK+PAR.CM
MOVEI S2,COM.SZ-1 ;SIZE OF SCRATCH HEADER
STORE S2,.MSTYP(S1),MS.CNT ;INITIALIZE SCRATCH BLOCK
SETZM PARBLK+PAR.SR ;INPUT COMES FROM TTY
MOVEI S1,PAR.SZ ;SIZE OF PARSER BLOCK
MOVEI S2,PARBLK ;LOCATION OF PARSER BLOCK
PUSHJ P,PARSER## ;PARSE A COMMAND
JUMPF PRSCM2 ;ON ERROR, BITCH.
MOVEI S1,COM.SZ+PARBUF ;POINT TO TOKENS
PUSHJ P,P$SETU## ;SET UP FOR RETRIEVAL
$RETIT ;AND RETURN IF ALL IS WELL
PRSCM2: WARN (CME,<Command error; ^T/@PRT.EM(S2)/>,,PRSCM1)
; HERE ON FATAL ERRORS
PRSERR::FATAL (CPF,<Command parse failure>)
SUBTTL PARSING ROUTINES -- PRSSWT - SWITCHES
PRSSWT: MOVE S1,[SWTTAB,,SWTTAB+1] ;SET UP BLT
SETOM SWTTAB ;INIT FIRST WORD
BLT S1,SWTTAB+SWTLEN-1 ;INIT SWITCH STORAGE
PRSSWX: PUSHJ P,P$SWIT## ;GET A SWITCH
JUMPF P$CFM## ;NOT THERE--TRY FOR EOL AND RETURN
HRRZ S2,(S1) ;GET SWITCH STORAGE ADDRESS
HLRZ S1,(S1) ;GET VALUE TO STORE
MOVEM S1,(S2) ;SAVE IT
JRST PRSSWX ;LOOP BACK FOR MORE
SUBTTL PARSING ROUTINES -- PRSWLD - USER ID
PRSWLD::MOVEI T1,WILDBK ;POINT TO WILDCARD BLOCK
MOVE T2,[POINT 8,WILDAK] ;BYTE POINTER TO ACK TEXT
MOVEM T2,WILDBP ;SAVE FOR SUMMARY
PUSHJ P,A$PWLD## ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
SETZM PROFAI ;ZERO FAILURE COUNTER
SETZM PROSUC ;ZERO SUCCESS COUNTER
$RETT ;RETURN
PRSALT::MOVEI T1,ALTRBK ;POINT TO WILDCARD BLOCK
MOVE T2,[POINT 8,ALTRAK] ;BYTE POINTER TO ACK TEXT
MOVEM T2,ALTRBP ;SAVE FOR SUMMARY
PUSHJ P,A$PWLD## ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
$RETT ;RETURN
SUBTTL UTILITY ROUTINES -- CVTPPD - CONVERT A PPN FOR DETAILED LISTING
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,CVTPPD
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT
CVTPPD: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,[ITEXT (<^O/S1/>)]
MOVEI P2,[ITEXT (<^O/S2/>)]
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
HRRZ S2,.AEPPN(U) ;AND PROGRAMMER NUMBER
CAIN S1,-1 ;DEFAULT PROJECT?
MOVEI P1,[ITEXT (<%>)] ;YES
CAIN S2,-1 ;DEFAULT PROGRAMMER?
MOVEI P2,[ITEXT (<%>)] ;YES
CAIN S2,-2 ;WILD PROGRAMMER?
MOVEI P2,[ITEXT (<#>)] ;YES
$TEXT (<-1,,PPNTXT>,<[^I/(P1)/,^I/(P2)/]^0>)
MOVEI S1,PPNTXT ;POINT TO TEXT
POPJ P, ;AND RETURN
SUBTTL UTILITY ROUTINES -- CVTPPF - CONVERT A PPN FOR FAST LISTING
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,CVTPPF
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT
CVTPPF: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,[ITEXT (<^O6R /S1/>)]
MOVEI P2,[ITEXT (<^O6L /S2/>)]
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
HRRZ S2,.AEPPN(U) ;AND PROGRAMMER NUMBER
CAIN S1,-1 ;DEFAULT PROJECT?
MOVEI P1,[ITEXT (< %>)] ;YES
CAIN S2,-1 ;DEFAULT PROGRAMMER?
MOVEI P2,[ITEXT (<% >)] ;YES
CAIN S2,-2 ;WILD PROGRAMMER?
MOVEI P2,[ITEXT (<# >)] ;YES
$TEXT (<-1,,PPNTXT>,<^I/(P1)/,^I/(P2)/^0>)
MOVEI S1,PPNTXT ;POINT TO TEXT
POPJ P, ;AND RETURN
SUBTTL UTILITY ROUTINES -- PRTBTS - BIT TABLE DRIVEN OUTPUT
; PRTBTS - PRINT OUT NAMES OF BITS WHICH ARE ON
; PRTBTX - SAME AS ABOVE, EXCEPT, IF NONE, DON'T TYPE "-NONE-"
; CALL: MOVE S1, IOWD TO TABLE OF BYTE POINTERS,,ASCIZ NAMES
PRTBTX::TDZA S2,S2
PRTBTS::SETOM S2 ;INDICATE ENTRY
JUMPGE S1,.POPJ ;RETURN IF TABLE IS EMPTY
PUSHJ P,.SAVET ;SAVE T ACS
SETO T3, ;COUNT ARGS TYPED OUT
PRTBT1: HLRZ T1,1(S1) ;GET POINTER TO BYTE POINTER
LDB T2,(T1) ;GET BYTE
JUMPE T2,PRTBT2 ;NOTHING THERE, IGNORE
HRRZ T1,1(S1) ;GET POINTER TO ASCIZ NAME
AOSE T3 ;INCREMENT NUMBER OF ARGS TYPED OUT
$TEXT (,<, ^A>) ;SEPARATE FROM PREVIOUS ARBUMENT
$TEXT (,<^T/(T1)/^A>) ;TYPE IT OUT
PRTBT2: AOBJN S1,PRTBT1 ;LOOP
SKIPGE T3 ;DID WE TYPE ANYTHING?
JUMPE S2,.POPJ ;NO, RETURN IF WE DON'T SAY SO
SKIPGE T3 ;TYPE ANYTHING?
$TEXT (,<-none-^A>) ;NO, INDICATE THE FACT
$TEXT (,<>) ;END IT WITH A CRLF
POPJ P, ;RETURN
SUBTTL UTILITY ROUTINES -- TYPUSR - DISPLAY A PROFILE
; HERE TO DUMP A PROFILE ON THE TERMINAL OR TO A FILE
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,TYPUSR
TYPUSR: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI S1,ENTDEC ;POINT TO DEC-DEFINED PROFILE ENTRY TABLE
PUSHJ P,TYPUS1 ;DISPLAY
MOVEI S1,ENTCUS## ;POINT TO CUSTOMER-DEFINED PROFILE ENTRY TABLE
TYPUS1: HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
JUMPGE P1,.RETT ;RETURN IF TABLE IS EMPTY
TYPUS2: HRRZ P2,(P1) ;GET A PROFILE ENTRY VECTOR ADDRESS
MOVE T1,CG.FLG(P2) ;GET FLAGS
TXNE T1,FL.NTY ;NO TYPEOUT?
JRST TYPUS3 ;SKIP IT
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
TYPUS3: MOVX T1,FL.XCR ;BIT TO TEST
TDNE T1,CG.FLG(P2) ;WANT AN EXTRA CRLF?
$TEXT (,<>) ;YES
AOBJN P1,TYPUS2 ;AND LOOP
$RETT ;DONE
SUBTTL UTILITY ROUTINES -- WLDWCK - CHECK FOR WILDCARDED USER-ID
WLDACK: MOVE S1,ALTRBK+UW$WST ;GET WILDCARD SEARCH TYPE
MOVE S2,ALTRBK+UW$PPM ;GET POSSIBLE PPN MASK
JRST WLDCH1 ;ENTER COMMON CODE
WLDWCK: MOVE S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
MOVE S2,WILDBK+UW$PPM ;GET POSSIBLE PPN MASK
WLDCH1: CAIN S1,2 ;NON-WILD NAME?
$RETF ;YES
CAIE S1,1 ;WILD NAME?
AOSE S2 ;NO--WILD PPN?
$RETT ;WILD
$RETF ;NON-WILD
SUBTTL UTILITY ROUTINES -- WLDUSR - FETCH A PROFILE
; QUEUE UP A REQUEST TO THE ACCOUNTING DAEMON FOR A PROFILE
WLDUSR::HRRZ T1,SELPTR ;GET POINTER TO FIRST FREE
SKIPN T1 ;IF NONE,
MOVEI T1,WILDBK+UW$MIN ;ASSUME MINIMAL
SUBI T1,WILDBK ;COMPUTE WORDS OF SELECTION DATA
HRLM T1,WILDBK+UW$TYP ;SAVE MESSAGE LENGTH
MOVEI T1,WILDBK ;POINT TO WILDCARD BLOCK
MOVEI T2,USER ;POINT TO RESPONSE BLOCK
SKIPE T3,DEBUGW ;IF DEBUGGING,
MOVSI T3,ACTPID ;TRY TO USE THE ALTERNATE PID
SKIPN DEBUGQ ;WANT TIMING?
HRRI T3,ZZTIME ;YEP
SETCM T4,UNPRIV ;GET PRIV FLAG
PJRST A$QWLD## ;RETURN RESULT OF WILDCARD REQUEST
ALTUSR::MOVEI T1,UW$MIN ;LENGTH OF BLOCK
HRLM T1,ALTRBK+UW$TYP ;SAVE IN MESSAGE
MOVEI T1,ALTRBK ;POINT TO WILDCARD BLOCK
MOVEI T2,USER ;POINT TO RESPONSE BLOCK
SKIPE T3,DEBUGW ;IF DEBUGGING,
MOVSI T3,ACTPID ;TRY TO USE THE ALTERNATE PID
SKIPN DEBUGQ ;WANT TIMING?
HRRI T3,ZZTIME ;YEP
SETCM T4,UNPRIV ;GET PRIV FLAG
PJRST A$QWLD## ;RETURN RESULT OF WILDCARD REQUEST
SUBTTL UTILITY ROUTINES -- WLDSUM - GENERATE A WILDCARD SUMMARY
WLDSUM: MOVEI T1,WILDBK ;POINT TO WILDCARD MESSAGE BLOCK
MOVE T2,WILDBP ;GET BYTE POINTER TO ACK TEXT
MOVE T3,S1 ;GET TEXT
HRLZ T4,PROSUC ;GET SUCCESS COUNT
HRR T4,PROFAI ;AND FAILURE COUNT
PUSHJ P,A$SWLD## ;GENERATE SUMMARY TEXT
SKIPT ;AT LEAST ONE PROFILE FOUND?
FATAL (NSU,<^T/(S1)/>,,.RETF)
$TEXT (,<^M^J ^T/(S1)/>)
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROFIL - MAIN LOOP
PROFIL: DMOVEM S1,PROARG ;SAVE COMMAND TABLE AND PROMPT
PROFI1: DMOVE S1,PROARG ;GET COMMAND TABLE AND PROMPT
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PROFI1 ;TRY AGAIN
SETZM PRSDFV ;NOT A DEFAULT VALUE YET
PUSHJ P,SELCHK ;CHECK FOR SELECTION IN PROGRESS
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PROFI1 ;TRY AGAIN
CAIG S1,PROLEN ;IS THIS AN ADDRESS OR NUMBER
JRST PROFI3 ;GO PROCESS A COMMON COMMAND
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P1) ;GET PROFILE ENTRY INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SAVE FOR SUBROUTINE
PUSHJ P,@CG.GET(P1) ;CALL PARSE ROUTINE IN ENTRY
SKIPE SELFLG ;SELCTION IN PROGRESS?
PUSHJ P,@CG.CHG(P1) ;YES--STORE DATA AWAY
JRST PROFI1 ;AND ASK FOR ANOTHER KEYWORD
PROFI3: PUSHJ P,@PROTAB-1(S1) ;DISPATCH
JUMPT PROFI1 ;LOOP BACK
$RETF ;GIVE UP
; KEYWORD DISPATCH TABLE
PROTAB: IFIW PRODFL ;"DEFAULT"
IFIW PRODON ;"DONE"
IFIW PROHEL ;"HELP"
IFIW PROQUI ;"QUIT"
IFIW PRORES ;"RESTORE"
IFIW PROSHO ;"SHOW"
PROLEN==.-PROTAB ;LENGTH OF TABLE
SUBTTL PROFILE PROCESSING -- PRODFL - COMMON TOPLEVEL "DEFAULT" COMMAND
PRODFL: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S1,CG.IDX(P1) ;GET CHANGE BLOCK INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SET FOR ROUTINE
PJRST @CG.DFL(P1) ;DEFAULT THE FIELD & RETURN
PRODFZ::WARN (MND,<Entry may not be defaulted>,,.RETT)
SUBTTL PROFILE PROCESSING -- PRODON - COMMON TOPLEVEL "DONE" COMMAND
PRODON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
JUMPF PRODO1 ;PERHAPS NOT
$TEXT (,<>) ;PUT OUT A BLANK LINE
JRST PRODO2 ;AND FINISH UP
PRODO1: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PRODO2: POP P,(P) ;POP OFF CALLER
$RETT ;RETURN TO TOP LEVEL
SUBTTL PROFILE PROCESSING -- PROHEL - COMMON TOPLEVEL "HELP" COMMAND
PROHEL: PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;FAILED
CAIG S1,PROLEN ;IS THIS AN ADDRESS OR NUMBER
$RETF ;SHOULD NEVER GET HERE
PUSH P,S1 ;SAVE
PUSHJ P,P$CFM## ;GET EOL
POP P,S1 ;RESTORE
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S2,CG.HLP(S1) ;GET ADDRESS OF HELP TEXT
$TEXT (,<^T/(S2)/>) ;DISPLAY TEXT
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROQUI - COMMON TOPLEVEL "QUIT" COMMAND
PROQUI: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPE SELFLG ;SELECTION IN PROGRESS?
JRST PROQU1 ;YES
PUSHJ P,PRORE1 ;GET ORIGINAL PROFILE (NAME MIGHT HAVE CHANGED)
PUSHJ P,CVTPPD ;CONVERT PPN
INFO (UPT,<User ^T/(S1)/ ^Q/USRNAM/ profile processing aborted>)
$RETF ;RETURN
PROQU1: PUSHJ P,SELINI ;RESET SELECTION STORAGE
INFO (SAB,<Selection aborted>,,.RETF)
SUBTTL PROFILE PROCESSING -- PRORES - COMMON TOPLEVEL "RESTORE" COMMAND
PRORES: PUSHJ P,.SAVE1 ;SAVE P1
MOVNI P1,1 ;ASSUME NO KEYWORD SPECIFIED
PUSHJ P,P$KEYW## ;TRY FOR A KEYWORD
SKIPF ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPL P1,PRORE1 ;JUMP IF NO KEYWORD
MOVE S1,CG.IDX(P1) ;GET PROFILE ENTRY INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SAVE FOR PROFILE SUBROUTINE
PUSHJ P,@CG.RES(P1) ;RESTORE DATA
$RETT ;AND RETURN
PRORE1: MOVSI S1,(X) ;POINT TO OLD PROFILE
HRRI S1,(U) ;AND TO WORKING COPY
BLT S1,.AEMAX-1(U) ;RESTORE ORIGINAL
PUSHJ P,PROZCH ;ZERO CHANGE TABLE FLAGS
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROSHO - COMMON TOPLEVEL "SHOW" COMMAND
PROSHO: PUSHJ P,.SAVE1 ;SAVE P1
MOVNI P1,1 ;ASSUME NO KEYWORD SPECIFIED
PUSHJ P,P$KEYW## ;TRY FOR A KEYWORD
SKIPF ;GOT ONE
MOVE P1,S1 ;COPY PROFILE VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPL P1,ENTSH1 ;JUMP IF NO KEYWORD
MOVEI S1,(P1) ;VECTOR ADDRESS
PUSHJ P,PROPRT ;PRINT DATA
$RETT ;RETURN
ENTSH1: PUSHJ P,TYPUSR ;TYPE THE PROFILE
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROBLK - EXTENSIBLE BLOCKS
; ROUTINE TO TO ADD OR DELETE EXTENSIBLE BLOCKS FROM A
; PROFILE GIVEN A PARSER DATA BLOCK POINTER
; CALL: MOVE S1, PARSER DATA BLOCK ADDRESS
; MOVE S2, PROFILE OFFSET
; PUSHJ P,PROBLK
;
; TRUE RETURN: BLOCK ADDED OR DELETED
; FALSE RETURN: NO ROOM IN PROFILE FOR BLOCK
PROBLK::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;COPY PARSER DATA BLOCK ADDRESS
MOVEI T1,(U) ;PROFILE ADDRESS
LOAD T2,ARG.HD(P1),AR.LEN ;GET LENGTH
SUBI T2,ARG.DA ;ACCOUNT FOR PARSER OVERHEAD WORDS
CAIN T2,1 ;DELETING?
SKIPE ARG.DA(P1) ;AND IS THERE ANY REAL DATA?
SKIPA ;SOMETHING VALID
JRST PROBL1 ;YES
MOVNS T2 ;NEGATE
HRLZS T2 ;PUT IN LH
HRRI T2,(S2) ;PROFILE OFFSET
MOVEI T3,ARG.DA(P1) ;ADDRESS OF DATA
JRST PROBL2 ;ENTER COMMON CODE
PROBL1: MOVEI T2,(S2) ;PROFILE OFFSET
SETZ T3, ;ZERO ADDRESS TO DELETE
PROBL2: MOVEI T4,0 ;CLEAR .AEMAP BIT
PJRST A$EBLK## ;ADD/DELETE EXTENSIBLE BLOCK AND RETURN
SUBTTL PROFILE PROCESSING -- PROCHG - PERFORM ALL CHANGES
PROCHG: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
SETZ P3, ;INIT CHANGE COUNTER
PUSHJ P,QINIT ;SETUP TO CHANGE A PROFILE
PROCH1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P2) ;AND ITS INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SKIPN (S1) ;CHANGING THIS PORTION OF THE PROFILE?
JRST PROCH3 ;NO
PUSHJ P,@CG.CHG(P2) ;EXECUTE THE CHANGE
JUMPT PROCH2 ;ONWARD IF NO ERRORS
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RETF ;AND RETURN
PROCH2: AOS P3 ;COUNT THE CHANGE
PROCH3: AOBJN P1,PROCH1 ;LOOP
SKIPN S1,P3 ;IF NOTHING TO DO,
$RETT ;SUCCEED VACUOUSLY
PUSHJ P,QUEUUO ;DO THE UUO
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RET ;PROPAGATE T/F BACK
SUBTTL PROFILE PROCESSING -- PROCLR - CLEAR USER SPECIFIC DATA
PROCLR: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,[XWD PASSWD,PASSWD+1] ;SET UP BLT
SETZM PASSWD ;CLEAR FIRST WORD
BLT S1,PASSWD+.APWLW-1 ;ZERO PASSWORD BLOCK
MOVSI P1,-CLRLEN ;AOBJN POINTER
PROCL1: MOVE S1,CLRTAB(P1) ;GET PROFILE OFFSET
MOVE S2,CHGTAB##(S1) ;GET FLAGS
TXNN S2,PD.EXT ;EXTENSIBLE BLOCK?
JRST PROCL2 ;NO
MOVEI S2,(S1) ;COPY OFFSET
ADDI S2,(U) ;INDEX INTO PROFILE
SKIPL (S2) ;DATA AVAILABLE?
JRST PROCL3 ;NO
MOVEI T1,(U) ;PROFILE ADDRESS
MOVE T2,S1 ;PROFILE OFFSET
HLL T2,(S2) ;GET -LENGTH
MOVEI T3,0 ;ZERO OUT BLOCK ADDRESS
MOVEI T4,1 ;SET .AEMAP ENTRY
PUSHJ P,A$EBLK## ;DELETE BLOCK AND DEFAULT THE FIELD
JRST PROCL3 ;ONWARD
PROCL2: ADDI S1,(U) ;INDEX INTO PROFILE
LOAD S2,S2,PD.WRD ;GET WORD COUNT
SETZM (S1) ;CLEAR A WORD
ADDI S1,1 ;ADVANCE POINTER TO NEXT WORD
SOJG S2,.-2 ;DO ALL WORDS IN BLOCK
PROCL3: AOBJN P1,PROCL1 ;LOOP BACK
POPJ P, ;RETURN
CLRTAB: EXP .AEFLG ;PROFILE FLAGS
EXP .AEFAI ;LAST PSW VALIDATION FAILURE UDT
EXP .AELPC ;LAST PSW CHANGE UDT
EXP .AEPNM ;PERSONAL NAME
CLRLEN==.-CLRTAB ;LENGTH OF TABLE
SUBTTL PROFILE PROCESSING -- PRODEF - FETCH DEFAULT PROFILE
PRODEF: PUSHJ P,.SAVE1 ;SAVE P1
SKIPN P1,.AEPPN(U) ;SAVE PPN INCASE OF ERROR
JRST PRODE1 ;ONLY TRY FOR THE SYSTEM DEFAULT
HLLO S1,P1 ;MAKE DEFAULT PPN FOR PROJECT ([10,%])
MOVEI S2,(U) ;POINT TO STORAGE
PUSHJ P,QPPNIN ;FETCH IT
JUMPT PRODE2 ;GO REPORT FINDINGS
PRODE1: MOVNI S1,1 ;GET DEFAULT PPN FOR ALL PROJECTS ([%,%])
MOVEI S2,(U) ;POINT TO STORAGE
PUSHJ P,QPPNIN ;FETCH IT
JUMPT PRODE2 ;GO REPORT FINDINGS
MOVEI S1,(U) ;NOT FOUND,
HRLI S1,USER0 ;SO USE AN EMPTY PROFILE
BLT S1,.AEMAX-1(U) ;RATHER THAN ACTDAE ERROR MESSAGE
HLRZ S2,P1 ;PUT PROJECT NUMBER IN RH
MOVEI S1,[ITEXT (<project ^O/S2/>)]
SKIPN S2 ;HAVE A PROJECT?
MOVEI S1,[ITEXT (<system-wide>)] ;NO
WARN (NDF,<No default ^I/(S1)/ profile found>,,PRODE3)
PRODE2: PUSHJ P,CVTPPD ;CONVERT PPN
INFO (DPL,<Default profile loaded: ^T/(S1)/>)
PRODE3: PUSHJ P,PROCLR ;CLEAR USER SPECIFIC DATA
MOVEM P1,.AEPPN(U) ;REPLACE PPN
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROFSP - FETCH A FILESPEC
PROFSP::PUSHJ P,P$FILE## ;GET FD BLOCK
$RETIF ;RETURN ON ERRORS
MOVSI S2,'...' ;GET PLACE HOLDER VALUE
CAMN S2,.FDSTR(S1) ;DEVICE SPECIFIED?
SETZM .FDSTR(S1) ;NO, ZERO DEVICE WORD
LOAD S2,.FDLEN(S1),FD.LEN ;GET FD LENGTH
SUBI S2,ARG.DA ;ACCOUNT FOR OVERHEAD
MOVNS S2 ;NEGATE
HRLZS S2 ;PUT IN LH
HRRI S2,.FDSTR(S1) ;MAKE AN AOBJN POINTER
SKIPN (S2) ;NULL?
AOBJN S2,.-1 ;SEARCH ENTIRE FD
JUMPL S2,.RETT ;RETURN IF SOMETHING TYPED
MOVEI S2,ARG.DA+1 ;OVERHEAD + ZERO WORD
STORE S2,.FDLEN(S1),FD.LEN ;CUTE WAY TO SAY BLOCK IS EMPTY
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PRONAM - GENERATE USER NAME BASED ON PPN
PRONAM: MOVSI S1,.AENAM(U) ;POINT TO STORAGE
HRRI S1,.AENAM+1(U) ;MAKE A BLT POINTER
SETZM .AENAM(U) ;CLEAR FIRST WORD
BLT S1,.AENAM+.AANLW-1(U) ;CLEAR ENTIRE BLOCK
MOVE S1,.AEPPN(U) ;GET PPN WE'RE HACKING
PUSHJ P,A$CKPP## ;MAKE A NAME FOR IT
SETCAM TF,RESPPN ;PROFILE IS FOR A RESERVED PPN
$TEXT (<POINT 8,.AENAM(U),-1>,<^T/(S1)/^0>)
POPJ P, ;DONE
SUBTTL PROFILE PROCESSING -- PROPSW - DEFAULT A PASSWORD
PROPSW: PUSHJ P,.SAVE4 ;SAVE SOME ACS
LOAD S1,.AEREQ(X),AE.PWL ;GET MINIMUM PASSWORD LENGTH
CAIN S1,0 ;ZERO ? (NONE SPECIFIED)
MOVEI S1,DEFPSZ ;USE DEFAULT
MOVEI S2,(S1) ;COPY
PUSHJ P,GENPSW ;GENERATE A PASSWORD
SUBB S2,S1 ;GET COUNT OF CHARACTERS GENERATED
IDIVI S2,.APWCW ;GET NUMBER OF WORDS REQUIRED
SKIPE T1 ;REMAINDER?
ADDI S2,1 ;YES
HRL S2,S1 ;MAKE IT #CHRS,,#WORDS
MOVEI T1,10 ;8-BIT ASCIZ
MOVE S1,[.APWLW+ARG.DA,,.CMFLD]
MOVEM S1,PASSHD+ARG.HD ;SAVE PARSER DATA BLOCK HEADER WORD
MOVEI S1,PASSHD ;POINT TO BLOCK
PUSHJ P,PROSTR ;FIX UP STRING AS NECESSARY
$RETT ;AND RETURN
; ROUTINE TO GENERATE A FULL LENGTH PASSWORD CONTAINING THINGS
; THAT LOOK LIKE SYLLABLES. THE PASSWORD WILL CONTAIN ALL
; UPPERCASE CHARACTERS.
GENPSW: MOVEI P3,.APWLC ;GET MAX PASSWORD SIZE
MOVE P4,[POINT 8,PASSWD] ;GET TARGET POINTER
RANPW0: PUSHJ P,RANDOM ;GET A RANDOM NUMBER
MOVEI T2,STRL
FSC T2,233
FMPR T2,T1
FIX T1,T2
MOVE P1,STRPTR(T1)
SETZ P2,
RANPW1: PUSHJ P,RANDOM ;GET A RANDOM NUMBER
HLRZ T2,(P1)
FSC T2,233
FMPR T2,T1
FIX T1,T2
HRRZ T2,(P1)
ADD T1,T2
LSH P2,6
ADD P2,(T1)
AOBJN P1,RANPW1
MOVE T2,P2 ;GET SIXBIT RESULT
GENPS3: LSHC T1,6 ;SHIFT IN A CHARACTER
ANDI T1,77 ;MASK OUT JUNK
JUMPE T1,GENPS4 ;LEADING BLANKS?
ADDI T1,40 ;MAKE ASCII
IDPB T1,P4 ;STORE
SOJLE P3,.POPJ ;COUNT DOWN
SOS S1 ;COUNT DOWN AGAINST USER LIMIT
GENPS4: JUMPN T2,GENPS3 ;LOOP BACK IF MORE CHARACTERS
SKIPLE S1 ;QUIT IF USER LIMIT FOUND
JUMPN P3,RANPW0 ;LOOP BACK IF PASSWORD INCOMPLETE
POPJ P,
RANDOM: SKIPE T1,ROOT ;HAVE A SEED?
JRST RAN1 ;YES
TIMER T1, ;GET TIME IN JIFFIES
FSC T1,211
MOVEM T1,ROOT
RAN1: FMPR T1,ROOT
FADRI T1,(47.)
FDVR T1,ROOT
FSC T1,-1
FSBRM T1,ROOT
MOVNS T1,ROOT
TLZ T1,777700
FSC T1,203
POPJ P,
; TABLE OF CONSONANTS
CON: 'B'
'C'
'D'
'F'
'G'
'H'
'J'
'K'
'L'
'M'
'N'
'P'
'R'
'S'
'T'
'V'
'W'
'X'
'Y'
'Z'
CONL==.-CON
; TABLE OF VOWELS
VOW: 'A'
'E'
'I'
'O'
'U'
VOWL==.-VOW
STR45: XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
STR6: XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
STRPTR: XWD -4,STR45
XWD -5,STR45
XWD -6,STR6
STRL==.-STRPTR
SUBTTL PROFILE PROCESSING -- PROSTR - STRING CHECKING
; ROUTINE TO CHECK STRING LENGTHS AND CLEAN UP POSSIBLE JUNK
; LEFT OVER BY THE PARSER.
; CALL: MOVE S1, PARSER DATA BLOCK ADDRESS
; MOVE S2, MAX # CHRS,,MAX # WORDS
; MOVE T1, BYTE SIZE
; PUSHJ P,PROSTR
PROSTR::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY ARGS
MOVEI S1,^D36 ;36-BITS PER WORD
IDIVI S1,(T1) ;S2 GETS NUMBER OF JUNK BITS
IMULI S1,(P2) ;GET MAX. BYTES IN BLOCK
HRLI T1,(S1) ;SAVE
MOVSI S1,-1 ;WILL HANDLE UP TO 18 BIT BYTES
ROT S1,(S2) ;GET MASK FOR CLEARING JUNK BITS
HRRZS S1 ;ISOLATE MASK
PUSH P,S1 ;SAVE FOR A SECOND
HRRZ S2,P2 ;GET MAXIMUM WORD COUNT
LOAD TF,ARG.HD(P1),AR.LEN ;GET BLOCK LENGTH
CAILE TF,ARG.DA(S2) ;IMPOSE LENGTH RESTRICTIONS
MOVEI TF,ARG.DA(S2) ;MUST REDUCE
STORE TF,ARG.HD(P1),AR.LEN ;REDUCE
SUBI TF,ARG.DA ;ACCOUNT FOR GALACTIC OVERHEAD
MOVEI S1,ARG.DA(P1) ;POINT TO START OF DATA
POP P,S2 ;GET MASK BACK
ANDCAM S2,(S1) ;CLEAR JUNK BITS
ADDI S1,1 ;ADVANCE ADDRESS POINTER
SOJG TF,.-2 ;DO ALL WORDS
MOVEI S1,ARG.DA(P1) ;POINT TO START OF DATA
DPB T1,[POINT 6,S1,11] ;STORE BYTE SIZE IN BYTE POINTER
TLO S1,440000 ;FINISH IT
HLRZ S2,P2 ;GET BYTE COUNT
PROST1: ILDB TF,S1 ;GET A CHARACTER
SKIPE TF ;NUL?
SOJG S2,PROST1 ;LOOP
HLRZ TF,T1 ;GET MAX. BYTE COUNT
SUB TF,S2 ;NUMBER REMAINING TO ZERO
JUMPE TF,PROST2 ;DON'T PROCEED IF DONE
SETZ S2, ;TO CLEAR OUT REMAINDER
IDPB S2,S1 ;TERMINATE
SOJG TF,.-1 ;CLEAN OUT REMAINDER OF THE BLOCK
PROST2: POPJ P, ;RETURN
SUBTTL PROFILE PROCESSING -- PROPRT - PRINT PROFILE DATA
; PRINT DATA ABOUT PROFILE ENTRIES
; CALL: MOVE S1, ENTRY VECTOR ADDRESS
; PUSHJ P,PROPRT/PROTTL
PROPRT: TDZA S2,S2 ;PRINT DATA
PROTTL: MOVEI S2,1 ;PRINT TITLE AND DATA
PUSHJ P,.SAVET ;SAVE T1-T4
PUSH P,[EXP 0] ;SAVE A FLAG
PUSH P,S2 ;SAVE FLAG
MOVEI T1,(U) ;POINT TO PROFILE
SKIPGE T2,CG.PFL(S1) ;GET PROFILE OFFSET
JRST PROPR1 ;FIELD CANNOT BE DEFAULTED
MOVNI T3,1 ;FLAG
PUSHJ P,A$BMAP## ;CHECK STATUS
JUMPF PROPR1 ;JUMP IF NOT DEFAULTED
SETOM -1(P) ;REMEMBER DEFAULTED STATUS
SKIPA S2,["*"] ;ASTERISK FOR A DEFAULTED FIELD
PROPR1: MOVEI S2," " ;ELSE NON-DEFAULTED FIELD
$TEXT (,< ^7/S2/ ^A>) ;DISPLAY FLAG
POP P,S2 ;GET TITLE FLAG
SKIPE S2 ;WANT TITLE?
$TEXT (,<^T/@CG.PRM(S1)/: ^A>) ;YES
POP P,S2 ;GET DEFAULTED FLAG
JUMPE S2,PROPR2 ;JUMP IF NOT
MOVE S2,CG.IDX(S1) ;GET PROFILE ENTRY INDEX
ADD S2,CHGPTR ;INDEX INTO CHANGE TABLE
MOVE S2,(S2) ;GET CHANGE FLAG FOR THIS ENTRY
JUMPE S2,PROPR2 ;JUMP IF IT'S CHANGED
$TEXT (,<-unknown->) ;ELSE SAY WE DON'T KNOW
$RETT ;RETURN
PROPR2: PUSHJ P,@CG.PRT(S1) ;PRINT DATA
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROUPD - UPDATE A PROFILE FROM A STATIC BLOCK
PROUPD: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE S1,[CHGMSK,,CHGMS2] ;NEED TO SAVE THIS BECAUSE OF RESTORES
BLT S1,CHGMS2+.AEMIN-1 ;SO SAVE IT
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
SETZ P3, ;INIT CHANGE COUNTER
PROUP1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P2) ;AND ITS INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SKIPN (S1) ;CHANGING THIS PORTION OF THE PROFILE?
JRST PROUP3 ;NO
PUSHJ P,@CG.CMP(P2) ;COMPARE INCASE WAS CHANGED BACK TO ORIGINAL
JUMPT PROUP3 ;NOTHING REALLY CHANGED
PROUP2: PUSHJ P,@CG.RES(P2) ;RESTORE DATA
SETOM @CHGADR ;RESTORE FLAG TO "CHANGED" STATE
JUMPT PROUP3 ;ONWARD IF NO ERRORS
PUSHJ P,PROUP4 ;SETUP RETURN
$RETF ;AND RETURN FAILURE
PROUP3: AOBJN P1,PROUP1 ;LOOP
PROUP4: MOVE S1,[CHGMS2,,CHGMSK] ;BLT VECTOR
BLT S1,CHGMSK+.AEMIN-1 ;RESTORE MASKS
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RETT ;AND RETURN
SUBTTL PROFILE PROCESSING -- PROZCH - ZERO PROFILE ENTRY CHANGE TABLE
PROZCH: MOVE S1,CHGPTR ;GET ADDRESS OF CHANGE TABLE
MOVSI S2,(S1) ;POINT TO START ADDRESS
HRRI S2,1(S1) ;MAKE A BLT POINTER
SETZM (S1) ;CLEAR FIRST WORD
ADD S1,CHGCTR ;COMPUTE END OF BLT
BLT S2,-1(S1) ;ZERO TABLE
PROZQM: MOVE S1,[CHGMSK,,CHGMSK+1] ;BLT POINTER
SETZM CHGMSK ;CLEAR FIRST WORD OF CHANGE MASKS
BLT S1,CHGMSK+.AEMIN-1 ;ZERO TABLE
POPJ P, ;RETURN
SUBTTL PROFILE PROCESSING -- PROZPB - ZERO PROFILE BLOCK
PROZPB: MOVSI S1,USER0 ;POINT TO INIT'ED USER BLOCK
HRRI S1,(U) ;AND TO CURRENT BLOCK
BLT S1,.AEMAX-1(U) ;RE-INIT PROFILE
POPJ P, ;RETURN
SUBTTL ENTRIES -- TABLE INITIALIZATION
ENTINI: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
HLRZ S1,ENTDEC ;GET COUNT OF DEC-DEFINED PROFILE ENTRIES
HLRZ S2,ENTCUS## ;GET COUNT OF CUSTOMER-DEFINED PROFILE ENTRIES
ADDI S1,1(S2) ;TOTAL THEM UP
PUSHJ P,M%GMEM ;GET SOME CORE
MOVEM S2,ENTKPT ;SAVE FOR PARSING
MOVEI S2,-1(S1) ;GET CORRECTED COUNT
MOVEM S2,@ENTKPT ;SAVE WORD COUNT TOO
PUSHJ P,M%GMEM ;GET MORE CORE
MOVEM S2,ENTHPT ;SAVE FOR HELP
SUBI S1,1 ;GET CORRECTED COUNT
MOVEM S1,@ENTHPT ;SAVE WORD COUNT TOO
PUSHJ P,M%GMEM ;GET MORE CORE
MOVEM S1,CHGCTR ;SAVE CHANGE TABLE WORD COUNT
MOVEM S2,CHGPTR ;SAVE CHANGE TABLE ADDRESS
MOVEI P1,ENTDEC ;POINT TO DEC-DEFINED TABLE
PUSHJ P,ENTIN1 ;LOAD WORKING COMMAND TABLE
MOVEI P1,ENTCUS## ;POINT TO CUSTOMER-DEFINED TABLE
ENTIN1: HLRZ S1,(P1) ;GET NUMBER OF ENTRIES IN TABLE
JUMPE S1,.RETT ;RETURN IF TABLE IS EMPTY
MOVNS S1 ;NEGATE
HRL P1,S1 ;GET -LENGTH
HRRI P1,1(P1) ;MAKE AN AOBJN POINTER
ENTIN2: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
SKIPL S1,CG.PFL(P2) ;AND PROFILE OFFSET
SKIPN UNPRIV ;UNPRIV'ED USER?
JRST ENTIN3 ;NO
MOVE S1,CHGTAB##(S1) ;FLAGS
TXNN S1,PD.UNP ;UNPRIV'ED PROFILE DATA?
JRST ENTIN4 ;NO--STUFF IN HELP TABLE INSTEAD
ENTIN3: MOVE S1,ENTKPT ;POINT TO TABLE HEADER
MOVE S2,(P1) ;GET KEYWORD ADDRESS
PUSHJ P,S%TBAD ;INSERT INTO TABLE
JUMPT ENTIN4 ;CHECK FOR ERRORS
CAIN S1,EREIT$ ;ENTRY ALREADY IN TABLE?
JRST ENTIN5 ;YES--PROBABLY THE NULL KEYWORD
STOPCD (EIF,HALT,,<Profile entry table initialization failure>)
ENTIN4: HLRZ S2,(P1) ;GET A KEYWORD
SKIPE S1,(S2) ;MUST CHECK
TLNE S1,(177B6) ;FIRST CHARACTER ZERO AND WORD NO ALL ZERO?
TDZA S1,S1 ;NO--MAKE FLAGS ALL ZERO
AOS S2 ;ADJUST TEXT POINTER
TXNE S1,CM%INV ;TEST FLAGS
JRST ENTIN5 ;DON'T INCLUDE
MOVE S1,ENTHPT ;POINT TO TABLE HEADER
HRLZS S2 ;POSITION KEYWORD
HRR S2,(P1) ;INCLUDE DATA
PUSHJ P,S%TBAD ;INSERT INTO TABLE
JUMPT ENTIN5 ;CHECK FOR ERRORS
STOPCD (HIF,HALT,,<Help table initialization failure>)
ENTIN5: AOBJN P1,ENTIN2 ;LOOP
; PARSING
MOVE S1,[ENTKBK,,ENTKEY] ;SET UP BLT
BLT S1,ENTKEY+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTKEY+1+.CMDAT ;SAVE
; "DEFAULT"
MOVE S1,[ENTDBK,,ENTDEF] ;SET UP BLT
BLT S1,ENTDEF+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTDEF+1+.CMDAT ;SAVE
; "HELP"
MOVE S1,[ENTHBK,,ENTHLP] ;SET UP BLT
BLT S1,ENTHLP+PB%SIZ-1 ;COPY
MOVE S1,ENTHPT ;GET TABLE ADDRESS
MOVEM S1,ENTHLP+1+.CMDAT ;SAVE
; "RESTORE"
MOVE S1,[ENTRBK,,ENTRST] ;SET UP BLT
BLT S1,ENTRST+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTRST+1+.CMDAT ;SAVE
; "SELECT"
MOVE S1,[ENTSBK,,ENTSLC] ;SET UP BLT
BLT S1,ENTSLC+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTSLC+1+.CMDAT ;SAVE
$RETT ;RETURN
; PARSER DATA BLOCK FOR PARSING
ENTKBK: $KEYDSP (.,<$NEXT(.),$ACTION(ENTAPR),$ALTER(ENT010)>)
BLOCK PB%SIZ-<.-ENTKBK>
; PARSER DATA BLOCK FOR "DEFAULT"
ENTDBK: $KEY (CONFRM,.,<$ACTION(ENTADF)>)
BLOCK PB%SIZ-<.-ENTDBK>
; PARSER DATA BLOCK FOR "HELP"
ENTHBK: $KEY (CONFRM,.,<$ACTION(ENTAHL)>)
BLOCK PB%SIZ-<.-ENTHBK>
; PARSER DATA BLOCK FOR "SELECT"
ENTSBK: $KEY (CONFRM,.,<$ACTION(ENTASL)>)
BLOCK PB%SIZ-<.-ENTSBK>
; PARSER DATA BLOCK FOR "RESTORE"
ENTRBK: $KEY (CONFRM,.,<$ACTION(ENTARS),$ALTER(CONFRM)>)
SUBTTL ENTRIES -- KEYWORD TABLES
ENT000: $INIT (ENTKEY)
ENT010: $KEYDSP (ENTCOM)
ENT020: $KEYDSP (ENTSEL)
; DEC-DEFINED ENTRY TYPES
ENTDEC: $STAB
KEYTAB (PPX,<PPN>,CM%NOR)
KEYTAB (NAM,<NAME>)
KEYTAB (PDF,<PROFILE-DEFAULT>)
KEYTAB (PNM,<PERSONAL-NAME>)
KEYTAB (DST,<DISTRIBUTION-LOCATION>)
KEYTAB (MAI,<MAILING-ADDRESS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (PSW,<PASSWORD>)
KEYTAB (EXP,<EXPIRATION-DATE>)
KEYTAB (LTI,<LOGIN-TIMES>)
KEYTAB (ACC,<ACCESS-TYPES>)
KEYTAB (RQL,<REQUIREMENTS>)
KEYTAB (SCH,<SCHEDULAR-TYPE>)
KEYTAB (PRG,<PROGRAM-TO-RUN>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (CTX,<CONTEXT-QUOTAS>)
KEYTAB (COR,<CORE-LIMITS>)
KEYTAB (ENQ,<ENQ-DEQ-QUOTA>)
KEYTAB (IPC,<IPCF-QUOTAS>)
KEYTAB (PRV,<PRIVILEGES>)
KEYTAB (SPO,<SPOOLED-DEVICES>)
KEYTAB (WAT,<WATCH-BITS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (STR,<STRUCTURE-QUOTAS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (ADM,<ADMINISTRATIVE-DATA>,CM%NOR)
$ETAB
; DEC AND CUSTOMER COMMON KEYWORDS
ENTCOM: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (ENTC10,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (ENTC20,3,<HELP>)
DSPTAB (CONFRM,4,<QUI>,CM%NOR)
DSPTAB (CONFRM,4,<QUIT>)
DSPTAB (ENTRST,5,<RESTORE>)
DSPTAB (ENTC30,6,<SHOW>)
$ETAB
ENTC10: $NOISE (ENTDEF,<entry>)
ENTC20: $NOISE (ENTHLP,<with>)
ENTC30: $CRLF (<$ALTER(ENTHLP)>)
; DEC AND CUSTOMER SELECTION KEYWORDS
ENTSEL: $STAB
DSPTAB ( ,2,\"32,CM%INV)
; DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (ENTC10,3,<HELP>)
DSPTAB (CONFRM,4,<QUI>,CM%NOR)
DSPTAB (CONFRM,4,<QUIT>)
; DSPTAB (ENTRST,5,<RESTORE>)
DSPTAB (ENTC20,6,<SHOW>)
$ETAB
; COMMON ENTRY ACTION ROUTINE TO SET THE NEXT PARSER DATA BLOCK
ENTASL:!
ENTAPR: HRRZ S1,@CR.RES(S2) ;GET ADDR OF TABLE ENTRY
HRRZ S1,CG.PRS(S1) ;GET ADDR OF NEXT PARSE BLOCK
PUSH P,S1 ;SAVE FOR A SECOND
LOAD S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
PUSHJ P,P$GPDB## ;GET ADDR WORKING COPY
POP P,PB%NXT(S1) ;POINT TO NEXT TABLE FOR PARSING
$RETT ;AND RETURN
; COMMON ENTRY ACTION ROUTINE FOR "DEFAULT", "HELP", AND "RESTORE"
ENTADF:!
ENTAHL:!
ENTARS: LOAD S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
PUSHJ P,P$GPDB## ;GET ADDR WORKING COPY
MOVEI S2,CONFRM ;TERMINATE
MOVEM S2,PB%NXT(S1) ; COMMAND
$RETT ;AND RETURN
SUBTTL ENTRIES -- ACC - ACCESS-TYPES
.ENTRY (ACC,.AEACC,<Access types>)
ACCPRS: $NOISE (CONFRM,<allowed>)
ACC000: $INIT (ACC010)
ACC010: $KEYDSP (ACC020,<$ALTER(ACC030)>)
ACC020: $STAB
DSPTAB (ACC010,[AE.ROP],<ANF-CTY>)
DSPTAB (ACC010,[AE.BAT],<BATCH>)
DSPTAB (ACC010,[AE.DST],<DATA-SET>)
DSPTAB (ACC010,[AE.FIO],<FILES-ONLY>)
DSPTAB (ACC010,[AE.LOC],<LOCAL>)
DSPTAB (ACC010,[AE.FAL],<NETWORK-FILE-ACCESS>)
DSPTAB (ACC010,[AE.CDR],<PHYSICAL-CARD-READER>)
DSPTAB (ACC010,[AE.RMT],<REMOTE>)
DSPTAB (ACC010,[AE.SBJ],<SUBJOB-OF-BATCH>)
$ETAB
ACC030: $KEYDSP (ACC040,$ALTER(CONFRM))
ACC040: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (ACC050,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
ACC050: $KEYDSP (ACC020)
; GET ROUTINE
ACCGET: PUSHJ P,.SAVE1 ;SAVE P1
ACCGE1: MOVEI S1,ACC000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ\ACCESS-TYPES>\]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
ACCGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT ACCGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIG S1,ACCLEN ;ADDRESS OF BIT?
JRST ACCGE3 ;NO--KEYWORD
MOVE S2,(S1) ;YES, GET THE BIT
IORM S2,.AEACC(U) ;SET IT ALWAYS
SKIPE P1 ;SKIP IF SETTING VALUE
ANDCAM S2,.AEACC(U) ;ZERO THE BIT
SETZ P1, ;CLEAR "NO" FLAG
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
IORM S2,CHGMSK+.AEACC ;LIGHT IN THE CHANGE MASK
JRST ACCGE2 ;AND LOOP
ACCGE3: PUSHJ P,@ACCTAB(S1) ;DISPATCH TO KEYWORD PROCESSOR
JRST ACCGE2 ;AND LOOP BACK
; COMPARE ROUTINE
ACCCMP: MOVEI S1,.AEACC ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
ACCCHG: MOVEI S1,.AEACC ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
ACCDFL: MOVX S1,DF.ACC ;DEFAULT BIT FOR FIELD
IORM S1,DF$ACC(U) ;LIGHT IN BIT MAP
SETOM PRSDFV ;REMEMBER WE CARE
SETOM @CHGADR ;WE CHANGED THIS ENTRY
SETOM CHGMSK+.AEACC ;AND THIS FIELD
$RETT ;WIN
; RESTORE ROUTINE
ACCRES: MOVE S1,.AEACC(X) ;GET ORIGINAL ACCESS BITS
MOVEM S1,.AEACC(U) ;RESTORE
MOVX S1,DF.ACC ;GET .AEACC DEFAULT BIT
ANDCAM S1,DF$ACC(U) ;CLEAR IN WORKING PROFILE
TDNE S1,DF$ACC(X) ;WAS IT SET IN ORIGINAL?
IORM S1,DF$ACC(U) ;YES, FIX IT
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEACC ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
ACCPRT: MOVE S1,[IOWD ACCBEN-ACCBIT,ACCBIT] ;POINTER TO LIST OF BITS
PUSHJ P,PRTBTS ;TYPE OUT BITS
$RETT
; HELP TEXT
ACCHLP: ASCIZ \
ACCESS-TYPES specifies the types of access allowed to the specified
user. ACCESS refers to any attempt by a user or in behalf of a user to
gain access to the system using a correct combination of user-id and
password.
\
; BIT STORAGE/DISPLAY TABLE
ACCBIT: XWD [POINTR .AEACC(U),AE.CDR],[ASCIZ \Card reader\]
XWD [POINTR .AEACC(U),AE.FAL],[ASCIZ \Network file access\]
XWD [POINTR .AEACC(U),AE.LOC],[ASCIZ \Local\]
XWD [POINTR .AEACC(U),AE.ROP],[ASCIZ \ANF CTY\]
XWD [POINTR .AEACC(U),AE.DST],[ASCIZ \Dataset\]
XWD [POINTR .AEACC(U),AE.RMT],[ASCIZ \Remote\]
XWD [POINTR .AEACC(U),AE.SBJ],[ASCIZ \Subjob of batch\]
XWD [POINTR .AEACC(U),AE.BAT],[ASCIZ \Batch\]
XWD [POINTR .AEACC(U),AE.FIO],[ASCIZ \Files only\]
ACCBEN:!
; KEYWORD DISPATCH TABLE
ACCTAB: IFIW ACCALL ;"ALL"
IFIW ACCDEF ;"DEFAULT"
IFIW ACCDON ;"DONE"
IFIW ACCHLX ;"HELP"
IFIW ACCNO ;"NO"
IFIW ACCNON ;"NONE"
IFIW ACCRES ;"RESTORE"
IFIW ACCPRT ;"SHOW"
ACCLEN==.-ACCTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
ACCALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,^-AE.FIO ;ALL ACCESS BITS BUT NOT "FILES ONLY"
MOVEM S1,.AEACC(U) ;TURN ON ALL ACCESS METHODS
ACCGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETOM CHGMSK+.AEACC ;BOTH PLACES
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "DEFAULT" KEYWORD PROCESSOR
ACCDEF: PUSHJ P,ACCDFL ;DO DEFAULTING
PJRST ACCGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
ACCDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE WILL RETURN ON BEHALF OF CALLER
MOVEI S1,.AEACC ;PROFILE OFFSET WE'RE DOING
PJRST CMPVAL ;SET CHANGE FLAGS ACCORDINGLY AND RETURN
; "HELP" KEYWORD PROCESSOR
ACCHLX: PUSHJ P,P$CFM ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@ACC+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "NO" KEYWORD PROCESSOR
ACCNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
ACCNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,AE.FIO ;NO ACCESS MEANS "FILES ONLY"
MOVEM S1,.AEACC(U) ;SAVE BIT
PJRST ACCGO ;GO SET THE MASKS
SUBTTL ENTRIES -- ADM - ADMINISTRATIVE DATA
.ENTRY (ADM,-1,<Administrative data>)
ADMPRS: $CRLF
; GET ROUTINE
ADMGET: $RETT
; COMPARE ROUTINE
ADMCMP: $RETT
; CHANGE ROUTINE
ADMCHG: $RETF
; DEFAULT ROUTINE
ADMDFL: PJRST PRODFZ ;NO CAN DO
; RESTORE ROUTINE
ADMRES: $RETF
; PRINT ROUTINE
ADMPRT: MOVE S1,.AEPAP(U) ;GET LAST CHANGE PPN
MOVE S2,.AETIM(U) ;GET LAST CHANGE DATE/TIME
$TEXT (,<^M^J Profile last changed by ^U/S1/ at ^H/S2/>)
SKIPE .AEFAI(U) ;ACCOUNT ACCESSED EVER?
JRST ADMPR1 ;YES
MOVEI T1,[ITEXT(<-never->)] ;NO
JRST ADMPR2
ADMPR1: MOVX S1,AE.FAI ;GET ACCESS FAILURE BIT
TDNE S1,.AEFLG(U) ;SUCCESS?
SKIPA S1,[[ASCIZ\failed\]] ;NOPE
MOVEI S1,[ASCIZ\succeeded\] ;YES
MOVEI T1,[ITEXT(<^T/(S1)/ on ^H/.AEFAI(U)/>)]
ADMPR2: $TEXT (,< Last access ^I/(T1)/>)
SKIPN .AELPC(U) ;LAST PASSWORD CHANGE?
SKIPA T1,[[ITEXT(<-none->)]] ;NO
MOVEI T1,[ITEXT(< at ^H/.AELPC(U)/>)] ;YES
$TEXT (,< Last password change ^I/(T1)/>)
$RETT ;RETURN
; HELP TEXT
ADMHLP: ASCIZ \
ADMINISTRATIVE DATA are those quantities maintained by the accounting
system to track profile changes. These values cannot be changed using
REACT, nor can they be defaulted.
\
SUBTTL ENTRIES -- CTX - CONTEXT-QUOTAS
.ENTRY (CTX,.AECTX,<Context-quotas>)
CTXPRS: $NUMBER (CTX010,^D10,<saved contexts>,<$PDEFAULT(DEFTX1),$PREFIL(CTXACT)>)
CTX010: $NUMBER (CONFRM,^D10,<saved pages>,<$PDEFAULT(DEFTX2)>)
CTXACT: MOVE S1,[%CTJCQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT CONTEXT QUOTA
MOVEI S1,4 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX1>,<^D/S1/^0>)
MOVE S1,[%CTJPQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT SAVED PAGE QUOTA
MOVEI S1,^D1000 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX2>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
CTXGET: PUSHJ P,P$NUM## ;GET NUMBER OF CONTEXTS
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET IDLE CONTEXT PAGE LIMIT
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPN T1 ;UNLIMITED?
WARN (NCL,<No context limit>)
MOVEI S1,<MASK.(<WID(AE.CNQ)>,35)> ;GET LIMIT
CAIG T1,(S1) ;RANGE CHECK
JRST CTXGE1 ;REASONABLE NUMBER
WARN (RCL,<Reducing context limit from ^D/T1/ to ^D/S1/>)
MOVEI T1,(S1) ;ADJUST
CTXGE1: DPB T1,CTXCNQ ;STORE CONTEXT LIMIT
SKIPN T2 ;UNLIMITED?
WARN (NPL,<No saved page limit>)
DPB T2,CTXCPQ ;STORE PAGE LIMIT
MOVEI S1,.AECTX ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
CTXCMP: MOVEI S1,.AECTX ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
CTXCHG: MOVEI S1,.AECTX ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
CTXDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.CTX ;DEFAULT BIT FOR FIELD
IORM S1,DF$CTX(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;CHANGED IT
SETOM CHGMSK+.AECTX ;WHOLE WORD
$RETT ;WIN
; RESTORE ROUTINE
CTXRES: MOVE S1,.AECTX(X) ;GET OLD CTX VALUES
MOVEM S1,.AECTX(U) ;RESTORE
MOVX S1,DF.CTX ;CTX DEFAULT BIT
ANDCAM S1,DF$CTX(U) ;CLEAR IN WORKING COPY
TDNE S1,DF$CTX(X) ;WAS IT CLEAR BEFORE?
IORM S1,DF$CTX(U) ;NO, FIX IT
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AECTX ;BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
CTXPRT: LDB T1,CTXCNQ
LDB T2,CTXCPQ
$TEXT (,<Contexts ^D/T1/, Total pages ^D/T2/>)
$RETT
; HELP TEXT
CTXHLP: ASCIZ \
CONTEXT-QUOTAS specify the limits governing the use of job contexts.
The context quota is the number of contexts a user may have at any one
time. Each logged in job has at least one (current) context. The
maximum is 511. A quota of zero indicates no limit. The saved page
quota is the number of pages of swapping space a user may occupy with
idle contexts. A quota of zero indicates no limit. Refer to the
description of job contexts in the TOPS-10 Operating System Commands
Manual for more information.
\
SUBTTL ENTRIES -- COR - CORE-LIMITS
.ENTRY (COR,.AECOR,<Core Limits>)
CORPRS: $NUMBER (COR010,^D10,<physcal page limit>,<$DEFAULT(<512>)>)
COR010: $NUMBER (CONFRM,^D10,<virtual page limit>,<$DEFAULT(<512>)>)
; GET ROUTINE
CORGET: PUSHJ P,P$NUM## ;GET A NUMBER FROM COMMAND BLOCK
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET THE NEXT NUMBER FROM COMMAND BLOCK
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S1,T1 ;GET PHYSICAL LIMIT
PUSHJ P,CORGE1 ;CHECK IT
DPB S1,CORPHY ;STORE NEW PHYSICAL LIMIT
MOVE S1,T2 ;GET VIRTUAL LIMIT
PUSHJ P,CORGE2 ;CHECK IT
DPB S1,CORVRT ;STORE NEW VIRTUAL LIMIT
MOVEI S1,.AECOR ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
CORGE1: SKIPA T3,[[ASCIZ /physical/]]
CORGE2: SKIPA T3,[[ASCIZ /virtual/]]
SKIPA S2,[MASK.(<WID(AE.NPP)>,35)] ;GET PHYSICAL LIMIT
MOVEI S2,<MASK.(<WID(AE.NVP)>,35)> ;GET VIRTUAL LIMIT
CAIG S1,(S2) ;RANGE CHECK
POPJ P, ;REASONABLE NUMBER
WARN (RCL,<Reducing ^T/(T3)/ limit from ^D/S1/ to ^D/S2/ pages>)
MOVEI S1,(S2) ;ADJUST
POPJ P, ;RETURN
; COMPARE ROUTINE
CORCMP: MOVEI S1,.AECOR ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
CORCHG: MOVEI S1,.AECOR ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
CORDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.COR ;DEFAULT BIT FOR FIELD
IORM S1,DF$COR(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;CHANGED THE ENTRY
SETOM CHGMSK+.AECOR ;BOTH FIELDS
$RETT ;WIN
; RESTORE ROUTINE
CORRES: MOVE S1,.AECOR(X) ;GET ORIGINAL CORE VALUES
MOVEM S1,.AECOR(U) ;RESTORE
MOVX S1,DF.COR ;DEFAULT BIT FOR CORE WORD
ANDCAM S1,DF$COR(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$COR(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$COR(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AECOR ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
CORPRT: LDB T1,CORPHY ;GET PHYSICAL LIMIT
LDB T2,CORVRT ;GET VIRTUAL LIMIT
$TEXT (,<Physical ^D/T1/, Virtual ^D/T2/>)
$RETT ;RETURN
; HELP TEXT
CORHLP: ASCIZ \
CORE-LIMITS specifies a decimal value for the physical and virtual
page limits. The maximum number of pages is 16,384.
\
SUBTTL ENTRIES -- DST - DISTRIBUTION-LOCATION
.ENTRY (DST,.AEBOX,<Distribution location>)
DSTPRS: $QUOTE (CONFRM,<optionally quoted string>,<$PREFI(P$8BIT##),$ALTER(DST010)>)
DST010: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)
; GET ROUTINE
DSTGET: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$QSTR## ;GET A QUOTED STRING
SKIPT ;CHECK FOR ERRORS
PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE STRING ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(P1) ;POINT TO PARSER DATA BLOCK
MOVE S2,[.ADLLC,,.ADLLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
MOVEI T1,10 ;8-BIT BYTES
PUSHJ P,PROSTR ;CHECK STRING LENGTH AND CONTENT
MOVEI S1,(P1) ;PARSER DATA BLOCK ADDRESS
MOVE S2,DST+CG.PFL ;PROFILE OFFSET
PUSHJ P,PROBLK ;ADD/DELETE EXTENSIBLE BLOCK
SKIPT ;CHECK FOR ERRORS
WARN (NRM,<No room in profile for DISTRIBUTION LOCATION>,,DSTRES)
MOVEI S1,.AEBOX ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
DSTCMP: MOVEI S1,.AEBOX ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
DSTCHG: MOVEI S1,.AEBOX ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
DSTDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.BOX ;DEFAULT BIT FOR FIELD
IORM S1,DF$BOX(U) ;SET IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEBOX ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
DSTRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEBOX(X) ;-LENGTH
HRRI T2,.AEBOX ;OFFSET
SKIPE T3,.AEBOX(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.BOX ;DEFAULT BIT FOR FIELD
TDNN T4,DF$BOX(X) ;WAS IT DEFAULTED BEFORE?
TDZA T4,T4 ;NO, CLEAR THE BIT
MOVEI T4,1 ;YES, SET THE BIT
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL DISTRIBUTION LOCATION
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEBOX ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
DSTPRT: SKIPN S1,.AEBOX(U) ;GET AOBJN POINTER
SKIPA S1,[NONE8] ;THERE IS NONE
ADDI S1,(U) ;INDEX INTO PROFILE
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
$TEXT (,<^Q/S1/>) ;DISPLAY
$RETT
; HELP TEXT
DSTHLP: ASCIZ \
DISTRIBUTION-LOCATION specifies text to be displayed on the banner
page(s) of spooled output. The text indicates where the operator should
distribute the user's output.
\
SUBTTL ENTRIES -- ENQ - ENQ-DEQ-QUOTA
.ENTRY (ENQ,.AEENQ,<ENQ/DEQ quota>)
ENQPRS: $NUMBER (CONFRM,^D10,<quota>,<$PDEFAULT(DEFTX1),$PREFIL(ENQACT)>)
ENQACT: MOVE S1,[%EQDEQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT ENQ/DEQ QUOTA
MOVEI S1,^D511 ;SICK MONITOR
$TEXT (<-1,,DEFTX1>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
ENQGET: PUSHJ P,P$NUM## ;GET A NUMBER FROM
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI T2,^D511 ;GET LIMIT
CAIG T1,(T2) ;TOO BIG?
JRST ENQGE1 ;YES
WARN (REL,<Reducing ENQ/DEQ limit from ^D/T1/ to ^D/T2/>)
MOVEI T1,(T2) ;ADJUST
ENQGE1: MOVEM T1,.AEENQ(U) ;STORE AS NEW ENQ/DEQ QUOTA
MOVEI S1,.AEENQ ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
ENQCMP: MOVEI S1,.AEENQ ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
ENQCHG: MOVEI S1,.AEENQ ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
ENQDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.ENQ ;DEFAULT BIT FOR FIELD
IORM S1,DF$ENQ(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED THE ENTRY
SETOM CHGMSK+.AEENQ ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
ENQRES: MOVE S1,.AEENQ(X) ;GET ORIGINAL ENQ/DEQ QUOTAS
MOVEM S1,.AEENQ(U) ;RESTORE
MOVX S1,DF.ENQ ;DEFAULT BIT FOR ENQ/DEQ WORD
ANDCAM S1,DF$ENQ(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$ENQ(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$ENQ(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEENQ ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
ENQPRT: MOVE T1,.AEENQ(U) ;GET ENQ/DEQ QUOTAS
$TEXT (,<^D/T1/>) ;DISPLAY
$RETT
; HELP TEXT
ENQHLP: ASCIZ \
ENQ-DEQ-QUOTA specifies a decimal value for the number of outstanding
ENQ locks. The maximum number is 511.
\
SUBTTL ENTRIES -- EXP - EXPIRATION-DATE
.ENTRY (EXP,.AEEXP,<Expiration date>)
EXPPRS: $KEYDSP (EXP010,<$ALTER(EXP020)>)
EXP010: $STAB
DSPTAB (CONFRM,0,<NEVER>)
DSPTAB (CONFRM,1,<NOW>)
$ETAB
EXP020: $TAD (CONFRM)
; GET ROUTINE
EXPGET: PUSHJ P,P$TIME## ;GET THE TIME FIELD FROM COMMAND BLOCK
JUMPT EXPGE1 ;IF WE GOT IT, O.K.
PUSHJ P,P$KEYW## ;FIND OUT IF KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPE S1,EXPGE1 ;JUMP IF "NEVER"
CAIE S1,1 ;ELSE BETTER BE "NOW"
JRST PRSERR ;GIVE UP
PUSHJ P,I%NOW ;GET CURRENT UDT
EXPGE1: MOVE T1,S1 ;COPY RESULT
PUSHJ P,P$CFM## ;GET CRLF
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEM T1,.AEEXP(U) ;SAVE EXPIRATION DATE/TIME IN USER BLOCK
MOVEI S1,.AEEXP ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
EXPCMP: MOVEI S1,.AEEXP ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
EXPCHG: MOVEI S1,.AEEXP ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
EXPDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.EXP ;DEFAULT BIT FOR FIELD
IORM S1,DF$EXP(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEEXP ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
EXPRES: MOVE S1,.AEEXP(X) ;GET ORIGINAL EXPIRATION DATE/TIME
MOVEM S1,.AEEXP(U) ;RESTORE
MOVX S1,DF.EXP ;DEFAULT BIT FOR EXPIRATION WORD
ANDCAM S1,DF$EXP(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$EXP(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$EXP(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEEXP ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
EXPPRT: PUSHJ P,I%NOW ;GET CURRENT DATE/TIME
MOVE T1,.AEEXP(U) ;GET EXPIRATION DATE
MOVEI T2,[ITEXT (<^H/T1/>)] ;ASSUME NORMAL DATE
CAMG T1,S1 ;EXPIRED?
MOVEI T2,[ITEXT (<expired on ^H/T1/>)] ;YES
SKIPG T1 ;NEVER?
MOVEI T2,[ITEXT (<never>)] ;YES
$TEXT (,<^I/(T2)/>) ;DISPLAY
$RETT ;AND RETURN
; HELP TEXT
EXPHLP: ASCIZ \
EXPIRATION-DATE specifies the date when LOGINs to this account are no
longer allowed. This date is also written into the UFD for all mounted
structures for disk maintenance purposes.
\
SUBTTL ENTRIES -- IPC - IPCF-QUOTAS
.ENTRY (IPC,.AEIPC,<IPCF quotas>)
IPCPRS: $NUMBER (IPC010,^D10,<send>,<$PDEFAULT(DEFTX1),$PREFIL(IPCACT)>)
IPC010: $NUMBER (IPCF20,^D10,<receive>,<$PDEFAULT(DEFTX2)>)
IPCF20: $NUMBER (CONFRM,^D10,<PID quota>,<$PDEFAULT(DEFTX3)>)
; ACTION ROUTINE TO GENERATE DEFAULT QUOTA STRINGS
IPCACT: MOVE S1,[%IPCDQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT SEND/RECEIVE QUOTA
MOVEI S1,2005 ;SICK MONITOR
LDB S2,[POINT 9,S1,26] ;GET SEND
$TEXT (<-1,,DEFTX1>,<^D/S2/^0>)
LDB S2,[POINT 9,S1,35] ;GET RECEIVE
$TEXT (<-1,,DEFTX2>,<^D/S2/^0>)
MOVE S1,[%IPDPQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT PID QUOTA
MOVEI S1,2 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX3>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
IPCGET: PUSHJ P,P$NUM## ;GET SEND QUOTA
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET THE RECEIVE QUOTA
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET NUMBER OF PIDS
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T3,S1 ;COPY
MOVEI T3,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(T1) ;GET SEND QUOTA
PUSHJ P,IPCGE1 ;CHECK IT
DPB S1,IPCFS ;STORE
MOVEI S1,(T2) ;GET RECEIVE QUOTA
PUSHJ P,IPCGE2 ;CHECK IT
DPB S1,IPCFR ;STORE
MOVEI S1,(T3) ;GET PID QUOTA
PUSHJ P,IPCGE3 ;CHECK IT
DPB S1,IPCFP ;STORE
MOVEI S1,.AEIPC ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
IPCGE1: MOVEI T4,[ASCIZ /send/]
MOVEI S2,<MASK.(<WID(AE.SND)>,35)> ;GET LIMIT
JRST IPCGE4 ;GO COMPARE
IPCGE2: MOVEI T4,[ASCIZ /receive/]
MOVEI S2,<MASK.(<WID(AE.RCV)>,35)> ;GET LIMIT
JRST IPCGE4 ;GO COMPARE
IPCGE3: MOVEI T4,[ASCIZ /PID/]
MOVEI S2,<MASK.(<WID(AE.PID)>,35)> ;GET LIMIT
IPCGE4: CAIG S1,(S2) ;TOO BIG?
POPJ P, ;NO
WARN (RIQ,<Reducing IPCF ^T/(T4)/ quota from ^D/S1/ to ^D/S2/>)
MOVEI S1,(S2) ;ADJUST
POPJ P, ;RETURN
; COMPARE ROUTINE
IPCCMP: MOVEI S1,.AEIPC ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
IPCCHG: MOVEI S1,.AEIPC ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
IPCDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.IPC ;DEFAULT BIT FOR FIELD
IORM S1,DF$IPC(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEIPC ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
IPCRES: MOVE S1,.AEIPC(X) ;GET ORIGINAL IPCF VALUES
MOVEM S1,.AEIPC(U) ;RESTORE
MOVX S1,DF.IPC ;DEFAULT BIT FOR IPCF WORD
ANDCAM S1,DF$IPC(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$IPC(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$IPC(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEIPC ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
IPCPRT: LDB T1,IPCFS ;SEND QUOTA
LDB T2,IPCFR ;RECEIVE QUOTA
LDB T3,IPCFP ;PID QUOTA
$TEXT (,<Send ^D/T1/, Receive ^D/T2/, PIDs ^D/T3/>)
$RETT
; HELP TEXT
IPCHLP: ASCIZ \
IPCF-QUOTAS specifies a decimal value for the SEND, RECEIVE, and PID
quotas. The maximum value for each quota is 511.
\
SUBTTL ENTRIES -- LTI - LOGIN-TIMES
.ENTRY (LTI,.AELGT,<LOGIN times>)
LTIPRS: $NOISE (CONFRM,<allowed>)
LTI000: $INIT (LTI010)
LTI010: $KEYDSP (LTI020,<$ALTER(LTI060)>)
LTI020: $STAB
DSPTAB (LTI010,-4,<NON>,CM%NOR)
DSPTAB (LTI010,-4,<NON-PRIME-TIME>)
DSPTAB (LTI010,-3,<PRIME-TIME>)
DSPTAB (LTI030,-2,<WEEKDAYS>)
DSPTAB (LTI030,-1,<WEEKENDS>)
$ETAB
LTI030: $NUMBER (LTI040,^D10,<starting hour>,<$DEFAULT(<0>)>)
LTI040: $TOKEN (LTI050,<:>,<$DEFAULT(<:>)>)
LTI050: $NUMBER (LTI010,^D10,<ending hour>,<$DEFAULT(<23>)>)
LTI060: $KEYDSP (LTI070,<$ALTER(CONFRM)>)
LTI070: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (LTI080,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
LTI080: $KEYDSP (LTI020)
; GET ROUTINE
LTIGET: PUSHJ P,.SAVE1 ;SAVE P1
LTIGE1: MOVEI S1,LTI000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ \LOGIN-TIMES>\]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
LTIGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT LTIGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAILE S1,LTILEN ;A COMMON KEYWORD?
HRRES S1 ;NO--MAKE A NEGATIVE INDEX
PUSHJ P,@LTITAB(S1) ;DISPATCH
JRST LTIGE2 ;TRY FOR MORE
; COMPARE ROUTINE
LTICMP: MOVEI S1,.AELGT ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
LTICHG: MOVEI S1,.AELGT ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
LTIDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.LGT ;DEFAULT BIT FOR FIELD
IORM S1,DF$LGT(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AELGT ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
LTIRES: MOVE S1,.AELGT(X) ;GET ORIGINAL LOGIN TIMES
MOVEM S1,.AELGT(U) ;RESTORE
MOVX S1,DF.LGT ;DEFAULT BIT FOR TIMES WORD
ANDCAM S1,DF$LGT(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$LGT(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$LGT(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AELGT ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
LTIPRT: $TEXT (,<Weekdays ^A>)
LOAD S1,.AELGT(U),AE.WDH ;GET WEEKDAY LOGIN TIMES
SKIPN S1 ;ANY TIMES SET?
$TEXT (,<-none- ^A>) ;IF NONE, SAY SO
SETZB T1,T4 ;CURRENT HOUR, OFFSET FOR ENDING HOUR
MOVSI T2,(1B0) ;FLOATING BIT
SETO T3, ;STARTING HOUR
LTIPR1: TDNE T2,.AELGT(U) ;TEST THE LOGIN TIMES WORD
JRST LTIPR2 ;JUST ADD IT IN
MOVEI S1,-1(T1) ;BACK DOWN TO LAST HOUR WE LOOKED AT
SKIPL T3 ;IS THERE A STARTING HOUR?
$TEXT (,<^D/T3/:^D/S1/ ^A>) ;YES, TYPE IT OUT
SETO T3, ;NO STARTING HOUR ANY MORE
JUMPN T2,LTIPR3 ;IF NOT END OF SEGMENT, JOIN COMMON CODE
JUMPN T4,LTIPR4 ;IF WE'VE ALREADY BEEN HERE, EXIT
$TEXT (,< Weekends ^A>)
LOAD S1,.AELGT(U),AE.WEH ;GET WEEKEND TIMES
SKIPN S1 ;ANY TIMES?
$TEXT (,<-none- ^A>) ;NO
MOVEI T1,0 ;START AT HOUR PAIR ZERO-ONE
MOVEI T2,1B24 ;BIT FOR WEEKEND HOURS
MOVEI T4,1 ;WEEKENDS WORK WITH DOUBLE WORD PAIRS
JRST LTIPR1 ;AND JUMP BACK INTO THAT CODE AGAIN
LTIPR2: SKIPL T3 ;IS THERE ALREADY A STARTING HOUR?
JRST LTIPR3 ;YES, JUST KEEP LOOPING
MOVE T3,T1 ;NO, INITIALIZE IT
LTIPR3: LSH T2,-1 ;SHIFT BIT TO THE RIGHT
CAIL T1,^D23 ;HAVE WE PASSED THE LAST HOUR?
SETZ T2, ;CLEAR LOOKING BIT
ADDI T1,1(T4) ;LOOK AT NEXT HOUR
JRST LTIPR1 ;AND LOOP
LTIPR4: $TEXT (,<>) ;END LINE
$RETT
; HELP TEXT
LTIHLP: ASCIZ \
LOGIN-TIMES specifies the time of the day the user is allowed to LOGIN.
Weekdays are divided into 24 one-hour segments. Weekends are divided
into 12 two-hour segments. Therefore, if a user is permitted to LOGIN
on Saturday at 7:00 AM, the user can actually LOGIN between 6:00 AM and
7:59 AM.
\
; KEYWORD DISPATCH TABLE
IFIW LTINPT ;"NON-PRIME-TIME"
IFIW LTIPTM ;"PRIME-TIME"
IFIW LTIWDY ;"WEEKDAYS"
IFIW LTIWEN ;"WEEKENDS"
LTITAB: IFIW LTIALL ;"ALL"
IFIW LTIDEF ;"DEFAULT"
IFIW LTIDON ;"DONE"
IFIW LTIHLX ;"HELP"
IFIW LTINO ;"NO"
IFIW LTINON ;"NONE"
IFIW LTIRES ;"RESTORE"
IFIW LTIPRT ;"SHOW"
LTILEN==.-LTITAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
LTIALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVNI S1,1 ;SET ALL HOURS
PJRST LTIHRS ;GO SET
; "DEFAULT" KEYWORD PROCESSOR
LTIDEF: PUSHJ P,LTIDFL ;DO DEFAULTING
PJRST LTIGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
LTIDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,.AELGT ;OFFSET TO CHECK
ADJSP P,-1 ;WE CO-RETURN
PJRST CMPVAL ;SET CHANGE FLAGS & RETURN
; "HELP" KEYWORD PROCESSOR
LTIHLX: PUSHJ P,P$CFM ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OFER THE CRLF
MOVEI S1,@LTI+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "NO" KEYWORD PROCESSOR
LTINO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
LTINON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVNI P1,1 ;MAKE IT LOOK LIKE "NO ALL"
MOVNI S1,1 ;GET MASK
PJRST LTIHRS ;GO CLEAR
; "NON-PRIME-TIME" KEYWORD PROCESSOR
LTINPT: SKIPA S1,[NPTHRS] ;GET NON-PRIME TIME HOURS
; "PRIME-TIME" KEYWORD PROCESSOR
LTIPTM: MOVX S1,PTMHRS ;GET PRIME TIME HOURS
LTIHRS: SKIPE P1 ;SKIP IF SETTING
ANDCAM S1,.AELGT(U) ;CLEAR HOURS
SKIPN P1 ;SKIP IF CLEARING
IORM S1,.AELGT(U) ;SET HOURS
IORM S1,CHGMSK+.AELGT ;UPDATE CHANGE MASK
LTIGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "WEEKDAY" KEYWORD PROCESSOR
LTIWDY: PUSHJ P,LTIRNG ;GET THE RANGE
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ T1, ;CLEAR AN AC
MOVSI T2,(1B0) ;BIT 0
MOVN T3,S2 ;NEGATIVE LSH
LSH T2,(T3) ;GET STARTING HOUR BIT
LTIWD1: IOR T1,T2 ;OR IT IN
LSH T2,-1 ;MOVE BIT TO NEXT HOUR
CAMGE S2,S1 ;REACHED END?
AOJA S2,LTIWD1 ;NO, LOOP
MOVE S1,T1 ;COPY BIT MASK
PJRST LTIHRS ;GO SET/CLEAR HOURS
; "WEEKEND" KEYWORD PROCESSOR
LTIWEN: PUSHJ P,LTIRNG ;GET THE RANGE
$RETIF ;RETURN ON ERRORS
LSH S1,-1 ;WEEKENDS USE TWO-HOUR PERIODS
LSH S2,-1 ;SAME FOR UPPER BOUND
SETZ T1, ;CLEAR AN AC
MOVEI T2,1B24 ;STARTING BIT FOR US TO USE
MOVN T3,S2 ;NEGATIVE LSH
LSH T2,(T3) ;STARTING HOUR BIT
LTIWE1: IOR T1,T2 ;OR IT IN
LSH T2,-1 ;MOVE BIT TO NEXT HOUR PAIR
CAMGE S2,S1 ;REACHED END?
AOJA S2,LTIWE1 ;LOOP
MOVE S1,T1 ;COPY BIT MASK
PJRST LTIHRS ;GO SET/CLEAR HOURS
LTIRNG: PUSHJ P,.SAVE1 ;WE TRASH P1
PUSHJ P,P$NUM## ;GET THE NUMBER
JUMPF .RETF ;IF FAILS, MUST NOT BE A RANGE
MOVE P1,S1 ;SAVE RANGE
PUSHJ P,P$TOK## ;GET THE SEPERATOR TOKEN
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$NUM## ;GET THE ENDING RANGE
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S2,P1 ;GET BACK FIRST NUMBER
CAIGE S1,^D24 ;RANGE CHECK BOTH
CAIL S2,^D24 ;NUMBERS
JRST LTIRN1 ;ONE OF THEM IS ILLEGAL
CAML S1,S2 ;MAKE SURE RANGE IS CORRECT DIRECTION
JRST .RETT ;IT'S GOOD, USE IT
LTIRN1: $TEXT (,<Illegal range ^D/P1/:^D/S1/, Ignored>)
JRST .RETF ;AND RETURN
SUBTTL ENTRIES -- MAI - MAILING ADDRESS
.ENTRY (MAI,.AEMAI,<Mailing address>)
MAIPRS: $NODNM (MAI010,,<$FLAGS(CM%PO),$ALTER(MAI010)>)
MAI010: $USER (MAI040,<$ALTER(MAI020)>)
MAI020: $QUOTE (MAI040,,<$PREFI(P$8BIT##),$ALTER(MAI030)>)
MAI030: $FIELD (MAI040,<user name>,<$PREFI(P$8BIT##),$BREAK(TXTBRK)>)
MAI040: $TOKEN (MAI050,<@>,<$PREFI(MAIXIF),$ALTER(CONFRM)>)
MAI050: $FIELD (CONFRM,<node name>,<$PREFI(MAIEIF),$BREAK(NNMBRK)>)
MAIXIF: MOVE S1,CR.FLG(S2) ;GET ADDRESS OF COMMAND STATE BLOCK
MOVX TF,CM%XIF ;EXCLUDE INDIRECT FILES FLAG
IORM TF,.CMFLG(S1) ;SET IT FOR S%CMND
$RETT ;AND WE'RE DONE SETTING UP
MAIEIF: MOVE S1,CR.FLG(S2) ;GET ADDRESS OF COMMAND STATE BLOCK
MOVX TF,CM%XIF ;EXCLUDE INDIRECT FILES FLAG
ANDCAM TF,.CMFLG(S1) ;CLEAR IT FOR S%CMND
PJRST P$8BIT## ;FINISH SETTING UP FOR 8-BIT PARSE
; GET ROUTINE
MAIGET: PUSHJ P,.SAVE4 ;SAVE P1-4
SETZB P3,P4 ;REMEMBER NO NODE YET
MOVE S1,[TEMP,,TEMP+1] ;SET UP BLT
SETZM TEMP ;CLEAR FIRST WORD
BLT S1,TEMP+.AEMAX-1 ;CLEAR TEMPORARY STORAGE
MOVE S1,[POINT 8,TEMP+ARG.DA] ;BYTE POINTER FOR STORAGE
MOVEM S1,MAIPTR ;SAVE
MOVEI S1,<<TEMP-ARG.DA>*.AMLCW> ;ABSOLUTE MAXIMUM CHARACTER COUNT
MOVEM S1,MAICNT ;SAVE IT TOO
PUSHJ P,P$NODE## ;FETCH OPTIONAL NODE
JUMPF MAIGE1 ;NOT THERE
MOVEI P4,[ITEXT (<@^O/P3/>)] ;ASSUME ANF-10 NODE NUMBER
TLNE S1,-1 ;POSSIBLE NODE NAME?
MOVEI P4,[ITEXT (<@^W/P3/>)] ;YES
SKIPN P3,S1 ;SAVE THE NODE VALUE
SETZ P4, ;FORGET IT IF NULL
MAIGE1: PUSHJ P,P$USER## ;TRY FOR A PPN
JUMPF MAIGE2 ;NOT THERE
MOVEI P1,[ITEXT (<^T/(P2)/>)] ;ITEXT BLOCK TO USE
PUSH P,.AEPPN(U) ;SAVE PPN IN PROFILE
MOVEM S1,.AEPPN(U) ;STORE TARGET PPN FOR A SECOND
PUSHJ P,CVTPPD ;GENERATE PPN STRING
MOVEI P2,(S1) ;POINT TO TEXT
POP P,.AEPPN(U) ;REPLACE ORIGINAL PPN IN PROFILE
JRST MAIGE4 ;ONWARD
MAIGE2: PUSHJ P,P$QSTR## ;TRY FOR A QUOTED STRING
JUMPF MAIGE3 ;NOT THERE
MOVEI P1,[ITEXT (<"^Q/P2/">)] ;ITEXT BLOCK TO USE
MOVEI P2,ARG.DA(S1) ;POINT TO START OF TEXT
HRLI P2,(POINT 8,) ;8-BIT ASCIZ
JRST MAIGE4 ;ONWARD
MAIGE3: PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI P1,[ITEXT (<^Q/P2/>)] ;ITEXT BLOCK TO USE
MOVEI P2,ARG.DA(S1) ;POINT TO START OF TEXT
HRLI P2,(POINT 8,) ;8-BIT ASCIZ
MAIGE4: JUMPN P3,MAIGE5 ;IF HAD A LEADING NODE, SKIP TRAILING NODE
PUSHJ P,P$TOK## ;WAS THERE A TOKEN?
JUMPF MAIGE5 ;NO--GO HANDLE EOL
PUSHJ P,P$FLD## ;YES--CHECK IF NEXT IS A FIELD
JUMPF PRSERR ;ERROR SOMEWHERE IF NOT
MOVEI P4,[ITEXT (<@^Q/P3/>)] ;ITEXT BLOCK FOR NODE
MOVEI P3,ARG.DA(S1) ;POINT TO START OF TEXT
HRLI P3,(POINT 8) ;8-BIT ASCIZ
MAIGE5: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPN P4 ;IF NO NODE INFORMATION,
MOVEI P4,[ITEXT (<>)] ;USE AN EMPTY ITEXT BLOCK
$TEXT (MAITYO,<^I/(P1)/^I/(P4)/^0>) ;STORE USER-ID AND MAYBE NODE-ID
MOVEI P1,TEMP ;POINT TO THE PSEUDO RETURNED PARSER DATA BLOCK
MOVEI S1,<<TEMP-ARG.DA>*.AMLCW> ;ABSOLUTE MAXIMUM CHARACTER COUNT
SUB S1,MAICNT ;GET HOW MANY CHARACTERS STORED
IDIVI S1,.AMLCW ;COMPUTE WORDS USED
SKIPE S2 ;REMAINDER?
ADDI S1,1 ;YES--COUNT ONE MORE
MOVSI S1,ARG.DA(S1) ;PUT IN LH
HRRI S1,.CMFLD ;FAKE UP RETURNED PARSER HEADER
MOVEM S1,ARG.HD(P1) ;SAVE
MOVEI S1,(P1) ;POINT TO STRING
MOVE S2,[.AMLLC,,.AMLLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
MOVEI T1,10 ;8-BIT BYTES
PUSHJ P,PROSTR ;CHECK STRING LENGTH AND CONTENT
MOVEI S1,(P1) ;PARSER DATA BLOCK ADDRESS
MOVE S2,MAI+CG.PFL ;PROFILE OFFSET
PUSHJ P,PROBLK ;ADD/DELETE EXTENSIBLE BLOCK
SKIPT ;CHECK FOR ERRORS
WARN (NRM,<No room in profile for MAILING-ADDRESS>,,MAIRES)
MOVEI S1,.AEMAI ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
MAITYO: SOSL MAICNT ;COUNT CHARACTERS
IDPB S1,MAIPTR ;STORE CHARACTER
$RETT ;RETURN
; COMPARE ROUTINE
MAICMP: MOVEI S1,.AEMAI ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
MAICHG: MOVEI S1,.AEMAI ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
MAIDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.MAI ;DEFAULT BIT FOR FIELD
IORM S1,DF$MAI(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEMAI ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
MAIRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEMAI(X) ;-LENGTH
HRRI T2,.AEMAI ;OFFSET
SKIPE T3,.AEMAI(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.MAI ;DEFAULT BIT FOR MAIL WORD
TDNN T4,DF$MAI(X) ;WAS IT ORIGINALLY DEFAULTED?
TDZA T4,T4 ;NO, CLEAR THE BIT
MOVEI T4,1 ;YES, SET THE BIT
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL MAILING ADDRESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEMAI ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
MAIPRT: SKIPN S1,.AEMAI(U) ;GET AOBJN POINTER
SKIPA S1,[NONE8] ;THERE IS NONE
ADDI S1,(U) ;INDEX INTO PROFILE
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
$TEXT (,<^Q/S1/>) ;DISPLAY
$RETT
; HELP TEXT
MAIHLP: ASCIZ \
MAILING ADDRESS specifies an address for mail forwarding. This is an
unprivileged entry in a profile, and as such may be modified by the
user.
\
SUBTTL ENTRIES -- NAM - NAME
.ENTRY (NAM,.AENAM,<User name>)
NAMPRS: $QUOTE (CONFRM,<user name>,<$PREFI(P$8BIT##),$ALTER(NAM010)>)
NAM010: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)
; GET ROUTINE
NAMGET: SKIPE RESPPN ;IS THE NAME-PPN CORRESPONDENCE FIXED?
WARN (RNC,<Reserved PPN's name cannot be changed>,,.RETT)
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,P$QSTR## ;GET A QUOTED STRING
SKIPT ;CHECK FOR ERRORS
PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPN ARG.DA(S1) ;REALLY HAVE A NAME?
WARN (NNG,<No name given; name not changed>,,.RETT)
MOVEI P1,ARG.DA(S1) ;COPY ADDRESS
LOAD P2,ARG.HD(S1),AR.LEN ;GET BLOCK LENGTH
MOVE S1,P1 ;POINT TO STRING
PUSHJ P,A$CKNM## ;CHECK IT FOR LEGALITY
JUMPT NAMGE1 ;JUMP IF NAME IS OK
HRLI P1,(POINT 8,) ;MAKE A BYTE POINTER
WARN (RNI,<Reserved name illegal; ^Q/P1/>,,.RETT)
NAMGE1: MOVSI S1,.AENAM(U) ;POINT TO STORAGE
HRRI S1,.AENAM+1(U) ;MAKE A BLT POINTER
SETZM .AENAM(U) ;CLEAR FIRST WORD
BLT S1,.AENAM+.AANLW-1(U) ;CLEAR ENTIRE BLOCK
CAILE P2,.AANLW ;ENFORCE CHARACTER MAXIMUM
MOVEI P2,.AANLW ;TOO LARGE
ADDI P2,.AENAM(U) ;COMPUTE END OF BLT
MOVSI S1,(P1) ;POINT TO NAME
HRRI S1,.AENAM(U) ;POINT TO STORAGE
BLT S1,-1(P2) ;COPY
MOVE S1,.AENAM+.AANLW-1(U) ;COPY LAST WORD
TRZN S1,7760 ;LAST CHARACTER ZERO?
JRST NAMGE2 ;YES
MOVEM S1,.AENAM+.AANLW-1(U) ;TERMINATE STRING
WARN (NTT,<NAME text truncated to ^D/[.AANLC]/ characters>)
NAMGE2: MOVEI S1,.AENAM ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
NAMCMP: SKIPE SELFLG ;HAS IT ALWAYS CHANGED?
$RETF ;YES, SKIP COMPARES
PUSHJ P,.SAVE1 ;SAVE P1
MOVEI T1,.AENAM(U) ;POINT TO SOURCE NAME
HRLI T1,(POINT 8,) ;8-BIT ASCIZ
MOVEI T2,.AENAM(X) ;POINT TO OLD NAME
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
MOVEI T3,.AANLC ;CHARACTERS
NAMCM1: ILDB S1,T1 ;GET A CHARACTER FROM NEW NAME
CAIL S1,"A"+40 ;CONVERT
CAILE S1,"Z"+40 ; LOWER
CAIA ; CASE TO
SUBI S1," " ; UPPER CASE
ILDB S2,T2 ;GET A CHARACTER FROM OLD NAME
CAIL S2,"A"+40 ;CONVERT
CAILE S2,"Z"+40 ; LOWER
CAIA ; CASE TO
SUBI S2," " ; UPPER CASE
CAIE S1,(S2) ;MATCH?
$RETF ;NAMES ARE DIFFERENT
SOJG T3,NAMCM1 ;YES--LOOP BACK FOR ANOTHER
$RETT ;RETURN IF POINTER RUNS OUT
; CHANGE ROUTINE
NAMCHG: MOVEI S1,.AENAM ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
NAMDFL: PJRST PRODFZ ;NO CAN DO
; RESTORE ROUTINE
NAMRES: MOVSI S1,.AENAM(X) ;POINT TO OLD NAME
HRRI S1,.AENAM(U) ;MAKE A BLT POINTER
BLT S1,.AENAM+.AANLW-1(U) ;COPY
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AENAM ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
NAMPRT: $TEXT (,<^Q/USRNAM/>) ;8-BIT ASCII NAME
$RETT ;RETURN
; HELP TEXT
NAMHLP: ASCIZ \
NAME specifies the user name for the specified profile. This name is
used for accounting purposes may not be changed by the user (see
PERSONAL-NAME). The user name can consist of any printable character.
A user name must be quoted if it contains any character other than A
through Z and dash. The maximum length of a name is 39 characters.
\
SUBTTL ENTRIES -- NUL - NULL-ENTRY
.ENTRY (NUL,-1,<>,FL.NTY!FL.XCR)
NULPRS: $CRLF
; GET ROUTINE
NULGET: $RETF
; COMPARE ROUTINE
NULCMP: $RETT
; CHANGE ROUTINE
NULCHG: $RETF
; DEFAULT ROUTINE
NULDFL: PJRST PRODFZ ;NO CAN DO
; RESTORE ROUTINE
NULRES: $RETF
; PRINT ROUTINE
NULPRT: $TEXT (,<>) ;JUST A CRLF
$RETT
; HELP TEXT
NULHLP: ASCIZ //
SUBTTL ENTRIES -- PDF - PROFILE-DEFAULT
.ENTRY (PDF,.AEDEF,<Profile default>)
PDFPRS: $USER (CONFRM,<$PDATA (CM%WLA+WILDPP),$ALTER(PDF010)>)
PDF010: $KEYDSP (PDF020,)
PDF020: $STAB
DSPTAB (CONFRM,0,<NONE>)
DSPTAB (CONFRM,1,<PROJECT>)
$ETAB
; GET ROUTINE
PDFGET: HRRE S1,.AEPPN(U) ;GET PROGRAMMER NUMBER
AOJN S1,PDFGE1 ;CONTINUE IF NOT THE DEFAULT
PUSH P,.AEPPN(U) ;SAVE PPN
MOVE S1,.AEDEF(U) ;GET DEFAULT PPN
MOVEM S1,.AEPPN(U) ;SAVE TEMPORARILY
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,.AEPPN(U) ;RESTORE PPN
WARN (MND,<No profile default allowed for ^T/(S1)/>,,PDFRES)
PDFGE1: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$USER## ;TRY FOR A PPN
MOVE P1,S1 ;COPY POSSIBLE PPN
JUMPT PDFGE2 ;JUMP IF ONE IS SUPPLIED
PUSHJ P,P$KEYW## ;TRY FOR A KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIE S1,0 ;ONLY TWO
CAIN S1,1 ; OPTIONS
SKIPA P1,[EXP <0,,-1>,<0>](S1)
PJRST PRSERR ;PARSE ERROR
PDFGE2: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEM P1,.AEDEF(U) ;SAVE DEFAULT PPN
MOVEI S1,.AEDEF ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
PDFCMP: MOVEI S1,.AEDEF ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
PDFCHG: MOVEI S1,.AEDEF ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
PDFDFL: PJRST PRODFZ ;CAN'T DEFAULT THIS ONE
; RESTORE ROUTINE
PDFRES: MOVE S1,.AEDEF(X) ;GET ORIGINAL DEFAULT
MOVEM S1,.AEDEF(U) ;RESTORE
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEDEF ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
PDFPRT: SKIPE S2,.AEDEF(U) ;GET DEFAULT PPN
JRST PDFPR1 ;DO DISPLAY SOMETHING
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
$TEXT (,<[^O/S1/,%] or [%,%]>)
$RETT ;RETURN
PDFPR1: CAIE S2,-1 ;NO DEFAULTING?
JRST PDFPR2 ;GO TRANSLATE PPN
MOVEI S1,NONE7 ;POINT TO "-NONE-"
JRST PDFPR3 ;AND FINISH UP
PDFPR2: PUSH P,.AEPPN(U) ;SAVE PPN
MOVEM S2,.AEPPN(U) ;STORE DEFAULT TEMPORARILY
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,.AEPPN(U) ;RESTORE PPN
PDFPR3: $TEXT (,<^T/(S1)/>) ;DISPLAY
$RETT ;RETURN
; HELP TEXT
PDFHLP: ASCIZ \
PROFILE-DEFAULT specifies which profile will be used for defaulting
various entries in the user's profile.
\
SUBTTL ENTRIES -- PNM - PERSONAL-NAME
.ENTRY (PNM,.AEPNM,<Personal name>)
PNMPRS: $QUOTE (CONFRM,<optionally quoted string>,<$PREFI(P$8BIT##),$ALTER(PNM010)>)
PNM010: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)
; GET ROUTINE
PNMGET: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$QSTR## ;GET A QUOTED STRING
SKIPT ;CHECK FOR ERRORS
PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE STRING ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(P1) ;POINT TO STRING
MOVE S2,[.APNLC,,.APNLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
MOVEI T1,10 ;8-BIT BYTES
PUSHJ P,PROSTR ;CHECK STRING LENGTH AND CONTENT
MOVEI S1,(P1) ;PARSER DATA BLOCK ADDRESS
MOVE S2,PNM+CG.PFL ;PROFILE OFFSET
PUSHJ P,PROBLK ;ADD/DELETE EXTENSIBLE BLOCK
SKIPT ;CHECK FOR ERRORS
WARN (NRM,<No room in profile for PERSONAL NAME>,,PNMRES)
MOVEI S1,.AEPNM ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
PNMCMP: MOVEI S1,.AEPNM ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
PNMCHG: MOVEI S1,.AEPNM ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
PNMDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.PNM ;DEFAULT BIT FOR FIELD
IORM S1,DF$PNM(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEPNM ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
PNMRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEPNM(X) ;-LENGTH
HRRI T2,.AEPNM ;OFFSET
SKIPE T3,.AEPNM(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.PNM ;DEFAULT BIT FOR PERSONAL NAME
TDNN T4,DF$PNM(X) ;WAS IT ORIGINALLY DEFAULTED?
TDZA T4,T4 ;NO, BIT TO RESTORE IS ZERO
MOVEI T4,1 ;YES, BIT TO RESTORE IS ONE
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL PERSONAL NAME
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEPNM ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
PNMPRT: SKIPN S1,.AEPNM(U) ;GET AOBJN POINTER
SKIPA S1,[NONE8] ;THERE IS NONE
ADDI S1,(U) ;INDEX INTO PROFILE
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
$TEXT (,<^Q/S1/>) ;DISPLAY
$RETT
; HELP TEXT
PNMHLP: ASCIZ \
PERSONAL-NAME specifies a name other than the user's offical accounting
name (see NAME). The personal name, if available, is displayed on the
banner page(s) of a user's spooled output. This is an unprivilged entry
in a profile, and as such may be modified by the user.
\
SUBTTL ENTRIES -- PPX - PPN
.ENTRY (PPX,.AEPPN,<PPN>)
PPXPRS: $USER (CONFRM)
; GET ROUTINE
PPXGET: $RETF
; COMPARE ROUTINE
PPXCMP: MOVEI S1,.AEPPN ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
PPXCHG: $RETF
; DEFAULT ROUTINE
PPXDFL: PJRST PRODFZ ;CAN'T DO IT
; RESTORE ROUTINE
PPXRES: $RETF
; PRINT ROUTINE
PPXPRT: PUSHJ P,CVTPPD ;TRANSLATE TO ASCIZ
$TEXT (,<^T/(S1)/>) ;DISPLAY
$RETT ;RETURN
; HELP TEXT
PPXHLP: ASCIZ \
PPN specifies the project and programmer number for a profile. The PPN
is the primary means of identifying a user.
\
SUBTTL ENTRIES -- PRG - PROGRAM-TO-RUN
.ENTRY (PRG,.AEPGR,<Program to run>)
PRGPRS: $NOISE (PRG010,<at LOGIN>)
PRG010: $FILE (CONFRM,<filespec>,<$PREFIL(PRGACT)>)
PRGACT: MOVE S1,[GJFBLK##,,GJFBLK##+1] ;SET UP TO ZERO BLOCK
SETZM GJFBLK## ;CLEAR 1ST WORD
BLT S1,GJFBLK##+GJFSIZ-1 ;CLEAR THE REST
MOVSI S1,'...' ;GET SOMETHING TO MARK OUR PLACE
MOVEM S1,GJFBLK##+.FDSTR ;STORE IT
$RETT ;RETURN
; GET ROUTINE
PRGGET: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,PROFSP ;FETCH FILESPEC
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE FD ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(P1) ;FD (PARSER DATA BLOCK) ADDRESS
MOVE S2,PRG+CG.PFL ;PROFILE OFFSET
PUSHJ P,PROBLK ;ADD/DELETE EXTENSIBLE BLOCK
SKIPT ;CHECK FOR ERRORS
WARN (NRM,<No room in profile for PROGRAM-TO-RUN>,,PRGRES)
MOVEI S1,.AEPGR ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
PRGCMP: MOVEI S1,.AEPGR ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
PRGCHG: MOVEI S1,.AEPGR ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
PRGDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.PGR ;DEFAULT BIT FOR FIELD
IORM S1,DF$PGR(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEPGR ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
PRGRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEPGR(X) ;-LENGTH
HRRI T2,.AEPGR ;OFFSET
SKIPE T3,.AEPGR(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.PGR ;DEFAULT BIT FOR PROGRAM-TO-RUN
TDNN T4,DF$PGR(X) ;WAS IT ORIGINALLY DEFAULTED?
TDZA T4,T4 ;NO, CLEAR THE BIT
MOVEI T4,1 ;YES, SET IT
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL PROGRAM TO RUN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEPGR ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
PRGPRT: SKIPE S1,.AEPGR(U) ;GET AOBJN POINTER TO FILESPEC
JRST PRGPR1 ;GOT ONE
$TEXT (,<-none->) ;NOPE
$RETT ;RETURN
PRGPR1: ADDI S1,(U) ;INDEX INTO PROFILE
HLRE S2,S1 ;GET -LENGTH OF FILESPEC
MOVMS S2 ;MAKE POSITIVE
HRLZM S2,FDBLK+.FDLEN ;SAVE AS FD LENGTH
HRLZS S1 ;PUT FILESPEC ADDRESS IN LH
HRRI S1,FDBLK+.FDSTR ;MAKE A BLT POINTER
BLT S1,FDBLK+.FDPAT+4 ;COPY FOR GLXTXT
$TEXT (,<^F/FDBLK/>) ;DISPLAY
$RETT ;RETURN
PRGHLP: ASCIZ \
PROGRAM-TO-RUN specifies a file specification of the program to run
after the user logs in. The file specification may include a device
name, program name, extension, and directory, including up to five
levels of sub-file directories (SFDs).
\
SUBTTL ENTRIES -- PRV - PRIVILEGES
.ENTRY (PRV,.AEPRV,<Privileges>)
PRVPRS: $NOISE (CONFRM,<allowed>)
PRV000: $INIT (PRV010)
PRV010::$KEYDSP (PRV020,<$ALTER(PRV030)>)
PRV020: $STAB
DSPTAB (PRV010,PRVADM,<ADMINISTRATIVE>)
DSPTAB (PRV010,PRVCCC,<CPU>)
DSPTAB (PRV070, -3,<DISK-PRIORITY>)
DSPTAB (PRV010,PRVENQ,<ENQ-DEQ>)
DSPTAB (PRV080, -2,<HPQ>)
DSPTAB (PRV010,PRVIPC,<IPCF>)
DSPTAB (PRV010,PRVLCK,<LOCK>)
DSPTAB (PRV010,PRVMET,<METER>)
DSPTAB (PRV090, -1,<OPERATOR>)
DSPTAB (PRV010,PRVPOK,<POKE>)
DSPTAB (PRV010,PRVRTT,<RTTRP>)
DSPTAB (PRV010,PRVSPA,<SPY-ALL-CORE>)
DSPTAB (PRV010,PRVSPM,<SPY-MONITOR>)
DSPTAB (PRV010,PRVTRP,<TRPSET>)
DSPTAB (PRV010,PRVNSP,<UNSPOOLING>)
$ETAB
PRV030: $KEYDSP (CPV010##,<$ALTER(PRV040)>)
PRV040: $KEYDSP (PRV050,<$ALTER(CONFRM)>)
PRV050: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (PRV060,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
PRV060: $KEYDSP (PRV020,<$ALTER(PRV110)>)
PRV070: $NUMBER (PRV010,^D10,<Maximum disk priority>,<$DEFAULT(<0>)>)
PRV080: $NUMBER (PRV010,^D10,<Maximum CPU priority>,<$DEFAULT(<0>)>)
PRV090: $KEYDSP (PRV100,<$PREFIL(PRVACT),$PDEFAULT(DEFTX1)>)
PRV100: $STAB
DSPTAB (PRV010,.OBHOP,<HOST>)
DSPTAB (PRV010,.OBNOP,<NONE>)
DSPTAB (PRV010,.OBROP,<REMOTE>)
DSPTAB (PRV010,.OBSOP,<SYSTEM>)
$ETAB
PRV110: $KEYDSP (CPV010##)
PRVACT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,[ASCIZ /NONE/] ;ASSUME NO PRIVS
SETZ P2, ;CLEAR
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
HRRZ S2,.AEPPN(U) ;GET PROGRAMMER NUMBER
CAIE S2,REMOPR ;POSSIBLY A REMOTE OPERATOR?
JRST PRVAC1 ;NO
CAILE S1,100 ;RANGE CHECK
CAILE S1,177 ; POSSIBLE STATION NUMBER
JRST PRVAC1 ;CAN'T BE A REMOTE OPERATOR
DMOVE P1,[ASCIZ /REMOTE/]
JRST PRVAC3 ;FINISH UP
PRVAC1: MOVE S2,.AEPPN(U) ;GET PPN IN QUESTION
CAIE S1,HSTPRJ ;ALLOWED HOST PRIVS?
JRST PRVAC2 ;NO
MOVE P1,[ASCIZ /HOST/]
SETZ P2, ;CLEAR
JRST PRVAC3 ;FINISH UP
PRVAC2: CAIE S1,SYSPRJ ;SYSTEM PROGRAMMER?
CAIN S1,GLXPRJ ;GALAXY PROJECT NUMBER?
DMOVE P1,[ASCIZ /SYSTEM/] ;GIVE FULL OPR PRIVS
PRVAC3: DMOVEM P1,DEFTX1 ;SAVE DEFAULT TEXT
$RETT ;RETURN
; GET ROUTINE
PRVGET: PUSHJ P,.SAVE1 ;SAVE P1
PRVGE1: MOVEI S1,PRV000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ \PRIVILEGES>\]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
PRVGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT PRVGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIL S1,PRVBPT ;ADDRESS OF A
CAIL S1,PRVBPE ; BYTE POINTER?
CAIA ;NO
JRST PRVGE3 ;NEEDS SPECIAL PROCESSING
CAIL S1,CPVBPS## ;ADDRESS OF A CUSTOMER
CAIL S1,CPVBPE## ; BYTE POINTER?
CAIA ;WRONG AGAIN
JRST PRVGE3 ;YES, GIVE IT SPECIAL ATTENTION
CAILE S1,PRVLEN ;A COMMON KEYWORD?
HRRES S1 ;NO--MAKE A NEGATIVE INDEX
PUSHJ P,@PRVTAB(S1) ;DISPATCH
JRST PRVGE2 ;TRY FOR MORE
PRVGE3: HLR S2,(S1) ;GET THE BPT
MOVEI S1,1 ;GET A BIT
PUSH P,U ;SAVE PROFILE ADDRESS
MOVEI U,CHGMSK ;FUDGE TO POINT TO BIT MASK
DPB S1,(S2) ;LIGHT BIT IN CHANGE/SELECT MASK
POP P,U ;RESTORE PROFILE ADDRESS
SKIPE P1 ;SETTING?
MOVEI S1,0 ;NO--CLEARING
DPB S1,(S2) ;ADD IN THE VALUE
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
JRST PRVGE2 ;AND LOOP
; COMPARE ROUTINE
PRVCMP: MOVEI S1,.AEPRV ;PRIMARY PROFILE OFFSET
PUSHJ P,COMPAR ;TEST FOR EQUALITY
$RETIF ;PROPAGATE 'CHANGED' RETURN
MOVEI S1,.AEPRX ;FIRST HALF WAS OK,
PJRST COMPAR ;RETURN RESULT FROM SECOND OFFSET
; CHANGE ROUTINE
PRVCHG: MOVEI S1,.AEPRV ;PROFILE OFFSET
PUSHJ P,QUECHG ;CHANGE IT
MOVEI S1,.AEPRX ;OTHER PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THAT CHANGE, TOO
; DEFAULT ROUTINE
PRVDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.PRV ;DEFAULT BIT FOR FIRST FIELD
IORM S1,DF$PRV(U) ;LIGHT IN PROFILE
MOVX S1,DF.PRX ;DEFAULT BIT FOR SECOND FIELD
IORM S1,DF$PRX(U) ;LIGHT THAT, TOO
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEPRV ;WHOLE WORD
SETOM CHGMSK+.AEPRX ;BOTH WORDS
$RETT ;WIN
; RESTORE ROUTINE
PRVRES: MOVE S1,.AEPRV(X) ;GET OLD PRIV WORD 1
MOVEM S1,.AEPRV(U) ;RESTORE OLD PRIV WORD 1
MOVX S1,DF.PRV ;PRIV WORD 1 DEFAULT BIT
ANDCAM S1,DF$PRV(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$PRV(X) ;RIGHT?
IORM S1,DF$PRV(U) ;NO, LIGHT IT AGAIN
MOVE S1,.AEPRX(X) ;GET OLD PRIV WORD 2
MOVEM S1,.AEPRX(U) ;RESTORE OLD PRIV WORD 2
MOVX S1,DF.PRX ;PRIV WORD 2 DEFAULT BIT
ANDCAM S1,DF$PRX(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$PRX(X) ;RIGHT?
IORM S1,DF$PRX(U) ;NO, LIGHT IT AGAIN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEPRV ;IN BOTH CHANGE MASKS
SETZM CHGMSK+.AEPRX ;AS WELL
$RETT ;AND RETURN
; PRINT ROUTINE
PRVPRT: SETO T3, ;COUNT OF SECOND SET OF BITS TYPED
LDB S1,PRVDPR ;GET DSKPRI BYTE
JUMPE S1,PRVPR1 ;BYPASS IF NOTHING
AOS T3 ;BUMP COUNT OF ARGS
$TEXT (,<Disk priority: ^D/S1/^A>)
PRVPR1: LDB S1,PRVCPQ ;GET HPQ BYTE
JUMPE S1,PRVPR2 ;BYPASS IF NOTHING
AOSE T3 ;INCREMENT COUNT OF ARGS
$TEXT (,<, ^A>) ;SEPERATE FROM PREVIOUS ARG
$TEXT (,<HPQ: ^D/S1/^A>)
PRVPR2: LDB S1,PRVOPP ;GET OPR PRIV BYTE
JUMPE S1,PRVPR3 ;BYPASS IF NONE
AOSE T3 ;INCREMENT COUNT OF ARGS
$TEXT (,<, ^A>)
$TEXT (,<^T/@PRVGLX(S1)/ operator^A>)
PRVPR3: LOAD S1,.AEPRV(U),LHMASK ;GET DEC PRIVS
SKIPL T3 ;IF NOTHING TYPED, DON'T END LINE
$TEXT (,<>) ;END LINE
SKIPE S1 ;DON'T INDENT IF NO BITS
$TEXT (,< ^A>) ;INDENT NEXT SET OF TYPEOUT
PRVPR4: MOVE S1,[IOWD PRVBPE-PRVBPT,PRVBPT] ;IOWD POINTER TO BITS
SKIPL T3 ;TYPE ANYTHING?
PUSHJ P,PRTBTX ;YES, DON'T TYPE "-NONE-"
SKIPGE T3
PUSHJ P,PRTBTS ;AND OUTPUT THE FIRST SET OF BITS
PUSHJ P,CPVPRT## ;PRINT CUSTOMER PRIV BITS
$RETT ;RETURN
PRVHLP: ASCIZ \
PRIVILEGES specifies the privileged functions allowed to the user. The
functions are: the ability to set ADMINISTRATIVE, CPU specification,
DISK-PRIORITY, ENQ-DEQ, HPQ, IPCF, LOCK, METER, OPERATOR, POKE, RTTRP,
SPY-ALL-CORE, SPY-MONITOR, TRPSET, and UNSPOOLING. Refer to the TOPS-10
Monitor Calls manual for more information on the use of privileges.
\
; KEYWORD DISPATCH TABLE
IFIW PRVDSK ;"DISK-PRIORITY"
IFIW PRVHPQ ;"HPQ"
IFIW PRVOPR ;"OPERATOR"
PRVTAB: IFIW PRVALL ;"ALL"
IFIW PRVDEF ;"DEFAULT"
IFIW PRVDON ;"DONE"
IFIW PRVHLX ;"HELP"
IFIW PRVNO ;"NO"
IFIW PRVNON ;"NONE"
IFIW PRVRES ;"RESTORE"
IFIW PRVPRT ;"SHOW"
PRVLEN==.-PRVTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
PRVALL: PUSHJ P,P$CFM ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,ALLPRV ;GET ALL PRIV BITS
IORM S1,.AEPRV(U) ;SAVE
IORM S1,CHGMSK+.AEPRV ;ALSO SET IN MASK
MOVEI S1,.OBSOP ;NOW GET SYSTEM OPERATOR CODE
DPB S1,PRVOPP ;SET IT
MOVX S1,JP.OPR ;GET OPR PRIVS FIELD
IORM S1,CHGMSK+.AEPRX ;SET IN SECOND WORD'S MASK
PRVGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "DEFAULT" KEYWORD PROCESSOR
PRVDEF: PUSHJ P,PRVDFL ;DO DEFAULTING
PJRST PRVGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
PRVDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE CO-RETURN
MOVE T1,@CHGADR ;SAVE PREVIOUS CHANGE FLAG
MOVEI S1,.AEPRV ;PRIMARY OFFSET
PUSHJ P,CMPVAL ;SET CHANGE FLAGS
SKIPN T1 ;IF NOT PREVIOUSLY CHANGED,
SKIPA T1,@CHGADR ;JUST USE THIS VALUE
EXCH T1,@CHGADR ;ELSE REMEMBER NEW FLAG AND RESTORE OLD ONE
MOVEI S1,.AEPRX ;SECONDARY OFFSET
PUSHJ P,CMPVAL ;SET CHANGE FLAGS FROM IT
SKIPE T1 ;IF WE CHANGED IT,
SETOM @CHGADR ; MAKE SURE WE MARK IT
POPJ P, ;RETURN
; "HELP" KEYWORD PROCESSOR
PRVHLX: PUSHJ P,P$CFM ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@PRV+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "NO" KEYWORD PROCESSOR
PRVNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;AND RETURN
; "NONE" KEYWORD PROCESSOR
PRVNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,ALLPRV ;GET ALL PRIV BITS
ANDCAM S1,.AEPRV(U) ;CLEAR THEM
IORM S1,CHGMSK+.AEPRV ;SET IN MASK FOR WORD
SETZM .AEPRX(U) ;AND EXTENDED PRIV WORD
SETOM CHGMSK+.AEPRX ;CHANGING THIS ONE, TOO
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "DISK-PRIORITY" KEYWORD PROCESSOR
PRVDSK: PUSHJ P,P$NUM## ;GET PRIORITY
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPE P1 ;SKIP IF SETTING
MOVEI S1,0 ;ZERO VALUE
SETZ P1, ;CLEAR "NO" FLAG
SKIPL S1 ;RANGE
CAILE S1,3 ; CHECK
WARN (DOR,<Disk priority ^D/S1/ out of range 0 to 3>,,.RETT)
DPB S1,PRVDPR ;SAVE AWAY
MOVX S1,JP.DPR ;DISK-PRIORITY MASK
IORM S1,CHGMSK+.AEPRV ;SET IN MODIFIED MASK
SETOM @CHGADR ;CHANGING PROFILE ENTRY
$RETT ;AND RETURN
; "HPQ" KEYWORD PROCESSOR
PRVHPQ: PUSHJ P,P$NUM## ;GET HPQ
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPE P1 ;SKIP IF SETTING
MOVEI S1,0 ;ZERO VALUE
SETZ P1, ;CLEAR "NO" FLAG
SKIPL S1 ;RANGE
CAILE S1,^D15 ; CHECK
WARN (HOR,<HPQ ^D/S1/ out of range 0 to 15>,,.RETT)
DPB S1,PRVCPQ ;SAVE AWAY
MOVX S1,JP.HPQ ;GET HPQ MASK
IORM S1,CHGMSK+.AEPRV ;SET IN MODIFY MASK
SETOM @CHGADR ;CHANGING PROFILE ENTRY
$RETT ;AND RETURN
; "OPERATOR" KEYWORD PROCESSOR
PRVOPR: PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPE P1 ;SKIP IF SETTING
MOVEI S1,.OBNOP ;ZERO VALUE
SETZ P1, ;CELAR "NO" FLAG
DPB S1,PRVOPP ;SAVE AWAY
MOVX S1,JP.OPR ;OPR PRIVS FIELD
IORM S1,CHGMSK+.AEPRX ;SET IN MODIFY MASK
SETOM @CHGADR ;CHANGING PROFILE ENTRY
$RETT ;AND RETURN
; BIT STORAGE/DISPLAY TABLE
PRVBPT:!
PRVADM: XWD [POINTR .AEPRV(U),JP.ADM],[ASCIZ \Administrative\]
PRVENQ: XWD [POINTR .AEPRV(U),JP.ENQ],[ASCIZ \ENQ-DEQ\]
PRVIPC: XWD [POINTR .AEPRV(U),JP.IPC],[ASCIZ \IPCF\]
PRVLCK: XWD [POINTR .AEPRV(U),JP.LCK],[ASCIZ \LOCK\]
PRVMET: XWD [POINTR .AEPRV(U),JP.MET],[ASCIZ \METER\]
PRVPOK: XWD [POINTR .AEPRV(U),JP.POK],[ASCIZ \POKE\]
PRVRTT: XWD [POINTR .AEPRV(U),JP.RTT],[ASCIZ \RTTRP\]
PRVCCC: XWD [POINTR .AEPRV(U),JP.CCC],[ASCIZ \CPU\]
PRVSPA: XWD [POINTR .AEPRV(U),JP.SPA],[ASCIZ \SPY-all-core\]
PRVSPM: XWD [POINTR .AEPRV(U),JP.SPM],[ASCIZ \SPY-monitor\]
PRVTRP: XWD [POINTR .AEPRV(U),JP.TRP],[ASCIZ \TRPSET\]
PRVNSP: XWD [POINTR .AEPRV(U),JP.NSP],[ASCIZ \Unspooling\]
PRVBPE:!
PRVDPR: POINTR .AEPRV(U),JP.DPR ;DISK PRIORITY
PRVCPQ: POINTR .AEPRV(U),JP.HPQ ;HPQ
PRVOPP: POINTR .AEPRX(U),JP.OPR ;OPERATOR
; GALAXY OPERATOR PRIVILEGES
PRVGLX: [ASCIZ \None\]
[ASCIZ \System\]
[ASCIZ \Host\]
[ASCIZ \Remote\]
SUBTTL ENTRIES -- PSW - PASSWORD
.ENTRY (PSW,.AEPSW,<Password>,FL.NTY)
PASS00: $INIT (PSWPRS)
PSWPRS: $FIELD (CONFRM,,<$PREFI(P$7BIT##),$FLAGS(CM%SDH),$BREAK(PSWBRK)>)
; GET ROUTINE
PSWGET: PUSHJ P,.SAVE2 ;SOME PERM ACS
PUSHJ P,P$FLD## ;GET POINTER TO FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETOM CHGMSK+.AEPSW ;IN BOTH PLACES
MOVE P1,S1 ;STASH POINTER TO BLOCK
MOVE S1,[XWD PASSWD,PASSWD+1] ;CLEAR PASSWORD BLOCK
SETZM PASSWD
BLT S1,PASSWD+.APWLW-1
MOVEI T1,ARG.DA(P1) ;ADDRESS OF TEXT
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
MOVE T2,[POINT 8,PASSWD] ;BYTE POINTER TO STORAGE
MOVEI T3,.APWLC ;MAXIMUM LENGTH
PSWGE1: ILDB S1,T1 ;GET A CHARACTER
JUMPE S1,.RETT ;RETURN IF ALL DONE
CAIL S1,140 ;UPPER CASE?
SUBI S1,40 ;IT IS NOW
; SUBI S1,40 ;SIXBIT NOW
IDPB S1,T2 ;PUT A CHARACTER
SOJG T3,PSWGE1 ;LOOP THROUGH STRING
ILDB S1,T1 ;GET NEXT CHARACTER
SKIPE S1 ;TERMINATING NUL?
WARN (PST,<Password truncated to ^D/[.APWLC]/ characters>)
$RETT
; COMPARE ROUTINE
PSWCMP: $RETT ;PASSWORD ALWAYS MATCHES
; CHANGE ROUTINE
PSWCHG: PUSHJ P,.SAVE2 ;PRESERVE SOME ACS
DMOVE P1,[EXP .AEPSW,<.APWLW,,PASSWD>] ;POINT TO BLOCK
PJRST QUEINS ;STUFF INTO UUO LIST
; DEFAULT ROUTINE
PSWDFL: PJRST PRODFZ ;CAN'T DEFAULT THIS ONE
; RESTORE ROUTINE
PSWRES: SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEPSW ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
PSWPRT: $RETT ;NEVER PRINT IT OUT
; HELP TEXT
PSWHLP: ASCIZ \
PASSWORD specifies a password the user must type to gain access to the
system. The password can consist of any printable characters, and can
be up to 39 characters long.
\
SUBTTL ENTRIES -- RQL - REQUIRE
.ENTRY (RQL,.AEREQ,<Requirements for LOGIN>)
RQLPRS: $NOISE (CONFRM,<for LOGIN>)
RQL000: $INIT (RQL010)
RQL010: $KEYDSP (RQL020,<$ALTER(RQL130)>)
RQL020: $STAB
DSPTAB (RQL010,-10,<ACCOUNT-STRING>)
DSPTAB (RQL060,-7,<CHANGE>)
DSPTAB (RQL090,-6,<INTERVAL>)
DSPTAB (RQL080,-5,<LENGTH>)
DSPTAB (RQL030,-4,<NAME>)
DSPTAB (RQL030,-3,<PASSWORD>)
DSPTAB (RQL100,-2,<PROHIBIT>)
DSPTAB (RQL010,-1,<REMARK-STRING>)
$ETAB
RQL030: $NOISE (RQL040,<under>)
RQL040: $KEY (RQL010,RQL050,<$DEFAULT(<BOTH>),$ALTER(RQL130)>)
RQL050: $STAB
KEYTAB (1,<BATCH>)
KEYTAB (3,<BOTH>)
KEYTAB (2,<TIMESHARING>)
$ETAB
RQL060: $NOISE (RQL070,<of password>)
RQL070: $FTAD (RQL010,<$HELP(<future date/time>),$ALTER(RQL010)>)
RQL080: $NUMBER (RQL010,^D10,<minimum password length>)
RQL090: $NUMBER (RQL010,^D10,<password change interval in days>)
RQL100: $NOISE (RQL110,<password changes>)
RQL110: $KEYDSP (RQL120,<$DEFAULT (<YES>)>)
RQL120: $STAB
DSPTAB (CONFRM,0,<NO>)
DSPTAB (CONFRM,1,<YES>)
$ETAB
RQL130: $KEYDSP (RQL140,<$ALTER(CONFRM)>)
RQL140: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (RQL150,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
RQL150: $KEYDSP (RQL020)
; GET ROUTINE
RQLGET: PUSHJ P,.SAVE1 ;SAVE P1
RQLGE1: MOVEI S1,RQL000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ /REQUIREMENTS>/]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
RQLGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT RQLGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAILE S1,RQLSIZ ;A COMMON KEYWORD?
HRRES S1 ;NO--MAKE A NEGATIVE INDEX
PUSHJ P,@RQLTAB(S1) ;DISPATCH
JRST RQLGE2 ;TRY FOR MORE
; COMPARE ROUTINE
RQLCMP: MOVEI S1,.AEREQ ;PRIMARY PROFILE OFFSET
PUSHJ P,COMPAR ;SEE IF THE SAME
$RETIF ;PROPAGATE '.NE.' RETURN
MOVEI S1,.AEPCT ;OK SO FAR,
PJRST COMPAR ;RETURN RESULT FROM SECOND OFFSET
; CHANGE ROUTINE
RQLCHG: MOVEI S1,.AEREQ ;WORD TO CHANGE
PUSHJ P,QUECHG ;MAYBE QUEUE UP THE CHANGE
MOVE S2,.AEPCT(U) ;GET UDT OF CHANGE
MOVEI S1,.AEPCT ;GET FORCE PASSWORD CHANGE FUNCTION
CAME S2,.AEPCT(X) ;IF A CHANGE,
PJRST QUECHG ;QUEUE IT UP AND RETURN
$RETT ;RETURN HAPPY
; DEFAULT ROUTINE
RQLDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.REQ ;DEFAULT BIT FOR FIRST FIELD
IORM S1,DF$REQ(U) ;LIGHT IN PROFILE
MOVX S1,DF.PCT ;DEFAULT BIT FOR SECOND FIELD
IORM S1,DF$PCT(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEREQ ;WHOLE THING
SETOM CHGMSK+.AEPCT ;BOTH WORDS
$RETT ;WIN
; RESTORE ROUTINE
RQLRES: MOVE S1,.AEREQ(X) ;GET ORIGINAL REQUIREMENTS
MOVEM S1,.AEREQ(U) ;RESTORE
MOVX S1,DF.REQ ;REQUIREMENTS WORD DEFAULT BIT
ANDCAM S1,DF$REQ(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$REQ(X) ;RIGHT?
IORM S1,DF$REQ(U) ;NO, LIGHT IT AGAIN
MOVE S1,.AEPCT(X) ;GET ORIGINAL PSW CHANGE UDT
MOVEM S1,.AEPCT(U) ;RESTORE
MOVX S1,DF.PCT ;CHANGE TIME WORD DEFAULT BIT
ANDCAM S1,DF$PCT(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$PCT(X) ;RIGHT?
IORM S1,DF$PCT(U) ;NO, LIGHT IT AGAIN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEPCT ;IN BOTH MASK WORDS
SETZM CHGMSK+.AEREQ ;AS WELL
$RETT ;AND RETURN
; PRINT ROUTINE
RQLPRT: LDB T1,[POINTR (.AEREQ(U),AE.ACT)] ;GET ACCOUNT BIT
LDB T2,[POINTR (.AEREQ(U),AE.RMK)] ;GET REMARK BIT
LSH T2,1 ;POSITION
IOR T2,T1 ;MERGE THE TWO
MOVE T1,RQLPRX(T2) ;GET APPROPRIATE TEXT
$TEXT (,<^M^J ^T/(T1)/>)
LDB T1,[POINTR (.AEREQ(U),AE.NRT)] ;GET NAME UNDER TIMESARING
LDB T2,[POINTR (.AEREQ(U),AE.NRB)] ;GET NAME UNDER BATCH
LSH T2,1 ;POSITION
IOR T2,T1 ;MERGE THE TWO
MOVE T1,RQLPRY(T2) ;GET APPROPRIATE TEXT
$TEXT (,< Name ^T/(T1)/>)
LDB T1,[POINTR (.AEREQ(U),AE.PRT)] ;GET PSW UNDER TIMESARING
LDB T2,[POINTR (.AEREQ(U),AE.PRB)] ;GET PSW UNDER BATCH
LSH T2,1 ;POSITION
IOR T2,T1 ;MERGE THE TWO
MOVE T1,RQLPRY(T2) ;GET APPROPRIATE TEXT
$TEXT (,< Password ^T/(T1)/>)
SKIPN S1,.AEPCT(U) ;PASSWORD CHANGE DATE?
SKIPA T1,[[ITEXT (<not required>)]]
MOVEI T1,[ITEXT (<at ^H/.AEPCT(U)/>)]
CAMN S1,[EXP -1] ;CHANGE AT NEXT LOGIN?
MOVEI T1,[ITEXT (<at next LOGIN>)]
$TEXT (,< Password change ^I/(T1)/>)
LOAD S1,.AEREQ(U),AE.PWL ;GET MINIMUM PASSWORD LENGTH
MOVEI S2,[ITEXT (<^D/S1/>)]
SKIPN S1 ;WAS IT SET?
MOVEI S2,[ITEXT (<^T/NONE7/>)] ;NO
$TEXT (,< Minimum password length: ^I/(S2)/>)
LOAD S1,.AEREQ(U),AE.PCI ;GET PASSWORD CHANGE INTERVAL
MOVEI S2,[ITEXT (<Every ^D/S1/ days>)]
SKIPN S1 ;WAS IT SET?
MOVEI S2,[ITEXT (<^T/NONE7/>)] ;NO
$TEXT (,< Password change interval: ^I/(S2)/>)
LDB S1,[POINTR (.AEREQ(U),AE.PCP)] ;GET BIT
MOVE S1,[[ASCIZ /allowed/]
[ASCIZ /prohibited/]](S1)
$TEXT (,< Password changes are ^T/(S1)/>)
$RETT ;RETURN
RQLPRX: [ASCIZ /Account and remark strings are not required/]
[ASCIZ /Account string/]
[ASCIZ /Remark string/]
[ASCIZ /Account and remark strings/]
RQLPRY: [ASCIZ /is not required/]
[ASCIZ /under timesharing/]
[ASCIZ /under batch/]
[ASCIZ /under timesharing and batch/]
; HELP TEXT
RQLHLP: ASCIZ \
REQUIREMENTS specifies additional information the user must supply in
order to LOGIN. Options are:
ACCOUNT-STRING
CHANGE of password
INTERVAL of required password changes in days
LENGTH of minimum password
NAME under timesharing or batch
PROHIBIT password changes
PASSWORD under timesharing or batch
REMARK-STRING to be stored in the usage files
\
; KEYWORD DISPATCH TABLE
IFIW RQLACC ;"ACCOUNT-STRING"
IFIW RQLCPW ;"CHANGE-OF-PASSWORD"
IFIW RQLINT ;"INTERVAL"
IFIW RQLLEN ;"LENGTH"
IFIW RQLNAM ;"NAME"
IFIW RQLPSW ;"PASSWORD"
IFIW RQLPRH ;"PROHIBIT"
IFIW RQLREM ;"REMARK-STRING"
RQLTAB: IFIW RQLALL ;"ALL"
IFIW RQLDEF ;"DEFAULT"
IFIW RQLDON ;"DONE"
IFIW RQLHLX ;"HELP"
IFIW RQLNO ;"NO"
IFIW RQLNON ;"NONE"
IFIW RQLRES ;"RESTORE"
IFIW RQLPRT ;"SHOW"
RQLSIZ==.-RQLTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
RQLALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
SETOM .AEREQ(U) ;SET ALL REQUIREMENTS
SETOM CHGMSK+.AEREQ ;CHANGED WHOLE WORD
SETOM .AEPCT(U) ;FORCE CHANGE ON THE NEXT LOGIN
SETOM CHGMSK+.AEPCT ;FLAG CHANGE HERE, TOO
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "DEFAULT" KEYWORD PROCESSOR
RQLDEF: PUSHJ P,RQLDFL ;DO DEFAULTING
PJRST RQLGO1 ;FINISH UP
; "DONE" KEYWORD PROCESSOR
RQLDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE T1,@CHGADR ;SAVE CHANGE FLAG
MOVEI S1,.AEREQ ;PRIMARY PROFILE OFFSET
PUSHJ P,CMPVAL ;SET CHANGE FLAGS
SKIPN T1 ;IF NOT PREVIOUSLY CHANGED,
SKIPA T1,@CHGADR ;JUST USE THIS VALUE
EXCH T1,@CHGADR ;ELSE REMEMBER NEW FLAG AND RESTORE OLD ONE
MOVEI S1,.AEPCT ;SECONDARY PROFILE OFFSET
PUSHJ P,CMPVAL ;SET ITS CHANGE FLAGS
SKIPE T1 ;IF WE KNOW WE CHANGED SOMETHING,
SETOM @CHGADR ; MAKE SURE WE MARK IT
ADJSP P,-1 ;WE CO-RETURN
POPJ P, ;DO SO
; "HELP" KEYWORD PROCESSOR
RQLHLX: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@RQL+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "NO" KEYWORD PROCESSOR
RQLNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
RQLNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
SETZM .AEREQ(U) ;CLEAR ALL REQUIREMENTS
SETOM CHGMSK+.AEREQ ;CHANGED WHOLE WORD
SETZM .AEPCT(U) ;CLEAR PASSWORD CHANGE DATE/TIME
SETOM CHGMSK+.AEPCT ;NOTE CHANGE HERE, TOO
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "ACCOUNT-STRING" KEYWORD PROCESSOR
RQLACC: MOVX S1,AE.ACT ;BIT TO SET
RQLGO: SKIPE P1 ;SKIP IF SETTING
ANDCAM S1,.AEREQ(U) ;CLEAR REQUIREMENTS
SKIPN P1 ;SKIP IF CLEARING
IORM S1,.AEREQ(U) ;SET REQUIREMENTS
IORM S1,CHGMSK+.AEREQ ;SET IN CHANGE MASK
RQLGO1: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "CHANGE" KEYWORD PROCESSOR
RQLCPW: SETZM .AEPCT(U) ;CLEAR PSW CHANGE DATE/TIME
PUSHJ P,P$TIME## ;GET TIME IN UDT FORMAT
SKIPT ;PERHAPS NOT SPECIFIED
SETOM S1 ;NEG MEANS LITE THE BIT, NOT A UDT
SKIPN P1 ;SKIP IF CLEARING PASSWORD CHANGE
MOVEM S1,.AEPCT(U) ;SAVE POSSIBLE UDT
PJRST RQLGO1 ;GO FINISH UP
; "INTERVAL" KEYWORD PROCESSOR
RQLINT: PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S2,DEFPCI ;MAXIMUM
SKIPL S1 ;CAN'T BE NEGATIVE
CAILE S1,(S2) ;BE REASONABLE
WARN (PCI,<Password change interval out of range 0 to ^D/S2/ days>,,.RETT)
STORE S1,.AEREQ(U),AE.PCI ;SAVE INTERVAL
MOVX S1,AE.PCI ;MASK WE CHANGED
IORM S1,CHGMSK+.AEREQ ;NOTE IT
PJRST RQLGO1 ;MARK CHANGE AND RETURN
; "LENGTH" KEYWORD PROCESSOR
RQLLEN: PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S2,.APWLC ;MAXIMUM LENGTH
SKIPL S1 ;CAN'T BE NEGATIVE
CAILE S1,(S2) ;RANGE CHECK
WARN (RPL,<Required password length out of range 0 to ^D/S2/ characters>,,.RETT)
STORE S1,.AEREQ(U),AE.PWL ;SAVE IN PROFILE
MOVX S1,AE.PWL ;GET MASK FOR FIELD
IORM S1,CHGMSK+.AEREQ ;SET IN CHANGE MASK
PJRST RQLGO1 ;MARK CHANGE AND RETURN
; "NAME" KEYWORD PROCESSOR
RQLNAM: MOVEI T1,3 ;DEFAULT TO NAME UNDER TIMESHARING AND BATCH
PUSHJ P,P$KEYW## ;GET A KEYWORD
SKIPF ;DEFAULTING?
MOVE T1,S1 ;NO
SETZ S1, ;CLEAR DESTINATION
TRNE T1,1 ;BATCH?
TXO S1,AE.NRB ;YES
TRNE T1,2 ;TIMESHARING?
TXO S1,AE.NRT ;YES
PJRST RQLGO ;GO SET/CLEAR BITS
; "PASSWORD" KEYWORD PROCESSOR
RQLPSW: MOVEI T1,3 ;DEFAULT TO PSW UNDER TIMESHARING AND BATCH
PUSHJ P,P$KEYW## ;GET A KEYWORD
SKIPF ;DEFAULTING?
MOVE T1,S1 ;NO
SETZ S1, ;CLEAR DESTINATION
TRNE T1,1 ;BATCH?
TXO S1,AE.PRB ;YES
TRNE T1,2 ;TIMESHARING?
TXO S1,AE.PRT ;YES
PJRST RQLGO ;GO SET/CLEAR BITS
; "PROHIBIT" KEYWORD PROCESSOR
RQLPRH: PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE T1,S1 ;GET KEYWORD VALUE
MOVX S1,AE.PCP ;GET PROHIBIT BIT
SKIPN P1 ;SKIP IF CLEARING
TRC T1,1 ;ELSE TOGGLE
MOVE P1,T1 ;UPDATE SET/CLEAR FLAG
PJRST RQLGO ;GO TOGGLE BIT AND RETURN
; "REMARK-STRING" KEYWORD PROCESSOR
RQLREM: MOVX S1,AE.RMK ;BIT TO SET
PJRST RQLGO ;GO SET/CLEAR BIT
SUBTTL ENTRIES -- SCH - SCHEDULER-TYPE
.ENTRY (SCH,.AESCD,<Schedular type>)
SCHPRS: $NUMBER (CONFRM,^D10,<Schedular type>)
; GET ROUTINE
SCHGET: PUSHJ P,P$NUM## ;GET THE TYPE
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,<MASK.(<WID(AE.SCD)>,35)> ;GET LIMIT
CAILE T1,(S1) ;RANGE CHECK
WARN (SOR,<Scheduler type ^D/T1/ out of range 0 to ^D/S1/>,,.RETT)
DPB T1,SCHED ;STORE THE VALUE
MOVEI S1,.AESCD ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
SCHCMP: MOVEI S1,.AESCD ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
SCHCHG: MOVEI S1,.AESCD ;FUNCTION TO CHANGE SCHEDULAR TYPE
JRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
SCHDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.SCD ;DEFAULT BIT FOR FIELD
IORM S1,DF$SCD(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AESCD ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
SCHRES: EXCH U,X ;SWAP PROFILE POINTERS
LDB S1,SCHED ;GET OLD SCHEDULER TYPE
EXCH U,X ;SWAP BACK
DPB S1,SCHED ;RESTORE OLD SCHEDULER TYPE
MOVX S1,DF.SCD ;SCHEDULER WORD DEFAULT BIT
ANDCAM S1,DF$SCD(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$SCD(X) ;RIGHT?
IORM S1,DF$SCD(U) ;NO, LIGHT IT AGAIN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AESCD ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
SCHPRT: LDB S1,SCHED ;GET THE TYPE
$TEXT (,<^D/S1/>) ;TYPE IT OUT
$RETT ;RETURN
; HELP TEXT
SCHHLP: ASCIZ \
SCHEDULER-TYPE associates the specified user profile with a group that
has been assigned a scheduler class. For more information about
assigning scheduler classes, see the SCDSET documentation in the TOPS-10
Software Installation Guide.
\
SUBTTL ENTRIES -- SPO - SPOOLED-DEVICES
.ENTRY (SPO,.AESPL,<Spooled device bits>)
SPOPRS: $NOISE (CONFRM,<set by LOGIN>)
SPO000: $INIT (SPO010)
SPO010: $KEYDSP (SPO020,<$ALTER(SPO030)>)
SPO020: $STAB
DSPTAB (SPO010,[JS.PCP],<CDP>)
DSPTAB (SPO010,[JS.PCR],<CDR>)
DSPTAB (SPO010,[JS.PLP],<LPT>)
DSPTAB (SPO010,[JS.PPL],<PLT>)
DSPTAB (SPO010,[JS.PPT],<PTP>)
$ETAB
SPO030: $KEYDSP (SPO040,<$ALTER(CONFRM)>)
SPO040: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (SPO050,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
SPO050: $KEYDSP (SPO020)
; GET ROUTINE
SPOGET: PUSHJ P,.SAVE1 ;SAVE P1
SPOGE1: MOVEI S1,SPO000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ /SPOOLED-DEVICES>/]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
SPOGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT SPOGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIG S1,SPOLEN ;ADDRESS OF BIT?
JRST SPOGE3 ;NO--KEYWORD
MOVE S2,(S1) ;GET THE BIT
IORM S2,.AESPL(U) ;SET IT ALWAYS
IORM S2,CHGMSK+.AESPL ;AT LEAST IN THE CHANGE MASK
SKIPE P1 ;SKIP IF SETTING
ANDCAM S2,.AESPL(U) ;ZERO THE BIT
SETZ P1, ;CLEAR "NO" FLAG
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
JRST SPOGE1 ;AND LOOP
SPOGE3: PUSHJ P,@SPOTAB(S1) ;DISPATCH
JRST SPOGE2 ;AND LOOP BACK
$RETT ;YES
; COMPARE ROUTINE
SPOCMP: MOVEI S1,.AESPL ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
SPOCHG: MOVEI S1,.AESPL ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
SPODFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.SPL ;DEFAULT BIT FOR FIELD
IORM S1,DF$SPL(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AESPL ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
SPORES: MOVE S1,.AESPL(X) ;GET ORIGINAL SPOOLING BITS
MOVEM S1,.AESPL(U) ;RESTORE
MOVX S1,DF.SPL ;SPOOLING WORD DEFAULT BIT
ANDCAM S1,DF$SPL(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$SPL(X) ;RIGHT?
IORM S1,DF$SPL(U) ;NO, LIGHT IT AGAIN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AESPL ;BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
SPOPRT: MOVE S1,[IOWD SPOBPE-SPOBPT,SPOBPT] ;POINTER TO TABLE OF BITS
PUSHJ P,PRTBTS ;PRINT THE BITS OUT
$RETT ;AND RETURN
; HELP TEXT
SPOHLP: ASCIZ \
SPOOLED-DEVICES specifies the physical devices which are not normally
available to the user. These devices are said to be spooled because the
monitor intercepts I/O to these devices and redirects the data to/from
disk files.
\
; KEYWORD DISPATCH TABLE
SPOTAB: IFIW SPOALL ;"ALL"
IFIW SPODEF ;"DEFAULT"
IFIW SPODON ;"DONE"
IFIW SPOHLX ;"HELP"
IFIW SPONO ;"NO"
IFIW SPONON ;"NONE"
IFIW SPORES ;"RESTORE"
IFIW SPOPRT ;"SHOW"
SPOLEN==.-SPOTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
SPOALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,JS.PAL ;SPOOL:ALL BITS
MOVEM S1,.AESPL(U) ;SET ALL SPOOLING BITS
MOVEM S1,CHGMSK+.AESPL ;IN MASK AS WELL
SPOGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "DEFAULT" KEYWORD PROCESSOR
SPODEF: PUSHJ P,SPODFL ;DO DEFAULTING
PJRST SPOGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
SPODON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE CO-RETURN
MOVEI S1,.AESPL ;OFFSET TO CHECK
PJRST CMPVAL ;SET CHANGE FLAGS & RETURN
; "HELP" KEYWORD PROCESSOR
SPOHLX: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@SPO+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "NO" KEYWORD PROCESSOR
SPONO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
SPONON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,JS.PAL ;SPOOL:ALL BITS
ANDCAM S1,.AESPL(U) ;CLEAR IN PROFILE ENTRY
IORM S1,CHGMSK+.AESPL ;NOTE AS CHANGED IN MASK
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; BIT STORAGE/DISPLAY TABLE
SPOBPT: XWD [POINTR .AESPL(U),JS.PCP],[ASCIZ \CDP\]
XWD [POINTR .AESPL(U),JS.PCR],[ASCIZ \CDR\]
XWD [POINTR .AESPL(U),JS.PLP],[ASCIZ \LPT\]
XWD [POINTR .AESPL(U),JS.PPL],[ASCIZ \PLT\]
XWD [POINTR .AESPL(U),JS.PPT],[ASCIZ \PTP\]
SPOBPE:!
SUBTTL ENTRIES -- STR - STRUCTURE-QUOTAS
.ENTRY (STR,.AEAUX,<Structure quotas>)
STRPRS: $NOISE (CONFRM,<set by LOGIN>)
STR000: $INIT (STR010)
STR010: $KEYDSP (STR020,<$ALTER(STR190)>)
STR020: $STAB
DSPTAB (STR030,-2,<ADD>)
DSPTAB (STR170,-1,<REMOVE>)
$ETAB
STR030: $NOISE (STR040,<structure>)
STR040: $FIELD (STR050,<structure name>,<$ACTION(STRACT)>)
STR050: $NOISE (STR060,<logged in>)
STR060: $NUMBER (STR080,^D10,<logged in quota>,<$PREFIL(STRPFF),$PDEFAULT(DEFTX1),$ACTION(STRACF),$ALTER(STR070)>)
STR070: $KEY (STR080,STR160,<$ACTION(STRACF)>)
STR080: $NOISE (STR090,<logged out>)
STR090: $NUMBER (STR110,^D10,<logged out quota>,<$PREFIL(STRPFO),$PDEFAULT(DEFTX1),$ACTION(STRACO),$ALTER(STR100)>)
STR100: $KEY (STR110,STR160,<$ACTION(STRACO)>)
STR110: $NOISE (STR120,<reserved>)
STR120: $NUMBER (STR140,^D10,<reserved quota>,<$PREFIL(STRPFR),$PDEFAULT(DEFTX1),$ACTION(STRACR)>)
STR140: $SWITCH (NEXT,STR150,<$PDEFAUL(DEFTX2),$ACTION(SHRSWT),$ALTER(CONFRM)>)
STR150: $STAB
KEYTAB (CREFLG,<CREATE>)
KEYTAB (NOCFLG,<NOCREATE>)
KEYTAB (NOWFLG,<NOWRITE>)
KEYTAB (WRTFLG,<WRITE>)
$ETAB
STR160: $STAB
KEYTAB (0,<INFINITE>)
$ETAB
STR170: $NOISE (STR180,<structure>)
STR180: $FIELD (CONFRM,<structure name>)
STR190: $KEYDSP (STR200,<$ALTER(CONFRM)>)
STR200: $STAB
DSPTAB ( ,2,\"32,CM%INV)
; DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
; DSPTAB (STR210,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
STR210: $KEYDSP (STR010)
CREFLG: EXP 0,AU.NCR ;CLEAR NO CREATE
NOCFLG: EXP 1,AU.NCR ;SET NO CREATE
WRTFLG: EXP 0,AU.RON ;CLEAR NO WRITE
NOWFLG: EXP 1,AU.RON ;SET NO WRITE
STRACT: MOVX S1,DEFQTA ;DEFAULT QUOTA
MOVEM S1,AUXBLK+.AULIN ;FCFS
SETZM AUXBLK+.AUOUT ;LOGGED OUT
SETZM AUXBLK+.AURES ;RESERVED
MOVX S1,STATBT ;DEFAULT STATUS BITS
MOVEM S1,AUXBLK+.AUBIT
PUSH P,T1 ;SAVE T1
PUSH P,U ;SAVE U (DON'T KNOW WHAT OPRPAR USES IT FOR)
MOVEI U,USER ;POINT TO PROFILE BLOCK
HRRZ S1,CR.SIZ(S2) ;GET ADDR OF OF PARSED DATA STORAGE
HRROI S1,ARG.DA(S1) ;POINT TO ASCIZ STRUCTURE NAME
PUSHJ P,S%SIXB ;CONVERT TO SIXBIT
MOVE S1,S2 ;COPY TO APPROPRIATE AC
PUSHJ P,STRPFL ;SEE IF ALREADY EXISTS IN THE PROFIL
MOVSI S1,(T1) ;POINT TO BLOCK
HRRI S1,AUXBLK ;MAKE A BLT POINTER
SKIPF ;REALLY HAVE AN AUXACC BLOCK?
BLT S1,AUXBLK+.AULEN-1 ;YES--COPY IT
SKIPN S1,AUXBLK+.AUBIT ;GET STATUS BITS
MOVEI S2,[ASCIZ \/CREATE /WRITE\]
TXNE S1,AU.NCR ;NO-CREATE?
MOVEI S2,[ASCIZ \/NOCREATE\]
TXNE S1,AU.RON ;NO-WRITE?
MOVEI S2,[ASCIZ \/NOWRITE\]
TXNE S1,AU.RON ;PERHAPS
TXNN S1,AU.NCR ; BOTH?
SKIPA ;NO
MOVEI S2,[ASCIZ \/NOCREATE /NOWRITE\]
$TEXT (<-1,,DEFTX2>,<^T/(S2)/^0>)
POP P,U ;RESTORE U
POP P,T1 ;RESTORE T1
$RETT ;RETURN
; PREFIL ROUTINES
STRPFF: SKIPA S1,[.AULIN] ;FCFS OFFSET
STRPFO: MOVEI S1,.AUOUT ;LOGGED OUT OFFSET
SKIPA
STRPFR: MOVEI S1,.AURES ;RESERVED OFFSET
MOVE S2,AUXBLK(S1) ;GET OLD QUOTA
SKIPE AUXBLK+.AUSTR ;NEW STRUCTURE?
JRST STRDF1 ;NO
CAIN S1,.AURES ;RESERVED QUOTA?
AOSA S1 ;YES--DEFAULT TO PREVIOUS (USUALLY ZERO) VALUE)
CAIE S1,.AULIN ;FIRST TIME HERE?
SKIPA S2,AUXBLK-1(S1) ;GET PREVIOUS VALUE TYPED
MOVEI S2,DEFQTA ;USE DEFAULT QUOTA
STRDF1: CAMN S2,[.INFIN] ;INFINITY?
JRST STRDF2 ;YES
$TEXT (<-1,,DEFTX1>,<^D/S2/^0>)
$RETT ;RETURN
STRDF2: DMOVE S1,[ASCIZ /INFINITE/]
DMOVEM S1,DEFTX1 ;SAVE DEFAULT TEXT
$RETT ;RETURN
; ACTION ROUTINES
STRACF: SKIPA S1,[.AULIN] ;FCFS QUOTA
STRACO: MOVEI S1,.AUOUT ;LOGGED OUT
SKIPA
STRACR: MOVEI S1,.AURES ;RESERVED
PUSH P,S1 ;SAVE OFFSET
HRRZ S1,CR.SIZ(S2) ;GET PARSED DATA STORAGE
LOAD S2,ARG.HD(S1),AR.TYP ;GET TYPE OF BLOCK
CAIN S2,.CMKEY ;KEYWORD ("INFINITE")?
SKIPA S2,[.INFIN] ;GET INFINITY
MOVE S2,ARG.DA(S1) ;ELSE PICK UP NUMBER
POP P,S1 ;GET AUXACC BLOCK OFFSET BACK
MOVEM S2,AUXBLK(S1) ;SAVE NEW VALUE
$RETT ;AND RETURN
; GET ROUTINE
STRGET: PUSHJ P,.SAVE1 ;SAVE P1
STRGE1: MOVEI S1,STR000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ \STRUCTURE-QUOTAS>\]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
STRGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT STRGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAILE S1,STRLEN ;A COMMON KEYWORD?
HRRES S1 ;NO--MAKE A NEGATIVE INDEX
PUSHJ P,@STRTAB(S1) ;DISPATCH
JUMPF STRGE1 ;TRY AGAIN ON FAILURES
JRST STRGE2 ;TRY FOR MORE
; COMPARE ROUTINE
STRCMP: MOVEI S1,.AEAUX ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
STRCHG: MOVEI S1,.AEAUX ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
STRDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.AUX ;DEFAULT BIT FOR FIELD
IORM S1,DF$AUX(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEAUX ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
STRRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEAUX(X) ;-LENGTH
HRRI T2,.AEAUX ;OFFSET
SKIPE T3,.AEAUX(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.AUX ;STRUCTURE QUOTAS DEFAULT BIT
TDNN T4,DF$AUX(X) ;WAS IT PREVIOUSLY DEFAULTED?
TDZA T4,T4 ;NO, RESTORE THE ZERO
MOVEI T4,1 ;YES, RESTORE THE ONE
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL AUXACC DATA
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEAUX ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
STRPRT: SKIPN T1,.AEAUX(U) ;AOBJN POINTER
SKIPA S1,[NONE7] ;THERE IS NONE
MOVEI S1,STRPR3 ;POINT TO HEADER
$TEXT (,<^T/(S1)/>)
JUMPE T1,.RETT ;RETURN IF NO AUXACC DATA
ADDI T1,(U) ;INDEX INTO PROFILE
PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,T1 ;COPY AUXACC POINTER
STRPR1: SKIPN .AUSTR(P1) ;IS THERE A STRUCTURE THERE?
JRST STRPR2 ;NO
MOVEI T1,[ITEXT (<^D10R /.AULIN(P1)/>)] ;QUOTA IN
MOVE S1,.AULIN(P1) ;GET LOGGED IN QUOTA
CAMN S1,[.INFIN] ;IS IT INFINITY?
MOVEI T1,[ITEXT (<-infinite->)] ;YES
MOVEI T2,[ITEXT (<^D10R /.AUOUT(P1)/>)] ;QUOTA OUT
MOVE S1,.AUOUT(P1) ;GET LOGGED OUT QUOTA
CAMN S1,[.INFIN] ;IS IT INFINITY?
MOVEI T2,[ITEXT (<-infinite->)] ;YES
MOVEI T3,[ITEXT (<^D10R /.AURES(P1)/>)] ;QUOTA OUT
MOVE S1,.AURES(P1) ;GET RESERVED QUOTA
CAMN S1,[.INFIN] ;IS IT INFINITY?
MOVEI T3,[ITEXT (<-infinite->)] ;YES
MOVEI T4,[ASCIZ //] ;ASSUME NO SPECIAL STATUS
MOVE S1,.AUBIT(P1) ;GET STATUS BITS
TXNE S1,AU.NCR ;NO-CREATE?
MOVEI T4,[ASCIZ \/NOCREATE\]
TXNE S1,AU.RON ;NO-WRITE?
MOVEI T4,[ASCIZ \/NOWRITE\]
TXNE S1,AU.RON ;PERHAPS
TXNN S1,AU.NCR ; BOTH?
SKIPA ;NO
MOVEI T4,[ASCIZ \/NOCREATE /NOWRITE\]
$TEXT (,< ^W6L/.AUSTR(P1)/ ^I/(T1)/ ^I/(T2)/ ^I/(T3)/ ^T/(T4)/>)
STRPR2: ADD P1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,STRPR1 ;AND LOOP
$RETT ;RETURN
STRPR3: ASCIZ \
Structure Quota in Quota out Reserved Status
--------- ----------- ---------- ---------- ----------\
; HELP TEXT
STRHLP: ASCIZ \
STRUCTURE-QUOTAS specifies the structures which are automatically
mounted when a user logs in. This list of structures constitutes the
job's search list (JSL).
\
; KEYWORD DISPATCH TABLE
IFIW STRADD ;"ADD"
IFIW STRREM ;"REMOVE"
STRTAB: IFIW STRALL ;"ALL"
IFIW STRDEF ;"DEFAULT"
IFIW STRDON ;"DONE"
IFIW STRHLX ;"HELP"
IFIW STRNO ;"NO"
IFIW STRNON ;"NONE"
IFIW STRRES ;"RESTORE"
IFIW STRPRT ;"SHOW"
STRLEN==.-STRTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
STRALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
$RETT ;RETURN
; "DEFAULT" KEYWORD PROCESSOR
STRDEF: PUSHJ P,STRDFL ;DO DEFAULTING
PJRST STRGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
STRDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE CO-RETURN
MOVEI S1,.AEAUX ;OFFSET TO CHECK
PJRST CMPVAL ;SET CHANGE FLAGS & RETURN
; "HELP" KEYWORD PROCESSOR
STRHLX: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@STR+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "NO" KEYWORD PROCESSOR
STRNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
STRNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
SETZM AUXPTR ;NO AUXACC DATA TO RESTORE
PJRST STRUPD ;UPDATE THE BLOCK IN THE PROFILE
; "ADD" KEYWORD PROCESSOR
STRADD: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,STRCPY ;COPY AUXACC DATA TO STATIC STORAGE
PUSHJ P,STRFND ;GET THE STRUCTURE AND POINTER TO BLOCK
SKIPF ;MAKE SURE IT DIDN'T ALREADY EXIST
WARN (SPE,<Superseding previous entry for ^W/S1/>)
MOVE P1,T1 ;SAVE POINTER
MOVE P2,S1 ;COPY STR NAME
PUSHJ P,STRCAT ;CHECK THE CATALOG
SKIPT ;CHECK FOR ERRORS
WARN (SNC,<Structure ^T/STRNAM/ is not cataloged>,,.RETF)
PUSHJ P,STRQTA ;GET A QUOTA
MOVE T1,S1 ;COPY FCFS
PUSHJ P,STRQTA ;GET A QUOTA
MOVE T2,S1 ;COPY LOGGED OUT
SETZ T3, ;ZERO RESERVED QUOTA
PUSHJ P,STRQTA ;GET A QUOTA
MOVE T3,S1 ;COPY RESERVED
PUSHJ P,STRSWT ;PARSE SWITCHES
MOVE T4,S1 ;GET AUXACC BITS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
EXCH P2,.AUSTR(P1) ;SAVE STRUCTURE NAME IN BLOCK
MOVEM T1,.AULIN(P1) ;SAVE FCFS
MOVEM T2,.AUOUT(P1) ;SAVE LOGGED OUT
MOVEM T3,.AURES(P1) ;SAVE RESERVED
MOVEM T4,.AUBIT(P1) ;SAVE STATUS
MOVSI T1,-.AULEN ;LENGTH OF AN AUXACC BLOCK
SKIPN P2 ;IF A NEW ENTRY,
ADDM T1,AUXPTR ;ACCOUNT FOR NEW ENTRY
STRUPD: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,AUXPTR ;GET -LENGTH
HRRI T2,.AEAUX ;PROFILE OFFSET
TLNN T2,-1 ;ANY DATA?
TDZA T3,T3 ;NO--DELETE AUXACC FROM PROFILE
MOVEI T3,AUXTMP ;POINT TO DATA
MOVEI T4,0 ;CLEAR .AEMAP BIT
PUSHJ P,A$EBLK## ;ALLOCATE AND STORE EXTENSIBLE BLOCK
STRGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "REMOVE" KEYWORD PROCESSOR
STRREM: PUSHJ P,STRCPY ;COPY AUXACC DATA TO STATIC STORAGE
PUSHJ P,STRFND ;GET STRUCTURE NAME AND POINTER TO BLOCK
JUMPF .RETT ;IGNORE ERRORS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
STRRE1: MOVSI S1,.AULEN(T1) ;POINT TO NEXT AUXACC BLOCK
HRRI S1,(T1) ;MAKE A BLT POINTER
BLT S1,.AULEN-1(T1) ;OVERWRITE THE ONE WE'RE DELETING
ADD T1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
STRRE2: AOBJN T1,STRRE1 ;LOOP
MOVSI T1,.AULEN ;LENGTH OF AN AUXACC BLOCK
ADDM T1,AUXPTR ;ACCOUNT FOR ENTRY DELETED
PJRST STRUPD ;GO UPDATE THE PROFILE AND RETURN
; CHECK THE CATALOG FOR A KNOWN STRUCTURE NAME
STRCAT: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,[.QUARG,,QUEBLK] ;POINT TO UUO ARGUMENT BLOCK
MOVE S1,[QF.RSP+.QUCAT] ;FLAGS AND FUNCTION CODE
MOVEM S1,.QUFNC(P1)
SETZM .QUNOD(P1) ;CENTRAL STATION
MOVE S1,[CATMAX,,CATACK] ;LENGTH,,RESPONSE BLOCK ADDRESS
MOVEM S1,.QURSP(P1) ;SAVE
SKIPN DEBUGQ ;DEBUGGING?
SKIPE OLDMON ;[241] CAN WE TIMOUT THE UUO?
JRST STRCA1 ;NO
MOVEI S1,ZZTIME ;NUMBER OF SECONDS
MOVEM S1,.QUTIM(P1) ;SAVE
MOVSI S1,1 ;PLUS A
ADDB P1,S1 ; WORD
MOVSS S1 ;GET TOTAL LENGTH SO FAR IN RH
DPB S1,[POINTR .QUFNC(P1),QF.HLN] ;STORE HEADER LENGTH
STRCA1: HLRZ S1,P1 ;GET WORD COUNT SO FAR
ADD P1,S1 ;POINT AT FIRST FREE WORD
DMOVE S1,[EXP <1,,.QBVSN>,STRNAM]
DMOVEM S1,(P1)
ADD P1,[2,,2] ;ADVANCE POINTER
DMOVE S1,[EXP <QA.IMM!.QBMFG>,<QB.DSK>]
DMOVEM S1,(P1)
ADD P1,[2,,2] ;ADVANCE POINTER
HLRZ S1,P1 ;GET LENGTH OF BLOCK
SUBB P1,S1 ;SET UP UUO AC
QUEUE. S1, ;SEE IF STRUCTURE IS CATALOGED
CAIN S1,QUILF% ;OK IF NO CATALOG KNOWN TO THIS MONITOR
$RETT ;RETURN
$RETF ;FAILED
; COPY AUXACC BLOCK TO STATIC STORAGE
STRCPY: MOVEI T1,AUXTMP ;POINT TO STATIC BLOCK
MOVEM T1,AUXPTR ;SAVE FOR ADD/REMOVE
MOVE T1,[AUXTMP,,AUXTMP+1] ;SET UP BLT
SETZM AUXTMP ;CLEAR FIRST WORD
BLT T1,AUXTMP+.AULEN+.AUMAX-1 ;[241] COPY
SKIPN T1,.AEAUX(U) ;GET AOBJN POINTER
POPJ P, ;NO DATA
;[241] HLLM T1,AUXPTR ;SAVE -LENGTH
ADDI T1,(U) ;INDEX INTO PROFILE
HRLZS T1 ;PUT IN LH
HRRI T1,AUXTMP ;MAKE A BLT POINTER
HLRE T2,.AEAUX(U) ;GET -LENGTH
MOVMS T2 ;MAKE POSITIVE
BLT T1,AUXTMP-1(T2) ;COPY
MOVEI T1,.AULEN-1(T2) ;[241] FOR ROUNDING UP
IDIVI T1,.AULEN ;[241] GET NUMBER OF STRS
IMULI T1,.AULEN ;[241] MAKE PROPER LENGTH
MOVNS T1 ;[241] NEGATE FOR AOBJN'ERS
HRLM T1,AUXPTR ;[241] UPDATE FOR STRFND AND FRIENDS
POPJ P, ;RETURN
; FIND A STRUCTURE IN AUXTMP OR A FREE SLOT
STRFND: PUSHJ P,P$FLD## ;GET THE DEVICE NAME
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S2,ARG.DA(S1) ;COPY ASCII NONSENSE
MOVEM S2,STRNAM ;SAVE FOR POSTERITY
HRROI S1,ARG.DA(S1) ;POINT TO STRING
PUSHJ P,S%SIXB ;CONVERT TO SIXBIT
TRNN S2,7777 ;CHECK FOR A LONG NAME
SKIPN S1,S2 ;NEED STR NAME IN S1
PJRST PRSERR ;WEED OUT NOTHING
SKIPL T1,AUXPTR ;GET AOBJN POINTER
$RETF ;NO AUXACC DATA
STRFN1: SKIPN .AUSTR(T1) ;DO WE GO THIS FAR?
JRST STRFN2 ;HOLE IN BLOCK?
CAMN S1,.AUSTR(T1) ;IS THIS THE STRUCTURE WE WANT?
$RETT ;YES, RETURN
STRFN2: ADD T1,[.AULEN-1,,.AULEN-1] ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN T1,STRFN1 ;LOOP
$RETF ;STRUCTURE NOT FOUND
; FIND A STRUCTURE IN THE PROFILE
STRPFL: SKIPN T1,.AEAUX(U) ;GET AOBJN POINTER
$RETF ;NO DATA
ADDI T1,(U) ;INDEX INTO PROFILE
PJRST STRFN1 ;ENTER COMMON CODE
; GET A QUOTA OR "INFINITE"
STRQTA: PUSHJ P,P$NUM## ;GET A QUOTA
$RETIT ;RETURN IF A NUMBER WAS SPECIFIED
PUSHJ P,P$KEYW## ;GET KEYWORD OF INFINITE
JUMPF PRSERR ;CHECK FOR ERRORS
MOVX S1,.INFIN ;GET QUANTITY OF INFINITY
$RETT ;RETURN
; PROCESS SWITCHES
STRSWT: PUSH P,[EXP 0] ;INIT SWITCH STORAGE FLAGS
STRSW1: PUSHJ P,P$SWIT ;GET A SWITCH
JUMPF STRSW2 ;JUMP IF NONE
MOVE S2,(P) ;GET FLAGS SO FAR
SKIPE 0(S1) ;SKIP IF CLEARING
IOR S2,1(S1) ;COPY THE BIT
SKIPN 0(S1) ;SKIP IF SETTING
TDZ S2,1(S1) ;CLEAR
MOVEM S2,(P) ;UPDATE
JRST STRSW1 ;AND LOOP
STRSW2: POP P,S1 ;GET FLAGS
POPJ P, ;AND RETURN
SUBTTL ENTRIES -- WAT - WATCH-BITS
.ENTRY (WAT,.AEWCH,<Watch bits>)
WATPRS: $NOISE (CONFRM,<set by LOGIN>)
WAT000: $INIT (WAT010)
WAT010: $KEYDSP (WAT020,<$ALTER(WAT030)>)
WAT020: $STAB
DSPTAB (WAT010,[JW.WCX],<CONTEXTS>)
DSPTAB (WAT010,[JW.WDY],<DAY>)
DSPTAB (WAT010,[JW.WFI],<FILES>)
DSPTAB (WAT010,[JW.WMT],<MTA>)
DSPTAB (WAT010,[JW.WDR],<READ>)
DSPTAB (WAT010,[JW.WRN],<RUN>)
DSPTAB (WAT010,[JW.WVR],<VERSION>)
DSPTAB (WAT010,[JW.WWT],<WAIT>)
DSPTAB (WAT010,[JW.WDW],<WRITE>)
$ETAB
WAT030: $KEYDSP (WAT040,<$ALTER(CONFRM)>)
WAT040: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (WAT050,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
WAT050: $KEYDSP (WAT020)
; GET ROUTINE
WATGET: PUSHJ P,.SAVE1 ;SAVE P1
WATGE1: MOVEI S1,WAT000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ /WATCH-BITS>/]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
WATGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT WATGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIG S1,WATLEN ;ADDRESS OF BIT?
JRST WATGE3 ;NO--KEYWORD
MOVE S2,(S1) ;GET THE BIT
IORM S2,.AEWCH(U) ;SET IT ALWAYS
IORM S2,CHGMSK+.AEWCH ;AT LEAST IN CHANGE BLOCK
SKIPE P1 ;SKIP IF SETTING
ANDCAM S2,.AEWCH(U) ;ZERO THE BIT
SETZ P1, ;CLEAR "NO" FLAG
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
JRST WATGE2 ;AND LOOP
WATGE3: PUSHJ P,@WATTAB(S1) ;DISPATCH
JRST WATGE2 ;AND LOOP BACK
; COMPARE ROUTINE
WATCMP: MOVEI S1,.AEWCH ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
WATCHG: MOVEI S1,.AEWCH ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
WATDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.WCH ;DEFAULT BIT FOR FIELD
IORM S1,DF$WCH(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEWCH ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
WATRES: MOVE S1,.AEWCH(X) ;GET ORIGINAL WATCH BITS
MOVEM S1,.AEWCH(U) ;RESTORE
MOVX S1,DF.WCH ;WATCH WORD DEFAULT BIT
ANDCAM S1,DF$WCH(U) ;ASSUME SHOULD BE OFF
TDNE S1,DF$WCH(X) ;RIGHT?
IORM S1,DF$WCH(U) ;NO, LIGHT IT AGAIN
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEWCH ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
WATPRT: MOVE S1,[IOWD WATBPE-WATBPT,WATBPT] ;POINTER TO TABLE OF BITS
PUSHJ P,PRTBTS ;PRINT THE BITS OUT
$RETT ;AND RETURN
; HELP TEXT
WATHLP: ASCIZ \
WATCH-BITS specifies any of the following watch bits that LOGIN
automatically sets when the user logs in:
CONTEXTS
DAY
FILES
MTA
READ
RUN
VERSION
WAIT
WRITE
For more information, see the SET WATCH command in the TOPS-10 Operating
System Commands Manual.
\
; KEYWORD DISPATCH TABLE
WATTAB: IFIW WATALL ;"ALL"
IFIW WATDEF ;"DEFAULT"
IFIW WATDON ;"DONE"
IFIW WATHLX ;"HELP"
IFIW WATNO ;"NO"
IFIW WATNON ;"NONE"
IFIW WATRES ;"RESTORE"
IFIW WATPRT ;"SHOW"
WATLEN==.-WATTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
WATALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,JW.WAL ;WATCH:ALL BITS
IORM S1,.AEWCH(U) ;LIGHT IN PROFILE
IORM S1,CHGMSK+.AEWCH ;AND IN CHANGE MASK
WATGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "DEFAULT" KEYWORD PROCESSOR
WATDEF: PUSHJ P,WATDFL ;DO DEFAULTING
PJRST WATGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
WATDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE CO-RETURN
MOVEI S1,.AEWCH ;OFFSET TO CHECK
PJRST CMPVAL ;SET CHANGE FLAGS & RETURN
; "HELP" KEYWORD PROCESSOR
WATHLX: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@WAT+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; "NO" KEYWORD PROCESSOR
WATNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;$RETT
; "NONE" KEYWORD PROCESSOR
WATNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,JW.WAL ;WATCH:ALL BITS
ANDCAM S1,.AEWCH(U) ;CLEAR IN PROFILE
IORM S1,CHGMSK+.AEWCH ;NOTE AS CHANGED IN MASK
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;RETURN
; BIT STORAGE/DISPLAY TABLE
WATBPT: XWD [POINTR .AEWCH(U),JW.WCX],[ASCIZ\Contexts\]
XWD [POINTR .AEWCH(U),JW.WDY],[ASCIZ\Day\]
XWD [POINTR .AEWCH(U),JW.WFI],[ASCIZ\Files\]
XWD [POINTR .AEWCH(U),JW.WMT],[ASCIZ\MTA\]
XWD [POINTR .AEWCH(U),JW.WDR],[ASCIZ\Read\]
XWD [POINTR .AEWCH(U),JW.WRN],[ASCIZ\Run\]
XWD [POINTR .AEWCH(U),JW.WVR],[ASCIZ\Version\]
XWD [POINTR .AEWCH(U),JW.WWT],[ASCIZ\Wait\]
XWD [POINTR .AEWCH(U),JW.WDW],[ASCIZ\Write\]
WATBPE:!
SUBTTL Utility routines -- QINIT, setup the QUEUE. block
;QINIT - Setup a modify or delete block
;QINITA - Setup an add block
QINITA: TDZA S1,S1 ;ADD FUNCTION
QINIT: MOVEI S1,AF.AND ;MODIFY OR DELETE
PUSHJ P,.SAVE2 ;PRESERVE SOME ACS
MOVE P2,S1 ;SAVE CALL TYPE
MOVE P1,[-QUEBLN,,QUEBLK] ;SETUP STORAGE POINTER
MOVE S1,[QF.RSP+.QUMAE] ;WANT RESPONSE, TALK TO ACTDAE
MOVEM S1,(P1) ;SET IN BLOCK
AOBJP P1,.+1 ;ADVANCE POINTER
SETZM (P1) ;CENTRAL SITE (IGNORED ANYWAY)
AOBJP P1,.+1 ;ADVANCE POINTER
MOVE S1,[.AEMAX,,RSPBLK] ;RESPONSE BLOCK POINTER
MOVEM S1,(P1) ;STORE IN BLOCK
AOBJP P1,.+1 ;ADVANCE POINTER
SKIPE OLDMON ;CAN THIS MONITOR DO ANYTHING FANCY?
JRST QINIT2 ;NO, SKIP THIS NONSENSE
SKIPE S1,DEBUGW ;ARE WE RUNNING IT PRIVATE?
MOVSI S1,ACTPID ;YES, TALK TO PRIVATE ACTDAE
SKIPN DEBUGQ ;DO WE WANT TO TIME THE CONVERSATION?
HRRI S1,ZZTIME ;YES, GET LIMIT
JUMPE S1,QINIT2 ;SKIP NONSENSE IF NEED NO EXTRA HEADER WORDS
HRRZM S1,(P1) ;STORE TIME LIMIT
AOBJP P1,.+1 ;ADVANCE POINTER
HLRZS S1 ;ISOLATE PID ADDRESS
SKIPE S1 ;IF WANT A PID,
SKIPN S1,(S1) ;AND HAVE ONE,
JRST QINIT1 ;NO, GO WITH WHAT WE HAVE
MOVEM S1,(P1) ;YES, SET FOR UUO
AOBJP P1,.+1 ;ADVANCE THE COUNTER
QINIT1: MOVEI S1,-QUEBLK(P1) ;GET LENGTH OF HEADER IN USE
STORE S1,QUEBLK,QF.HLN ;TELL UUO ABOUT EXTRA WORDS
QINIT2: DMOVE S1,[EXP QA.IMM!.QBAFN,UGCUP$] ;TELL ACTDAE OF FUNCTION TYPE
SKIPN UNPRIV ;HAVE PRIVS?
TXO S2,AF.PRV ;YES, INVOKE THEM
DMOVEM S1,(P1) ;STUFF INTO BLOCK
ADD P1,[2,,2] ;UPDATE POINTER
MOVE S1,[QA.IMM+.AEVRS(2)] ;MASKED VALUE COMING
MOVEM S1,(P1) ;SET SUB-BLOCK TYPE
DMOVE S1,[EXP <FLD(ACTFMT,AE.VRS)>,AE.VRS]
DMOVEM S1,1(P1) ;GIVE DATA TO THE BLOCK
ADD P1,[3,,3] ;UPDATE POINTER
MOVEM P1,QUEPTR ;SAVE FOR QUEINS
MOVEI P1,.AEPPN(P2) ;GET DESIRED FUNCTION
HRROI P2,.AEPPN(U) ;AND POINT TO PPN
PJRST QUEINS ;STORE IN BLOCK AND RETURN
SUBTTL Utility routines -- DELUSR, delete current profile
;DELUSR - Delete the current profile
;Call:
; U/ Address of profile to delete
DELUSR: PUSHJ P,.SAVE2 ;PRESERVE ACS USED BY QUEINS
PUSHJ P,QINIT ;SETUP MINIMAL QUEUE. BLOCK
MOVEI P1,.AEPPN ;PROFILE OFFSET TO CHANGE
SETZ P2, ;CLEARING IT
PUSHJ P,QUEINS ;STUFF INTO THE UUO LIST
$RETIF ;SHOULD NEVER FAIL
$FALL QUEUUO ;RETURN AFTER DOING THE UUO
SUBTTL Utility routines -- QUEUUO, ask ACTDAE to do its thing
;QUEUUO -- Queue up the current request to ACTDAE.
;Expects QINIT(A) to have been called, and QUEPTR to be up to date
QUEUUO: HRLZ S1,QUEPTR ;GET FIRST FREE WORD IN LH
ADD S1,[-QUEBLK,,QUEBLK] ;MAKE UUO ARG POINTER
QUEUE. S1, ;ASK ACTDAE TO DO IT FOR US
$RETF ;FAILED
$RETT ;RETURN HAPPY
SUBTTL Utility routines -- QUECHG, load up QUEUE. block
;QUECHG - Add a change request to the QUEUE. block
;Call
; S1/ Profile offset under consideration
; U/ Address of profile being modified
;Return
; $RETF No more room (should never happen) or invalid request
; $RETT Change request inserted
QUECHG::PUSHJ P,.SAVE2 ;PRESERVE SOME WORKING ACS
CAIL S1,.AEMIN ;VALID OFFSET?
$RETF ;NO
MOVE S2,CHGTAB##(S1) ;YES, GET ITS CONTROL BITS
DMOVE P1,S1 ;PRESERVE THINGS
PUSHJ P,COMPAR ;IS THERE REALLY A CHANGE?
$RETIT ;DON'T BOTHER ME IF NONE
TXNE P2,PD.NMD ;CAN IT BE MODIFIED?
$RETIF ;NO, GIVE UP
ADJBP S1,[POINT 1,.AEMAP(U),0] ;GET B.P. TO DEFAULT BIT
LDB S1,S1 ;FETCH THE BIT
JUMPE S1,QUECH1 ;GO ON IF NOT DEFAULTED
TXNE P2,PD.CND ;CAN IT BE DEFAULTED?
$RETF ;NO, GIVE UP
TRO P1,AF.DEF ;YES, LIGHT BIT TO REQUEST THAT
SETZ P2, ;DATA IS JUNK
PJRST QUEINS ;GO INSERT INTO THE QUEUE. BLOCK
QUECH1: SKIPN INSFLG ;ALWAYS FULL WORD MASK IN INSERT MODE
TXNN P2,PD.MSK ;IS THIS MASKABLE?
JRST QUECH2 ;NO, GO ON
MOVEI S1,(P1) ;YES, COPY OFFSET
ADDI S1,(U) ;POINT TO WORD IN PROFILE
MOVE S1,(S1) ;FETCH IT
MOVE S2,CHGMSK(P1) ;AND ITS CHANGE MASK
JUMPE S2,.RETT ;DON'T QUEUE IT IF NOTHING WAS CHANGED
DMOVEM S1,QUETMP ;SAVE FOR A BIT
MOVE P2,[-2,,QUETMP] ;DO AS LONG IMMEDIATE ARGUMENT
PJRST QUEINS ;GO STUFF INTO THE BLOCK
QUECH2: TXNN P2,PD.EXT ;IS IT EXTENSIBLE?
JRST QUECH3 ;NO, JUST A SIMPLE BLOCK
MOVE S1,P1 ;COPY PROFILE OFFSET
ADDI S1,(U) ;ADDRESS OF POINTER WORD
SKIPE S1,(S1) ;GET RELATIVE POINTER
ADDI S1,(U) ;DE-RELATIVIZE IT
LOAD S2,P2,PD.WRD ;GET MAX. LENGTH
MOVE P2,S1 ;COPY POINTER (FOR ADDRESS)
HLRES S1 ;ISOLATE -VE LENGTH
MOVNS S1 ;MAKE POSITIVE
CAILE S1,(S2) ;DOES IT FIT?
MOVE S1,S2 ;NO, RESTRICT IT
CAIN S1,1 ;IF SMALL,
MOVNS S1 ;MAKE IT IMMEDIATE
HRL P2,S1 ;MAKE BLOCK POINTER
PJRST QUEINS ;GO STUFF INTO THE UUO LIST
QUECH3: LOAD S2,P2,PD.WRD ;GET BLOCK LENGTH
CAIN S2,1 ;IS IT SHORT?
MOVNS S2 ;YES, DO IT IN IMMEDIATE MODE
MOVEI P2,(P1) ;COPY PROFILE OFFSET
ADDI P2,(U) ;MAKE ADDRESS OF FIELD
HRL P2,S2 ;GET THE LENGTH
$FALL QUEINS ;STUFF INTO THE UUO LIST
SUBTTL Utility routines -- QUEINS to insert info into a QUEUE. block
;QUEINS - Stuff information into a QUEUE. UUO arg block
;Call:
; P1/ Block type code
; P2/ length,,addr of indirect data or -length,,addr for immediate data
;Return:
; $RETF no more room
; $RETT sub-block inserted
;Implicit inputs:
; QUEPTR is AOBJN storage pointer for the sub-blocks
; SELFLG to indicate to use QUESEL/SELPTR mechanism instead
;Side effects:
; QUEPTR is updated to reflect the insertion
QUEINS: SKIPE SELFLG ;DOING THIS FOR SELECT?
JRST QUESEL ;YES, INSERT INTO A DIFFERENT BLOCK
MOVE T4,QUEPTR ;GET AOBJN STORAGE POINTER
JUMPLE P2,QUEIN1 ;ELSEWHERE FOR IMMEDIATE ARGS
HLL P1,P2 ;GET LENGTH IN RIGHT AC
MOVEM P1,(T4) ;STUFF INTO LIST
AOBJP T4,.RETF ;OUT OF ROOM
HRRZM P2,(T4) ;STUFF AWAY THE ADDRESS
AOBJP T4,.RETF ;EXHAUSTED THE BLOCK
MOVEM T4,QUEPTR ;STORE UPDATED POINTER
$RETT ;DONE
QUEIN1: HLRE S1,P2 ;COPY -VE LENGTH
MOVNS S1 ;MAKE POSITIVE
HRL P1,S1 ;PUT INTO FUNCTION WORD
TXO P1,QA.IMM ;TURN ON IMMEDIATE MODE
MOVEM P1,(T4) ;STUFF FUNCTION INTO UUO LIST
AOBJP T4,.RETF ;GIVE UP IF OUT OF ROOM
QUEIN2: SKIPE S2,P2 ;ZERO IS ZERO
MOVE S2,(P2) ;ELSE FETCH VALUE
MOVEM S2,(T4) ;PLUG INTO BLOCK
AOBJP T4,.RETF ;GIVE UP IF NO MORE ROOM
AOBJN P2,QUEIN2 ;LOOP OVER THE ARGS TO INSERT
MOVEM T4,QUEPTR ;UPDATE POINTER
$RETT ;WE WIN
SUBTTL Utility routines -- QUESEL, insert into select block
;QUESEL - Append to selection criteria
;Call:
; P1/ Profile offset
; P2/ (+/-)length,,address
;Return:
; $RETT always
;Implicit inputs:
; SELPTR is AOBJN storage pointer
; WILDBK is setup to allow selecting
;Side effects:
; SELPTR & WILDBK are updated to reflect the addition of the select block
QUESEL: HLRE TF,P2 ;GET LENGTH
MOVMS TF ;MAKE POSITIVE
SKIPN TF ;DEFAULTING THE LENGTH,
AOS TF ;DO SO
TRNE P1,AF.DEF ;BUT IF DEFAULTING,
SETZ TF, ;THEN WE DON'T NEED THE DATA
MOVS T3,TF ;COPY LENGTH TO BETTER PLACE FOR LATER
AOS TF ;ACCOUNT FOR THE OVERHEAD WORD
HRLS TF ;PUT IN LH TOO
ADD TF,SELPTR ;ADD TO EXISTING POINTER
SKIPL TF ;SKIP IF ROOM IN BLOCK
WARN (NMS,<No more storage available for selection criteria>,,.RETT)
QUESE1: MOVE T4,SELPTR ;GET POINTER TO FIRST FREE
HRLI P1,1 ;GET LENGTH OF OVERHEAD
ADD P1,T3 ;MAKE BLOCK DESCRIPTOR
IOR P1,SELFNC ;INCLUDE THE SELECT FUNCTION
MOVNS T3 ;GET -LEN,,0
HLL P2,T3 ;UPDATE LENGTH FOR STUFFING DATA
MOVEM P1,(T4) ;STORE FUNCTION TYPE
AOBJP T4,.+1 ;UPDATE POINTER
JUMPGE T3,QUESE3 ;DON'T STUFF MORE IF NO DATA
QUESE2: MOVE T1,(P2) ;GET A DATA WORD
MOVEM T1,(T4) ;INSERT IT
AOBJP T4,.+1 ;ADVANCE POINTER
AOBJN P2,QUESE2 ;LOOP OVER DATA
QUESE3: MOVEM T4,SELPTR ;UPDATE
AOS WILDBK+UW$SEL ;COUNT THE SECTION SUB-BLOCK
$RETT ;RETURN
SUBTTL Utility routines -- Compare and Change
;ROUTINE TO COMPARE BASED SOLELY ON PROFILE OFFSET
;CALL: MOVEI S1, PROFILE OFFSET
; MOVEI U, WORKING PROFILE
; MOVEI X, ORIGINAL PROFILE
;RETURN:
; $RETT THE SAME
; $RETF CHANGED
;IMPLICIT INPUTS:
; CHGMSK SETUP BY PRS/GET ROUTINES
;SIDE-EFFECTS:
; CLOBBERS S2
COMPAR::CAIL S1,.AEMIN ;IS IT VALID?
$RETT ;NO, THEN WE DIDN'T CHANGE IT
SKIPN SELFLG ;DO WE CONSIDER ALL CHANGES SIGNIFICANT?
SKIPE INSFLG ;WELL, DO WE?
$RETF ;YES, IT'S NOT THE SAME
MOVE S2,CHGTAB##(S1) ;NO, GET THE BITS
TXNE S2,PD.WRD ;IS IT IN THE MIDDLE OF A BLOCK?
TXNE S2,PD.NMD ;COULD WE HAVE CHANGED IT?
$RETT ;YES OR NO, WE DIDN'T TOUCH IT
PUSHJ P,.SAVET ;WE NEED MORE ACS TO LOOK HARDER
TXNE S2,PD.CND ;IS IT DEFAULTABLE?
JRST COMPA1 ;NO
MOVEI T3,(S1) ;YES, COPY THE OFFSET
ADJBP T3,[POINT 1,.AEMAP(U),0] ;POINT TO THE APPROPRIATE BIT
LDB T4,T3 ;GET CURRENT STATE OF DEFAULT BIT
TLC T3,U^!X ;POINT TO ORIGINAL PROFILE
LDB T3,T3 ;AND GET ORIGINAL DEFAULT BIT
CAIE T3,(T4) ;ARE THEY DIFFERENT?
$RETF ;YES, WE CHANGED SOMETHING
JUMPN T3,.RETT ;'DEFAULTED' MEANS IT'S THE SAME (DESPITE VALUE)
COMPA1: MOVEI T1,(U) ;COPY WORKING PROFILE ADDRESS
MOVEI T2,(X) ;AND ORIGINAL'S ADDRESS
ADDI T1,(S1) ;OFFSET TO ENTRY
ADDI T2,(S1) ;BOTH CASES
TXNN S2,PD.MSK ;IS IT A BIT-MASK?
JRST COMPA2 ;NO, DON'T TREAT IT AS ONE
MOVE T3,(T1) ;YES, GET NEW VALUE
XOR T3,(T2) ;SEE WHAT'S CHANGED SINCE ORIGINAL
AND T3,CHGMSK(S1) ;ONLY CARE ABOUT WHAT WE THINK WE CHANGED
JUMPN T3,.RETF ;DIFFERENT
$RETT ;THE SAME
COMPA2: LOAD T3,S2,PD.WRD ;SOME TYPE OF BLOCK--GET (MAX.) SIZE
MOVNS T3 ;WANT NEGATED FOR AOBJN POINTERS
TXNN S2,PD.EXT ;IS THIS AN EXTENSIBLE BLOCK?
JRST COMPA3 ;NO, JUST AN ORDINARY BLOCK
SKIPE T1,(T1) ;YES, GET BLOCK POINTER
ADDI T1,(U) ;DE-RELATIVIZED
SKIPE T2,(T2) ;FROM EACH PROFILE
ADDI T2,(X) ;DE-RELATIVIZED
HLRE T4,T1 ;GET WORKING BLOCK'S LENGTH
CAMGE T4,T3 ;WITHIN LIMITS?
HRLI T1,(T3) ;NO, ENFORCE THE LIMIT
HLRE T4,T2 ;GET ORIGINAL'S LENGTH
CAMGE T4,T3 ;DID IT FIT?
HRLI T2,(T3) ;NO, RESTRICT IT
JRST COMPA4 ;GO COMPARE BLOCKS
COMPA3: HRLI T1,(T3) ;MAKE AOBJN POINTER
HRLI T2,(T3) ;FOR BOTH PROFILES
COMPA4: SKIPGE T1 ;STILL SOME TO FETCH?
SKIPA T3,(T1) ;YES, DO SO
SETZ T3, ;NO, PAD WITH ZEROS
SKIPGE T2 ;SIMILAR TREATMENT
SKIPA T4,(T2) ;WITH ORIGINAL PROFILE
SETZ T4, ;PADDING SHORTER
CAME T3,T4 ;STILL THE SAME?
$RETF ;NO, WE CHANGED SOMETHING
AOBJP T1,.+1 ;ADVANCE WORKING POINTER
AOBJN T2,COMPA4 ;LOOP WITH ORIGINAL'S POINTER
JUMPL T1,COMPA4 ;GO UNTIL BOTH POINTERS RUN OUT
$RETT ;THEY'RE STILL THE SAME
;SETUP CHANGE MASKS
CMPVLC::SETOM @CHGADR ;ASSUME A CHANGE
SETOM CHGMSK(S1) ;PARSE ROUTINE DOES WHOLE WORD
CMPVAL::MOVE S2,CHGTAB##(S1) ;GET CONTROL BITS
TXNE S2,PD.MSK ;IF MASKABLE,
JRST CMPVA1 ;DON'T DO THIS
MOVE S2,@CHGADR ;IF WE THINK WE MIGHT HAVE CHANGED IT,
MOVEM S2,CHGMSK(S1) ;ASSUME A FULL WORD CHANGED
CMPVA1: SKIPN @CHGADR ;DO WE THINK WE CHANGED IT?
JRST CMPVA2 ;NO, DON'T TWEAK DEFAULT BIT
PUSH P,S1 ;SAVE PROFILE OFFSET
ADJBP S1,[POINT 1,.AEMAP(U),0] ;POINT TO ITS DEFAULT BIT
MOVE S2,PRSDFV ;GET 'SET DEFAULT' FLAG
DPB S2,S1 ;SET CORRESPONDINGLY IN MAP
POP P,S1 ;RESTORE OFFSET
CMPVA2: PUSHJ P,COMPAR ;CHECK FOR CHANGES
JUMPF .RETT ;GUESSED RIGHT, WE'RE DONE
SETZM CHGMSK(S1) ;WORD DIDN'T CHANGE
SETZM @CHGADR ;NOR DID ENTRY
POPJ P, ;RETURN HAPPY
SUBTTL Utility routines -- QPPNIN and QUSRIN
;QPPNIN, QPPNNX, QUSRIN and QUSRNX
;Call
; S1/ PPN to read or pointer to name
; S2/ Where to put it
QPPNIN: SKIPA T1,[QA.IMM!1B17!.UGPPN]
QUSRIN: MOVE T1,[.AANLW,,.UGUSR]
$FALL QPROF ;NON WILD NAME OR PPN
;COMMON CODE
QPROF:
;.UGPPN OR .UGUSR
MOVE T2,S1 ;SAVE VALUE
;.QURSP
HRLI S2,.AEMAX ;SIZE OF RESPONSE BLOCK
MOVEM S2,QUEBLK+.QURSP ;SAVE AS RESPONSE BLOCK
;.QUFNC and .QUNOD
MOVE S1,[QF.RSP!.QUMAE] ;FUNCTION CODE
SETZ S2, ;NODE
DMOVEM S1,QUEBLK+.QUFNC ;SAVE AS FUNCTION
;.QUTIM and .QUPID
MOVEI S1,3 ;ASSUME A STANDARD HEADER OFFSET
SKIPE OLDMON ;NON-FANCY UUO?
JRST QPROF1 ;YES, SKIP THIS
SKIPE DEBUGQ ;WANT TIMING?
TDZA S2,S2 ;NO
MOVEI S2,ZZTIME ;YES
MOVEM S2,QUEBLK+3 ;SAVE TIME LIMIT
SKIPE S2,DEBUGW ;IF RUNNING IN PRIVATE MODE,
MOVE S2,ACTPID ;USE THE ALTERNATE PID
MOVEM S2,QUEBLK+4 ;SAVE FOR UUO
SKIPE S2 ;IF WE ADDED THE PID,
AOSA S1 ;ADD TWO HEADER WORDS
SKIPE QUEBLK+3 ;ELSE, IF WE ADDED THE TIMER,
AOS S1 ;ADD ONE HEADER WORD
STORE S1,QUEBLK,QF.HLN ;SAVE HEADER LENGTH FOR THE UUO
QPROF1:
;SELECT FUNCTION
DMOVEM T1,QUEBLK+2(S1) ;STUFF ACTDAE ARGS IN SECOND BLOCK AFTER HEADER
;.QBAFN
DMOVE T1,[QA.IMM!1B17!.QBAFN ;SUBFUNCTION
EXP UGOUP$] ; OF OBTAIN PROFILE
SKIPN UNPRIV ;HAVE PRIVS?
TXO T2,AF.PRV ;YES, USE THEM
DMOVEM T1,QUEBLK(S1) ;STASH
MOVSI S1,4(S1) ;GET BLOCK LENGTH
HRRI S1,QUEBLK ;UUO ARG POINTER
QUEUE. S1, ;DO THE QUEUE.
$RETF ;FAILED
$RETT ;SUCCESS
SUBTTL Utility routines -- OUTLST - Send a character to the list file
;OUTLST - Character from $TEXT to output file
;Call
;
;Return
; Always
OUTLST: SKIPE S2,LSTIFN ;ARE WE GOING TO A FILE?
JRST OUTLS1 ;YES
PUSHJ P,T%TTY ;NO, JUST OUTPUT THE CHARACTER
$RETT ;RETURN
OUTLS1: EXCH S2,S1 ;COPY BYTE
PUSHJ P,F%OBYT ;OUTPUT TO THE LST FILE
$RETT ;AND RETURN
END REACT