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