Trailing-Edge
-
PDP-10 Archives
-
BB-BT99V-BB_1990
-
10,7/acct/actdae.mac
There are 9 other files named actdae.mac in the archive. Click here to see a list.
TITLE ACTDAE - Accounting Daemon for TOPS10
SUBTTL B.A.HUIZENGA/BAH/Tarl/LWS/DPM/RCB 14-Nov-89
SEARCH ACTPRM,QSRMAC,ORNMAC
MODULE (ACTDAE)
.REQUIR ACTRCD ;USAGE RECORDS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1988,1990.
; ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
AC.VER==2 ;VERSION NUMBER
AC.EDT==162 ;EDIT NUMBER
AC.WHO==0 ;WHO EDITED LAST
AC.MIN==3 ;MINOR VERSION NUMBER
%%.ACV==:<VRSN. (AC.)>
;AC DEFINITIONS OTHER THAN GLXLIB
DEFADR==15 ;CURRENT ADDRESS OF DEFUS DATA ITEM BEING WORKED UPON.
; NEEDS TO BE PRESERVED OVER DATFIL ROUTINES.
LENGTH==16 ;LENGTH OF CURRENT DATA ITEM BEING WORKED UPON.
; NEEDS TO BE PRESERVED OVER CONVERT ROUTINES.
;CUSTOMER CHANGABLE PARMETERS
IFNDEF FILPRO,<FILPRO==177> ;USAGE/FAILURE FILE PROTECTION
IFNDEF FILBSZ,<FILBSZ==^D7> ;USAGE/FAILURE FILE BYTE SIZE FOR NEW FILES
IFNDEF WTOINT,<WTOINT==^D5> ;INTERVAL TIME (MINUTES) BETWEEN RETRY WTO'S
IFNDEF RMGINT,<RMGINT==^D120> ;INTERVAL TIME (SECONDS) BETWEEN RMS MESSAGES
IFNDEF SLPSEC,<SLPSEC==^D15> ;SECONDS TO SLEEP BETWEEN RETRIES
;SHOULD EVENLY DIVIDE ^D60 OR WTOINT WON'T
;BE CALCULATED CORRECTLY. MAXIMUM IS ^D60.
IF1,<IFG <SLPSEC-^D60>,<PRINTX ?SLPSEC GREATER THAN ^D60.>>
IFNDEF CHKINT,<CHKINT==^D10> ;INTERVAL FOR CHECKPOINTING USAGE FILES
;DONE ON THE FULL MINUTE SO MUST BE
;EVENLY DIVISIBLE INTO 60. I.E. WITH 15
;MINUTE INTERVAL, CHECKPOINTING WILL BE
;DONE AT xx:00, xx:15, xx:30, AND xx:45
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1990. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
LOC 137
EXP %%.ACV
RELOC
SUBTTL EDIT HISTORY
;1) Implement Account validation
;2) Convert to use GLXLIB
;3) Use extended channels and the new FILOP. for I/O
;4) Implement Checkpointing for active jobs
;5) Take action when LOGIN sends LOGIN, SESSION, and ATTACH messages
;6) When disk space is too low for allocating checkpoint files, limit
; the number of jobs to be logged in
;7) Implement Usage file handling code
;10) Validation routine doesn't do enough checking for whom to validate
;11) Verify routine didn't handle PPNs less than the first
; PPN in PROJCT.SYS. Also, verify couldn't handle more than one
; block of validation data in PROJCT.SYS
;12) Make ACTDAE know about ACCT.SYS. Build a table of first PPNs
; in every block and search ACCT.SYS for any PPN validation error
;13) Teach ACTDAE about the 7.01 MOnitor LOGOUT message from [SYSTEM]GOPHER
;14) Since the 70017 monitor starts up the ACTDAE via FRCLIN, the job
; must run detached. Also teach ACTDAE about wild card ppns in ACCT.SYS.
;15) Write MAKENT routine that generally writes an entry
; given an entry number and address of DEFUS data.
;16) Imement the QUEUE. UUO validation function.
;17) Implement the QUEUE. UUO make an entry function.
;20) Use PSI for IPCF traffic and begin timer code
;21) Complete Job checkpoint code and timers for running same.
;22) Make Session entries for jobs after a reload or ACTDAE restart
;23) Implement code for closing sessions and the usage file
;24) Implement device checkpoint files and entries.
;25) Implement Disk Usage accounting from BACKUP
;26) ORIONs messages for SET USAGE FILE/BILLING commands changed
;27) Would you believe ORIONs message changed again
;30) Wild-card in Account string support missing, add it (req PROJCT V1(2)).
; Also, could only find first account for wild-card'ed ppns, fix that.
;31) Space wasted by PHASE/DEPHASE assembly, also bum SKIPT/$RETF pairs.
;32) $FATAL doesn't type on OPR if detached, define $BOMB that always uses OPR
;33) LOGIN sends -1 if no Account or Remark specified at LOGIN time
;34) Physical device name not provided in magtape and DECtape entries
;35) Bad BLT for text fields for STRUCTURE/MAGTAPE/DECTAPE mount IPCF messages.
;36) GLXLIB will DETACH if on FRCLIN, remove code from ACTDAE
;37) Add code and range checks for user defined entries (5000-9999)
;40) Make system restart a little faster
;41) Fix problems with finding entries in PROJCT.SYS
;42) Bad "Make An Entry" messages caused lost free space
;43) Do case conversion when verifying account if FTCASECONVERT is on.
; Return account string (may be modified if FTCASECONVERT is on) in IPCF
; message or in response block of QUEUE. on successful validation.
;44) Implement /NO-SESSION-ENTRIES on the SET USAGE FILE-CLOSURE command to
; over-ride the implicit SET USAGE BILLING-CLOSURE that occurs when the
; file is closed.
;45) Edit 37 broke Disk Utilization records, fix that.
;46) Use assembly parameter PRJWPB for PROJCT.SYS instead of 200s
;47) Implement Default account strings from PROJCT.SYS. The default is
; used if asked to verify a null account string and a default exists.
; The default is returned in the IPCF message or QUEUE. response block.
;50) Allow PPN entries to cross block boundries in PROJCT.SYS. This change
; becomes format version 2. Implement code such that version 1 PROJCT.SYS
; still works. With this change, making PRJWPB larger simply becomes a
; performance gain.
;51) Jobs doing QUEUE. UUO to make an entry hang in EW if not privileged or
; specify an unknown entry type. Un-stick them.
;52) Implement QUEUE. UUO subfunctions UGACC$ and UGOUP$
; for access control requests.
;53) Complete implementation of Date/Time change
;54) Assume account string is NOT required if a ppn isn't in ACCT.SYS
;55) Random fixes from random QARs
;56) Remove our definition of the job field in the LOGOUT message and
; use QUASAR's definition from QSRMAC.
;57) Correct sense of check in ACTLIN so we dont send a bogus error
; message to the OPR if the PID we send to is gone.
;60) Check for PROJCT.SYS being created from a zero-length PROJCT.ACT
; and assume [*,*]=*
;61) Always call ALLDEV on LOGOUT to insure nnnDEV.BIN gets deleted.
;Start version 2 here, to be shipped with TOPS10 7.03.
;
;This version implements SYS:ACCT.SYS version 5, now ACT:ACCT.ACT (See
; ACTCIO.MAC). Only ACTDAE should be reading/writing ACCT.ACT.
; ACTDAE depends on the fact that only it can change the file.
;
;100) Up the version number to 2. Start massive changes. /Tarl
;
;101) Add "context limit" and "idle contexts page limit" UGCHG$
; subfunctions. /LWS
;
;102) Add new "profile flag" word and last access UDT word. Fix various
; bugs in ACCTIO from page boundary problems to miscalculating
; number of customer defined words and program to run words. /LWS
;
;103) Add rudimentary "validation failure log" file support. Fix bugs
; in ACCTIO dealing with page boundaries. /LWS
;
;104) Add LOCK and UNLOCK user account file functions. /LWS
;
;105) Rewrite FNDIDX in ACCTIO and add IDXINI. /LWS
;
;106) Add support for synonym-to-account string translation. This is
; useful for sites which frequently change account strings and do
; not want to inconvience their users by making them change their
; SWITCH.INIs, control files, or MIC file. A file called SYN.ACT
; resides on ACT: and contains one or more lines equating synonym
; strings with account strings. The format is synonym=account.
; Every time we validate an account string, we first check to see
; if the string in question is a synonym. If it is, then the
; string is changed to the appropriate account string.
;
; For example, the account string for user [10,56] changes on a
; monthly basis, but the user has "TOPS10-DEVELOPMENT" as his
; synonym. The system administrator may change the entry in SYN.ACT
; for TOPS10-DEVELOPMENT at any time, and the user remains unaffected.
; After the synonynm translation occurs, the final account string is
; still checked for legality.
;
; Note: This feature is controlled by the setting of SYNONYM, and
; is normally turned off.
;
;107) Allow LOGIN, SESSION, and ATTACH messages via QUEUE. UUO /DPM
;
;110) Fix bug where error messages were being sent back with various
; incorrect lengths. Preserve "T" ACs in LOGUSR. /LWS
;
;111) Username storage was only 1 word. Copying a maxium of 39 8-bit
; characters there would clobber what ever followed.
; QAR #868037 /LWS
;
;112) Rip out the ACCTIO interface and replace with ACTRMS. /TL
;
;113) Add UGVUP$ function, "validate account string and return user
; profile. /LWS
;
;114) Move calls to SCDINI and SCDCLS from ACTRMS to ACTDAE. Add code
; to support new function UGSCD$. User account file is now
; SYS:ACTDAE.SYS and PROJCT.SYS now should reside on SYS:. /LWS
;
;115) Fix bug where CHKACT was calling GETPRO without PPN in T1. /LWS
;
;116) Turn on code that supports a password along with profile to
; insert. REACT now knows how to do it. /LWS
;
;117) Remove VERSET to set version. ACTRMS must be loaded before ACTDAE. /LWS
;
;120) Add code to prevent password changes if AE.PCP is set in the
; profile flag word (.AEFLG).
; 23-Jul-85 /DPM
;
;121) Implement administrative priveleges.
; 24-Jul-85 /DPM
;
;122) Let owner obtain his/her own profile and not require a password
; to change unpriv'ed fields in the profile. If the PPN or project
; number (depending of the setting of INDPPN) of the sender matches
; that of the profile, then access is granted.
; 15-Aug-85 /DPM
;
;123) Move all PPN and user name wildcarding out of REACT and into ACTDAE
; (actually ACTRMS). Support new wildcard message UGWLD$ either from
; a QUEUE. UUO or direct IPCF. See ACTSYM for a definition of the
; message offsets (UW$xxx).
; 26-Aug-85 /DPM
;
;124) Move CHGTAB and friends into ACTCHG module of ACTLIB. Make the
; writing of 8-bit usage/failure files an option. Set FILBSZ to
; the desired byte size (default is 7-bit).
; 29-Aug-85 /DPM
;
;125) Convert all old-style calls for a [next] profile to internal
; wildcard calls. Start converting error ACKing to use ACTLIB's
; error facilities. Other miscellaneous changes made to conform
; to changes in the RMS-10 interface module of ACTLIB.
; 6-Sep-85 /DPM
;
;126) Convert more error ACKs. Almost done!
; 13-Sep-85 /DPM
;
;127) Add support for new accounting function UGMAP$ to map PPNs to user
; names.
; 16-Sep-85 /DPM
;
;130) Change format of FAILUR.LOG to record ANF/DECNET/LAT node/line
; number on a LOGIN failure.
; 15-Oct-85 /CJA
;
;131) Fix ACTMAP to always update name. Since user may have supplied
; a unique abbreviation, he might be interested in the complete
; name too.
;
;132) PUSH and POP of .AEPPN isn't enough in ACTMAP. Copy PPN and
; name to temporary storage.
;
;133) Update UGCUP$ for profile format version 6. This also changes
; the format of select blocks. Also start to enable setting
; ACOPRV via the function code, and turning on the new acking
; code via the function code bits. The UG.xxx symbols of the
; old UGCUP$ are going away sometime. If possible, we'll make
; .UGPRV go away too.
; 18-Nov-85 /RCB
;
;134) Fix some bugs with the defaulting code.
; 24-Nov-85 /RCB
;
;135) Fix undeserved invalid account string problems.
; 4-Dec-85 /DPM
;
;136) Fix some minor bugs in UGCUP$ and UGMAP$.
; 17-Dec-85 /RCB
;
;137) Fix up some bugs in UGCUP$.
; 13-Jan-86 /RCB
;
;140) Fix up password change time when changing a password even if the
; .AEPCT value was orginally defaulted.
; 7-Mar-86 /RCB
;
;141) If an attempt is made to insert a profile with a duplicate
; name, return a meaningful error message instead of the usual
; "unexpected RMS error xxxxxx" cruft.
; 15-Apr-86 /DPM
;
;142) Allow * to match null account strings like the documentation
; and the usage spec claims will work. Also match double quotes
; in invalid account error message.
; 17-Apr-86 /DPM
;
;143) Implement PSI on date/time change so that entrys have correct times
; and connect time if the system has USAGE FILE CLOSURES set for DAILY.
; 2-Jun-86 /BAH
;
;144) Make debugging easier by not using a job-wide pid.
; 3-Jul-86 /RCB
;
;145) Invent a bunch of error codes, and use them in the coded error acks and
; in the failure file.
; 28-Oct-86 /RCB
;
;146) Convert to use the new STOPCD macro in GLXMAC, rather than $STOP.
; 1-Dec-86 /RCB
;
;147) Fix privilege checking for AF.PRV.
; 3-Dec-86 /RCB
;
;150) Range-check program-supplied job numbers on various usage entries.
; SPR 10-35687
; 11-Feb-87 /RCB
;
;151) Fix the (unsupported) NCRYPT algorithm in ALGCUS so that it
; decrypts correctly (thus matching the original LOGIN routine).
; SPR 10-35694
; 19-Feb-87 /JJF
;
;152) Fix selection testing of .AEAUX entries to allow for wildcarded
; structures as well as wild quotas and bits.
; 15-May-87 /RCB
;
;153) Set UC$PRF accordingly if UGVUP$ function.
; SPR 10-36011
; 7-Sep-87 /LWS
;
;154) Try not to hang jobs in EW for EV.IPC. Always ACK all [SYSTEM]GOPHER
; messages, whether we like them or not.
; 29-Sep-87 /RCB
;
;155) Fix bug in checking for password change allowed. No change required
; is not the same as an expired password.
; 16-Jun-88 /RCB
;
;156) Correct problems with unique (10,#) PPNs.
; SPR 10-35597
; 5-Jan-89 /DPM
;
;157) MAPLGL doesn't fixup PPN/NAME block pointers correctly when
; processing an IPCF (not QUEUE. UUO) message to map PPNs to
; names.
; 10-Jan-89 /DPM
;
;160) Check for fatal RMS errors (ER$BUG and ER$UDF). When these
; errors are encountered, send messages to the operator and to
; the user.
; 30-Aug-89 /KDO
;
;161) Fix account ownership checking for [1,2]. It shouldn't be able
; to do so much without admin privs.
; 14-Nov-89 /RCB
;
;162) Don't start virtual timer traps until after we're done in ACTINI.
; We thrash too badly while reading the old USEJOB.BIN etc. Defer
; going virtual until we start accepting IPCF messages.
; 14-Nov-89 /RCB
;
; End of Revision History
;LOOSE ENDS
REPEAT 0,<
NONE
>
SUBTTL DEFINITIONS AND DATA STORAGE
;GENERAL DEFINITIONS
ACTLNG==100 ;LENGTH OF PUSH DOWN LIST
ND SYNONYM,0 ;DEFAULT SYNONYM TO ACCOUNT STRING TRANSLATION
; 0 = OFF, 1 = ON
SYNFLG: EXP SYNONYM ;SYNONYM FLAG
SYNIFN: BLOCK 1 ;IFN FOR SYNONYM FILE
SYNLIN: BLOCK 1 ;SYNONYM FILE LINE NUMBER
SYNTAB: BLOCK 1 ;POINTER TO SYNONYM TABLE
SYNTMP: BLOCK 10 ;TEMPORARY SYNONYM STRING STORAGE
SYNARG: BLOCK 1 ;SYNONYM-ADDR,,ACCOUNT-STRING-ADDR
ACKEFL: BLOCK 1 ;NON-ZERO IF NEW-STYLE ACKS WANTED
ACKETX: BLOCK 1 ;ADDRESS OF ACK TEXT ON USER ERRORS
ACKITX: BLOCK 1 ;ADDRESS OF ACK ITEXT BLOCK
MVBFLG: BLOCK 1 ;FLAG TO MOVE WHOLE VALIDATION BLOCK
STATE2: BLOCK 1 ;SECOND STATES WORD (CONTAINS VALIDATION FLAG)
ACTDEV: BLOCK 1 ;USUALLY ERSATZ DEVICE ACT:, DSK: IF DEBUGGING
; (E.G., .JBOPS CONTAINS NON-ZERO)
PRJDEV: BLOCK 1 ;FOR PROJCT.SYS NOW USE SYS: OR DSK: IF DEBUG
ACNDEV: BLOCK 1 ;DEVICE FOR ACTDAE.SYS (SYS: OR DSK: IF DEBUG)
ACTUSE: BLOCK 2 ;USETI/O BLOCK FOR POSITIONING ANY FILE
ACTPDL: BLOCK ACTLNG ;PUSH DOWN LIST
ACCTFN: BLOCK 16 ;STORAGE FOR ASCIZ ACCOUNTING FILE NAME
;INITIALIZATION BLOCK
IB: $BUILD (IB.SZ) ;INITIALIZATION BLOCK
$SET (IB.PIB,,PIB) ;ADDRESS OF PID BLOCK
$SET (IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET (IB.INT,,ACTPSI) ;INTERRUPT VECTOR BASE
$SET (IB.FLG,IB.NPF,1) ;DON'T DO VIRTUAL TIMER TRAPS UNTIL ALL SET UP
$EOB
PIB: $BUILD (PB.MXS) ;PID BLOCK
$SET (PB.HDR,PB.LEN,PB.MXS) ;LENGTH OF THIS BLOCK
$SET (PB.FLG,IP.JWP,1) ;JOB-WIDE PID
$SET (PB.FLG,IP.SPF,1) ;BE A SYSTEM PID
$SET (PB.FLG,IP.SPB,1) ;SEE IF SENDER SET IP.CFP
$SET (PB.FLG,IP.PSI,1) ;CONNECT THIS PID TO PSI SYSTEM
$SET (PB.INT,IP.SPI,SP.ACT) ;SPECIAL PID INDEX [SYSTEM]ACCOUNT
$SET (PB.INT,IP.CHN,<IPCPSI-ACTPSI>) ;CHANNEL
$SET (PB.SYS,IP.MNP,1) ;ONLY 1 PID ALLOWED FOR THIS JOB
$SET (PB.SYS,IP.SQT,-1) ;INFINITE SEND QUOTA
$SET (PB.SYS,IP.RQT,-1) ;INFINITE RECEIVE QUOTA
$EOB
;IPCF SEND/RECEIVE MESSAGE DEFINITIONS
IPS.BL: BLOCK SAB.SZ ;IPCF SEND BLOCK
IPR.BL: BLOCK MDB.SZ ;IPCF RECEIVE BLOCK
MDBADR: BLOCK 1 ;MESSAGE DESCRIPTOR BLOCK OF LAST RECEIVE
MMSADR: BLOCK 1 ;RECEIVE DATA ADDRESS
DATADR: BLOCK 1 ;ADDRESS OF DATA FOR ADTDAE FUNCIONS
SABADR: BLOCK 1 ;ADDRESS OF SEND DATA PAGE
SABFLG: BLOCK 1 ;FLAG TO CHECK IF ACK STILL NEEDED
;PSI INTERRUPT BLOCKS
ACTPSI:
IPCPSI: EXP IPCTRP
BLOCK 3
DTCPSI: EXP DTCTRP
BLOCK 3
DTCTRP: $BGINT 1,
PUSHJ P,ACTCHD ;ADJUST ALL TIMES AND CHECKPOINT
$DEBRK
IPCTRP: $BGINT 1,
$CALL C%INTR
$DEBRK
SUBTTL ERROR CODE GENERATOR
;USAGE:
; DEFINE LOCAL ERROR CODES, ERRA%=0, ERRB%=1, ...
; DEFINE LOCAL LABELS WHICH CORRESPOND TO EACH ERROR CODE.
; FOR EACH ERROR CODE, LABEL PAIR, ERCODE(LABEL,CODE)
ECDMAX==11 ;MAXIMUM NUMBER OF ERROR TYPES IN ACTDAE
DEFINE ERCODE(NAME,CODE)<
.DIRECTIVE .XTABM
ERRCOD (NAME,CODE,\CODE)
.DIRECTIVE .ITABM>
DEFINE ERRCOD(NAME,CODE,ACODE)<
IFG <CODE+1-ECDMAX>,<
PRINTX %ECOD'ACODE is undefined, define ECDMAX in ACTDAE.MAC to be ACODE+1>
NAME==ECOD'ACODE>
DEFINE ERCALC(N)<
.N==0
REPEAT N,<ERRJSP (\.N)
.N=.N+1>
ECOD: SUBI T1,ECOD0+1
HRRZS T1
JRST ERRPRO>
DEFINE ERRJSP(N)<
ECOD'N: JSP T1,ECOD>
ERCALC (ECDMAX)
SUBTTL MACROS
;DEFINE A MACRO TO PUT STANDARD ACTDAE HEADER AROUND A MESSAGE TO THE OPERATOR
DEFINE $WTOXX (TEXT),<
$WTO (<Message from the Accounting System>,<TEXT>,,<$WTFLG(WT.SJI)>)
>
;DEFINE A MACRO TO OUTPUT FATAL ERRORS TO OPERATOR THEN STOP
DEFINE $BOMB (TEXT),<
JRST [$WTO(<Fatal error in the Accounting System>,<TEXT>)
$FATAL(<TEXT>)]
>
SUBTTL ACTDAE - PRIMARY MODULE FOR TOPS10 ACCOUNTING DAEMON
ACTDAE: RESET
MOVE P,[IOWD ACTLNG,ACTPDL] ;SET UP OUR PDL
MOVX S1,IP.JWP ;[144] JOB-WIDE PID FLAG
SKIPE DEBUGW ;[144] IF DEBUGGING,
ANDCAM S1,PIB+PB.FLG ;[144] USE ONLY INIT-CLASS PID
MOVEI S1,IB.SZ ;LOAD SIZE OF INITIALIZATION BLOCK (IB)
MOVEI S2,IB ;LOAD ADDRESS OF IB
$CALL I%INIT ;INITIALIZE THE WORLD OF GLXLIB
$CALL I%ION ;TURN ON THE PSI SYSTEM
MOVX T2,.PCDTC ;DATE/TIME CHANGE PSI CONDITION
MOVSI T3,<DTCPSI-ACTPSI>
SETZM T4 ;NO PRIORITY
MOVX T1,<PS.FAC+T2> ;SET UP CALL
PISYS. T1,
$WTOXX (<Date/time changes will not be adjusted in the USAGE files.
Please report PISYS. error >,^O/T1/)
PUSHJ P,ACTINI ;INITIALIZE THE WORLD
MOVE S1,[.STTVM,,^D1000] ;SETUP TO ATTEMPT VIRTUAL TIMER TRAPS
SETUUO S1, ;EVERY SECOND OF RUN TIME
TRN ;BUT I DON'T MIND IF NEVER GO VIRTUAL!
ACTDA1: $CALL C%RECV
JUMPF ACTDA2 ;NO MESSAGES YET. WAIT FOR AN EVENT TO HAPPEN
MOVEM S1,MDBADR ;SAVE THE MESSAGE DESCRIPTOR ADDRESS
MOVE T1,MDB.MS(S1) ;GET THE ADDRESS OF THE MESSAGE
ANDX T1,MD.ADR ;MASK OUT THE ADDRESS
MOVEM T1,MMSADR ;SAVE IT FOR LATER
MOVEM T1,DATADR ;DATA MESSAGE IF NOT FROM A QUEUE. UUO
MOVEM T1,SABADR ;AND IN CASE OF ERROR MESSAGES
SETZM SABFLG ;NOT YET ACK'ED
SETZM RMGCOD ;NO FATAL RMS ERRORS SO FAR
PUSHJ P,QUECHK ;CHECK IF MESSAGE CAME FROM QUEUE.
JUMPF [PUSHJ P,IGNORE
JRST ACTDA1]
MOVE T1,DATADR ;USE DATADR IN CASE IT WAS A QUEUE. MESSAGE
HRRZ T1,UV$TYP(T1) ;GET THE IPCF MESSAGE TYPE
ANDI T1,AF.FUN ;MASK IT DOWN
CAILE T1,IPCMAX ;IS IT A LEGAL MESSAGE?
SETZ T1, ;NO, MAKE IT 0 = ILLEGAL
HLRZ T2,ACTDSP(T1) ;GET PRIV CHECKING ROUTINE
SKIPE T2 ;SKIP IF NO CHECKING NEEDED
PUSHJ P,(T2) ;CHECK PRIVILEGES
HRRZ T2,ACTDSP(T1) ;GET MESSAGE PROCESSOR ROUTINE
PUSHJ P,(T2) ;DISPATCH
SKIPN SABFLG ;DID WE EVER SEND THE ACK?
PUSHJ P,IGNORE ;NO--MAKE SURE
JRST ACTDA1
ACTDA2: PUSHJ P,CHKIVL ;COMPUTE TIME UNTIL NEXT CHECKPOINT
$CALL I%SLP ;AND SLEEP THAT LONG
JRST ACTDA1 ;GO BACK AND SEE WHAT WOKE US UP
;DISPATCH TABLE FOR ACCOUNT DAEMON EVENTS
ACTDSP: XWD PRVOPR,IGNORE ;(0) ILLEGAL
XWD 0,ACTVER ;(1) REQUEST FOR ACCOUNT VALIDATION
XWD PRVOPR,ACTLIN ;(2) USER IS LOGGING IN
XWD PRVOPR,ACTSES ;(3) USER TYPED A SESSION COMMAND
XWD PRVOPR,ACTATT ;(4) USER TYPED AN ATTACH COMMAND
XWD PRVOPR,IGNORE ;(5) SET DATE/TIME MESSAGE FROM DAEMON
XWD PRVOPR,IGNORE ;(6) RESPONSE TO A VALIDATION MESSAGE
XWD PRVOPR,USGMAK ;(7) MAKE A USAGE ENTRY (QUEUE. UUO only)
XWD PRVOPR,DOUBC ;(10) DO BILLING CLOSURE
XWD PRVOPR,DOUFC ;(11) DO FILE CLOSURE
XWD PRVOPR,ACTFDM ;(12) USER FILE STRUCTURE MOUNT MESSAGE
XWD PRVOPR,ACTFDD ;(13) USER FILE STRUCTURE DISMOUNT MESSAGE
XWD PRVOPR,ACTMGM ;(14) USER MAGTAPE MOUNT MESSAGE
XWD PRVOPR,ACTMGD ;(15) USER MAGTAPE DISMOUNT MESSAGE
XWD PRVOPR,ACTDTM ;(16) USER DECTAPE MOUNT MESSAGE
XWD PRVOPR,ACTDTD ;(17) USER DECTAPE DISMOUNT MESSAGE
XWD PRVOPR,ACTSPM ;(20) DISK PACK SPINDLE SPIN-UP MESSAGE
XWD PRVOPR,ACTSPD ;(21) DISK PACK SPINDLE SPIN-DOWN MESSAGE
XWD PRVOPR,IGNORE ;(22) ACK (SENT FROM ACTDAE, NEVER RECEIVED)
XWD PRVOPR,ACTDUE ;(23) DISK USAGE DATA
XWD PRVOPR,ACTACC ;(24) ACCESS CONTROL CHECK (QUEUE. UUO only)
XWD 0,ACTOUP ;(25) OBTAIN USER PROFILE (QUEUE. UUO only)
XWD PRVOPR,IGNORE ;(26) UNDEFINED
XWD 0,ACTOUT ;(27) A LOGOUT UUO WAS DONE
XWD 0,ACTACC ;(30) ACC BUT RETURN PROFILE (QUEUE. UUO only)
XWD 0,ACTCUP ;(31) CHANGE USER PROFILE (QUEUE. UUO only)
XWD PRVOPR,ACTPSW ;(32) VALIDATE PASSWORD (QUEUE. UUO only)
XWD PRVADM,ACTLOK ;(33) LOCK USER ACCOUNT FILE (QUEUE. UUO only)
XWD PRVADM,ACTUNL ;(34) UNLOCK USER ACCOUNT FILE (QUEUE. UUO only)
XWD PRVOPR,ACTVER ;(35) VALIDATE ACCOUNT AND RETURN PROFILE
XWD PRVADM,ACTSCD ;(36) CLOSE AND REOPEN SCDMAP.INI (QUEUE. UUO only)
XWD 0,ACTWLD ;(37) GET POSSIBLY WILDCARDED PPN/NAME
XWD 0,ACTMAP ;(40) MAP PPNS/NAMES
IPCMAX==:.-ACTDSP-1
IGNORE: SKIPE GFRFLG ;IF THIS CAME FROM [SYSTEM]GOPHER,
JRST QUEACK ;RELEASE THE JOB
SKIPN SABFLG ;NO. DO WE NEED TO RELEASE THE MSG?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
$RETF
IPCREL: MOVE S1,MDBADR ;GET THE MDB ADDRESS
SKIPE MDB.MS(S1) ;HAS IT ALREADY BEEN RELEASED?
$CALL C%REL ;NO. DO IT NOW
SETOM SABFLG ;REMEMBER THAT WE CALLED C%REL
POPJ P, ;RETURN
SUBTTL PRIVILEGE CHECKING
PRVADM: PUSHJ P,CHKADM ;CHECK ADMINISTRATIVE PRIVS
JUMPF NOPRV ;NO ACCESS ALLOWED
$RETT ;RETURN
PRVOPR: PUSHJ P,CHKOPR ;CHECK FOR [1,2] OR JACCT PRIVS
JUMPF NOPRV ;NO ACCESS ALLOWED
$RETT ;RETURN
; CHECK FOR ADMINISTRATIVE PRIVS OR JACCT
CHKADM: MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
LOAD T3,MDB.PV(T2),MD.PJB ;GET JOB NUMBER
HRLZS T3 ;PUT IN LH
HRRI T3,.GTPRV ;INCLUDE GETTAB TABLE
GETTAB T3, ;GET PRIV WORD
SETZ T3, ;FAILED?
MOVE T4,MDB.PV(T2) ;GET SENDER'S PRIVS
TXNN T4,MD.PWH ;JACCT'ED JOB?
TXNE T3,JP.ADM ;ADMINISTRATIVE PRIVS?
$RETT ;YES OR YES, RETURN GOODNESS
$RETF ;NO TO BOTH, FAIL
; ([1,2] DOESN'T WIN FOR FREE)
; CHECK FOR [1,2] OR JACCT PRIVS
CHKOPR: MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
MOVE T3,MDB.PV(T2) ;GET SENDER'S PRIVS AND JOB NUMBER
MOVE T4,MDB.SD(T2) ;GET SENDER'S PPN
CAME T4,MYPPN ;SAME AS US (NORMALLY [1,2])
TXNE T3,MD.PWH ;NO--JACCT'ED JOB?
$RETT ;YES
$RETF ;NO ACCESS ALLOWED
; CHECK FOR OWNER
CHKOWN: SKIPE ACOPRV ;IF PRIV'ED
$RETT ;THEN AN OWNER
MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
MOVE T3,MDB.SD(T2) ;GET SENDER'S PPN
CAMN T3,S1 ;IS THIS AN EXACT MATCH?
$RETT ;YES, HE OWNS IT
$SAVE T1 ;PRESERVE AN AC
MOVE T2,S1 ;GET TARGET PPN
CAMN T3,MYPPN ;IF [1,2],
TRCA T3,1 ;THEN FOOL THE CHKACC UUO,
TRNA ;(NOT [1,2])
TRC T2,1 ;BUT GIVE THE RIGHT ANSWER
MOVE T1,[.ACCPR,,<777>B26+<077>B35] ;SETUP FOR CHKACC
MOVEI T4,T1 ;POINT TO UUO ARG BLOCK
CHKACC T4, ;TRY IT
$RETF ;SICK MONITOR
CAIE T4,0 ;IS HE A WINNER?
$RETF ;NO
$RETT ;OR YES
NOPRV: SKIPN GFRFLG ;DID THIS COME FROM [SYSTEM]GOPHER?
JRST NOPRV1 ;NO, JUST IGNORE (CAN'T TRUST USERS DATA)
PUSHJ P,M%GPAG ;BUT CAN TRUST THE MONITOR, GET A MESSAGE
MOVEM S1,SABADR ;STORE WHERE COMMON ROUTINES CAN FIND IT
PUSHJ P,ERROR3 ;SAY "JOB NOT PRIVILEGED"
PUSHJ P,FIXQUE ;MOVE ACK CODE AND FORMAT THE MESSAGE
PUSHJ P,RSPSAB ;SEND RESPONSE FROM SABADR TO THE MONITOR
NOPRV1: SETZ T1, ;RETURN FUNCTION = 0 = ILLEGAL
$RETF ;AND PITCH IT
SUBTTL ACTDAE - INITIALIZATION
ACTINI: MOVEI S1,'ACT' ;ACTDAE PREFIX
MOVEI S2,ERRACK ;ROUTINE TO ACK USER ERRORS
PUSHJ P,A$ERRI## ;INIT ERROR PROCESSOR
PUSHJ P,ACGTAB ;AREA TO DO ALL THE GENERAL GETTABS
MOVX S1,ACTFIL ;GET ACCOUNTING FILE NAME
$TEXT (<-1,,ACCTFN>,<^W/ACNDEV/:^W/S1/.SYS^0>) ;GENERATE ACCT FILESPEC
PUSHJ P,USGSAU ;APPEND TO USAGE.OUT
PUSHJ P,SYSINI ;SYSTEM RESTARTED. DO PRELIMINARY WORK
PUSHJ P,ACDINI ;INITIALIZE ALL DISK STUFF
MOVE T1,STATE2 ;GET STATES WORD
TXNN T1,ST%ACV ;ACCOUNT VALIDATION REQUIRED?
$WTOXX (<Account validation is not required>)
PUSHJ P,SYNFIL ;READ SYNONYM FILE
SETOM CHKNDX ;FORCE A CHECKPOINT WHEN IPCF QUEUE IS EMPTY
POPJ P,
;ACGTAB - ROUTINE TO DO ALL GENERAL GETTABS AND STORE THE RESULTS FOR
; LATER USE.
ACGTAB: SKIPE .JBOPS ;ARE WE DEBUGGING?
SKIPA T1,[' DSK'] ;YES. LOOK IN OUR OWN AREA
MOVEI T1,'ACT' ;NO. USE ERSATZ DEVICE
MOVEM T1,ACTDEV ;SAVE IT
SKIPE .JBOPS ;ARE WE DEBUGGING?
SKIPA T1,[' DSK'] ;YES. LOOK IN OUR OWN AREA
MOVEI T1,'SYS' ;NO. USE SYS: FOR PROJCT.SYS
MOVEM T1,PRJDEV ;SAVE IT
MOVSM T1,ACNDEV ;SETUP FOR ACTDAE.SYS
MOVX T1,%CNTIC ;GET NUMBER OF JIFFIES/SECOND ON THIS MACHINE
GETTAB T1,
MOVEI T1,^D60 ;DEFAULT TO 60
MOVEM T1,JIFSEC
MOVX T1,%CNST2
GETTAB T1,
MOVEI T1,0 ;ERROR. DON'T DO VALIDATION.
MOVEM T1,STATE2 ;SAVE IT
TXNN T1,ST%ERT ;IS THERE EBOX/MBOX RUNTIME?
JRST ACGTA1 ;NO. SKIP KL-ONLY STUFF
MOVX T1,%CVETJ ;GET CPU0'S EBOX TICKS/JIFFY
GETTAB T1,
MOVEI T1,0
MOVEM T1,ETICKS
MOVX T1,%CVNTJ ;GET CPU0'S MBOX TICKS/JIFFY
GETTAB T1,
MOVEI T1,0
MOVEM T1,MTICKS
ACGTA1: MOVX T1,%CNSJN ;GET NUMBER OF JOBS FROM MONGEN
GETTAB T1,
MOVEI T1,^D201 ;ERROR. DEFAULT TO A 200 JOB MONITOR
MOVEI T1,-1(T1) ;REMOVE NULL JOB
MOVEM T1,JOBMAX ;ONLY ALLOW THIS MANY JOBS TO LOGIN
GETPPN T1, ;GET OUR PPN
JFCL ;SILLY SKIP
MOVEM T1,MYPPN ;STORE FOR JUNK MAIL CHECK
POPJ P,
;SYSINI - ROUTINE CALLED AT SYSTEM STARTUP TO MAKE INCOMPLETE SESSION ENTRIES
SYSINI: $CALL .SAVE1 ;GET A WORKING (AND SAFE) AC
PUSHJ P,CPJSAU ;OPEN THE CHECKPOINT FILE
MOVE T1,JOBMAX ;GET NUMBER OF JOBS ALLOWED TO LOGIN
IMULI T1,CPJIOB ;*BLOCKS PER CHECKPOINT AREA FOR EACH JOB
ADDI T1,1+JBOFFS ;ADJUST + ACCOUNT FOR GENERAL BLOCK
MOVE T2,CPJCHN ;THE CHANNEL NUMBER
PUSHJ P,AUSETO ;CREATE/EXTEND THE FILE, ZEROING AS WE GO
JUMPT SYSIN1 ;SO FAR SO GOOD
TXNN T1,IO.BKT ;OUT OF DISK SPACE
$BOMB <ACTECE Error (^O/T1/) while Creating or Extending the checkpoint file>
PUSHJ P,CPJCLS ;CLOSE THE FILE
PUSHJ P,CPJSAU ;RE-OPEN
MOVE T1,USEJOB+.RBSIZ ;AMOUNT THAT GOT CREATED
ADDI T1,177 ;CONVERT TO BLOCKS
LSH T1,-7 ;...
SUBI T1,JBOFFS ;ACCOUNT FOR THE GENERAL BLOCK
IDIVI T1,CPJIOB ;COMPUTE NUMBER OF JOBS THAT CAN BE DESCRIBED
SKIPG T1 ;HOPE SO
SETZ T1, ;WHOOPS?
MOVEM T1,JOBMAX ;SAVE AS MAX JOBS WE WILL ALLOW
$WTOXX <Disk is too full, only ^D/JOBMAX/ jobs will be allowed to log in>
SYSIN1: PUSHJ P,READJG ;READ IN THE FILE HEADER
PUSHJ P,DATIM ;SET UP CURRENT DATE/TIME
SKIPN USGOSZ ;IF ZERO, THE WE JUST CREATED USAGE.OUT
PUSHJ P,MAKUFH ; SO MAKE A USAGE FILE HEADER RECORD
PUSHJ P,MAKRES ;MAKE A SYSTEM RESTART ENTRY
MOVN P1,CPJGEN+FILMJB ;MAXIMUM NUMBER OF JOBS IN THE FILE
JUMPE P1,SYSIN4 ;DONE IF JUST CREATED THE FILE
MOVE T1,CPJGEN+FILBPJ ;GET NUMBER OF BLOCKS REQUIRED FOR EACH JOB
MOVE T2,CPJGEN+FILBPD ;GET NUMBER OF BLOCKS REQUIRED FOR DEVICES
CAIN T2,CPDIOB ;BETTER MATCH
CAIE T1,CPJIOB ;BETTER MATCH
$BOMB <ACTCFF Checkpoint File Format doesn't match this version of ACTDAE>
HRLZS P1 ;FORM AOBJN
HRRI P1,1 ;SKIP THE NULL JOB
SETZM SYSINC ;CLEAR COUNT OF JOBS STILL AROUND (ACTDAE RESTART)
SYSIN2: HRRZM P1,JOBNUM ;STORE JOB NUMBER
PUSHJ P,READJP ;READ IN THE CHECKPOINT INFORMATION
SKIPN CPJBUF+CJOB ;DO WE HAVE DATA FOR THIS JOB
JRST SYSIN3 ;NO, TRY THE NEXT JOB
HRL T1,P1 ;THE JOB NUMBER AGAIN
HRRI T1,.GTJLT ;JOB LOGIN TIME
GETTAB T1, ;THIS MIGHT BE AN ACTDAE RESTART INSTEAD OF
SETZ T1, ; A SYSTEM RESTART, ONLY SOME WILL GET INCOMPLETE
JUMPE T1,SYSIN5 ;JOB NOT THERE IF NO LOGIN TIME
CAMN T1,CPJBUF+CJLGTM ;THIS JOB STILL AROUND
JRST [AOS SYSINC ;YES, COUNT IT TO INDICATE ACTDAE RESTART
JRST SYSIN3] ;WILL CATCH THE JOB AT LOGOUT
SYSIN5: PUSHJ P,MKISES ;MAKE AN INCOMPLETE SESSION ENTRY
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,SYSIND ;GENERATE DEVICE ENTRIES
PUSHJ P,CBJZER ;CLEAR OUT THE JOB INFORMATION
PUSHJ P,CPJCOP ;IN BOTH PLACES
PUSHJ P,WRITJP ;CLEAN FILE NOW THAT WE ARE DONE WITH THIS JOB
SYSIN3: AOBJN P1,SYSIN2 ;DO ALL POSSIBLE JOBS
SETZM JOBNUM ;JOB NUMBER 0 = SPINDLE ENTRIES
SKIPN SYSINC ;IF ACTDAE RESTART, DONT DO SPINDLES HERE
PUSHJ P,SYSIND ;DO THEM NOW
SYSIN4: PUSHJ P,CPJCLS ;CLOSE OUT THE FILE NOW
POPJ P, ;AND ALL DONE WITH RESTART
SYSINC: BLOCK 1 ;COUNT/FLAG FOR ACTDAE-RESTART RATHER THAN SYSTEM RESTART
SYSIND: HRROI T1,INIDVS ;POINT TO ROUTINE
PUSHJ P,ALLDEV ;AND CALL IT FOR ALL DEVICES
POPJ P, ;AND RETURN
;FOLLOWING CO-ROUTINE CALLED BY ALLDEV FOR EACH DEVICE IN THE jjjDEV.BIN FILE
;P1 = THE DEVICE TYPE INDEX
INIDVS: PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CBDZER ;CLEAR THE BLOCK
PUSHJ P,CPDCOP ;BOTH HALVES
PUSHJ P,WRITDP ;ZAP THE DISK AREA
POPJ P, ;AND RETURN FOR THE NEXT
;ACDINI - ROUTINE TO DO INITIALIZATION OF DISK (E.G., OPENING THE FILES
; PROJCT.SYS, USEJOB.BIN, ACTDAE.SYS
ACDINI: MOVE T1,STATE2 ;GET SECOND STATES WORD
TXNN T1,ST%ACV ;IF VALIDATION IS NOT REQUIRED DON'T DO
JRST ACDIN1 ; PROJCT.SYS INITIALIZATION
PUSHJ P,PRJRED ;PROJCT.SYS INITIALIZATION
SKIPF ;WHOOPS
PUSHJ P,BLDPRJ ;VERIFY VERSIONS, SIZES, BUILD TABLES
ACDIN1: PUSHJ P,INITIO## ;INIT FILE I/O (RMS-10 INTERFACE)
SKIPT ;CHECK FOR ERRORS
STOPCD (IOF,HALT,,<File I/O interface initialization failure>)
MOVEI S1,ACCTFN ;GET FILENAME FOR RMS TO OPEN
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
SKIPT ;MAKE SURE IT WORKED
STOPCD (AFF,HALT,,<Accounting file initialization failure>)
PUSHJ P,A$ISCD## ;INITIALIZE CLASS SCHEDULER MAPPING
PUSHJ P,CPJSAU ;INITIALIZE THE PRIMARY JOB CHECKPOINT FILE
POPJ P,
SUBTTL ACTDAE - GENERAL ROUTINES
;AUSETI - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
; TO THE BLOCK NUMBER STORED IN T1 FOR INPUT
;CALL: MOVE T1,BLOCK NUMBER
; HRL T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
; PUSHJ P,AUSETI
; ONLY RETURN (TRUE OR FALSE)
AUSETI: MOVEM T1,ACTUSE+1 ;STORE THE BLOCK #
HRRI T2,.FOUSI ;GET THE USETI FUNCTION CODE
MOVEM T2,ACTUSE ;STORE IT
MOVE T1,[2,,ACTUSE]
FILOP. T1,
$RETF ;ERROR. GIVE A FALSE RETURN
$RETT ;GIVE A TRUE RETURN
;AUSETO - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
; TO THE BLOCK NUMBER STORED IN T1 FOR OUTPUT
;CALL: MOVE T1,BLOCK NUMBER
; HRL T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
; PUSHJ P,AUSETO
; ONLY RETURN (TRUE OR FALSE)
AUSETO: MOVEM T1,ACTUSE+1 ;STORE THE BLOCK #
HRRI T2,.FOUSO ;GET THE USETO FUNCTION CODE
MOVEM T2,ACTUSE ;STORE IT
MOVE T1,[2,,ACTUSE]
FILOP. T1,
$RETF ;ERROR. GIVE A FALSE RETURN
$RETT ;GIVE A TRUE RETURN
SUBTTL ACTQUE - MODULE FOR QUEUE. UUO ROUTINES
;GENERAL DEFINITIONS
MYPPN: BLOCK 1 ;MY PPN FOR PRIV CHECKING
QUECNT: 0 ;COUNT OF QUEUE ARGUMENT BLOCKS LEFT
QUEFLG: 0 ;SET IF MESSAGE WAS FROM A QUEUE. UUO
QUEBLK: 0 ;ADDRESS OF NEXT QUEUE. ARGUMENT BLOCK
QUEEND: 0 ;ADDRESS JUST OFF THE END OF QUEUE. BLOCK
GFRFLG: 0 ;FLAG FOR [SYSTEM]GOPHER AS THE SENDER
RMGUDT: 0 ;UNIVERSAL DATE/TIME OF LAST RMS MESSAGE
RMGCOD: 0 ;FATAL RMS ERROR CODE
;***DESCRIPTOR
ACONMD: EXP -1 ;THIS IS A NAME
EXP ACOUSR ;POINT TO NAME BUFFER
;***
;****DESCRIPTOR
ACOPPD: EXP 0 ;THIS IS A PPN
ACOPPN: BLOCK 1 ;PPN WE ARE TALKING ABOUT
;****
ACOPRV: BLOCK 1 ;INDICATES USER IS PRIVED
VALZER: ;BEGINNING OF BLOCK TO ZERO (MAINTAIN ORDER)
VALBLK: BLOCK UV$ACE+1 ;REBUILT QUEUE. VALIDATION MESSAGE
VALACT: BLOCK 1 ;FLAG THAT .UGACT BLOCK WAS GIVEN
ACOPSW: BLOCK .APWLW ;PASSWORD FOR ACCESS CONTROL
ACOTYP: BLOCK 1 ;TYPE OF ACCESS (0 = REGULAR, NON-0 = SPRINT)
ACOUXP: BLOCK 1 ;INDICATES USERNAME VS PPN BEING USED
ACOUSR: BLOCK .AANLW ;NAME WE ARE TALKING ABOUT
ACOPTR: BLOCK 1 ;POINTER TO A WILDCARD BLOCK
ACOWLD: BLOCK UW$MIN ;INTERNAL WILDCARD BLOCK
ACOACK: BLOCK .AANLW ;WILDCARD ACK BLOCK
ACOMAP: BLOCK 1 ;ADDRESS OF PPN/NAME MAPPING BLOCK
TMPMAP: BLOCK UU$LEN ;TEMPORARY MAPPING BLOCK
TMPLEN: BLOCK 1 ;LENGTH OF SUPPLIED NAME
TMPCNT: BLOCK 1 ;NUMBER OF MAPPING BLOCKS SUPPLIED
;***ACTRMS INTERFACE
ACOPRO: BLOCK .AEMAX ;BLOCK FOR USER PROFILE
ACODEF: BLOCK .AEMAX ;DEFAULT PROFILE STORAGE
ACODWL: BLOCK UW$MIN ;WILDCARD BLOCK FOR DEFAULTING
ACOBIT: BLOCK .AMPLW ;DEFAULTING BIT MAP
ACOBMP: BLOCK 1 ;POINTER INTO BIT MAP
;***
VALZND==.-1 ;LAST WORD TO ZERO FOR VALIDATION REQUESTS
QUEADR: BLOCK 1 ;ADDRESS OF THE REBUILT DEFUS LIST FOR MAKING AN ENTRY
QUELEN: BLOCK 1 ;LENGTH OF THE CONTENTS OF QUEADR
QEXTRA==7 ;EXTRA WORDS NEEDED TO COMPLETE AN ENTRY'S
; INTERNAL DEFUS LIST BUILT AT THE CONTENTS OF
; QUEADR:. 1) DISPATCH (UGENT$) 2. ENTRY TYPE
; 3. TERMINATED WITH A ZERO WORD AND 4-7. PROVIDE
; DEFUS'S FOR ACTDAE VERSION NUMBER AND THE DATE
; AND TIME THE ENTRY IS MADE. SEE QUEENT ROUTINE.
SUBTTL ACTQUE - GENERAL ROUTINES FOR QUEUE. UUO SECTION
;QUECHK - ROUTINE TO CHECK IF MESSAGE IF FROM A QUEUE. UUO. IF SO, MESSAGE
; HAS A DIFFERENT FORMAT THAN THE MESSAGES DEFINED IN ACTSYM.MAC.
QUECHK: SETZM QUEFLG ;INITALIZE
SETZM GFRFLG ;ASSUME NOT FROM GOPHER
SETZM QUEBLK ;NO POINTER YET
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.FG(T1) ;GET THE FLAGS
TXNE T2,IP.CFE!IP.CFM ;CHECK FOR ERRORS OR RETURNED MAIL
$RETF ;PITCH THE MESSAGE
SETZM ACOPRV ;ASSUME NO DESIRE FOR PRIVS
SETZM ACKEFL ;ASSUME WANTS OLD ERROR ACKS
MOVE T2,MDB.SI(T1) ;GET THE SYSTEM INDEX WORD
TXNN T2,SI.FLG ;IS THIS FROM A SYSTEM PID?
JRST QUECH7 ;NO. CHECK FUNCTION FOR FLAGS
LOAD T2,T2,SI.IDX ;YES. FETCH THE S-PID INDEX
CAXE T2,SP.GFR ;IS IT FROM [SYSTEM]GOPHER?
JRST QUECH7 ;NO. JUST CHECK FUNCTION FOR FLAGS
SETOM GFRFLG ;YES. REMEMBER THAT IT'S FROM GOPHER
MOVE T1,MMSADR ;MESSAGE ADDRESS
MOVE T2,.MSTYP(T1)
ANDX T2,MS.TYP ;MESSAGE TYPE
CAIE T2,.IPCQU ;IS THIS FROM A QUEUE. UUO?
$RETT ;NO. ASSUME ANOTHER FORMAT (E.G., LOGOUT MESSAGE)
SETOM QUEFLG ;REMEMBER IT'S A QUEUE. UUO
; SETZM QUEBLK ;INDICATE THE START OF NEW MESSAGE
QUECH1: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET NEXT QUEUE BLOCK
JUMPF .POPJ ;NO MORE BLOCKS, ASSUME BAD MESSAGE
CAIE T1,.QBFNC ;IS THIS THE FUNCTION BLOCK?
JRST QUECH1 ;NO. LOOP UNTIL IT'S FOUND
MOVE T1,(T3) ;GET THE FUNCTION
CAIN T1,.QUVAL ;IS IT A VALIDATION MESSAGE?
PJRST QUEVAL ;YES. SET UP THE MESSAGE AND VALIDATE
CAIE T1,.QUMAE ;IS IT SOME KIND OF ACCOUNTING MESSAGE?
$RETF ;NO. ASSUME ILLEGAL MESSAGE
QUECH2: MOVE T1,MMSADR ;GET THE NEXT QUEUE. BLOCK
PUSHJ P,GETBLK ; FOR ACCOUNTING SUBFUNCTION
JUMPF .POPJ ;ILLEGAL ACCOUNTING MESSAGE
CAIE T1,.QBAFN ;IS THIS THE RIGHT BLOCK?
$RETF ;NO. DECLARE IT ILLEGAL ACCOUNTING MESSAGE
MOVE T1,(T3) ;GET THE SUBFUNCTION
PUSHJ P,QUECH8 ;ANALYZE THE FLAGS
$RETIF ;PROPAGATE FAILURE
MOVSI S1,-QUESIZ ;AOBJN POINTER
QUECH3: HLRZ S2,QUETAB(S1) ;GET ACCT MSG TYPE CODE
CAIE S2,(T1) ;A MATCH?
AOBJN S1,QUECH3 ;SEARCH THE TABLE
JUMPGE S1,.RETF ;NO SUCH BEAST
HRRZ S2,QUETAB(S1) ;GET QUEUE. UUO CONVERSION ROUTINE ADDR
PJRST (S2) ;DISPATCH
QUECH7: MOVE T3,MMSADR ;GET MESSAGE ADDRESS
LOAD T1,(T3),MS.TYP ;GET FUNCTION CODE
QUECH8: TRZE T1,AF.CEA ;WANT NEW ERROR ACKS?
SETOM ACKEFL ;YES, REMEMBER THAT
TRZN T1,AF.PRV ;WANT PRIVS?
JRST QUECH9 ;NO, SKIP IT
PUSH P,T1 ;SAVE BITS
PUSHJ P,PRVADM ;CHECK FOR PRIVS
POP P,T1 ;RESTORE
$RETIF ;PROPAGATE FAILURE
SETOM ACOPRV ;YES, HE GETS PRIVS
QUECH9: TRNN T1,^-AF.FUN ;ANY RESERVED BITS ON?
$RETT ;NO, HE WINS
$RETF ;YES, HE LOSES
QUETAB: UGVAL$,,QUEVLX ;VALIDATION
UGLGN$,,QUELGN ;LOGIN
UGSES$,,QUESES ;SESSION
UGATT$,,QUEATT ;ATTACH
UGENT$,,QUEENT ;MAKE AN ENTRY
UGOUP$,,QUEACC ;ACCESS CONTROL
UGACC$,,QUEACC ;ACCESS CONTROL
UGCUP$,,QUECUP ;CHANGE USER PROFILE
UGVRP$,,QUEACC ;CHANGE USER PROFILE
UGPSW$,,QUEACC ;VERIFY PASSWORD
UGLOK$,,QUEACC ;LOCK ACCOUNTING FILE
UGUNL$,,QUEACC ;UNLOCK ACCOUNTING FILE
UGSCD$,,QUEACC ;REREAD SCDMAP.INI
UGWLD$,,QUEACC ;GET POSSIBLY WILDCARDED PPN OR NAME
UGMAP$,,QUEACC ;MAP PPN/NAMES
QUESIZ==.-QUETAB ;LENGTH OF TABLE
; QUEATT - ATTACH MESSAGE
QUEATT: MOVEI T1,UA$ACK ;ACK CODE OFFSET
PJRST QUECOM ;ENTER COMMON CODE
; QUELGN - LOGIN MESSAGE
QUELGN: MOVEI T1,UL$ACK ;ACK CODE OFFSET
PJRST QUECOM ;ENTER COMMON CODE
; QUESES - SESSION MESSAGE
QUESES: MOVEI T1,US$ACK ;ACK CODE OFFSET
; PJRST QUECOM ;ENTER COMMON CODE
; QUECOM - COMMON ROUTINE TO CONVERT QUEUE. UUO MESSAGES TO NORMAL IPCF FORMAT
; CALL: MOVE T1, ACK CODE OFFSET IN QUEUE MSG
; PUSHJ P,QUECOM
;
; TRUE RETURN: MESSAGE CONVERTED
; FALSE RETURN: JUNK MESSAGE
QUECOM: PUSH P,T1 ;SAVE ACK CODE OFFSET
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUECMF ;CHECK FOR ERRORS
CAIE T1,.QBAET ;ACCOUNTING ENTRY BLOCK?
JUMPF QUECMF ;BAD MESSAGE FORMAT
MOVE T1,DATADR ;POINT TO MESSAGE
MOVE T1,.MSCOD(T1) ;GET ACK CODE
EXCH T1,(P) ;SWAP ACK CODE WITH OFFSET
ADDI T1,(T3) ;INDEX INTO MESSAGE
POP P,(T1) ;MOVE ACK CODE
MOVSI T1,(T3) ;POINT TO DATA PORTION OF MESSAGE
HRR T1,DATADR ;AND TO START OF ACTUAL MESSAGE
ADD T2,DATADR ;COMPUTE END OF BLT
BLT T1,-1(T2) ;SLIDE MSG UP SO IT'S LIKE AN IPCF MSG
$RETT ;AND RETURN
QUECMF: POP P,(P) ;PRUNE STACK
$RETF ;RETURN
; ACK A QUEUE. UUO
; CALL: PUSHJ P,QUEACK
;
; TRUE RETURN: OLD MESSAGE RELEASED, ACK SENT
; FALSE RETURN: OLD MESSAGE RELEASED, GLXLIB ERROR CODE IN AC S1
QUEACK: SKIPN SABFLG ;STILL NEED TO DO THIS?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
MOVE T1,ACKCOD ;GET ACK CODE
MOVEM T1,ACKMSG+.MSCOD ;SAVE
MOVEI S1,SAB.SZ ;SEND ARGUMENT BLOCK LENGTH
MOVEI S2,IPS.BL ;SEND ARGUMETN BLOCK ADDRESS
MOVE T1,MDBADR ;GET MESSAGE DISCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;SENDER'S PID
MOVEM T1,SAB.PD(S2)
MOVEI T1,ACKLEN ;LENGTH OF MESSAGE
MOVEM T1,SAB.LN(S2)
MOVEI T1,ACKMSG ;MESSAGE ADDRESS
MOVEM T1,SAB.MS(S2)
$CALL C%SEND ;ACK THE USER
$RETIT ;RETURN IF NO ERRORS
MOVE T1,MDBADR ;POINT TO MDB
$WTOXX <^I/ACKTXT/>
$RETF ;GIVE UP
ACKMSG: $BUILD (.OHDRS+ARG.SZ) ;SIZE OF MESSAGE
$SET (.MSTYP,MS.CNT,ACKLEN) ;LENGTH OF MESSAGE
$SET (.MSTYP,MS.TYP,.OMTXT) ;TEXT MESSAGE
$SET (.MSFLG,MF.NOM,1) ;NO DATA IN MESSAGE (JUST AN ACK)
$SET (.MSCOD,,0) ;ACK CODE (FILLED IN LATER)
$SET (.OHDRS+ARG.HD,AR.LEN,2);TWO WORDS OF DATA
$SET (.OHDRS+ARG.HD,AR.TYP,.CMTXT) ;TYPE OF DATA (TEXT)
$SET (.OHDRS+ARG.DA,,0) ;NO TEXT
$EOB ;END OF BLOCK
ACKLEN==.-ACKMSG ;LENGTH OF MESSAGE
ACKTXT: ITEXT (<Cannot ACK job ^D/MDB.PV(T1),MD.PJB/ ^U/MDB.SD(T1)/
Error: ^E/S1/>)
;QUEVAL - ROUTINE TO CONVERT A QUEUE. UUO VALIDATION MESSAGE INTO A FORMAT THE
; ACCOUNT DAEMON AND FRIENDS ALREADY KNOW ABOUT.
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF MESSAGE DATA
; QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEVAL: MOVEI T1,UGVAL$ ;TYPE OF ACCOUNT MESSAGE
PUSHJ P,PREVAL ;PREPARE VALIDATION BLOCKS
QUEVA1: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEVA3 ;END OF BLOCK, BEGIN VALIDATION
CAIE T1,.QBOID ;IS IT A PPN?
JRST QUEVA2 ;NO. SEE IF IT'S AN ACCOUNT BLOCK
MOVE T3,(T3) ;GET THE PPN
MOVEM T3,VALBLK+UV$PPN ;STORE THE PPN
JRST QUEVA1 ;LOOK AT NEXT BLOCK
QUEVA2: CAIE T1,.QBACT ;IS THIS BLOCK AN ACCOUNT?
JRST QUEVA1 ;NO. SEE IF WE'RE DONE
HRLZ S1,T3 ;BLT THE ACCOUNT INTO VALBLK
HRRI S1,VALBLK+UV$ACT
CAILE T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
MOVEI T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
BLT S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
JRST QUEVA1 ;LOOK AT NEXT BLOCK
QUEVA3: MOVEI T1,VALBLK
MOVEM T1,DATADR ;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
$RETT
;SUBROUTINE TO PREPARE VALIDATION BLOCKS FOR QUEUE. FUNCTIONS
;CALL: T1/MESSAGE TYPE TO FILL INTO THE BLOCK
PREVAL: SETZM VALZER ;ZERO THE BLOCKS
MOVE S1,[VALZER,,VALZER+1]
BLT S1,VALZND ;CLEAR THE WHOLE THING
MOVEM T1,VALBLK+UV$TYP ;STORE TYPE OF MESSAGE
POPJ P, ;AND RETURN
;QUEACC - ROUTINE TO EXTRACT ACCESS CONTROL INFORMATION FROM THE QUEUE. BLOCKS
;CALL: T1/ FUNCTION CODE
; MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
; QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEACC:
PUSHJ P,PREVAL ;PREPARE THE INTERNAL BLOCK
QUEACT: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEACX ;END OF BLOCK, BEGIN VALIDATION
QUEAC0: CAIE T1,.UGTYP ;IS THIS BLOCK THE ACCESS TYPE
JRST QUEAC1 ;NO, LOOK AT NEXT BLOCK
MOVE T3,(T3) ;GET TYPE ARGUMENT
MOVEM T3,ACOTYP ;STORE
JRST QUEACT ;LOOK AT THE NEXT BLOCK
QUEAC1: CAIE T1,.UGACT ;IS THIS BLOCK AN ACCOUNT?
JRST QUEAC2 ;NO. SEE IF ITS A PPN BLOCK
HRLZ S1,T3 ;BLT THE ACCOUNT INTO VALBLK
HRRI S1,VALBLK+UV$ACT
CAILE T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
MOVEI T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
BLT S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
SETOM VALACT ;NOTE THAT WE GOT HERE
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC2: CAIE T1,.UGPPN ;IS IT A PPN?
JRST QUEAC3 ;NO. SEE IF IT'S A PASSWORD BLOCK
MOVEM T1,ACOUXP ;INDICATE WE GOT A PPN
MOVE T3,(T3) ;GET THE PPN
MOVEM T3,VALBLK+UV$PPN ;STORE THE PPN
MOVEM T3,ACOPPN ;STASH HERE TOO
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC3: CAIE T1,.UGPSW ;IS THIS BLOCK THE PASSWORD
JRST QUEAC4 ;NO. SEE IF ITS A USERNAME
HRLZ S1,T3 ;BLT THE PASSWORD INTO ACOPSW
HRRI S1,ACOPSW
CAILE T2,.APWLW ;MAKE SURE NOT LONGER THAN MAX
MOVEI T2,.APWLW ;MAKE MAXIMUM LENGTH IF SO
BLT S1,ACOPSW-1(T2) ;COPY THE PASSWORD
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC4: CAIE T1,.UGUSR ;IS THIS BLOCK THE USERNAME
JRST QUEACT ;NOPE, IGNORE IT THEN
MOVEM T1,ACOUXP ;INDICATE WE GOT A USERNAME
HRLZ S1,T3 ;BLT THE USERNAME INTO ACOPSW
HRRI S1,ACOUSR
CAILE T2,.AANLW ;MAKE SURE NOT LONGER THAN MAX
MOVEI T2,.AANLW ;MAKE MAXIMUM LENGTH IF SO
BLT S1,ACOUSR-1(T2) ;COPY THE NAME
JRST QUEACT
QUEACX: MOVEI T1,VALBLK
MOVEM T1,DATADR ;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
$RETT
;QUECUP - ROUTINE TO CONVERT A QUEUE. UUO UGCUP$ MESSAGE TO A NORMAL ONE
QUECUP: MOVE T2,QUEBLK ;POINTER TO NEXT DATA BLOCK
SUBI T2,.OHDRS ;BACK UP BY GALACTIC HEADER
MOVE T3,QUECNT ;NUMBER OF ARG BLOCKS REMAINING
MOVEM T3,.OARGC(T2) ;SETUP AS IF ORION HAD TOLD US
HRRM T1,(T2) ;STORE THE FUNCTION CODE
MOVE T3,DATADR ;GET MESSAGE ADDRESS
MOVE T3,1(T3) ;GET ACK CODE
MOVEM T3,1(T2) ;SAVE HERE
SETZM .OFLAG(T2) ;NO FLGS
MOVEM T2,DATADR ;SAVE FOR OTHERS
$RETT ;RETURN
;QUEENT - ROUTINE TO CONVERT A QUEUE. UUO 'MAKE AN ENTRY' MESSAGE INTO A
; FORMAT THE ACCOUNT DAEMON ALREADY KNOWS ABOUT (FORMAT IS CALLED A
; DEFUS DATA LIST).
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
; QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEENT: $CALL .SAVE1
MOVE T1,MMSADR ;GET THE TOTAL NUMBER OF QUEUE. BLOCKS
MOVE S1,.OARGC(T1) ;REBUILT MESSAGE WILL HAVE 2 WORDS/BLOCK,
IMULI S1,2
ADDI S1,QEXTRA ;SEE COMMENTS AT QEXTRA DEFINITION FOR EXTRA
; SPACE NEEDED
$CALL M%GMEM ;GET SPACE NEEDED TO BUILD AN INTERNAL DEFUS LIST
MOVEM S1,QUELEN ;STORE THE LENGTH FOR RELEASING MEMORY
MOVEM S2,QUEADR ;STORE THE ADDRESS
MOVEM S2,DATADR
MOVE P1,S2
MOVEI T1,UGENT$ ;"MAKE AN ENTRY" DISPATCH VALUE FOR ACTDSP
MOVEM T1,(P1)
AOS P1
MOVE T1,MMSADR ;GET THE NEXT QUEUE. BLOCK
PUSHJ P,GETBLK
JUMPF QUEEN3 ;ILLEGAL MESSAGE IF NO MORE
CAIE T1,.QBAET ;BLOCK TYPE MUST BE ENTRY TYPE BLOCK
JRST QUEEN3 ;OTHERWISE DECLARE IT AN ILLEGAL MESSAGE
MOVE T1,(T3) ;GET THE ENTRY TYPE
MOVEM T1,(P1) ;STORE IT
AOS P1 ;STEP TO THE NEXT WORD
QUEEN1: MOVE T1,MMSADR
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEEN2 ;NO MORE BLOCKS. FINISH UP AND RETURN
CAIN T1,.USTAD ;CURRENT DATE/TIME IS ALWAYS PROVIDED BY ACTDAE
JRST QUEEN1 ;GO READ NEXT BLOCK
CAIN T1,.USAMV ;AS IS THE ACCOUNT DAEMON'S VERSION NUMBER
JRST QUEEN1 ;READ THE NEXT BLOCK
TXO T1,1B0 ;HANDLE THE ZERO DEFUS CASE
MOVEM T1,(P1) ;STORE THE DEFUS NUMBER
MOVEM T3,1(P1) ;THIS IS THE ADDRESS WHERE THE DATA IS FOUND
ADDI P1,2 ;COUNT THE TWO WORDS JUST FILLED
JRST QUEEN1 ;READ THE NEXT QUEUE. BLOCK
QUEEN2: PUSHJ P,QEXFIL ;PROVIDE THE ACTDAE-ONLY DATA
SETZM (P1) ;MUST TERMINATE WITH A ZERO WORD
$RETT
QUEEN3: MOVE S1,QUELEN ;MUST RETURN SPACE WE GOT FOR THE MESSAGE
MOVE S2,QUEADR ;...
$CALL M%RMEM ;GIVE IT BACK IF THE MESSAGE IS BAD
$RETF ;AND PITCH THE MESSAGE
;QUEVLX - ROUTINE TO CONVERT VALIDATION MESSAGES
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF MESSAGE DATA
; QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEVLX: MOVEI T1,UGVAL$ ;TYPE OF ACCOUNT MESSAGE
PUSHJ P,PREVAL ;PREPARE VALIDATION BLOCKS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
$RETIF ;CHECK FOR ERRORS
CAIE T1,.QBAET ;ACCOUNTING ENTRY BLOCK?
$RETF ;BAD MESSAGE FORMAT
HRLZ T2,T3 ;POINT TO VALIDATION BLOCK IN MESSAGE
HRRI T2,VALBLK ;MAKE A BLT POINTER
BLT T2,VALBLK+UV$ACE ;COPY
MOVEI T1,VALBLK ;POINT TO OUR VALIDATION BLOCK
MOVEM T1,DATADR ;SAVE ADDRESS
SETOM MVBFLG ;REMEMBER TO MOVE THE WHOLE BLOCK
$RETT ;RETURN
;QEXFIL - ROUTINE TO PROVIDE ACCOUNT-DAEMON-ONLY DATA IN THE INTERNAL DEFUS LIST.
QEXFIL: MOVEI T1,.USTAD ;DATE/TIME ENTRY IS MADE IS ALWAYS GIVEN BY ACTDAE
MOVEM T1,(P1) ;STORE ITS DEFUS NUMBER
PUSHJ P,DATIM ;FILL IN CURRENT DATE AND TIME
MOVEI T1,CURDTM ;ADDRESS WHERE THE DATE/TIME WILL BE STORED
MOVEM T1,1(P1)
ADDI P1,2 ;ADJUST P1 FOR NEXT ITEM
MOVEI T1,.USAMV ;THE ACCOUNTING MODULE'S VERSION NUMBER
MOVEM T1,(P1) ;STORE THE DEFUS NUMBER
MOVEI T1,.JBVER ;ADDRESS WHERE IT'S STORED
MOVEM T1,1(P1)
ADDI P1,2 ;ADJUST P1
POPJ P,
;GETBLK - ROUTINE TO FIND THE NEXT QUEUE. ARGUMENT BLOCK (MATCHES A$GBLK IN QSRADM.MAC)
;CALL: T1/ THE MESSAGE ADDRESS
;RETURN T1/ THE BLOCK TYPE
; T2/ THE LENGTH OF THE DATA IN THE BLOCK
; T3/ THE ADDRESS OF THE DATA IN THE BLOCK
; FALSE IF NO MORE BLOCKS
GETBLK: SKIPE S1,QUEBLK ;GET THE BLOCK ADDRESS IF THERE IS ONE
JRST GETBL1 ;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
MOVE S1,.OARGC(T1) ;GET THE MESSAGE BLOCK COUNT
MOVEM S1,QUECNT ;AND SAVE IT
LOAD S1,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
ADDI S1,(T1) ;POINT OFF THE END
MOVEM S1,QUEEND ;SAVE FOR LIMIT COMPUTATIONS
MOVE S1,MDBADR ;GET DESCRIPTOR BLOCK ADDRESS
LOAD T2,MDB.MS(S1),MD.CNT ;GET MESSAGE SIZE
LOAD S1,MDB.MS(S1),MD.ADR ;AND ADDRESS
ADD S1,T2 ;A DIFFERENT IDEA OF THE END
CAMGE S1,QUEEND ;IS THIS MORE RESTRICTIVE?
MOVEM S1,QUEEND ;YES, DON'T ILL MEM REF
MOVEI S1,.OHDRS+ARG.HD(T1) ;IF NOT,,GET THE FIRST ONE
GETBL1: CAMGE S1,QUEEND ;DON'T ADVANCE PAST THE END
SOSGE QUECNT ;CHECK THE BLOCK COUNT
$RETF ;NO MORE,,JUST RETURN
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;POINT TO THE ACTUAL DATA
ADD S1,T2 ;POINT TO THE NEXT BLOCK
MOVEM S1,QUEBLK ;SAVE IT FOR THE NEXT TIME AROUND
CAMG S1,QUEEND ;BEYOND THE LIMIT?
SOJA T2,.RETT ;T2 NOW ONLY REFLECTS DATA LENGTH, GOOD RETURN
$RETF ;MESSAGE IS BAD
;GETBLF - ROUTINE TO RETURN BLOCK TYPE & FLAGS
;CALL: LIKE GETBLK
;RETURN: T1 HAS THE BLOCK TYPE, MASKED DOWN TO A PROFILE ENTRY OFFSET
; S2 HAS THE SELECTION FLAGS THAT WERE MASKED OFF OF T1
GETBLF: PUSHJ P,GETBLK ;GET THE BLOCK INFO
$RETIF ;PROPAGATE FAILURE
MOVE S2,T1 ;COPY BLOCK TYPE
ANDI T1,AF.OFS ;KEEP ONLY OFFSET HERE
TRZ S2,AF.OFS ;AND ONLY BITS HERE
POPJ P, ;RETURN GOODNESS
;FNDBLK - ROUTINE TO FIND ANY QUEUE. ARGUMENT BLOCK IN A MESSAGE
;CALL: T1/ THE MESSAGE ADDRESS
; T2/ THE TYPE OF BLOCK WE WANT
;RETURN T1/ THE ADDRESS WHERE THE BLOCK STARTS (OR FALSE IF NOT FOUND)
FNDBLK: $CALL .SAVE2 ;SAVE P1,P2
LOAD P1,.OARGC(T1) ;GET THE MESSAGE ARGUMENT COUNT
MOVE P2,T2 ;SAVE THE BLOCK TYPE
MOVEI S1,.OHDRS(T1) ;POINT TO THE FIRST BLOCK
LOAD TF,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
CAXLE TF,PAGSIZ ;CAN'T BE GREATER THEN A PAGE
$RETF ;ELSE THATS AN ERROR
ADD TF,T1 ;POINT TO THE END OF THE MESSAGE
FNDBL1: LOAD S2,ARG.HD(S1),AR.TYP ;GET THIS BLOCK TYPE
CAMN S2,P2 ;IS IT THE BLOCK HE WANTS ???
JRST [MOVE T1,S1 ;YES, MOVE ADDRESS TO RETURN AC
$RETT] ;AND RETURN GOOD
LOAD S2,ARG.HD(S1),AR.LEN ;NO,,GET THIS BLOCKS LENGTH
ADD S1,S2 ;POINT TO THE NEXT BLOCK
CAIG TF,0(S1) ;ARE WE STILL IN THE MESSAGE ???
$RETF ;NO,,RETURN BLOCK NOT FOUND
SOJG P1,FNDBL1 ;CONTINUE TILL DONE
$RETF ;NOT FOUND
SUBTTL ACTVER - GENERAL DEFINITIONS FOR ACCOUNT VALIDATION MODULE
;ACCOUNT VALIDATION MODULE DEFINITIONS
PPN: BLOCK 1 ;PPN TO BE VALIDATED
PRJCHN: BLOCK 1 ;LH=CHANNEL # FOR PROJCT.SYS, RH=0
PRJBLK: BLOCK 10 ;FILOP. BLOCK FOR PROJCT.SYS
PROJCT: BLOCK 36 ;LOOKUP BLOCK
PRJBUF: BLOCK PRJWPB ;BUFFER FOR READING PROJCT.SYS IN DUMP MODE
IOLIST: BLOCK 2 ;I/O LIST FOR READING PROJCT.SYS
Z.DATE: BLOCK 1 ;CREATION DATE/TIME OF PROJCT.SYS WHICH TABLE WAS BUILT FOR
Z.TADR: BLOCK 1 ;ADDRESS OF FIRST WORD OF TABLE IN LOW SEGMENT
Z.TLEN: BLOCK 1 ;LENGTH OF TABLE LAST READ (IN WORDS)
BLKNUM: BLOCK 1 ;LOCATION TO SAVE LAST BLOCK NUMBER READ FROM PROJCT.SYS
LSTBLK: BLOCK 1 ;BLOCK NUMBER OF LAST BLOCK WHERE ENTRIES ARE FOUND IN PROJCT.SYS
PRJIOW: BLOCK 1 ;NEGATIVE WORDS PER LOGICAL DISK BLOCK IN PROJCT.SYS
PRJMUL: BLOCK 1 ;MULTIPLIER FOR LOGICAL TO REAL DISK BLOCKS
PRJCON: BLOCK 1 ;CONSTANT FOR COMPUTING PHYS BLOCK FROM LOGICAL BLOCK
PRJVRS: BLOCK 1 ;VERSION NUMBER OF PROJCT.SYS WE ARE READING
ACKCOD: BLOCK 1 ;ACKNOWLEDGMENT CODE USED BY THE REQUESTOR
SUBTTL ACTVER - FORMAT OF PROJCT.SYS
BLKOFS==1 ;OFFSET INTO THE BLOCK WHERE THE FIRST ENTRY IS
PPNOFS==1 ;OFFSET INTO THE ENTRY WHERE PPN CAN BE FOUND
CNTOFS==2 ;OFFSET FROM THE PPN WHERE THE CHARACTER COUNT OF THE
; ACCOUNT STRING CAN BE FOUND
ACTOFS==3 ;OFFSET FROM THE PPN WHERE THE ACCOUNT STRING CAN BE FOUND
;FOLLOWING IS THE FORMAT OF THE FIRST BLOCK OF PROJCT.SYS. THIS BLOCK
; CONTAINS FILE AND DATA INFORMATION. THIS TOTAL BLOCK HAS BEEN
; RESERVED SPECIFICALLY FOR THIS PURPOSE.
A.VERS==0 ;(0) VERSION # OF FORMAT. MUST AGREE WITH ACVERS
A.TLEN==1 ;(1) LENGTH OF TABLE IN STORED IN PROJCT.SYS
A.FBLK==2 ;(2) BLOCK NUMBER OF TABLE IN FILE
A.WPBL==3 ;(3) NUMBER OF WORDS PER LOGICAL DISK BLOCK (PRJWPB)
;***************************************************************
; This is the format of the first block of PROJCT.SYS
;***************************************************************
; !=======================================================!
; ! Version # of PROJCT.SYS format !
; !-------------------------------------------------------!
; ! Length of table stored in PROJCT.SYS !
; !-------------------------------------------------------!
; ! Block number of table in PROJCT.SYS !
; !-------------------------------------------------------!
; ! Number of words per logical disk block !
; !=======================================================!
;***************************************************************
; End of the first block of PROJCT.SYS
;***************************************************************
;***************************************************************
; Format of table pointed to by third word of first block
;***************************************************************
; !=======================================================!
; ! First PPN found in first data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !-------------------------------------------------------!
; ! First PPN found in second data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !-------------------------------------------------------!
; \ \
; \ \
; \ \
; !-------------------------------------------------------!
; ! First PPN found in last data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !=======================================================!
;***************************************************************
; End of table format
;***************************************************************
;***************************************************************
; Format of a block of data pointed to by entries in the table
;***************************************************************
; !=======================================================!
; ! Number of words used in this block !
; !=======================================================!
; ! Length of PPN entry ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; \ \
; !-------------------------------------------------------!
; ! 0 ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !=======================================================!
; ! Length of PPN entry ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !-------------------------------------------------------!
; ! 0 ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !=======================================================!
;***************************************************************
; End of format of a block of data
;***************************************************************
SUBTTL ACTVER - MAIN VALIDATION ROUTINE
ACTVER: $CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,UV$PPN(T2) ;GET THE PPN TO BE VALIDATED
MOVEM T1,PPN ;SAVE IT FOR LATER
JUMPG T1,ACTVCM ;IS IT A LEGAL PPN?
PUSHJ P,ERROR2 ;NO.
JUMPF ACTVE1 ;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTVCM: MOVE T1,STATE2 ;GET THE SECOND STATES WORD
TXNN T1,ST%ACV ;IS VALIDATION REQUIRED?
JRST ACTVE1 ;NO. GIVE A SUCCESSFUL RETURN
MOVE T2,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.FG(T2) ;FLAGS OF THE MESSAGE
TXNE T1,IP.CFP ;HAS THE SENDER SET THE PRIV BIT?
JRST ACTVE5 ;YES. ASSUME HE'S TRYING TO BREAK THE SYSTEM
MOVE T1,MDB.PV(T2) ;GET THE SENDER'S CPABILITIES
TXNE T1,MD.PWH!MD.POP ;IS THE SENDER J.ACCT'D OR A SYSTEM OPERATOR?
JRST ACTVE4 ;YES. ALLOW ALL KINDS OF VALIDATION
MOVE T1,MDB.SD(T2) ;GET THE SENDER'S PPN
CAMN T1,PPN ;DOES HE WANT TO VALIDATE FOR HIMSELF?
JRST ACTVE4 ;YES. ALLOW ONLY THAT
ACTVE5: PUSHJ P,ERROR3 ;UNPRIVILEGED USER CANNOT VALIDATE FOR OTHER PPNS
JUMPF ACTVE8 ;[153]
ACTVE4: MOVE T1,DATADR ;GET ADDRESS OF DATA
ADDI T1,UV$ACT ;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
LDB T1,[POINT 7,(T1),6] ;GET THE FIRST CHARACTER OF ACCOUNT
JUMPN T1,ACTVE6 ;ALWAYS VALIDATE A NON-NULL ACCOUNT
PUSHJ P,CHKDEF ;SEE IF DEFAULT EXISTS FOR NULL ACCOUNT, THIS PPN
JUMPT ACTVE1 ;THERE IS, MUST BE VALID, RETURN IT TO CALLER
PUSHJ P,CHKACT ;NO DEFAULT, IS VALIDATION REQUIRED?
JUMPF ACTVE1 ;NOT REQUIRED
ACTVE6: PUSHJ P,CHKPRJ ;VALIDATE THE ACCOUNT
SKIPF ;[153]
ACTVE1: SKIPA T3,[UGTRU$] ;[153] GET SUCCESS CODE
ACTVE8: MOVEI T3,UGFAL$ ;[153] GET FAILURE CODE
SKIPE QUEFLG ;WAS THIS FROM A QUEUE. UUO?
JRST [JUMPF ACTVXT
MOVE T1,VALBLK+UV$TYP ;WHAT DOES HE WANT BACK?
CAIN T1,UGVRP$ ;USER PROFILE?
SKIPA T1,[-2] ;YES, "ERROR" -2, MOVE USER PROFILE
SETO T1, ;GET A -1 (NOT REALLY AN ERROR NUMBER)
AOSN MVBFLG ;MOVE WHOLE VALIDATION BLOCK?
MOVNI T1,3 ;YES
PUSHJ P,ERRQUE ;GENERATE NEGATIVE "ERROR"
JRST ACTVXT] ;RELEASE OLD MSG AND SEND QUEUE UUO RESPONSE
MOVE T2,SABADR ;[153] GET MESSAGE PAGE ADDRESS
MOVEM T3,UC$RES(T2) ;[153] SAVE VALIDATION RESPONSE
MOVE S1,DATADR ;GET DATA ADDRESS
MOVEI T1,UGVUP$ ;GET VALIDATE ACCOUNT AND RETURN PROFILE CODE
CAME T1,UV$TYP(S1) ;WAS IT?
JRST ACTVE3 ;[153] NO
MOVEI T1,UGFAL$ ;[153] YES, ASSUME CANNOT GET PROFILE
MOVEM T1,UC$PRF(T2) ;[153]
MOVE T1,PPN ;YES, GET PPN
PUSHJ P,GETPRO ;FETCH PROFILE
JUMPF ACTVE3 ;[153]
MOVEI T1,UGTRU$ ;[153] GET SUCCESS CODE
MOVEM T1,UC$PRF(T2) ;[153] SAY THERE'S A PROFILE
MOVEI T1,UC$PRO(T2) ;GET TARGET ADDRESS
HRLI T1,ACOPRO ;GET START OF PROFILE
BLT T1,UC$PRE(T2) ;COPY PROFILE
ACTVE3: CAIE T3,UGTRU$ ;[153] ACCOUNT VALIDATION SUCCESSFUL?
JRST ACTVXT ;[153] NO
MOVE T1,DATADR ;INCOMING MESSAGE
HRLI T1,UV$ACT(T1) ;ORIGINAL (OR MODIFIED) ACCOUNT STRING
HRRI T1,UC$ACT(T2) ;THE RESPONSE FIELD OF THE IPCF MESSAGE
BLT T1,UC$ACE(T2) ;RETURN IT TO THE SENDER
CAIA ;DONE
ACTVXX::PUSHJ P,UPDDSK ;PASWORD WAS (NOT) VALIDATED, SAVE DATE/TIME
ACTVXT::SKIPE QUEFLG ;WAS THIS FROM A QUEUE. UUO?
JRST [PUSHJ P,FIXQUE ;YES, BUILD THE REST OF THE MESSAGE
JRST ACTVE7] ;RELEASE MESSAGE AND SEND RESPONSE
MOVE T2,SABADR ;GET THE PAGE ADDRESS WE WANT TO SEND
MOVEI T1,UGVAC$ ;GET THE MESSAGE TYPE
MOVEM T1,UC$TYP(T2)
MOVE T1,ACKCOD ;GET THE ACK CODE
MOVEM T1,UC$ACK(T2) ;STORE IT FOR THE REQUESTOR
ACTVE7: SKIPN SABFLG ;STILL NEED TO RELEASE THE MESSAGE?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
;HERE TO SEND RESPONSE POINTED TO BY SABADR TO THE USER OR THE MONITOR
RSPSAB: MOVE T1,MDBADR ;GET THE ADDRESS OF THE MDB
MOVE T1,MDB.SP(T1) ;GET THE PID OF THE SENDER
MOVEM T1,IPS.BL+SAB.PD;STORE IT IN THE SEND ARGUMENT BLOCK
MOVEI T1,1000 ;MAXIMUM LENGTH OF MESSAGE
MOVEM T1,IPS.BL+SAB.LN
MOVE T1,SABADR ;ADDRESS OF DATA
MOVEM T1,IPS.BL+SAB.MS
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE
JUMPT .POPJ ;RETURN IF SEND WENT OK
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
MOVE S1,SABADR ;ADDRESS OF PAGE TO RETURN TO POOL
$CALL M%RPAG ;RETURN THE PAGE
$RETT
;SUBROUTINE TO MAKE THE MESSAGE POINTED TO BY SABADR INTO A QUEUE. UUO RESPONSE
FIXQUE: MOVE T2,SABADR ;GET ADDRESS OF MESSAGE TO SEND
LOAD T1,.MSTYP(T2),MS.CNT ;GET THE CURRENT WORD COUNT
ADDI T1,.OHDRS ;ADD IN THE MESSAGE HEADER LENGTH
STORE T1,.MSTYP(T2),MS.CNT
MOVEI T1,.OMTXT ;MESSAGE TYPE TO RESPOND TO QUEUE. UUO
STORE T1,.MSTYP(T2),MS.TYP
MOVE T3,MMSADR ;ADDRESS OF MESSAGE QUEUE. UUO SEND US
MOVE T3,.MSCOD(T3) ;GET THE ACK CODE SEND TO US
MOVEM T3,.MSCOD(T2) ;MAKE SURE THE RIGHT USER GETS IT
$RETT
;ROUTINE TO UPDATE DISK WITH RECORD IN ACOPRO TO INDICATE THAT
;PASSWORD VALIDATION DID (NOT) SUCCEED. BE SURE WE GET HERE ONLY
;IF BUFFER IS VALID, ELSE RMS WILL HAPPILY REPLACE THE CURRENT REC...
UPDDSK: MOVEI S1,ACOPRO ;POINT AT THE PROFILE
PUSHJ P,UPDA## ;UPDATE FILE "A"
$RET ;NOT MUCH WE CAN DO
ACTACC: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
JUMPF [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTACA ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL--SEND RESPONSE
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;SAVE IN PPN PLACE
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,ACOPPN ;GET THE PPN TO BE VALIDATED
MOVEM T1,UV$PPN(T2) ;STORE IT HERE
MOVEM T1,PPN ;SAVE IT FOR LATER
JUMPG T1,ACTAC1 ;IS IT A LEGAL PPN?
ACTACA: PUSHJ P,ERROR2 ;NO.
JUMPF ACTVXT ;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTAC1: MOVEI T1,ACOPRO ;POINT TO PROFILE
MOVE S1,ACOTYP ;GET TYPE OF CHECK TO MAKE
CAIN S1,UG.SPV ;SPRINT TYPE CHECK?
SKIPA T2,[AE.PRB] ;SPRINT, GET PASSWORD FOR BATCH BIT
MOVX T2,AE.PRT ;NORMAL, GET PASSWORD FOR TS BIT
TDNN T2,.AEREQ(T1) ;SEE IF PASSWORD IS REQUIRED
PJRST ACTVCM ;NO, SKIP THIS, GO CHECK ACCOUNT STRING
MOVEI S1,ACOPSW ;POINT TO THE PASSWORD
MOVE S2,T1 ;POINT TO BUFFER
$CALL CHKPSW## ;CHECK THE PASSWORD
MOVEI S1,ACOPRO ;POINT TO THIS PROFILE
PUSHJ P,FIXVLD ;UPDATE VALIDATION STATUS
; JUMPT ACTVCM ;PASSWORD MATCHES, CHECK ACCOUNT STRING
JUMPT [PUSHJ P,UPDDSK;UPDATE DISK RECORD
JRST ACTVCM] ;DONE
ILLPSW: MOVEI T1,ACPSW% ;CALL WITH PROPER ERROR CODE
PUSHJ P,LOGUSR ;LOG INITIAL USER STUFF
$TEXT (LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
PUSHJ P,FAIOUT ;FORCE BUFFERS OUT
MOVE S1,ACOPRO+.AEPPN ;GET PPN
FATAL (PSW,<Invalid password for ^U/S1/>,ACPSW%,ACTVXX)
SUBTTL PROCESSOR FOR "OBTAIN USER PROFILE" QUEUE. FUNCTION
ACTOUP: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
ACTOU0: MOVEM S2,ACOPTR ;SAVE POINTER TO WILDCARD BLOCK
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;STASH WHERE WE CAN FIND IT
JUMPF [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTOU1 ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL-SEND RESPONSE
PUSHJ P,CHKOWN ;IS OWNER REQUESTING PROFILE?
JUMPT ACTOU2 ;JUMP IF WE FOUND THE PPN
ACTOU1: MOVE T1,ACOPTR ;GET ADDRESS OF WILDCARD BLOCK
MOVE T2,[POINT 8,ACOACK] ;AND TO ACK TEXT
PUSHJ P,A$WACK## ;GENERATE A WILDCARD ACK
MOVE T1,ACOPTR ;GET ADDR AGAIN
MOVE T2,[POINT 8,ACOACK] ;BYTE POINTER TO ACK TEXT
SKIPE UW$FND(T1) ;WAS AT LEAST ONE PROFILE FOUND?
FATAL (NAU,<No additional users matching ^Q/T2/>,ACNAU%,ACTVXT)
MOVEI T3,[ASCIZ /found/]
HLRZ T4,ACOWLD+UW$FND ;GET COUNT OF PROFILES FOUND
PUSHJ P,A$SWLD## ;GENERATE SUMMARY TEXT
FATAL (NUS,<^T/(S1)/>,ACNUS%,ACTVXT)
ACTOU2: MOVEI S2,ACOPRO ;SET UP POINTER TO PROFILE BLOCK
MOVX S1,AE.LOK ;GET FILE IS LOCKED BIT
SKIPE ACTLCK## ;IS FILE LOCKED?
IORM S1,ACOPRO+.AEFLG ;YES, LITE IN PROFILE
MOVEI S1,ACOPRO ;GET ADDRESS OF PROFILE
PUSHJ P,A$FSCD## ;GET SCHEDULAR CLASSES FROM SCDMAP
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,ACOPPN ;GET PPN WE WERE ASKED FOR
MOVEM T1,UV$PPN(T2) ;STASH HERE
MOVEM T1,PPN ;SAVE IT FOR LATER
MOVNI T1,2 ;GET A -2 (NOT REALLY AN ERROR NUMBER)
PUSHJ P,ERRPRO ;GENERATE "ERROR" -2 (MOVE ACTDAE.SYS ENTRY)
PJRST ACTVXT ;FINISH RESPONSE TO QUEUE. AND RETURN
; CONVERT OLD-STYLE "GET PROFILE" CALL TO NEW-STYLE WILDCARD CALL
CVTWLD: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,ACOWLD ;POINT TO INTERNAL WILDCARD BLOCK
MOVSI S1,0(P1) ;START ADDRESS
HRRI S1,1(P1) ;MAKE A BLT POINTER
SETZM (P1) ;CLEAR FIRST WORD
BLT S1,UW$MIN-1(P1) ;CLEAR ENTIRE BLOCK
MOVSI S1,UW$MIN ;LENGTH
MOVEM S1,UW$TYP(P1) ;SAVE
MOVE S1,ACOTYP ;GET TYPE FIELD
MOVE S2,ACOUXP ;FIND OUT WHAT WE WERE GIVE
CAIN S2,.UGUSR ;USER NAME?
JRST CVTWL3 ;YES
; PPN
CVTWL1: SETZM UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO PPN
CAIE S1,UG.NXT ;WANT NEXT PROFILE?
SKIPA S1,ACOPPN ;PPN
TDZA S1,S1 ;WILD PPN
SKIPA S2,[EXP -1] ;NON-WILD MASK
TDZA S2,S2 ;WILD MASK
TDZA P2,P2 ;NON-WILD PREVIOUS RESULT
MOVE P2,ACOPPN ;WILD PREVIOUS RESULT
JUMPE P2,CVTWL2 ;ONWARD IF STARTING FROM FIRST PPN IN FILE
TRNN P2,-1 ;ELSE HAVE A PROGRAMMER NUMBER?
SOS P2 ;NO--BACK OFF ONE
CVTWL2: MOVEM S1,UW$PPN(P1) ;SAVE TARGET PPN
MOVEM S2,UW$PPM(P1) ;SAVE MASK
MOVEM P2,UW$BRE(P1) ;SAVE PREVIOUS RESULT
JRST CVTWL5 ;FINISH UP
; NAME
CVTWL3: MOVSI S2,ACOUSR ;POINT TO NAME
CAIN S1,UG.NXT ;WANT NEXT?
JRST CVTWL4 ;YES
HRRI S2,UW$NAM(P1) ;POINT TO STORAGE
BLT S2,UW$NAM+.AANLW-1(P1) ;COPY
MOVEI S2,2 ;CODE
MOVEM S2,UW$WST(P1) ;SET WILDCARD SEARCH TYPE NON-WILD NAME
JRST CVTWL5 ;FINISH UP
CVTWL4: HRRI S2,UW$BRE(P1) ;POINT TO STORAGE
BLT S2,UW$BRE+.AANLW-1(P1) ;COPY
MOVSI S2,(BYTE(8)"*",0) ;FAKING WILDCARD
MOVEM S2,UW$NAM(P1) ;SAVE IN MESSAGE
MOVEI S2,1 ;CODE
MOVEM S2,UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO WILD NAME
CVTWL5: MOVE S2,P1 ;RETURN ADDRESS OF WILDCARD BLOCK
POPJ P, ;RETURN
WLDACK: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,[POINT 8,ACOWLD+UW$NAM] ;POINT TO NAME
MOVE P2,[POINT 8,ACOACK] ;POINT TO ACK BLOCK
MOVEI P3,.AANLC ;NUMBER OF CHARACTERS
WLDAC1: ILDB S1,P1 ;GET A CHARACTER
IDPB S1,P2 ;PUT A CHARACTER
SKIPE S1 ;DONE?
SOJG P3,WLDAC1 ;LOOP IF MORE CHARACTERS
POPJ P, ;RETURN
;ACTCUP - Change a user profile
;Call
; ACOPRV/ Non-zero if invoking privs
;Return
; RETF Unprived or other problem
; RETT Change made
ACTCUP: $CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
SKIPE ACTLCK## ;IS THE FILE LOCKED?
FATAL (AFL,<Accounting file is locked>,ACAFL%,ACTVXT)
MOVE T1,MMSADR ;BASE MESSAGE ADDRESS
PUSHJ P,GETBLK ;MAKE SURE WE HAVE A FIRST BLOCK
JUMPF CUP.EF ;FORMAT ERROR IF NOT
SOS T3 ;YES, POINT TO BASE OF BLOCK
AOS T1,QUECNT ;AND GET TOTAL COUNT OF BLOCKS
MOVEM T1,CUPCNT ;STORE FOR TRANSACTION PROCESSING
MOVEM T3,CUPLIS ;REMEMBER START OF LIST
MOVEM T3,QUEBLK ;AND RESTORE IT FOR PREPROCESSING
MOVEI T1,UGCUP$ ;FUNCTION BEING PERFORMED
PUSHJ P,PREVAL ;PRESET THE VALIDATION BLOCK
SETZM CUPMEM ;ADDITIONAL DYNAMIC MEMORY
MOVE S1,[CUPMEM,,CUPMEM+1]
BLT S1,CUPZND ;CLEAR IT OUT
MOVSI S1,UW$DAT ;LENGTH OF WILD BLOCK WITH NO SELECTIONS
MOVEM S1,CUPWLD ;INIT TO NO SELECT BLOCKS
$FALL CUP.1 ;OK, ENTER PARSE LOOP ON NEXT PAGE
CUP.1: PUSHJ P,GETBLF ;GET BLOCK, SEPARATING TYPE & FLAGS
JUMPF CUP.3 ;TIME TO PROCESS AT END OF LIST
CAIL T1,.AEMIN ;IN RANGE?
JRST CUP.EF ;FORMAT ERROR IF NOT
TXNN S2,AF.SEL ;DOING ANY SELECTION WITH THIS BLOCK?
JRST CUP.2 ;NO, CHECK MODIFIERS
LOAD S1,S2,AF.SEL ;YES, GET THE TYPE CODE
TXNN S2,AF.DEF ;MUST BE TESTING THE VALUE
CAIE S1,.AFAND ;VIA AN 'AND' SELECT
JRST CUP.10 ;NO TO EITHER, JUST STORE THE BLOCK
CAIE T1,.AEPPN ;SELECTING ON THE PPN?
JRST CUP.11 ;NO, KEEP LOOKING
CAIL T2,1 ;YES, IS THE BLOCK
CAILE T2,2 ; OF A VALID LENGTH?
JRST CUP.EF ;NO, COMPLAIN OF FORMAT ERROR
SKIPE CUPPPN ;HAVE WE ALREADY SEEN A PPN BLOCK?
JRST CUP.EF ;YES, COMPLAIN OF FORMAT ERROR
MOVEI S1,-1(T3) ;GET BASE ADDRESS OF BLOCK
MOVEM S1,CUPPPN ;STORE FOR PROFILE FETCHING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.11: CAIE T1,.AENAM ;SELECTING ON USERNAME?
CAIN T1,.AENAM+1 ;OR FORCED NON-WILD?
CAIA ;YES, CHECK IT
JRST CUP.12 ;NO, KEEP LOOKING
SKIPE CUPNAM ;HAVE WE SEEN A NAME ALREADY?
JRST CUP.EF ;YES, COMPLAIN OF FORMAT ERROR
MOVEI S1,-1(T3) ;POINT TO BASE ADDRESS
MOVEM S1,CUPNAM ;SAVE FOR LATER
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.12: CAIE T1,.AEPSW ;SELECTING ON PASSWORD?
JRST CUP.10 ;NO, JUST ADD TO SELECT BLOCK
SKIPE CUPPWD ;YES, IS THIS A DUPLICATE?
JRST CUP.EF ;FORMAT ERROR IF SO
MOVEI S1,-1(T3) ;POINT TO BASE ADDRESS
MOVEM S1,CUPPWD ;SAVE FOR ACCESS CHECKING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.10: MOVEI T1,-1(T3) ;POINT TO BASE ADDRESS OF BLOCK
AOS T2 ;AND MAKE LENGTH REFLECT REALITY
PUSHJ P,CUP.S1 ;INSERT INTO SELECTION LIST OF WILDCARD BLOCK
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.SL: LDB T2,[POINT 9,(T1),17] ;GET BLOCK LENGTH
HRRZ S2,(T1) ;AND FLAGS
CUP.S1: TXNE S2,AF.DEF ;IF SELECTING BASED ON .AEMAP,
MOVEI T2,1 ;FORGET THE VALUE
SKIPN S1,CUPSEL ;IS THIS FIRST INSERTION TO THE BLOCK?
MOVEI S1,CUPWLD+UW$DAT ;YES, POINT TO START OF SELECTION DATA
HRLI S1,(T1) ;MAKE TRANSFER WORD
HRRZ S2,S1 ;COPY DESTINATION POINTER
ADD S2,T2 ;POINT ONE BEYOND DESTINATION BLOCK
MOVEM S2,CUPSEL ;SAVE FOR NEXT TIME
BLT S1,-1(S2) ;MOVE THE DATA
AOS CUPWLD+UW$SEL ;UPDATE THE COUNT OF SELECTION BLOCKS
CAIN T2,1 ;IF SELECTING ON .AEMAP,
DPB T2,[POINT 9,-1(S2),17] ;UPDATE BLOCK LENGTH IN LIST
SUBI S2,CUPWLD ;GET CURRENT LENGTH OF WILDCARD BLOCK
HRLM S2,CUPWLD ;SET LENGTH IN HEADER FOR ACTRMS
POPJ P, ;RETURN
CUP.2: CAIE T1,.AEDEF ;WANT TO CHANGE THE DEFAULT PPN?
JRST CUP.21 ;NO, KEEP LOOKING
CAIL T2,1 ;DEMAND ONE WORD
CAIL T2,3 ;AND NOT MORE THAN TWO,
JRST CUP.EF ;ELSE IS FORMAT ERROR
TXNE S2,AF.DEF ;AND NOT BEING DEFAULTED
JRST CUP.EF ;ELSE IS FORMAT ERROR
MOVE S1,(T3) ;GET VALUE
MOVEM S1,CUPDEF ;SAVE FOR LATER
JRST CUP.1 ;EXAMINE ALL MESSAGE BLOCKS
CUP.21: CAIE T1,.AEPPN ;WANT TO CHANGE THE PPN?
JRST CUP.22 ;NO, KEEP LOOKING
TXNE S2,AF.DEF ;CAN'T SET PPN TO DEFAULT
JRST CUP.EF ;COMPLAIN OF FORMAT ERROR
CAIN T2,1 ;MUST BE JUST ONE DATA WORD
SKIPE CUPPPM ;SECOND PPN BLOCK FOUND?
JRST CUP.EF ;ALSO A FORMAT ERROR
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPPPM ;REMEMBER PPN BEING MODIFIED
MOVE S1,(T3) ;GET PPN BEING SET
SKIPGE S1,(T3) ;GET PPN BEING SET
JRST CUP.EI ;INVALID IF NOT POSITIVE
JRST CUP.1 ;ELSE LET IT THROUGH
CUP.22: CAIE T1,.AENAM ;WANT TO CHANGE THE NAME?
JRST CUP.23 ;NO, KEEP LOOKING
SKIPN CUPNMM ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;CAN'T SET NAME TO DEFAULT
JRST CUP.EF ;FORMAT ERROR IF TRIED
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPNMM ;SAVE NAME MODIFIER BLOCK
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.23: CAIE T1,.AEPSW ;CHANGING THE PASSWORD?
JRST CUP.24 ;NO, KEEP LOOKING
SKIPN CUPPWM ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;CAN'T SET TO DEFAULT
JRST CUP.EF ;FORMAT ERROR EITHER WAY
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPPWM ;SAVE PASSWORD MODIFIER ADDRESS
HRLI T3,(POINT 8) ;MAKE BYTE POINTER TO SUPPLIED PASSWORD
IMULI T2,.APWCW ;CHARACTER COUNT
CAILE T2,.APWLC ;TOO MANY?
MOVEI T2,.APWLC ;TRUNCATE
MOVE T1,[POINT 8,CUPPWB] ;PLACE TO STORE THE PASSWORD
PUSHJ P,CUPSTR ;MOVE THE STRING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.24: CAIE T1,.AEVRS ;CHANGING THE VERSION NUMBER?
JRST CUP.20 ;NO, JUST VALIDATE
SKIPN CUPVRS ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;AND NOT DEFAULTED
JRST CUP.EF ;OR IS FORMAT ERROR
CAIE T2,2 ;MUST HAVE EXACTLY TWO DATA WORDS
JRST CUP.EF ;FORMAT ERROR OTHERWISE
MOVX S1,AE.VRS ;VERSION MASK
CAME S1,1(T3) ;MAKE SURE RIGHT FIELD IS MODIFIED
JRST CUP.EF ;FORMAT ERROR IF NOT
LOAD S1,(T3),AE.VRS ;GET VALUE TO SET
CAIE S1,%AECVN ;IS IT IN PHASE WITH OURS?
FATAL (WFV,<Wrong format version specified>,ACWFV%,ACTVXT)
SETOM CUPVRS ;WE GOT THE VERSION WORD
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.20: MOVE S1,CHGTAB##(T1) ;GET CONTROL BITS
SKIPN ACOPRV ;PRIVED?
TXNE S1,PD.UNP ;NO, DO WE NEED TO BE?
CAIA ;NO, SKIP ON
JRST CUP.E3 ;YES, GIVE PRIVILEGE ERROR
TXNE S1,PD.NMD ;IS IT LEGAL TO MODIFY THIS FIELD AT ALL?
FATAL (FNM,<Value at offset ^O/T1/ is not modifiable>,ACFNM%,ACTVXT)
TXNE S1,PD.CND ;CAN IT BE DEFAULTED?
TXNN S2,AF.DEF ;NO, ARE WE ATTEMPTING IT?
AOSA CUPMFC ;NO, COUNT ANOTHER FIELD TO MODIFY
FATAL (FND,<Value at offset ^O/T1/ is not defaultable>,ACFND%,ACTVXT)
LOAD T4,S1,PD.WRD ;GET MAXIMUM BLOCK LENGTH
TXNE S1,PD.MSK ;IF MASKABLE,
AOS T4 ;ALLOW ANOTHER
CAILE T2,(T4) ;IS THE SUPPLIED BLOCK TOO LONG?
JRST CUP.EF ;YES, GIVE A FORMAT ERROR
TXNN S2,AF.DEF ;UNLESS DEFAULTING,
JUMPE T2,CUP.EF ;REQUIRE SOME DATA
JRST CUP.1 ;OK, PARSE REST OF MESSAGE
CUP.3: SKIPN CUPVRS ;DID WE GET A VALID VERSION CHANGE WORD?
JRST CUP.EF ;FORMAT ERROR IF NOT
SKIPN T1,CUPPPM ;ARE WE TRYING TO CHANGE THE PPN?
JRST CUP.31 ;NO, DON'T WORRY ABOUT IT
SKIPN ACOPRV ;MUST BE PRIVED FOR THESE OPERATIONS
JRST CUP.E3 ;ERROR IF NOT
SKIPN 1(T1) ;MODIFYING IT TO ZERO?
JRST [SETOM CUPDEL ;YES, THAT'S HOW WE DELETE THINGS
JRST CUP.31] ;CHECK OTHER FIELDS
SKIPN CUPWLD+UW$SEL ;NO, ADDING, MUST HAVE NO SELECT BLOCKS
SKIPE CUPPPN ;OF ANY KIND
JRST CUP.EF ;FORMAT ERROR IF SO
SKIPN CUPNAM ;CHECK OTHER SELECT BLOCKS
SKIPE CUPPWD ;FOR ABSENCE
JRST CUP.EF ;FORMAT ERROR IF PRESENT
JRST CUP.AE ;ALL IS COPASETIC, GO ADD AN ENTRY
CUP.31: SKIPN CUPNAM ;WANT TO SELECT BY NAME?
JRST CUP.33 ;NO, SKIP NAME STUFF, CHECK FOR PPN
SKIPE T1,CUPPPN ;YES, WAS A PPN BLOCK ALSO GIVEN?
PUSHJ P,CUP.SL ;YES, ADD IT TO THE SELECTION DATA
SETZM CUPPPN ;MAKE SURE IT DOESN'T CONFUSE US IN THE FUTURE
MOVE T1,CUPNAM ;GET NAME SELECTION BLOCK
MOVE S1,(T1) ;GET OVERHEAD WORD
ANDI S1,AF.OFS ;KEEP .AENAM OR .AENAM+1
SUBI S1,.AENAM-1 ;MAKE 1 OR 2
MOVEM S1,CUPWLD+UW$WST ;SETUP WILDCARD SEARCH TYPE
MOVE T2,[POINT 8,1(T1)] ;POINT TO SUPPLIED NAME
MOVE T3,[POINT 8,CUPWLD+UW$NAM] ;POINT TO NAME FIELD OF WILD BLOCK
LDB S1,[POINT 9,(T1),17] ;GET WORD LENGTH OF BLOCK
SUBI S1,1 ;OFFSET FOR OVERHEAD WORD
IMULI S1,.APWCW ;TIMES CHARACTER PER WORD
CAILE S1,.APWLC ;WITHIN CHARACTER LENGTH LIMIT?
MOVEI S1,.APWLC ;NO, TRUNCATE
MOVE T4,S1 ;KEEP INITIAL SPACE COUNT
JUMPLE S1,CUP.EF ;FORMAT ERROR IF NULL NAME
CUP.32: LDB S2,T2 ;GET A SOURCE BYTE
DPB S2,T3 ;COPY TO WILDCARD BLOCK
SKIPE S2 ;DONE IF NULL
SOJG S1,CUP.32 ;LOOP OVER ALL CHARACTERS IN MESSAGE BLOCK
SUB T4,S1 ;FIND NUMBER OF CHARACTERS TRANSFERRED
JUMPE T4,CUP.EF ;FORMAT ERROR IF NULL NAME
JRST CUP.34 ;GOT A NAME, SKIP THE PPN CHECKING
CUP.33: SKIPN T1,CUPPPN ;MUST HAVE A PPN FOR SELECTION IF NO NAME
JRST CUP.EF ;FORMAT ERROR IF NOT
LDB T2,[POINT 9,(T1),17] ;GET TOTAL BLOCK LENGTH
MOVE S1,1(T1) ;GET PPN FROM MESSAGE
CAIL T2,3 ;IF MASK WAS SUPPLIED,
SKIPA S2,2(T1) ;THEN USE IT,
SETO S2, ;ELSE ASSUME NOT WILD
DMOVEM S1,CUPWLD+UW$PPN ;SETUP TO SEARCH BASED ON PPN
$FALL CUP.34 ;CONTINUE ON NEXT PAGE
CUP.34: SKIPE ACOPRV ;DO WE HAVE PRIVS?
JRST CUP.35 ;YES, DON'T NEED TO CHECK HERE
SKIPE CUPPWM ;IF MODIFYING PASSWORD,
SKIPE CUPPWD ;MUST HAVE OLD ONE
CAIA ;OK
JRST CUP.EP ;PASSWORD ERROR
MOVEI S1,2 ;GET NON-WILD NAME FLAG
SKIPE CUPWLD+UW$WST ;DOING A NAME PARSE?
MOVEM S1,CUPWLD+UW$WST ;YES, FORCE NON-WILD
SKIPN CUPWLD+UW$WST ;SEARCHING BY NAME?
JRST CUP.35 ;YES, DONE CHECKING
SETO S1, ;NO, GET A -1
CAME S1,CUPWLD+UW$PPM ;CHECK FOR NON-WILD PPN MASK
JRST CUP.E3 ;NOT PRIVILEGED
CUP.35: SKIPN T3,CUPPWD ;DO WE HAVE A PASSWORD?
JRST CUP.4 ;NO, START MODIFYING
LDB T2,[POINT 9,(T3),17] ;YES, GET BLOCK LENGTH
SOS T2 ;WANT ONLY DATA LENGTH
IMULI T2,.APWCW ;TIMES CHARACTERS PER WORD
CAILE T2,.APWLC ;TOO MANY CHARACTERS?
MOVEI T2,.APWLC ;TRUNCATE
ADD T3,[POINT 8,1] ;SOURCE BYTE POINTER
MOVE T1,[POINT 8,ACOPSW] ;DESTINATION B.P.
PUSHJ P,CUPSTR ;COPY THE STRING
$FALL CUP.4 ;START GETTING/MODIFYING, NEXT PAGE
CUP.4: SETZM CUPCHG ;NOTHING CHANGED THIS PASS
MOVEI S1,ACOPRO ;PROFILE BLOCK
MOVEI S2,CUPWLD ;WILDCARD BLOCK
PUSHJ P,PROFIL ;FETCH THE PROFILE IN QUESTION
JUMPF CUP.6 ;MIGHT BE DONE
AOS CUPWLD+UW$FND ;UPDATE COUNT OF ENTRIES MATCHED
MOVE S1,ACOPRO+.AEPPN ;GET THIS ENTRY'S PPN
MOVEM S1,ACOPPN ;SAVE FOR VARIOUS ROUTINES
MOVEM S1,PPN ;HERE TOO (JUST IN CASE)
SKIPE CUPDEL ;SUPPOSED TO DELETE THIS ENTRY?
JRST CUP.DE ;YES, DO SO
PUSHJ P,A$CKPP## ;NO, CHECK FOR RESERVED PPN
SETCAM TF,CUPRES ;REMEMBER IF DOING A RESERVED PROFILE
SKIPN CUPPWD ;NO, DO WE WANT TO VALIDATE THE PASSWORD?
JRST CUP.41 ;NO, SKIP IT
MOVEI S1,ACOPSW ;POINT TO (OLD) PASSWORD
MOVEI S2,ACOPRO ;AND PROFILE BUFFER
PUSHJ P,CHKPSW## ;MAKE SURE ITS VALID
MOVEI S1,ACOPRO ;POINT TO PROFILE AGAIN
PUSHJ P,FIXVLD ;UPDATE VALIDATION TIME IN PROFILE
JUMPF CUP.EL ;INVALID LOGIN INFORMATION
AOS CUPCHG ;WE CHANGED SOMETHING
JRST CUP.42 ;DON'T CHECK OWNERSHIP, WE HAVE THE PASSWORD
CUP.41: MOVE S1,PPN ;WHO WE'RE TRYING TO HACK
PUSHJ P,CHKOWN ;TEST OWNERSHIP IF NOT
JUMPF CUP.EI ;ILLEGAL PPN ERROR
CUP.42: MOVE S1,CUPLIS ;GET START OF MESSAGE BLOCKS
MOVEM S1,QUEBLK ;SAVE FOR GETBLK
MOVE S1,CUPCNT ;GET BLOCK COUNT
MOVEM S1,QUECNT ;ALSO FOR GETBLK
$FALL CUP.5 ;ENTER MODIFICATION LOOP, NEXT PAGE
CUP.5: MOVE T1,MMSADR ;POINT TO MESSAGE
PUSHJ P,GETBLF ;GET BLOCK TYPE AND FLAGS
JUMPF CUP.50 ;CHECK NEED TO UPDATE AT EOM
TXNE S2,AF.SEL ;IF A SELECTION BLOCK,
JRST CUP.5 ;IGNORE IT (ALREADY CHECKED BY GETA)
CAIN T1,.AEVRS ;DOING THE VERSION?
JRST CUP.5 ;GIMME A BREAK
MOVSI T4,-CUPTLN ;SET TO EXAMINE THE CHANGE TABLE
CUP.51: HLRZ S1,CUPTAB(T4) ;SEE IF WE CARE
CAIE S1,(T1) ;IS THERE A ROUTINE TO PROCESS THIS ENTRY?
AOBJN T4,CUP.51 ;NOT YET, KEEP LOOKING
JUMPGE T4,CUP.52 ;NOT AT ALL, HANDLE NORMALLY
HRRZ T4,CUPTAB(T4) ;YES, GET ITS ADDRESS
JRST (T4) ;LET IT PROCESS THE ENTRY
CUP.52: MOVE S1,CHGTAB##(T1) ;GET CONTROL BITS
TXNE S1,PD.EXT ;EXTENSIBLE BLOCK?
JRST CUP.53 ;YES, UPDATE IT
TXNE S1,PD.MSK ;NO, MASKABLE WORD?
TXNE S2,AF.DEF ;WITH A REAL VALUE?
JRST CUP.55 ;NO, UPDATE A STATIC BLOCK
CAIG T2,1 ;IF NO MASK,
JRST CUP.55 ;TREAT LIKE STATIC BLOCK (FULLWORD CHANGE)
MOVE S1,(T3) ;GET VALUE TO SET
MOVE T4,1(T3) ;AND CHANGE MASK
AND S1,T4 ;CHANGE ONLY REQUESTED BITS
ANDCA T4,ACOPRO(T1) ;GET BITS TO PRESERVE FROM OLD VALUE
IOR S1,T4 ;MAKE NEW VALUE WORD
MOVEM S1,(T3) ;RESET THE WORD
SOS T4,T2 ;MEET EXPECTATIONS OF LATER TESTS
PJRST CUP.55 ;THEN GO HANDLE AS A STATIC BLOCK
CUP.53: LOAD T4,S2,AF.DEF ;GET DEFAULTING BIT
JUMPN T4,CUP.54 ;GO DEFAULT IT IF REQUESTED
SKIPN (T3) ;IF THE FIRST WORD IS ZERO,
CAIE T2,1 ;AND THAT'S ALL THERE IS,
CAIA ;(NO)
JRST CUP.54 ;THEN GO DELETE THE BLOCK
MOVE S1,ACOPRO(T1) ;NO, GET ITS AOBJN POINTER
ADDI S1,ACOPRO ;DE-RELATIVIZE IT
MOVN S2,T2 ;GET MINUS LENGTH OF MESSAGE BLOCK
MOVSS S2 ;IN CORRECT HALFWORD
HRRI S2,(T3) ;AOBJN POINTER TO MESSAGE DATA
PUSHJ P,CUP.CW ;COMPARE THE DATA BLOCKS
PUSHJ P,CUP.CD ;NO CHANGE, CHECK IF DEFAULTED
CAIA ;CHANGED OR DEFAULTED
JRST CUP.5 ;NO CHANGE AT ALL
MOVNS T2 ;GET MINUS LENGTH
MOVSS T2 ;IN CORRECT HALFWORD
HRRI T2,(T1) ;ALSO GET ENTRY OFFSET
MOVEI T1,ACOPRO ;POINT TO PROFILE
SETZ T4, ;CLEARING DEFAULTED BIT
PUSHJ P,A$EBLK## ;MODIFY THE PROFILE
JUMPF CUP.EE ;NO ROOM
AOS CUPCHG ;WE CHANGED SOMETHING
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.54: PUSH P,T4 ;SAVE THE DESIRED VALUE
PUSHJ P,CUP.CD ;CHECK IF DEFAULTED ALREADY
TDZA S1,S1 ;ZERO IF ALREADY DEFAULTED
MOVEI S1,1 ;ONE IF NOT DEFAULTED (BACKWARDS VALUE OF T4)
POP P,T4 ;RESTORE REQUESTED SETTING
CAIE S1,(T4) ;IF THE OLD STATUS MATCHES THE NEW,
JUMPN T4,CUP.5 ;NOTHING TO DO IF DEFAULTING
SKIPN ACOPRO(T1) ;IF VALUE IS ALREADY ZERO,
SKIPN S1 ;AND NOT DEFAULTED,
CAIA ;(NO)
JUMPE T4,CUP.5 ;THEN NOTHING TO DO IF THAT'S THE DESIRED STATE
HRROI T2,(T1) ;NO, MAKE ENTRY DESCRIPTOR
MOVEI T1,ACOPRO ;CHANGING THIS PROFILE
SETZ T3, ;GIVING NO VALUE
PUSHJ P,A$EBLK## ;DELETE OLD BLOCK (SETTING BITMAP AS DESIRED)
JUMPF CUP.EE ;NO ROOM (SHOULD NEVER HAPPEN)
AOS CUPCHG ;CHANGE HAPPENED
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.55: TXNE S2,AF.DEF ;DEFAULTING?
JRST CUP.57 ;YES, GO DEFAULT IT
PUSHJ P,CUP.CD ;SEE IF DEFAULTED
SETZ T4, ;YES, MUST CHANGE
LOAD S1,CHGTAB##(T1),PD.WRD ;NO, GET BLOCK SIZE
MOVNS S1 ;MAKE MINUS SIZE
MOVSS S1 ;IN CORRECT HALFWORD
HRRI S1,ACOPRO(T1) ;AOBJN POINTER TO CURRENT VALUE
MOVN S2,T2 ;GET MINUS MESSAGE BLOCK LENGTH
MOVSS S2 ;IN LH
HRRI S2,(T3) ;AOBJN POINTER TO MESSAGE DATA
JUMPE T4,CUP.56 ;ALWAYS CHANGE IF MUST CLEAR BIT
PUSHJ P,CUP.CW ;COMPARE WORD VALUES IN THE BLOCKS
JRST CUP.5 ;NO CHANGE HERE
CUP.56: SKIPGE S2 ;ANYTHING LEFT IN MESSAGE DATA?
SKIPA T4,(S2) ;YES, USE IT
SETZ T4, ;NO, GET A ZERO
MOVEM T4,(S1) ;UPDATE PROFILE
AOBJP S2,.+1 ;ADVANCE USER POINTER
AOBJN S1,CUP.56 ;TRANSFER WORDS TO FILL THE BLOCK
PUSHJ P,CUP.CD ;CHECK PREVIOUS STATE OF DEFAULT BIT
ANDCAM T4,ACOPRO+.AEMAP(S1) ;CLEAR IT IF IT WAS SET
AOS CUPCHG ;SOMETHING CHANGED
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.57: PUSHJ P,CUP.CD ;CHECK WHETHER DEFAULTED
JRST CUP.5 ;YES, THIS IS NO CHANGE
IORM T4,ACOPRO+.AEMAP(S1) ;NO, LIGHT THE BIT
; LOAD S1,CHGTAB##(T1),PD.WRD ;GET BLOCK LENGTH
; MOVEI S2,ACOPRO(T1) ;AND BLOCK ADDRESS
; $CALL .ZCHNK ;CLEAR THE BLOCK
AOS CUPCHG ;WE CHANGED IT
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.NM: MOVX S2,AE.NCH ;NAME-CHANGE REQUIRED BIT
TDNN S2,ACOPRO+.AEFLG ;IS IT ON?
SKIPE ACOPRV ;OR ARE WE PRIVED?
CAIA ;YES, WE'RE GOLDEN
JRST CUP.E3 ;NOPE
MOVN S2,T2 ;GET MINUS LENGTH OF USER ARG
MOVSS S2 ;IN LH
HRRI S2,(T3) ;AOBJN POINTER TO USER DATA
MOVE S1,[-.AANLW,,ACOPRO+.AENAM] ;AOBJN POINTER TO PROFILE DATA
PUSHJ P,CUP.CW ;WORD-MODE BLOCK COMPARE
JRST CUP.5 ;NO CHANGE, DON'T BOTHER ME
MOVX S1,AE.NCH ;NAME-CHANGE REQUIRED BIT
ANDCAM S1,ACOPRO+.AEFLG ;CLEAR IT NOW
AOS CUPCHG ;WE'RE CHANGING THINGS
MOVE S1,[ACOPRO+.AENAM,,ACOPRO+.AENAM+1] ;BLT XFER WORD
SETZM ACOPRO+.AENAM ;CLEAR A WORD
BLT S1,ACOPRO+.AENAM+.AANLW-1 ;START OFF WITH CLEAN BLOCK
IMULI T2,.AANCW ;GET NUMBER OF CHARACTERS (MAX.) IN BLOCK
CAILE T2,.AANLC ;BEYOND MAXIMUM CHARACTER COUNT?
MOVEI T2,.AANLC ;TRUNCATE
HRLI T3,(POINT 8) ;AND A BYTE POINTER TO THE DATA
MOVE T1,[POINT 8,ACOPRO+.AENAM] ;AND A DESTINATION POINTER
PUSHJ P,CUPSTR ;COPY THE STRING
JRST CUP.5 ;LOOP OVER ALL CHANGE BLOCKS
CUP.PW: SKIPE CUPADD ;IF ALREADY DID THIS,
JRST CUP.5 ;DON'T DO IT AGAIN
SKIPE ACOPRV ;IF PRIVED,
JRST CUP.P1 ;THEN JUST DO IT
MOVX S1,AE.PCP ;PASSWORD CHANGE PROHIBITED BIT
TDNN S1,ACOPRO+.AEREQ ;TEST IT
JRST CUP.P1 ;CLEAR, GO CHANGE IT
SKIPLE S1,ACOPRO+.AEPCT ;SKIP IF MUST CHANGE PSW NOW
$CALL I%NOW ;ELSE, GET CURRENT UDT
CAML S1,ACOPRO+.AEPCT ;HAS THE PASSWORD EXPIRED?
JUMPN S1,CUP.P1 ;CHANGE IT IF REQUIRED (DESPITE AE.PCP)
FATAL (PCP,<Password changes are prohibited for ^U/ACOPPN/>,ACPCP%,ACTVXT)
CUP.P1: SKIPE ACOPRV ;IGNORE LENGTH IF PRIVED
JRST CUP.P2 ;YES
MOVEI S1,ACOPRO ;THE PROFILE WE'RE MODIFYING
MOVEI S2,CUPPWB ;THE PROPOSED NEW PASSWORD
PUSHJ P,LENPSW## ;CHECK IT OUT
JUMPF CUP.EW ;PASSWORD LENGTH ERROR
CUP.P2: MOVX S1,AE.PCP ;CAN THE USER INITIATE PSW CHANGES?
TDNN S1,ACOPRO+.AEREQ ;TEST
JRST CUP.P3 ;YES, DON'T BOTHER TO CHECK IF SAME
REPEAT 0,<
LOAD S1,ACOPRO+.AEFLG,AE.PWE ;GET PREVIOUS ENCRYPTION ALGORITHM
CAME S1,CURALG## ;IS IT THE SAME AS WHAT WE WILL USE?
JRST CUP.P3 ;NO, DON'T CHECK FOR MATCH WITH OLD PSW
>
MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,CHKPSW## ;SEE IF THIS IS A REAL CHANGE
JUMPF CUP.P3 ;YES, JUST GO DO IT
FATAL (PMC,<Password must change>,ACPMC%,ACTVXT) ;NO
CUP.P3: MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,SETPSW## ;CHANGE THE PASSWORD PLEASE
JUMPF CUP.EA ;ENCRYPTION FAILURE?
MOVEI S1,ACOPRO ;PROFILE BUFFER
PUSHJ P,FIXPCR ;FIXUP REQUIRED PROFILE CHANGE
AOS CUPCHG ;SOMETHING CHANGED
JRST CUP.5 ;LOOP OVER ALL CHANGE ENTRIES
CUP.RQ: PUSH P,S2 ;SAVE FLAGS WORD
PUSHJ P,CUP.CD ;CHECK IF DEFAULTED
TDZA T4,T4 ;YES
MOVEI T4,1 ;OR NO
POP P,S2 ;RESTORE FLAGS
TXNN S2,AF.DEF ;SETTING TO DEFAULT?
TRCA T4,1 ;NO, CHANGE MATCH FLAG
SKIPA S1,ACODEF+.AEREQ ;YES, GET DEFAULT
SKIPA S1,(T3) ;NO, GET VALUE
MOVEI T2,1 ;YES, DEMAND A FULL-WORD CHANGE
CAIL T2,2 ;WAS A MASK GIVEN?
SKIPA T1,1(T3) ;YES, FETCH IT
SETO T1, ;NO, ASSUME FULLWORD
AND S1,T1 ;KEEP ONLY BITS TO CHANGE
ANDCA T1,ACOPRO+.AEREQ ;FETCH BITS TO LEAVE ALONE
IOR S1,T1 ;CONSTRUCT NEW WORD
CAMN S1,ACOPRO+.AEREQ ;IS THIS A CHANGE?
JUMPE T4,CUP.5 ;NO CHANGE AT ALL IF VALUES & BITS AGREE
EXCH S1,ACOPRO+.AEREQ ;YES, UPDATE, REMEMBERING OLD
XOR S1,ACOPRO+.AEREQ ;GET DIFFERENCE MASK
ANDI S1,AE.PCI ;ISOLATE CHANGES TO INTERVAL
JUMPE S1,CUP.R1 ;DON'T UPDATE PCT IF NO CHANGE HERE
MOVX S1,AE.PCI ;YES, GET FIELD MASK
AND S1,ACOPRO+.AEREQ ;GET NEW CHANGE INTERVAL
MOVSS S1 ;CORRECT FOR UDT FORMAT
ADD S1,ACOPRO+.AELPC ;GET NEW REQUIRED CHANGE TIME
CAMLE S1,ACOPRO+.AELPC ;IF USEFUL,
MOVEM S1,ACOPRO+.AEPCT ;SET IT IN THE PROFILE
CUP.R1: AOS CUPCHG ;WE MADE A CHANGE
LOAD T3,S2,AF.DEF ;GET DEFAULTING BIT
MOVEI T2,.AEREQ ;THIS IS WHAT WE CHANGED
MOVEI T1,ACOPRO ;POINT TO PROFILE
PUSHJ P,A$BMAP## ;SET THE BIT AS REQUESTED
JRST CUP.5 ;LOOP OVER ALL CHANGE BLOCKS
CUP.50: SKIPN CUPCHG ;HAS ANYTHING CHANGED?
JRST CUP.4 ;NO, JUST LOOP OVER ALL MATCHES
MOVEI S1,ACOPRO+.AENAM ;YES, POINT TO NAME (MAYBE MODIFIED)
PUSHJ P,A$CKNM## ;SEE IF IT'S RESERVED
XOR TF,CUPRES ;MAKE TRUE IFF NAME AND PPN AGREE ON RESERVATION
JUMPF CUP.EI ;WRONG STATE--SAY ILLEGAL PPN
SKIPE CUPRES ;IS PPN RESERVED?
CAMN S1,ACOPRO+.AEPPN ;YES, NAME BETTER BE FOR THIS PPN
CAIA ;IT IS
JRST CUP.EI ;WRONG. SAY ILLEGAL PPN
MOVE S1,MDBADR ;YES, GET MDB ADDRESS
SKIPE S1,MDB.SD(S1) ;GET SENDER'S PPN
MOVEM S1,ACOPRO+.AEPAP ;UPDATE PROFILE CHANGER'S PPN
$CALL I%NOW ;GET CURRENT UDT
MOVEM S1,ACOPRO+.AETIM ;SET LAST PROFILE CHANGE TIME
SKIPE CUPADD ;IS THIS AN UPDATE?
JRST CUP.A0 ;NO, FINISH UP AN INSERT INSTEAD
PUSHJ P,UPDDSK ;UPDATE THE CURRENT RECORD
JUMPF CKOPR ;RETURN FAILURES APPROPRIATELY
JRST CUP.4 ;LOOP OVER ALL MATCHING PROFILES
CUP.DE: DMOVE S1,ACOPPD ;POINT TO VANISHING USER BY PPN
SKIPE CUPWLD+UW$WST ;ARE WE SEARCHING BY PPN?
DMOVE S1,ACONMD ;NO, USE NAME DESCRIPTOR
PUSHJ P,DELA## ;DELETE FROM FILE "A"
JUMPF CKOPR ;RETURN FAILURES APPROPRIATELY
JRST CUP.4 ;LOOP OVER ALL MATCHING PROFILES
CUP.6: SKIPE S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
PJRST RMGERX ;FATAL--SEND RESPONSE
MOVEI T1,CUPWLD ;WILD BLOCK
MOVE T2,[POINT 8,ACOACK] ;WILDCARD ACK BLOCK
PUSHJ P,A$WACK## ;GENERATE THE ACK TEXT
MOVEI T1,CUPWLD ;WILD BLOCK AGAIN
MOVE T2,[POINT 8,ACOACK] ;B.P. TO ACK TEXT
MOVS T4,UW$FND(T1) ;GET XWD SUCCESS,FAILURE
MOVEI T3,[ASCIZ /modified/] ;ASSUME MODIFY DONE
SKIPE CUPDEL ;RIGHT ASSUMPTION?
MOVEI T3,[ASCIZ /deleted/] ;NO, GET RIGHT TEXT
MOVE S1,T3 ;SUMMARY ROUTINE USES WRONG AC
PUSHJ P,A$SWLD## ;GENERATE THE SUMMARY TEXT
SKIPF ;SEE IF OK
INFO (SUM,<^T/(S1)/>,ACSUM%,ACTVXT) ;RESPOND TO USER AND RETURN
FATAL (NSU,<^T/(S1)/>,ACNSU%,ACTVXT) ;GIVE ERROR TO USER
CUPTAB: .AEPSW,,CUP.PW ;NEED A ROUTINE TO MODIFY THE PASSWORD
.AENAM,,CUP.NM ;AND THE NAME
.AEREQ,,CUP.RQ ;AND THE PSW CHANGE INTERVAL
CUPTLN==.-CUPTAB ;LENGTH OF TABLE OF SPECIALS
CUP.AE: PUSHJ P,.SAVE2## ;GET SOME BREATHING ROOM
SETOM ACOPRO+.AEMAP ;START BY DEFAULTING THINGS
MOVE S1,[ACOPRO+.AEMAP,,ACOPRO+.AEMAP+1]
BLT S1,ACOPRO+.AEMAP+.AMPLW-1 ;TURN ON ALL DEFAULTING BITS
MOVEI T1,ACOPRO ;POINT TO PROFILE
SETZ T3, ;SETUP TO CLEAR SOME BITS
MOVSI P1,-.AEMIN ;HOW FAR INTO THE TABLE TO GO
MOVX P2,PD.CND ;CAN-NOT-DEFAULT BIT
CUP.A1: HRRZ T2,P1 ;COPY ENTRY OFFSET
TDNE P2,CHGTAB##(P1) ;CAN THIS ENTRY BE DEFAULTED?
PUSHJ P,A$BMAP## ;NO, FLAG IT IN THE BITMAP
AOBJN P1,CUP.A1 ;LOOP OVER PROFILE ENTRIES
MOVE S1,CUPPPM ;ADDRESS OF NEW PPN BLOCK
MOVE S1,1(S1) ;GET NEW PPN
MOVEM S1,ACOPPN ;SETUP FOR ERROR ROUTINES
MOVEM S1,PPN ;LIKEWISE
MOVEM S1,ACOPRO+.AEPPN ;AND SET IN PROFILE
MOVE S1,[%AECVN,,.AEMIN] ;CURRENT VERSION AND PROFILE SIZE
MOVEM S1,ACOPRO+.AEVRS ;INITIALIZE IN PROFILE BUFFER
MOVE S1,CUPDEF ;GET DEFAULT PPN
MOVEM S1,ACOPRO+.AEDEF ;SET FOR PRODEF
MOVEI S1,ACOPRO ;POINT TO PROFILE
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE ENTRIES
MOVE S1,PPN ;ENTRY TO BE ADDED
PUSHJ P,A$CKPP## ;GET A DEFAULT NAME
SETCAM TF,CUPRES ;REMEMBER IF IT'S A RESERVED PPN
SKIPN CUPNMM ;IF NONE WAS RECEIVED,
$TEXT (<POINT 8,ACOPRO+.AENAM,-1>,<^T/(S1)/^0>) ;DEFAULT IT
SETOM CUPADD ;REMEMBER THAT WE WANT TO ADD, NOT MODIFY
AOS CUPCHG ;WE DO WANT TO MAKE THE CALL TO ACTRMS
JRST CUP.42 ;MODIFY THE BLOCK, THEN COME BACK
CUP.A0: MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,SETPSW## ;SET THE ENCRYPTED PASSWORD IN THE BLOCK
JUMPF CUP.EA ;ENCRYPT FAILED
SKIPN CUPPWM ;WERE WE GIVEN A PASSWORD?
SETOM ACOPRO+.AEPCT ;NO, REQUIRE ONE UPON FIRST LOGIN
SKIPN CUPNMM ;WERE WE GIVEN A NAME?
SKIPE CUPRES ;OR DEFAULT NAME NOT CHANGEABLE?
JRST CUP.A2 ;YES, DON'T NEED TO CREATE ONE
MOVX S2,AE.NCH ;NO, GET NAME-CHANGE BIT
IORM S2,ACOPRO+.AEFLG ;REQUIRE A NEW NAME UPON FIRST LOGIN
CUP.A2: SKIPN CUPPWM ;WERE WE GIVEN A PASSWORD?
JRST CUP.A6 ;NO, CAN'T DO ANY OF THE FOLLOWING
MOVE S1,ACOPRO+.AETIM ;YES, GET LAST PROFILE CHANGE TIME
MOVEM S1,ACOPRO+.AELPC ;SET LAST PASSWORD CHANGE TIME
SKIPE ACOPRO+.AEPCT ;ALREADY HAVE A REQUIRED CHANGE TIME?
JRST CUP.A6 ;YES, DON'T INVENT ONE
LOAD S1,ACOPRO+.AEREQ,AE.PCI ;NO, GET CHANGE INTERVAL
JUMPE S1,CUP.A6 ;GIVE UP IF NO REQULAR CHANGES REQUIRED
MOVSS S1 ;INTERVAL IS SET, CORRECT FOR UDT FORMAT
ADD S1,ACOPRO+.AETIM ;OFFSET FROM CURRENT TIME
MOVEM S1,ACOPRO+.AEPCT ;THEN SETUP BASED ON CHANGE INTERVAL
CUP.A6:
REPEAT 0,< ;FOLLOWING CODE MIGHT BE CUTE, BUT IT'S NOT USEFUL
SKIPN ACOPRO+.AEPNM ;DO WE HAVE A PERSONAL NAME YET?
SKIPN CUPNMM ;CAN'T DO THIS IF DEFAULTED NAME
JRST CUP.A7 ;YES, DON'T DEFAULT ONE
MOVEI T1,ACOPRO ;POINT TO PROFILE
MOVEI T2,.AEPNM ;OFFSET TO TEST
SETO T3, ;CHECKING
PUSHJ P,A$BMAP## ;TEST IF DEFAULTED EMPTY
JUMPF CUP.A7 ;NO, DON'T CHANGE IT
MOVE T1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
SETZ T2, ;INIT COUNT
ILDB T3,T1 ;GET CHAR FROM NAME
SKIPE T3 ;IF NOT AT END,
AOJA T2,.-2 ;KEEP COUNTING ITS LENGTH
IDIVI T2,.AANCW ;MAKE WORD COUNT
SETCA T2, ;NEGATE AND ROUND 'UP'
LDB T3,[POINT 9,@CUPNMM,17] ;GET LENGTH OF NAME BLOCK
MOVNI T3,-1(T3) ;GET MINUS DATA LENGTH
CAMGE T2,T3 ;IN RANGE?
MOVE T2,T3 ;NO, LIMIT OURSELVES
MOVSS T2 ;GET IN RIGHT HALFWORD
HRRI T2,.AEPNM ;FIELD WE WANT TO SET
MOVE T3,CUPNMM ;POINT TO NAME BLOCK
AOS T3 ;DATA FOR FETCHING
MOVEI T1,ACOPRO ;PROFILE TO MODIFY
SETZ T4, ;NOT FROM DEFAULT PROFILE
PUSHJ P,A$EBLK## ;TRY TO GIVE THE USER A MIXED-CASE NAME
> ;END OF REPEAT 0
CUP.A7: MOVEI S1,ACOPRO ;POINT TO NEW PROFILE
PUSHJ P,PUTA## ;FINISH THE CREATE
JUMPF CKOPR ;ANALYZE FAILURE OR ACK SUCCESS
INFO (INS,<User [^O/PPN,LHMASK/,^O/PPN,RHMASK/] inserted>,ACINS%,ACTVXT)
CUP.EF: FATAL (IFM,<Illegally formatted message>,ACIFM%,ACTVXT)
CUP.E3: PUSHJ P,ERROR3 ;SET THE PRIVILEGE ERROR ACK
PJRST ACTVXT ;THEN DELIVER IT
CUP.EA: MOVE S1,CURALG## ;GET ALGORITHM INDEX
FATAL (EAF,<Encryption algorithm ^O/S1/ failed>,ACEAF%,ACTVXT)
CUP.EP: FATAL (MPR,<Missing password required>,ACMPR%,ACTVXT)
CUP.EL: SKIPE ACOPRV ;PRIVED USER?
PJRST ILLPSW ;YES, GO ADMIT TO BAD PASSWORD
MOVEI T1,ACPSW% ;NO, BUT TELL THE TRUTH IN THE ERROR FILE
PUSHJ P,LOGUSR ;LOG INITIAL USER STUFF
$TEXT (LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
PUSHJ P,FAIOUT ;FLUSH THE BUFFERS
PUSHJ P,UPDDSK ;RECORD THE VALIDATION FAILURE ON DISK
PJRST CUP.EI ;PRETEND IT WAS AN ILLEGAL PPN
CUP.EE: FATAL (PTF,<Profile is too full; user ^U/ACOPPN/>,ACPTF%,ACTVXT)
CUP.EW: FATAL (PLL,<Password length is less than ^D/S1/ characters>,ACPLL%,ACTVXT)
CUP.CW: PUSHJ P,.SAVE4## ;PRESERVE ALL ACS USED
DMOVE P3,S1 ;COPY POINTERS
CUP.C1: SKIPGE P3 ;IF STILL A BASE WORD,
SKIPA P1,(P3) ;THEN USE IT,
SETZ P1, ;ELSE FETCH ZERO
SKIPGE P4 ;SIMILARLY WITH
SKIPA P2,(P4) ;THE MESSAGE DATA
SETZ P2, ;FETCH WORD OR ZERO
CAME P1,P2 ;ARE THEY THE SAME?
JRST .POPJ1 ;NOPE, FLAG DIFFERENT
AOBJP P3,.+1 ;ADVANCE POINTER
AOBJN P4,CUP.C1 ;LOOP OVER ALL WORDS
JUMPL P3,CUP.C1 ;UNTIL BOTH POINTERS GIVE OUT
POPJ P, ;THE BLOCKS ARE THE SAME IF WE GET HERE
CUP.CD: MOVEI S1,(T1) ;COPY ENTRY OFFSET
IDIVI S1,^D36 ;GET WORD & BIT NUMBERS
MOVNS S2 ;GET SHIFT OFFSET
MOVSI T4,(1B0) ;GET BIT TO SHIFT
LSH T4,(S2) ;MAKE BIT TO TEST
TDNN T4,ACOPRO+.AEMAP(S1) ;IS THIS FIELD ALREADY DEFAULTED?
AOS (P) ;SKIP IF NOT
POPJ P, ;RETURN RESULT
CUPSTR: ILDB S1,T3 ;GET A SOURCE BYTE
JUMPE S1,.POPJ ;DONE AT END OF ASCIZ
IDPB S1,T1 ;STUFF A DESTINATION BYTE
SOJG T2,CUPSTR ;UNTIL EOS OR FULL BLOCK
POPJ P, ;THEN RETURN
CUPMEM:! ;BEGINNING OF UGCUP$-SPECIFIC STORAGE
CUPPWB: BLOCK .APWLW ;SPACE FOR A PASSWORD BLOCK
CUPWLD: BLOCK PAGSIZ ;SPACE FOR A WILDCARDING BLOCK
CUPSEL: BLOCK 1 ;CURRENT ALLOCATION OF SELECT BLOCKS
CUPADD: BLOCK 1 ;FLAG FOR CALLING PUTA RATHER THAN UPDA
CUPDEF: BLOCK 1 ;MODIFIED VALUE OF .AEDEF
CUPRES: BLOCK 1 ;FLAG FOR INSERTING RESERVED PROFILE
CUPDEL: BLOCK 1 ;FLAG FOR WHETHER ENTRY SHOULD BE DELETED
CUPPPN: BLOCK 1 ;POINTER TO SELECT BLOCK FOR PPN
CUPPPM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR PPN
CUPNAM: BLOCK 1 ;POINTER TO SELECT BLOCK FOR NAME
CUPNMM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR NAME
CUPPWD: BLOCK 1 ;POINTER TO SELECT BLOCK FOR PASSWORD
CUPPWM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR PASSWORD
CUPVRS: BLOCK 1 ;FLAG FOR WHETHER VERSION CHANGE WAS SEEN
CUPMFC: BLOCK 1 ;MODIFIABLE FIELD COUNT
CUPCHG: BLOCK 1 ;FLAG FOR WRITING OUT ACOPRO
CUPZND==.-1 ;LAST WORD TO ZERO ON UGCUP$
CUPCNT: BLOCK 1 ;MEMORY OF QUECNT
CUPLIS: BLOCK 1 ;MEMORY OF QUEBLK
CKOPR: JUMPT ACTVXT ;JUMP IF OK
MOVEI S1,3 ;IT DID NOT, SEE WHY
PUSHJ P,OPTA## ;GET STATUS OF FILE "A"
CAIN S1,ER$DUP## ;WAS THE NAME ALREADY IN USE?
JRST [MOVE S1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
FATAL (NAE,<Name already exists; ^Q/S1/>,ACNAE%,ACTVXT)]
CAIN S1,ER$RNF## ;RECORD NOT FOUND?
CUP.EI: FATAL (ILP,<Illegal PPN [^O/PPN,LHMASK/,^O/PPN,RHMASK/]>,ACILP%,ACTVXT)
PUSHJ P,RMGCH1 ;CHECK FOR FATAL RMS ERRORS
RMGERX: FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)
;CHECK FOR FATAL RMS ERRORS.
RMGCHK: $RETIT ;NO ERRORS--RETURN
MOVEI S1,3 ;
PUSHJ P,OPTA## ;GET STATUS OF FILE "A"
RMGCH1: CAIE S1,ER$BUG## ;INTERNAL ERROR?
CAIN S1,ER$UDF## ;UNDEFINED STATE?
TRNA ;YES--TELL THE OPERATOR (MAYBE)
$RETT ;NO--IGNORE IT
MOVEM S1,RMGCOD ;SAVE RMS ERROR CODE
PUSHJ P,I%NOW ;GET CURRENT UNIVERSAL DATE/TIME
SKIPN RMGUDT ;FIRST TIME THROUGH THIS CODE?
JRST RMGCH2 ;YES--SEND MESSAGE TO OPERATOR
MOVE S2,S1 ;NO--CALCULATE TIME SINCE LAST MESSAGE
SUB S2,RMGUDT ;
IMULI S2,^D24*^D3600 ;CONVERT TO SECONDS
HLRZ S2,S2 ;
CAIGE S2,RMGINT ;HAS ENOUGH TIME PASSED?
JRST RMGCH3 ;NO--DON'T BOTHER THE OPERATOR
RMGCH2: MOVEM S1,RMGUDT ;SAVE CURRENT UNIVERSAL DATE/TIME
MOVEI S1,4 ;
PUSHJ P,OPTA## ;GET FILESPEC FOR FILE "A"
$WTOXX <Fatal RMS error on ^F/(S2)/; RMS error ^OR0/RMGCOD/>
RMGCH3: MOVE S1,RMGCOD ;RESTORE RMS ERROR CODE
$RETF ;
;FIXUP REQUIRED PASSWORD CHANGE BITS
FIXPCR: $SAVE P1 ;SAVE AN AC
MOVE P1,S1 ;SAVE ADDRESS OF RECORD BUFFER
$CALL I%NOW ;GET CURRENT UDT
CAML S1,.AEPCT(P1) ;PERHAPS A REQUIRED CHANGE?
SETZM .AEPCT(P1) ;YES, CLEAR THE UT
MOVEM S1,.AELPC(P1) ;SAVE LAST PASSWORD CHANGE
LOAD S1,.AEREQ(P1),AE.PCI ;GET CHANGE INTERVAL
MOVSS S1 ;CORRECT FOR UDT FORMAT
ADD S1,.AELPC(P1) ;ADJUST CHANGE TIME BY INTERVAL
CAMLE S1,.AELPC(P1) ;IF INTERVAL IS PRESENT,
MOVEM S1,.AEPCT(P1) ;SETUP NEW REQUIRED CHANGE TIME
MOVX S1,1B<.AEPCT-<<.AEPCT/36>*36>> ;GET DEFAULT BIT
ANDCAM S1,.AEMAP+.AEPCT/^D36(P1) ;CLEAR IT, SINCE CHANGED VALUE
POPJ P,
;ROUTINE TO HANDLE SELECTION ON .AEAUX
;CALL: P1/ WILD BLOCK ADDRESS
; P2/ SELECTION BLOCK ADDRESS
; P3/ PROFILE BUFFER ADDRESS
UGAUX%::LDB T1,[POINT 9,(P2),17] ;NUMBER OF WORDS IN BLOCK
SOJLE T1,.RETF ;OFFSET FOR ONLY DATA WORDS
MOVNS T1 ;MAKE MINUS DATA LENGTH
MOVSS T1 ;IN LH FOR AOBJN
HRRI T1,1(P2) ;POINTER TO REQUESTOR'S DATA
MOVE T2,.AEAUX(P3) ;RELATIVE POINTER TO PROFILE DATA
ADDI T2,(P3) ;DE-RELATIVIZE IT
UGAUX1: MOVE T3,T2 ;GET WORKING COPY OF PROFILE POINTER
MOVE T4,.AUSTR(T1) ;AND CURRENT NAME TO MATCH
UGAUX2: CAME T4,.AUSTR(T3) ;[152] FOUND START OF SUBSTRING?
CAMN T4,[-1] ;[152] OR A WILDCARD?
JRST UGAUX3 ;YES, PROCESS THE LIST
ADD T3,[.AULEN-1,,.AULEN-1] ;UPDATE FOR MULTI-WORD ENTRIES
AOBJN T3,UGAUX2 ;KEEP LOOKING THROUGH SEARCH LIST
LOAD T1,(P2),AF.SEL ;GET SELECTION TYPE
CAIN T1,.AFNOT ;ONLY SUCCEED
AOS (P) ;IF A 'NOT' BLOCK
POPJ P, ;RETURN THE DECISION
UGAUX3: MOVE T4,T1 ;COPY SEARCH POINTER
UGAUX4: MOVE T2,(T4) ;GET NEXT SEARCH WORD
CAMN T2,[-1] ;IS IT A DON'T CARE?
JRST UGAUX5 ;YES, IT SUCCEEDS
SKIPL T3 ;[152] IF NO MORE IN PROFILE,
TDZA T1,T1 ;[152] ZERO-FILL
MOVE T1,(T3) ;NO, FETCH WORD FROM PROFILE
PUSHJ P,CMPINS## ;CHECK FOR MATCH
POPJ P, ;PROPAGATE FAILURE
UGAUX5: AOBJP T4,.POPJ1 ;SUCCEED IF END OF MATCH LIST
AOBJN T3,UGAUX4 ;KEEP SEARCHING
JRST UGAUX4 ;[152] EVEN IF PROFILE IS SHORT
ACTPSW: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
JUMPF [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTACA ;NOT FATAL--NO SUCH USERS
PJRST RMGERX] ;FATAL--SEND RESPONSE
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;SAVE IN PPN PLACE
ACTPS0: MOVEI S1,ACOPSW ;POINT AT THE PASSWORD
MOVEI S2,ACOPRO ;RECORD HE WANTS TO CHECK
$CALL CHKPSW## ;CHECK THE PASSWORD, PLEASE
MOVEI S1,ACOPRO ;POINT TO THIS PROFILE
PUSHJ P,FIXVLD ;UPDATE VALIDATION STATUS
JUMPT ACTPS1 ;IT'S GOOD, CONTINUE
PJRST ILLPSW ;REPORT INVALID PASSWORD AND RETURN
ACTPS1: JRST ACTVXX ;AND RETURN
SUBTTL LOCK/UNLOCK USER ACCOUNT FILE
ACTLOK: TDZA S1,S1 ;INDICATE ENTRY
ACTUNL: SETOM S1
SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
PJRST IGNORE ;WASN'T, RELEASE THE MESSAGE
MOVE T1,S1 ;SAVE ENTRY INDICATOR
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
JUMPL T1,UNLOCK ;JUMP IF UNLOCK FUNCTION
SKIPN ACTLCK## ;ALREADY LOCKED?
JRST LOCK ;NO, GO DO IT
FATAL (FAL,<File already locked>,ACFAL%,ACTVXT)
LOCK: PUSHJ P,CLSA## ;CLOSE FILE "A"
JUMPF LOCK.1 ;CHECK FOR ERRORS
MOVEI S1,ACCTFN ;GET ADDRESS OF FILENAME FOR RMS
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNA## ;OPEN FILE "A" FOR INPUT
JUMPF LOCK.1 ;CAN'T GO OPEN REGULAR (TRY ANYWAY)
SETOM ACTLCK## ;FLAG FILE IS LOCKED
PJRST ACTVXT ;RETURN
LOCK.1: MOVEI S1,3 ;OPTION CODE
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
PUSH P,S1 ;SAVE ERROR CODE
MOVEI S1,ACCTFN ;GET FILENAME ADDRESS
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
JUMPT LOCK.2 ;GO COMPLAIN ABOUT PREVIOUS ERROR
MOVEI S1,3 ;UNLESS THIS FAILS TOO--GET OPTION CODE
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
MOVEM S1,(P) ;SAVE
LOCK.2: POP P,S1 ;GET RMS ERROR CODE BACK
FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)
UNLOCK: SKIPN ACTLCK## ;FILE LOCKED?
FATAL (FNL,<File not locked>,ACFNL%,ACTVXT)
PUSHJ P,CLSA## ;CLOSE FILE "A"
JUMPF UNLO.2 ;CHECK FOR ERRORS
MOVEI S1,ACCTFN ;GET FILENAME ADDRESS
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
JUMPF UNLO.2
SETZM ACTLCK## ;FLAG FILE IS NOW UNLOCKED
PJRST ACTVXT ;RETURN
UNLO.2: MOVEI S1,3 ;IT DID NOT, SEE WHY
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)
ACTSCD: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
PJRST IGNORE ;WASN'T, RELEASE THE MESSAGE
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,A$DSCD## ;DELETE SCDMAP.SYS DATA
SKIPF
PUSHJ P,A$ISCD## ;INITIALIZE CLASS SCHEDULER MAPPING
JUMPT ACTVXT ;JUMP IF OK
FATAL (SMF,<Class scheduler mapping failed>,ACSMF%,ACTVXT)
;ROUTINE TO UPDATE VALIDATION TIME AND FAILURE BIT
FIXVLD: $SAVE P1 ;FOR THE BUFFER ADDRESS
MOVE P1,S1 ;SAVE WHAT WE'RE UPDATING
SKIPF ;SKIP IF FAILED
SKIPA S2,[ANDCAM S1,.AEFLG(P1)] ;GET INSTR TO CLEAR AE.FAI
MOVE S2,[IORM S1,.AEFLG(P1)] ;GET INSTR TO SET AE.FAI
PUSH P,TF ;SAVE STATUS ON STACK
MOVX S1,AE.FAI ;GET FAILURE TIME VALID BIT
XCT S2 ;DO THE DESIRED OPERATION
$CALL I%NOW ;GET CURRENT UDT
MOVEM S1,.AEFAI(P1) ;SAVE IT ALSO
POP P,TF ;RESTORE STATUS
$RET
SUBTTL ACTMAP - PERFORM USER PPN/NAME MAPPING
ACTMAP: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,MAPLGL ;CHECK FOR A LEGAL MESSAGE FORMAT
JUMPF ACTVXT ;ACK USER ON ERRORS
ACTMA1: PUSHJ P,MAPWLD ;BUILD WILDCARD BLOCK
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
MOVEI S2,(P2) ;POINT TO WILDCARD BLOCK
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
JUMPF [PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
JUMPT ACTMA4 ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL-SEND RESPONSE
MOVE T1,ACOPRO+.AEPPN ;GET PPN
MOVEM T1,TMPMAP+UU$PPN ;SAVE
MOVE T1,[ACOPRO+.AENAM,,TMPMAP+UU$NAM] ;SET UP BLT
BLT T1,TMPMAP+UU$LEN-1 ;SAVE NAME IN TEMPORARY STORAGE
SKIPE T1,UW$WST(P2) ;A PPN?
CAIN T1,2 ;OR NON-WILD NAME?
JRST ACTMA3 ;YES--NO AMBIGUITY EXISTS
MOVEI T1,TMPMAP+UU$NAM ;POINTER TO RETURNED NAME
HRLI T1,(POINT 8) ;FOR LOADING
SETZ T2, ;TO COUNT CHARACTERS
ACTMA2: ILDB T3,T1 ;GET NEXT CHARACTER
SKIPE T3 ;STOP AT END OF NAME
AOJA T2,ACTMA2 ;LOOP OVER ALL CHARACTERS
CAMN T2,TMPLEN ;NAMES OF THE SAME LENGTH?
JRST ACTMA3 ;YES, THEY ARE IDENTICAL (EXCEPT FOR CASE?)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
MOVEI S2,(P2) ;POINT TO WILDCARD BLOCK
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
JUMPT ACTMA4 ;JUMP IF AMBIGUOUS NAME GIVEN
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
JUMPF RMGERX ;FATAL ERROR--SEND RESPONSE
ACTMA3: MOVSI T1,TMPMAP ;POINT TO TEMPORARY STORAGE
HRRI T1,(P1) ;AND TO DESTINATION
BLT T1,UU$LEN-1(P1) ;COPY
ACTMA4: ADDI P1,UU$LEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,ACTMA1 ;ONTO THE NEXT MAPPING BLOCK
MOVNI T1,4 ;GET A -4 (NOT REALLY AN ERROR NUMBER)
PUSHJ P,ERRPRO ;GENERATE "ERROR" -4 (MOVE MAPPING INFO)
PJRST ACTVXT ;FINISH RESPONSE TO QUEUE. AND RETURN
; CHECK FOR LEGAL MAPPING MESSAGE FORMAT
MAPLGL: MOVE P1,MMSADR ;POINT TO MESSAGE
MOVEI T3,(P1) ;INCASE IPCF MESSAGE
MOVE T1,UU$ACK(P1) ;GET THE ACK CODE
MOVEM T1,ACKCOD ;SAVE
SKIPN QUEFLG ;QUEUE UUO?
JRST MAPLG2 ;NO
SETZM QUEBLK ;RESET POINTER TO SCAN FROM BEGINING
MOVE T1,MMSADR ;POINT TO MESSAGE
MAPLG1: PUSHJ P,GETBLK ;GET A BLOCK
SKIPT ;CHECK FOR ERRORS
FATAL (PEM,<Premature end of mapping message block>,ACPEM%,.RETF)
CAIE T1,.QBAET ;START OF INTERESTING DATA?
JRST MAPLG1 ;NOT YET
MAPLG2: MOVEI P1,UU$MAP(T3) ;POINT TO START OF ACTUAL DATA
MOVEM P1,ACOMAP ;SAVE ADDRESS
SKIPN T1,UU$CNT(T3) ;GET COUNT OF MAPPING BLOCKS
FATAL (MBZ,<Mapping block count is zero>,ACMBZ%,.RETF)
MOVEM T1,TMPCNT ;SAVE FOR ERRMAP
MOVNS T1 ;NEGATE
HRL P1,T1 ;MAKE AN AOBJN POINTER
MOVE P2,P1 ;COPY MESSAGE POINTER
MAPLG3: HRRZ T1,P2 ;GET CURRENT MAPPING BLOCK ADDRESS
SUB T1,ACOMAP ;COMPUTE OFFSET INTO MESSAGE
IDIVI T1,UU$LEN ;GET BLOCK NUMBER
SKIPN UU$PPN(P2) ;HAVE A PPN?
SKIPE UU$NAM(P2) ;OR A NAME?
SKIPA ;YES TO EITHER
FATAL (MBF,<Mapping block format error; block = ^D/T1/>,ACMBF%,.RETF)
ADDI P2,UU$LEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,MAPLG3 ;CHECK THE NEXT BLOCK
$RETT ;RETURN
; BUILD WILDCARD MESSAGE
MAPWLD: MOVEI P2,ACOWLD ;POINT TO INTERNAL WILDCARD BLOCK
MOVSI T1,0(P2) ;START ADDRESS
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,UW$MIN-1(P2) ;CLEAR ENTIRE BLOCK
MOVSI T1,UW$MIN ;LENGTH
HRRI T1,UGWLD$ ;FUNCTION CODE
MOVEM T1,UW$TYP(P2) ;SAVE
SKIPN T1,UU$PPN(P1) ;HAVE A PPN?
JRST MAPWL1 ;NO--A NAME
MOVEM T1,UW$PPN(P2) ;SAVE IN WILDCARD BLOCK
SETOM UW$PPM(P2) ;NON-WILD MASK
POPJ P, ;RETURN
MAPWL1: MOVEI T1,UU$NAM(P1) ;POINT TO NAME
HRLI T1,(POINT 8,) ;8-BIT ASCIZ
MOVEI T2,UW$NAM(P2) ;POINT TO STORAGE
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
MOVSI T3,-.AANLC ;LENGTH IN CHARACTERS
MAPWL2: ILDB T4,T1 ;GET A CHARACTER
JUMPE T4,MAPWL4 ;DONE?
IDPB T4,T2 ;PUT A CHARACTER
TRZE T3,1B19 ;WAS PREVIOUS CHARACTER A QUOTE?
JRST MAPWL3 ;YES, DON'T DAMAGE THIS ONE
CAIE T4,"*" ;NO, CHECK FOR WILDCARD
CAIN T4,"?" ;OF EITHER TYPE
TRO T3,1B18 ;YES, REMEMBER IT
CAIE T4,.CHCNV ;OR IS IT THE MAGIC QUOTE CHARACTER?
JRST MAPWL3 ;NO, DON'T FUDGE FOR IT
TRO T3,1B19!1B20 ;YES, FLAG FOR NEXT TIME AROUND
SOS T3 ;DON'T COUNT CHARACTER AGAINST MATCH LENGTH
MAPWL3: AOBJN T3,MAPWL2 ;LOOP
MOVEI T1,2 ;CODE
MOVEM T1,UW$WST(P2) ;SET WILDCARD SEARCH TYPE TO NON-WILD NAME
POPJ P, ;RETURN
MAPWL4: TRZ T3,1B20 ;JUST IN CASE IT'S STILL ON
HRRZM T3,TMPLEN ;SAVE LENGTH OF NAME
MOVEI T4,"*" ;MAKE A WILD NAME
IDPB T4,T2 ;STORE CHARACTER
MOVEI T1,1 ;CODE
MOVEM T1,UW$WST(P2) ;SET WILDCARD SEARCH TYPE TO WILD NAME
POPJ P, ;RETURN
SUBTTL ACTWLD - GET PROFILE FOR POSSIBLY WILDCARDED PPN/NAME
ACTWLD: PUSHJ P,M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
MOVE S2,MMSADR ;POINT TO MESSAGE
SKIPN QUEFLG ;FROM A QUEUE. UUO?
PJRST ACTOU0 ;NO CONVERSION NECESSARY
SETZM QUEBLK ;RESET POINTER TO SCAN FROM BEGINING
MOVE T1,MMSADR ;POINT TO MESSAGE
ACTWL1: PUSHJ P,GETBLK ;GET A BLOCK
JUMPF ACTWL2 ;CHECK FOR PREMATURE END OF MESSAGE
CAIE T1,.QBAET ;START OF INTERESTING DATA?
JRST ACTWL1 ;NOT YET
MOVE S2,T3 ;POINT TO DATA
PJRST ACTOU0 ;GO ENTER COMMON CODE
ACTWL2: FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,ACILP%,ACTVXT)
SUBTTL ACTVER - COMMON SUBROUTINES
;CHKPRJ - ROUTINE TO VERIFY ACCOUNT IN PROJCT.SYS.
;CALL: PUSHJ P,CHKPRJ
; RETURN HERE - NO FATAL ERRORS DETECTED
CHKPRJ: PUSHJ P,CHKCOM ;DO COMMON STUFF TO GET POSITIONED
JUMPF .POPJ ;WHOOPS, SOME ERROR TO RETURN TO THE USER
PJRST VERIFY ;DO VALIDATION
;CHKDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
;CALL: PUSHJ P,CHKDEF
; RETURN HERE - NO FATAL ERROR DETECTED
CHKDEF: PUSHJ P,CHKCOM ;DO COMMON STUFF TO GET POSITIONED
JUMPF .POPJ ;WHOOPS, SAY NO DEFAULT EXISTS
PJRST FNDDEF ;GO FIND DEFAULT AND RETURN
;CHKCOM - PERFORM COMMON POSITIONING FOR CHKPRJ AND CHKDEF
CHKCOM: PUSHJ P,PRJRED ;LOOKUP PROJCT.SYS
JUMPF .POPJ ;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
PUSHJ P,BLDPRJ ;SEE IF WE NEED TO BUILD THE TABLE
JUMPF .POPJ ;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
PJRST SEARCH ;SEARCH PROJCT.SYS FOR BLOCK CONTAINING PPN
;CHKACT - ROUTINE TO LOOK IN ACTDAE.SYS.
; AND SEE IF THE USER IS REQUIRED TO HAVE AN ACCOUNT WHEN A NULL ACCOUNT
; HAS BEEN GIVEN IN THE IPCF MESSAGE. IF HE IS, GIVE HIM AN INVALID
; ACCOUNT ERROR MESSAGE.
;CALL: PUSHJ P,CHKACT
; RETURN HERE
CHKACT: MOVE T1,PPN ;GET PPN
PUSHJ P,GETPRO ;DO COMMON STUFF TO FIND PPN IN ACTDAE.SYS
JUMPF .RETT ;ASSUME ACCOUNT STRING IS NOT REQUIRED
MOVE T1,.AEREQ(T1) ;GET USER'S REQUIREMENT WORD
TXNE T1,AE.ACT ;IS AN ACCOUNT REQUIRED FOR THIS PPN?
$RETT ;YES--MUST VALIDATE
$RETF ;NO VALIDATION NECESSARY
INVPPN: SKIPA S2,.AEPPN(T1) ;GET PPN FROM PROFILE
INVACC: MOVE S2,PPN ;GET PPN FROM LOW CORE
PUSH P,S2 ;SAVE PPN
PUSH P,T1 ;SAVE CALLER'S AC
MOVEI T1,ACIVA% ;INVALID ACCOUNT STRING ERROR
PUSHJ P,LOGUSR ;LOG THE ERROR
POP P,T1 ;RESTORE AC
$TEXT (LOGFAI,<^O6R0/PPN,LHMASK/^O6R0/PPN,RHMASK/>) ;DEPENDENT INFO
PUSHJ P,FAIOUT ;WRITE OUT TO THE FAILURE LOG
POP P,S2 ;GET PPN BACK
MOVE S1,DATADR ;GET ADDRESS OF DATA
ADDI S1,UV$ACT ;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
FATAL (IVA,<Invalid account "^T/(S1)/" for ^U/S2/>,ACIVA%,.RETF)
;BLDPRJ - ROUTINE TO SEE IF PROJCT.SYS HAS DATA AND TO DETERMINE IF
; THE IN-CORE TABLE NEEDS TO BE REBUILT. IF NOT, JUST RETURN.
; OTHERWISE, REBUILD TABLE AND RETURN.
;CALL: PUSHJ P,BLDPRJ
; RETURN HERE ALWAYS. IF THERE'S AN ERROR, JRST TO AN ERROR ROUTINE
BLDPRJ: SKIPN T1,PROJCT+.RBSIZ ;IS THERE DATA IN PROJCT.SYS?
$BOMB <ACTNDA No data in PROJCT.SYS -- cannot validate>
MOVE T1,PROJCT+.RBTIM ;GET THE CREATION DATE
EXCH T1,Z.DATE ;STORE NEW, GET OLD
CAMN T1,Z.DATE ;HAS IT CHANGED?
$RETT ;NO, WE HAVE THE CURRENT FILE IN-CORE
SETZM BLKNUM ;FORCE READ OF DISK
MOVNI T1,200 ;SET LENGTH = 200 WORDS
MOVEM T1,PRJIOW ;FOR INITIAL READ OF INFORMATION BLOCK
MOVEI T1,1 ;READ THE FILE/DATA INFORMATION BLOCK
MOVEM T1,PRJMUL ;SET LOG TO PHYS MULTIPLIER TO 1 ALSO
MOVEM T1,PRJCON ;CONSTANT TOO SO THAT LOGICAL 1 = PHYSICAL 1
PUSHJ P,READ
SKIPT
$BOMB <ACTUXE Unexpected EOF in PROJCT.SYS when reading first block>
MOVE T1,PRJBUF+A.VERS ;CHECK THE VERSION NUMBER
CAIE T1,1 ;WE SPEAK VERSION 1
CAIN T1,2 ;AND VERSION 2 FORMATS
CAIA ;ONE OF THE ABOVE
$BOMB <ACTVSP Version skew of PROJCT.SYS>
MOVEM T1,PRJVRS ;SAVE FOR LATER CHECKS
MOVEI T2,2 ;CONSTANT = 2 FOR BLOCK CONVERSION
CAIN T1,1 ;UNLESS VERSION 1 FORMAT
MOVEI T2,1 ;THEN CONSTANT = 1
MOVEM T2,PRJCON ;STORE FOR LATER COMPUTATION
SKIPN T1,PRJBUF+A.WPBL ;GET WHAT PROJCT.EXE THINKS IS PRJWPB
MOVEI T1,200 ;OLD PROJCT.SYS WAS WRITTEN AT 200 WORDS PER
CAILE T1,PRJWPB ;ALWAYS OK IF WE KNOW ABOUT LARGER FORMATS
$BOMB <ACTPTS PRJWPB too small for whats in PROJCT.SYS>
MOVNM T1,PRJIOW ;SAVE - WORD COUNT FOR READING BLOCKS
LSH T1,-7 ;CONVERT TO REAL DISK BLOCKS PER LOGICAL ONE
MOVEM T1,PRJMUL ;SAVE MULTIPLIER FOR LOG TO PHYS CONVERSION
;FALL INTO BUILD TABLE ROUTINE
BLDPR1: SKIPN T1,PRJBUF+A.TLEN ;GET LENGTH OF TABLE
$RETT ;NULL TABLE, ASSUME [*,*]=*
CAMG T1,Z.TLEN ;IS THE TABLE LARGER THAN BEFORE?
JRST [MOVEM T1,Z.TLEN
JRST BLDPR3] ;NO. DON'T NEED MORE CORE. STORE LENGTH
SKIPN S2,Z.TADR ;HAVE WE BUILT THE TABLE BEFORE?
JRST BLDPR2 ;NO. JRST BUILD IT
MOVE S1,Z.TLEN ;THE SIZE OF CORE BLOCK TO GIVE UP
$CALL M%RMEM ;GET RID OF THE OLD TABLE
BLDPR2: MOVEM T1,Z.TLEN ;STORE LENGTH OF NEW TABLE
MOVE S1,T1 ;LENGTH OF NEW TABLE
$CALL M%GMEM ;GET ENOUGH CORE TO FIT THE NEW TABLE
MOVEM S2,Z.TADR ;SAVE THE BEGINNING ADDRESS
BLDPR3: MOVE T1,PRJBUF+A.FBLK ;GET BLOCK NUMBER NUMBER OF THE TABLE
SUBI T1,1 ;BACK OFF TO PREVIOUS BLOCK
MOVEM T1,LSTBLK ;AND STORE AS LAST BLOCK CONTAINING DATA
MOVE T1,Z.TADR ;READ TABLE INTO LOW SEGMENT
SUBI T1,1
MOVN T2,Z.TLEN
HRL T1,T2
MOVEM T1,IOLIST ;SET UP COMMAND LIST FOR READING TABLE
SETZM IOLIST+1
MOVE T1,PRJBUF+A.FBLK ;GET THE BLOCK # OF THE TABLE
SUB T1,PRJCON ;COMPUTE READ DISK BLOCK NUMBER
IMULI T1,@PRJMUL ;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
ADD T1,PRJCON ;...
MOVE T2,PRJCHN ;AND THE CHANNEL (STORED IN LH(PRJCHN))
PUSHJ P,AUSETI ;POSITION TO THE BLOCK #
SKIPT
$BOMB <ACTCUJ Cannot USETI to PROJCT.SYS block containing index table>
MOVEI T1,.FOINP ;INPUT
HLL T1,PRJCHN ;CHANNEL #
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO SYS:
MOVEM T1,PRJBLK+.FOFNC
MOVEI T1,IOLIST ;I/O LIST
MOVEM T1,PRJBLK+.FOIOS
MOVE T1,[2,,PRJBLK]
FILOP. T1,
SKIPA ;ERROR
$RETT ;RETURN OK
TXNE T1,IO.EOF ;IS AN END OF FILE?
$RETF ;YES.
$BOMB <ACTRFI Cannot read (^O/T1/) file information block of PROJCT.SYS>
;SEARCH - SEARCH THE TABLE FOR THE GIVEN PPN, READ IT IN
;CALL: PUSHJ P,SEARCH
; ONLY RETURN. IF ERROR, JRST TO THE ERROR ROUTINE
SEARCH: MOVE T4,PPN ;GET THE PPN TO VALIDATE FOR
MOVE T2,Z.TLEN ;GET LENGTH OF TABLE
MOVE T3,Z.TADR ;INITIALIZE ADDRESS
HLRZ T1,1(T3) ;GET POSSIBLE BLOCK NUMBER FOR ENTRY
CAMLE T4,(T3) ;IS IT IN THE FIRST BLOCK
SEARC1: CAMN T4,(T3) ;SAME AS FIRST PPN IN BLOCK
JRST SEARC2 ;GO SEARCH THIS BLOCK
CAMG T4,(T3) ;IS IT IN PREVIOUS BLOCK
SOJA T1,SEARC2 ;YES, GO SEARCH THAT BLOCK
ADDI T3,2 ;DOUBLE WORD ENTRIES
HLRZ T1,1(T3) ;GET BLOCK NUMBER FOR THIS ENTRY
SOS T2 ;BACK OFF THE LENGTH OF THE TABLE
SOJG T2,SEARC1 ;AND LOOK SOME MORE
MOVE T1,LSTBLK ;IF NOT FOUND, MUST BE IN THE LAST BLOCK
SEARC2: PUSHJ P,READ ;READ IT IN
JUMPT .POPJ
$BOMB <ACTUEP Unexpected EOF in PROJCT.SYS when searching for ^P/PPN/>
;VERIFY - ROUTINE TO VALIDATE IF THE GIVEN PPN CAN USE THE GIVEN
; ACCOUNT STRING
;CALL: PUSHJ P,VERIFY
; ONLY RETURN. IF AN ERROR, JRST TO ERROR ROUTINE
VERIFY: PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
MOVE S1,DATADR ;GET ADDRES OF THE VALIDATION MESSAGE
MOVEI S1,UV$ACT(S1) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
PUSHJ P,SYNCHK ;CHECK FOR AN ACCOUNT STRING SYNONYM IF ANY
IFN FTCASECONVERT,< ;IF CONVERTING LOWER TO UPPER
MOVE T1,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI T1,UV$ACT(T1) ;OFFSET INTO MESSAGE FOR ACCOUNT STRNG
HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
MOVEI T2,.AACLC ;NUMBER OF CHARACTERS IN ACCOUNT STRING
VERIF0: ILDB T3,T1 ;GET A CHARACTER
JUMPE T3,VERIF1 ;QUIT AT END OF STRING
CAIG T3,"Z"+" " ;CHECK IF LOWER CASE LETTER
CAIGE T3,"A"+" " ;...
JRST VERIF5 ;NOT LOWER CASE LETTER
SUBI T3," " ;CONVERT TO UPPER CASE
DPB T3,T1 ;STORE BACK IN ACCOUNT STRING
VERIF5: SOJG T2,VERIF0 ;CONTINUE FOR ALL CHARACTERS
>
VERIF1: MOVE P1,PPN ;GET THE PPN WE'RE VEIFYING FOR AGAIN
XOR P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
AND P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
JUMPE P1,VERIF2 ;HAVE WE FOUND A MATCH?
HLRZ T1,PRJBUF(P2) ;SET UP TO LOOK AT NEXT PPN ENTRY BY
ADD P2,T1 ; GETTING RIGHT OFFSET INTO THE BLOCK
CAMGE P2,PRJBUF ;ARE THERE ANY MORE ENTRIES?
JRST VERIF1 ;YES. KEEP SEARCHING
PUSHJ P,READNX ;READ NEXT BLOCK LOOKING FOR WILD CARDING
SKIPT ;CHECK FOR ERRORS
FATAL (NAP,<No defined account string for ^U/PPN/>,ACNAP%,.RETF)
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
JRST VERIF1 ;GO TRY TO FIND ANOTHER MATCH
VERIF2: MOVE P3,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI P3,UV$ACT(P3) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
HRLI P3,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
HLRZ T1,PRJBUF+PPNOFS+CNTOFS(P2) ;GET THE CHARACTER COUNT OF ACCOUNT
MOVNS T1
MOVE T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
VERIF3: ILDB T3,T2 ;GET A CHARACTER IN THE ENTRY ACCOUNT
ILDB T4,P3 ;GET A CHARACTER IN THE ARGUMENT ACCOUNT
CAIN T3,"*" ;WILDCARD THE REST OF THE USERS ACCOUNT STRING
$RETT ;YES, DECLARE IT VALID
CAIN T3,"?" ;WILDCARD THIS CHARACTER
MOVE T3,T4 ;YES, INSURE A MATCH
CAME T3,T4 ;DO THEY MATCH?
JRST VERIF4 ;NO. PROCEED TO NEXT ENTRY
AOJN T1,VERIF3 ;YES. CONTINUE COMPARING THE ACCOUNTS
ILDB T4,P3 ;GET THE NEXT CHARACTER OF THE ARGUMENT. IT
JUMPE T4,.RETT ; MUST BE NULL TO BE VALID
VERIF4: MOVE P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
HRRZ T1,PRJBUF(P2) ;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
ADD P2,T1 ;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
CAMGE P2,PRJBUF ;DOES IT EXIST?
JRST VERIF6 ;YES, SEE IF STILL WITHIN SAME PPN
MOVE T1,PRJVRS ;GET VERSION OF PROJCT.SYS
CAIN T1,1 ;THIS VERSION 1
JRST INVACC ;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
PUSHJ P,READNX ;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
JUMPF INVACC ;NO NEXT BLOCK, ACCOUNT STRING NOT FOUND
MOVEI P2,BLKOFS ;RESTART AT BEGINNING OF NEW DATA BLOCK
VERIF6: CAMN P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
PJRST VERIF2 ;YES. COMPARE THE NEXT ACCOUNT STRING
JRST INVACC ;NO. VALIDATION ERROR
;FNDDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
; FOR THE REQUESTED PPN. ALREADY KNOW THAT SPECIFIED STRING WAS NULL.
;CALL: PUSHJ P,FNDDEF
; RETURN TRUE WITH UV$ACT FILLED IN WITH THE DEFAULT
; RETURN FALSE IF NO DEFAULT FOUND
FNDDEF: PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
FNDEF1: MOVE P1,PPN ;GET THE PPN WE'RE VEIFYING FOR AGAIN
XOR P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
AND P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
JUMPE P1,FNDEF2 ;HAVE WE FOUND A MATCH?
HLRZ T1,PRJBUF(P2) ;SET UP TO LOOK AT NEXT PPN ENTRY BY
ADD P2,T1 ; GETTING RIGHT OFFSET INTO THE BLOCK
CAMGE P2,PRJBUF ;ARE THERE ANY MORE ENTRIES?
JRST FNDEF1 ;YES. KEEP SEARCHING
PUSHJ P,READNX ;READ NEXT BLOCK (IF ANY) LOOKING FOR WILD CARDING
JUMPF .POPJ ;EOF. PPN DOESN'T EXIST IN PROJCT.SYS
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
JRST FNDEF1 ;GO TRY TO FIND ANOTHER MATCH
FNDEF2: MOVE T1,PRJBUF+PPNOFS+CNTOFS(P2) ;FETCH CHR COUNT AND FLAGS
TRNN T1,1B35 ;THIS THE DEFAULT
JRST FNDEF4 ;NO, TRY ANOTHER
HLRZS T1 ;ISOLATE STRING LENGTH
MOVE P3,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI P3,UV$ACT(P3) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
HRLI P3,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
MOVE T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
SETZM (P3) ;I KNOW IT IS A NULL ACCOUNT BUT...
HRLI T3,(P3) ;ZERO RECEIVING AREA ANYWAY
HRRI T3,1(P3) ;...
BLT T3,7(P3) ;...
ILDB T3,T2 ;MOVE DEFAULT ACCOUNT STRING TO RETURN BLOCK
IDPB T3,P3 ;...
SOJG T1,.-2 ;...
$RETT ;GIVE GOOD RETURN
FNDEF4: MOVE P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
HRRZ T1,PRJBUF(P2) ;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
ADD P2,T1 ;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
CAMGE P2,PRJBUF ;DOES IT EXIST?
JRST FNDEF5 ;YES, SEE IF STILL WITHIN SAME PPN
MOVE T1,PRJVRS ;GET VERSION OF PROJCT.SYS
CAIN T1,1 ;THIS VERSION 1
$RETF ;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
PUSHJ P,READNX ;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
JUMPF .POPJ ;NO NEXT BLOCK, DEFAULT NOT FOUND
MOVEI P2,BLKOFS ;RESTART AT BEGINNING OF NEW DATA BLOCK
FNDEF5: CAMN P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
PJRST FNDEF2 ;YES. COMPARE THE NEXT ACCOUNT STRING
$RETF ;NO DEFAULT EXISTS
;SUBROUTINE TO READ THE NEXT BLOCK OF PROJCT.SYS.
;CALL: PUSHJ P,READNX
; RETURN FALSE IF NO NEXT BLOCK
; RETURN TRUE IF WITH BLOCK IN PRJBUF
READNX: MOVE T1,BLKNUM ;GET BLOCK NUMBER WE ARE LOOKING AT NOW
ADDI T1,1 ;DOES THE NEXT BLOCK OF THE FILE CONTAIN
CAMLE T1,LSTBLK ; DATA?
$RETF ;NO. THE PPN DOESN'T EXIST IN PROJCT.SYS
;FALL INTO READ ROUTINE
;READ - ROUTINE TO READ IN A SPECIFIED BLOCK OF PROJCT.SYS.
;CALL: MOVE T1,BLOCK #
; PUSHJ P,READ
; ERROR RETURN. EOF REACHED. IF OTHER ERROR JRST TO ERROR ROUTINE.
; GOOD RETURN
READ: CAMN T1,BLKNUM ;ALREADY HAVE THIS BLOCK IN CORE
$RETT ;YES, GOOD RETURN, AVOID DISK ACTIVITY
MOVEM T1,BLKNUM ;SAVE THE BLOCK NUMBER WE ARE GOING TO READ IN
SUB T1,PRJCON ;COMPUTE READ DISK BLOCK NUMBER
IMULI T1,@PRJMUL ;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
ADD T1,PRJCON ;...
MOVE T2,PRJCHN
PUSHJ P,AUSETI ;POSITION TO BLOCK IN T1
SKIPT
$BOMB <ACTCUB Could not USETI to a block in PROJCT.SYS>
MOVEI T1,.FOINP ;INPUT
HLL T1,PRJCHN ;GET THE CHANNEL
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO SYS:
MOVEM T1,PRJBLK+.FOFNC
MOVEI T1,IOLIST ;I/O LIST
MOVEM T1,PRJBLK+.FOIOS
HRL T1,PRJIOW ;GET - NUMBER OF WORDS TO READ
HRRI T1,PRJBUF-1 ;FORM REST OF IOWD
MOVEM T1,IOLIST ;SET UP THE LIST
SETZM IOLIST+1
MOVE T1,[2,,PRJBLK]
FILOP. T1,
SKIPA ;ERROR
$RETT
TXNN T1,IO.EOF ;IS IT AND END OF FILE?
$BOMB <ACTRBP Cannot READ (^O/T1/) PROJCT.SYS>
SETZM BLKNUM ;DON'T WANT TO KEEP BAD DATA AROUND
$RETF ;INDICATE EOF.
;GETPRO - ROUTINE TO FIND A PPN'S ENTRY IN ACTDAE.SYS
;CALL: MOVE T1,PPN
; PUSHJ P,GETPRO
; RETURN HERE--IF TRUE, T1/ADDR OF ACTDAE.SYS ENTRY FOR USER
; --IF FALSE, ERROR MESSAGE ALREADY BUILT
GETPRO: TDZA TF,TF ;EXTERNAL ENTRY POINT
GETPRX: MOVEI TF,1 ;INTERNAL ENTRY POINT
PUSH P,TF ;SAVE FLAG
GETP.1: MOVEM T1,ACOPPN ;PPN TO GET
PUSH P,ACOUXP ;SAVE LOC
MOVEI S1,.UGPPN ;CODE FOR A PPN
MOVEM S1,ACOUXP ;SAVE TEMPORARILY
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
POP P,ACOUXP ;RESTORE LOC
JUMPF GETP.2 ;IF FAIL, SAY NO SUCH PPN
POP P,(P) ;PHASE STACK
MOVEI T1,ACOPRO ;POINT AT BLOCK WHERE PROFILE IS
$RETT ; AND RETURN
GETP.2: PUSH P,S1 ;SAVE THE PPN
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
POP P,S1 ;RESTORE THE PPN
POP P,TF ;GET ENTRY POINT FLAG
JUMPN TF,.RETF ;JUMP IF INTERNAL
SKIPE S2,RMGCOD ;FATAL RMS ERROR?
FATAL (RMS,<Unexpected RMS error ^O6R0/S2/>,ACRMS%,.RETF)
FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,ACILP%,.RETF)
SUBTTL PROFIL - READ PROFILE AND PERFORM DEFAULTING
; THIS ROUTINE WILL FETCH A PROFILE AND DO DEFAULTING BASED ON
; THE CONTENTS OF .AEDEF AND .AEMAP.
; CALL: MOVE S1, ADDRESS OF BUFFER TO RETURN PROFILE
; MOVE S2, ADDRESS OF WILDCARD MESSAGE BLOCK
; PUSHJ P,PROFIL
;
; TRUE RETURN: PROFILE READ AND DEFAULTED AS NECESSARY
; FALSE RETURN: REQUESTED PROFILE OR DEFAULT PROFILE NOT FOUND
PROFIL: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE P1,S1 ;SAVE PROFILE BUFFER ADDRESS
PUSHJ P,GETA## ;FETCH REQUESTED PROFILE
JUMPF [PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
$RETF] ;RETURN FALSE (NO SUCH USER OR FATAL ERROR)
PUSHJ P,PROFMT ;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
JRST PROFI0 ;OK, GO DEFAULT IT
PRODEF: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE P1,S1 ;SAVE PROFILE BUFFER ADDRESS
PROFI0: MOVE S1,[ACODEF,,ACODEF+1] ;BLT WORD
SETZM ACODEF ;CLEAR START OF BLOCK
BLT S1,ACODEF+.AEMAX-1 ;START OFF WITH A CLEAN SLATE
MOVE S1,.AEDEF(P1) ;GET DEFAULT PPN WORD
CAIN S1,-1 ;WANT DEFAULTING?
$RETT ;NO--THAT'S EASY
MOVSI S1,-.AMPLW ;-LENGTH OF DEFAULT MAP
HRRI S1,.AEMAP(P1) ;MAKE AN AOBJN POINTER
SKIPN (S1) ;ANY FIELDS TO DEFAULT?
AOBJN S1,.-1 ;NO
JUMPGE S1,.RETT ;RETURN IF NO DEFAULTING NECESSARY
PUSHJ P,PROLOD ;GO LOAD DEFAULT PROFILE
JUMPF .RETT ;RETURN IF CAN'T FIND PROFILE FOR DEFAULTING
$SAVE <T1,T2> ;DON'T CLOBBER CALLER'S ACS
MOVE T1,P1 ;COPY USER PROFILE ADDRESS
MOVEI T2,ACODEF ;POINT TO DEFAULTING BLOCK
PJRST A$PDEF## ;GO APPLY THE DEFAULTS
; READ AND VERIFY ACCOUNTING FILE/PROFILE FORMAT VERSION NUMBER
PROFMT: HLRZ S1,.AEVRS(P1) ;GET VERSION
CAIN S1,6 ;KNOWN FORMAT?
POPJ P, ;YES
STOPCD (WVR,HALT,,<Wrong accounting file format>)
; DETERMINE DEFAULT PPN AND LOAD THAT PROFILE INTO ACODEF
PROLOD: MOVE S1,[ACODWL,,ACODWL+1] ;SET UP BLT
SETZM ACODWL ;CLEAR FIRST WORD
BLT S1,ACODWL+UW$MIN-1 ;ZERO OUT DEFAULTING WILDCARD BLOCK
HLLO S1,.AEPPN(P1) ;ASSUME [10,%] WANTED
SKIPN S2,.AEDEF(P1) ;CONVENTIONAL DEFAULTING?
JRST PROLO1 ;YES
MOVE S1,S2 ;COPY POSSIBLE PPN
TLNE S1,-1 ;FULL PPN SPECIFIED?
JRST PROLO1 ;YES
HRLZS S1 ;PUT PROJECT NUMBER IN PROPER PLACE
HRR S1,.AEPPN(P1) ;LOAD PROGRAMMER NUMBER
PROLO1: MOVEM S1,ACODWL+UW$PPN ;SAVE DEFAULT PPN
SETOM ACODWL+UW$PPM ;SET MASK
MOVEI S1,ACODEF ;PROFILE BUFFER
MOVEI S2,ACODWL ;WILDCARD BLOCK ADDRESS
PUSHJ P,GETA## ;FETCH DEFAULT PROFILE
JUMPT PROLO2 ;CONTINUE IF NO ERRORS
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
; (TELL OPERATOR, BUT KEEP TRYING)
SKIPE .AEDEF(P1) ;DOING CONVENTIONAL DEFAULTING?
$RETF ;NO--CAN'T DO DEFAULTING
MOVE S1,ACODWL+UW$PPN ;GET PPN
AOJE S1,.RETF ;RETURN IF ALREADY TRIED [%,%]
MOVNI S1,1 ;ELSE GET PPN OF LAST RESORT
JRST PROLO1 ;AND TRY ONCE MORE
PROLO2: PUSHJ P,PROFMT ;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
$RETT ;AND RETURN
SUBTTL ACTIPC - SECTION TO HANDLE ALL OTHER IPCF MESSAGES
;GENERAL DEFINITIONS FOR ACTIPC MODULE
JOBNUM: BLOCK 1 ;JOB NUMBER OF USER
JOBMAX: BLOCK 1 ;MAXIMUM NUMBER OF JOBS ALLOWED TO BE LOGGED IN
; (USUALLY THE NUMBER THE RUNNING MONITOR WAS
; BUILT FOR). THIS NUMBER WILL ONLY BE LESS
; IF THE CHECKPOINT FILES CANNOT BE ALLOCATED
; DUE TO DISK FULL PROBLEMS. SEE THE DSKLOW ROUTINE
DEVNUM: BLOCK 1 ;nTH DEVICE JUST READ IN A JOB'S DEVICE
; CHECKPOINT FILE
DEVAVL: BLOCK 1 ;LAST DEVICE SLOT AVAILABLE
DCHRBL: BLOCK .DCALT+1 ;BLOCK FOR DSKCHR TO FIND ALTERATE PORT
SUBTTL ACTIPC - ACTLIN--ROUTINE TO HANDLE LOGIN IPCF MESSAGE
;ACTLIN - ROUTINE TO TAKE ACTION WHEN A USER LOGS IN. ACTIONS ARE TO
; INITIALIZE A JOB SLOT IN THE PRIMARY JOB CHECKPOINT FILE AND TRANSFER
; INFORMATION FROM THE MESSAGE TO THE JOB SLOT. LOGIN IS BLOCKED UNTIL
; DATA IS WRITTEN AND AN ACK MESSAGE IS SEND BACK
;CALL: MMSADR CONTAINS THE ADDRESS OF LOGIN IPCF DATA RECEIVED
; MDBADR CONTAINS THE ADDRESS OF LOGIN IPCF MESSAGE DESCRIPTOR BLOCK
ACTLIN: PUSHJ P,IPCGEN ;FIND THE JOB NUMBER
MOVE T1,JOBNUM ;GET IT
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
FATAL (JCE,<Job capacity exceeded>,ACJCE%,ACTVXT)
JUMPF [MOVE T2,MMSADR
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
JRST ACTLI1]
PUSHJ P,CBJZER ;ZERO THE PRIMARY DATA AREA
PUSHJ P,GTTTYS ;GET INITIAL TTY STATISTICS NUMBERS
PUSHJ P,CPJCOP ;ZERO AND INCLUDE INIT TTY STATS IN AUX AREA
PUSHJ P,CPJLIN ;TRANSFER THE DATA RECEIVED
HRL T1,JOBNUM ;GET THE JOB NUMBER
HRRI T1,.GTJLT ;JOB LOGIN TIME
GETTAB T1, ;GET IT
SETZ T1, ;WHAT!
MOVEM T1,CPJBUF+CJLGTM ;RECORD FOR RESTART CHECK
PUSHJ P,WRITJP ;WRITE THE PRIMARY JOB SLOT
SKIPE QUEFLG ;QUEUE. UUO?
JRST [PUSHJ P,QUEACK ;YES--ACK DIFFERENTLY
JUMPF ACTLI2 ;CHECK FOR ERRORS
$RETT] ;ELSE RETURN
MOVE T2,MMSADR ;USE THE SAME PAGE WE RECEIVED
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
MOVEI T1,UGTRU$ ;INDICATE ALL OK
MOVEM T1,UC$RES(T2)
ACTLI1: MOVE T1,ACKCOD ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T1,UC$ACK(T2) ;PUT IN THE MESSAGE
MOVEI T1,UGVAC$ ;INDICATE RESPONSE MESSAGE
MOVEM T1,UC$TYP(T2)
MOVE T1,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;GET PID OF THE JOB LOGGING IN
MOVEM T1,IPS.BL+SAB.PD
MOVEI T1,1000 ;INDICATE A PAGE IS BEING SENT
MOVEM T1,IPS.BL+SAB.LN
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE, GLXLIB
JUMPT .POPJ ;PROPOGATE TRUE RETURN
CAIN S1,ERNSP$
JRST ACTLI2 ;IF NO PID, ASSUME USER CONTROL-C'D OUT OF LOGIN
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending a LOGIN response to job ^D/T3/ user ^P/T2/>
ACTLI2: PUSHJ P,CBJZER ;ZERO THE JOB SLOT BUFFER OF PRIMARY FILE
PUSHJ P,WRITJP ;AND WRITE IT TO ENSURE DATA INTEGRITY
$RETT
;CPJLIN - ROUTINE TO TAKE DATA FROM THE LOGIN IPCF MESSAGE AND PUT IT INTO CPJBUF.
; NOTICE THAT THIS ROUTINE ASSUMES THAT PART OF THE LOGIN IPCF MESSAGE
; HAS THE SAME FORMAT AS CPJBUF.
CPJLIN: MOVE T1,DATADR ;GET ADDRESS OF DATA
MOVE T2,UL$ACK(T1) ;GET THE SENDER'S UNIQUE MESSAGE IDENTIFIER
MOVEM T2,ACKCOD ;AND SAVE IT FOR THE RESPONSE MESSAGE
HRLI T2,UL$LIN(T1)
HRRI T2,CPJBUF+CLINNO
BLT T2,CPJBUF+CTERDE ;MOVE LARGE CHUNK OF DATA
SETO T1, ;GET A -1
CAMN T1,CPJBUF+CACCT ;WAS THERE ONE SPECIFIED TO LOGIN
SETZM CPJBUF+CACCT ;NO, AVOID JUNK IN USAGE.OUT
CAMN T1,CPJBUF+CRMRK ;CHECK /REMARK TOO
SETZM CPJBUF+CRMRK
;NOW DO ITEMIZED DATA TRANSFER
MOVE T1,.JBVER ;ACCOUNT DAEMON VERSION NUMBER
MOVEM T1,CPJBUF+CACVER
MOVE T1,JOBNUM ;SENDERS JOB NUMBER
MOVEM T1,CPJBUF+CJOB
MOVE T1,CPJBUF+CSESST
MOVEM T1,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE CHECKPOINTING THIS JOB
POPJ P,
SUBTTL ACTIPC - ACTSES--ROUTINE TO HANDLE SESSION IPCF MESSAGE
;ACTSES - ROUTINE TO TAKE ACTION WHEN A USER TYPES A SESSION COMMAND. ACTIONS
; ARE TO MAKE A SESSION ENTRY, COPY THE PRIMARY BUFFER CPJBUF TO CAJBUF,
; THE AUXILLIARY BUFFER, UPDATE CPJBUF AND WRITE BOTH BUFFERS.
; LOGIN IS BLOCKED BECAUSE A CHECKPOINT MUST BE MADE.
;CALL: MDBADR CONTAINS THE MESSAGE DESCRIPTOR BLOCK ADDRESS
; MMSADR CONTAINS THE ADDRESS OF THE IPCF MESSAGE RECEIVED.
ACTSES: PUSHJ P,IPCGEN ;DO GENERAL DATA SETUP
MOVE T1,JOBNUM ;GET JOB NUMBER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
PUSHJ P,CHKJOB ;GATHER ALL THE DATA
PUSHJ P,MAKSES ;NOW MAKE THE SESSION ENTRY
MOVEI T1,SESDVS ;POINT TO ROUTINE TO MAKE ENTRIES
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,ALLDEV ;CALL IT FOR ALL USER DEVICES
PUSHJ P,CPJCOP ;COPY THE PRIMARY DATA TO AUXILLIARY BUFFER
PUSHJ P,CPJSES ;COPY NEW DATA TO CPJBUF FROM IPCF MESSAGE
PUSHJ P,WRITJP ;WRITE THE BUFFER.
SKIPE QUEFLG ;QUEUE. UUO?
PJRST QUEACK ;YES--ACK AND RETURN
; JRST SNDRSP ;FALL INTO STANDARD RESPONSE STUFF
SNDRSP: MOVE T2,MMSADR ;USE THE SAME PAGE WE RECEIVED
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
MOVE T1,ACKCOD ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T1,UC$ACK(T2)
MOVEI T1,UGTRU$ ;INDICATE ALL OK
MOVEM T1,UC$RES(T2)
MOVEI T1,UGVAC$ ;INDICATE RESPONSE MESSAGE
MOVEM T1,UC$TYP(T2)
MOVE T1,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;GET PID OF THE JOB
MOVEM T1,IPS.BL+SAB.PD
MOVEI T1,1000 ;INDICATE A PAGE IS BEING SENT
MOVEM T1,IPS.BL+SAB.LN
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE, GLXLIB
JUMPT .POPJ ;PROPOGATE TRUE RETURN
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
$RETT
;CPJSES - ROUTINE TO COPY DATA FROM THE IPCF MESSAGE (SENT BECAUSE OF A
; SESSION COMMAND TYPED BY A USER) TO THE PRIMARY CHECKPOINT BUFFER (CPJBUF).
CPJSES: MOVE T1,.JBVER ;ACCOUNT DAEMON VERSION NUMBER
MOVEM T1,CPJBUF+CACVER
MOVE T1,DATADR ;ADDRESS OF DATA
MOVE T2,US$ACK(T1) ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T2,ACKCOD ;AND SAVE IT FOR THE RESPONSE MESSAGE
MOVE T2,US$PRG(T1) ;PROGRAM NAME
MOVEM T2,CPJBUF+CPGNAM
MOVE T2,US$VER(T1) ;PROGRAM VERSION NUMBER
MOVEM T2,CPJBUF+CPGVER
MOVE T2,US$ACT(T1) ;GET FIRST WORD OF ACCOUNT STRING
AOJE T2,CPJSE1 ; (SENT AS -1 IS NO CHANGE IN ACCOUNT STRING)
MOVEI T2,CPJBUF+CACCT ;NEW ACCOUNT
HRLI T2,US$ACT(T1)
BLT T2,CPJBUF+CACCT+7
CPJSE1: MOVE T2,US$BEG(T1) ;SESSION START DATE/TIME
MOVEM T2,CPJBUF+CSESST
MOVEM T2,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE NEXT CHECKPOINT
MOVE T2,US$RMK(T1) ;GET REMARK
AOJE T2,.POPJ ; (SENT AS -1 IF NO CHANGE IN REMARK)
MOVEI T2,CPJBUF+CRMRK ;NEW SESSION REMARK
HRLI T2,US$RMK(T1)
BLT T2,CPJBUF+CRMRK+7
POPJ P,
;ROUTINE CALLED FROM ACTSES (VIA ALLDEV) TO MAKE DEVICE SESSION ENTRIES
SESDVS: PUSHJ P,@[EXP CHKFSR,CHKMTA,CHKDTA,CHKSPN]-1(P1) ;CHECKPOINT IT
PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CPDCOP ;MOVE CURRENT DATA TO AUX AREA
MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,@[EXP CPDBUF+FSESST,CPDBUF+MSESST,CPDBUF+DSESST,CPDBUF+SCSHIF]-1(P1)
CAIN P1,SPNTYP ;NO SPINDLE RECORDS IN JOB FILES
PUSHJ P,ACTIDT ;CRASH CAUSE THERES NO ACCOUNT STRING FOR THEM
MOVE T2,DATADR ;NEW ACCOUNT STRING IN MESSAGE FROM LOGIN
MOVE T1,US$ACT(T2) ;GET FIRST WORD OF ACCOUNT STRING
AOJE T1,SESDV1 ;SENT AS -1 IF NO CHANGE IN ACCOUNT STRING
MOVSI T1,US$ACT(T2) ;SOURCE = NEW ACCOUNT STRING
HRR T1,[EXP CPDBUF+FACCT,CPDBUF+MACCT,CPDBUF+DACCT]-1(P1)
BLT T1,@[EXP CPDBUF+FACCT+7,CPDBUF+MACCT+7,CPDBUF+DACCT+7]-1(P1)
SESDV1: PUSHJ P,WRITDP ;WRITE IT BACK OUT
POPJ P, ;RETURN FOR NEXT DEVICE
;ACTATT - ROUTINE TO TAKE ACTION WHEN A USER ATTACHES TO HIS JOB WITH AN
; ATTACH COMMAND. ONLY THE NEW LINE NUMBER AND NODE NAME (IF ANY)
; ARE COPYED TO THE JOB SLOT OF THE PRIMARY JOB CHECKPOINT FILE (CPJBUF).
; NO SESSION ENTRY IS MADE. MMSADR AND MDBADR ARE ALREADY SET UP.
ACTATT: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,IPCGEN ;DO GENERAL DATA SETUP
MOVE P1,DATADR ;ADDRESS OF THE DATA FROM LOGIN
MOVE P1,UA$TJN(P1) ;GET TARGET JOB NUMBER
CAMLE P1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
FATAL (JCE,<Job capacity exceeded by job ^D/P1/>,ACJCE%,ACTVXT)
EXCH P1,JOBNUM ;FETCH SENDERS JOB NUMBER, STORE TARGET
CAMLE P1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
FATAL (JCE,<Job capacity exceeded by job ^D/P1/>,ACJCE%,ACTVXT)
PUSHJ P,READJP ;READ IT IN
PUSHJ P,CPJATT ;COPY NEW DATA TO CPJBUF FROM IPCF MESSAGE
PUSHJ P,DOFDTT ;COMPUTE UNBILLED TTY STATS FOR OLD TERMINAL
EXCH P1,JOBNUM ;GET STATS FOR TTY WHERE LOGIN IS NOW
PUSHJ P,GTTTYS ; THAT IS WHERE THE TARGET JOB WILL BE
MOVE T1,CPJBUF+CTTCMD ;COMMANDS ON THIS TERMINAL
SUB T1,SESBLK+CTTCMD ;NUMBER LEFT OUT OF LAST BILLING SESSION
MOVEM T1,CAJBUF+CTTCMD ;OFFSET SO WILL BE INCLUDED ON NEXT BILL
MOVE T1,CPJBUF+CTTYI ;INPUT CHARACTER COUNTS
SUB T1,SESBLK+CTTYI
MOVEM T1,CAJBUF+CTTYI
MOVE T1,CPJBUF+CTTYO ;OUTPUT CHARACTER COUNTS
SUB T1,SESBLK+CTTYO
MOVEM T1,CAJBUF+CTTYO
MOVE T1,CPJBUF+CTTYBR ;BREAK CHARACTER COUNTS
SUB T1,SESBLK+CTTYBR
MOVEM T1,CAJBUF+CTTYBR
MOVEM P1,JOBNUM ;WRITE DATA FOR TARGET JOB
PUSHJ P,WRITJP ;WRITE THE BUFFER.
SKIPN QUEFLG ;QUEUE. UUO?
PJRST SNDRSP ;NO--SEND A RESPONSE AND RETURN
PJRST QUEACK ;ACK APPROPRIATELY AND RETURN
;CPJATT - ROUTINE TO COPY DATA FROM THE IPCF MESSAGE (SENT BECAUSE OF A
; ATTACH COMMAND TYPED BY A USER) TO THE PRIMARY CHECKPOINT BUFFER (CPJBUF).
CPJATT: MOVE T1,.JBVER ;ACCOUNT DAEMON VERSION NUMBER
MOVEM T1,CPJBUF+CACVER
MOVE T1,DATADR ;ADDRESS OF DATA
MOVE T2,UA$ACK(T1) ;GET UNIQUE MESSAGE IDENTIFIER
MOVEM T2,ACKCOD ;SAVE IT FOR THE RESPONSE MESSAGE
MOVE T2,UA$PRG(T1) ;PROGRAM NAME
MOVEM T2,CPJBUF+CPGNAM
MOVE T2,UA$VER(T1) ;PROGRAM VERSION NUMBER
MOVEM T2,CPJBUF+CPGVER
MOVE T2,UA$LIN(T1) ;LINE NUMBER
MOVEM T2,CPJBUF+CLINNO
MOVE T2,UA$NOD(T1) ;NODE NAME
MOVEM T2,CPJBUF+CNODE
MOVE T2,UA$TDE(T1) ;TERMINAL DESIGNATOR
MOVEM T2,CPJBUF+CTERDE
POPJ P,
;ACTOUT - ROUTINE TO TAKE ACTION WHEN THE MONITOR SENDS THE ACCOUNT DAEMON A
; LOGOUT MESSAGE. NOTE THAT THIS CAN HAPPEN EVEN IF A USER DOES NOT LOG
; IN (E.G., HE TYPES A ^C BEFORE LOGIN DOES THE LOGIN UUO).
ACTOUT: SKIPE GFRFLG ;MUST BE FROM [SYSTEM]GOPHER
SKIPE QUEFLG ;AND NOT A USER'S QUEUE. UUO
JRST NOPRV ;WRONG. GIVE 'NOT PRIVILEGED' ERROR
MOVE T1,DATADR ;MESSAGE ADDRESS
MOVE T1,LGO.JB(T1)
ANDX T1,LG.JOB ;JOB NUMBER DOING LOGOUT UUO
HLRZS T1 ;PUT JOB NUMBER IN RIGHT HALF
MOVEM T1,JOBNUM ;STORE IT
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
JRST ACTOT1 ;NO, JUST ACK [SYSTEM]GOPHER
PUSHJ P,CHKJOB ;GATHER ALL THE DATA
PUSHJ P,MAKSES ;CHECKPOINT THE JOB AND MAKE A SESSION ENTRY
HRROI T1,LGODVS ;ROUTINE TO MAKE DEVICE ENTRIES
PUSHJ P,ALLDEV ;CALL IT FOR ALL DEVICES THAT WE KNOW ABOUT
PUSHJ P,CBJZER ;NOW ZERO THE PRIMARY SLOT
PUSHJ P,CPJCOP ;COPY TO AUXILLIARY SLOT
PUSHJ P,WRITJP ;WRITE ZEROES TO PRIMARY CHECKPOINT FILE
ACTOT1: MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;PID OF [SYSTEM]GOPHER
MOVEM T1,IPS.BL+SAB.PD ;STORE IT IN THE SEND ARGUMENT BLOCK
MOVEI T1,1 ;LENGTH OF MESSAGE
MOVEM T1,IPS.BL+SAB.LN
MOVE T1,MMSADR ;ADDRESS OF DATA
MOVEM T1,IPS.BL+SAB.MS
MOVE T2,JOBNUM ;JOB NUMBER OF USER LOGGING OUT
MOVEM T2,(T1) ;TELL [SYSTEM]GOPHER
MOVEI S1,SAB.SZ
MOVEI S2,IPS.BL
$CALL C%SEND
JUMPT .POPJ ;RETURN IF OK
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending LOGOUT response to job ^D/T3/ user ^P/T2/>
$RETT
;ROUTINE TO MAKE THE ENTRIES FOR THE DEVICES OWNED BY THE JOB LOGGING OUT
; CAN'T CHECKPOINT HERE CAUSE DEVICES WERE RELEASED BEFORE WE SEE THIS JOB
LGODVS: MOVE T1,CURDTM ;GET CURRENT DATE/TIME (ONLY THING TO CHECKPOINT)
MOVEM T1,@[EXP CPDBUF+FLSTCK,CPDBUF+MLSTCK,CPDBUF+DLSTCK,CPDBUF+SLSTCK]-1(P1)
PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CBDZER ;CLEAR THE BLOCK
PUSHJ P,CPDCOP ;BOTH HALVES
PUSHJ P,WRITDP ;ZAP THE DISK AREA
POPJ P, ;AND RETURN FOR THE NEXT
;ACTFDM - Routine called when a mount message for a user file structure
; is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTFDM: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UF$JOB(T2) ;GET THE JOB NUMBER OF THE USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE IT FOR THE CHECKPOINT FILE NAME
MOVE T1,UF$DEV(T2) ;FILE STRUCTURE NAME
PUSHJ P,FNDDEV ;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
JUMPT ACTFD1 ;WHAT, ALREADY FOUND, SOMEONE IS CONFUSED
PUSHJ P,CBDZER ;CLEAR OUT THE DEVICE AREA
PUSHJ P,CPDCOP ;AND THE SESSION/CSHIFT AREA
PUSHJ P,CPDFDM ;COPY MESSAGE DATA TO CPDBUF
MOVE T1,DEVAVL
MOVEM T1,DEVNUM ;WRITE THE DEVICE AREA
PUSHJ P,WRITDP
PUSHJ P,READJP ;READ IN JOB PROPER DATA
AOS CPJBUF+CDEVFL ;INCREMENT DEVICE COUNT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTFD1: PUSHJ P,CPDCLS ;CLOSE THE FILE
; JRST SNDACK ;FALL INTO STANDARD SEND ACK CODE
SNDACK: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVE T1,.MSFLG(T2) ;FLAGS WORD
TXNN T1,MF.ACK ;DID HE WANT AN ACK?
JRST IGNORE ;NO. RELEASE MESSAGE AND RETURN
MOVE T1,[.MSCOD+1,,UGACK$]
MOVEM T1,.MSTYP(T2)
MOVX T1,MF.NOM ;JUST ACK THE MESSAGE
MOVEM T1,.MSFLG(T1) ;PRESERVE THE CODE IN .MSCOD
MOVE T3,MDBADR ;MESSAGE DESCRIPTOR ADDRESS
MOVE T1,MDB.SP(T3) ;PID TO SEND TO
MOVEM T1,IPS.BL+SAB.PD
LOAD T1,.MSTYP(T2),MS.CNT ;LENGTH OF MESSAGE
MOVEM T1,IPS.BL+SAB.LN
MOVEI S1,SAB.SZ ;SEND ARGUMENT BLOCK LENGTH
MOVEI S2,IPS.BL ;SEND ARUGMENT BLOCK ADDRESS
$CALL C%SEND
JUMPT .POPJ ;PROPOGATE TRUE RETURN
$WTOXX <Error (^E/S1/) sending ACK message>
$RETT
;CPDFDM - Routine to copy data from user file structure mount message to CPDBUF.
CPDFDM: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVEI T1,FSRTYP ;DEVICE TYPE
MOVEM T1,CPDBUF+DEVTYP
MOVE T1,UF$DEV(T2) ;DEVICE NAME
MOVEM T1,CPDBUF+DEVICE
MOVE T1,UF$JOB(T2) ;JOB NUMBER OF USER
MOVEM T1,CPDBUF+FJOB
MOVE T1,UF$TRD(T2) ;TERMINAL DESIGNATOR
MOVEM T1,CPDBUF+FTERDE
MOVE T1,.JBVER ;ACTDAE VERSION NUMBER
MOVEM T1,CPDBUF+FACVER
$CALL I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,CPDBUF+FLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
MOVEM S1,CPDBUF+FSESST ;SESSION START DATE/TIME
MOVE T1,UF$TNO(T2) ;LINE NUMBER OF USER
MOVEM T1,CPDBUF+FLINNO
MOVE T1,UF$PNM(T2) ;PROGRAM NAME (PULSAR)
MOVEM T1,CPDBUF+FPGNAM
MOVE T1,UF$PVR(T2) ;PROGRAM'S VERSION NUMBER
MOVEM T1,CPDBUF+FPGVER
MOVE T1,UF$NOD(T2) ;NODE NAME OF USER
MOVEM T1,CPDBUF+FNODE
HRLI T1,UF$ACT(T2) ;ACCOUNT STRING
HRRI T1,CPDBUF+FACCT
BLT T1,CPDBUF+FACCT+7
MOVE T1,UF$PPN(T2) ;USER'S PROJECT PROGRAMMER NUMBER
MOVEM T1,CPDBUF+FPPN
DMOVE T3,UF$NM1(T2) ;USER'S NAME
DMOVEM T3,CPDBUF+FNAME1
MOVE T1,UF$STY(T2) ;TYPE OF FILE STRUCTURE
MOVEM T1,CPDBUF+FFSTYP
MOVE T1,UF$PNO(T2) ;NUMBER OF PACKS IN FILE STRUCTURE
MOVEM T1,CPDBUF+FPCKNO
MOVE T1,UF$CTY(T2) ;CONTROLLER TYPE
MOVEM T1,CPDBUF+FCONTY
MOVE T1,UF$DTY(T2) ;DEVICE TYPE
MOVEM T1,CPDBUF+FDEVTY
MOVE T1,UF$DSP(T2) ;DISPOSITION
MOVEM T1,CPDBUF+FDISPO
HRLI T1,UF$TXT(T2) ;TEXT TO EXPLAIN DISPOSITION
HRRI T1,CPDBUF+FOTEXT
BLT T1,CPDBUF+FOTEXT+7
MOVE T1,UF$CDT(T2) ;CREATION DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+FCREDT
MOVE T1,UF$SDT(T2) ;SCHEDULED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+FSCHDT
MOVE T1,UF$VDT(T2) ;SERVICED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+FSERDT
MOVE T1,UF$CBR(T2) ;MOUNT COUNT BEFORE REQUEST
MOVEM T1,CPDBUF+FMNTCT
MOVE T1,UF$ACC(T2) ;ACCESS TYPE
MOVEM T1,CPDBUF+FACCES
POPJ P,
;ACTFDD - Routine called when a dismount message for a user file structure
; is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTFDD: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UF$JOB(T2) ;JOB NUMBER OF USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE FOR THE CHECKPOINT FILE NAME
MOVE T1,UF$DEV(T2) ;FILE STRUCTURE NAME
PUSHJ P,FNDDEV ;FIND THE DEVICE ENTRY
JUMPF ACTFD2 ;DIDN'T FOUND THE FILE STRUCTURE ENTRY
PUSHJ P,CPDFDD ;COPY DATA FROM THE MESSAGE
$CALL DATIM ;GET CURRENT DATE/TIME
PUSHJ P,CHKFSR ;CHECKPOINT THE DATA
PUSHJ P,MAKFSR ;GO MAKE AN ENTRY
PUSHJ P,CBDZER ;ZERO THE DEVICE AREA
PUSHJ P,CPDCOP ;COPY IN CASE OF AUXILLIARY DATA
PUSHJ P,WRITDP ;WRITE IT OUT
PUSHJ P,READJP ;READ IN JOB PROPER DATA
SOSG CPJBUF+CDEVFL ;DECREMENT DEVICE COUNT
PUSHJ P,CPDDEL ;FILE IS NOW EMPTY, DELETE IT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTFD2: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDFDD - Routine to copy data from user file structure dismount message to
; CPDBUF.
CPDFDD: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVE T1,UF$SCT(T2) ;MOUNT COUNT AFTER DISMOUNT
MOVEM T1,CPDBUF+FDISCT
POPJ P,
;ACTMGM - Routine called when a mount message for a user magtape is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTMGM: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UM$JOB(T2) ;GET THE JOB NUMBER OF THE USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE IT FOR THE CHECKPOINT FILE NAME
MOVE T1,UM$DEV(T2) ;DEVICE NAME
PUSHJ P,FNDDEV ;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
JUMPT ACTMG1 ;ALREADY FOUND, SOMEONE IS CONFUSED
PUSHJ P,CBDZER ;CLEAR OUT THE DEVICE AREA
PUSHJ P,CPDCOP ;AND THE SESSION/CSHIFT AREA
PUSHJ P,CPDMGM ;COPY MESSAGE DATA TO CPDBUF
MOVE T1,DEVAVL
MOVEM T1,DEVNUM ;WRITE THE DEVICE AREA
PUSHJ P,WRITDP
PUSHJ P,READJP ;READ IN JOB PROPER DATA
AOS CPJBUF+CDEVFL ;INCREMENT DEVICE COUNT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTMG1: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDMGM - Routine to copy data from user magtape mount message to CPDBUF.
CPDMGM: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVEI T1,MAGTYP ;DEVICE TYPE
MOVEM T1,CPDBUF+DEVTYP
MOVE T1,UM$DEV(T2) ;DEVICE NAME
MOVEM T1,CPDBUF+DEVICE
MOVE T1,UM$JOB(T2) ;JOB NUMBER OF USER
MOVEM T1,CPDBUF+MJOB
MOVE T1,UM$TRD(T2) ;TERMINAL DESIGNATOR
MOVEM T1,CPDBUF+MTERDE
MOVE T1,.JBVER ;ACTDAE VERSION NUMBER
MOVEM T1,CPDBUF+MACVER
$CALL I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,CPDBUF+MLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
MOVEM S1,CPDBUF+MSESST ;SESSION START DATE/TIME
MOVE T1,UM$TNO(T2) ;LINE NUMBER OF USER
MOVEM T1,CPDBUF+MLINNO
MOVE T1,UM$PNM(T2) ;PROGRAM NAME (PULSAR)
MOVEM T1,CPDBUF+MPGNAM
MOVE T1,UM$PVR(T2) ;PROGRAM'S VERSION NUMBER
MOVEM T1,CPDBUF+MPGVER
MOVE T1,UM$NOD(T2) ;NODE NAME OF USER
MOVEM T1,CPDBUF+MNODE
HRLI T1,UM$ACT(T2) ;ACCOUNT STRING
HRRI T1,CPDBUF+MACCT
BLT T1,CPDBUF+MACCT+7
MOVE T1,UM$PPN(T2) ;USER'S PROJECT PROGRAMMER NUMBER
MOVEM T1,CPDBUF+MPPN
DMOVE T3,UM$NM1(T2) ;USER'S NAME
DMOVEM T3,CPDBUF+MNAME1
MOVE T1,UM$CTY(T2) ;CONTROLLER TYPE
MOVEM T1,CPDBUF+MCONTY
MOVE T1,UM$DSP(T2) ;DISPOSITION
MOVEM T1,CPDBUF+MDISPO
HRLI T1,UM$TXT(T2) ;TEXT TO EXPLAIN DISPOSITION
HRRI T1,CPDBUF+MOTEXT
BLT T1,CPDBUF+MOTEXT+7
MOVE T1,UM$CDT(T2) ;CREATION DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+MCREDT
MOVE T1,UM$SDT(T2) ;SCHEDULED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+MSCHDT
MOVE T1,UM$VDT(T2) ;SERVICED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+MSERDT
MOVE T1,UM$VID(T2) ;VOLUME ID IN VOL1 LABEL
MOVEM T1,CPDBUF+MVOLID
MOVE T1,UM$RID(T2) ;REEL ID
MOVEM T1,CPDBUF+MRELID
MOVE T1,UM$LTY(T2) ;LABEL TYPE
MOVEM T1,CPDBUF+MLABEL
MOVE T1,UM$LST(T2) ;VOLUME LABEL STATE
MOVEM T1,CPDBUF+MSTATE
MOVE T1,UM$FSI(T2) ;FILE SET IDENTIFIER
MOVEM T1,CPDBUF+MFSTID
POPJ P,
;ACTMGD - Routine called when a dismount message for a user magtape is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTMGD: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UM$JOB(T2) ;JOB NUMBER OF USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE FOR THE CHECKPOINT FILE NAME
MOVE T1,UM$DEV(T2) ;DEVICE NAME
PUSHJ P,FNDDEV ;FIND THE DEVICE ENTRY
JUMPF ACTMG2 ;DIDN'T FOUND THE MAGTAPE ENTRY
PUSHJ P,CPDMGD ;COPY DATA FROM THE MESSAGE
$CALL DATIM ;GET CURRENT DATE/TIME
MOVEM S1,CPDBUF+MLSTCK ;STORE AS TIME OF LAST CHECKPOINT
PUSHJ P,MAKMAG ;GO MAKE AN ENTRY
PUSHJ P,CBDZER ;ZERO THE DEVICE AREA
PUSHJ P,CPDCOP ;COPY IN CASE OF AUXILLIARY DATA
PUSHJ P,WRITDP ;WRITE IT OUT
PUSHJ P,READJP ;READ IN JOB PROPER DATA
SOSG CPJBUF+CDEVFL ;DECREMENT DEVICE COUNT
PUSHJ P,CPDDEL ;FILE IS NOW EMPTY, DELETE IT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTMG2: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDMGD - Routine to copy data from user magtape dismount message to CPDBUF.
CPDMGD: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UM$MRD(T2) ;CHARACTERS READ
MOVEM T1,CPDBUF+MMREAD
MOVE T1,UM$MWR(T2) ;CHARACTERS WRITTEN
MOVEM T1,CPDBUF+MMWRIT
MOVE T1,UM$RRD(T2) ;RECORDS READ
MOVEM T1,CPDBUF+MRECRD
MOVE T1,UM$SRE(T2) ;SOFT READ ERRORS
MOVEM T1,CPDBUF+MNOSRE
MOVE T1,UM$SWE(T2) ;SOFT WRITE ERRORS
MOVEM T1,CPDBUF+MNOSWE
MOVE T1,UM$HRE(T2) ;HARD READ ERRORS
MOVEM T1,CPDBUF+MNOHRE
MOVE T1,UM$HWE(T2) ;HARD WRITE ERRORS
MOVEM T1,CPDBUF+MNOHWE
POPJ P,
;ACTDTM - Routine called when a mount message for a user DECtape is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTDTM: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UD$JOB(T2) ;GET THE JOB NUMBER OF THE USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE IT FOR THE CHECKPOINT FILE NAME
MOVE T1,UD$DEV(T2) ;DEVICE NAME
PUSHJ P,FNDDEV ;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
JUMPT ACTDT1 ;ALREADY HAVE IT, SOMEBODY IS CONFUSED
PUSHJ P,CBDZER ;CLEAR OUT THE DEVICE AREA
PUSHJ P,CPDCOP ;AND THE SESSION/CSHIFT AREA
PUSHJ P,CPDDTM ;COPY MESSAGE DATA TO CPDBUF
MOVE T1,DEVAVL
MOVEM T1,DEVNUM ;WRITE THE DEVICE AREA
PUSHJ P,WRITDP
PUSHJ P,READJP ;READ IN JOB PROPER DATA
AOS CPJBUF+CDEVFL ;INCREMENT DEVICE COUNT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTDT1: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDDTM - Routine to copy data from user DECtape mount message to CPDBUF.
CPDDTM: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVEI T1,DECTYP ;DEVICE TYPE
MOVEM T1,CPDBUF+DEVTYP
MOVE T1,UD$DEV(T2) ;DEVICE NAME
MOVEM T1,CPDBUF+DEVICE
MOVE T1,UD$JOB(T2) ;JOB NUMBER OF USER
MOVEM T1,CPDBUF+DJOB
MOVE T1,UD$TRD(T2) ;TERMINAL DESIGNATOR
MOVEM T1,CPDBUF+DTERDE
MOVE T1,.JBVER ;ACTDAE VERSION NUMBER
MOVEM T1,CPDBUF+DACVER
$CALL I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,CPDBUF+DLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
MOVEM S1,CPDBUF+DSESST ;SESSION START DATE/TIME
MOVE T1,UD$TNO(T2) ;LINE NUMBER OF USER
MOVEM T1,CPDBUF+DLINNO
MOVE T1,UD$PNM(T2) ;PROGRAM NAME (PULSAR)
MOVEM T1,CPDBUF+DPGNAM
MOVE T1,UD$PVR(T2) ;PROGRAM'S VERSION NUMBER
MOVEM T1,CPDBUF+DPGVER
MOVE T1,UD$NOD(T2) ;NODE NAME OF USER
MOVEM T1,CPDBUF+DNODE
HRLI T1,UD$ACT(T2) ;ACCOUNT STRING
HRRI T1,CPDBUF+DACCT
BLT T1,CPDBUF+DACCT+7
MOVE T1,UD$PPN(T2) ;USER'S PROJECT PROGRAMMER NUMBER
MOVEM T1,CPDBUF+DPPN
DMOVE T3,UD$NM1(T2) ;USER'S NAME
DMOVEM T3,CPDBUF+DNAME1
MOVE T1,UD$DSP(T2) ;DISPOSITION
MOVEM T1,CPDBUF+DDISPO
HRLI T1,UD$TXT(T2) ;TEXT TO EXPLAIN DISPOSITION
HRRI T1,CPDBUF+DOTEXT
BLT T1,CPDBUF+DOTEXT+7
MOVE T1,UD$CDT(T2) ;CREATION DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+DCREDT
MOVE T1,UD$SDT(T2) ;SCHEDULED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+DSCHDT
MOVE T1,UD$VDT(T2) ;SERVICED DATE/TIME OF MOUNT REQUEST
MOVEM T1,CPDBUF+DSERDT
MOVE T1,UD$VID(T2) ;VOLUME ID IN VOL1 LABEL
MOVEM T1,CPDBUF+DVOLID
MOVE T1,UD$RID(T2) ;REEL ID
MOVEM T1,CPDBUF+DRELID
POPJ P,
;ACTDTD - Routine called when a dismount message for a user DECtape is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTDTD: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
MOVE T1,UD$JOB(T2) ;JOB NUMBER OF USER
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS USER?
FATAL (JCE,<Job capacity exceeded by job ^D/T1/>,ACJCE%,ACTVXT)
MOVEM T1,JOBNUM ;STORE FOR THE CHECKPOINT FILE NAME
MOVE T1,UD$DEV(T2) ;DEVICE NAME
PUSHJ P,FNDDEV ;FIND THE DEVICE ENTRY
JUMPF ACTDT2 ;DIDN'T FOUND THE DECTAPE ENTRY
PUSHJ P,CPDDTD ;COPY DATA FROM THE MESSAGE
$CALL DATIM ;GET CURRENT DATE/TIME
PUSHJ P,CHKDTA ;CHECKPOINT THE DATA
PUSHJ P,MAKDEC ;GO MAKE AN ENTRY
PUSHJ P,CBDZER ;ZERO THE DEVICE AREA
PUSHJ P,CPDCOP ;COPY IN CASE OF AUXILLIARY DATA
PUSHJ P,WRITDP ;WRITE IT OUT
PUSHJ P,READJP ;READ IN JOB PROPER DATA
SOSG CPJBUF+CDEVFL ;DECREMENT DEVICE COUNT
PUSHJ P,CPDDEL ;FILE IS NOW EMPTY, DELETE IT
PUSHJ P,WRITJP ;AND RE-WRITE THE DATA
ACTDT2: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDDTD - Routine to copy data from user DECtape dismount message to CPDBUF.
CPDDTD: POPJ P,
;ACTSPM - Routine called when a mount message for a disk spindle is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTSPM: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
SETZM JOBNUM ;JOB NUMBER 0 IS USED FOR SPINDLES
MOVE T1,US$DEV(T2) ;DISK UNIT NAME
PUSHJ P,FNDDEV ;FIND A ZERO DEVICE SLOT IN THE CHECKPOINT FILE
JUMPT ACTSP1 ;ALREADY HAVE IT, SOMEONE IS CONFUSED
PUSHJ P,CBDZER ;CLEAR OUT THE DEVICE AREA
PUSHJ P,CPDCOP ;AND THE SESSION/CSHIFT AREA
PUSHJ P,CPDSPM ;COPY MESSAGE DATA TO CPDBUF
MOVE T1,DEVAVL
MOVEM T1,DEVNUM ;WRITE THE DEVICE AREA
PUSHJ P,WRITDP
ACTSP1: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDSPM - Routine to copy data from disk spindle mount message to CPDBUF.
CPDSPM: MOVE T2,MMSADR ;MESSAGE ADDRESS
MOVEI T1,SPNTYP ;DEVICE TYPE
MOVEM T1,CPDBUF+DEVTYP
MOVE T1,US$DEV(T2) ;DISK UNIT NAME
MOVEM T1,CPDBUF+DEVICE
MOVEM T1,DCHRBL+.DCNAM ;GET THE ALTERNATE PORT IF IT EXISTS
MOVE T1,[.DCALT+1,,DCHRBL]
DSKCHR T1,
JFCL
MOVE T1,DCHRBL+.DCALT ;GET ALTERNATE PORT
MOVEM T1,CPDBUF+ALTPRT
MOVE T1,US$JOB(T2) ;JOB NUMBER OF PULSAR
MOVEM T1,CPDBUF+SJOB
MOVE T1,US$TRD(T2) ;TERMINAL DESIGNATOR
MOVEM T1,CPDBUF+STERDE
MOVE T1,.JBVER ;ACTDAE VERSION NUMBER
MOVEM T1,CPDBUF+SACVER
$CALL I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,CPDBUF+SLSTCK ;INITIALIZE LAST CHECKPOINT DATE/TIME
MOVEM S1,CPDBUF+SCSHIF ;USED FOR CONNECT TIME IN CASE OF CSHIFT
MOVE T1,US$TNO(T2) ;LINE NUMBER OF PULSAR
MOVEM T1,CPDBUF+SLINNO
MOVE T1,US$PNM(T2) ;PROGRAM NAME (PULSAR)
MOVEM T1,CPDBUF+SPGNAM
MOVE T1,US$PVR(T2) ;PROGRAM'S VERSION NUMBER
MOVEM T1,CPDBUF+SPGVER
MOVE T1,US$NOD(T2) ;NODE NAME OF PULSAR
MOVEM T1,CPDBUF+SNODE
MOVE T1,US$STY(T2) ;TYPE OF FILE STRUCTURE
MOVEM T1,CPDBUF+SFSTYP
MOVE T1,US$PNO(T2) ;NUMBER OF PACKS IN FILE STRUCTURE
MOVEM T1,CPDBUF+SPCKNO
MOVE T1,US$CTY(T2) ;CONTROLLER TYPE
MOVEM T1,CPDBUF+SCONTY
MOVE T1,US$DTY(T2) ;DEVICE TYPE
MOVEM T1,CPDBUF+SDEVTY
MOVE T1,US$DTM(T2) ;DATE/TIME PACK WAS SPUN UP
MOVEM T1,CPDBUF+SMNTDT
MOVE T1,US$DPI(T2) ;DISK PACK IDENTIFIER
MOVEM T1,CPDBUF+SPAKID
MOVE T1,US$FSN(T2) ;FILE STRUCTURE NAME
MOVEM T1,CPDBUF+SFSNAM
MOVE T1,US$MTH(T2) ;M OF N COUNT
MOVEM T1,CPDBUF+SPKMTH
POPJ P,
;ACTSPD - Routine called when a dismount message for a disk spindle is received.
;Call: MDBADR contains the message descriptor address
; MMSADR contains the message address
ACTSPD: MOVE T2,MMSADR ;ADDRESS OF MESSAGE
SETZM JOBNUM ;USE JOB 0 FOR SPINDLE USAGE
MOVE T1,US$DEV(T2) ;FILE STRUCTURE NAME
PUSHJ P,FNDDEV ;FIND THE DEVICE ENTRY
JUMPF ACTSP2 ;DIDN'T FOUND THE FILE STRUCTURE ENTRY
PUSHJ P,CPDSPD ;COPY DATA FROM THE MESSAGE
$CALL DATIM ;GET CURRENT DATE/TIME
PUSHJ P,CHKSPN ;CHECKPOINT THE SPINDLE
PUSHJ P,MAKSPN ;GO MAKE AN ENTRY
PUSHJ P,CBDZER ;ZERO THE DEVICE AREA
PUSHJ P,CPDCOP ;COPY IN CASE OF AUXILLIARY DATA
PUSHJ P,WRITDP ;WRITE IT OUT
ACTSP2: PUSHJ P,CPDCLS ;CLOSE THE FILE
PJRST SNDACK ;SEND ACK AND RETURN
;CPDSPD - Routine to copy data from disk spindle spin-down message to CPDBUF.
CPDSPD: POPJ P,
;ACTCHD - Routine called when the operator has changed the Date/Time
;Call: DTCPSI+.PSVIS contains the date/time offset
ACTCHD: MOVE T1,DTCPSI+.PSVIS;GET DATE/TIME OFFSET
MOVEM T1,DTMOFS ;STORE FOR LATER ADJUSTMENT
PUSHJ P,CHKAJB ;CHECKPOINT ALL STUFF, ADJUSTING FOR NEW TIME
MOVM T1,DTCPSI+.PSVIS;GET OFFSET BETWEEN TIMES
HLRZM T1,DAEOFD ;STORE NUMBER OF DAYS
TLZ T1,-1 ;CLEAR DAYS
MUL T1,[^D24*^D60*^D60] ;CONVERT TO SECONDS
DIV T1,[1,,0] ;...
TRNE T2,1B18 ;SHOULD IT BE ROUNDED
AOS T1 ;YES
MOVEM T1,DAEOFS ;STORE OFFSET IN SECONDS
MOVE T1,MONJNO ;ACTDAE'S JOB NUMBER
PUSHJ P,SETTNL ;FIGURE OUT WHERE WE ARE
PUSHJ P,DATIM ;FETCH CURRENT DATE/TIME
SUB S1,DTMOFS ;ADJUST CURRENT TIME BY OFFSET
MOVEM S1,DAEODT ;STORE AS OLD DATE/TIME
SETZM DTMOFS ;BACK TO NORMAL TIME
MOVEI T1,.UTTAD ;ENTRY = DATE/TIME CHANGE
MOVEI DEFADR,DTMDFS ;POINT TO THE DEFUS LIST
PUSHJ P,MAKENT ;MAKE THE ENTRY
$RETT ;SO DON'T BOTHER SENDING IT ONE
;THE DEFUS LIST FOR DATE/TIME ENTRY
DTMDFS: USJNO. (MONJNO) ;OUR JOB NUMBER
USTAD. (CURDTM) ;THE DATE/TIME
USTRM. (MONTDE) ;OUR TERMINAL DESIGNATOR
USLNO. (MONLNO) ;OUR LINE NUMBER
USNOD. (MONNOD) ;OUR NODE NAME
USPNM. ([SIXBIT /ACTDAE/]) ;ACTDAES PROGRAM NAME
USPVR. (.JBVER) ;AND VERSION NUMBER
USAMV. (.JBVER) ;ACTDAE VERSION NUMBER
USODT. (DAEODT) ;OLD DATE/TIME
USOFD. (DAEOFD) ;OFFSET IN DAYS
USOFS. (DAEOFS) ;OFFSET IN SECONDS
0 ;AND A ZERO TO TERMINATE THE LIST
DAEODT: BLOCK 1 ;SPACE TO HOLD INFORMATION
DAEOFD: BLOCK 1 ;...
DAEOFS: BLOCK 1 ;...
;ACTDUE - ROUTINE CALLED UPON RECEIPT OF A DISK USAGE MESSAGE FROM BACKUP
;CALL: MMSADR CONTAINS THE MESSAGE ADDRESS
;THIS ROUTINE "KNOWS" THE FORMAT OF AN ENTRY TO BE MADE IN USAGE.OUT AND
; SINCE DISK RECORDS HAVE AND EXTENSIBLE FORMAT (LOTS OF RECORD 3'S)
; IT FAKES OUT MAKENT TO DO ITS BIDDING. BEWARE OF THIS IF SOMEONE
; CHANGES THE NUMBER OR POSITION OF RECORDS IN A DISK USAGE ENTRY.
ACTDUE: SETZM MAKDUE ;CLEAR FLAG
MOVE T1,MMSADR ;POINT TO RECEIVED MESSAGE
HRLI T2,UB$ACN(T1) ;MOVE DATA FROM MESSAGE
HRRI T2,DUEBLK ;TO SCRATCH STORAGE
BLT T2,DUEBLK+UB$ACT-UB$ACN-1 ;CAUSE DEFUS LIST CANT HANDLE INDEXING
PUSHJ P,DATIM ;SET UP CURRENT DATE/TIME
SOS @ENTRYS##-1+.UTFLU ;REDUCE ENTRY TO 2 RECORDS
MOVEI T1,.UTFLU ;MAKE DISK USAGE ENTRY
MOVEI DEFADR,DUELST ;POINT TO THE DEFUS LIST FOR THE FIRST 2 RECORDS
PUSHJ P,MAKENT ;AND MAKE THEM
AOS @ENTRYS##-1+.UTFLU ;BACK TO 3 RECORDS IN THE ENTRY
SETOM MAKDUE ;FLAG WE ONLY WANT THE LAST ON THIS TIME
MOVE P1,MMSADR ;POINT TO THE MESSAGE AGAIN
MOVEI P1,UB$ACT(P1) ;POINT TO THE FIRST ACCOUNT STRING SECTION
ACTDU1: SOSGE DUEBLK+UB$ACN-UB$ACN ;DONE YET?
JRST ACTDU2 ;YES, CLEAN UP AND RETURN
HRLI T1,UB$ACT-UB$ACT(P1) ;PREPARE TO MOVE THE DATA
HRRI T1,DU1BLK ;FROM THE MESSAGE TO THE BLOCK
BLT T1,DU1BLK+UB$END-UB$ACT-1 ;POINTED TO BY THE DEFUS LIST
MOVEI T1,.UTFLU ;MAKE DISK USAGE ENTRY AGAIN (ONLY 3RD RECORD)
MOVEI DEFADR,DU1LST ;POINT TO THE DEFUS LIST
PUSHJ P,MAKENT ;AND MAKE THE ENTRY
ADDI P1,UB$END-UB$ACT ;STEP TO THE NEXT ACCOUNT STRING DATA
JRST ACTDU1 ;AND MAKE ANY MORE
ACTDU2: SETZM MAKDUE ;DONE FAKING OUT MAKENT
$RETT ;AND RETURN
;DEFUS LIST FOR DISK USAGE ENTRIES
DUELST:
USJNO. (DUEBLK+UB$JOB-UB$ACN) ;JOB NUMBER
USTAD. (CURDTM) ;CURRENT DATE/TIME
USTRM. (DUEBLK+UB$TRD-UB$ACN) ;TERMINAL DESIGNATOR
USLNO. (DUEBLK+UB$TNO-UB$ACN) ;TERMINAL NUMBER
USPNM. (DUEBLK+UB$PNM-UB$ACN) ;PROGRAM NAME
USPVR. (DUEBLK+UB$PVR-UB$ACN) ;PROGRAM VERSION NUMBER
USAMV. (.JBVER) ;ACCOUNT DAEMON VERSION NUMBER
USNOD. (DUEBLK+UB$NOD-UB$ACN) ;NODE NUMBER
USNRF. (DUEBLK+UB$ACN-UB$ACN) ;NUMBER OF RECORDS FOLLOWING
USTAL. (DUEBLK+UB$TAU-UB$ACN) ;TOTAL ALLOCATED DISK SPACE
USTUS. (DUEBLK+UB$TWU-UB$ACN) ;TOTAL WRITTEN DISK SPACE
USTNF. (DUEBLK+UB$TNF-UB$ACN) ;TOTAL NUMBER OF FILES
USDFS. (DUEBLK+UB$FSN-UB$ACN) ;FILE STRUCTURE NAME
USPPN. (DUEBLK+UB$PPN-UB$ACN) ;PPN
USSTP. (DUEBLK+UB$FST-UB$ACN) ;FILE STRUCTURE TYPE
USKTP. (DUEBLK+UB$CNT-UB$ACN) ;CONTROLLER TYPE
USDTP. (DUEBLK+UB$DVT-UB$ACN) ;DEVICE TYPE
USLIQ. (DUEBLK+UB$QIN-UB$ACN) ;LOGGED IN QUOTA
USLOQ. (DUEBLK+UB$QOU-UB$ACN) ;LOGGED OUT QUOTA
USLLG. (DUEBLK+UB$LLG-UB$ACN) ;DATE/TIME OF LAST LOGIN (OLD FORMAT)
USLAT. (DUEBLK+UB$LAT-UB$ACN) ;DATE/TIME OF LAST ACCOUNTING
USUPF. (DUEBLK+UB$UPF-UB$ACN) ;UFD WAS PROTECTED FLAG
USFPF. (DUEBLK+UB$FPF-UB$ACN) ;SOME FILES WERE PROTECTED FLAG
USTMA. (DUEBLK+UB$ABO-UB$ACN) ;ACCOUNT BUFFER OVERFLOW IN IPCF MESSAGE
USEXP. (DUEBLK+UB$EXP-UB$ACN) ;EXPIRED PPN FLAG
USFON. ([ASCII/N/]) ;NEVER FILES ONLY
0 ;AND A ZERO TO TERMINATE THE LIST
DU1LST:
USDFS. (DUEBLK+UB$FSN-UB$ACN) ;FILE STRUCTURE NAME
USPPN. (DUEBLK+UB$PPN-UB$ACN) ;PPN
USDFT. (DUEBLK+UB$FST-UB$ACN) ;FILE STRUCTURE TYPE
USDKT. (DUEBLK+UB$CNT-UB$ACN) ;CONTROLLER TYPE
USDDT. (DUEBLK+UB$DVT-UB$ACN) ;DEVICE TYPE
USDAC. (DU1BLK+UB$ACT-UB$ACT) ;ACCOUNT STRING
USALC. (DU1BLK+UB$BAL-UB$ACT) ;BLOCKS ALLOCATED
USUSG. (DU1BLK+UB$BWR-UB$ACT) ;BLOCKS WRITTEN
USFIL. (DU1BLK+UB$NFL-UB$ACT) ;NUMBER OF FILES
0 ;AND A ZERO TO TERMINATE THE LIST
MAKDUE: BLOCK 1 ;FLAG SAYING SECOND (THRU N'TH) CALL TO MAKENT
DUEBLK: BLOCK UB$ACT-UB$ACN ;AREA TO HOLD DATA FROM MESSAGE
DU1BLK: BLOCK UB$END-UB$ACT ;AREA TO HOLD INDIVIDUAL ACCOUNT RECORDS
SUBTTL ACTIPC - GENERAL ROUTINES
;IPCGEN - ROUTINE TO DO ALL GENERAL STORAGE AND COMPUTING NEEDED FOR JOB-SPECIFIC
; IPCF MESSAGES. MDBADR AND MMSADR CONTAIN ALL THAT IS NECESSARY.
IPCGEN: MOVE T1,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.PV(T1) ;SENDER'S JOB NUMBER
ANDX T2,MD.PJB
MOVEM T2,JOBNUM ;SAVE IT
POPJ P,
SUBTTL ACTCHK - SECTION TO HANDLE JOB AND DEVICE CHECKPOINT FILES
;GENERAL DEFINITIONS FOR CHECKPOINT MODULE
DTMOFS: BLOCK 1 ;DATE/TIME OFFSET. IF NON-ZERO, ADJUST DATA ITEMS
CURDTM: BLOCK 1 ;CURRENT DATE/TIME --FILLED IN BY ROUTINE DATIM
CHKNDX: BLOCK 1 ;INDEX INTO TABLE DESCRIBING CHECKPOINT TIMES
;THE FOLLOWING DEVICE TYPES ARE DEFINED FOR SYMBOLIC REFERENCES BUT SOME
; TABLES AND DISPATCH VECTORS "KNOW" THE ORDER. DON'T CHANGE THESE.
FSRTYP==1 ;INDICATES THE DEVICE AREA IS FOR A FILE STRUCTURE
MAGTYP==2 ;INDICATES THE DEVICE AREA IS FOR A MAGTAPE
DECTYP==3 ;INDICATES THE DEVICE AREA IS FOR A DECTAPE
SPNTYP==4 ;INDICATES THE DEVICE AREA IS FOR A SPINDLE
SUBTTL ACTCHK - GENERAL DEFINITIONS FOR CHECKPOINT MODULE
;*********************************************************************
; JOB CHECKPOINT FILE (PRIMARY AND AUXILLIARY) DEFINITIONS
;*********************************************************************
CPJFIL==1 ;BLOCK WHERE GENERAL CHECKPOINT FILE INFORMATION IS STORED
JBOFFS==1 ;OFFSET TO ADD TO JOB NUMBER TO FIND WHAT BLOCK JOB'S
; INFORMATION IS STORED.
;STORAGE FOR PRIMARY JOB CHECKPOINT FILE CALLED USEJOB.BIN
CPJCHN: BLOCK 1 ;CHANNEL NUMBER OF PRIMARY JOB CHECKPOINT FILE
; # IS POSITIONED WHERE THE FILOP EXPECTS IT (FO.CHN)
CPJBLK: BLOCK 10 ;FILOP. BLOCK USED FOR THE PRIMARY JOB CHECKPOINT FILE
USEJOB: BLOCK .RBSIZ+1 ;LOOKUP BLOCK FOR CPJBLK (USEJOB.BIN)
CPJGEN: BLOCK 200 ;BUFFER WHERE THE CHECKPOINT FILE INFORMATION BLOCK
; WILL BE READ INTO.
RECLM1: ;WHERE READ DATA ENDS
;*****************************************************************
;* * * * * * * FORMAT OF CPJGEN * * * * * * * *
;*****************************************************************
PHASE 0
BLOCK 1 ;RESERVE WORD 0 OF THE BLOCK
LASTCH: BLOCK 1 ;DATE/TIME OF THE LAST CHECKPOINT DONE.
FILMJB: BLOCK 1 ;NUMBER OF JOBS THIS FILE WAS BUILT FOR
FILBPJ: BLOCK 1 ;BLOCKS PER JOB IN CHECKPOINT FILE
FILBPD: BLOCK 1 ;BLOCKS PER DEVICE IN jjjDEV.BIN FILE(S)
DEPHASE
;*****************************************************************
;* * * * * * * END OF CPJGEN FORMAT * * * * * * *
;*****************************************************************
;*****************************************************************
;* * * * * * FORMAT OF CPJBUF AND CAJBUF * * * * * * * *
;*****************************************************************
; EACH JOB SLOT IN THE CHECKPOINT FILE CONTAINS THE PRIMARY AND AUXILLIARY
; AREAS. EACH JOB REQUIRES "N" DISK BLOCKS AS DETERMINED BY THE SIZE OF
; THE PRIMARY AREA (CBUFLN) * 2. THE AUXILLIARY AREA (FOR SESSION) BEGINS
; AFTER THE PRIMARY AREA ROUNDED UP TO NEXT 100 WORD BOUNDRY FOR EXPANSION.
; WHEN THE NUMBER OF BLOCKS REQUIRED FOR A JOB CHANGES, THE OLD USEJOB.BIN
; FILE IS INVALID AND MUST BE DELETED BEFORE THE NEW VERSION OF THE ACTDAE
; CAN BE USED. TO AVOID LOSING DATA IN THE TRANSITION BETWEEN VERSIONS,
; SCHEDULE A KSYS FOR THE SYSTEM, ATTACH THE OLD ACTDAE AFTER IT IS COMPLETE,
; RUN THE OLD VERSION AGAIN (TO GET ACCOUNTING FOR [OPR] JOBS), DELETE
; THE OLD USEJOB.BIN, PUT THE NEW VERSION ON SYS, AND RELOAD THE MONITOR.
;*****************************************************************
PHASE 0
;THE FOLLOWING ITEMS ARE UPDATED WITH EACH CHECKPOINT IN THE PRIMARY CHECKPOINT
; FILE. THEY ARE ALSO THE MINUEND (PRIMARY CHECKPOINT FILE) AND THE
; SUBTRAHEND (AUXILLIARY CHECKPOINT FILE) USED WHEN MAKING ANY SESSION
; ENTRY. NOTE THAT ANY CONVERSION/CALCULATIONS NEEDED WILL BE DONE
; WHEN THE SESSION ENTRY IS BEING APPENDED TO THE USAGE FILE
CJOB: BLOCK 1 ;JOB NUMBER OF USER
CRUNTM: BLOCK 1 ;RUNTIME (TEN-MICROSECOND UNITS)
CDREAD: BLOCK 1 ;DISK READS (BLOCKS)
CDWRIT: BLOCK 1 ;DISK WRITES (BLOCKS)
CCTI: BLOCK 1 ;CORE-TIME INTEGRAL (KILO-CORE TICKS)
CVCTI: BLOCK 1 ;VIRTUAL CORE-TIME INTEGRAL (KILO-CORE TICKS)
CEBOX: BLOCK 1 ;EBOX (JIFFIES)
CMBOX: BLOCK 1 ;MBOX (JIFFIES)
CMCALL: BLOCK 1 ;MONITOR CALLS
CTTYI: BLOCK 1 ;TERMINAL INPUT CHARACTERS
CTTYO: BLOCK 1 ;TERMINAL OUTPUT CHARACTERS
CTTYBR: BLOCK 1 ;COUNT OF BREAK CHARACTERS USER TYPED
CTTCMD: BLOCK 1 ;MONITOR COMMAND COUNT
CQUTIM: BLOCK 1 ;TIME IN RUN QUEUE (USED TO CALCULATE RUN QUEUE QUOTIENT)
CEND: ;LENGTH OF VARIABLE DATA ( USED FOR SESBLK )
CACVER: BLOCK 1 ;VERSION OF ACTDAE (%%.ACV)
CLSTCK: BLOCK 1 ;DATE/TIME OF LAST CHECKPOINT
CJLGTM: BLOCK 1 ;LOGIN TIME OF THE JOB (FOR RESTART)
CDEVFL: BLOCK 1 ;FLAG INDICATING A DEVICE CHECKPOINT FILE EXISTS
;THE FOLLOWING ITEMS ARE NOT CHANGED DURING A CHECKPOINT BUT ARE NEEDED TO BE
; RECORDED HERE IN CASE OF A SYSTEM CRASH SO A INCOMPLETE SESSION
; ENTRY CAN BE MADE. NOTE THAT THE FORMAT EXACTLY MATCHES (BEGINNING
; WITH CLINNO) WITH THE LOGIN IPCF MESSAGE. IF THEY DO NOT MATCH, THE
; ROUTINE CALLED CPJLIN, MUST CHANGE FROM DOING THE BLT.
CLINNO: BLOCK 1 ;LINE NUMBER
CPGNAM: BLOCK 1 ;NAME OF PROGRAM (USUALLY LOGIN)
CPGVER: BLOCK 1 ;VERSION OF PROGRAM (USUALLY LOGIN)
CNODE: BLOCK 1 ;NODE NAME OF USER'S LOCATION
CACCT: BLOCK 10 ;ACCOUNT STRING
CSESST: BLOCK 1 ;SESSION START DATE/TIME
CJBTYP: BLOCK 1 ;JOB TYPE
CBTNAM: BLOCK 1 ;BATCH JOB NAME
CBTSEQ: BLOCK 1 ;BATCH SEQUENCE NUMBER
CRMRK: BLOCK 10 ;SESSION REMARK
CCLASS: BLOCK 1 ;SCHEDULING CLASS
CPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER OF USER
CNAME1: BLOCK 1 ;FIRST SIX LETTERS OF USER'S NAME
CNAME2: BLOCK 1 ;LAST SIX LETTERS OF USER'S NAME
CBTRID: BLOCK 1 ;BATCH REQUEST ID
CTERDE: BLOCK 1 ;TERMINAL DESIGNATOR
CBUFLN: ;LENGTH OF THE CHECKPOINT AREAS
DEPHASE
;*****************************************************************
;* * * * * * END OF CPJBUF AND CAJBUF FORMAT * * * * * * * * *
;*****************************************************************
;*****************************************************************
RELOC RECLM1 ;ORG OVER DATA DEFINITIONS TO SAVE SPACE
CPJIOB==<<2*CBUFLN>+177>/200 ;NUMBER OF DISK BLOCKS PER JOB AREA
CPJIOL==200*CPJIOB ;NUMBER OF WORDS FOR I/O TO THE FILE
CPJBUF: BLOCK CPJIOL ;THE BUFFER AREA FOR WORKING ON THE FILE
CAJBUF==CPJBUF+<CPJIOL/2> ;AUXILLIARY AREA STARTS IN THE MIDDLE
;*********************************************************************
; DEVICE CHECKPOINT FILE (PRIMARY AND AUXILLIARY) DEFINITIONS
;*********************************************************************
DVOFFS==0 ;OFFSET TO ADD TO FIND WHAT BLOCK DEVICE INFORMATION BEGINS
;STORAGE FOR PRIMARY DEVICE CHECKPOINT FILE CALLED JJJDEV.BIN WHERE JJJ IS THE JOB NUMBER
CPDCHN: BLOCK 1 ;CHANNEL NUMBER OF PRIMARY DEVICE CHECKPOINT FILE
; # IS POSITIONED WHERE THE FILOP EXPECTS IT (FO.CHN)
CPDBLK: BLOCK 10 ;FILOP. BLOCK USED FOR THE PRIMARY DEVICE CHECKPOINT FILE
JJJDEV: BLOCK .RBSIZ+1 ;LOOKUP BLOCK FOR CPDBLK (JJJDEV.BIN)
JJJDEL: BLOCK .RBSIZ+1 ;RENAME (DELETE) BLOCK FOR JJJDEV.BIN
RECLM2: ;WHERE READ DATA ENDS
;*****************************************************************
;* * * * * * FORMAT OF CPJBUF AND CADBUF * * * * * * * *
;*****************************************************************
; EACH DEVICE SLOT IN THE CHECKPOINT FILE CONTAINS THE PRIMARY AND AUXILLIARY
; AREAS. EACH DEVICE REQUIRES "N" DISK BLOCKS AS DETERMINED BY THE SIZE OF
; THE PRIMARY AREA (CDBFLN) * 2. THE AUXILLIARY AREA (FOR SESSION) BEGINS
; AFTER THE PRIMARY AREA ROUNDED UP TO NEXT 100 WORD BOUNDRY FOR EXPANSION.
; WHEN THE NUMBER OF BLOCKS REQUIRED FOR A DEVICE CHANGES, THE OLD JJJDEV.BIN
; FILE IS INVALID AND MUST BE DELETED BEFORE THE NEW VERSION OF THE ACTDAE
; CAN BE USED. TO AVOID LOSING DATA IN THE TRANSITION BETWEEN VERSIONS,
; SCHEDULE A KSYS FOR THE SYSTEM, ATTACH THE OLD ACTDAE AFTER IT IS COMPLETE,
; RUN THE OLD VERSION AGAIN (TO GET ACCOUNTING FOR [OPR] DEVICES), DELETE
; ALL OLD JJJDEV.BIN'S, PUT THE NEW VERSION ON SYS, AND RELOAD THE MONITOR.
;
; NOTE: IN THE CASE OF DEVICE CHECKPOINT FILES ONLY -- IF A NEW
; ACCOUNT DAEMON IS RUN WHICH HAS CHANGED THE NUMBER OF BLOCKS FOR EACH
; DEVICE, ANY DEVICE CHECKPOINT FILE WHICH HAS AN UNKNOWN FORMAT
; (FILBPD IN THE CPDFIL BLOCK IS NOT = TO CPDIOB) WILL BE DELETED WITH
; A WARNING SENT TO THE OPERATOR AND NO USAGE ENTRY WILL BE MADE.
;
;*****************************************************************
;FILE STRUCTURE BLOCK FORMAT
PHASE 0
DEVTYP: BLOCK 1 ;DEVICE TYPE (SEE FSRTYP DEFINITION AREA)
DEVICE: BLOCK 1 ;DEVICE NAME IN SIXBIT
FJOB: BLOCK 1 ;JOB NUMBER OF USER
FTERDE: BLOCK 1 ;TERMINAL DESIGNATOR
FACVER: BLOCK 1 ;VERSION OF ACTDAE (%%.ACV)
FLSTCK: BLOCK 1 ;DATE/TIME OF LAST CHECKPOINT
FLINNO: BLOCK 1 ;LINE NUMBER
FPGNAM: BLOCK 1 ;NAME OF PROGRAM (USUALLY PULSAR)
FPGVER: BLOCK 1 ;VERSION OF PROGRAM (USUALLY PULSAR)
FNODE: BLOCK 1 ;NODE NAME OF USER'S LOCATION
FACCT: BLOCK 10 ;ACCOUNT STRING
FSESST: BLOCK 1 ;SESSION START DATE/TIME
FPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER OF USER
FNAME1: BLOCK 1 ;FIRST SIX LETTERS OF USER'S NAME
FNAME2: BLOCK 1 ;LAST SIX LETTERS OF USER'S NAME
FFSTYP: BLOCK 1 ;TYPE OF FILE STRUCTURE
FPCKNO: BLOCK 1 ;NUMBER OF PACKS IN FILE STRUCTURE
FCONTY: BLOCK 1 ;CONTROLLER TYPE
FDEVTY: BLOCK 1 ;DEVICE TYPE
FDISPO: BLOCK 1 ;DISPOSITION
FOTEXT: BLOCK 10 ;TEXT TO EXPLAIN DISPOSITION
FCREDT: BLOCK 1 ;CREATION DATE/TIME OF MOUNT REQUEST
FSCHDT: BLOCK 1 ;SCHEDULED DATE/TIME OF MOUNT REQUEST
FSERDT: BLOCK 1 ;SERVICE DATE/TIME OF MOUNT REQUEST
FMNTCT: BLOCK 1 ;MOUNT COUNT BEFORE REQUEST
FDISCT: BLOCK 1 ;MOUNT COUNT AFTER DISMOUNT
FACCES: BLOCK 1 ;ACCESS TYPE
FCONNE: BLOCK 1 ;CONNECT TIME IN SECONDS
FBUFLN: ;LENGTH OF THE CHECKPOINT AREAS
DEPHASE
;END OF FILE STRUCTURE BLOCK FORMAT
;MAGTAPE BLOCK FORMAT
PHASE DEVTYP
MEVTYP: BLOCK 1 ;SEE DEVTYP
MEVICE: BLOCK 1 ;DEVICE NAME IN SIXBIT (REFERENCED BY DEVICE
; DEFINED IN FILE STRUCTURE BLOCK)
MJOB: BLOCK 1 ;JOB NUMBER OF USER
MTERDE: BLOCK 1 ;TERMINAL DESIGNATOR
MACVER: BLOCK 1 ;VERSION OF ACTDAE (%%.ACV)
MLSTCK: BLOCK 1 ;DATE/TIME OF LAST CHECKPOINT
MLINNO: BLOCK 1 ;LINE NUMBER
MPGNAM: BLOCK 1 ;NAME OF PROGRAM (USUALLY PULSAR)
MPGVER: BLOCK 1 ;VERSION OF PROGRAM (USUALLY PULSAR)
MNODE: BLOCK 1 ;NODE NAME OF USER'S LOCATION
MACCT: BLOCK 10 ;ACCOUNT STRING
MSESST: BLOCK 1 ;SESSION START DATE/TIME
MPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER OF USER
MNAME1: BLOCK 1 ;FIRST SIX LETTERS OF USER'S NAME
MNAME2: BLOCK 1 ;LAST SIX LETTERS OF USER'S NAME
MCONTY: BLOCK 1 ;CONTROLLER TYPE
MDISPO: BLOCK 1 ;DISPOSITION
MOTEXT: BLOCK 10 ;TEXT TO EXPLAIN DISPOSITION
MCREDT: BLOCK 1 ;CREATION DATE/TIME OF MOUNT REQUEST
MSCHDT: BLOCK 1 ;SCHEDULED DATE/TIME OF MOUNT REQUEST
MSERDT: BLOCK 1 ;SERVICE DATE/TIME OF MOUNT REQUEST
MVOLID: BLOCK 1 ;VOLUME ID RECORDED IN VOL1 LABEL
MRELID: BLOCK 1 ;REEL ID VISUAL LABEL OF TAPE
MMREAD: BLOCK 1 ;MAGTAPE READS - THOUSANDS OF CHARS
MMWRIT: BLOCK 1 ;MAGTAPE WRITES - THOUSANDS OF CHARS
MLABEL: BLOCK 1 ;LABEL TYPE
MSTATE: BLOCK 1 ;VOLUME LABEL STATE
MRECRD: BLOCK 1 ;PHYSICAL RECORDS READ
MRECWR: BLOCK 1 ;PHYSICAL RECORDS WRITTEN
MFSTID: BLOCK 1 ;FILE SET IDENTIFIER
MNOSRE: BLOCK 1 ;NUMBER OF SOFT READ ERRORS
MNOSWE: BLOCK 1 ;NUMBER OF SOFT WRITE ERRORS
MNOHRE: BLOCK 1 ;NUMBER OF HARD READ ERRORS
MNOHWE: BLOCK 1 ;NUMBER OF HARD WRITE ERRORS
MCONNE: BLOCK 1 ;CONNECT TIME IN SECONDS
MBUFLN: ;LENGTH OF THE CHECKPOINT AREAS
DEPHASE
;END OF MAGTAPE BLOCK FORMAT
;DECTAPE BLOCK FORMAT
PHASE DEVTYP
DDVTYP: BLOCK 1 ;SEE DEVTYP
DDVICE: BLOCK 1 ;DEVICE NAME IN SIXBIT (REFERENCED BY DEVICE
; DEFINED IN FILE STRUCTURE BLOCK)
DJOB: BLOCK 1 ;JOB NUMBER OF USER
DTERDE: BLOCK 1 ;TERMINAL DESIGNATOR
DACVER: BLOCK 1 ;VERSION OF ACTDAE (%%.ACV)
DLSTCK: BLOCK 1 ;DATE/TIME OF LAST CHECKPOINT
DLINNO: BLOCK 1 ;LINE NUMBER
DPGNAM: BLOCK 1 ;NAME OF PROGRAM (USUALLY MOUNT)
DPGVER: BLOCK 1 ;VERSION OF PROGRAM (USUALLY MOUNT)
DNODE: BLOCK 1 ;NODE NAME OF USER'S LOCATION
DACCT: BLOCK 10 ;ACCOUNT STRING
DSESST: BLOCK 1 ;SESSION START DATE/TIME
DPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER OF USER
DNAME1: BLOCK 1 ;FIRST SIX LETTERS OF USER'S NAME
DNAME2: BLOCK 1 ;LAST SIX LETTERS OF USER'S NAME
DDISPO: BLOCK 1 ;DISPOSITION
DOTEXT: BLOCK 10 ;TEXT TO EXPLAIN DISPOSITION
DCREDT: BLOCK 1 ;CREATION DATE/TIME OF MOUNT REQUEST
DSCHDT: BLOCK 1 ;SCHEDULED DATE/TIME OF MOUNT REQUEST
DSERDT: BLOCK 1 ;SERVICE DATE/TIME OF MOUNT REQUEST
DVOLID: BLOCK 1 ;VOLUME ID RECORDED IN VOL1 LABEL
DRELID: BLOCK 1 ;REEL ID VISUAL LABEL OF TAPE
DDREAD: BLOCK 1 ;DECTAPE READS - BLOCKS
DDWRIT: BLOCK 1 ;DECTAPE WRITES - BLOCKS
DCONNE: BLOCK 1 ;CONNECT TIME IN SECONDS
DBUFLN: ;LENGTH OF THE CHECKPOINT AREAS
DEPHASE
;END OF DECTAPE BLOCK FORMAT
;DISK SPINDLE BLOCK FORMAT
PHASE DEVTYP
SEVTYP: BLOCK 1 ;SEE DEVTYP
SEVICE: BLOCK 1 ;DISK UNIT NAME IN SIXBIT
ALTPRT: BLOCK 1 ;IF DUAL PORTED, OTHER DISK UNIT NAME
SJOB: BLOCK 1 ;JOB NUMBER OF PULSAR
STERDE: BLOCK 1 ;TERMINAL DESIGNATOR
SACVER: BLOCK 1 ;VERSION OF ACTDAE (%%.ACV)
SLSTCK: BLOCK 1 ;DATE/TIME OF LAST CHECKPOINT
SMNTDT: BLOCK 1 ;DATE/TIME PACK WAS SPUN UP
SLINNO: BLOCK 1 ;LINE NUMBER
SPGNAM: BLOCK 1 ;NAME OF PROGRAM (USUALLY PULSAR)
SPGVER: BLOCK 1 ;VERSION OF PROGRAM (USUALLY PULSAR)
SNODE: BLOCK 1 ;NODE NAME
SCSHIF: BLOCK 1 ;CSHIFT DATE/TIME
SPAKID: BLOCK 1 ;DISK PACK IDENTIFIER
SFSNAM: BLOCK 1 ;FILE STRUCTURE NAME
SFSTYP: BLOCK 1 ;TYPE OF FILE STRUCTURE
SPCKNO: BLOCK 1 ;NUMBER OF PACKS IN FILE STRUCTURE
SPKMTH: BLOCK 1 ;M OF N COUNT
SCONTY: BLOCK 1 ;CONTROLLER TYPE
SDEVTY: BLOCK 1 ;DEVICE TYPE
SCONNE: BLOCK 1 ;CONNECT TIME IN SECONDS
SBUFLN: ;LENGTH OF THE CHECKPOINT AREAS
DEPHASE
;END OF DISK SPINDLE BLOCK FORMAT
RELOC RECLM2 ;ORG OVER DATA DEFINITIONS TO SAVE SPACE
;NOW DEFINE THE LENGTH OF A DEVICE CHECKPOINT AREA. FOR SIMPLICITY, THE
;LENGTH IS THE GREATEST LENGTH OF ANY DEVICE BLOCK DEFINED.
CDBFLN==FBUFLN ;INITIALIZE WITH FILE STRUCTURE LENGTH
IFG MBUFLN-CDBFLN, <CDBFLN==MBUFLN> ;IF MAGTAPE LENGTH IS GREATER
IFG DBUFLN-CDBFLN, <CDBFLN==DBUFLN> ;IF DECTAPE LENGTH IS GREATER
IFG SBUFLN-CDBFLN, <CDBFLN==SBUFLN> ;IF SPINDLE LENGTH IS GREATER
CPDIOB==<<2*CDBFLN>+177>/200 ;NUMBER OF DISK BLOCKS PER DEVICE AREA
CPDIOL==200*CPDIOB ;NUMBER OF WORDS FOR I/O TO THE FILE
CPDBUF: BLOCK CPDIOL ;THE BUFFER AREA FOR WORKING ON THE FILE
CADBUF==CPDBUF+<CPDIOL/2> ;AUXILLIARY AREA STARTS IN THE MIDDLE
SUBTTL ACTCHK - MAIN ROUTINES
;CHKAJB - ROUTINE TO CHECKPOINT ALL JOBS CURRENTLY LOGGED IN. ON EXIT, NEXT
; CHECKPOINT IS SET UP
CHKAJB: $CALL .SAVE1 ;SAVE A WORKING AC
; PUSHJ P,READJG ;READ GENERAL CHECKPOINT BLOCK
;DON'T REALLY NEED TO READ IT IN
PUSHJ P,DATIM ;GET CURRENT DATE/TIME
MOVEM S1,CPJGEN+LASTCH ;RECORD AS TIME OF LAST CHECKPOINT
MOVE S1,JOBMAX ;MAXIMUM NUMBER OF JOBS ALLOWED
MOVEM S1,CPJGEN+FILMJB ;RECORD FOR RESTART
MOVEI S1,CPJIOB ;NUMBER OF BLOCKS PER JOB IN CHECKPOINT FILE
MOVEM S1,CPJGEN+FILBPJ ;RECORD FOR VERSION CHECK
MOVEI S1,CPDIOB ;NUMBER OF BLOCKS PER DEVICE IN jjjDEV.BIN
MOVEM S1,CPJGEN+FILBPD ;RECORD FOR VERSION CHECK
PUSHJ P,WRITJG ;AND RE-WRITE THE BLOCK
MOVX P1,%NSHJB ;GET HIGHEST JOB IN THE SYSTEM
GETTAB P1, ;GET IT
ACTCGH: $BOMB <ACTCGH Cannot GETTAB Highest job in use>
CAMLE P1,JOBMAX ;CAN WE DO THIS MANY?
MOVE P1,JOBMAX ;STAY WITHIN THE FILE
MOVNS P1 ;FORM AOBJN
HRLZS P1 ;...
HRRI P1,1 ;SKIP THE NULL JOB
CHKAJ1: MOVNI T2,(P1) ;NEGATE JOB NUMBER
JOBSTS T2, ;SEE IF A REAL JOB
JRST CHKAJ2 ;CAN'T DO IT
TXNN T2,JB.ULI ;IS THE JOB LOGGED IN
JRST CHKAJ3 ;NO, TRY NEXT JOB
HRRZM P1,JOBNUM ;JOB NUMBER FOR CHKJOB
PUSHJ P,CHKJOB ;CHECKPOINT IT
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,CHJDVS ;CHECKPOINT THE JOBS DEVICES TOO
JRST CHKAJ3 ;ONWARD
CHKAJ2: $WTO (<Accounting error>,<^I/CHKTXT/>,,<$WTFLG(WT.SJI)>)
CHKAJ3: AOBJN P1,CHKAJ1 ;LOOP FOR ALL JOBS
SETZM JOBNUM ;JOB 0'S DEVICES ARE SYSTEM SPINDLES
PUSHJ P,CHJDVS ;CHECKPOINT THEM NOW
PUSHJ P,NXTCHK ;SET UP FOR NEXT CHECKPOINT
POPJ P, ;AND RETURN
CHJDVS: MOVEI T1,CHKDVS ;ROUTINE TO DO THE CHECKPOINT
PUSHJ P,ALLDEV ;DO THAT FOR ALL DEVICES
POPJ P, ;AND RETURN
CHKTXT: ITEXT (<Cannot read job status for job ^D/P1,RHMASK/
Job not checkpointed>)
;CHKJOB - ROUTINE TO CHECKPOINT THE JOB CHECKPOINT FILE, USEJOB.BIN ON ACT:.
; NOTE THAT THIS IS THE PRIMARY CHECKPOINT FILE...THE AUXILIARY FILE
; WILL NEVER BE CHECKPOINTED.
;CALL: PUSHJ P,CHKJOB
CHKJOB: PUSHJ P,READJP ;MUST READ IT IN CORE TO PRESERVE THE STATIC INFORMATION
SKIPE T1,DTMOFS ;WAS THERE A DATE/TIME CHANGE
PUSHJ P,[ADDM T1,CPJBUF+CJLGTM ;ADJUST LOGIN TIME OF JOB
ADDM T1,CPJBUF+CSESST ;AND SESSION START TIME
POPJ P,] ;DONE ADJUSTING
PUSHJ P,CHKPNT ;CHECKPOINT THE JOB'S DATA
PUSHJ P,WRITJP ;GO WRITE IT
POPJ P, ;AND RETURN
;ROUTINE TO CHECKPOINT THE DEVICE CHECKPOINT FILE FOR THIS JOB.
CHKDVS: PUSHJ P,@[EXP CHKFSR,CHKMTA,CHKDTA,CHKSPN]-1(P1) ;CHECKPOINT IT
SKIPE T1,DTMOFS ;WAS THERE A DATE/TIME CHANGE
PUSHJ P,@[EXP OFSFSR,OFSMTA,OFSDTA,OFSSPN]-1(P1) ;YES, ADJUST TIMES
PUSHJ P,WRITDP ;WRITE IT BACK OUT
POPJ P, ;RETURN FOR NEXT DEVICE
OFSFSR: ADDM T1,CPDBUF+FSESST ;ADJUST SESSION START TIME
ADDM T1,CPDBUF+FCREDT ;CREATION TIME OF REQUEST
ADDM T1,CPDBUF+FSCHDT ;SCHEDULED TIME OF REQUEST
ADDM T1,CPDBUF+FSERDT ;SERVICED TIME OF REQUEST
POPJ P, ;DONE ADJUSTING
OFSMTA: ADDM T1,CPDBUF+MSESST ;ADJUST SESSION START TIME
ADDM T1,CPDBUF+MCREDT ;CREATION TIME OF REQUEST
ADDM T1,CPDBUF+MSCHDT ;SCHEDULED TIME OF REQUEST
ADDM T1,CPDBUF+MSERDT ;SERVICED TIME OF REQUEST
POPJ P, ;DONE ADJUSTING
OFSDTA: ADDM T1,CPDBUF+DSESST ;ADJUST SESSION START TIME
ADDM T1,CPDBUF+DCREDT ;CREATION TIME OF REQUEST
ADDM T1,CPDBUF+DSCHDT ;SCHEDULED TIME OF REQUEST
ADDM T1,CPDBUF+DSERDT ;SERVICED TIME OF REQUEST
POPJ P, ;DONE ADJUSTING
OFSSPN: ADDM T1,CPDBUF+SCSHIF ;ADJUST SESSION START TIME
ADDM T1,CPDBUF+SMNTDT ;SPIN UP DATE/TIME
POPJ P, ;DONE ADJUSTING
;SESAJB - ROUTINE TO MAKE SESSION ENTRIES FOR ALL JOBS. CALLED WHEN IT IS
; TIME TO CLOSE OUT THE USAGE.OUT FILE OR WHEN A CSHIFT OCCURS
SESAJB: PUSHJ P,CHKAJB ;FIRST, CHECKPOINT ALL JOB INFORMATION
$CALL .SAVE1 ;SAVE A WORKING AC
MOVX P1,%NSHJB ;GET HIGHEST JOB IN USE RIGHT NOW
GETTAB P1, ;GET IT
JRST ACTCGH ;GIVE AN ERROR
CAMLE P1,JOBMAX ;CAN WE DO THIS MANY?
MOVE P1,JOBMAX ;STAY WITHIN THE FILE
MOVNS P1 ;FORM AOBJN
HRLZS P1 ;...
HRRI P1,1 ;SKIP THE NULL JOB
SESAJ1: HRRZM P1,JOBNUM ;STORE JOB NUMBER WE ARE DOING
PUSHJ P,READJP ;READ IN THE INFORMATION
SKIPN CPJBUF+CJOB ;IS THERE A JOB
JRST SESAJ2 ;NO, TRY THE NEXT
PUSHJ P,MAKSES ;MAKE THE SESSION ENTRY
PUSHJ P,CPJCOP ;MOVE PRIMARY DATA TO AUXILLIARY REGION
MOVE T1,CPJBUF+CLSTCK ;GET TIME OF LAST CHECKPOINT (=NOW)
MOVEM T1,CPJBUF+CSESST ;STORE AS SESSION START TIME
PUSHJ P,WRITJP ;AND RE-WRITE THE FILE
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,SESADV ;MAKE SESSION ENTRIES FOR ALL THE JOBS DEVICES TOO
SESAJ2: AOBJN P1,SESAJ1 ;TRY THE NEXT JOB
SETZM JOBNUM ;JOB 0 = SYSTEM SPINDLE INFO
PUSHJ P,SESADV ;DO THEM NOW
PUSHJ P,NXTCHK ;RESTART CHECKPOINT TIMER IF THIS TOOK A LONG TIME
POPJ P, ;AND RETURN
SESADV: MOVEI T1,SEADVS ;ROUTINE TO ACTUALLY MAKE THE ENTRIES
PUSHJ P,ALLDEV ;DO IT FOR ALL DEVICES
POPJ P, ;AND RETURN
;ROUTINE TO MAKE SESSION ENTRIES FOR ALL THE DEVICES OWNED BY A JOB
SEADVS: PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CPDCOP ;MOVE DATA ALREADY BILLED
MOVE T1,@[EXP CPDBUF+FLSTCK,CPDBUF+MLSTCK,CPDBUF+DLSTCK,CPDBUF+SLSTCK]-1(P1)
MOVEM T1,@[EXP CPDBUF+FSESST,CPDBUF+MSESST,CPDBUF+DSESST,CPDBUF+SCSHIF]-1(P1)
PUSHJ P,WRITDP ;WRITE IT BACK TO THE FILE
POPJ P, ;ALL DONE HERE
;READJG - ROUTINE TO READ THE GENERAL CHECKPOINT BLOCK OF THE PRIMARY JOB
; CHECKPOINT FILE. THE BLOCK NUMBER IS DEFINED BY CPJFIL AND SHOULD
; ALWAYS BE THE FIRST BLOCK OF THE FILE.
READJG: MOVEI T1,CPJFIL ;GET THE BLOCK NUMBER
MOVE T2,CPJCHN ; AND THE CHANNEL NUMBER
PUSHJ P,AUSETI ;POSITION THE INPUT
SKIPT
$BOMB <ACTCUG Cannot USETI (^O/T1/) to general checkpoint block>
MOVE T1,[IOWD 200,CPJGEN]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPJCHN ;CHANNEL NUMBER
HRRI T1,.FOINP ;READ
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPJBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPJBLK+.FOIOS
MOVE T1,[2,,CPJBLK]
FILOP. T1,
$BOMB <ACTCRG Cannot READ general checkpoint block>
$RETT
;WRITJG - ROUTINE TO WRITE THE GENERAL CHECKPOINT BLOCK OF THE PRIMARY JOB
; CHECKPOINT FILE. THE BLOCK NUMBER IS DEFINED BY CPJFIL AND SHOULD
; ALWAYS BE THE FIRST BLOCK OF THE FILE.
WRITJG: MOVEI T1,CPJFIL ;GET THE BLOCK NUMBER
MOVE T2,CPJCHN ; AND THE CHANNEL NUMBER
PUSHJ P,AUSETO ;POSITION THE OUTPUT
SKIPT
$BOMB <ACTCUG Cannot USETO to general checkpoint block>
MOVE T1,[IOWD 200,CPJGEN]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPJCHN ;CHANNEL NUMBER
HRRI T1,.FOOUT ;WRITE
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPJBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPJBLK+.FOIOS
MOVE T1,[2,,CPJBLK]
FILOP. T1,
$BOMB <ACTCWG Cannot WRITE general checkpoint block>
$RETT
;READJP - ROUTINE TO READ A BLOCK OF THE PRIMARY JOB CHECKPOINT FILE FOR A JOB.
;CALL: JOBNUM SET TO DESIRED JOB
READJP: MOVE T1,JOBNUM ;GET THE DESIRED JOB NUMBER
SOS T1 ;COMPUTE POSITION IN CHECKPOINT FILE
IMULI T1,CPJIOB ;*NUMBER OF BLOCKS PER CHECKPOINT AREA
ADDI T1,1+JBOFFS ;ADJUST + FILE OFFSET
MOVE T2,CPJCHN ;SET UP THE CHANNEL NUMBER
PUSHJ P,AUSETI ;POSITION THE INPUT
SKIPT
ACTCPC: $BOMB <ACTCPC Cannot position checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
MOVE T1,[IOWD CPJIOL,CPJBUF]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPJCHN ;CHANNEL NUMBER
HRRI T1,.FOINP ;READ
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPJBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPJBLK+.FOIOS
MOVE T1,[2,,CPJBLK]
FILOP. T1,
$BOMB <ACTCRP Cannot READ checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
$RETT
;WRITJP - ROUTINE TO WRITE A BLOCK OF THE PRIMARY JOB CHECKPOINT FILE FOR A JOB.
;CALL: JOBNUM SET TO DESIRED JOB
WRITJP: MOVE T1,JOBNUM ;GET THE DESIRED JOB NUMBER
SOS T1 ;COMPUTE POSITION IN CHECKPOINT FILE
IMULI T1,CPJIOB ;*NUMBER OF BLOCKS PER CHECKPOINT AREA
ADDI T1,1+JBOFFS ;ADJUST + FILE OFFSET
MOVE T2,CPJCHN ;SET UP THE CHANNEL NUMBER
PUSHJ P,AUSETO ;POSITION THE OUTPUT
JUMPF ACTCPC ;REPORT POSITIONING ERROR
MOVE T1,[IOWD CPJIOL,CPJBUF]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPJCHN ;CHANNEL NUMBER
HRRI T1,.FOOUT ;WRITE
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPJBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPJBLK+.FOIOS
MOVE T1,[2,,CPJBLK]
FILOP. T1,
$BOMB <ACTCWP Cannot WRITE checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
$RETT
;CBJZER - ROUTINE TO ZERO THE PRIMARY JOB CHECKPOINT FILE JOB SLOT BUFFER
; (CPJBUF). THIS IS USED TO INITIALIZE JOB SLOTS AT LOGIN TIME AND
; TO ENSURE DATA INTEGRITY IN CASE OF ERROR.
CBJZER: MOVE T1,[CPJBUF,,CPJBUF+1]
SETZM CPJBUF
BLT T1,CPJBUF+CBUFLN-1
POPJ P,
;CPJCOP - ROUTINE TO COPY THE PRIMARY CHECKPOINT FILE JOB SLOT BUFFER (CPJBUF)
; TO ITS COUNTERPART OF THE AUXILLIARY JOB CHECKPOINT FILE BUFFER (CAJBUF).
; THIS IS USED TO ZERO CAJBUF AND TO RETAIN INFORMATION IN CASE OF A SESSION
; COMMAND EVENT OR CSHIFT COMMAND EVENT.
CPJCOP: MOVE T1,[CPJBUF,,CAJBUF]
BLT T1,CAJBUF+CBUFLN-1
POPJ P,
;READDP - ROUTINE TO READ THE NEXT DEVICE AREA OF THE DEVICE CHECKPOINT FILE
; ALREADY OPENED.
;CALL: DEVNUM CONTAINS THE NUMBER OF READS ALREADY DONE (IN OTHER WORDS,
; NUMBER OF DEVICES ALREADY READ IN)
READDP: AOS T1,DEVNUM ;GET NUMBER OF READS DONE
SOS T1 ;COMPUTE POSITION IN CHECKPOINT FILE
IMULI T1,CPDIOB ;*NUMBER OF BLOCKS PER CHECKPOINT AREA
ADDI T1,1+DVOFFS ;ADJUST + FILE OFFSET
MOVE T2,CPDCHN ;SET UP THE CHANNEL NUMBER
PUSHJ P,AUSETI ;POSITION THE INPUT
JUMPF ACTPCF
MOVE T1,[IOWD CPDIOL,CPDBUF]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPDCHN ;CHANNEL NUMBER
HRRI T1,.FOINP ;READ
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPDBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPDBLK+.FOIOS
MOVE T1,[2,,CPDBLK]
FILOP. T1,
$BOMB <ACTRCF Cannot READ device checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
$RETT
ACTPCF:!TXNN T1,IO.EOF ;IS IT END OF FILE?
$BOMB <ACTPCF Cannot position device checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
PUSHJ P,CPDCLS ;CLOSE THE FILE
PUSHJ P,CPDSAU ;AND RE-OPEN IT (CLEAR EOF)
$RETF ;YES.
;WRITDP - ROUTINE TO WRITE A DEVICE AREA OF THE DEVICE CHECKPOINT FILE ALREADY
; OPENED.
;CALL: DEVNUM SET TO DESIRED DEVICE COUNT
WRITDP: MOVE T1,DEVNUM ;GET THE DESIRED JOB NUMBER
SOS T1 ;COMPUTE POSITION IN CHECKPOINT FILE
IMULI T1,CPDIOB ;*NUMBER OF BLOCKS PER CHECKPOINT AREA
ADDI T1,1+DVOFFS ;ADJUST + FILE OFFSET
MOVE T2,CPDCHN ;SET UP THE CHANNEL NUMBER
PUSHJ P,AUSETO ;POSITION THE OUTPUT
JUMPF ACTPCF ;REPORT POSITIONING ERROR
MOVE T1,[IOWD CPDIOL,CPDBUF]
MOVEM T1,IOLIST ;SET UP THE I/O LIST
SETZM IOLIST+1
MOVE T1,CPDCHN ;CHANNEL NUMBER
HRRI T1,.FOOUT ;WRITE
TXO T1,FO.PRV ;FULL FILE ACCESS TO ACT:
MOVEM T1,CPDBLK+.FOFNC
MOVEI T1,IOLIST
MOVEM T1,CPDBLK+.FOIOS
MOVE T1,[2,,CPDBLK]
FILOP. T1,
$BOMB <ACTWCF Cannot WRITE checkpoint file for job ^D/JOBNUM/, file status = ^O/T1/>
$RETT
;CBDZER - ROUTINE TO ZERO THE PRIMARY JOB CHECKPOINT FILE JOB SLOT BUFFER
; (CPJBUF). THIS IS USED TO INITIALIZE JOB SLOTS AT LOGIN TIME AND
; TO ENSURE DATA INTEGRITY IN CASE OF ERROR.
CBDZER: MOVE T1,[CPDBUF,,CPDBUF+1]
SETZM CPDBUF
BLT T1,CPDBUF+CDBFLN-1
POPJ P,
;CPDCOP - ROUTINE TO COPY THE PRIMARY CHECKPOINT FILE JOB SLOT BUFFER (CPDBUF)
; TO ITS COUNTERPART OF THE AUXILLIARY JOB CHECKPOINT FILE BUFFER (CADBUF).
; THIS IS USED TO ZERO CADBUF AND TO RETAIN INFORMATION IN CASE OF A SESSION
; COMMAND EVENT OR CSHIFT COMMAND EVENT.
CPDCOP: MOVE T1,[CPDBUF,,CADBUF]
BLT T1,CADBUF+CDBFLN-1
POPJ P,
;CHKPNT - ROUTINE CALLED FROM CHKJOB TO CHECKPOINT THE JOB (JOBNUM) AND STORE
; THE INFORMATION IN CPJBUF AND CPDBUF.
; CHKPNT IS DRIVEN BY TWO TABLES GENERATED BY THE "TABS" MACRO.
; THE FIRST TABLE CONTAINS THE ARGUMENT TO GETTAB; THE SECOND CONTAINS
; AN INSTRUCTION WHICH IS EXECUTED TO STORE THE RESULTS. NOTE THAT THIS
; MACRO IS BASED ON GETTAB'S INDEXED BY JOB NUMBER ONLY.
CHKPNT: MOVSI T2,-.NMTAB ;MAKE AN AOBJN POINTER
CHKPN1: MOVE T1,GTAB1(T2) ;GET AN ARGUMENT
HRL T1,JOBNUM ;GET THE JOB NUMBER
GETTAB T1, ;DO THE GETTAB
SETZ T1, ;CAN'T
XCT GTAB2(T2) ;STORE THE RESULT
AOBJN T2,CHKPN1 ;AND LOOP
;NOW GET ALL THE NECESSARY INFORMATION THAT CANNOT BE GETTAB'ED.
HRRZ T1,JOBNUM ;GET THE JOB NUMBER
TXO T1,RN.PCN ;GET THE RUNTIME TO THE NEAREST TEN-MICROSECOND
RUNTIM T1,
MOVEM T1,CPJBUF+CRUNTM;STORE IT
PUSHJ P,GTTTYS ;GET TTY STATISTICS
PUSHJ P,DATIM ;GET THE CURRENT DATE/TIME
MOVEM S1,CPJBUF+CLSTCK ;STORE AS TIME OF LAST CHECKPOINT
SKIPE CPJBUF+CJOB ;IS THE JOB KNOWN TO US
POPJ P, ;YES, STATIC INFORMATION IS CORRECT
;HERE WHEN CHECKPOINTING A JOB (SESSION OR LOGOUT ALSO) AND THE JOB ISN'T
; KNOWN TO THE ACTDAE. THIS USUALLY HAPPENS FOR JOBS STARTED BY INITIA
; OR VIA SYSJOB.INI (INCLUDES ACTDAE).
MOVE T1,JOBNUM ;THE JOB NUMBER
MOVEM T1,CPJBUF+CJOB ;STORE THE JOB NUMBER
MOVE T1,[SIXBIT/ACTDAE/] ;OUR NAME
MOVEM T1,CPJBUF+CPGNAM ;AS PROGRAM WHO PROVIDED THE DATA
MOVE T1,.JBVER ;OUR VERSION NUMBER
MOVEM T1,CPJBUF+CPGVER
MOVEM T1,CPJBUF+CACVER ;STORE IN BOTH PLACES
MOVSI T2,-.NUTAB ;MAKE AN AOBJN POINTER
CHKPN3: MOVE T1,GTAB3(T2) ;GET AN ARGUMENT
HRL T1,JOBNUM ;GET THE JOB NUMBER
GETTAB T1, ;DO THE GETTAB
SETZ T1, ;CAN'T
XCT GTAB4(T2) ;STORE THE RESULT
AOBJN T2,CHKPN3 ;AND LOOP
MOVE T1,[.ACTRD,,T2] ;READ ACCT STRING FUNCTION
MOVEI T2,2 ;NUMBER OF ARGS
HRRZ T3,JOBNUM ;THE JOB NUMBER
MOVEI T4,CPJBUF+CACCT ;WHERE TO PUT THE ACCOUNT STRING
SETZM CPJBUF+CACCT ;INCASE UUO FAILS
ACCT. T1, ;ASK FOR IT
$WTO (<Accounting error>,<^I/ACTTXT/>,,<$WTFLG(WT.SJI)>)
HRRZ T1,JOBNUM ;THE JOB NUMBER
PUSHJ P,SETTNL ;SET TERMINAL, NODE, LINE FOR JOB
MOVE T1,MONLNO ;SETTNL LEFT VALUES THERE
MOVEM T1,CPJBUF+CLINNO ;SO MOVE THEM INTO THE CHECKPOINT BLOCK
MOVE T1,MONNOD ;THE NODE NAME
MOVEM T1,CPJBUF+CNODE
MOVE T1,MONTDE ;THE TERMINAL DESIGNATOR
MOVEM T1,CPJBUF+CTERDE
POPJ P, ;AND RETURN
ACTTXT: ITEXT (<Cannot read account string while checkpointing
job ^D/JOBNUM/; assuming a null string>)
SUBTTL ACTCHK - GETTABS USED FOR CHECKPOINTING
;THE ARGUMENTS TO THE TABS MACRO ARE:
; 1) ARGUMENT TO GETTAB
; 2) INSTRUCTION TO STORE THE RESULT
DEFINE TABS,<
T <.GTRCT>,<PUSHJ P,DSKRED>
T <.GTWCT>,<PUSHJ P,DSKWRT>
T <.GTKCT>,<MOVEM T1,CPJBUF+CCTI>
T <.GTVKS>,<MOVEM T1,CPJBUF+CVCTI>
T <.GTEBT>,<MOVEM T1,CPJBUF+CEBOX>
T <.GTMBT>,<MOVEM T1,CPJBUF+CMBOX>
T <.GTUUC>,<MOVEM T1,CPJBUF+CMCALL>
T <.GTTRQ>,<MOVEM T1,CPJBUF+CQUTIM>
> ;END DEFINE TABS
DSKRED: ANDX T1,RC.TTL ;ISOLATE TOTAL DISK READS
MOVEM T1,CPJBUF+CDREAD ;STORE IT
POPJ P,
DSKWRT: ANDX T1,WC.TTL ;ISOLATE TOTAL DISK WRITES
MOVEM T1,CPJBUF+CDWRIT ;STORE IT
POPJ P,
;NOW GENERATE THE TABLES
DEFINE T(A,B),<
EXP <A>
>
GTAB1: TABS
.NMTAB==.-GTAB1
DEFINE T(A,B),<
EXP <B>
>
GTAB2: TABS
;THESE TABLES FOR JOBS LOGGED IN BEFORE THE ACTDAE STARTED (SYSJOB, INITIA)
DEFINE TABS,<
T <.GTPPN>,<MOVEM T1,CPJBUF+CPPN>
T <.GTNM1>,<MOVEM T1,CPJBUF+CNAME1>
T <.GTNM2>,<MOVEM T1,CPJBUF+CNAME2>
T <.GTJLT>,<MOVEM T1,CPJBUF+CSESST>
T <.GTLIM>,<PUSHJ P,ISBTCH>
T <.GTJLT>,<MOVEM T1,CPJBUF+CJLGTM>
> ;END DEFINE TABS
ISBTCH: TXNE T1,JB.LBT ;IS THIS A BATCH JOB
SKIPA T1,[2] ;YES, GET CODE FOR BATCH
MOVEI T1,1 ;NO, CODE FOR TIMESHARING JOB
MOVEM T1,CPJBUF+CJBTYP ;STORE TYPE
POPJ P, ;RETURN FOR MORE GETTABS
;NOW GENERATE THE TABLES
DEFINE T(A,B),<
EXP <A>
>
GTAB3: TABS
.NUTAB==.-GTAB3
DEFINE T(A,B),<
EXP <B>
>
GTAB4: TABS
;SUBROUTINE TO GET THE CURRENT TTY STATISTICS FOR THE JOB IN JOBNUM
; FILLS IN THE WORDS IN CPJBUF, DOESN'T DO ANYTHING IF THE JOB IS DETACHED
GTTTYS: HRRZ T3,JOBNUM ;GET THE JOB NUMBER
TRMNO. T3, ;LINE NUMBER OF JOB
POPJ P, ;ASSUME DETACHED
MOVEI T2,.TOBCT ;GET MONITOR COMMANDS IN LEFT HALF AND COUNT OF
MOVE T1,[2,,T2] ; BREAK CHARACTERS TYPED BY USER IN RIGHT HALF
TRMOP. T1,
SETZ T1, ;CAN'T GET IT
HLRM T1,CPJBUF+CTTCMD
HRRM T1,CPJBUF+CTTYBR
MOVEI T2,.TOICT ;COUNT OF BREAK CHARACTERS TYPED
MOVE T1,[2,,T2]
TRMOP. T1,
SETZ T1, ;CAN'T GET IT
MOVEM T1,CPJBUF+CTTYI
MOVEI T2,.TOOCT ;OUTPUT CHARACTERS (INCLUDING FILL)
MOVE T1,[2,,T2]
TRMOP. T1,
SETZ T1, ;CAN'T GET IT
MOVEM T1,CPJBUF+CTTYO
POPJ P, ;AND RETURN
;SETTNL - SUBROUTINE TO SET UP TERMINAL DESIGNATOR, NODE NAME AND LINE NUMBER
; FOR THE JOB IN T1. STORES VALUES IN MONTDE, MONLNO, AND MONNOD WHICH
; IS WHERE THE SYSTEM RESTART RECORD WOULD LIKE TO FIND THEM.
;USES T1-T4
SETTNL: SETZM MONLNO ;GET RID OF OLD STUFF FIRST
SETZM MONNOD ;...
MOVSI T4,(ASCIZ/D/) ;ASSUME DETACHED
TRMNO. T1, ;GET TERMINAL DESIGNATOR
JRST SETTN1 ;DETACHED
DPB T1,[POINT 9,MONLNO,35] ;STORE IN CASE NO NETWORKS
GETLCH T1 ;GET LINE CHARACTERISTICS
MOVSI T4,(ASCIZ/T/) ;ASSUME REGULAR TTY
TXNE T1,GL.CTY ;THE SYSTEM CTY
MOVSI T4,(ASCIZ/C/) ;YES
TXNE T1,GL.ITY ;INVISIBLE (PSEUDO) TTY
MOVSI T4,(ASCIZ/P/) ;YES
HRRZS T1 ;GET RID OF GETLCH BITS
GTNTN. T1, ;CONVERT TO NODE AND LINE
JRST SETTN1 ;NO NETWORKS
HRRZM T1,MONLNO ;STORE REAL LINE NUMBER
HLRZ T3,T1 ;ISOLATE NODE NUMBER
MOVEI T2,2 ;NUMBER OF ARGUMENTS
MOVE T1,[.NDRNN,,T2] ;RETURN NODE NAME FOR NUMBER
NODE. T1, ;ASK TODD
SKIPA ;FAILED?
MOVEM T1,MONNOD ;STORE SIXBIT NODE NAME
SETTN1: MOVEM T4,MONTDE ;STORE TERMINAL DESIGNATOR
POPJ P, ;AND RETURN
;CHKSPN - Routine to checkpoint a disk spindle data area. The
; device data area has already been read into CPDBUF.
; This routine will also be called whenever a dismount message
; is received for the device in CPDBUF.
CHKSPN: MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,CPDBUF+SLSTCK ;STORE IT IN THE BLOCK
$RETT
;CHKFSR - Routine to checkpoint a user file structure data area. The
; device data area has already been read into CPDBUF.
; This routine will also be called whenever a dismount message
; is received for the device in CPDBUF.
CHKFSR: MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,CPDBUF+FLSTCK ;STORE IT IN THE BLOCK
$RETT
;CHKDTA - Routine to checkpoint a user DECtape device data area. The
; device data area has already been read into CPDBUF.
; This routine will also be called whenever a dismount message
; is received for the device in CPDBUF.
CHKDTA: MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,CPDBUF+DLSTCK ;STORE IT IN THE BLOCK
$RETT
;CHKMTA - Routine to checkpoint a user magtape device data area. The
; device data area has already been read into CPDBUF.
; This routine will also be called whenever a dismount message
; is received for the device in CPDBUF.
CHKMTA: MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,CPDBUF+MLSTCK ;STORE IT IN THE BLOCK
MOVEI T2,MTABLK ;ADDRESS OF .TFSTA ARGUMENT BLOCK
MOVEI T1,.TFSTA
MOVEM T1,.TSFUN(T2) ;READ THE STATISTICS
MOVE T1,CPDBUF+DEVICE ;MAGTAPE DEVICE NAME
MOVEM T1,.TSDEV(T2)
MOVE T1,[.TSHWE+1,,MTABLK]
TAPOP. T1,
POPJ P, ;WHAT!
MOVE T1,.TSCRD(T2) ;MAGTAPE READS
MOVEM T1,CPDBUF+MMREAD
MOVE T1,.TSCWR(T2) ;MAGTAPE WRITES
MOVEM T1,CPDBUF+MMWRIT
MOVE T1,.TSSRE(T2) ;SOFT READ ERRORS
MOVEM T1,CPDBUF+MNOSRE
MOVE T1,.TSHRE(T2) ;HARD READ ERRORS
MOVEM T1,CPDBUF+MNOHRE
MOVE T1,.TSSWE(T2) ;SOFT WRITE ERRORS
MOVEM T1,CPDBUF+MNOSWE
MOVE T1,.TSHWE(T2) ;HARD WRITE ERRORS
MOVEM T1,CPDBUF+MNOHWE
MOVE T1,.TSREC(T2) ;RECORDS
MOVEM T1,CPDBUF+MRECRD
$RETT
MTABLK: BLOCK .TSHWE+1 ;BLOCK FOR TAPOP. STATISTICS
;FNDDEV - Routine to fine the device area for the specified job and device.
; If an empty device area is found, the device count is stored in
; DEVAVL.
;Call: JOBNUM contains the job number
; T1 contains the device name
;Returns false if EOF and the device area has not been found
;Returns true if the device area has been found. CPDBUF contains the data.
FNDDEV: $CALL .SAVE1
MOVE P1,T1 ;SAVE THE DEVICE NAME
PUSHJ P,CPDSAU ;OPEN THE DEVICE CHECKPOINT FILE
SETZM DEVNUM ;START WITH THE FIRST DEVICE IN THE FILE
SETZM DEVAVL ;INITIALIZE FOR FIRST AVAILABLE SLOT IN THE FILE
FNDDE1: $CALL READDP ;READ THE NEXT BLOCK
JUMPF [MOVE T1,DEVNUM ;EOF
SKIPN DEVAVL ;IS THERE AN EMPTY DEVICE AREA?
MOVEM T1,DEVAVL ;NO. INDICATE THE LAST OF THE FILE
$RETF]
CAMN P1,CPDBUF+DEVICE ;IS THIS THE CORRECT DEVICE?
$RETT ;YES.
SKIPE CPDBUF+DEVICE ;IS THIS AREA AVAILABLE?
JRST FNDDE1 ;NO. READ IN THE NEXT DEVICE AREA
MOVE T1,DEVNUM ;YES.
SKIPN DEVAVL ;HAS AN AREA ALREADY BEEN FOUND?
MOVEM T1,DEVAVL ;NO. STORE THIS DEVICE AREA COUNT
JRST FNDDE1 ;AND READ THE NEXT DEVICE AREA
;ALLDEV - ROUTINE TO FIND ALL THE DEVICES FOR A JOB AND CALL A SERVICE FOR
; EACH ONE AFTER READING THE DATA INTO CPDBUF.
;CALL T1 = 0,,ROUTINE TO SCAN THE FILE
; T1 = -1,,ROUTINE TO SCAN THEN DELETE THE FILE
; JOBNUM = THE JOB WE ARE LOOKING AT
;"ROUTINE" GET CALLED FOR EACH DEVICE WITH P1 = THE DEVICE TYPE NUMBER
ALLDEV: $CALL .SAVE2 ;SAVE SOME ACS
MOVE P2,T1 ;COPY ROUTINE TO CALL
PUSHJ P,CPDSAU ;OPEN THE CORRECT FILE
SETZM DEVNUM ;START AT THE BEGINNING OF THE FILE
ALLDV1: $CALL READDP ;READ IN A DEVICE AREA
JUMPF ALLDV2 ;END OF FILE
SKIPN CPDBUF+DEVICE ;IS THERE A DEVICE IN THIS AREA
JRST ALLDV1 ;NO, TRY THE NEXT AREA
SKIPLE P1,CPDBUF+DEVTYP ;GET DEVICE TYPE
CAILE P1,4 ;;;RANGE CHECK IT
ACTIDT: JRST [$WTO (<Accounting error>,<Unknown device type ^O/P1/>,,<$WTFLG(WT.SJI)>)
JRST ALLDV1] ;GET ANOTHER DEVICE
PUSHJ P,(P2) ;CALL ROUTINE WITH GOOD "P1"
JRST ALLDV1 ;AND GET ANOTHER DEVICE
ALLDV2: MOVE T1,DEVNUM ;GET DEVICE AFTER EOF
CAIE T1,1 ;IF FIRST, THEN FILE IS EMPTY, DELETE IT
SKIPGE P2 ;CALLER WANT FILE TO DISAPPEAR
PUSHJ P,CPDDEL ;YES, DELETE IT
PUSHJ P,CPDCLS ;CLOSE THE FILE
POPJ P, ;AND RETURN
SUBTTL ACTCHK - TIME KEEPING ROUTINES
DATIM: $CALL I%NOW ;GET THE CURRENT DATE/TIME
MOVEM S1,CURDTM ;SAVE IT
$RETT
;CHKTMR - RETURN NUMBER OF SECONDS INTO THE CURRENT HOUR
CHKTMR: MSTIME S1, ;GET MS. PAST MIDNIGHT
IDIVI S1,^D1000 ;GET SECONDS PAST MIDNIGHT
IDIVI S1,^D3600 ;S1 = THE HOUR, S2 = SECONDS PAST THE HOUR
POPJ P, ;RETURN VALUES
;NXTCHK - COMPUTE THE NEXT CHECKPOINT TIME
NXTCHK: PUSHJ P,CHKTMR ;FIND OUT CURRENT TIME IN CHECKPOINT UNITS
MOVSI S1,-INTBLN ;NUMBER OF ENTRIES IN THE TABLE
CAML S2,INTTBL(S1) ;STOP WHEN WE FIND ONE BEYOND NOW
AOBJN S1,.-1 ;KEEP LOOKING
HRRZM S1,CHKNDX ;SAVE INDEX INTO TABLE
POPJ P, ;RETURN
;CHKIVL - COMPUTE THE TIME REMAINING UNTIL A CHECKPOINT IS REQUIRED
; DOES THE CHECKPOINT IF IT IS TIME TO
CHKIVL: PUSHJ P,CHKTMR ;FIND OUT THE CURRENT TIME
SKIPGE S1,CHKNDX ;INDEX FOR NEXT COMPUTED TIME
JRST CHKIV1 ;FORCED ONE AT STARTUP, DO IT NOW
MOVE S1,INTTBL(S1) ;AND GET "WHEN" FROM TABLE
SUB S1,S2 ;S1 = TIME TO DESIRED CHECKPOINT
CAILE S1,CHKINT*^D60 ;IF TIME .GT. THE CHECKPOINT INTERVAL
SETO S1, ;THEN THIS IS WRAP AROUND ON THE HOUR
JUMPG S1,.POPJ ;RETURN TIME IF NOT YET TIME TO CHECKPOINT
CHKIV1: PUSHJ P,CHKAJB ;CHECKPOINT ALL ACTIVE JOBS
SKIPN FAIIFN ;IF NO FAILURE LOG FILE IFN, TRY OF OPEN FILE
PUSHJ P,OPNFAI
JRST CHKIVL ;RECOMPUTE/RETURN TIME TIL NEXT ONE
;THE TABLE USED FOR DETERMINING WHEN THE NEXT CHECKPOINT WILL OCCUR
INTTBL:
..VAL==0
REPEAT ^D60,<
..VAL==..VAL+<CHKINT*^D60>
IFL ..VAL-^D3600,<EXP ..VAL>
>
EXP ^D3600 ;LAST ENTRY AT THE FULL HOUR
INTBLN==.-INTTBL ;NUMBER OF ENTRIES IN THE TABLE
SUBTTL ACTUSG - MODULE TO HANDLE USAGE FILES
;GENERAL DEFINITIONS
USGBSZ: BLOCK 1 ;USAGE FILE BYTE SIZE
USGBPT: BLOCK 1 ;USAGE FILE BYTE POINTER
USGOSZ: BLOCK 1 ;SIZE OF USAGE.OUT AT FIRST SIGHT
USGIFN: BLOCK 1 ;GALAXY HANDLE FOR USAGE.OUT
USGPTR: BLOCK 1 ;BYTE POINTER INTO USGBUF FOR THE CURRENT ENTRY
SAVPTR: BLOCK 1 ;TEMPORARY STORAGE FOR USGPTR
USGBUF: BLOCK ^D200 ;BUFFERS WHERE USAGE ENTRIES ARE BUILT BEFORE BEING
; WRITTEN OUT TO THE USAGE.OUT FILE.
USGBND: ;FIRST WORD OUTSIDE THE BUFFER
NUMBER: BLOCK 1 ;TEMPORARY STORAGE FOR DATA BEING FORMATTED
USGENT: BLOCK 1 ;CURRENT ENTRY BEING WORKED ON
USGERD: BLOCK 1 ;CURRENT RECORD DEFINITION BLOCK FOR "USGENT"
JIFSEC: BLOCK 1 ;NUMBER OF JIFFIES/SECOND ON THIS MACHINE
ETICKS: BLOCK 1 ;NUMBER OF EBOX TICKS/JIFFY
MTICKS: BLOCK 1 ;NUMBER OF MBOX TICKS/JIFFY
FAIIFN: EXP 0 ;VALIDATION FAILURE FILE IFN
FAIPAG: EXP 0 ;ADDRESS OF VALIDATION FAILURE BUFFER
FAIMAX: EXP 0 ;MAXIMUM BYTES IN BUFFER
FAICNT: EXP 0 ;NUMBER OF BYTES THAT CAN FIT
FAIPTR: EXP 0 ;BYTE POINTER INTO BUFFER
USRZER: ;START ZEROING HERE
USRERR: BLOCK 1 ;ERROR CODE
USRJOB: BLOCK 1 ;JOB NUMBER OF OFFENDER
USRPPN: BLOCK 1 ;PPN OF OFFENDER
USRNAM: BLOCK 2 ;12 CHAR SIXBIT NAME OF OFFENDER
USRPRG: BLOCK 1 ;PROGRAM NAME OF OFFENDER
USRARG: BLOCK 1 ;START OF ARG BLOCK FOR NETOP.
USRFLG: BLOCK 1 ;FLAGS RETURNED BY NETOP.
USRUDX: BLOCK 1 ;UDX OF OFFENDER
USRDTY: BLOCK 1 ;DEVTYP OF HIS TTY
USRDCH: BLOCK 1 ;DEVCHR OF HIS TTY
USRNDA: BLOCK 1 ;ADDRESS OF STRING BLOCK CONTAINING HIS NODE
USRLNA: BLOCK 1 ;ADDRESS OF STRING BLOCK CONTAINING HIS LINE
USRTTY: BLOCK 1 ;TTY NAME OF OFFENDER
USRNOD: BLOCK 1 ;ANF NODE NUMBER OF OFFENDER
USRNDN: BLOCK <<^D16/4>+1> ;STRING BLOCK FOR NODE NAME OF OFFENDER
USRLIN: BLOCK <<^D16/4>+1> ;STRING BLOCK FOR LINE NAME OF OFFENDER
USRAPC: BLOCK 1 ;APC CODE OF OFFENDER
USRZEN==.-1
;USGMAK - ROUTINE TO DO PRELIMINARY SET UP FOR MAKING ANY KIND OF USAGE ENTRY.
; SO FAR ONLY QUEUE. UUO'S ARE ALLOWED FOR PROGRAMS OTHER THAN THE
; ACTDAE TO MAKE AN ENTRY.
;CALL: QUEADR/ ADDRESS OF MAKE AN ENTRY DATA WHICH CONTAINS:
; 0/ USENT$
; 1/ ENTRY TYPE
; 2/ BEGINNING OF DEFUS LIST
; MDBADR/ MESSAGE DESCRIPTOR BLOCK ADDRESS
; MMSADR/ MESSAGE DATA ADDRESS
USGMAK: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE AND IGNORE IT
MOVE T2,QUEADR ;ADDRESS OF DATA IN THE FORMAT THIS ROUTINE EXPECTS
MOVE T1,1(T2) ;ENTRY TYPE
MOVEI DEFADR,2(T2) ;BEGINNING ADDRESS OF DEFUS LIST
PUSHJ P,MAKENT ;MAKE THE ENTRY IN THE USAGE FILE
PUSH P,TF ;SAVE SUCCESS/FAILURE OF MAKENT
MOVE S1,QUELEN ;GIVE BACK THE MEMORY USED FOR DEFUS LIST
MOVE S2,QUEADR
$CALL M%RMEM
PUSHJ P,M%GPAG ;GET A PAGE FOR THE RESPONSE
MOVEM S1,SABADR ;STORE WHERE COMMON ROUTINES WANT IT
MOVX T1,MF.NOM ;NO MESSAGE (YET)
MOVEM T1,.MSFLG(S1) ;STORE FLAG SETTINGS
POP P,TF ;RESTORE RETURN FROM MAKENT
SKIPT ;DID MAKENT HONOR THE REQUEST
FATAL (IET,<Invalid entry type ^D/USGENT/>,ACIET%,.+1)
PJRST ACTVXT ;RELEASE OLD MSG AND SEND QUEUE UUO RESPONSE
;MAKENT - ROUTINE TO BE CALLED WHEN AN ENTRY IS TO BE APPENDED TO USAGE.OUT.
;CALL: MOVE T1,ENTRY NUMBER
; MOVE DEFADR,BEGINNING ADDRESS OF DEFUS DATA LIST
MAKENT: MOVEM T1,USGENT ;SAVE ENTRY NUMBER DESIRED
JUMPLE T1,.RETF ;FIRST ENTRY IS 1
CAIL T1,.UTUSR ;SYSTEM OR USER DEFINED ENTRY
JRST [SUBI T1,.UTUSR-1 ;USER, CONVERT TO TABLE INDEX
CAILE T1,ENTRUL## ;SEE IF DEFINED IN ACTRCD
$RETF ;NOPE, GIVE ERROR RETURN
MOVE T1,ENTRYU##-1(T1) ;GET RECORD DEFINITION ADDRESS
JRST MAKEN1] ;JOIN MAIN CODE AGAIN
CAILE T1,ENTRYL## ;SEE IF DEFINED IN ACTRCD
$RETF ;NOPE, GIVE ERROR RETURN
MOVE T1,ENTRYS##-1(T1) ;GET RECORD DEFINITION ADDRESS
MAKEN1: MOVEM T1,USGERD ;SAVE FOR DATFIL
MOVE S1,USGBPT ;GET BYTE POINTER
HRRI S1,USGBUF ;ADD IN ADDRESS
MOVEM S1,USGPTR ;STORE IT
SETZM USGBUF ;CLEAR THE WORKING BUFFER
MOVE S1,[USGBUF,,USGBUF+1]
BLT S1,USGBND-1 ;CLEAR IT
PUSHJ P,PREFIL ;GO PRE-FILL THE ENTRY
MOVE T1,USGPTR ;BYTE POINTER AT END
MOVEM T1,SAVPTR ;SAVE TO COMPUTE SIZE OF ENTRY
PUSHJ P,DATFIL ;NOW FILL IN THE SUPPLIED DATA
PUSHJ P,USGAPP ;GO PUT ENTRY INTO THE FILE
$RETT ;MAKENT SUCCEEDS
;PREFIL - ROUTINE TO PRE-FILL AN ENTRY IN CASE SOME DATA ISN'T PROVIDED BY
; THE CALLER.
;CALL: MOVE T1,ADDRESS OF RECORD LIST
; USGENT CONTAINS THE ENTRY NUMBER
PREFIL: $CALL .SAVE4
HRRZ P1,T1
TXO P1,<(P2)> ;PUT P2 IN INDEX REGISTER FOR "DOUBLE INDEXING"
MOVEI P2,1 ;FIRST RECORD SEQUENCE NUMBER
SKIPE MAKDUE ;ARE WE MAKING DISK USAGE ENTRIES (2ND HALF)
MOVEI P2,3 ;YES, GO STRAIGHT TO THE 3RD RECORD
PREFI1: HRRZ P3,@P1 ;GET ADDRESS OF DATA ITEM LIST
PUSHJ P,MAKHDR ;FILL FIRST 20 CHARACTERS
HLRZ P4,(P3) ;GET DATA ITEM COUNT -- P4 IS THE LOOP COUNTER
; OVER RECORD'S DATA LIST
ADDI P3,1 ;STEP TO BEGINNING OF DATA ITEMS IN LIST
PREFI2: MOVE T1,USGPTR ;GET BYTE POINTER TO THE BEGINNING OF THIS
MOVEM T1,1(P3) ; DATUM IN USGBUF AND SAVE IT IN THE
; SECOND WORD OF THIS DATUM'S DESCRIPTOR
MOVSI T1,(1B0) ;INDICATE NULL DATA IN T1
LDB T3,[POINT 12,(P3),11] ;GET CONVERSION TYPE
LDB LENGTH,[POINT 9,(P3),20] ;GET LENGTH OF DATA ITEM
PUSHJ P,CONVRT ;FILL
ADDI P3,2 ;STEP TO NEXT DATA ITEM DESCRIPTOR
SOJG P4,PREFI2 ;PRE-FILL THE RECORD
PUSHJ P,CRLF ;PUT IN CARRIAGE RETURN-LINE FEED
CAMGE P2,(P1) ;HAVE ALL RECORDS BEEN PRE-FILLED?
AOJA P2,PREFI1 ;NO. DO NEXT RECORD
POPJ P,
;CRLF - ROUTINE TO OUTPUT A CARRIAGE RETURN-LINE FEED.
CRLF: MOVEI T1,.CHCRT ;CARRIAGE RETURN
IDPB T1,USGPTR
MOVEI T1,.CHLFD ;LINE-FEED
IDPB T1,USGPTR
POPJ P,
;MAKHED - ROUTINE TO ENTER THE FIRST 20 CHARACTERS OF A RECORD.
; TO BE SAFE, THE ONLY ROUTINE CALLING THIS ONE IS PREFIL.
;
;CALL: MOVE P1,ADJUSTED INDEXED POINTER TO RECORD LIST
; MOVE P2,RECORD SEQUENCE #
; MOVE P3,ADDRESS OF RECORDS' DATA ITEM LIST
MAKHDR: MOVE T1,USGENT ;ENTRY TYPE ADDRESS
TXO T1,US%IMM ;INDICATE T1 CONTAINS DATA
MOVEI LENGTH,^D4 ;LENGTH OF FOUR
MOVEI T3,.USDEC ;DECIMAL CONVERSION
PUSHJ P,CONVRT
MOVEI T1,^D1 ;INDICATE TOPS10 OPERATING SYSTEM
TXO T1,US%IMM ;INDICATE THAT T1 CONTAINS THE DATA
MOVEI LENGTH,^D1 ;LENGTH OF 1
MOVEI T3,.USDEC ;DECIMAL CONVERSION
PUSHJ P,CONVRT
HRRZ T1,P2 ;RECORD SEQUENCE NUMBER
TXO T1,US%IMM ;INDICATE T1 CONTAINS DATA
MOVEI LENGTH,^D1 ;LENGTH OF 1
MOVEI T3,.USDEC ;DECIMAL CONVERSION
PUSHJ P,CONVRT
LDB T1,[POINT 9,(P3),26] ;DEC REVISION NUMBER
TXO T1,US%IMM ;INDICATE T1 CONTAINS DATA
MOVEI LENGTH,^D2 ;LENGTH OF 2
MOVEI T3,.USDEC ;DECIMAL CONVERSION
PUSHJ P,CONVRT
LDB T1,[POINT 9,(P3),35] ;CUSTOMER REVISION NUMBER
TXO T1,US%IMM ;INDICATE THAT T1 CONTAINS DATA
MOVEI LENGTH,^D2 ;LENGTH OF 2
MOVEI T3,.USDEC ;DECIMAL CONVERSION
PUSHJ P,CONVRT
MOVEI LENGTH,^D10 ;NOW DO THE FILLER
MOVEI T3,.USSPC ;SPACE CONVERSION
PUSHJ P,CONVRT
POPJ P,
;DATFIL - ROUTINE TO TAKE GIVEN DATA, CONVERT TO ASCII AND PUT IN ITS PROPER
; PLACE OF THE USAGE ENTRY IN USGBUF. NOTE THAT THE ENTRY SHOULD HAVE
; ALREADY BEEN PRE-FILLED SINCE THE BYTE POINTER OF EACH DATUM IS STORED
; IN ALL THE DATA ITEM LISTS. SEE PREFIL ROUTINE. USGENT SHOULD ALREADY
; CONTAIN THE ENTRY NUMBER.
; P1 WILL BECOME THE ADJUSTED INDEXED POINTER TO THE ENTRY'S RECORD LIST.
; P2 WILL CONTAIN THE RECORD SEQUENCE NUMBER CURRENTLY BEING SCANNED.
; P3 WILL CONTAIN THE ADDRESS OF THE CURRENT RECORD'S DATA LIST.
; P4 IS THE LOOP COUNTER OVER THE CURRENT RECORD'S DATA LIST.
; DEFADR CONTAINS THE ADDRESS OF THE DEFUS ITEM IN THE MESSAGE CURRENTLY
; BEING WORKED UPON. ALL DATA ITEMS OF ALL RECORDS OF AN ENTRY ARE SCANNED
; FOR EACH DATUM SUPPLIED IN THE MESSAGE. THAT WAY A PARTICULAR DATUM
; CAN APPEAR IN AN ENTRY TWICE BUT ONLY OCCUR ONCE IN THE MESSAGE.
;CALL: MOVE DEFADR, ADDRESS OF DATA CONSISTING OF DEFUS FORMATTED DATA (SEE ACTSYM)
DATFIL: $CALL .SAVE4
MOVE P1,USGERD ;GET ADDRESS OF THIS ENTRY'S RECORD LIST
DATFI1: SKIPN (DEFADR) ;IS THERE MORE DATA TO PUT IN THE ENTRY?
POPJ P, ;NO. ALL DONE PUTTING ENTRY IN USGBUF
TXO P1,<(P2)> ;PUT P2 IN INDEX REG. FOR "DOUBLE INDEXING"
MOVEI P2,1 ;FIRST RECORD SEQUENCE NUMBER
SKIPE MAKDUE ;ARE WE MAKING DISK USAGE ENTRIES (2ND HALF)
MOVEI P2,3 ;YES, GO STRAIGHT TO THE 3RD RECORD
DATFI2: HRRZ P3,@P1 ;GET ADDRESS OF THIS RECORD'S DATA ITEM LIST
HLRZ P4,(P3) ;RECORD'S DATA ITEM COUNT, P4 IS LOOP COUNTER
; OVER RECORD'S DATA LIST
ADDI P3,1 ;STEP TO BEGINNING OF RECORD'S DATA LIST
DATFI3: LDB T1,[POINTR (<(DEFADR)>,US%COD)] ;GET THE NUMBER OF DATA ITEM IN THE MESSAGE
LDB T2,[POINTR (<(P3)>,US%COD)] ;GET DEFUS NUMBER OF RECORD'S DATA ITEM
CAMN T1,T2 ;ARE THEY THE SAME?
PUSHJ P,PUTDAT ;YES. GO CONVERT DATA AND PUT IN USGBUF
ADDI P3,2 ;STEP TO NEXT DATA ITEM DESCRIPTOR IN RECORD LIST
SOJG P4,DATFI3 ;SCAN ALL DATA ITEMS IN THIS RECORD (P2)
CAMGE P2,(P1) ;HAVE ALL RECORDS BEEN SCANNED FOR THIS PIECE OF DATA?
AOJA P2,DATFI2 ;NO. DO NEXT RECORD
ADDI DEFADR,2 ;ADJUST POINTER TO MESSAGE TO POINT TO NEXT DATUM
JRST DATFI1 ; AND SCAN OVER ALL RECORDS
;PUTDAT - ROUTINE TO CONVERT AND PUT DATA ITEMS INTO USGBUF BASED ON BYTE
; POINTER STORED IN SECOND WORD OF RECORD MACRO FOR THE DATUM.
; SEE DATFIL FOR CORRECT AC SET UP.
PUTDAT: LDB T3,[POINTR (<(P3)>,US%TYP)] ;GET CONVERSION TYPE
LDB LENGTH,[POINTR (<(P3)>,US%LEN)] ;GET LENGTH OF DATUM
MOVE T1,1(DEFADR) ;GET THE SECOND WORD OF THIS DATUM
MOVE T2,1(P3) ;GET THE BYTE POINTER INTO USGBUF WHERE DATA STARTS
MOVEM T2,USGPTR ;CONVRT USES USGPTR AS THE COMMON BYTE POINTER
PJRST CONVRT ;PLACE THE DATA INTO USGBUF AND RETURN TO DATFIL
;CONVRT - ROUTINE TO BE CALLED TO CONVERT AND PUT DATA INTO THE USAGE FILE
; BLOCK (USGBUF) BASED ON THE BYTE POINTER USGPTR.
;CALL: MOVE T1,DATA IF BIT 0=1, OR
; ADDRESS OF DATA IF BIT 0=0
; MOVE LENGTH,LENGTH OF DATA ITEM
; MOVE T3,ITEM CONVERSION TYPE (SEE US%TYP DESCRIPTIONS IN ACCSYM)
; PUSHJ P,CONVRT
; RETURN HERE
CONVRT: PJRST @CONVR1(T3)
CONVR1: OUTASC ;PUT ASCII DATA IN ENTRY
OUTSIX ;PUT SIXBIT DATA IN ENTRY
OUTOCT ;PUT OCTAL NUMBER IN ENTRY
OUTDEC ;PUT DECIMAL NUMBER IN ENTRY
OUTDTM ;PUT DATE/TIME IN ENTRY (STANDARD FORMAT)
OUTSPC ;PUT A SPECIAL ITEM IN ENTRY
OUTVER ;PUT A VERSION NUMBER IN ENTRY (STANDARD FORMAT)
OUTSPC ;PUT ALL SPACES IN ENTRY
OUTODT ;PUT OLD FORMAT DATE/TIME
;OUTODT - ROUTINE TO OUTPUT OLD STYLE TOPS-10 DATE/TIME INTO FORMAT
; "YYYYMMDDHHMMSS" AND PLACE INTO USAGE BUFFER.
OUTODT: TXZN T1,US%IMM ;DOES T1 CONTAIN DATA OR AN ADDRESS
MOVE T1,(T1) ;ADDRESS, GET DATUM
JUMPE T1,OUTZER ;ZERO FILL IF NULL ARGUMENT
PUSH P,T1 ;SAVE DATE/TIME
HLRZ T1,T1 ;GET DATE
PUSHJ P,OUTDAT ;OUTPUT DATE
POP P,T1 ;RESTORE DATE/TIME
HRRZ T1,T1 ;ONLY TIME
IMULI T1,^D60*^D1000 ;CONVERT MINUTES AFTER TO MILLISECONDS
PJRST OUTTIM ;CONVERT TIME
;OUTASC - ROUTINE TO OUTPUT AN ASCIZ STRING INTO THE USAGE BUFFER.
;
;CALL: SEE CONVRT ROUTINE FOR SETUP AND CALL
OUTASC: TXZE T1,US%IMM ;DOES T1 CONTAIN THE DATA?
SKIPA T2,[POINT 7,T1] ;YES.
MOVSI T2,(POINT 7,(T1)) ;NO.
OUTAS1: ILDB T3,T2 ;NOW GET A CHARACTER
JUMPE T3,OUTSPC ;IF NULL, SPACE FILL THE REST
CAIGE T3,40 ;VALID ASCII CHARACTER?
MOVEI T3,"\" ;NO. PROVIDE ONE
IDPB T3,USGPTR ;PUT THE CHARACTER IN THE USAGE BUFFER
SOJG LENGTH,OUTAS1 ;LOOP BACK FOR NEXT CHARACTER
POPJ P, ;PERFECT FIT. RETURN.
;OUT8BT - ROUTINE TO OUTPUT AN 8-BIT ASCIZ STRING INTO THE USAGE BUFFER.
;
;CALL: SEE CONVRT ROUTINE FOR SETUP AND CALL
OUT8BT: TXZE T1,US%IMM ;DOES T1 CONTAIN THE DATA?
SKIPA T2,[POINT 8,T1] ;YES.
MOVSI T2,(POINT 8,(T1)) ;NO.
OUT8B1: ILDB T3,T2 ;NOW GET A CHARACTER
JUMPE T3,OUTSPC ;IF NULL, SPACE FILL THE REST
CAIGE T3,40 ;VALID ASCII CHARACTER?
MOVEI T3,"\" ;NO. PROVIDE ONE
IDPB T3,USGPTR ;PUT THE CHARACTER IN THE USAGE BUFFER
SOJG LENGTH,OUT8B1 ;LOOP BACK FOR NEXT CHARACTER
POPJ P, ;PERFECT FIT. RETURN.
;OUTSIX - ROUTINE TO FORMAT AND OUTPUT A SIXBIT WORD IN THE USAGE FILE. NOTE THAT
; THIS ROUTINE WILL ONLY HANDLE ONE WORD OF SIXBIT DATA. IF MORE THAN THAT
; IS REQUIRED, AN ASCIZ STRING SHOULD BE USED INSTEAD (SEE OUTASC).
;CALL: SEE CONVRT ROUTINE FOR SET UP AND CALL
OUTSIX: TXZN T1,US%IMM ;DOES T1 CONTAIN THE DATA?
MOVE T1,(T1) ;NO. GET THE DATA
MOVE T2,[POINT 6,T1] ;MAKE THE BYTE POINTER
OUTSX1: ILDB T3,T2 ;GET A CHARACTER
ADDI T3,40 ;CONVERT TO ASCII
IDPB T3,USGPTR ;PUT IT IN THE USAGE BUFFER
SOJG LENGTH,OUTSX1 ;LOOP UNTIL DONE
POPJ P, ;EXACT FIT OF SIX CHARACTERS. RETURN
;OUTOCT AND OUTDEC - ROUTINES TO PUT SIGNED NUMBERS INTO THE USAGE BUFFER.
; SEE CONVRT ROUTINE FOR SETUP AND CALL.
OUTOCT: SKIPA T4,[10] ;OCTAL ENTRY
OUTDEC: MOVEI T4,^D10 ;DECIMAL ENTRY
TXZN T1,US%IMM ;IS THE DATA IN T1 OR AN ADDRESS?
MOVE T1,(T1) ;IT'S AN ADDRESS. GET THE DATA.
PJRST NUMRHT ;CONVERT AND FORMAT THE NUMBER
;NUMRHT -- ROUTINE TO ENTER A NUMBER INTO USGBUF.
; (NUMBERS ARE ALWAYS RIGHT-JUSTIFIED IN THE USAGE FILE.)
;CALL: MOVE LENGTH,THE MAXIMUM LENGTH OF THE DATA ITEM
; MOVE T1,NUMBER TO BE PROCESSED
; MOVE T4,RADIX USED TO CONVERT
; PUSHJ P,NUMRHT
; RETURN HERE ALWAYS
NUMRHT: JUMPLE T1,OUTZER ;IF NUMBER IS ZERO THE FIELD HAS ALREADY BEEN FILLED
MOVEM T1,NUMBER ;SAVE NUMBER
MOVEI T3,1 ;COUNT THE FIRST DIVIDE
CAIGE T1,0 ;CHECK FOR NEGATIVE NUMBER
ADDI T3,1 ;ALLOW FOR NEGATIVE SIGN
NUMRH0: IDIVI T1,(T4)
SKIPE T1
AOJA T3,NUMRH0 ;T3 IS CHARACTER COUNT OF NUMBER
MOVE T1,NUMBER ;GET NUMBER
NUMRH1: CAMG T3,LENGTH ;SKIP IF NUMBER WON'T FIT IN FIELD
JRST [MOVEM T1,NUMBER ;STORE ADJUSTED NUMBER
JRST NUMRH2]
IDIVI T1,(T4) ;THROW AWAY LEAST SIGNIFICANT DIGIT
SOJA T3,NUMRH1 ;LOOP UNTIL NUMBER CAN FIT
NUMRH2: SUBI T3,(LENGTH) ;NUMBER OF CHARACTERS TO SKIP
SKIPN T3 ;IF ZERO DON'T ADJUST THE BYTE POINTER
JRST NUMRH4
MOVEI T1,"0" ;FILL WITH ZERO
NUMRH3: IDPB T1,USGPTR ;SKIP OVER ALL FILLS
AOJL T3,NUMRH3
NUMRH4: MOVE T1,NUMBER ;RESTORE THE NUMBER BEFORE WE FALL INTO RDXSTR
; PJRST RDXSTR
;FALL INTO RDXSTR
;RDXSTR -- PUT SIGNED NUMBER INTO USGBUF (NOTE THAT NO FILL IS DONE HERE)
;CALL: MOVE T1,NUMBER
; MOVE T4,RADIX
; PUSHJ P,RDXSTR
RDXSTR::JUMPGE T1,RDXST1 ;CHECK FOR NEGATIVE
MOVE T2,T1 ;SAVE AWAY ARGUMENT
MOVEI T1,"-" ;YES--GET MINUS
IDPB T1,USGPTR ;PUT IN STRING
MOVE T1,T2 ;RESTORE NUMBER
RDXST1: IDIV T1,T4 ;DIVIDE BY RADIX
MOVMS T2 ;GET MAGNITUDE
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;SEE IF ANYTHING LEFT
PUSHJ P,RDXST1 ;YES--LOOP BACK WITH PD LIST
HLRZ T1,(P) ;GET BACK A DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
IDPB T1,USGPTR
POPJ P,
;OUTDTM -- ROUTINE TO PROCESS UNIVERSAL DATE AND TIME (GETTAB %CNDTM) INTO
; FORMAT "YYYYMMDDHHMMSS" AND PLACE INTO USAGE BUFFER.
;CALL: SEE CONVRT ROUTINE FOR SETUP.
OUTDTM: TXZN T1,US%IMM ;DOES T1 CONTAIN DATA OR AN ADDRESS?
MOVE T1,(T1) ;T1 CONTAINS AN ADDRESS. GET THE DATA IN T1
JUMPE T1,OUTZER ;ZERO FILL IF NULL ARGUMENT
PUSHJ P,CNGDAT ;CHANGE DATE/TIME
PUSH P,T1 ;SAVE TIME
MOVE T1,T2 ;GET DATE
PUSHJ P,OUTDAT ;OUTPUT DATE
POP P,T1 ;RETURN TIME
PJRST OUTTIM ;CONVERT TIME
;OUTDAT -- OUTPUT ACCOUNTING DATE IN FORMAT OF YYYYMMDD
;CALL: MOVE T1,DATE RETURNED BY CNGDAT
; PUSHJ P,OUTDAT
OUTDAT: IDIVI T1,^D31*^D12 ;GET YEAR - 1964
PUSH P,T2 ;SAVE DAYS IN THE YEAR
MOVEI LENGTH,^D4 ;SET UP LENGTH SINCE JUSTIFICATION IS NECESSARY WITHIN ITEM
ADDI T1,^D1964 ;ADJUST YEAR
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
PUSHJ P,OUTDEC ;ENTER NUMBER IN USGBUF
POP P,T1 ;RETURN DAYS IN YEAR
IDIVI T1,^D31 ;GET MONTHS
ADDI T1,1 ;ADJUST MONTH #
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
PUSH P,T2 ;SAVE REMAINDER
MOVEI LENGTH,^D2 ;FIELD LENGTH
PUSHJ P,OUTDEC ;PUT IN USGBUF
POP P,T1 ;GET DAY NUMBER
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
AOJA T1,OUTDEC ;FIELD LENGTH SAME AS MONTHS
;OUTTIM -- ACCOUNTING TIME IN FORMAT HHMMSS
;CALL: MOVE T1, TIME RETURNED BY CNGDAT (IN MILLISECONDS)
; PUSHJ P,OUTTIM
OUTTIM: IDIV T1,[^D3600000] ;GET HOURS
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
PUSH P,T2 ;SAVE REMAINDER
MOVEI LENGTH,^D2 ;FIELD LENGTH
PUSHJ P,OUTDEC ;PUT IN USGBUF
POP P,T1 ;GET THE REST
IDIVI T1,^D60000 ;GET MINUTES
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
PUSH P,T2 ;SAVE REMAINDER
MOVEI LENGTH,2 ;FIELD LENGTH
PUSHJ P,OUTDEC ;PUT IN USGBUF
POP P,T1 ;GET THE REST
IDIVI T1,^D1000 ;GET SECONDS
TXO T1,US%IMM ;INDICATE THAT THE DATA IS IN T1
MOVEI LENGTH,2 ;FIELD LENGTH
PJRST OUTDEC ;PUT IN USGBUF
;CNGDAT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL: MOVE T1,DATE/TIME
; PUSHJ P,CNGDAT
; RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4
CNGDAT::PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNGDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
RADIX 10 ;**** NOTE WELL ****
ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
;T1=DAYS SINCE JAN 1, 1501
IDIVI T1,400*365+400/4-400/100+400/400
;SPLIT INTO QUADRACENTURY
LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS
IDIVI T2,<100*365+100/4-100/100>*4+400/400
;SPLIT INTO CENTURY
IORI T3,3 ;DISCARD FRACTIONS OF DAY
IDIVI T3,4*365+1 ;SEPARATE INTO YEARS
LSH T4,-2 ;T4=NO DAYS THIS YEAR
LSH T1,2 ;T1=4*NO QUADRACENTURIES
ADD T1,T2 ;T1=NO CENTURIES
IMULI T1,100 ;T1=100*NO CENTURIES
ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
TRNE T2,3 ;IS THE YEAR A MULT OF 4?
JRST CNGDT0 ;NO--JUST INDICATE NOT A LEAP YEAR
IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100
SKIPN T3 ;IF NOT, THEN LEAP
TRNN T2,3 ;IS YEAR MULT OF 400?
TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL
CNGDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG
;T3 IS 0 IF LEAP YEAR
;UNDER RADIX 10 **** NOTE WELL ****
CNGDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNGDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNGDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNGDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNGDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNGDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNGDT3 ;LOOP THROUGH NOVEMBER
CNGDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH
CNGDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNGDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8
;OUTVER -- PUT WORD IN VERSION NUMBER FORMAT. (NOTE THAT THIS ROUTINE ALWAYS
; DOES ITS OWN FORMATTING.)
;CALL: SEE CONVRT ROUTINE FOR THE SETUP.
; PUSHJ P,OUTVER
; RETURN HERE ALWAYS
OUTVER: TXZN T1,US%IMM ;DOES T1 CONTAIN DATA OR AN ADDRESS?
MOVE T1,(T1) ;AN ADDRESS. GET THE DATA
SKIPN T1 ;IF ZERO JUST DO SPACE FILL
JRST OUTSPC
MOVEI T4,10 ;SET UP RADIX HERE
MOVEM T1,NUMBER ;PUT THE VERSION NUMBER IN A SAFE PLACE
LDB T1,[POINT 9,NUMBER,11] ;GET MAJOR VERSION
SKIPE T1 ;IF NON-ZERO,
PUSHJ P,RDXSTR ;PUT OCTAL NUMBER IN STRING
LDB T1,[POINT 6,NUMBER,17] ;GET MINOR VERSION
JUMPE T1,OUTVE2 ;IF NON-ZERO,
SOS T1 ; PRINT IN MODIFIED
IDIVI T1,^D26 ; RADIX 26 ALPHA
JUMPE T1,OUTVE1 ; JUMP IF ONE CHAR
MOVEI T1,"A"-1(T1) ; ISSUE FIRST OF TWO
IDPB T1,USGPTR ; CHARACTERS
OUTVE1: MOVEI T1,"A"(T2) ; ISSUE "UNITS"
IDPB T1,USGPTR ; CHARACTER
OUTVE2: HRRZ T1,NUMBER ;GET EDIT NUMBER
JUMPE T1,OUTVE3 ;IF NON-ZERO,
MOVEI T2,"(" ; ISSUE
IDPB T2,USGPTR ; AS OCTAL WITHIN
PUSHJ P,RDXSTR ; PARENTHESES
MOVEI T1,")" ; ..
IDPB T1,USGPTR
OUTVE3: LDB T1,[POINT 3,NUMBER,2] ;GET "WHO" FIELD
JUMPE T1,.POPJ ;IF NON-ZERO,
MOVEI T2,"-" ; PRINT -
IDPB T2,USGPTR ; AND THEN
PJRST RDXSTR ; AS OCTAL
;OUTSPC - ROUTINE TO OUTPUT (LENGTH) SPACES INTO THE USAGE BUFFER USGBUF.
; THIS ROUTINE IS ALSO CALLED BY OTHERS TO FINISH UP ANY SPACE FILL.
;CALL: SEE CONVRT ROUTINE FOR SET UP AND CALL.
OUTSPC: JUMPLE LENGTH,.POPJ ;DON'T DO ANYTHING.
MOVEI T1," " ;ASCII SPACE
OUTSP1: IDPB T1,USGPTR ;OUTPUT THE CHARACTER IN THE USAGE BUFFER
SOJG LENGTH,OUTSP1 ;LOOP UNTIL DONE
POPJ P,
;OUTZER - ROUTINE TO OUTPUT (LENGTH) ZEROES INTO THE USAGE BUFFER USGBUF.
;CALL: SEE CONVRT ROUTINE FOR SET UP AND CALL.
OUTZER: JUMPLE LENGTH,.POPJ ;DON'T DO ANYTHING
MOVEI T1,"0" ;ASCII ZERO
OUTZE1: IDPB T1,USGPTR ;OUTPUT THE CHARACTER IN THE USAGE BUFFER
SOJG LENGTH,OUTZE1 ;LOOP UNTIL DONE
POPJ P,
;MAKSES - ROUTINE TO MAKE A SESSION ENTRY FROM THE PRIMARY AND AUXILIARY
; JOB CHECKPOINT FILES.
;CALL: JOBNUM CONTAINS THE JOB NUMBER
; CURDTM CONTAINS THE DATE/TIME FOR THE ENTRY
; CPJBUF AND CAJBUF CONTAIN THE JOBS INFORMATION
; PUSHJ P,MAKSES
; RETURN HERE
MAKSES: PUSHJ P,DODIFF ;GET THE SESSION'S DATA
MOVEI T1,.UTSEN ;INDICATE A SESSION ENTRY
MOVEI DEFADR,SESSIO ;ADDRESS OF SESSION ENTRY'S DEFUS LIST
PJRST MAKENT
;MKISES - ROUTINE TO MAKE AN INCOMPLETE SESSION ENTRY FOR RESTART
; SAME AS MAKSES EXCEPT DIFFERENT ENTRY CODE
MKISES: PUSHJ P,DODIFF ;GET THE SESSION DATA
MOVEI T1,.UTCKP ;INDICATE CAME FROM RESTART FILE
MOVEI DEFADR,SESSIO ;WHERE THE DEFUS LIST IS
PJRST MAKENT ;MAKE THE ENTRY
;DODIFF - ROUTINE TO CALCULATE THE ACTUAL VARIANT DATA OF ANY JOB'S SESSION.
; TO DO THIS, A DATUM OF THE JOB'S SLOT IN THE AUXILLIARY CHECKPOINT
; FILE IS SUBTRACTED FROM ITS COUNTERPART IN THE PRIMARY JOB CHECKPOINT
; FILE. IN SOME CASES, I.E., CONNECT TIME, CALCULATIONS HAVE TO BE
; MADE.
;CALL: A CHECKPOINT OF JOB HAS BEEN DONE (THIS IMPLIES THAT CURDTM, THE
; CURRENT DATE/TIME HAS BEEN UPDATED), AND THE JOB'S SLOTS OF BOTH
; CHECKPOINT FILES HAVE ALREADY BEEN READ INTO CPJBUF AND CAJBUF.
DODIFF: MOVE T1,CPJBUF+CRUNTM ;RUNTIME
SUB T1,CAJBUF+CRUNTM
IDIVI T1,^D100 ;CONVERT TO MS. FROM 10-US.
MOVEM T1,SESBLK+CRUNTM
MUL T1,JIFSEC ; RUNTIME/TIME IN RUN QUEUE
MULI T1,[^D100000000] ;RQT=(RUNTIME IN JIFFIES * JIFFIES PER SECOND
MOVE T2,CPJBUF+CQUTIM ; * 10**11)/1000
DIV T1,T2
MOVEM T1,SESBLK+CQUTIM
MOVE T1,CPJBUF+CLSTCK ;CALCULATE CONNECT TIME
SUB T1,CPJBUF+CSESST
MUL T1,[^D24*^D60*^D60]
DIV T1,[1,,0]
TRNE T2,1B18 ;SHOULD THE NUMBER BE ROUNDED?
AOS T1 ;YES.
MOVEM T1,SESCCT
MOVE T1,CPJBUF+CDREAD ;DISK READS
SUB T1,CAJBUF+CDREAD
MOVEM T1,SESBLK+CDREAD
MOVE T1,CPJBUF+CDWRIT ;DISK WRITES
SUB T1,CAJBUF+CDWRIT
MOVEM T1,SESBLK+CDWRIT
MOVE T1,CPJBUF+CCTI ;CORE-TIME INTEGRAL
SUB T1,CAJBUF+CCTI
IMULI T1,^D100
IDIV T1,JIFSEC
MOVEM T1,SESBLK+CCTI
MOVE T1,CPJBUF+CVCTI ;VIRTUAL CORE-TIME INTEGRAL
SUB T1,CAJBUF+CVCTI
IMULI T1,^D100
IDIV T1,JIFSEC
MOVEM T1,SESBLK+CVCTI
MOVE T1,CPJBUF+CEBOX ;EBOX RUNTIME
SUB T1,CAJBUF+CEBOX
MOVEM T1,SESBLK+CEBOX
MOVE T1,CPJBUF+CMBOX ;MBOX RUNTIME
SUB T1,CAJBUF+CMBOX
MOVEM T1,SESBLK+CMBOX
MOVE T1,CPJBUF+CMCALL
SUB T1,CAJBUF+CMCALL
MOVEM T1,SESBLK+CMCALL
DOFDTT: MOVE T1,CPJBUF+CTTCMD ;MONITOR COMMANDS
SUB T1,CAJBUF+CTTCMD
MOVEM T1,SESBLK+CTTCMD
MOVE T1,CPJBUF+CTTYI ;TERMINAL INPUT CHARACTERS
SUB T1,CAJBUF+CTTYI
MOVEM T1,SESBLK+CTTYI
MOVE T1,CPJBUF+CTTYO ;TERMINAL OUTPUT CHARACTERS
SUB T1,CAJBUF+CTTYO
MOVEM T1,SESBLK+CTTYO
MOVE T1,CPJBUF+CTTYBR ;TERMINAL BREAK CHARACTERS USER TYPED
SUB T1,CAJBUF+CTTYBR
MOVEM T1,SESBLK+CTTYBR
POPJ P,
;DEFUS LIST FOR SESSION AND INCOMPLETE SESSION ENTRIES
SESSIO: USJNO. (CPJBUF+CJOB) ;JOB NUMBER
USTAD. (CURDTM) ;CURRENT DATE/TIME
USTRM. (CPJBUF+CTERDE) ;TERMINAL DESIGNATOR
USLNO. (CPJBUF+CLINNO) ;LINE NUMBER
USPNM. (CPJBUF+CPGNAM) ;NAME OF PROGRAM (USUALLY LOGIN)
USPVR. (CPJBUF+CPGVER) ;VERSION OF USPNM.
USAMV. (CPJBUF+CACVER) ;VERSION OF ACTDAE
USNOD. (CPJBUF+CNODE) ;NODE NAME
USACT. (CPJBUF+CACCT) ;ACCOUNT STRING
USRTM. (SESBLK+CRUNTM) ;RUNTIME
USSST. (CPJBUF+CSESST) ;SESSION START DATE/TIME
USJTY. (CPJBUF+CJBTYP) ;JOB TYPE
USBJN. (CPJBUF+CBTNAM) ;BATCH JOB NAME
USBSN. (CPJBUF+CBTSEQ) ;BATCH SEQUENCE NUMBER
USCOM. (CPJBUF+CRMRK) ;SESSION REMARK
USCCT. (SESCCT) ;SESSION CONNECT TIME
USRIN. (CPJBUF+CBTRID) ;BATCH REQUEST ID
USDKR. (SESBLK+CDREAD) ;DISK READS
USDKW. (SESBLK+CDWRIT) ;DISK WRITES
USCTI. (SESBLK+CCTI) ;CORE-TIME INTEGRAL
USVTI. (SESBLK+CVCTI) ;VIRTUAL CORE-TIME INTEGRAL
USEBX. (SESBLK+CEBOX) ;EBOX MEGACOUNTS
USMBX. (SESBLK+CMBOX) ;MBOX MEGACOUNTS
USMCL. (SESBLK+CMCALL) ;MONITOR CALLS
USMCM. (SESBLK+CTTCMD) ;MONITOR COMMANDS
USSCL. (CPJBUF+CCLASS) ;SCHEDULING CLASS
USTYI. (SESBLK+CTTYI) ;TERMINAL INPUT CHARACTERS
USTYO. (SESBLK+CTTYO) ;TERMINAL OUTPUT CHARACTERS
USTYW. (SESBLK+CTTYBR) ;COUNT OF BREAK CHARACTERS USER TYPED
USRQQ. (SESBLK+CQUTIM) ;RUN QUEUE QUOTIENT -- RUNTIME/TIME IN QUEUE
USPPN. (CPJBUF+CPPN) ;PROJECT-PROGRAMMER NUMBER
USNM1. (CPJBUF+CNAME1) ;USER NAME
USNM3. (CPJBUF+CNAME2) ;USER NAME (SECOND WORD)
0 ;AND A ZERO TO TERMINATE THE LIST
SESCCT: BLOCK 1 ;SESSION CONNECT TIME
SESBLK: BLOCK CEND ;STORAGE FOR CALCULATED VALUES
;MAKFSR - Routine to make a user file structure entry based on the correct
; data being in CPDBUF.
MAKFSR: PUSHJ P,FSRDIF ;CALCULATE ANY DIFFERENCES
MOVEI T1,.UTMNT ;ENTRY TYPE
MOVEI DEFADR,FILMNT ;DEFUS LIST
PJRST MAKENT
;FSRDIF - Routine to calculate data needed to make a user file structure entry.
FSRDIF: MOVE T1,CPDBUF+FLSTCK ;CALCULATE CONNECT TIME
SUB T1,CPDBUF+FSESST
MUL T1,[^D24*^D60*^D60]
DIV T1,[1,,0]
TRNE T2,1B18 ;SHOULD THE NUMBER BE ROUNDED?
AOS T1 ;YES.
MOVEM T1,CPDBUF+FCONNE
POPJ P,
;DEFUS LIST FOR USER FILE STRUCTURE ENTRY
FILMNT: USJNO. (CPDBUF+FJOB) ;JOB NUMBER
USTAD. (CURDTM) ;CURRENT DATE/TIME
USTRM. (CPDBUF+FTERDE);TERMINAL DESIGNATOR
USLNO. (CPDBUF+FLINNO);LINE NUMBER
USPNM. (CPDBUF+FPGNAM);PROGRAM NAME
USPVR. (CPDBUF+FPGVER);PROGRAM VERSION NUMBER
USAMV. (CPDBUF+FACVER);ACTDAE VERSION NUMBER
USNOD. (CPDBUF+FNODE) ;NODE NAME
USFMA. (CPDBUF+FACCT) ;ACCOUNT OF USER
USSSI. (CPDBUF+DEVICE);FILE STRUCTURE NAME
USFST. (CPDBUF+FFSTYP);FILE STRUCTURE TYPE
USTNP. (CPDBUF+FPCKNO);NUMBER OF PACKS IN FILE STRUCTURE
USFCT. (CPDBUF+FCONTY);CONTROLLER TYPE
USFDT. (CPDBUF+FDEVTY);DEVICE TYPE
USFDS. (CPDBUF+FDISPO);DISPOSITION
USFOT. (CPDBUF+FOTEXT);TEXT TO EXPLAIN DISPOSITION
USFCD. (CPDBUF+FCREDT);CREATION DATE/TIME
USFSD. (CPDBUF+FSCHDT);SCHEDULED DATE/TIME
USSRV. (CPDBUF+FSERDT);SERVICED DATE/TIME
USMCT. (CPDBUF+FMNTCT);MOUNT COUNT BEFORE MOUNT
USDCT. (CPDBUF+FDISCT);MOUNT COUNT AFTER DISMOUNT
USATP. (CPDBUF+FACCES);ACCESS TYPE
USFCO. (CPDBUF+FCONNE);CONNECT TIME IN SECONDS
USPPN. (CPDBUF+FPPN) ;PROJECT-PROGRAMMER NUMBER OF USER
USNM1. (CPDBUF+FNAME1);USER NAME
USNM3. (CPDBUF+FNAME2);USER NAME (CONT.)
0 ;TERMINATE LIST WITH A ZERO
;MAKMAG - Routine to make a user magtape entry based on the correct
; data being in CPDBUF.
MAKMAG: PUSHJ P,MAGDIF ;CALCULATE ANY DIFFERENCES
MOVEI T1,.UTMMT ;ENTRY TYPE
MOVEI DEFADR,MAGMNT ;DEFUS LIST
PJRST MAKENT
;MAGDIF - Routine to calculate data needed to make a user magtape entry.
MAGDIF: MOVE T1,CPDBUF+MLSTCK ;CALCULATE CONNECT TIME
SUB T1,CPDBUF+MSESST
MUL T1,[^D24*^D60*^D60]
DIV T1,[1,,0]
TRNE T2,1B18 ;SHOULD THE NUMBER BE ROUNDED?
AOS T1 ;YES.
MOVEM T1,CPDBUF+MCONNE
MOVE T1,CPDBUF+MMREAD ;READS
SUB T1,CADBUF+MMREAD
IDIVI T1,^D1000 ;IN THOUSANDS
MOVEM T1,MGREAD
MOVE T1,CPDBUF+MMWRIT ;WRITES
SUB T1,CADBUF+MMWRIT
IDIVI T1,^D1000 ;IN THOUSANDS
MOVEM T1,MGWRIT
MOVE T1,CPDBUF+MRECRD ;RECORDS READ
SUB T1,CADBUF+MRECRD
SKIPGE T1 ;COULD BE -1 IF NEVER READ
SETZ T1, ;MAKE DATA CONSISTANT
MOVEM T1,MRCRED
MOVE T1,CPDBUF+MNOSRE ;SOFT READ ERRORS
SUB T1,CADBUF+MNOSRE
MOVEM T1,MAGSRE
MOVE T1,CPDBUF+MNOSWE ;SOFT WRITE ERRORS
SUB T1,CADBUF+MNOSWE
MOVEM T1,MAGSWE
MOVE T1,CPDBUF+MNOHRE ;HARD READ ERRORS
SUB T1,CADBUF+MNOHRE
MOVEM T1,MAGHRE
MOVE T1,CPDBUF+MNOHWE ;HARD WRITE ERRORS
SUB T1,CADBUF+MNOHWE
MOVEM T1,MAGHWE
POPJ P,
;DEFUS LIST FOR USER MAGTAPE ENTRY
MAGMNT: USJNO. (CPDBUF+MJOB) ;JOB NUMBER
USTAD. (CURDTM) ;DATE/TIME ENTRY IS MADE
USTRM. (CPDBUF+MTERDE);TERMINAL DESIGNATOR
USLNO. (CPDBUF+MLINNO);LINE NUMBER
USPNM. (CPDBUF+MPGNAM);PROGRAM NAME
USPVR. (CPDBUF+MPGVER);PROGRAM VERSION NUMBER
USAMV. (CPDBUF+MACVER);ACTDAE VERSION NUMBER
USNOD. (CPDBUF+MNODE) ;NODE NAME
USMAC. (CPDBUF+MACCT) ;USER ACCOUNT STRING
USVID. (CPDBUF+MVOLID);VOLUME ID RECORDED IN VOL1 LABEL
USVSN. (CPDBUF+MRELID);VISUAL LABEL OF TAPE
USMRF. (MGREAD) ;MAGTAPE READS - THOUSANDS OF CHARS
USMWF. (MGWRIT) ;MAGTAPE WRITES - THOUSANDS OF CHARS
USMDS. (CPDBUF+MDISPO);DISPOSITION
USMTX. (CPDBUF+MOTEXT);TEXT TO EXPLAIN DISPOSITION
USMCD. (CPDBUF+MCREDT);CREATION DATE/TIME OF REQUEST
USMSD. (CPDBUF+MSCHDT);SCHEDULED DATE/TIME OF MOUNT REQUEST
USMVD. (CPDBUF+MSERDT);SERVICED DATE/TIME OF MOUNT REQUEST
USMCO. (CPDBUF+MCONTY);TYPE OF CONTROLLER
USMLT. (CPDBUF+MLABEL);LABEL TYPE
USMLS. (CPDBUF+MSTATE);VOLUME LABEL STATE
USMRD. (MRCRED) ;RECORDS READ
USMWR. (MRCWRI) ;RECORDS WRITTEN
USFSI. (CPDBUF+MFSTID);FILE SET IDENTIFIER
USSRE. (MAGSRE) ;NUMBER OF SOFT READ ERRORS
USSWE. (MAGSWE) ;NUMBER OF SOFT WRITE ERRORS
USHRE. (MAGHRE) ;NUMBER OF HARD READ ERRORS
USHWE. (MAGHWE) ;NUMBER OF HARD WRITE ERRORS
USMCN. (CPDBUF+MCONNE);CONNECT TIME IN SECONDS
USDVN. (CPDBUF+MEVICE) ;PHYSICAL DEVICE NAME
USPPN. (CPDBUF+MPPN) ;PROJECT PROGRAMMER NUMBER
USNM1. (CPDBUF+MNAME1);USER NAME
USNM3. (CPDBUF+MNAME2);USER NAME (CONT.)
0 ;TERMINATE LIST WITH A ZERO
;MAKDEC - Routine to make a user DECtape entry based on the correct
; data being in CPDBUF.
MAKDEC: PUSHJ P,DECDIF ;CALCULATE ANY DIFFERENCES
MOVEI T1,.UTDMT ;ENTRY TYPE
MOVEI DEFADR,DECMNT ;DEFUS LIST
PJRST MAKENT
;DECDIF - Routine to calculate data needed to make a user DECtape entry.
DECDIF: MOVE T1,CPDBUF+DLSTCK ;CALCULATE CONNECT TIME
SUB T1,CPDBUF+DSESST
MUL T1,[^D24*^D60*^D60]
DIV T1,[1,,0]
TRNE T2,1B18 ;SHOULD THE NUMBER BE ROUNDED?
AOS T1 ;YES.
MOVEM T1,CPDBUF+DCONNE
POPJ P,
;DEFUS LIST FOR USER DECTAPE ENTRY
DECMNT: USJNO. (CPDBUF+DJOB) ;JOB NUMBER
USTAD. (CURDTM) ;DATE/TIME ENTRY IS MADE
USTRM. (CPDBUF+DTERDE);TERMINAL DESIGNATOR
USLNO. (CPDBUF+DLINNO);LINE NUMBER
USPNM. (CPDBUF+DPGNAM);PROGRAM NAME
USPVR. (CPDBUF+DPGVER);PROGRAM VERSION NUMBER
USAMV. (CPDBUF+DACVER);ACTDAE VERSION NUMBER
USNOD. (CPDBUF+DNODE) ;NODE NAME
USDAN. (CPDBUF+DACCT) ;ACCOUNT STRING OF USER
USDVI. (CPDBUF+DVOLID);DECTAPE LABEL
USDRI. (CPDBUF+DRELID);VISUAL LABEL OF DECTAPE
USDTR. (DECRED) ;DECTAPE READS
USDTW. (DECWRI) ;DECTAPE WRITES
USDDS. (CPDBUF+DDISPO);DISPOSITION
USDTX. (CPDBUF+DOTEXT);TEXT TO EXPLAIN DISPOSITION
USDCE. (CPDBUF+DCREDT);CREATION DATE/TIME
USDSQ. (CPDBUF+DSCHDT);SCHEDULED DATE/TIME
USDSS. (CPDBUF+DSERDT);SERVICED DATE/TIME
USDCN. (CPDBUF+DCONNE);CONNECT TIME
USDVN. (CPDBUF+DDVICE) ;PHYSICAL DEVICE NAME
USPPN. (CPDBUF+DPPN) ;PROJECT PROGRAMMER NUMBER
USNM1. (CPDBUF+DNAME1);USER NAME
USNM3. (CPDBUF+DNAME2);USER NAME (CONT.)
0 ;TERMINATE LIST WITH A ZERO
;MAKSPN - Routine to make a disk spindle entry based on the correct
; data being in CPDBUF.
MAKSPN: PUSHJ P,SPNDIF ;CALCULATE ANY DIFFERENCES
MOVEI T1,.UTDSU ;ENTRY TYPE
MOVEI DEFADR,DSKMNT ;DEFUS LIST
PJRST MAKENT
;SPNDIF - Routine to calculate data needed to make a disk spindle entry.
SPNDIF: MOVE T1,CPDBUF+SLSTCK ;CALCULATE CONNECT TIME
SUB T1,CPDBUF+SCSHIF
MUL T1,[^D24*^D60*^D60]
DIV T1,[1,,0]
TRNE T2,1B18 ;SHOULD THE NUMBER BE ROUNDED?
AOS T1 ;YES.
MOVEM T1,CPDBUF+SCONNE
POPJ P,
;DEFUS LIST FOR DISK PACK SPINDLE ENTRY
DSKMNT: USJNO. (CPDBUF+SJOB) ;JOB NUMBER
USTAD. (CURDTM) ;DATE/TIME ENTRY IS MADE
USTRM. (CPDBUF+STERDE);TERMINAL DESIGNATOR
USLNO. (CPDBUF+SLINNO);LINE NUMBER
USPNM. (CPDBUF+SPGNAM);PROGRAM NAME
USPVR. (CPDBUF+SPGVER);PROGRAM VERSION NUMBER
USAMV. (CPDBUF+SACVER);ACTDAE VERSION NUMBER
USNOD. (CPDBUF+SNODE) ;NODE NAME
USSFS. (CPDBUF+SFSNAM);FILE STRUCTURE NAME
USSFT. (CPDBUF+SFSTYP);FILE STRUCTURE TYPE
USSCT. (CPDBUF+SCONTY);CONTROLLER TYPE
USSDT. (CPDBUF+SDEVTY);DEVICE TYPE
USSID. (CPDBUF+SPAKID);DISK PACK IDENTIFIER
USSDU. (CPDBUF+SEVICE) ;DISK UNIT NAME
USSNP. (CPDBUF+SPCKNO);TOTAL NUMBER OF PACKS IN FILE STRUCTURE
USSMN. (CPDBUF+SPKMTH);M OF N COUNT
USDTF. (CPDBUF+SMNTDT);DATE/TIME PACK WAS FIRST SPUN UP
USDCC. (CPDBUF+SCONNE);CONNECT TIME
0 ;TERMINATE LIST WITH A ZERO
;STORAGE FOR CALCULATED VALUES
DECRED: BLOCK 1 ;DECTAPE READS (NOT IMPLEMENTED)
DECWRI: BLOCK 1 ;DECTAPE WRITES (NOT IMPLEMENTED)
MAGHRE: BLOCK 1 ;MAGTAPE HARD READ ERRORS
MAGHWE: BLOCK 1 ;MAGTAPE HARD WRITE ERRORS
MAGSRE: BLOCK 1 ;MAGTAPE SOFT READ ERRORS
MAGSWE: BLOCK 1 ;MAGTAPE SOFT WRITE ERRORS
MGREAD: BLOCK 1 ;MAGTAPE READS
MGWRIT: BLOCK 1 ;MAGTAPE WRITES
MRCRED: BLOCK 1 ;MAGTAPE RECORDS READ
MRCWRI: BLOCK 1 ;MAGTAPE RECORDS WRITTEN (TOPS-20 ONLY)
;MAKUFH - ROUTINE TO MAKE A USAGE FILE HEADER WHEN USAGE.OUT IS INITIALLY CREATED.
MAKUFH: PUSHJ P,DOUFHD ;FILL IN A USAGE FILE HEADER
MOVEI T1,.UTUSB ;FIRST RECORD OF USAGE.OUT
MOVEI DEFADR,UFHLST ;POINT TO THE DEFUS LIST
PJRST MAKENT ;MAKE THE ENTRY AND RETURN
;MAKRES - ROUTINE TO MAKE A SYSTEM OR ACTDAE RESTART RECORD
MAKRES: PUSHJ P,DOREST ;FILL IN A RESTART RECORD
MOVEI T1,.UTRST ;SYSTEM/ACTDAE RESTART
MOVEI DEFADR,RESLST ;POINT TO THE DEFUS LIST
PJRST MAKENT
;DOREST - FILL IN THE DEFUS ITEMS FOR A SYSTEM RESTART RECORD
; THE UFH RECORD IS THE SAME FORMAT SO THERE IS ONLY 1
; ROUTINE TO GATHER THE DATA FOR BOTH OF THEM.
DOUFHD: ;OTHER NAME
DOREST: MOVSI T2,-.NXTAB ;MAKE AN AOBJN POINTER
RESTA1: MOVE T1,GTAB5(T2) ;GET AN ARGUMENT
GETTAB T1, ;DO THE GETTAB
SETZ T1, ;ASSUME 0
XCT GTAB6(T2) ;STORE THE RESULT
AOBJN T2,RESTA1 ;AND LOOP
PJOB T1, ;GET OUT JOB NUMBER
MOVEM T1,MONJNO ;SAVE IT AWAY
PUSHJ P,SETTNL ;SET UP TERMINAL, NODE AND LINE
POPJ P, ;AND RETURN
DEFINE TABS,<
T <%CNFG0>,<MOVEM T1,MONAME+0>
T <%CNFG1>,<MOVEM T1,MONAME+1>
T <%CNFG2>,<MOVEM T1,MONAME+2>
T <%CNFG3>,<MOVEM T1,MONAME+3>
T <%CNFG4>,<MOVEM T1,MONAME+4>
T <%CNVER>,<MOVEM T1,MONVER>
T <%CCSER+2*0>,<MOVEM T1,MONCPI+0>
T <%CCSER+2*1>,<MOVEM T1,MONCPI+1>
T <%CCSER+2*2>,<MOVEM T1,MONCPI+2>
T <%CCSER+2*3>,<MOVEM T1,MONCPI+3>
T <%CCSER+2*4>,<MOVEM T1,MONCPI+4>
T <%CCSER+2*5>,<MOVEM T1,MONCPI+5>
T <%CNCPU>,<MOVEM T1,MONCPN>
T <%CNSUP>,<PUSHJ P,SYSUPT>
> ;END DEFINE TABS
SYSUPT: PUSH P,T2 ;SAVE LOOP INDEX
IDIV T1,JIFSEC ;CONVERT JIFFIES TO SECONDS
MOVEM T1,MONUPT ;SAVE UPTIME
POP P,T2 ;RESTORE AC
POPJ P, ;RETURN TO GET ANOTHER
;NOW GENERATE THE TABLES
DEFINE T(A,B),<
EXP <A>
>
GTAB5: TABS
.NXTAB==.-GTAB5
DEFINE T(A,B),<
EXP <B>
>
GTAB6: TABS
MONJNO: BLOCK 1 ;SPACE FOR ACTDAE JOB NUMBER
MONLNO: BLOCK 1 ;SPACE FOR ACTDAE LINE NUMBER
MONNOD: BLOCK 1 ;SPACE FOR ACTDAE NODE NUMBER
MONTDE: BLOCK 1 ;SPACE FOR ACTDAE TERMINAL DESIGNATOR
MONCPN: BLOCK 1 ;SPACE FOR NUMBER OF CPUS IN CONFIG
MONUPT: BLOCK 1 ;SPACE FOR SYSTEM UPTIME (IN SECONDS)
MONVER: BLOCK 1 ;SPACE FOR MONITOR VERSION NUMBER
MONAME: BLOCK 10 ;SPACE FOR MONITOR NAME IN ASCII
MONCPI: BLOCK 6 ;SPACE FOR CPU0 THROUGH CPU5 APR ID
;THE DEFUS LIST PROPER FOR RESTART AND NEW FILE RECORDS
UFHLST:
RESLST: USJNO. (MONJNO) ;OUR JOB NUMBER
USTAD. (CURDTM) ;CURRENT DATE/TIME
USTRM. (MONTDE) ;OUR TERMINAL DESIGNATOR
USLNO. (MONLNO) ;OUR LINE NUMBER
USPNM. ([SIXBIT/ACTDAE/]) ;PROGRAM MAKING THE ENTRY
USPVR. (.JBVER) ;VERSION NUMBER
USAMV. (.JBVER) ;VERSION OF THE ACTDAE
USNOD. (MONNOD) ;OUR NODE NAME
USSNM. (MONAME) ;MONITOR NAME
USMVR. (MONVER) ;MONITOR VERSION NUMBER
USMUP. (MONUPT) ;SYSTEM UPTIME
USCPN. (MONCPN) ;NUMBER OF CPUS FROM MONGEN
USCP0. (MONCPI+0) ;APRID OF CPU0
USCP1. (MONCPI+1) ;APRID OF CPU1
USCP2. (MONCPI+2) ;APRID OF CPU2
USCP3. (MONCPI+3) ;APRID OF CPU3
USCP4. (MONCPI+4) ;APRID OF CPU4
USCP5. (MONCPI+5) ;APRID OF CPU5
USLCK. (CPJGEN+LASTCH) ;LAST CHECKPOINT DATE/TIME IS ALWAYS THERE
0 ;AND A ZERO THE TERMINATE THE DEFUS LIST
;DOUBC - CALLED BY QUASAR TO DO BILLING CLOSURE
DOUBC: PUSHJ P,SESAJB ;MAKE ENTRIES FOR ALL JOBS
$WTOXX <Session entries written for all jobs>
$RETT ;AND RETURN
;DOUFC - ROUTINE TO CLOSE OUT BILLING SESSION FOR ALL ACTIVE JOBS AND THEN
; CLOSE/RENAME/RE-OPEN USAGE.OUT. CALLED BY QUASAR (SET USAGE FILE-CLOSURE)
DOUFC: $CALL .SAVE1 ;SAVE P1 FOR A MOMENT
MOVE T1,MMSADR ;GET MESSAGE ADDRESS
MOVE P1,.OFLAG(T1) ;GET FLAGS
TXNN P1,US.NOS ;DO WE WANT /SOME-SESSION-ENTRIES
PUSHJ P,SESAJB ;YES, CLOSE OUT ALL THE SESSIONS
PUSHJ P,USGCRN ;CLOSE, RENAME USAGE.OUT
JUMPF USGUF2 ;GIVE DIFFERENT MESSAGE IF DIDN'T MAKE IT
$WTOXX <^F/USGFD/ closed and renamed to ^F/USGRFD/>
USGUF1: PUSHJ P,USGSAU ;RE-OPEN THE FILE
SKIPN USGOSZ ;DID THE RENAME WORK (NEW FILE SIZE = 0)
PUSHJ P,MAKUFH ;YES, MAKE A USAGE FILE HEADER RECORD
$RETT ;AND RETURN
USGUF2: $WTOXX <Cannot rename ^F/USGFD/, continuing with old file>
JRST USGUF1 ;RESUME
SUBTTL ACTIO - MODULE CONTAINING COMMON INPUT/OUTPUT ROUTINES
;CPJSAU - ROUTINE TO OPEN THE PRIMARY JOB CHECKPOINT FILE, USEJOB.BIN, IN
; SINGLE ACCESS UPDATE MODE.
; CPJCHN - CHANNEL NUMBER
; CPJBLK - FILOP. BLOCK
; USEJOB - LOOPUP/ENTER BLOCK
CPJSAU: SKIPN T1,CPJCHN ;DOES A CHANNEL ALREADY EXIST?
TXO T1,FO.ASC ;NO. HAVE THE MONITOR GIVE US ONE.
TXO T1,FO.PRV ;GIVE US FULL FILE ACCESS TO ACT:
HRRI T1,.FOSAU ;OPEN FOR UPDATE MODE
MOVEM T1,CPJBLK+.FOFNC
MOVEI T1,.IODMP ;DUMP MODE
TXO T1,UU.RRC ;LET TONY KEEP THE RIB UP TO DATE
MOVEM T1,CPJBLK+.FOIOS
HRLZ T1,ACTDEV
MOVEM T1,CPJBLK+.FODEV
SETZM CPJBLK+.FOBRH
SETZM CPJBLK+.FONBF
MOVEI T1,USEJOB ;THIS IS THE EXTENDED LOOKUP BLOCK
MOVEM T1,CPJBLK+.FOLEB
MOVEI T1,.RBSIZ
MOVEM T1,USEJOB+.RBCNT
SETZM USEJOB+.RBPPN ;NO PPN SPECIFIED
SETZM USEJOB+.RBPRV ;CLEAR DATE/TIME WORD
SETZM USEJOB+.RBSIZ ;CLEAR OLD SIZE VALUE
MOVE T1,[SIXBIT /USEJOB/]
MOVEM T1,USEJOB+.RBNAM
MOVSI T1,'BIN'
MOVEM T1,USEJOB+.RBEXT
MOVE T1,[7,,CPJBLK]
FILOP. T1,
$BOMB <ACTCOB Cannot OPEN (^O/T1/) ^W/USEJOB+.RBNAM/.^W3/USEJOB+.RBEXT/>
SKIPE T1,CPJCHN ;WAS THERE A CHANNEL BEFORE?
POPJ P, ;YES. NO NEED TO STORE ONE
MOVE T1,CPJBLK+.FOFNC
ANDX T1,FO.CHN ;ISOLATE THE CHANNEL NUMBER
MOVEM T1,CPJCHN ;CPJCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
POPJ P,
;CPJCLS - ROUTINE TO CLOSE THE PRIMARY JOB CHECKPOINT FILE, USEJOB.BIN.
; CPJCHN - CHANNEL NUMBER (ALREADY IN BIT POSITION)
; CPJBLK - FILOP. BLOCK
CPJCLS: MOVE T1,CPJCHN ;YES.
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO ACT:
HRRI T1,.FOCLS ;NOW CLOSE THE FILE
MOVEM T1,CPJBLK+.FOFNC
MOVE T1,[1,,CPJBLK]
FILOP. T1,
$BOMB <ACTCCP Cannot close (^O/T1/) primary job checkpoint file>
POPJ P,
;CPDSAU - ROUTINE TO OPEN A DEVICE CHECKPOINT FILE FOR A JOB, JJJDEV.BIN,
; WHERE JJJ IS THE JOB NUMBER, IN SINGLE ACCESS UPDATE MODE.
; JOBNUM - JOB NUMBER
; CPDCHN - CHANNEL NUMBER
; CPDBLK - FILOP. BLOCK
; JJJDEV - LOOPUP/ENTER BLOCK
;CPDDEL - ROUTINE TO DELETE THE DEVICE CHECKPOINT FILE, SAME CALL AS CPDSAU
CPDDEL: MOVEI T1,.RBSIZ ;NUMBER OF WORDS IN THE RENAME (DELETE) BLOCK
MOVEM T1,JJJDEL+.RBCNT ;SET COUNT (ALSO FLAG FOR DELETE)
SETZM JJJDEL+.RBNAM ;CLEAR THE NAME FOR DELETE
SETZM JJJDEL+.RBEXT ;AND THE EXTENSION FOR GOOD MEASURE
SKIPA ;AND ENTER OPEN ROUTINE TO DO THE FILOP.
CPDSAU: SETZM JJJDEL+.RBCNT ;OPENING - NOT DELETING
SKIPN T1,CPDCHN ;DOES A CHANNEL ALREADY EXIST?
TXO T1,FO.ASC ;NO. HAVE THE MONITOR GIVE US ONE.
TXO T1,FO.PRV ;GIVE US FULL FILE ACCESS TO ACT:
HRRI T1,.FOSAU ;OPEN FOR UPDATE MODE
SKIPE JJJDEL+.RBCNT ;IS THIS DELETE
HRRI T1,.FODLT ;YES, USE DIFFERENT FUNCTION
MOVEM T1,CPDBLK+.FOFNC
MOVEI T1,.IODMP ;DUMP MODE
TXO T1,UU.RRC ;LET TONY KEEP THE RIB UP TO DATE
MOVEM T1,CPDBLK+.FOIOS
HRLZ T1,ACTDEV
MOVEM T1,CPDBLK+.FODEV
SETZM CPDBLK+.FOBRH
SETZM CPDBLK+.FONBF
MOVEI T1,JJJDEV ;THIS IS THE EXTENDED LOOKUP BLOCK
SKIPE JJJDEL+.RBCNT ;IS THIS DELETE
HRLI T1,JJJDEL ;THIS IS THE EXTENDED RENAME BLOCK
MOVEM T1,CPDBLK+.FOLEB
SETZM CPDBLK+.FOPAT ;NO PATH SPECIFIED
MOVEI T1,.RBSIZ
MOVEM T1,JJJDEV+.RBCNT
SETZM JJJDEV+.RBPPN ;NO PPN SPECIFIED
SETZM JJJDEV+.RBPRV ;CLEAR DATE/TIME WORD
SETZM JJJDEV+.RBSIZ ;CLEAR OLD SIZE VALUE
MOVE T1,[SIXBIT /SYSDEV/]
MOVEM T1,JJJDEV+.RBNAM
MOVSI T1,'BIN'
MOVEM T1,JJJDEV+.RBEXT
SKIPN JOBNUM ;HERE FOR SYSTEM SPINDLES
JRST CPDSA1 ;YES, DON'T INSERT JOB NUMBER IN FILE NAME
MOVE T1,[POINT 6,JJJDEV+.RBNAM] ;POINT TO THE NAME FIELD
MOVEM T1,USGCRY ;SAVE BYTE POINTER
$TEXT (USGCRX,<^D3R0/JOBNUM/^0>) ;HAVE GLXLIB FILL IN THE JOB NUMBER
CPDSA1: MOVE T1,[7,,CPDBLK]
FILOP. T1,
$BOMB <ACTOPD Cannot OPEN (^O/T1/) ^W/JJJDEV+.RBNAM/.^W3/JJJDEV+.RBEXT/>
SKIPE T1,CPDCHN ;WAS THERE A CHANNEL BEFORE?
POPJ P, ;YES. NO NEED TO STORE ONE
MOVE T1,CPDBLK+.FOFNC
ANDX T1,FO.CHN ;ISOLATE THE CHANNEL NUMBER
MOVEM T1,CPDCHN ;CPDCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
POPJ P,
;CPDCLS - ROUTINE TO CLOSE A DEVICE CHECKPOINT FILE, JJJDEV.BIN.
; CPDCHN - CHANNEL NUMBER (ALREADY IN BIT POSITION)
; CPDBLK - FILOP. BLOCK
CPDCLS: MOVE T1,CPDCHN ;YES.
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO ACT:
HRRI T1,.FOCLS ;NOW CLOSE THE FILE
MOVEM T1,CPDBLK+.FOFNC
MOVE T1,[1,,CPDBLK]
FILOP. T1,
$BOMB <ACTCPD Cannot close (^O/T1/) device checkpoint file for job ^D/JOBNUM/>
POPJ P,
;PRJRED - ROUTINE TO OPEN THE ACCOUNT VALIDATION FILE, PROJCT.SYS, IN
; READ MODE.
; PRJCHN - CHANNEL NUMBER
; PRJBLK - FILOP. BLOCK
; PROJCT - LOOKUP/ENTER BLOCK
PRJRED: SKIPN T1,PRJCHN ;DOES A CHANNEL ALREADY EXIST?
TXO T1,FO.ASC ;NO. HAVE THE MONITOR GIVE US ONE.
TXO T1,FO.PRV ;GIVE US FULL FILE ACCESS TO SYS:
HRRI T1,.FORED ;MAKE SURE SYS:PROJCT.SYS EXISTS
MOVEM T1,PRJBLK+.FOFNC
MOVEI T1,.IODMP ;DUMP MODE
MOVEM T1,PRJBLK+.FOIOS
HRLZ T1,PRJDEV ;PROJCT.SYS NOW ON SYS:
MOVEM T1,PRJBLK+.FODEV
SETZM PRJBLK+.FOBRH
SETZM PRJBLK+.FONBF
MOVEI T1,PROJCT ;THIS IS THE EXTENDED LOOKUP BLOCK
MOVEM T1,PRJBLK+.FOLEB
MOVEI T1,35 ; AND IS 35 WORDS LONG
MOVEM T1,PROJCT+.RBCNT
MOVE T1,[SIXBIT /PROJCT/]
MOVEM T1,PROJCT+.RBNAM
MOVSI T1,'SYS'
MOVEM T1,PROJCT+.RBEXT
MOVE T1,[7,,PRJBLK]
FILOP. T1,
$BOMB <ACTCOJ Cannot OPEN (^O/T1/) ^W/PROJCT+.RBNAM/.^W3/PROJCT+.RBEXT/>
SKIPE T1,PRJCHN ;WAS THERE A CHANNEL BEFORE?
$RETT ;YES. NO NEED TO STORE ONE
MOVE T1,PRJBLK+.FOFNC
ANDX T1,FO.CHN ;ISOLATE THE CHANNEL NUMBER
MOVEM T1,PRJCHN ;PRJCHN NOW CONTAINS CHANNEL # IN THE LEFT HALF
$RETT
;USGSAU - ROUTINE TO OPEN USAGE.OUT IN SINGLE-ACCESS UPDATE MODE USING DUMP MODE I/O.
; USGIFN - GALAXY HANDLE FOR USAGE.OUT
USGSAU: PUSHJ P,.SAVE3 ;SAVE P1 - P3
SETZM P3 ;CLEAR COUNTER
USGSA1: HRLZ S1,ACTDEV ;GET THE DEVICE TO OPEN (ACT: OR DSK:)
MOVEM S1,USGFD+.FDSTR ;STORE IN FILE OPEN BLOCK
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,USGFOB ;FOB ADDRESS
PUSH P,[EXP -1] ;STORAGE FOR IFN ON STACK
$CALL F%IOPN ;FIRST OPEN THE FILE FOR INPUT
JUMPF USGSA2 ;FAILED--ASSUME IT DOESN'T EXIST
MOVEM S1,(P) ;SAVE IFN
MOVEI S2,FI.BSZ ;WANT TO READ BYTE SIZE
$CALL F%INFO ;DO IT
JUMPF USGSA3 ;ASSUME IT'S NOT KNOWN
CAIE S1,^D7 ;SOMETHING
CAIN S1,^D8 ; REASONABLE?
SKIPA ;YES
USGSA2: MOVEI S1,FILBSZ ;ELSE USE DEFAULT
MOVEM S1,USGBSZ ;SAVE AWAY
STORE S1,FAIFOB+FOB.CW,FB.BSZ ;SAVE IN FAILURE FILE FOB
LSH S1,^D24 ;POSITION
TLO S1,440000 ;MAKE A PARTIAL BYTE POINTER
MOVEM S1,USGBPT ;SAVE
USGSA3: POP P,S1 ;GET IFN BACK
SKIPL S1 ;SKIP IF CHANNEL NEVER OPENED
$CALL F%RREL ;CLOSE AND RELASE CHANNEL
MOVEI S1,FOB.SZ ;SIZE OF THE FOB
MOVEI S2,USGFOB ;WHERE IT IS
$CALL F%AOPN ;OPEN FILE IN APPEND MODE
JUMPF USGSA4 ;GET COMPLAIN AND WAIT FOR A WHILE
MOVEM S1,USGIFN ;SAVE THE IFN FROM GALAXY
MOVEI S2,FI.SIZ ;ASK FOR THE FILE SIZE
$CALL F%INFO ;...
MOVEM S1,USGOSZ ;SAVE ORIGINAL FILE SIZE
PUSHJ P,OPNFAI ;GO OPEN VALIDATION FAILURE LOG FILE
POPJ P, ;NOW RETURN
USGSA4: MOVE P1,P3 ;GET COUNTER
IDIVI P1,<^D60/SLPSEC>*WTOINT ;SEE IF TIME FOR A WTO
SKIPN P2 ;NOT YET
$WTOXX (<Couldn't open usage file, ^F/USGFD/^M^JError: ^E/S1/>)
MOVEI S1,SLPSEC ;GET TIME TO SLEEP
SLEEP S1, ;ZZZZ
AOJA P3,USGSA1 ;TRY TO OPEN THE FILE AGAIN
;USGAPP - ROUTINE TO APPEND AN ENTRY TO USAGE.OUT. ENTRY MUST BE IN USGBUF.
USGAPP: HRRZ S2,SAVPTR ;HIGHEST BYTE FILLED IN THE ENTRY
SUBI S2,USGBUF-1 ;COMPUTE LENGTH (WORDS) OF ENTRY
CAILE S2,USGBND-USGBUF ;CHECK FOR OVERFLOW
STOPCD (EBO,HALT,,<Entry buffer overflow>)
HRLS S2 ;WANT LENGTH IN LH
HRRI S2,USGBUF ;WHERE IT IS
MOVE S1,USGIFN ;GALAXY HANDLE
$CALL F%OBUF ;OUTPUT THE ENTRY
SKIPT ;EVERYTHING OK?
ACTATU: STOPCD (CAU,HALT,,<Cannot append to usage file>)
MOVE S1,USGIFN ;THE HANDLE AGAIN
$CALL F%CHKP ;MARK SURE DATA GETS TO FILE
JUMPF ACTATU ;GIVE UP IF DIDN'T WORK
POPJ P, ;AND RETURN
;USGCRN - ROUTINE TO CLOSE AND RENAME USAGE.OUT
USGCRN: $CALL .SAVE1 ;SAVE A WORKING AC
MOVE S1,USGIFN ;THE HANDLE FOR THE FILE
$CALL F%REL ;CLOSE/RELEASE IT
SKIPT ;DID THAT WORK
STOPCD (CCU,HALT,,<Cannot close usage file>)
HRLZ S1,ACTDEV ;GET DEVICE OPENED
MOVEM S1,USGRFD+.FDSTR ;FILL IN RENAME BLOCK
DEVPPN S1, ;FIND PPN ASSOCIATED WITH DEV
$BOMB <ACTCFO Cannot find owner of ^W/USGRFD+.FDSTR/>
MOVEM S1,USGRFD+.FDPPN ;STORE IT CAUSE GALAXY WANTS IT THERE
PUSHJ P,DATIM ;GET CURRENT DATE/TIME
MOVE T1,S1 ;WANT IT IN T1
PUSHJ P,CNGDAT ;CONVERT TO DATE AND TIME
PUSH P,T2 ;SAVE DATE FOR A SEC
IDIV T1,[^D3600000] ;T1 = HOURS PAST MIDNIGHT
POP P,T2 ;RESTORE DATE
IDIVI T2,^D31*^D12 ;T2 = YEARS AFTER 1964
ADDI T2,^D64 ;CONVERT TO 2 DIGIT YEAR (WON'T WORK AFTER 21999)
IDIVI T3,^D31 ;T3 = MONTH (ALMOST) T4 = DAY (ALMOST)
AOS T3 ;NOW EXACT
AOS T4 ;...
MOVSI P1,-^D10 ;10 TRIES FOR UNIQUE DIGIT
USGCR1: MOVE S1,[POINT 6,USGRFD+.FDNAM]
MOVEM S1,USGCRY ;STUFF AWAY THE BYTE POINTER
$TEXT (USGCRX,<^D2R0/T2/^D2R0/T3/^D2R0/T4/^D2R0/T1/^D1R0/P1,RHMASK/^0>)
MOVEI S1,FRB.MZ ;SIZE OF THE RENAME BLOCK
MOVEI S2,USGFRB ;ADDRESS OF IT
$CALL F%REN ;RENAME USAGE.OUT TO "yymmdd.hhu"
JUMPT USGCR2 ;IF OK, GO RENAME VALIDATION FAILURE FILE
CAIN S1,ERFAE$ ;FILE ALREADY EXISTS ERROR
AOBJN P1,USGCR1 ;YES, DO WE GET ANOTHER CHANCE
USGCR2: PUSH P,TF ;SAVE TF
PUSHJ P,RENFAI ;RENAME VALIDATION FAILURE LOG FILE
POP P,TF ;GET TF BACK
POPJ P, ;RETURN PREVIOUS FLAG
USGCRX: CAIG S1,"9" ;ONLY DIGITS
CAIGE S1,"0" ; IN FILE NAME
$RETT ;IGNORE IT
SUBI S1," "-' ' ;CONVERT TO SIXBIT
IDPB S1,USGCRY ;STORE CHARACTER IN FILE NAME
$RETT ;AND RETURN
USGCRY: BLOCK 1 ;PLACE TO HOLD THE POINTER
SUBTTL ROUTINES TO OPEN, CLOSE AND RENAME VALIDATION FAILURE LOG FILE
;Note: The validation failure log file is opened and renamed at the same
; time the usage file is opened and renamed. However, if the validation
; log file can't be opened or renamed, it's not fatal. If the file can't
; be opened, logging is not done. If the file can't be renamed, the
; current file open will be appended to if possible.
;OPNFAI - Open validation failure log file, ACT:FAILUR.LOG, or DSK:FAILUR.LOG
; if debugging. ACTDEV should already be set.
OPNFAI: SKIPE FAIIFN ;IFN ALREADY?
$RETT ;YES, JUST RETURN
HRLZ S1,ACTDEV ;GET THE DEVICE (ACT: OR DSK:)
MOVEM S1,FAIFD+.FDSTR ;STORE IT
MOVEI S1,FOB.SZ ;GET SIZE OF THE FOB
MOVEI S2,FAIFOB ;AND ITS ADDRESS
$CALL F%AOPN ;OPEN THE FILE IN APPEND MODE
JUMPF OPNF.1 ;IF IT FAILED GO COMPLAIN
MOVEM S1,FAIIFN ;SAVE THE IFN
$RETT ;RETURN SUCCESS
OPNF.1: $WTOXX (<Validation failure file open error, ^F/FAIFD/^M^JError: ^E/S1/>)
SETZM FAIIFN ;MAKE SURE WE DON'T THINK FILE IS OPEN
$RETT
;RENFAI - Rename the validation failure log file to FAILUR.nnn where nnn
; is 000 - 999. If FAILUR.000 exists, then FAILUR.001 is used, etc.
RENFAI: SKIPN S1,FAIIFN ;FILE OPEN?
$RETT ;NO, NOTHING TO DO
$CALL F%REL ;CLOSE THE FILE
JUMPF RENF.1 ;IF WE COULDN'T, GO COMPLAIN
SETZM FAIIFN ;CLEAR THE IFN WORD
HRLZ S1,ACTDEV ;GET THE DEVICE FILE IS OPENED ON
MOVEM S1,FAIRFD+.FDSTR ;STORE IT
DEVPPN S1, ;GET THE PPN ASSOCIATED
MOVE S1,[1,,7] ;SHOULD NOT HAPPEN
MOVEM S1,FAIRFD+.FDPPN ;STORE IT
PUSHJ P,.SAVET ;GET SOME SCRATCH ACS
SETZB T1,FAIRFD+.FDEXT ;START WITH 000
RENF.0: CAIL T1,^D1000 ;LESS THAN MAX?
JRST RENF.2 ;NO, PHEW!
MOVE T4,[POINT 6,FAIRFD+.FDEXT] ;GET BP FOR EXTENSION
PUSH P,T1 ;SAVE COUNT
IDIVI T1,^D100 ;GET 1ST DIGIT IN T1
ADDI T1,' 0' ;MAKE SIXBIT
IDIVI T2,^D10 ;GET 2ND AND 3RD IN T2 AND T3 RESPECTIVELY
ADDI T2,' 0'
ADDI T3,' 0'
IDPB T1,T4
IDPB T2,T4
IDPB T3,T4 ;STORE THE EXTENSION
POP P,T1 ;GET COUNT BACK
MOVEI S1,FRB.SZ ;GET SIZE OF RENAME BLOCK
MOVEI S2,FAIFRB ;GET ADDRESS OF RENAME BLOCK
$CALL F%REN ;TRY THE RENAME
$RETIT ;RETURN IF SUCCESS
CAIN S1,ERFAE$ ;FILE ALREADY THERE?
AOJA T1,RENF.0 ;YES, TRY NEXT EXTENSION
$WTOXX (<Couldn't rename validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
PJRST OPNFAI ;GO OPEN OLD ONE IF WE CAN
RENF.1: $WTOXX (<Couldn't close validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
$RETT ;JUST RETURN AFTER COMPLAINING
RENF.2: $WTOXX (<Too many validation failure files^M^JWill continue to write to ^F/FAIFD/>)
PJRST OPNFAI ;TRY TO OPEN FAILUR.LOG AGAIN
;LOGFAI - Routine to stuff characters in the buffer for the validation
; failure log file. This routine is setup to be called by $TEXT macros,
; i.e. S1 contains char to be logged.
LOGFAI: SKIPE FAIPAG ;IS THE LOG PAGE THERE?
JRST LOGF.1 ;YES, GO DEPOSIT TEXT
PUSH P,S1 ;NO, SAVE CHAR
PUSHJ P,FBFINI ;GET INTIAILIZE PAGE AND BP
POP P,S1 ;GET CHAR BACK
LOGF.1: SOSGE FAICNT ;ROOM LEFT IN BUFFER?
JRST LOGF.2 ;NO, GO DUMP IT AND CONTINUE
IDPB S1,FAIPTR ;YES, STORE CHAR AND EXIT
POPJ P, ;RETURN
LOGF.2: PUSH P,S1 ;SAVE CHAR
PUSHJ P,FAIOUT ;DUMP BUFFER
POP P,S1 ;GET CHAR BACK
JRST LOGF.1 ;AND PUT IT IN BUFFER
;FBFINI - Routine to get a buffer page for validation failure file and
; setup byte pointer and char count.
FBFINI: SKIPE S1,FAIPAG ;HAVE A PAGE?
JRST FBFI.1 ;YES, JUST DO BP AND COUNT
$CALL M%GPAG ;GET A PAGE
JUMPF FBFI.2 ;CAN'T GO COMPLAIN
MOVEM S1,FAIPAG ;SAVE ADDRESS
FBFI.1: HLL S1,USGBPT ;FORM A BYTE POINTER
MOVEM S1,FAIPTR ;SAVE IT
MOVEI S1,^D36 ;BITS PER WORD
LDB S2,[POINT 6,USGBPT,11] ;GET CURRENT BYTE SIZE
IDIVI S1,(S2) ;GET BYTES PER WORD
IMULI S1,PAGSIZ ;AND BYTES PER BUFFER
MOVEM S1,FAICNT ;SAVE
MOVEM S1,FAIMAX ;SAVE AS MAXIMUM TOO
POPJ P, ;RETURN
FBFI.2: $RETF ;FOR NOW
;FAIOUT - Routine to write whatever is in the buffer to the validation
; failure log file and checkpoint the file.
FAIOUT: SKIPE S1,FAIIFN ;GET THE IFN
SKIPN S2,FAIPAG ;GET THE BUFFER ADDRESS
$RETF ;BOTH HAVE TO BE THERE TO WORK
MOVN TF,FAICNT ;GET NEGATIVE FREE CHAR COUNT
ADD TF,FAIMAX ;COMPUTE HOW MANY IN BUFFER
JUMPE TF,.RETT ;NO BYTES IN BUFFER, JUST RETURN
HRL S2,TF ;GET COUNT,,ADDRESS IN S2
$CALL F%OBUF ;OUTPUT BUFFER
JUMPF FAIO.1 ;GO COMPLAIN IF WE CAN'T
PUSHJ P,FBFINI ;GET REINIT COUNT AND BP
MOVE S1,FAIIFN ;GET IFN AGAIN
$CALL F%CHKP ;CHECKPOINT THE FILE
$RETIT ;RETURN IF OK
$WTOXX (<Couldn't checkpoint validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
$RETF
FAIO.1: $WTOXX (<Couldn't output to validation failure file, ^F/FAIFD/^M^JError: ^E/S1/>)
$RETF
SUBTTL FILE PARAMETER BLOCKS FOR GALAXY INTERFACE
;Usage file paramter blocks
USGFOB: $BUILD (FOB.SZ) ;BUILD THE FILE OPEN BLOCK
$SET (FOB.FD,,USGFD) ;POINT TO THE FD
$SET (FOB.CW,FB.BSZ,^D36) ;USE FULL WORD MODE
$SET (FOB.AB,,USGFAB) ;POINT TO THE FAB
$EOB
USGFAB: $BUILD (7) ;FILE ATTRIBUTE BLOCK FOR PROT CODE
$SET (0,,7) ;SIZE OF ENTIRE BLOCK
$SET (1,FI.IMM,1) ;IMMEDIATE ARGUMENT
$SET (1,FI.LEN,1) ;LENGTH OF ARGUMENT
$SET (1,FI.ATR,.FIPRO) ;PROTECTION CODE
$SET (2,,<EXP FILPRO>) ;PROTECTION CODE DEFINED IN ACTSYM
$SET (3,FI.LEN,1) ;LENGTH IS ONE WORD
$SET (3,FI.ATR,.FIBSZ) ;THE LOGICAL DATA BYTE SIZE
$SET (4,,USGBSZ) ;DEFINED VALUE
$SET (5,FI.IMM,1) ;IMMEDIATE ARGUMENT
$SET (5,FI.LEN,1) ;LENGTH IS ONE WORD
$SET (5,FI.ATR,.FIDTY) ;THE DATA TYPE
$SET (6,,.RBDAS) ;ASCII
$EOB
USGFD: $BUILD (FDMSIZ) ;BUILD THE FILE DESCRIPTOR BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;FILL IN THE LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE FILE SPEC
$SET (.FDNAM,,<SIXBIT/USAGE/>) ;THE FILE NAME
$SET (.FDEXT,,<SIXBIT/OUT/>) ;THE EXTENSION
$EOB
USGRFD: $BUILD (FDMSIZ) ;BUILD A FILE DESCRIPTOR BLOCK FOR RENAME
$SET (.FDLEN,FD.LEN,FDMSIZ) ;FILL IN THE LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE FILE SPEC
$EOB
USGFRB: $BUILD (FRB.MZ) ;BUILD A FILE RENAME BLOCK
$SET (FRB.SF,,USGFD) ;POINTER TO SOURCE FILE
$SET (FRB.DF,,USGRFD) ;DESTINATION FILE
$EOB
;Validation failure file parameter blocks
FAIFOB: $BUILD (FOB.SZ) ;BUILD THE FILE OPEN BLOCK
$SET (FOB.FD,,FAIFD) ;POINT TO THE FD
$SET (FOB.CW,FB.BSZ,0) ;FILLED IN AT RUNTIME
$SET (FOB.AB,,USGFAB) ;FILE ATTRIBUTE BLOCK
$EOB
FAIFD: $BUILD (FDMSIZ) ;BUILD THE FILE DESCRIPTOR BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;FILL IN THE LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE FILE SPEC
$SET (.FDNAM,,<SIXBIT/FAILUR/>) ;THE FILE NAME
$SET (.FDEXT,,<SIXBIT/LOG/>) ;THE EXTENSION
$EOB
FAIRFD: $BUILD (FDMSIZ) ;BUILD A FILE DESCRIPTOR BLOCK FOR RENAME
$SET (.FDLEN,FD.LEN,FDMSIZ) ;FILL IN THE LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE FILE SPEC
$SET (.FDNAM,,<SIXBIT/FAILUR/>) ;THE FILE NAME
$EOB
FAIFRB: $BUILD (FRB.SZ) ;BUILD A FILE RENAME BLOCK
$SET (FRB.SF,,FAIFD) ;POINTER TO SOURCE FILE
$SET (FRB.DF,,FAIRFD) ;DESTINATION FILE
$SET (FRB.AB,,USGFAB) ;ATTRIBUTE BLOCK
$EOB
SUBTTL ERRACK - ROUTINE TO SEND ERROR ACKS TO USERS
EXTERN ERRPFX, ERRTXT
ERRACK: SKIPE GFRFLG ;WAS THE MESSAGE FROM [SYSTEM]GOPHER?
PJRST ERRAC1 ;YES. RETURN MESSAGE IS A DIFFERENT FORMAT
MOVE T1,SABADR ;GET THE PAGE ADDRESS
MOVEI T2,UGFAL$ ;INDICATE THE VALIDATION MODULE HAS AN ERROR
MOVEM T2,UC$RES(T1) ;STORE IT IN THE IPCF SEND MESSAGE
ADDI T1,UC$ERR ;RELOCATE T1 TO POINT TO WHERE ERROR GOES
MOVEM T1,ACKETX ;SAVE ADDRESS
PUSHJ P,ERRAC4 ;SETUP ACK STUFF
$TEXT (<-1,,@ACKETX>,<^I/@ACKITX/^0>)
POPJ P, ;RETURN
ERRAC1: MOVE T1,SABADR ;GET THE PAGE ADDRESS
MOVEI T2,1 ;ONE BLOCK FOLLOWING
STORE T2,.OARGC(T1) ;STORE AS NUMBER OF BLOCKS
SETZM .OFLAG(T1) ;NO FLAGS HAVE BEEN DEFINED YET
ADDI T1,.OHDRS+1 ;ERROR MESSAGE STARTS HERE
MOVEM T1,ACKETX ;SAVE ADDRESS
PUSHJ P,ERRAC4 ;SET UP ACK STUFF
$TEXT (<-1,,@ACKETX>,<^I/@ACKITX/^0>)
MOVEI T1,2 ;MIN IS HEADER WORD + A NULL FOR STRING
SKIPE ACKEFL ;NEW-STYLE ACK?
SOSA T2,ACKETX ;YES--ADJUST ADDRESS
MOVE T2,ACKETX ;GET TEXT ADDRESS BACK
MOVE T3,ERRICH## ;GET INITIAL CHARACTER
CAIE T3,"?" ;FATAL ERROR?
TDZA T3,T3 ;NO
MOVX T3,MF.FAT ;LITE THE BIT
ERRAC2: SKIPN (T2) ;HAVE WE REACHED THE END OF THE ERROR MESSAGE?
JRST ERRAC3 ;YES. STORE THE COUNTS IN THE PROPER PLACES
AOS T2 ;LOOK AT THE NEXT WORD
AOJA T1,ERRAC2 ;COUNT IT
ERRAC3: MOVE T2,SABADR ;GET THE BEGINNING ADDRESS AGAIN
MOVEM T3,.MSFLG(T2) ;STORE FLAGS IN THE MESSAGE
LOAD T3,.MSTYP(T2),MS.CNT ;GET THE MESSAGE COUNT
ADD T3,T1 ;ADD IN THE ERROR MESSAGE LENGTH
STORE T3,.MSTYP(T2),MS.CNT ;JUST COUNT WHAT WAS ADDED IN THIS ROUTINE
HRLM T1,.OHDRS(T2) ;WORD COUNT OF THE ERROR BLOCK
MOVEI T1,.CMTXT ;TYPE OF RESPONSE BLOCK
HRRM T1,.OHDRS(T2) ;SAVE IN MESSAGE
JRST ERRAC5 ;GO RESTORE ACS AND RETURN
; SET UP FOR NEW-STYLE ACKS IF NECESSARY
ERRAC4: MOVE T1,ERRPFX## ;GET SIXBIT PREFIX
HRL T1,ERRDAT## ;AND ERROR CODE
MOVEM T1,@ACKETX ;SAVE IN FIRST WORD
SKIPE ACKEFL ;WANT NEW-STYLE ACKS?
AOSA ACKETX ;YES--ADVANCE POINTER TO NEXT WORD
SKIPA T1,[[ITEXT (<^W/ERRPFX/ ^I/@ERRTXT/^0>)]]
MOVEI T1,[ITEXT (<^I/@ERRTXT/^0>)]
MOVEM T1,ACKITX ;SAVE
ERRAC5: DMOVE T1,ERRACS##+0 ;RESTORE T1 AND T2
DMOVE T3,ERRACS##+2 ;RESTORE T3 AND T4
POPJ P, ;RETURN
SUBTTL ERRPRO - OLD USER ERROR ROUTINES
;ERROR CODES
ERCODE ERROR0,ACNPP% ;(0) NONEXISTENT PPN
ERCODE ERROR1,ACIVA% ;(1) OBSOLETE
ERCODE ERROR2,ACILP% ;(2) ILLEGAL PPN
ERCODE ERROR3,ACJNP% ;(3) JOB NOT PRIVILEGED
ERCODE ERROR4,ACJCE% ;(4) JOB CAPACITY EXCEEDED
;ERRPRO - ROUTINE TO BE CALLED WHEN AN ERROR OCCURS. THIS ROUTINE WILL
; STORE THE ERROR MESSAGE IN AN IPCF MESSAGE. T1 CONTAINS THE ERROR NUMBER.
ERRPRO: SKIPE GFRFLG ;WAS THE MESSAGE FROM [SYSTEM]GOPHER?
PJRST ERRQUE ;YES. RETURN MESSAGE IS A DIFFERENT FORMAT
MOVE T2,SABADR ;GET THE PAGE ADDRESS
MOVEI T3,UGFAL$ ;INDICATE THE VALIDATION MODULE HAS AN ERROR
MOVEM T3,UC$RES(T2) ;STORE IT IN THE IPCF SEND MESSAGE
ADDI T2,UC$ERR ;RELOCATE T2 TO POINT TO WHERE ERROR GOES
PUSHJ P,@ERRDSP(T1) ;PUT THE MESSAGE INTO THE IPCF PAGE
MOVEI T3,UGFAL$^!UGTRU$ ;VALUE TO CONVERT FAILURE TO SUCCESS
SKIPF ;IF APPROPRIATE,
XORM T3,UC$RES-UC$ERR(T2) ;DO SO
$RETF
;ERRQUE - ROUTINE THAT WILL SET UP AN ERROR MESSAGE IN QUEUE. UUO FORMAT
;
;CALL: T1/DISPATCH IN ERRDSP
ERRQUE: MOVE T2,SABADR ;GET THE PAGE ADDRESS
MOVEI T3,1 ;ONE BLOCK FOLLOWING
STORE T3,.OARGC(T2) ;STORE AS NUMBER OF BLOCKS
SETZM .OFLAG(T2) ;NO FLAGS HAVE BEEN DEFINED YET
ADDI T2,.OHDRS+1 ;ERROR MESSAGE STARTS HERE
PUSHJ P,@ERRDSP(T1) ;PUT THE RIGHT MESSAGE IN
$RETIF ;FATAL HAS ALREADY BEEN SET UP
SETZ T3, ;NO FLAGS
ADDI T1,1 ;INCLUDE HEADER WORD IN LENGTH OF RESPONSE
ERRQU2: MOVE T2,SABADR ;GET THE BEGINNING ADDRESS AGAIN
MOVEM T3,.MSFLG(T2) ;STORE FLAGS IN THE MESSAGE
LOAD T3,.MSTYP(T2),MS.CNT ;GET THE MESSAGE COUNT
ADD T3,T1 ;ADD IN THE ERROR MESSAGE LENGTH
STORE T3,.MSTYP(T2),MS.CNT ;JUST COUNT WHAT WAS ADDED IN THIS ROUTINE
HRLM T1,.OHDRS(T2) ;WORD COUNT OF THE ERROR BLOCK
MOVEI T1,.CMTXT ;TYPE OF RESPONSE BLOCK
HRRM T1,.OHDRS(T2)
$RETF ;ALL DONE
;ERROR DISPATCH TABLE FOR PUTTING ERROR MESSAGES IN IPCF PAGE
ERRMAP ;(-4) MOVE MAPPING DATA
ERRMVB ;(-3) MOVE VALIDATION BLOCK
ERRMUP ;(-2) MOVE USER PROFILE
ERRMAS ;(-1) MOVE ACCOUNT STRING TO RESPONSE BLOCK
ERRDSP: ERRFOO ;(0) OBSOLETE
ERRFOO ;(1) OBSOLETE
ERRILP ;(2) ILLEGAL PPN
ERRJNP ;(3) JOB NOT PRIVILEGED
ERRFOO: HALT .
ERRMAP: HRLZ T3,ACOMAP ;POINT TO MAPPING BLOCKS
HRRI T3,(T2) ;WHERE IT GOES IN THE RESPONSE BLOCK
MOVE T1,TMPCNT ;GET BLOCK COUNT
IMULI T1,UU$LEN ;LENGTH OF RESPONSE DATA
ADDI T1,(T2) ;COMPUTE END OF BLT
BLT T3,-1(T1) ;COPY DATA
SUBI T1,(T2) ;GET LENGTH AGAIN
$RETT ;RETURN
ERRMVB: HRLZ T1,DATADR ;POINT TO OUR VALIDATION BLOCK
HRRI T1,(T2) ;WHERE IT GOES IN THE RESPONSE BLOCK
BLT T1,UV$ACE(T2) ;COPY IT
MOVEI T1,UV$ACE+1 ;GET LENGTH
$RETT ;AND RETURN
ERRMUP: PUSH P,T3 ;SAVE T3
HRLI T1,ACOPRO ;POINT TO THE PROFILE
HRRI T1,(T2) ;WHERE IT GOES IN RESPONSE BLOCK
HRRZ T3,ACOPRO+.AEVRS ;GET LENGTH OF THIS PROFILE
ADDI T3,(T2) ;COMPUTE END OF BLT
BLT T1,-1(T3) ;COPY
HRRZ T1,ACOPRO+.AEVRS ;GET LENGTH OF BLOCK WE'RE RETURING
POP P,T3 ;RESTORE T3
$RETT ;GOOD RETURN
ERRMAS: MOVE T1,DATADR ;WHERE VALIDATION REQUEST MESSAGE LIVES
HRLI T1,UV$ACT(T1) ;ORIGINAL (OR MODIFIED) ACCOUNT STRING
HRRI T1,(T2) ;WHERE TO PUT IT IN ASSEMBLED MESSAGE
BLT T1,7(T2) ;MOVE THE ACCOUNT STRING
MOVEI T1,10 ;NUMBER OF WORDS FOR RESPONSE BLOCK
$RETT ;THIS IS NOT REALLY AN ERROR ROUTINE
ERRILP: FATAL (ILP,<Illegal ppn ^U/PPN/>,ACILP%,.RETF)
ERRJNP: PUSHJ P,LOGUSR ;GET USER INDEPENDENT INFO
MOVEI S1,.CHCRT ;JUST APPEND A <CR><LF>
PUSHJ P,LOGFAI
MOVEI S1,.CHLFD
PUSHJ P,LOGFAI
PUSHJ P,FAIOUT ;JOB NUMBER ALREADY LOGGED, WRITE FAILURE FILE
FATAL (JNP,<Job not privileged>,ACJNP%,.RETF)
;LOGUSR - Routine to get a lot of info about current IPCF sender (user)
; and log it in the validation failure log file.
; MDB pointed to by MDBADR is assumed valid.
; Call with T1=error code
LOGUSR: PUSHJ P,.SAVET ;SAVE T1 - T4
MOVE S1,[XWD USRZER,USRZER+1] ;ZERO OUR STORAGE
SETZM USRZER
BLT S1,USRZEN
MOVEM T1,USRERR ;SAVE ERROR CODE
MOVE S1,MDBADR ;GET MDB ADDRESS
LOAD S1,MDB.PV(S1),MD.PJB ;GET JOB NUMBER OF SENDER
JUMPE S1,.RETF ;HMMMM
MOVEM S1,USRJOB ;SAVE IT
HRLZS S1,S1 ;GET JOB NUMBER IN LH
HRRI S1,.GTPPN ;GET TABLE NUMBER
GETTAB S1, ;GET PPN OF THE GUY DOING IT
TRNA ;USE ZEROS
MOVEM S1,USRPPN ;STORE IT
HRLZ S1,USRJOB ;GET JOB NUMBER AGAIN
HRRI S1,.GTPRG ;GET TABLE NUMBER
GETTAB S1, ;GET PROGRAM NAME
TRNA ;USER BLANKS
MOVEM S1,USRPRG ;SAVE IT
HRLZ S1,USRJOB ;GET JOB NUMBER
HRRI S1,.GTNM1 ;GET 1ST WORD OF USERNAME
GETTAB S1,
TRNA ;USE BLANKS
MOVEM S1,USRNAM ;SAVE IT
HRLZ S1,USRJOB ;GET JOB NUMBER AGAIN
HRRI S1,.GTNM2 ;GET 2ND WORD OF USER NAME
GETTAB S1,
TRNA
MOVEM S1,USRNAM+1 ;SAVE IT
HRRZ S1,USRJOB ;GET JOB NUMBER AGAIN
TRMNO. S1, ;GET THE UDX
TRNA
MOVEM S1,USRUDX ;STORE
JUMPE S1,LOGU.1 ;IF ERROR, SKIP OTHER THINGS BASED ON UDX
DEVNAM S1, ;GET TTY NAME
SETZM S1 ;ZERO WILL BE SIXBIT BLANKS
MOVEM S1,USRTTY ;SAVE IT
MOVE S2,USRUDX ;GET UDX AGAIN
MOVEI S1,.TOAPC ;WANT ASYNCH PORT CHARACTERISTIC
MOVE TF,[XWD 2,S1] ;GET LENGTH,,ADDR
TRMOP. TF, ;GET THE APC CODE
TRNA ;ASSUME UNKNOWN
MOVEM TF,USRAPC
;Here to get node and line information on the offender
MOVE S1,[7,,.NOGDI] ;FUNCTION TO GET TTY INFO
MOVEM S1,USRARG ;FROM NETOP. UUO (7.03 AND LATER)
XMOVEI S1,USRNDN ;SET UP POINTER TO STRING BLOCK
MOVEM S1,USRNDA
XMOVEI S1,USRLIN ;POINT TO LINE NAME BLOCK
MOVEM S1,USRLNA
MOVEI S1,<<^D16/4>+1> ;SIZE OF THOSE STRING BLOCKS
MOVEM S1,USRLIN
MOVEM S1,USRNDN
XMOVEI S1,USRARG
NETOP. S1, ;ASK FOR TTY INFO
JRST LOGU.0 ;DO IT THE OLD-FASHIONED WAY
MOVEI S1,USRNDN ;CRAM INTO 7 BIT
PUSHJ P,C8TO7
MOVEI S1,USRLIN ;SAME FOR LINE NAME
PUSHJ P,C8TO7
JRST LOGU.1 ;SKIP THE OLD-FASHIONED WAY
LOGU.0: MOVE S1,USRUDX ;GET UDX AGAIN
GTNTN. S1, ;GET NODE,,LINE NUMBER
SETZM S1
HLRZM S1,USRNOD ;SAVE NODE NUMBER
HRRZS S1 ;ISOLATE LINE NUMBER
MOVE S2,[ASCII /TTY/] ;CONSTRUCT LINE NAME
MOVEM S2,USRLIN
MOVE T1,[POINT 7,USRLIN,20] ;POINT TO START OF NUMBER PART
PUSHJ P,COTO7 ;AND STUFF IT IN
MOVE S2,USRNOD ;GET NODE NUMBER IN RH OF S2
MOVEI S1,2 ;GET LEGNTH FOR UUO
MOVE TF,[XWD .NDRNN,S1] ;GET ARG FOR NODE. UUO
NODE. TF, ;GET NODE NAME
TRNA ;USE BLANKS
MOVEM TF,S1 ;STORE NODE NAME IN SIXBIT
MOVE T1,[POINT 7,USRNDN] ;POINT TO NODE NAME STORAGE
PUSHJ P,C6TO7 ;AND STORE IT IN ASCII
;Here to log the data
LOGU.1: PUSHJ P,.SAVE1 ;SAVE P1
$TEXT (LOGFAI,<^O2R0/USRERR/>^A) ;DUMP ERROR CODE
MOVE P1,FAIPTR ;TRICK ACTDAE'S USAGE OUTPUT ROUTINES
EXCH P1,USGPTR ;MAKE THEM WRITE IN OUR BUFFER
$CALL I%NOW ;GET CURRENT UDT
MOVEI T1,S1 ;POINT T1 AT ARG
PUSHJ P,OUTDTM ;OUTPUT DATE/TIME AS "YYYYMMDDHHMMSS"
EXCH P1,USGPTR ;PUT USAGE POINTER BACK AND GET OURS
MOVEM P1,FAIPTR ;STORE IT FOR LOGFAI
MOVE S1,FAICNT ;UPDATE OUR BUFFER COUNT
SUBI S1,^D14
MOVEM S1,FAICNT
;Log the rest
$TEXT (LOGFAI,<^D3R0/USRJOB/^O6R0/USRPPN,LHMASK/^O6R0/USRPPN,RHMASK/^W6L/USRNAM/^W6L/USRNAM+1/^W6L/USRPRG/^W6L/USRTTY/^T20L/USRNDN/^T20L/USRLIN/^O2R0/USRAPC/^A>)
$RETT
SUBTTL Convert the user's node and line names to 7 bit ASCII
;C8TO7 - Convert 8 bit string in string block into 7 bit ASCIZ
; in place
; Call: MOVEI S1,address of string block
; PUSHJ P,C8TO7
C8TO7: $SAVE <<S1+2>,<S1+3>,<S1+4>,<S1+5>> ;SAVE ACS USED IN MOVSLJ
MOVE S2,S1 ;GET ADDRESS OF BLOCK
HRLI S2,041000 ;MAKE ILDB BYTE POINTER TO NEXT WORD
MOVE S1+4,S1 ;AND MAKE DESTINATION POINTER TOO
HRLI S1+4,(POINT 7,) ;TO OVERWRITE THE BLOCK
HLRZ S1,(S1) ;GET NUMBER OF SOURCE BYTES
MOVEI S1+3,1(S1) ;ONE EXTRA DESTINATION BYTE FOR 0 FILL
EXTEND S1,[MOVSLJ 0
0] ;MOVE THE SLUDGE WITH A 0 TERMINATOR
JFCL
POPJ P,
;C6TO7 - CONVERT SIXBIT NAME IN S1 TO ASCIZ STRING
;CALL: MOVE T1,[BYTE POINTER]
; MOVE S1,SIXBIT
; PUSHJ P,C6TO7
C6TO7: SETZ S2,
ROTC S1,6 ;GET A CHARACTER IN S2
ADDI S2,40 ;CONVERT TO ASCII
IDPB S2,T1 ;STUFF IT
JUMPN S1,C6TO7 ;AND CONTINUE IF NOT DONE
IDPB S1,T1 ;TERMINATE WITH A 0 BYTE (S1 CONTAINS 0)
POPJ P,
;COTO7 - CONVERT OCTAL NUMBER IN S1 TO ASCII STRING
;CALL: MOVE T1,[BYTE POINTER]
; MOVE S1,NUMBER
; PUSHJ P,COTO7
COTO7: IDIVI S1,^D8
PUSH P,S2 ;SAVE REMAINDER
SKIPE S1 ;CONTINUE IF NOT DONE
PUSHJ P,COTO7 ;RECURSE
POP P,S1 ;GET A DIGIT
ADDI S1,"0" ;CONVERT TO OCTAL
IDPB S1,T1 ;STUFF IT
POPJ P,
SUBTTL Account string synonyms -- Initialize file
; Initialize ACT:SYN.ACT
; Call: PUSHJ P,SYNFIL
SYNFIL: SKIPN SYNFLG ;WANT SYNONYMS?
POPJ P, ;NOPE
MOVEI S1,FOB.MZ ;FOB SIZE
MOVEI S2,SYNFOB ;FOB ADDRESS
$CALL F%IOPN ;OPEN THE FILE
JUMPT SYNFI1 ;JUMP IF NO ERRORS
$WTOXX (<^E/[-1]/; ^F/SYNFD/>) ;REPORT ERROR
SETZM SYNFLG ;CAN'T DO SYNONYMS
POPJ P, ;RETURN
SYNFI1: MOVEM S1,SYNIFN ;SAVE IFN
MOVEI S1,^D100 ;START OFF WITH 100 ENTRIES
$CALL M%GMEM ;GET CORE
MOVEM S1,(S2) ;SAVE FOR S%TBLK
MOVEM S2,SYNTAB ;SAVE TABLE ADDRESS
SETZM SYNLIN ;INIT LINE NUMBER
SYNFI2: PUSHJ P,SYNRED ;READ A SYNONYM
JUMPF SYNFI6 ;JUMP IF EOF
SYNFI3: MOVE S1,SYNTAB ;GET TABLE POINTER
MOVE S2,SYNARG ;AND ARGUMENT
$CALL S%TBAD ;ADD TO TABLE
JUMPT SYNFI2 ;LOOP IF OK
CAIE S1,EREIT$ ;ALREADY IN TABLE?
JRST SYNFI4 ;NO
HLRZ S1,SYNARG ;GET DUPLICATE NAME ADDR
$WTOXX (<Duplicate synosym "^T/(S1)/" ignored>)
JRST SYNFI2 ;ON TO THE NEXT ONE
SYNFI4: CAIE S1,ERTBF$ ;TABLE FULL?
JRST SYNFI5 ;NO
MOVE TF,SYNTAB ;GET ADDRESS OF TABLE
HRRZ TF,@TF ;GET LENGTH
MOVE S2,TF ;MAKE A COPY
LSH TF,-1 ;DIVIDE BY TWO
MOVE S1,TF ;GET RESULT
ADDI S1,(S2) ;INCREASE TABLE LENGTH BY THIS MUCH
$CALL M%GMEM ;GET CORE
PUSH P,S1 ;SAVE NEW LENGTH
PUSH P,S2 ;SAVE NEW ADDRESS
HRLZ S1,SYNTAB ;POINT TO EXISTING TABLE
HRR S1,S2 ;MAKE A BLT POINTER
MOVE S2,SYNTAB ;GET OLD POINTER AGAIN
HRRZ S2,(S2) ;AND LENGTH
ADD S2,(P) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY OLD TABLE INTO NEW TABLE
MOVE S1,-1(P) ;GET NEW TABLE LENGTH
HRRM S1,@(P) ;SET IN NEW TABLE
MOVE S2,SYNTAB ;POINT TO OLD TABLE
HRRZ S1,(S2) ;GET ITS LENGTH
$CALL M%RMEM ;RELEASE CORE
POP P,SYNTAB ;SET NEW TABLE ADDRESS
POP P,(P) ;PHASE STACK
JRST SYNFI3 ;LOOP BACK AND ADD NEW ENTRY TO TABLE
SYNFI5: $WTOXX (<Unexpected error processing synonyms; ^E/[S1]/>)
SYNFI6: MOVE S1,SYNIFN ;GET IFN
$CALL F%REL ;RELEASE IT
$RETT ;AND RETURN
; FOB for synonym file
SYNFOB: $BUILD FOB.MZ
$SET(FOB.FD,,SYNFD)
$SET(FOB.CW,FB.BSZ,^D7)
$SET(FOB.CW,FB.LSN,1)
$EOB
; FD for synonym file
SYNFD: $BUILD FDMSIZ
$SET(.FDLEN,FD.LEN,FDMSIZ)
$SET(.FDSTR,,<SIXBIT/ACT/>)
$SET(.FDNAM,,<SIXBIT/SYN/>)
$SET(.FDEXT,,<SIXBIT/ACT/>)
$EOB
SUBTTL Account string synonyms -- Read a line from the file
; Read synonym-string=account-string
; Call: PUSHJ P,SYNRED
;
; TRUE return: SYNARG = synonym-string,,account-string
; FALSE return: EOF
SYNRED: PUSHJ P,SYNSTR ;READ FIRST STRING
$RETIF ;RETURN IF EOF
CAIE S2,"=" ;SYN STRING COMING?
JRST SYNRE1 ;ERROR
HRLZM S1,SYNARG ;SAVE SYNONYN
PUSHJ P,SYNSTR ;READ SYNONYM
JUMPF SYNRE1 ;ERROR IF EOF NOW
CAIE S2,.CHLFD ;<LF>?
JRST SYNRE1 ;ERROR
HRRM S1,SYNARG ;SAVE ACCOUNT STRING ADDRESS
AOS SYNLIN ;COUNT THE LINE
$RETT ;RETURN
SYNRE1: $WTOXX (<Bad format in synonym file following line ^D/SYNLIN/>)
$RETF ;AND FAIL
SUBTTL Account string synonyms -- Read a string
; Read an arbitrary ASCII string;CALL:
; Call: PUSHJ P,SYNSTR
;
; TRUE return: S1 = address of string, S2 = break character
; FALSE return: EOF
SYNSTR: $SAVE <P1,P2> ;SAVE SOME ACS
MOVE P1,[POINT 7,SYNTMP] ;P1 CONTAINS POINTER TO STORAGE
MOVEI P2,0 ;P2 COUNTS CHARACTERS
MOVE S1,SYNIFN ;GET IFN
SYNST1: $CALL F%IBYTE ;GET A CHAR
JUMPF SYNST3 ;JUMP IF ERRORS
CAIE S2,.CHNUL ;NULL
CAIN S2,.CHCRT ;OR <CR>
JRST SYNST1 ;YES--BORING
CAIE S2,.CHTAB ;TAB
CAIN S2," " ;OR SPACE?
JRST SYNST1 ;YES--SKIP THEM TOO
CAIE S2,"=" ;DELIMITER?
CAIN S2,.CHLFD ;<LF>?
JRST SYNST2 ;YES--FOUND END
CAIGE P2,.AACLC ;IF NOT TOO LONG
IDPB S2,P1 ;STORE CHARACTER
CAIN P2,.AACLC ;TOO LONG?
$WTOXX (<Truncating long string following line ^D/SYNLIN/>)
AOJA P2,SYNST1 ;LOOP
SYNST2: PUSH P,S2 ;SAVE BREAK CHAR
MOVEI S2,0 ;MAKE ASCIZ
IDPB S2,P1 ;STORE
ADDI P2,5 ;ROUND UP
IDIVI P2,5 ;TO WORDS
MOVEI S1,(P2) ;GET WORDS REQUIRED
$CALL M%GMEM ;GO GET THEM
MOVEI S1,(S2) ;POINT TO STORAGE
HRLZI S2,SYNTMP ;POINT TO START OF STRING
HRR S2,S1 ;POINT TO DESTINATION
MOVEI P1,(S1) ;GET DESTINATION
ADDI P1,(P2) ;PLUS SIZE
BLT S2,-1(P1) ;MOVE STRING
POP P,S2 ;RESTORE BREAK CHAR
$RETT ;AND RETURN
SYNST3: CAIE S1,EREOF$ ;END OF FILE?
$WTOXX (<Unexpected error processing ^F/SYNFD/; ^E/[S1]/>)
$RETF ;RETURN EOF
SUBTTL Account string synonyms -- Translate synonym to account string
; This routine wil translate a possible synonynm to a real
; account string.
; Call: MOVE S1, address of possible synonym
; PUSHJ P,SYNCHK
;
; TRUE return: Synonym converted to account string if necessary
; FALSE return: Never
SYNCHK: SKIPN SYNFLG ;WANT SYNONYMS?
$RETT ;NO
$SAVE <P1> ;SAVE P1
MOVEI P1,(S1) ;SAVE POINTER TO STRING
MOVEI S2,(S1) ;COPY POINTER
MOVE S1,SYNTAB ;POINT TO TABLE
$CALL S%TBLK ;LOOKUP IN TABLE
TXNN S2,TL%EXM!TL%ABR ;EXACT OR UNIQUE ABBREVIATION?
$RETT ;NO--NOTHING TO TRANSLATE
HRRZ S1,(S1) ;GET NEW STRING POINTER
HRLI S1,(POINT 7,) ;FORM POINTER TO NEW STRING
HRLI P1,(POINT 7,) ;FORM POINTER TO USER STRING
SYNCH1: ILDB S2,S1 ;GET A CHAR
IDPB S2,P1 ;STORE
JUMPN S2,SYNCH1 ;LOOP FOR ALL
$RETT ;AND RETURN
SUBTTL End
END ACTDAE