Trailing-Edge
-
PDP-10 Archives
-
BB-BT99U-BB_1990
-
10,7/acct/actlib.mac
There are 9 other files named actlib.mac in the archive. Click here to see a list.
UNIVERSAL ACTPRM - PARAMETER FILE FOR THE ACCOUNTING SUBROUTINE PACKAGE
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1986,1990.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; VERSION NUMBERS
APRVER==1 ;VERSION NUMBER
APRMIN==1 ;MINOR VERSION NUMBER
APREDT==13 ;EDIT NUMBER
APRWHO==0 ;WHO EDITED LAST
%%ACTP==:<BYTE(3)APRWHO(9)APRVER(6)APRMIN(18)APREDT>
SALL ;CLEAN LISTINGS
.DIREC FLBLST ;CLEANER LISTINGS
SUBTTL REVISION HISTORY
; 1 QAR ?????? DPM Date unknown
; Creation.
;
; 2 QAR ?????? DPM/RCB Date unknown
; A few buggers.
;
; 3 No SPR DPM 9-Jul-86
; Create edit history to satisfy Autopatch requirements.
; 4 No SPR DPM 18-Jul-86
; Change name of DEFAULT-LOG-FILE to LOG-FILE-DEFAULT to make
; the folks at TWINKY happy.
; 5 No SPR JAD 7-Aug-86
; Change TEMP in ACTRMS to be a block of length .AEMAX, otherwise
; updates of large records may fail unexpectedly.
;
; 6 No SPR DPM 18-Aug-86
; Correct undefined globals and parsing of filespecs in DLG routines.
;
; 7 No SPR RCB 2-Dec-86
; ERRMSG wasn't preserving S1 under 7.02.
;
; 10 10-35694 JJF 19-Feb-87
; (Incorrectly made as edit 151 to ACTDAE.)
; Fix the (unsupported) NCRYPT algorithm in ALGCUS so that it
; decrypts correctly (thus matching the original LOGIN routine).
;
; 11 10-35725 DPM 27-Aug-87
; Defend against updating a profile whose length has changed and the
; user name is being set to one which already exists. The code to
; handle profile length variations must detect this case before setting
; the sign bit of user name word zero to prevent record corruption.
;
; 12 10-36142 KDO 30-Aug-89
; Use the RMS function $NOMESSAGE to suppress error messages
; (since ACTDAE runs detached).
;
; 13 No SPR DPM 29-Nov-89
; Do not use %CNDAE for checking the monitor version; that is for
; use only by DAEMON. Use %CNDVN instead.
SUBTTL MODULE INITIALIZATION MACRO
; MACRO TO SEARCH THE APPROPRIATE UNIVERSALS AND TO INITIALIZE ASSEMBLY
DEFINE MODULE (NAME),<
SALL ;;CLEAN LISTINGS
.DIREC FLBLST ;;CLEAN LISTINGS
SEARCH ACTSYM ;;ACCOUNTING DEFINITIONS
SEARCH GLXMAC ;;GALAXY DEFINITIONS
; SEARCH ORNMAC ;;PARSING DEFINITIONS
PROLOG ('NAME) ;;INIT GALACTIC STUFF
%%ACTP==:%%ACTP ;;FORCE ACTPRM VERSION INTO THE SYMBOL TABLE
TWOSEG 400K ;;MAKE US SHARABLE
RELOC 400K ;;START LOADING THE HIGH SEG BY DEFAULT
> ;END DEFINE MODULE
MODULE (ACTPRM)
SUBTTL ASSEMBLY PARAMETERS
; ASSEMBLY PARAMETERS
ND ACTFIL,<SIXBIT /ACTDAE/> ;ACCOUNTING FILE NAME
; SPECIAL AC ASSIGNMENTS USED BY REACT AND CUSREA
U==.A13 ;POINTER TO USER BLOCK
X==.A14 ;ALTERNATE POINTER TO USER BLOCK
SUBTTL ERROR MACROS
DEFINE FATAL (PFX,TXT,DAT,RET<MAIN>),<.ERR. ("?",PFX,<TXT>,DAT,RET)>
DEFINE WARN (PFX,TXT,DAT,RET<.+1>),<.ERR. ("%",PFX,<TXT>,DAT,RET)>
DEFINE INFO (PFX,TXT,DAT,RET<.+1>),<.ERR. ("[",PFX,<TXT>,DAT,RET)>
DEFINE .ERR. (CHR,PFX,TXT,DAT,RET),<
PUSHJ P,[PUSHJ P,A$ERRM##
XWD CHR,''PFX''
XWD RET,[ITEXT (<TXT>)]
IFB <DAT>,< EXP 0>
IFNB <DAT>,< EXP DAT>
]
> ;END DEFINE .ERR.
SUBTTL PROFILE DESCRIPTORS
; PROFILE DESCRIPTORS USED IN THE TABLE DRIVEN CHANGE AND
; SELECTION CODE
PD.RTN==1B0 ;CALL A ROUTINE
PD.NSL==1B1 ;NO SELECTION IS TO BE DONE
PD.UNP==1B2 ;UNPRIVILEGED FIELD
PD.MSK==1B3 ;MASKABLE WORD
PD.EXT==1B4 ;EXTENSIBLE QUANTITY
PD.NMD==1B5 ;NOT MODIFIABLE VIA UGCUP$
PD.CND==1B6 ;CAN NOT BE DEFAULTED
PD.NDI==1B7 ;CAN NOT BE DISPLAYED
PD.WRD==777B17 ;WORD (REPEAT) COUNT
;DEFINE SOME SYMBOLS FOR DEALING WITH .AEMAP
DEFINE AE (NAM,LEN,BITS,RTN),<
.DF'NAM==<.AE'NAM/^D36> ;;WORD OFFSET IN MAP
DF.'NAM==1B<.AE'NAM-.DF'NAM*^D36> ;;BIT IN WORD
DF$'NAM==.AEMAP+.DF'NAM ;;WORD IN PROFILE
>
AEPROF ;DEFINE THE SYMBOLS
PURGE AE ;DON'T KEEP THE MACRO AROUND
SUBTTL PROFILE ENTRY VECTOR DEFINITIONS USED BY REACT AND CUSREA
; OFFSETS INTO THE PROFILE ENTRY VECTOR
CG.FLG==:0 ;FLAGS
FL.NTY==:1B0 ;IGNORE THIS BLOCK ON TYPEOUT
FL.XCR==:1B1 ;OUTPUT AN EXTRA CRLF AFTER TYPEOUT
CG.IDX==:1 ;PROFILE ENTRY INDEX
CG.PRM==:2 ;PROMPT STRING
CG.GET==:3 ;ROUTINE TO GET VALUES FROM COMMAND BLOCK
CG.CMP==:4 ;ROUTINE TO COMPARE VALUES IN TWO BLOCKS
CG.CHG==:5 ;ROUTINE TO REQUEST CHANGES FROM ACTDAE
CG.RES==:6 ;ROUTINE TO RESTORE OLD VALUES
CG.PRT==:7 ;ROUTINE TO TYPE OUT VALUES IN PRETTY FORM
CG.HLP==:10 ;ADDRESS OF HELP TEXT
CG.PRS==:11 ;ADDRESS OF PARSE BLOCKS
CG.PFL==:12 ;PROFILE OFFSET FOR ENTRY
CG.DFL==:13 ;ROUTINE TO RESET TO DEFAULTS
ENTNUM==:700000 ;INITIALIZE PROFILE ENTRY INDEX
; MACRO TO GENERATE THE PROFILE ENTRY VECTORS
DEFINE .ENTRY (ABV,PFL,TEXT,FLAGS,%A),<
.XCREF %A
.ASSIGN %A,ENTNUM,1
ABV:: EXP FLAGS
XLIST
EXP <%A&7777>+1
IFIW [ASCIZ \TEXT\]
IFIW ABV'GET
IFIW ABV'CMP
IFIW ABV'CHG
IFIW ABV'RES
IFIW ABV'PRT
IFIW ABV'HLP
IFIW ABV'PRS
EXP PFL
IFIW ABV'DFL
LIST
> ;END DEFINE .ENTRY
PRGEND
TITLE ACTERR - SUPPORT FOR THE ERROR MESSAGE MACROS
SEARCH ACTPRM
MODULE (ACTERR)
ENTRY A$ERRI
; INITIALIZE
A$ERRI::HRLZM S1,PGMPFX ;SAVE PROGRAM PREFIX
MOVEM S2,PGMSUB ;SAVE EXIT SUBROUTINE ADDRESS
POPJ P, ;RETURN
; THIS CODE CAN ONLY BE INVOKED BY USING THE FATAL, WARN, AND INFO
; MACROS DEFINED IN ACTPRM
A$ERRM::DMOVEM T1,ERRACS ;SAVE T1 AND T2
DMOVEM T3,ERRACS+2 ;SAVE T3 AND T4
HRRZ T1,(P) ;GET ADDRESS OF ARGS FROM CALL
POP P,(P) ;GET EXTRA PUSHJ OFF THE STACK
MOVE T2,2(T1) ;GET DATA WORD
MOVEM T2,ERRDAT ;SAVE
SKIPE PGMSUB ;ERROR SUBROUTINE SUPPLIED?
JRST ERRM1 ;YES
HRROI T2,.GTWCH ;GETTAB TO
GETTAB T2, ; RETURN WATCH BITS
SETZ T2, ;STRANGE ...
TXNN T2,JW.WPR!JW.WFL ;HAVE PREFIX OR FIRST LINE SET?
ERRM1: TXO T2,JW.WPR!JW.WFL ;NO--DEFAULT TO THEM
MOVEI T3," " ;GET A SPACE
TXNE T2,JW.WPR ;PREFIX?
TXNN T2,JW.WFL ; AND FIRST LINE?
SETZ T3, ;NO
MOVEM T3,ERRSPC ;SAVE SPACE
HLRZ T3,0(T1) ;GET INITIAL CHARACTER
MOVEM T3,ERRICH ;SAVE
MOVEI T4,"]" ;INCASE INFORMATIONAL
CAIE T3,"[" ;CHECK
MOVEI T4,0 ;ISN'T
MOVEM T4,ERRFCH ;SAVE FINAL CHARACTER
MOVE T3,PGMPFX ;GET PROGRAM PREFIX
HRR T3,0(T1) ;INCLUDE ERROR PREFIX
TXNN T2,JW.WPR ;WANT PREFIX?
SETZ T3, ;NO
MOVEM T3,ERRPFX ;SAVE
HRRZ T3,1(T1) ;GET ITEXT BLOCK
TXNN T2,JW.WFL ;WANT FIRST LINE?
MOVEI T3,[ITEXT (<>)] ;NO
MOVEM T3,ERRTXT ;SAVE
HLRZ T3,1(T1) ;GET RETURN ADDRESS
HRRM T3,(P) ;SAVE ON STACK
SKIPE PGMSUB ;ERROR SUBROUTINE SUPPLIED?
JRST ERRM2 ;YES--DON'T TYPE ANYTHING
MOVE T1,[2,,T2] ;SET UP UUO AC
MOVEI T2,.TOFLM ;FUNCTION CODE
MOVNI T3,1 ;-1 FOR US
TRMOP. T1, ;FORCE LEFT MARGIN
$TEXT (T%TTY,<>) ;OLD MONITOR, DO IT THE HARD WAY
ERRM2: DMOVE T1,ERRACS ;RESTORE T1 AND T2
DMOVE T3,ERRACS+2 ;RESTORE T3 AND T4
SKIPE PGMSUB ;ERROR SUBROUTINE SUPPLIED?
PJRST @PGMSUB ;YES--GIVE CALLER CONTROL
$TEXT (T%TTY,<^7/ERRICH/^W/ERRPFX/^7/ERRSPC/^I/@ERRTXT/^7/ERRFCH/>)
POPJ P, ;RETURN
; ROUTINE TO PROCESS A QUEUE. UUO ERROR
; CALL: MOVE T1, UUO AC
; MOVE T2, ADDRESS OF QUEUE. UUO BLOCK
; MOVE T3, RETURN ADDRESS
; MOVE T4, EXTRA DATA
; PUSHJ P,A$QERR
A$QERR::DMOVEM T1,ERRACS ;SAVE T1 AND T2
DMOVEM T3,ERRACS+2 ;SAVE T3 AND T4
MOVE T1,[ERRBLK,,ERRBLK+1] ;SET UP BLT
SETZM ERRBLK ;CLEAR FIRST WORD
BLT T1,ERRBLK+4 ;ZAP ENTIRE BLOCK
MOVE T1,[PUSHJ P,A$ERRM] ;INSTRUCTION TO CALL ERROR HANDLER
MOVEM T1,ERRBLK+0
POP P,T1 ;PHASE STACK
SKIPN T3 ;HAVE A RETURN ADDRESS
MOVE T3,T1 ;NO--RETURN .+1
HRLZM T3,ERRBLK+2 ;SAVE
MOVEM T4,ERRBLK+3 ;SAVE EXTRA DATA
; CHECK FOR A RESPONSE BLOCK
QERR1: DMOVE T1,ERRACS ;GET T1 AND T2 BACK
TXNE T1,QU.RBT!QU.RBR;RESPONSE BLOCK RETURNED?
JUMPN T2,QERR2 ;YES
MOVE T2,T1 ;COPY ERROR CODE
MOVEM T2,ERRTMP ;SAVE INCASE UNKNOWN
CAIL T2,QUEELN ;KNOWN ERROR CODE?
MOVEI T2,0 ;NO
MOVS T3,QUEETB(T2) ;GET PREFIX,,ITEXT
HLRM T3,ERRBLK+2 ;SAVE ITEXT
HRLI T3,"?" ;FATAL ERROR
MOVEM T3,ERRBLK+1 ;SAVE PREFIX
JRST QERR4 ;FINISH UP
QERR2: MOVEI T1,[ITEXT(<^T/@ERRTMP/>)]
HRRM T1,ERRBLK+2 ;SAVE ITEXT BLOCK
HRRZ T2,.QURSP(T2) ;GET ADDRESS OF THE RESPONSE BLOCK
MOVE T1,(T2) ;GET PREFIX CHARACTER AND SIXBIT PREFIX
MOVEM T1,ERRBLK+1 ;SAVE
MOVEI T1,1(T2) ;POINT TO START OF STRING
MOVEM T1,ERRTMP ;SAVE ADDRESS FOR LATER
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
QERR3: ILDB T3,T1 ;GET A CHARACTER
CAIE T3,.CHLFD ;LINE FEED?
CAIN T3,.CHCRT ;CARRIAGE RETURN?
MOVEI T3,.CHNUL ;YES--WE DON'T DO MULTI-LINE STUFF
IDPB T3,T1 ;PUT A CHARACTER
SKIPE T3 ;DONE?
JRST QERR3 ;NO
QERR4: DMOVE T1,ERRACS+0 ;RESTORE T1 AND T2
DMOVE T3,ERRACS+2 ;RESTORE T3 AND T4
PUSHJ P,ERRBLK ;GENERATE ERROR MESSAGE (NEVER RETURN)
QUEETB: XWD 'UUE',[ITEXT (<Unknown QUEUE. UUO error ^O/ERRTMP/>)]
XWD 'IAL',[ITEXT (<Illegal argument list>)]
XWD 'IFC',[ITEXT (<Illegal function code>)]
XWD 'NFC',[ITEXT (<No monitor free core>)]
XWD 'ADC',[ITEXT (<Address check>)]
XWD 'CNR',[ITEXT (<Component not running; no system pid>)]
XWD 'EFO',[ITEXT (<Fatal error returned from component>)]
XWD 'IMO',[ITEXT (<Invalid message from component>)]
XWD 'NPV',[ITEXT (<Not privileged>)]
XWD 'NRA',[ITEXT (<No response from component>)]
QUEELN==.-QUEETB
LIT
RELOC 0
PGMSUB: BLOCK 1 ;ERROR SUBROUTINE
PGMPFX: BLOCK 1 ;3-CHARACTER PROGRAM PREFIX
ERRBLK: BLOCK 5 ;DUMMY ERROR BLOCK
ERRTMP: BLOCK 1 ;TEMP STORAGE
ERRACS::BLOCK 4 ;ERROR ACS (T1-T4)
ERRDAT::BLOCK 1 ;DATA WORD
ERRPFX::BLOCK 1 ;ERROR PREFIX
ERRTXT::BLOCK 1 ;ERROR TEXT
ERRICH::BLOCK 1 ;INITIAL ERROR CHARACTER
ERRFCH::BLOCK 1 ;FINAL ERROR CHARACTER
ERRSPC::BLOCK 1 ;SPACE CHARACTER
PRGEND
TITLE ACTNAM - CHECK FOR RESERVED NAMES
SEARCH ACTPRM
MODULE (ACTNAM)
ENTRY A$CKNM, A$CKPP
; THIS ROUTINE WILL WEED OUT RESERVED NAMES SUCH AS "*-DEFAULT"
; AND "NNN-DEFAULT" WHERE NNN IS A VALID PROJECT NUMBER. THE
; RESERVED NAMES ARE USED FOR THE DEFAULT PROFILES. THIS ALSO
; CHECKS FOR "POSTMASTER", THE STANDARD NAME RESERVED FOR MAIL.
;
; NOTE THAT IN THE COMPARE LOOP BELOW, THE CHARACTER FROM OUR
; INTERNAL STRING IS CASE SHIFTED RATHER THAN MESSING AROUND
; WITH THE USER SUPPLIED STRING WHICH COULD CONTAIN UGLY 8-BIT
; CHARACTERS AND NECESSITATE THE USE OF ELABORATE CASE SHIFTING
; SCHEMES.
;
; RETURNS TRUE IF NAME IS OK FOR GENERAL USE. RETURNS FALSE IF THE NAME
; IS RESERVED TO THE ACCOUNTING SYSTEM. ON THE FALSE RETURN, S1 HOLDS
; THE PPN CORRESONDING TO THE RESERVED NAME.
A$CKNM::PUSHJ P,.SAVET ;SAVE T1-T4
PUSHJ P,.SAVE1 ;AND ANOTHER
MOVE T1,S1 ;COPY ADDRESS OF NAME
HRLI T1,(POINT 8,) ;8-BIT ASCIZ
MOVEI T2,^D39-1 ;LENGTH MINUS ONE
MOVEI T3,6 ;DIGIT COUNTER
MOVNI T4,1 ;ASSUME AN ASTERISK IS ON THE WAY
ILDB S1,T1 ;GET A CHARACTER
CAIE S1,"P" ;PERHAPS "POSTMASTER"
CAIN S1,"P"+40 ; IN EITHER CASE?
SOJA T3,CKNM4 ;GO CHECK IT OUT
SETO T4, ;PROJECT FOR "*-DEFAULT"
CAIN S1,"*" ;SPECIAL DEFAULT FOR ALL PPNS?
SOJA T3,CKNM2 ;YES--COUNT NEXT CHARACTER WE'RE ABOUT TO GET
TDZA T4,T4 ;CLEAR PROJECT NUMBER RESULT
CKNM1: ILDB S1,T1 ;GET A CHARACTER
CAIL S1,"0" ;RANGE
CAILE S1,"7" ; CHECK
JRST CKNM3 ;NOT A DIGIT
IMULI T4,10 ;PROJECT NUMBERS ARE OCTAL
ADDI T4,-"0"(S1) ;ADD IN DIGIT
SOSLE T2 ;COUNT NEXT CHARACTER WE'RE ABOUT TO GET
SOJG T3,CKNM1 ;LOOP BACK
SKIPA ;NOW CHECK FOR A DASH
CKNM2: ILDB S1,T1 ;GET NEXT CHARACTER
CKNM3: CAIE S1,"-" ;OCTAL STRING FOLLOWED BY A DASH?
$RETT ;NAME IS LEGAL
CAML T4,[-1] ;RANGE
CAILE T4,377777 ; CHECK
$RETT ;OK NAME IF PROJECT OUT OF RANGE
MOVE T3,[POINT 7,[ASCIZ /DEFAULT/]] ;POINT TO "DEFAULT"
MOVEI P1,7 ;CHARACTER COUNT
JRST CKNM5 ;ENTER LOOP
CKNM4: MOVE T3,[POINT 7,[ASCIZ /OSTMASTER/]] ;STANDARD RESERVED FOR MAIL
MOVEI P1,11 ;CHARACTER COUNT
MOVSI T4,'UPS' ;ERSATZ DEVICE RESERVED TO MAIL
DEVPPN T4,UU.PHY ;OBTAIN POSTMASTER'S PPN
MOVE T4,[5,,35] ;DEFAULT VALUE
CKNM5: ILDB S1,T1 ;GET CHARACTER FROM NAME
ILDB S2,T3 ;GET CHARACTER FROM SPECIAL STRING
MOVEI TF,40(S2) ;GET LOWER CASE EQUIVALENT TOO
CAIE S2,(S1) ;MATCH UPPER CASE?
CAIN TF,(S1) ;MATCH LOWER CASE?
SKIPA ;YES
$RETT ;NAME IS LEGAL
SOJLE T2,.RETT ;RETURN IF NAME RUNS OUT
SOJG P1,CKNM5 ;LOOP
TLNN T4,-1 ;HAVE A PPN OR A PROJECT?
HRLOS T4 ;PROJECT, MAKE IT A PPN
MOVE S1,T4 ;RETURN THE CORRESPONDING PPN
$RETF ;REQUESTED NAME IS RESERVED TO ACCT SYSTEM
; THIS ROUTINE CHECKS A PPN TO SEE IF IT IS ONE OF THOSE RESERVED TO THE
; ACCOUNTING SYSTEM.
;
; RETURNS TRUE IF THE PPN IS OK FOR GENERAL USE. RETURNS FALSE IF THE PPN
; IS RESERVED. BOTH RETURNS LEAVE S1 POINTING TO AN ASCIZ (7-BIT) TEXT
; STRING WHICH IS THE DEFAULT (OR RESERVED) NAME FOR THAT PPN.
A$CKPP::MOVE S2,S1 ;COPY THE PPN SUPPLIED
AOJE S2,CKPP.0 ;*-DEFAULT IF [%,%]
HLLO S2,S1 ;NO, GET PROJECT-DEFAULT FOR GIVEN VALUE
CAMN S2,S1 ;MATCH?
JRST CKPP.1 ;YES, GO DEAL WITH NNN-DEFAULT
MOVSI S2,'UPS' ;NO, GET MAILER'S ERSATZ DEVICE
DEVPPN S2,UU.PHY ;GET CORRESPONDING PPN
MOVE S2,[5,,35] ;DEFAULT
CAMN S2,S1 ;MATCH?
JRST CKPP.2 ;YES, GO RETURN POSTMASTER
$TEXT (<-1,,PPNNAM>,<^O/S1,LHMASK/,^O/S1,RHMASK/^0>)
MOVEI S1,PPNNAM ;POINT TO BLOCK FOR "P,PN" NAME
$RETT ;NON-RESERVED PPN
CKPP.0: MOVEI S1,[ASCIZ /*-DEFAULT/] ;POINT TO NAME FOR [%,%]
$RETF ;RESERVED PPN
CKPP.1: $TEXT (<-1,,PPNNAM>,<^O/S1,LHMASK/-DEFAULT^0>)
MOVEI S1,PPNNAM ;POINT TO BLOCK FOR NNN-DEFAULT
$RETF ;RESERVED PPN
CKPP.2: MOVEI S1,[ASCIZ /POSTMASTER/] ;NAME FOR MAILER'S PPN
$RETF ;RESERVED PPN
LIT
RELOC 0 ;LOWSEG
PPNNAM: BLOCK .AANLW ;SPACE TO MAKE A NAME
PRGEND
TITLE ACTPRS - PARSE AN OPTIONALLY WILDCARDED USER-ID
SEARCH ACTPRM
MODULE (ACTPRS)
ENTRY A$PWLD
; PARSE A USER-ID
; CALL: MOVE T1, WILDCARD BLOCK ADDRESS
; MOVE T2, BYTE POINTER TO USER-ID ACK BLOCK
; PUSHJ P,A$PWLD
;
; TRUE RETURN: WILDCARD AND ACK BLOCKS FILLED IN
; FALSE RETURN: NO PPN, NAME, OR QUOTED STRING TO BE PARSED
A$PWLD::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,T1 ;COPY WILDCARD BLOCK, BYTE POINTER
MOVSI T1,0(P1) ;POINT TO START OF WILDCARD BLOCK
HRRI T1,1(P1) ;MAKE A BLT POINTER
SETZM (P1) ;CLEAR FIRST WORD
BLT T1,UW$SEL-1(P1) ;CLEAR ALL BUT SELECTION COUNT AND DATA
PUSHJ P,P$USER## ;TRY TO GET A PPN
JUMPT PRSPPN ;GOT IT
PUSHJ P,P$FLD## ;ELSE GO FOR A NAME
JUMPT PRSNAM ;GOT IT
PUSHJ P,P$QSTR## ;PERHAPS A QUOTED STRING?
JUMPT PRSQST ;YES
$RETF ;GIVE UP
; PARSE A PPN
PRSPPN: SETZM UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO PPN
LOAD S1,ARG.HD(S2),AR.LEN ;GET RETURNED LENGTH
DMOVE T1,ARG.DA(S2) ;GET PPN AND POSSIBLE MASK
CAIE S1,3 ;WAS A MASK RETURNED?
MOVNI T2,1 ;NO--DEFAULT TO NON-WILD
ORCM T1,T2 ;MAKE SURE WILD FIELDS GET CAUGHT BELOW
MOVEM T1,UW$PPN(P1) ;SAVE PPN
MOVEM T2,UW$PPM(P1) ;SAVE MASK
PJRST PPNACK## ;GENERATE ACK TEXT AND RETURN
; PARSE A NAME
PRSNAM: MOVE T1,[POINT 8,1(S1)] ;POINT AT USERNAME
MOVEI T3,UW$NAM(P1) ;NAME FOR WILDCARDING
HRLI T3,(POINT 8,) ;8-BIT ASCIZ
PUSH P,[EXP 0] ;INIT WILD FLAG
MOVEI T2,1 ;INIT OTHER WILD FLAG
PRSNA1: ILDB S2,T1 ;GET A BYTE
IDPB S2,T3 ;STORE IN NAME FOR WILDCARDING
CAIE S2,"*" ;IS IT A WILDCARD?
CAIN S2,"?" ;OR A DIFFERENT WILDCARD?
ADDM T2,(P) ;MAYBE FLAG THE FACT
CAIN S2,.CHCNV ;IS THIS THE QUOTE CHARACTER?
TDZA T2,T2 ;YES, NEXT CHARACTER CAN'T LIGHT THE WILD FLAG
MOVEI T2,1 ;NO, NEXT CHARACTER GETS CHECKED NORMALLY
JUMPN S2,PRSNA1 ;LOOP
POP P,S1 ;GET FLAG BACK
MOVEI S2,1 ;ASSUME WILDCARDED NAME
SKIPN S1 ;TEST
MOVEI S2,2 ;NON-WILDCARDED NAME
MOVEM S2,UW$WST(P1) ;SAVE WILDCARD SEARCH TYPE
PJRST NAMACK## ;GENERATE ACK TEXT AND RETURN
; PARSE A QUOTED NAME
PRSQST: MOVE T1,[POINT 8,1(S1)] ;POINT AT USERNAME
MOVEI T2,UW$NAM(P1) ;NAME FOR WILDCARDING
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
PRSQS1: ILDB S2,T1 ;GET A BYTE
IDPB S2,T2 ;STORE IN NAME FOR WILDCARDING
JUMPN S2,PRSQS1 ;LOOP
MOVEI S1,2 ;GET CODE
MOVEM S1,UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO NON-WILD NAME
PJRST NAMACK## ;GENERATE ACK TEXT AND RETURN
LIT
PRGEND
TITLE ACTACK - ACK TEXT GENERATOR
SEARCH ACTPRM
MODULE (ACTACK)
ENTRY A$WACK, NAMACK, PPNACK
; GENERATE ACK TEXT BASED ON WILDCARD BLOCK
; CALL: MOVE T1, WILDCARD BLOCK ADDRESS
; MOVE T2, BYTE POINTER TO USER-ID ACK BLOCK
; PUSHJ P,A$GACK
A$WACK::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,T1 ;COPY WILDCARD BLOCK, BYTE POINTER
SKIPN UW$WST(P1) ;SKIP IF SEARCHING BY NAME
JRST PPNACK ;IT'S PPN
NAMACK::MOVEI T2,UW$NAM(P1) ;POINT TO NAME
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
NAMAC1: ILDB T1,T2 ;GET A BYTE
IDPB T1,P2 ;PUT A BYTE
JUMPN T1,NAMAC1 ;LOOP BACK
POPJ P, ;AND RETURN
PPNACK::MOVEI T1,"[" ;GET A BRACKET
IDPB T1,P2 ;STORE
HLLZ T1,UW$PPN(P1) ;GET PROJECT NUMBER
HLR T1,UW$PPM(P1) ;AND MASK
PUSHJ P,PPNAC1 ;TYPE MASKED OCTAL HALF WORD
MOVEI T1,"," ;GET A COMMA
IDPB T1,P2 ;STORE
HRLZ T1,UW$PPN(P1) ;GET PROGRAMMER NUMBER
HRR T1,UW$PPM(P1) ;AND MASK
PUSHJ P,PPNAC1 ;TYPE MASKED OCTAL HALF WORD
MOVEI T1,"]" ;GET A BRACKET
IDPB T1,P2 ;STORE
MOVEI T1,0 ;GET A NUL
IDPB T1,P2 ;TERMINATE STRING
POPJ P, ;AND RETURN
PPNAC1: TRCN T1,-1 ;MAKE MASK BIT 0 IF NOT WILD
JRST PPNAC5 ;TYPE * IF ALL WILD
HLRZ T2,T1 ;GET LH
CAIN T2,-2 ;FUNNY NUMBER?
JRST PPNAC6 ;YES
CAIN T2,-1 ;DEFAULT NUMBER?
JRST PPNAC7 ;YES
MOVE T2,T1 ;MOVE TO CONVENIENT PLACE
MOVEI T3,6 ;SET LOOP COUNT
PPNAC2: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;POSITION FIRST DIGIT
JUMPN T1,PPNAC4 ;GO IF NON-ZERO
SOJG T3,PPNAC2 ;LOOP UNTIL ALL DONE
PPNAC3: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;GET NEXT DIGIT
PPNAC4: ADDI T1,"0" ;CONVERT TO ASCII
TLNE T2,7 ;CHECK MASK
MOVEI T1,"?" ;CHANGE TO ? IF WILD
IDPB T1,P2 ;STORE CHARACTER
SOJG T3,PPNAC3 ;LOOP UNTIL DONE
POPJ P, ;RETURN
PPNAC5: MOVEI T1,"*" ;GET AN ASTERISK
IDPB T1,P2 ;STORE CHARACTER
POPJ P, ;RETURN
PPNAC6: SKIPA T1,["#"] ;FUNNY CHARACTER
PPNAC7: MOVEI T1,"%" ;DEFAULT CHARACTER
IDPB T1,P2 ;STORE CHARACTER
POPJ P, ;RETURN
LIT
PRGEND
TITLE ACTQUE - QUEUE UP A REQUEST FOR A PROFILE
SEARCH ACTPRM
MODULE (ACTQUE)
ENTRY A$QWLD
; QUEUE A REQUEST FOR A POSSIBLY WILDCARDED USER-ID TO [SYSTEM]ACCOUNTING
; CALL: MOVE T1, WILDCARD BLOCK ADDRESS
; MOVE T2, RESPONSE BLOCK ADDRESS
; MOVE T3, DEBUGGING PID ADDRESS,,MAXIMUM NUMBER OF SECONDS TO WAIT
; MOVE T4, PRIV-ENABLE FLAG (FALSE-OFF, TRUE-ON)
; PUSHJ P,A$QWLD
;
; TRUE RETURN: FIRST/NEXT PROFILE RETURNED IN SPECIFIED BLOCK
; FLASE RETURN: PROFILE NOT FOUND, S1 CONTAINS THE QUEUE. UUO ERROR CODE
ND .QUPID,.QUTIM+1 ;IN CASE NOT YET IN UUOSYM
A$QWLD::PUSHJ P,.SAVE1 ;SAVE P1
SKIPN DEBUGW ;ARE WE DEBUGGING IN GALACTIC STYLE?
ANDI T3,-1 ;NO, IGNORE THE PID ADDRESS
MOVEI P1,QUEBLK ;POINT TO ARG BLOCK
MOVE S1,[QF.RSP+.QUMAE] ;WANT RESPONSE BLOCK + ACCOUNTING FUNCTION
MOVEM S1,.QUFNC(P1) ;SAVE
SETZM .QUNOD(P1) ;CENTRAL STATION
MOVE S1,T2 ;GET RESPONSE BLOCK ADDRESS
HRLI S1,.AEMAX ;LENGTH OF A USER PROFILE
MOVEM S1,.QURSP(P1) ;SAVE
HRLI P1,.QUARG ;LENGTH OF BLOCK SO FAR
JUMPE T3,QWLD1 ;SKIP THIS STUFF IF NO TIME LIMIT
MOVE S1,[%CNDVN] ;GETTAB ARGUMENT
GETTAB S1, ;GET MONITOR VERSION
SETZ S1, ;ANCIENT MONITOR
LDB S1,[POINT 9,S1,11] ;GET MONITOR VERSION
CAIGE S1,703 ;CAN QUEUE. UUO TIMEOUT?
JRST QWLD1 ;NO
HRRZM T3,.QUTIM(P1) ;SAVE
ADD P1,[1,,0] ;UPDATE THE HEADER LENGTH
TLNN T3,-1 ;DO SOME MORE?
JRST QWLD1 ;NO, SKIP .QUPID
HLRZ S1,T3 ;YES, GET PID ADDRESS
MOVE S1,(S1) ;FETCH VALUE
JUMPE S1,QWLD1 ;IGNORE THIS IF WANT DEFAULT PID AFTER ALL
MOVEM S1,.QUPID(P1) ;SET FOR QUEUE. UUO
ADD P1,[1,,0] ;ANOTHER HEADER WORD
QWLD1: HLRZ S1,P1 ;GET WORD COUNT SO FAR
CAIE S1,.QUARG ;IF NOT THE DEFAULT,
DPB S1,[POINTR .QUFNC(P1),QF.HLN] ;STORE HEADER LENGTH
ADD P1,S1 ;POINT AT FIRST FREE WORD
DMOVE S1,[EXP <QA.IMM!1B17!.QBAFN>,UGWLD$] ;ACCOUNTING SUB-FUNCTION
SKIPE T4 ;WANT PRIVS?
TXO S2,AF.PRV ;YES, REQUEST THEM
DMOVEM S1,(P1) ;SAVE
ADD P1,[2,,2] ;ADVANCE POINTER
HLRZ S1,UW$TYP(T1) ;GET LENGTH OF MESSAGE
SKIPN S1 ;IS IT SET UP?
MOVEI S1,UW$MIN ;NO--DEFAULT TO MINIMUM LENGTH
CAIN S1,UW$MIN ;ANY SELECTION DATA?
SETZM UW$SEL(T1) ;NO--CLEAR OUT BLOCK COUNT
HRLZS S1 ;PUT LENGTH IN LH
HRRI S1,.QBAET ;INCLUDE BLOCK TYPE
MOVE S2,T1 ;POINT TO WILDCARD BLOCK
DMOVEM S1,(P1) ;SAVE
ADD P1,[2,,2] ;ADVANCE POINTER
HLRZ S1,P1 ;GET LENGTH OF BLOCK
SUBB P1,S1 ;SET UP UUO AC
QUEUE. S1, ;SEND REQUEST TO ACCOUNTING DAEMON
$RETF ;NO SUCH USER
QWLD2: MOVE S1,.AEPPN(T2) ;GET RESULT
MOVEM S1,UW$BRE(T1) ;SAVE
MOVSI S1,.AENAM(T2) ;POINT TO NAME
HRRI S1,UW$BRE(T1) ;AND DESTINATION
SKIPE UW$WST(T1) ;SKIP IF WILDCARDING BY PPN
BLT S1,UW$ERE(T1) ;COPY FOR NEXT CALL
AOS UW$FND(T1) ;COUNT THE PROFILE RETURNED
$RETT ;YES
LIT
RELOC 0
QUEBLK: BLOCK 11 ;QUEUE. UUO ARGUMENT BLOCK
PRGEND
TITLE ACTRMS - RMS-10 INTERFACE TO ACTDAE
SEARCH RMSINT,ACTPRM
MODULE (ACTRMS)
ENTRY INITIO
; SYMBOLS UNIQUE TO RMS THAT CALLERS MAY CARE ABOUT. SAVES THEM HAVING
; TO USE RMSINT
INTERN ER$RNF,ER$DUP,SU$DUP,ER$CHG,ER$COF,ER$EOF,ER$FNF,ER$PRV
INTERN ER$RSZ,ER$RTB,ER$BUG,ER$UDF
; SPECIAL AC DEFINITIONS
F==13 ;CURRENT FAB
R==14 ;CURRENT RAB
SUBTTL RMS-10 DATA STRUCTURES
; PROTOTYPE FAB
FAB: FAB$B ;INITIALIZE A FAB
F$BSZ ^D9 ;FILE BYTE SIZE
F$BKS ^D5 ;BUCKET SIZE FOR FILE
F$FOP FB$CIF ;CREATE IF NOT FOUND
F$MRS <<<<<.AEMAX>*4>>>> ;MAX RECORD (PROFILE) SIZE
F$ORG FB$IDX ;INDEXED MODE
F$RFM FB$VAR ;VARIABLE LENGTH RECORDS
F$SHR FB$NIL ;NO SHARING
FAB$E ;END OF FAB
; PROTOTYPE RAB
RAB: RAB$B ;INITIALIZE THE RAB
R$KRF 0 ;DEFAULT KEY OF REF IS PRI INDEX
R$MBF ^D8 ;ALLOW SOME REASONABLE # OF BUFFERS
R$PAD 0 ;PAD CHAR
RAB$E ;END OF RAB
; PROTOTYPE XAB FOR AREA 1 (PPN)
XABA1: XAB$B ALL ;ALLOCATION
X$AID 1 ;PPN INDEX
X$BKZ 1 ;BUCKET SIZE
XAB$E ;END OF XAB
; PROTOTYPE XAB FOR AREA 2 (NAME SECONDARY DATA BUCKETS)
XABA2: XAB$B ALL ;ALLOCATION
X$AID 2 ;NAME SIDRS
X$BKZ 1 ;BUCKET SIZE
XAB$E ;END OF XAB
; PROTOTYPE XAB FOR AREA 3 (NAME INDEX)
XABA3: XAB$B ALL ;ALLOCATION
X$AID 3 ;NAME INDEX
X$BKZ 1 ;BUCKET SIZE
XAB$E ;END OF XAB
; PROTOTYPE XAB FOR KEY 0
XABK0: XAB$B KEY ;KEY
X$REF 0 ;THIS IS THE PRIMARY KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 0 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$IAN 1 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$POS <<<<<.AEPPN>*4>>>> ;OFFSET TO PPN
X$SIZ ^D4 ;SIZE OF PPN (BYTES)
XAB$E ;END OF XAB
; PROTOTYPE XAB FOR KEY 1
XABK1: XAB$B KEY ;KEY
X$REF 1 ;THIS IS THE SECOND KEY
X$DTP XB$EBC ;EBCDIC (9 BIT BYTES)
X$DAN 2 ;IT LIVES IN THIS DATA AREA
X$DFL 1 ;FILL 1/2 FULL
X$IAN 3 ;IT LIVES IN THIS INDEX AREA
X$IFL 1 ;FILL 1/2 FULL
X$POS <<<<.AENAM*4>>>> ;OFFSET TO NAME
X$SIZ .AANLC ;SIZE OF NAME (BYTES)
X$FLG XB$CHG ;VALUE OF KEY MAY CHANGE
XAB$E ;END OF XAB
SUBTTL RMS-10 INTERFACE INITIALIZATION
; INITIALIZE RMS-10 INTERFACE
; CALL: PUSHJ P,INITIO
INITIO::SETOM SAVFLG ;INIT AC SAVE ROUTINES
PUSHJ P,ENTX ;SWITCH CONTEXTS
$NOMESS 0 ;SUPPRESS ERROR MESSAGES
JRST .POPJ1 ;RETURN FOR NOW
SUBTTL OPEN A FILE
; CALL: MOVE AC1, ADDRESS OF ASCIZ FILESPEC
; MOVE AC2, READ/WRITE FLAG (0 = READ, 1 = WRITE)
; PUSHJ P,OPNA/OPNB/OPNC
OPNA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
XMOVEI T1,A.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,A.ZEND ;POINT TO END OF STORAGE
XMOVEI T3,A.WXA1 ;WORKING XAB FOR AREA 1
MOVEM T3,X.WXA1 ;SAVE
XMOVEI T3,A.WXA2 ;WORKING XAB FOR AREA 2
MOVEM T3,X.WXA2 ;SAVE
XMOVEI T3,A.WXA3 ;WORKING XAB FOR AREA 3
MOVEM T3,X.WXA3 ;SAVE
XMOVEI T3,A.WXK0 ;WORKING XAB FOR KEY 0
MOVEM T3,X.WXK0 ;SAVE
XMOVEI T3,A.WXK1 ;WORKING XAB FOR KEY 1
MOVEM T3,X.WXK1 ;SAVE
PUSHJ P,OPNCOM ;OPEN THE FILE
POPJ P, ;FAILED
PUSHJ P,CLSCOM ;NOW CLOSE THE FILE
POPJ P, ;SHOULDN'T FAIL
PUSHJ P,OPNFIX ;FIX UP FILE PROTECTION AND STATUS WORD
XMOVEI T1,A.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,A.ZEND ;POINT TO END OF STORAGE
PJRST OPNCOM ;ENTER COMMON CODE
OPNB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
XMOVEI T1,B.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,B.ZEND ;POINT TO END OF STORAGE
XMOVEI T3,B.WXA1 ;WORKING XAB FOR AREA 1
MOVEM T3,X.WXA1 ;SAVE
XMOVEI T3,B.WXA2 ;WORKING XAB FOR AREA 2
MOVEM T3,X.WXA2 ;SAVE
XMOVEI T3,B.WXA3 ;WORKING XAB FOR AREA 3
MOVEM T3,X.WXA3 ;SAVE
XMOVEI T3,B.WXK0 ;WORKING XAB FOR KEY 0
MOVEM T3,X.WXK0 ;SAVE
XMOVEI T3,B.WXK1 ;WORKING XAB FOR KEY 1
MOVEM T3,X.WXK1 ;SAVE
PUSHJ P,OPNCOM ;OPEN THE FILE
POPJ P, ;FAILED
PUSHJ P,CLSCOM ;NOW CLOSE THE FILE
POPJ P, ;SHOULDN'T FAIL
PUSHJ P,OPNFIX ;FIX UP FILE PROTECTION AND STATUS WORD
XMOVEI T1,B.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,B.ZEND ;POINT TO END OF STORAGE
PJRST OPNCOM ;ENTER COMMON CODE
OPNC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
XMOVEI T1,C.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,C.ZEND ;POINT TO END OF STORAGE
XMOVEI T3,C.WXA1 ;WORKING XAB FOR AREA 1
MOVEM T3,X.WXA1 ;SAVE
XMOVEI T3,C.WXA2 ;WORKING XAB FOR AREA 2
MOVEM T3,X.WXA2 ;SAVE
XMOVEI T3,C.WXA3 ;WORKING XAB FOR AREA 3
MOVEM T3,X.WXA3 ;SAVE
XMOVEI T3,C.WXK0 ;WORKING XAB FOR KEY 0
MOVEM T3,X.WXK0 ;SAVE
XMOVEI T3,C.WXK1 ;WORKING XAB FOR KEY 1
MOVEM T3,X.WXK1 ;SAVE
PUSHJ P,OPNCOM ;OPEN THE FILE
POPJ P, ;FAILED
PUSHJ P,CLSCOM ;NOW CLOSE THE FILE
POPJ P, ;SHOULDN'T FAIL
PUSHJ P,OPNFIX ;FIX UP FILE PROTECTION AND STATUS WORD
XMOVEI T1,C.ZBEG ;POINT TO START OF STORAGE
XMOVEI T2,C.ZEND ;POINT TO END OF STORAGE
PJRST OPNCOM ;ENTER COMMON CODE
; COMMON OPEN CODE
OPNCOM: PUSHJ P,OPNINI ;INIT STORAGE, FETCH ARGS, SETUP FAB/RAB
POPJ P, ;FAILED
$FETCH T1,FAC,0(F) ;GET THE DESIRED ACCESS MODE
TXNN T1,FB$PUT ;DID WE ASK FOR WRITE ACCESS?
JRST OPNCO1 ;NO, CAN'T DO $CREATE
$CREATE 0(F) ;OPEN THE FILE. AS THIS IS THE FIRST
; RMS CALL, ACS 1 TO 4 MAY HAVE BEEN TRASHED
JRST OPNCO2 ;CONTINUE
OPNCO1: $OPEN 0(F) ;READ ONLY, CAN'T DO $CREATE EVEN THOUGH
; IT'S A CREATE-IF THAT WOULDN'T
OPNCO2: PUSHJ P,ERRCKF ;CHECK FOR ERRORS
POPJ P, ;FAILED
PUSHJ P,OPNBLK ;INIT FILOP, L/E/R, AND PATH BLOCKS
$CONNEC 0(R) ;SET UP AN IO STREAM
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
PUSHJ P,DOLOA ;SET LOAD MODE IF REQUESTED
JFCL ;IGNORE ERRORS
PUSHJ P,UPDFIX ;SEE IF PREVIOUS UPDATE NEEDS FIXING UP
POPJ P, ;IT DID AND IT FAILED
JRST .POPJ1 ;RETURN
; INITIALIZE FILE PROCESSING
; THIS ROUTINE WILL DO THE FOLLOWING:
; 1. ZERO STORAGE FOR THIS FILE
; 2. FETCH OPEN ARGUMENTS
; 3. SET UP FAB
; 4. SET UP RAB
;
; CALL: MOVE T1, START ADDRESS OF STORAGE
; MOVE T2, ENDING ADDRESS OF STORAGE
; MOVE F, ADDRESS OF THE WORKING FAB
; MOVE R, ADDRESS OF THE WORKING RAB
; PUSHJ P,OPNINI
OPNINI: SETZM 0(T1) ;CLEAR FIRST WORD
HRLS T1 ;COPY START ADDRESS TO LH
HRRI T1,1(T1) ;MAKE A BLT POINTER
BLT T1,-1(T2) ;CLEAR STORAGE
; FETCH ARGUMENTS
MOVE T1,SAVACS+1 ;GET ADDRESS OF ASCIZ FILESPEC
SKIPN T2,SAVACS+2 ;GET READ/WRITE FLAG
SKIPA T2,[FB$GET] ;READ-ONLY
MOVX T2,FB$PUT!FB$GET!FB$DEL!FB$UPD ;WRITE
; SET UP FAB
MOVSI T3,FAB ;POINT TO PROTOTYPE FAB
HRRI T3,(F) ;MAKE A BLT POINTER TO WORKING FAB
BLT T3,FA$LNG-1(F) ;COPY INTO FAB
$STORE T1,FNA,0(F) ;SET THE FILE NAME ADDRESS
$STORE T2,FAC,0(F) ;SET THE DESIRED ACCESS MODE
; SET UP RAB
MOVSI T4,RAB ;POINT TO PROTOTYPE RAB
HRRI T4,(R) ;MAKE A BLT POINTER TO WORKING RAB
BLT T4,RA$LNG-1(R) ;COPY INTO RAB
$STORE F,FAB,0(R) ;STORE THE FAB ADDRESS IN THE RAB
; XAB FOR AREA 1
SETZ T1, ;NO PREVIOUS XAB
XMOVEI T2,XABA1 ;XAB ADDRESS
MOVE T3,X.WXA1 ;WORKING STORAGE
PUSHJ P,OPNXAL ;SETUP
; XAB FOR AREA 2
XMOVEI T2,XABA2 ;XAB ADDRESS
MOVE T3,X.WXA2 ;WORKING STORAGE
PUSHJ P,OPNXAL ;SETUP
; XAB FOR AREA 3
XMOVEI T2,XABA3 ;XAB ADDRESS
MOVE T3,X.WXA3 ;WORKING STORAGE
PUSHJ P,OPNXAL ;SETUP
; XAB FOR KEY 0
XMOVEI T2,XABK0 ;XAB ADDRESS
MOVE T3,X.WXK0 ;WORKING STORAGE
PUSHJ P,OPNXKY ;SETUP
; XAB FOR KEY 1
XMOVEI T2,XABK1 ;XAB ADDRESS
MOVE T3,X.WXK1 ;WORKING STORAGE
PUSHJ P,OPNXKY ;SETUP
JRST .POPJ1 ;RETURN
; INITIALIZE XAB FOR ALLOCATION
; CALL: MOVE T1, PREVIOUS XAB
; MOVE T2, PROTOTYPE XAB
; MOVE T3, WORKING XAB
; MOVE F, FAB
; MOVE R, RAB
; PUSHJ P,OPNXAL
OPNXAL: SKIPN T1 ;SKIP IF A PREVIOUS XAB
$STORE T3,XAB,(F) ;LINK CURRENT XAB TO FAB
SKIPE T1 ;SKIP IF NO PREVIOUS XAB
$STORE T3,NXT,(T1) ;LINK CURRENT XAB TO PREVIOUS XAB
MOVSI T4,(T2) ;POINT TO PROTOTYPE
HRRI T4,(T3) ;MAKE A BLT POINTER
BLT T4,XA$SXA-1(T3) ;COPY
MOVE T1,T3 ;CURRENT XAB IS NOW THE PREVIOUS XAB
POPJ P, ;RETURN
; INITIALIZE XAB FOR ALLOCATION
; CALL: MOVE T1, PREVIOUS XAB
; MOVE T2, PROTOTYPE XAB
; MOVE T3, WORKING XAB
; MOVE F, FAB
; MOVE R, RAB
; PUSHJ P,OPNXKY
OPNXKY: $STORE T3,NXT,(T1) ;LINK CURRENT XAB TO PREVIOUS XAB
MOVSI T4,(T2) ;POINT TO PROTOTYPE
HRRI T4,(T3) ;MAKE A BLT POINTER
BLT T4,XA$SXK-1(T3) ;COPY
MOVE T1,T3 ;CURRENT XAB IS NOW THE PREVIOUS XAB
POPJ P, ;RETURN
; INITIALIZE FILOP, LOOKUP/ENTER/RENAME, AND PATH BLOCKS
; MUST BE CALLED AFTER A SUCCESSFUL $CREATE OR $OPEN
OPNBLK: MOVE T1,[FFZBEG,,FFZBEG+1] ;SET UP BLT
SETZM FFZBEG ;CLEAR FIRST WORD
BLT T1,FFZEND-1 ;CLEAR STORAGE
; NOW GET FILESPEC ON OPENED CHANNEL
OPNBL1: MOVE T1,[2,,T2] ;SET UP UUO AC
$FETCH T2,JFN,0(F) ;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
HRLZS T2 ;PUT IN LH
HRRI T2,.FOFIL ;FILOP. UUO FUNCTION CODE
MOVE T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
FILOP. T1, ;READ FILESPEC
POPJ P, ;RETURN
; LOAD FILOP BLOCK
OPNBL2: MOVEI T1,FFFOP ;POINT TO BLOCK
MOVE T2,[FO.PRV!FO.ASC+.FORED] ;PRIV'ED, ASSIGN CHANNEL, READ
MOVEM T2,.FOFNC(T1)
MOVE T2,[UU.PHS+.IODMP] ;PHYSICAL DUMP MODE I/O
MOVEM T2,.FOIOS(T1)
MOVE T2,FFFIL+.FOFDV ;DEVICE NAME
MOVEM T2,.FODEV(T1)
MOVEI T2,FFLKP ;LOOKUP/ENTER/RENAME BLOCK
MOVEM T2,.FOLEB(T1)
; LOAD LOOKUP/ENTER/BLOCK
OPNBL3: MOVEI T1,FFLKP ;POINT TO BLOCK
MOVEI T2,.RBMAX ;LENGTH
MOVEM T2,.RBCNT(T1)
MOVEI T2,FFPTH ;PATH BLOCK
MOVEM T2,.RBPPN(T1)
MOVE T2,FFFIL+.FOFFN ;FILE NAME
MOVEM T2,.RBNAM(T1)
MOVE T2,FFFIL+.FOFEX ;EXTENSION
MOVEM T2,.RBEXT(T1)
; LOAD PATH BLOCK
OPNBL4: MOVE T1,[-<.PTMAX-.PTPPN>,,FFPTH+.PTPPN] ;POINT TO BLOCK
MOVEI T2,FFFIL+.FOFPP ;POINT TO RETURNED FILESPEC
OPNBL5: MOVE T3,(T2) ;GET A WORD
MOVEM T3,(T1) ;PUT A WORD
AOS T2 ;ADVANCE POINTER
AOBJN T1,OPNBL5 ;LOOP
SETOM FFFLG ;INDICATE GOODNESS
POPJ P, ;RETURN
; FIX UP THE FILE PROTECTION AND STATUS WORD
; MUST BE CALLED AFTER OPNBLK/CLOSE SEQUENCE
OPNFIX: $FETCH T1,FAC,0(F) ;GET THE DESIRED ACCESS MODE
TXNE T1,FB$PUT ;DID WE ASK FOR WRITE ACCESS?
SKIPN FFFLG ;YES--WAS CALL TO OPNBLK SUCCESSFUL?
POPJ P, ;NOPE
MOVE T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
FILOP. T1, ;LOOKUP THE FILE
POPJ P, ;SHOULDN'T FAIL
MOVE T1,FFFOP+.FOFNC ;GET FUNCTION WORD
TDZ T1,[-1-FO.CHN] ;KEEP ONLY THE CHANNEL
TDO T1,[FO.PRV+FO.UOC+.FORNM] ;USE ALREADY OPENED CHANNEL FOR RENAME
MOVEM T1,FFFOP+.FOFNC ;UPDATE FUNCTION WORD
MOVEI T1,FFREN ;POINT TO RENAME BLOCK
HRLM T1,FFFOP+.FOLEB
MOVE T1,[FFLKP,,FFREN] ;SET UP BLT
BLT T1,FFREN+.RBMAX-1 ;COPY
MOVE T1,[%LDSSP] ;ASK MONITOR FOR SYS:*.SYS CODE
GETTAB T1, ;SO
MOVSI T1,(157B8) ;DEFAULT
LSH T1,-33 ;POSITION
DPB T1,[POINTR (FFREN+.RBPRV,RB.PRV)] ;STORE
MOVEI T1,RP.ABU ;CAUSE FILE TO ALWAYS BE BACKED UP
IORM T1,FFREN+.RBSTS ; TO TAPE REGARDLESS OF ACCESS DATE
MOVE T1,[.FOMAX,,FFFOP] ;SET UP UUO AC
FILOP. T1, ;RENAME THE FILE
JFCL ;IGNORE ERRORS HERE
MOVE T1,[1,,T2] ;SET UP UUO AC
MOVE T2,FFFOP+.FOFNC ;GET FUNCTION WORD
TDZ T2,[-1-FO.CHN] ;KEEP ONLY THE CHANNEL
HRRI T2,.FOREL ;NEW FUNCTION
FILOP. T1, ;RELEASE THE CHANNEL
JFCL ;???
POPJ P, ;DONE
SUBTTL CLOSE A FILE
; CLOSE FILE "A"
CLSA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST CLSCOM ;ENTER COMMON CODE
; CLOSE FILE "B"
CLSB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST CLSCOM ;ENTER COMMON CODE
; CLOSE FILE "C"
CLSC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST CLSCOM ;ENTER COMMON CODE
; COMMON CLOSE CODE
CLSCOM: $CLOSE 0(F) ;CLOSE THE FILE
PUSHJ P,ERRCKF ;CHECK UP ON IT
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN GOODNESS
SUBTTL ERASE (DELETE) A FILE
; ERASE FILE "A"
ERSA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST ERSCOM ;ENTER COMMON CODE
; ERASE FILE "B"
ERSB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST ERSCOM ;ENTER COMMON CODE
; ERASE FILE "C"
ERSC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST ERSCOM ;ENTER COMMON CODE
; COMMON ERASE CODE
ERSCOM: $ERASE 0(F) ;DELETE THE FILE
PUSHJ P,ERRCKF ;CHECK UP ON IT
POPJ P, ;FAILED
JRST .POPJ1 ;RETURN GOODNESS
SUBTTL DELETE A RECORD
; CALL: MOVE AC1, FLAG (0 = PPN, -1 = NAME)
; MOVE AC2, PPN OR ADDRESS OF NAME
; PUSHJ P,DELA/DELB/DELC
DELA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST DELCOM ;ENTER COMMON CODE
DELB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST DELCOM ;ENTER COMMON CODE
DELC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST DELCOM ;ENTER COMMON CODE
; COMMON DELETE CODE
DELCOM: SKIPE ACTLCK ;LOCKED OUT?
POPJ P, ;YES--GO AWAY
DMOVE T1,ARGS ;GET CALLER'S ARGUMENTS
JUMPGE T1,DELCO1 ;JUMP IF BY PPN
MOVE T2,T2 ;COPY ADDRESS OF NAME
HRLI T2,(POINT 8,0) ;MAKE A SOURCE POINTER
MOVE T3,[POINT 9,TMPNAM] ;POINT TO A SCRATCH BUFFER
PUSHJ P,CVTNM1 ;COPY THE STRING
MOVEI T1,1 ;SECONDARY KEY
MOVEI T2,.AANLC ;EXACT MATCH
JRST DELCO2 ;READY TO FIND
DELCO1: MOVEM T2,TMPNAM ;SAVE PPN AS SEARCH STRING
MOVX T1,0 ;PRIMARY KEY
MOVX T2,^D4 ;BYTES IN A PPN
DELCO2: PUSHJ P,SETFND ;SET UP FIND
$FIND 0(R) ;NOW POSITION TO THAT RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
POPJ P, ;FAILED
$DELETE 0(R) ;TOSS THE RECORD
PUSHJ P,ERRCKR ;SEE IF WE DELETED IT
POPJ P, ;FAILED
; JRST .POPJ1 ;RETURN
$FLUSH 0(R) ;*** FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;*** CHECK FOR ERRORS
POPJ P, ;*** FAILED
JRST .POPJ1 ;RETURN
SUBTTL GET A RECORD FROM A FILE
; HERE TO SET UP THE RMS CALL FOR A POSSIBLY WILDCARDED SEARCH
; CALL: MOVE AC1, ADDRESS OF BUFFER
; MOVE AC2, ADDRESS OF WILDCARD MESSAGE BLOCK
; PUSHJ P,GETA/GETB/GETC
GETA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST GETCOM ;ENTER COMMON CODE
GETB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST GETCOM ;ENTER COMMON CODE
GETC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST GETCOM ;ENTER COMMON CODE
GETCOM: MOVE P1,ARGS+1 ;COPY WILDCARD MESSAGE BLOCK ADDRESS
SETOM WLDNXT ;INIT NEXT PROFILE FLAG
PUSHJ P,FIXNAM ;FIX UP POSSIBLY WILD NAME
GETCO1: MOVEI T1,.AEMAX ;GET MAXIMUM LENGTH OF PROFILE
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
MOVE T1,ARGS ;GET BUFFER ADDRESS
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
PUSHJ P,SRHSET ;SET UP SEARCH
POPJ P, ;RETURN IF DONE
PUSHJ P,SETFND ;SET UP FIND
$FETCH T1,ROP,0(R) ;FETCH THE CURRENT OPTIONS
SKIPN WLDNXT ;FETCH NEXT PROFILE?
TXO T1,RB$KGT ;YES
$STORE T1,ROP,0(R) ;SAVE FLAGS AND BYTE COUNT
$GET 0(R) ;READ SPECIFIED RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
JRST GETCO3 ;FAILED
MOVE T1,ARGS ;FETCH BUFFER ADDRESS
PUSHJ P,NAME8 ;CONVERT 9-BIT NAME TO 8-BIT
PUSHJ P,MATCH ;COMPARE PPNS/NAMES
JRST GETCO2 ;NO MATCH
PUSHJ P,SELANL ;PERFORM SELECTION ANALYSIS
JRST GETCO1 ;FAILED, CHECK NEXT
JRST .POPJ1 ;RETURN
GETCO2: JUMPN T1,GETCO1 ;TRY AGAIN IF MORE POSSIBLE
JRST SRHRNF ;NO--MAKE IT LOOK LIKE "NO SUCH RECORD"
GETCO3: SKIPN T1,UW$WST(P1) ;GET WILDCARD SEARCH TYPE
JRST GETCO4 ;TEST IS DIFFERENT FOR PPN
CAIE T1,2 ;MUST BE WILD
AOSE WLDNXT ;MAYBE FETCH NEXT PROFILE
POPJ P, ;NO--GIVE UP
JRST GETCO1 ;LOOP BACK
GETCO4: SETO T1, ;GET A MASK
CAME T1,UW$PPM(P1) ;IF NON-WILD MASK,
AOSE WLDNXT ;OR ALREADY TRIED THIS,
POPJ P, ;THEN GIVE UP
JRST GETCO1 ;LOOP BACK TO TRY FOR NEXT PPN
; FIX UP PREVIOUS NAME FOR WILD NAME SEARCHES
FIXNAM: SKIPN UW$WST(P1) ;SEARCHING BY PPNS?
POPJ P, ;NOTHING TO DO
MOVE T1,[BASNAM,,BASNAM+1] ;SET UP BLT
SETZM BASNAM ;CLEAR FIRST WORD
BLT T1,BASNAM+11 ;NO--CLEAR BASE NAME STORAGE
MOVEI T2,UW$NAM(P1) ;POINT TO TARGET NAME
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
SKIPE UW$BRE(P1) ;A PREVIOUS RESULT?
SKIPA T3,T2 ;YES--JUST CONVERT TARGET NAME
MOVE T3,[POINT 8,BASNAM] ;POINT TO BASE NAME STORAGE
MOVE T4,UW$WST(P1) ;GET WILDCARD SEARCH TYPE
SUBI T4,1 ;MAKE WILD NAME CODE = 0
FIXNA1: ILDB T1,T2 ;GET A BYTE
SKIPE UW$BRE(P1) ;A PREVIOUS RESULT?
JRST FIXNA2 ;YES--JUST DO CASE CONVERSION
CAIN T1,.CHCNV ;MAGIC QUOTE CHARACTER?
JRST FIXNA4 ;YES, DO QUOTING
JUMPN T4,FIXNA2 ;JUMP IF NON-WILD NAME
CAIE T1,"*" ;IS IT A WILDCARD?
CAIN T1,"?" ;OR A DIFFERENT WILDCARD?
JRST FIXNA3 ;YES--ALMOST DONE
FIXNA2: PUSHJ P,CVTCAS ;DO CASE CONVERSION
IDPB T1,T3 ;STORE IN BASE FOR WILDCARDING
JUMPN T1,FIXNA1 ;LOOP
FIXNA3: SKIPE UW$BRE(P1) ;A PREVIOUS RESULT?
POPJ P, ;YES--ALL DONE
MOVEI T2,UW$NAM(P1) ;POINT TO TARGET NAME
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
MOVE T3,T2 ;SOURCE AND DESTINATION ARE SAME
PJRST CVTNM1 ;CONVERT TO UPPER CASE
FIXNA4: ILDB T1,T2 ;GET QUOTED CHARACTER
JRST FIXNA2 ;COPY IT WITH NO WILDCARD CHECKING
; SEARCH SET UP
; CALL: PUSHJ P,SRHSET
;
; ON RETURN, T1 HAS KEY NUMBER AND T2 LENGTH OF KEY IN BYTES
SRHSET: MOVE T1,UW$SEL(P1) ;GET COUNT OF SELECTION BLOCKS
MOVEM T1,SELBLK ;SAVE
SKIPN UW$WST(P1) ;SKIP IF SEARCHING BY NAME
JRST SRHSE2 ;GO SEARCH BY PPN
; SEARCH BY NAME
SRHSE1: MOVEI T2,UW$BRE(P1) ;POINT TO PREVIOUS RESULT
MOVE T3,UW$WST(P1) ;GET WILDCARD SEARCH TYPE
SKIPE (T2) ;BEEN HERE BEFORE?
SOJG T3,SRHRNF ;YES
SKIPN (T2) ;BEEN HERE BEFORE?
MOVEI T2,BASNAM ;FIRST TIME--POINT TO BASE NAME
HRLI T2,(POINT 8,0) ;MAKE A SOURCE POINTER
MOVE T3,[POINT 9,TMPNAM] ;POINT TO A SCRATCH BUFFER
PUSHJ P,CVTNM1 ;COPY THE STRING
MOVE T1,UW$WST(P1) ;GET SEARCH TYPE
CAIE T1,2 ;NON-WILD NAME?
SKIPN UW$BRE(P1) ;A PREVIOUS RESULT?
SKIPA ;DON'T ASK FOR NEXT PROFILE
SETZM WLDNXT ;YES--ASK FOR NEXT PROFILE
MOVEI T1,1 ;SECONDARY KEY
MOVEI T2,.AANLC ;EXACT MATCH
JRST .POPJ1 ;READY TO FIND
; SEARCH BY PPN
SRHSE2: MOVE T1,UW$PPM(P1) ;GET MASK
SKIPE UW$BRE(P1) ;A PREVIOUS RESULT?
AOJE T1,SRHRNF ;YES
MOVE T1,UW$PPN(P1) ;GET PPN
MOVE T2,UW$PPM(P1) ;GET MASK
AND T1,T2 ;MASK DOWN PPN
SKIPE T2,UW$BRE(P1) ;A PREVIOUS RESULT?
MOVE T1,T2 ;YES--USE IT INSTEAD
MOVEM T1,TMPNAM ;SAVE PPN AS SEARCH STRING
SKIPE UW$BRE(P1) ;HAVE A PREVIOUS VALUE?
SETZM WLDNXT ;YES--FETCH NEXT PROFILE
MOVEI T1,0 ;PRIMARY KEY
MOVEI T2,^D4 ;BYTES IN A PPN
JRST .POPJ1 ;READY TO FIND
; HERE IF NO SEARCH WILL BE DONE. MAKE IT LOOK LIKE A STANDARD
; RMS "RECORD NOT FOUND" ERROR.
SRHRNF: MOVEI T1,ER$RNF ;CODE FOR RECORD NOT FOUND
MOVEI T2,0 ;STATUS
$STORE T1,STS,0(R) ;SET STATUS
$STORE T2,STV,0(R) ;AND STATUS VALUE
POPJ P, ;RETURN
; CHECK FOR A MATCH
MATCH: SKIPN T1,UW$WST(P1) ;SKIP IF SEARCHING BY PPN
PJRST MATPPN ;COMPARE PPNS
SOJG T1,.POPJ1 ;RETURN GOODNESS IF NON-WILD NAME
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSHJ P,MATNAM ;COMPARE NAMES
SKIPA ;FAILED
AOS -2(P) ;SKIP
POP P,P3 ;RESTORE P3
POP P,P2 ;RESTORE P2
POPJ P, ;RETURN
; CHECK FOR A PPN MATCH
MATPPN: MOVE T2,ARGS ;FETCH BUFFER ADDRESS
MOVE T2,.AEPPN(T2) ;AND THE PPN RETURNED
MOVEM T2,UW$BRE(P1) ;SAVE
SETZ T1, ;SET RETURN CODE TO "NO MORE PROFILES"
HLRZ T2,UW$PPN(P1) ;GET PROJECT NUMBER
JUMPE T2,MATPP1 ;ALL PROJECTS?
HLRZ T3,UW$BRE(P1) ;AND THE ONE FROM PROFILE
CAILE T3,(T2) ;GONE BEYOND THIS PROJECT NUMBER YET?
POPJ P, ;YES--STOP NOW
HRRZ T2,UW$PPN(P1) ;GET PROGRAMMER NUMBER
JUMPE T2,MATPP1 ;ALL PROGRAMMERS?
HRRZ T3,UW$BRE(P1) ;AND THE ONE FROM PROFILE
CAIG T3,(T2) ;GONE BEYOND PROGRAMMER NUMBER YET?
JRST MATPP1 ;NO
MOVE T3,UW$PPM(P1) ;GET MASK
AOJE T3,.POPJ ;RETURN IF NOT WILD
HLLOS UW$BRE(P1) ;MAKE IT [PROJECT,777777]
JRST MATPP2 ;NO MATCH BUT MAYBE MORE TO COME
MATPP1: MOVE T2,UW$BRE(P1) ;GET PPN
AND T2,UW$PPM(P1) ;MASK
MOVE T3,UW$PPN(P1) ;GET REQUESTED PPN
AND T3,UW$PPM(P1) ;MASK
CAMN T2,T3 ;MATCH?
JRST .POPJ1 ;YES
MATPP2: MOVNI T1,1 ;MAYBE MORE PROFILES AVAILABLE
POPJ P, ;SAY NO MORE
; CHECK FOR A NAME MATCH
MATNAM: MOVE T1,ARGS ;FETCH BUFFER ADDRESS
MOVE T3,T1 ;COPY FOR LATER
MOVSI T1,.AENAM(T1) ;POINT TO RETURNED NAME
HRRI T1,UW$BRE(P1) ;AND TO RESULT NAME
BLT T1,UW$ERE(P1) ;COPY
MOVEI T1,UW$NAM(P1) ;POINT TO SOURCE NAME
HRLI T1,(POINT 8,) ;8-BIT ASCIZ STRING
MOVEI T2,.AANLC ;LENGTH IN CHARACTERS
MOVEI T3,.AENAM(T3) ;POINT TO NAME
HRLI T3,(POINT 8,) ;8-BIT ASCIZ STRING
MOVEI T4,.AANLC ;LENGTH IN CHARACTERS
SETZM WLDCNT ;NO ITERATIONS YET
MATNA1: SOJL T2,MATNA6 ;MAYBE AT END
ILDB P2,T1 ;GET CHARACTER FROM PROTOTYPE
JUMPE P2,MATNA6 ;TEST FOR END MATCH IF NUL
CAIN P2,.CHCNV ;MAGIC QUOTE CHARACTER?
JRST MATNA8 ;YES, SKIP WILDCARDING
CAIN P2,"*" ;FOUND THE SPECIAL CASE?
JRST MATNA2 ;YES, RECURSE
SOJL T4,MATNA7 ;NO, CHECK FOR ANOTHER CHARACTER HERE
ILDB P3,T3 ;FETCH IT
JUMPE P3,MATNA7 ;NO MATCH IF AT END
CAIN P2,"?" ;IF WILD,
AOS WLDCNT ;FLAG IT
CAIE P2,"?" ;IF WILD,
CAMN P2,P3 ;OR IF THEY MATCH,
JRST MATNA1 ;KEEP LOOKING
JRST MATNA7 ;FAIL IF THEY DON'T MATCH
MATNA2: AOS WLDCNT ;ABOUT TO ITERATE
ADJSP P,4 ;MAKE ROOM
DMOVEM T1,-3(P) ;SAVE PROTOTYPE POINTER
MATNA3: DMOVEM T3,-1(P) ;AND ENTRY POINTER
PUSHJ P,MATNA1 ;CHECK FOR A MATCH
SKIPA ;FAILED
JRST MATNA5 ;FINISH UP
DMOVE T1,-3(P) ;RETRIEVE WILDCARD POINTER
DMOVE T3,-1(P) ;RETRIEVE ENTRY POINTER
SOJL T4,MATNA4 ;NO MATCH IF AT END
ILDB P3,T3 ;GET NEXT CHARACTER
JUMPN P3,MATNA3 ;TRY AGAIN IF NOT YET AT END
MATNA4: ADJSP P,-4 ;TRIM STACK
JRST MATNA7 ;ANOTHER SEARCH NEEDED
MATNA5: ADJSP P,-4 ;TRIM STACK
JRST .POPJ1 ;RETURN IF MATCH
MATNA6: SOJL T4,.POPJ1 ;IF END HERE, THEY MATCH
ILDB P3,T3 ;GET NEXT CHARACTER
JUMPE P3,.POPJ1 ;MATCH
MATNA7: SETZ T1, ;SET RETURN CODE TO "NO MORE PROFILES"
SKIPE WLDCNT ;ANY CHARACTER MATCHES?
MOVNI T1,1 ;YES--ANOTHER SEARCH IS NEEDED
POPJ P, ;RETURN NO MATCH ON THIS NAME
MATNA8: SOJL T2,MATNA7 ;QUOTE REQUIRES A FOLLOWING CHARACTER
ILDB P2,T1 ;FETCH IT
JUMPE P2,MATNA7 ;REQUIRED TO BE PRESENT
SOJL T4,MATNA7 ;CAN'T MATCH IF NO MORE CHARACTERS
ILDB P3,T3 ;GET NEXT FROM PROFILE
CAMN P2,P3 ;IF THE SAME,
JRST MATNA1 ;THIS CHARACTER MATCHES
JRST MATNA7 ;ELSE NO MATCH HERE
; HERE TO PERFORM SELECTION ANALYSIS
SELANL: SKIPN SELBLK ;ANY BLOCKS SPECIFIED?
JRST .POPJ1 ;NO--SAY THIS PROFILE MATCHES
MOVSI T1,[REPEAT 4,<JRST .POPJ1>] ;SOME FRIENDLY INSTRUCTIONS
HRRI T1,CMPINS ;POINT TO STORAGE
BLT T1,CMPINS+3 ;COPY
HLRZ P2,UW$TYP(P1) ;GET LENGTH OF MESSAGE
SUBI P2,UW$DAT ;KEEP ONLY COUNT OF SELECTION DATA WORDS
MOVNS P2 ;NEGATE
HRLZS P2 ;PUT IN LH
HRRI P2,UW$DAT(P1) ;POINT TO START OF SELECTION DATA
MOVEM P2,SELPTR ;SAVE
SETOM SELFLG ;FLAG SELECTION IN PROGRESS
SELAN1: LOAD T4,(P2),AF.SEL ;GET FUNCTION CODE
CAIL T4,1 ;RANGE
CAILE T4,SELMAX ; CHECK
POPJ P, ;GIVE UP
SELAN2: MOVE T4,SELTAB-1(T4) ;POINT TO INSTUCTIONS
DMOVE T1,0(T4) ;FETCH
DMOVE T3,2(T4) ; AND
DMOVEM T1,CMPINS ; INSTRUCTIONS
DMOVEM T3,CMPINS+2 ; ...
PUSHJ P,SELCMP ;COMPARE PROFILE DATA WITH THAT IN MSG
JRST SELAN3 ;PROFILE DOESN'T SATISFY CRITERIA
PUSHJ P,ADVBLK ;ADVANCE TO NEXT SELECTION SUB-BLOCK
JRST .POPJ1 ;RETURN IF NO MORE SUB-BLOCKS
LOAD T4,(P2),AF.SEL ;GET TYPE OF NEXT BLOCK
CAIE T4,.AFOR ;IS THIS AN "OR" BLOCK?
JRST SELAN1 ;NO, JUST TRY IT
JRST .POPJ1 ;YES, WE FOUND A WINNING SET OF CONSTRAINTS
SELAN3: PUSHJ P,ADVBLK ;LOST THIS TIME, LOOK FOR AN "OR" BLOCK
POPJ P, ;ALL OUT OF POSSIBILITIES
LOAD T4,(P2),AF.SEL ;MAYBE, GET BLOCK TYPE
CAIE T4,.AFOR ;IS IT TIME TO START OVER?
JRST SELAN3 ;NO, KEEP LOOKING
JRST SELAN2 ;YES, TRY A NEW STRING OF CONSTRAINTS
; SELECTION FUNCTION TABLE
SELTAB: IFIW SELAND ;"AND"
IFIW SELOR ;"OR"
IFIW SELNOT ;"NOT"
IFIW SELGEQ ;".GE."
IFIW SELLEQ ;".LE."
SELMAX==.-SELTAB ;LENGTH OF TABLE
; "OR"
SELOR:!
; "AND"
SELAND: CAMN T1,T2 ;COMPARE
AOS (P) ;SAME
POPJ P, ;RETURN
; "NOT"
SELNOT: CAME T1,T2 ;COMPARE
AOS (P) ;DIFFERENT
POPJ P, ;RETURN
; "GEQ"
SELGEQ: CAML T1,T2 ;PROFILE .GE. USER VALUE?
AOS (P) ;YES, SUCCEED
POPJ P, ;NO, FAIL
; "LEQ"
SELLEQ: CAMG T1,T2 ;PROFILE .LE. USER VALUE?
AOS (P) ;YES, SUCCEED
POPJ P, ;NO, FAIL
; ADVANCE TO THE NEXT SELECTION SUB-BLOCK
ADVBLK: SOSG T1,SELBLK ;COUNT SELECTION BLOCKS
POPJ P, ;NO MORE
LDB T1,[POINT 9,(P2),17] ;GET LENGTH
HRLS T1 ;PUT IN BOTH HALVES
ADD P2,T1 ;ADVANCE
MOVEM P2,SELPTR ;UPDATE
JUMPGE P2,.POPJ ;JUMP IF POINTER RAN OUT
JRST .POPJ1 ;ELSE RETURN OK
; COMPARE VALUES
SELCMP: LOAD T1,(P2),AF.OFS ;GET BLOCK TYPE
CAIL T1,.AEMIN ;RANGE CHECK
POPJ P, ;ILLEGAL
MOVX T2,AF.DEF ;DEFAULTING BIT
TDNE T2,(P2) ;WANTING TO CHECK FOR DEFAULTED FIELD?
JRST SELCM6 ;YES, DO SO
MOVE T2,CHGTAB##(T1) ;NO, GET BITS FOR THIS BLOCK TYPE
TXNE T2,PD.NSL ;INVALID FOR SELECTION?
POPJ P, ;YES, FAIL
MOVE P3,ARGS ;POINT TO PROFILE BUFFER FOR CALLED ROUTINE
IFE 1B0-PD.RTN,<JUMPL T2,(T2)> ;CALL ROUTINE IF ONE IS PROVIDED
IFN 1B0-PD.RTN,<
HRRZ T3,T2 ;GET POSSIBLE ROUTINE ADDRESS
TXNE T2,PD.RTN ;WAS IT PROVIDED?
PJRST (T3) ;YES, USE IT
>
SELCM1: TXNE T2,PD.EXT ;EXTENSIBLE BLOCK?
JRST SELCM2 ;YES, HANDLE
TXNN T2,PD.MSK ;MASKABLE WORD?
JRST SELCM3 ;NO, SIMPLE WORD COMPARES
LDB T3,[POINT 9,(P2),17] ;YES, GET SUPPLIED BLOCK LENGTH
CAILE T3,2 ;WAS A MASK SUPPLIED?
SKIPA T2,2(P2) ;YES, USE IT
SETO T2, ;NO, USE FULLWORD
CAIL T3,2 ;WAS A VALUE GIVEN?
CAILE T3,3 ;OR MORE THAN VALUE & MASK?
POPJ P, ;YES, IT DOESN'T MATCH
HRRZ T3,ARGS+0 ;OK, GET PROFILE BUFFER ADDRESS
ADD T3,T1 ;GET BLOCK OFFSET
MOVE T1,1(P2) ;GET VALUE FROM THE SELECTION SUB-BLOCK
AND T1,T2 ;KEEP ONLY PORTION TO COMPARE
AND T2,(T3) ;FETCH & MASK FROM PROFILE
PJRST CMPINS ;GO COMPARE AND RETURN TRUE/FALSE
; EXTENSIBLE BLOCK PROCESSING
SELCM2: ADD T1,P3 ;GET ADDRESS TO FETCH
MOVE T1,(T1) ;DO SO
ADD T1,P3 ;UN-RELATIVIZE THE AOBJN POINTER
JRST SELCM4 ;JOIN COMMON CODE FOR WORD COMPARES
; REGULAR BLOCK PROCESSING
SELCM3: LOAD T2,CHGTAB##(T1),PD.WRD ;GET BLOCK LENGTH
ADD T1,P3 ;GET ADDRESS OF BLOCK TO TEST
MOVNS T2 ;GET MINUS BLOCK LENGTH
HRL T1,T2 ;MAKE AOBJN POINTER TO BLOCK
;HERE FOR COMMON WORD-MODE COMPARISON CODE
SELCM4: LDB T2,[POINT 9,(P2),17] ;GET SUPPLIED BLOCK LENGTH
SUBI T2,1 ;ONLY WANT DATA LENGTH
MOVNS T2 ;USE NEGATIVE FOR AOBJN
MOVSS T2 ;AOBJN CHECKS LH
HRRI T2,1(P2) ;POINT TO DATA
DMOVE T3,T1 ;MOVE POINTERS TO SAFER ACS
SELCM5: SKIPL T3 ;ANY MORE TO FETCH HERE?
TDZA T1,T1 ;NOPE
MOVE T1,(T3) ;YES, GET IT
SKIPL T4 ;SIMILARLY FOR USER DATA
TDZA T2,T2
MOVE T2,(T4)
PUSHJ P,CMPINS ;TEST IT
POPJ P, ;FAILS THE CRITERIA
AOBJP T3,.+1 ;ADVANCE POINTER
AOBJN T4,SELCM5 ;LOOP OVER DATA
JUMPL T3,SELCM5 ;AS LONG AS EITHER POINTER HOLDS OUT
JRST .POPJ1 ;MEETS SELECTION CRITERIA
; DEFAULTED FIELD CHECKING
SELCM6: IDIVI T1,^D36 ;GET MAP OFFSET & BIT NUMBER
MOVN T4,T2 ;SHIFT VALUE
MOVX T2,1B0 ;BIT TO SHIFT
LSH T2,(T4) ;GET BIT TO TEST
ADDI T1,.AEMAP ;OFFSET TO MAP
HRRZ T3,ARGS+0 ;GET PROFILE ADDRESS
ADD T1,T3 ;GET ADDRESS TO FETCH
MOVE T1,(T1) ;FETCH WORD FROM PROFILE MAP
AND T1,T2 ;MAKE THINGS EASY
PJRST CMPINS ;TEST AND RETURN TRUE/FALSE
;SETFND - SET UP A $FIND
;
;T1/ KEY OF REFERENCE
;T2/ # OF BYTES
;TMPNAM/KEY TO MATCH
SETFND: $STORE T1,KRF,0(R) ;STORE WHICH KEY TO USE
MOVEI T1,TMPNAM ;BUFFER ADDRESS
$STORE T1,KBF,0(R) ;STORE KEY BUFFER ADDRESS
$STORE T2,KSZ,0(R) ;STORE KEY SIZE
MOVEI T1,RB$KEY ;KEYED ACCESS
$STORE T1,RAC,0(R) ;SET
$FETCH T1,ROP,0(R) ;FETCH THE CURRENT OPTIONS
TXZ T1,RB$KGE!RB$KGT ;MATCH SHOULD BE EQUAL
$STORE T1,ROP,0(R) ;PUT THEM BACK (AND RETURN TO CALLER)
POPJ P, ;DONE
; SETHDR - SETS UP THE RMS RECORD HEADER AND RAB GIVEN THE USER ARGS
; CALL: MOVE T1, BUFFER ADDRESS
; PUSHJ P,SETHDR
SETHDR: $SAVE P1 ;FOR LOOPING
MOVSI T2,(T1) ;POINT TO USER ARGUMENT
HRRI T2,PROFIL ;POINT TO INTERNAL PROFILE BLOCK
HRRZ T3,.AEVRS(T1) ;GET LENGTH OF THIS PROFILE
BLT T2,PROFIL-1(T3) ;COPY
MOVEI T2,PROFIL ;FROM NOW ON, WE'LL USE INTERNAL BLOCK
$STORE T2,RBF,0(R) ;STORE BUFFER ADDRESS
HRRZ T2,.AEVRS(T2) ;GET BUFFER SIZE
IMULI T2,^D4 ;MAKE SIZE INTO BYTES
$STORE T2,RSZ,0(R) ;TELL RMS HOW MUCH TO WRITE
MOVEI T2,RB$KEY ;KEYED ACCESS
$STORE T2,RAC,0(R) ;TELL RMS
CAIN T1,PROFIL ;INTERNAL BUFFER?
POPJ P, ;YES--ALREADY IN 9-BIT FORMAT
MOVEI T2,.AENAM(T1) ;POINT TO NAME
HRLI T2,(POINT 8,) ;8-BIT BYTES
MOVE T3,[POINT 9,PROFIL+.AENAM] ;POINTER TO STORAGE
MOVEI T4,.AANLC ;LENGTH IN CHARACTERS
SETHD1: ILDB T1,T2 ;GET 8-BIT CHARACTER
PUSHJ P,CVTCAS ;DO CASE CONVERSION IF NECESSARY
IDPB T1,T3 ;PUT 9-BIT CHARACTER
SOJG T4,SETHD1 ;LOOP THROUGH NAME
MOVEI P1,.AEMIN ;OFF-THE-END INDEX FOR CHGTAB
SETHD2: SOJL P1,SETHD4 ;LOOP OVER CHGTAB ENTRIES
MOVE T4,CHGTAB##(P1) ;GET CONTROL BITS
TXNE T4,PD.EXT ;MUST BE EXTENSIBLE
TXNE T4,PD.NMD!PD.CND ;MUST BE MODIFIABLE AND DEFAULTABLE
JRST SETHD2 ;ELSE JUST TRUST THE CALLER
HRRZ T2,P1 ;GET OFFSET
SETO T3, ;WANT TO TEST
MOVEI T1,PROFIL ;OUR COPY OF THE BLOCK
PUSHJ P,A$BMAP## ;SEE IF IT WAS DEFAULTED
JUMPF SETHD2 ;NO, DON'T GRIND IT DOWN
MOVE T4,CHGTAB##(P1) ;YES, GET BITS AGAIN
TXNN T4,PD.EXT ;EXTENSIBLE?
JRST SETHD3 ;NO, DON'T MESS WITH THE BLOCK
SETO T4, ;YES, DON'T WANT TO CHANGE THE DEFAULT BIT
SETZ T3, ;WE WANT TO DELETE THE BLOCK
HRROI T2,(P1) ;INDEX TO THE ENTRY
; MOVEI T1,PROFIL ;STILL SETUP
SKIPE PROFIL(T2) ;IF BLOCK IS IN USE,
PUSHJ P,A$EBLK## ;DELETE IT
JRST SETHD2 ;KEEP CLEANING UP THE BLOCK
SETHD3: LOAD S1,T4,PD.WRD ;GET BLOCK SIZE
MOVEI S2,PROFIL(P1) ;AND ITS ADDRESS
$CALL .ZCHNK ;CLEAR IT OUT
JRST SETHD2 ;KEEP CLEANING UP THE BLOCK
SETHD4: HRRZ T2,PROFIL+.AEVRS ;GET BUFFER SIZE
IMULI T2,^D4 ;MAKE SIZE INTO BYTES
$STORE T2,RSZ,0(R) ;TELL RMS HOW MUCH TO WRITE
POPJ P, ;RETURN
; CONVERT 9-BIT INTERNAL ACCOUNTING USER NAME TO 8-BIT
; CALL: MOVE T1, PROFILE ADDRESS
; PUSHJ P,NAME8
NAME8: MOVSI T2,.AENAM(T1) ;POINT TO NAME
HRRI T2,TMPNAM ;TEMP STORAGE
BLT T2,TMPNAM+.AANLW-1 ;COPY
SETZM .AENAM(T1) ;WANT TO CLEAR LOW-ORDER BITS
MOVEI T2,.AENAM+1(T1) ;OF ENTIRE BLOCK
HRLI T2,.AENAM(T1) ;MAKE TRANSFER WORD
BLT T2,.AENAM+.AANLW-1(T1) ;CLEAR THE BLOCK
MOVE T2,[POINT 9,TMPNAM] ;POINT TO 9-BIT NAME
MOVEI T3,.AENAM(T1) ;WHERE TO RETURN THE CONVERTED NAME
HRLI T3,(POINT 8,) ;8-BIT ASCIZ
MOVEI T4,.AANLC ;LENGTH IN CHARACTERS
NAME81: ILDB T1,T2 ;GET A CHARACTER
IDPB T1,T3 ;PUT A CHARACTER
SOJG T4,NAME81 ;LOOP
POPJ P, ;RETURN
CVTNM1: MOVEI T4,.AANLC ;MAX LENGTH OF USER NAME
CVNLUP: SKIPE T1,T2 ;IF NOT OFF END,
ILDB T1,T2 ;FETCH GIVEN NAME
SKIPN T1 ;DONE?
SETZ T2, ;YES, MAKE SURE FILLED WITH ZEROS
PUSHJ P,CVTCAS ;DO CASE CONVERSION
IDPB T1,T3 ;COPY INTO KEY
SOJGE T4,CVNLUP ;LOOP IF NOT (1 EXTRA FOR NULL @END)
POPJ P, ;RETURN
; CASE CONVERSION
; "UPCASE" ANY 8 BIT CHARS TOO. SCNSER SHOULD BE WORRYING IF
; 7-BIT TTY TYPES 8-BIT NAME. I WON'T.
CVTCAS: CAIL T1,"A"+40 ;CONVERT
CAILE T1,"Z"+40 ; LOWER
CAIL T1,"A"+240 ; CASE TO
CAILE T1,"Z"+240 ; UPPER CASE
POPJ P, ;NOTHING TO CONVERT
SUBI T1," " ;OK, DO THE CONVERSION
POPJ P, ;RETURN
SUBTTL PUT A RECORD INTO A FILE
; CALL: MOVE AC1, ADDRESS OF USER BUFFER
; PUSHJ P,PUTA/PUTB/PUTC
PUTA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST PUTCOM ;ENTER COMMON CODE
PUTB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST PUTCOM ;ENTER COMMON CODE
PUTC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST PUTCOM ;ENTER COMMON CODE
; COMMON PUT CODE
PUTCOM: SKIPE ACTLCK ;LOCKED OUT?
POPJ P, ;DON'T BOTHER RMS
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
PUSHJ P,SETHDR ;SET UP THE RECORD HEADER
PUTCO1: $PUT 0(R) ;PUT THE RECORD IN THE FILE
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
; JRST .POPJ1 ;RETURN
$FLUSH 0(R) ;*** FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;*** CHECK FOR ERRORS
POPJ P, ;*** FAILED
JRST .POPJ1 ;RETURN
SUBTTL UPDATE A FILE
; UPDATE THE LAST RECORD READ
; CALL: MOVE AC1, ADDRESS OF USER BUFFER
; PUSHJ P,UPDA/UPDB/UPDC
UPDA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST UPDCOM ;ENTER COMMON CODE
UPDB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST UPDCOM ;ENTER COMMON CODE
UPDC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST UPDCOM ;ENTER COMMON CODE
; COMMON UPDATE CODE
UPDCOM: SKIPE ACTLCK ;LOCKED OUT?
POPJ P, ;DON'T BOTHER RMS
MOVEI T1,.AEMIN+$AEFLT ;GET LENGTH OF PROFILE
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
MOVEI T1,TEMP ;POINT TO TEMP PROFILE STORAGE
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
MOVE T2,.AEPPN(T1) ;AND TARGET PPN FROM PROFILE
MOVEM T2,TMPNAM ;SAVE PPN AS SEARCH STRING
MOVEI T1,0 ;PRIMARY KEY
MOVEI T2,4 ;BYTES IN A PPN
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;READ SPECIFIED RECORD
PUSHJ P,ERRCKR ;SEE IF WE FOUND IT
POPJ P, ;MUST BE THERE
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
PUSHJ P,SETHDR ;SET UP HEADERS
HRRZ T1,TEMP+.AEVRS ;GET LENGTH OF PROFILE TO UPDATE
HRRZ T2,PROFIL+.AEVRS ;GET LENGTH OF PROFILE ON DISK
CAIN T1,(T2) ;UPDATE OF SAME SIZE?
JRST UPDCO3 ;YES--THAT'S EASY
PUSHJ P,UPDVAL ;VALIDATE A POSSIBLE NAME CHANGE
POPJ P, ;PROBABLY DUPLICATE NAME
UPDCO1: MOVE T1,TEMP+.AEPPN ;TARGET PPN
MOVEM T1,PROFIL+.AEACS ;SAVE
SETZM PROFIL+.AEPPN ;ZAP PPN (KEY)
MOVSI T1,400000 ;HIGH BIT OF FIRST CHARACTER IN USER NAME
IORM T1,PROFIL+.AENAM ;TURN IT ON
PUSHJ P,PUTCO1 ;STORE TEMP PROFILE WITH PPN [0,0]
POPJ P, ;FAILED
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
MOVE T2,.AEPPN(T1) ;AND TARGET PPN
PUSHJ P,DELCO1 ;DELETE ORIGINAL PROFILE
JRST UPDCO2 ;UNWIND AS BEST WE CAN
MOVE T1,ARGS ;GET CALLER'S ARGUMENT
PUSHJ P,SETHDR ;SET UP THE RECORD HEADER
MOVE T1,PROFIL+.AEPPN ;GET THE PPN
MOVEM T1,PROFIL+.AEACS ;SAVE AS THE UPDATE ACTIVE PPN
PUSHJ P,PUTCO1 ;INSERT NEW PROFILE FOR ORIGINAL PPN
POPJ P, ;FAILED
SETZ T2, ;GET [0,0]
PUSHJ P,DELCO1 ;DELETE THAT PROFILE
POPJ P, ;FAILED
MOVE T1,PROFIL+.AEACS ;GET TARGET PPN
MOVEM T1,TMPNAM ;SAVE AS KEY
MOVEI T1,0 ;KEY OF REFERENCE
MOVEI T2,4 ;KEY LENGTH
PUSHJ P,SETFND ;SET UP FIND
$FIND 0(R) ;FIND THE RECORD
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
MOVEI T1,PROFIL ;POINT TO INTERNAL PROFIL BUFFER
JRST UPDCO4 ;GO FINISH UP
UPDCO2: SETZ T2, ;[0,0]
PUSHJ P,DELCO1 ;TRY TO DELETE THE PPN
JFCL ;WHO CARES AT THIS POINT
POPJ P ;RETURN
UPDCO3: MOVE T1,ARGS ;GET CALLER'S ARGUMENT
UPDCO4: PUSHJ P,SETHDR ;SET UP THE RECORD HEADER
SETZM PROFIL+.AEACS ;MAKE SURE UPDATE ACTIVE PPN IS ZEROED
$UPDATE 0(R) ;REPLACE THE RECORD IN THE FILE
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
POPJ P, ;FAILED
; JRST .POPJ1 ;RETURN
$FLUSH 0(R) ;*** FORCE BUFFERS OUT
PUSHJ P,ERRCKR ;*** CHECK FOR ERRORS
POPJ P, ;*** FAILED
JRST .POPJ1 ;RETURN
UPDFIX: PUSHJ P,.SAVE1 ;SAVE P1
MOVEI T1,.AEMAX ;GET MAXIMUM LENGTH OF PROFILE
$STORE T1,USZ,0(R) ;STORE SIZE IN RAB
MOVEI T1,PROFIL ;POINT TO TEMP PROFILE STORAGE
$STORE T1,UBF,0(R) ;STORE ADDRESS IN RAB
SETZB T1,TMPNAM ;KEY OF REFERENCE, PPN IS [0,0]
MOVEI T2,4 ;KEY LENGTH
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;FETCH TEMPORARY PROFILE
PUSHJ P,ERRCKR ;SEE IF FOUND
JRST .POPJ1 ;NOT THERE SO NO UPDATE WAS IN PROGRESS
SKIPN P1,PROFIL+.AEACS ;GET ACTIVE UPDATE PPN
POPJ P, ;MUST BE ONE
MOVEM P1,TMPNAM ;SAVE PPN AS KEY
SETZ T1, ;PRIMARY KEY
MOVEI T2,4 ;KEY LENGTH
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;FETCH PROFILE
PUSHJ P,ERRCKR ;CHECK FOR ERRORS
JRST UPDFI2 ;NOT THERE
UPDFI1: MOVE T2,PROFIL+.AEPPN ;GET ORIGINAL PPN
PUSHJ P,DELCO1 ;DELETE ITS PROFILE
POPJ P, ;FAILED
UPDFI2: SETZB T1,TMPNAM ;KEY OF REFERENCE, PPN IS [0,0]
MOVEI T2,4 ;KEY LENGTH
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;FETCH TEMPORARY PROFILE AGAIN
PUSHJ P,ERRCKR ;SEE IF FOUND
POPJ P, ;SHOULD NOT FAIL
MOVE T1,PROFIL+.AEACS ;GET ACTIVE UPDATE PPN
MOVEM T1,PROFIL+.AEPPN ;SAVE AS REAL PPN NOW
MOVSI T1,400000 ;HIGH BIT OF FIRST WORD IN USER NAME
ANDCAM T1,PROFIL+.AENAM ;CLEAR IT
MOVEI T1,PROFIL ;POINT TO BUFFER
PUSHJ P,SETHDR ;SET UP THE RECORD HEADER
PUSHJ P,PUTCO1 ;INSERT PROFILE WITH ORIGINAL PPN
POPJ P, ;FAILED
SETZ T2, ;[0,0]
PUSHJ P,DELCO1 ;DELETE TEMPORARY PROFILE
POPJ P, ;FAILED
MOVEM P1,TMPNAM ;TARGET IS ORIGINAL PPN AGAIN
MOVEI T1,0 ;KEY OF REFERENCE
MOVEI T2,4 ;KEY LENGTH
PUSHJ P,SETFND ;SET UP FIND
$GET 0(R) ;FETCH TEMPORARY PROFILE AGAIN
PUSHJ P,ERRCKR ;SEE IF FOUND
POPJ P, ;SHOULD NOT FAIL
MOVEI T1,PROFIL ;POINT TO INTERNAL PROFILE BUFFER
PJRST UPDCO4 ;GO CLEAR UPDATE ACTIVE PPN AND RETURN
;VALIDATE USER NAME ON AN UPDATE WHEN PROFILE LENGTH DIFFERS
UPDVAL: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,TEMP+.AENAM ;TEMP PROFILE USER NAME
MOVEI P2,PROFIL+.AENAM ;NAME ON DISK
MOVSI T1,-.AANLW ;AOBJN POINTER
UPDVA1: MOVE T2,(P1) ;GET A WORD
CAME T2,(P2) ;MATCH?
JRST UPDVA2 ;NO
ADDI P1,1 ;ADVANCE POINTER
ADDI P2,1 ;...
AOBJN T1,UPDVA1 ;LOOP THROUGH ENTIRE NAME
JRST .POPJ1 ;RETURN IF NO NAME CHANGE
UPDVA2: MOVE T1,ARGS ;GET CALLER'S BUFFER
MOVSI T1,.AENAM(T1) ;NEW NAME
HRRI T1,TEMP+.AENAM ;STORAGE
BLT T1,TEMP+.AENAM+.AANLW-1 ;COPY IN NEW NAME
MOVEI T1,TEMP ;POINT TO PROFILE
PUSHJ P,UPDCO4 ;FIRST CHANGE JUST THE NAME
POPJ P, ;FAILED
JRST .POPJ1 ;NOW COMPLETE THE UPDATE
SUBTTL SET RMS-SPECIFIC OPTIONS
; BIT FIDDLER'S DELIGHT
; CALL: MOVE AC1, OPTION-NUMBER
; MOVE AC2, VALUE
; PUSHJ P,OPTA/OPTB/OPTC
OPTA:: PUSHJ P,ENTA ;SWITCH TO FILE "A" CONTEXT
JRST OPTCOM ;ENTER COMMON CODE
OPTB:: PUSHJ P,ENTB ;SWITCH TO FILE "B" CONTEXT
JRST OPTCOM ;ENTER COMMON CODE
OPTC:: PUSHJ P,ENTC ;SWITCH TO FILE "C" CONTEXT
; JRST OPTCOM ;ENTER COMMON CODE
; COMMON OPTION CODE
OPTCOM: DMOVE T1,ARGS ;GET CALLER'S ARGUMENTS
SKIPL T1 ;RANGE
CAILE T1,OPTMAX ; CHECK
POPJ P, ;NO
PJRST @OPTTAB(T1) ;CALL FUNCTION-SPECIFIC PROCESSOR
OPTTAB: IFIW .POPJ ;(0) CATCH RANDOM CALLERS
IFIW SETLOA ;(1) SET/CLEAR THE RMS "LOAD" MODE BIT
IFIW GETFBE ;(2) GET LAST FAB ERROR
IFIW GETRBE ;(3) GET LAST RAB ERROR
IFIW GETFIL ;(4) GET ADDRESS OF RETURNED FILESPEC BLOCK
OPTMAX==<.-OPTTAB>-1 ;MAX LEGAL OPTION
; FUNCTION 1 - SET/CLEAR LOAD FLAG
;
; T2/ 0 - SET NORMAL MODE, RECORDS WILL BE PLACED REGARDLESS OF FILL FACTORS
; 1 - SET LOAD MODE, FILL FACTOR WILL DETERMINE RECORD PLACEMENT
; MAY BE CALLED ANY TIME, REMAINS AS SET UNTIL CHANGED.
; SHOULD BE SET TO 1 WHEN MASS INSERTIONS ARE BEING DONE. SUCH INSERTIONS
; SHOULD BE SORTED BY PPN TO MAXIMIZE BENEFIT.
SETLOA: MOVEM T2,LOAFLG ;SAVE THE REQUESTED STATUS
DOLOA: JUMPE R,.POPJ ;JUMP IF NO STREAM OPEN
$FETCH T1,ROP,0(R) ;GET CURRENT ROP FIELD
SKIPN LOAFLG ;LOAD MODE?
TXZA T1,RB$LOA ;NO, TELL RMS
TXO T1,RB$LOA ;YES, TELL RMS
$STORE T1,ROP,0(R) ;RETURN RESULT
JUMPE F,.POPJ ;JUMP IF NO FAB
$FETCH T1,FOP,0(F) ;GET CURRENT FOP FIELD
SKIPN LOAFLG ;LOAD MODE?
TXZA T1,FB$DFW ;NO, TELL RMS
TXO T1,FB$DFW ;YES, TELL RMS
$STORE T1,FOP,0(F) ;RETURN RESULT
JRST .POPJ1 ;OK
; FUNCTION 2 - GET FAB ERROR STATUS
GETFBE: JUMPE F,.POPJ ;ERROR IF NO FAB
$FETCH T1,STS,0(F) ;GET STATUS
$FETCH T2,STV,0(F) ;AND STATUS VALUE
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;SUCCESS
; FUNCTION 3 - GET RAB STATUS
GETRBE: JUMPE R,.POPJ ;ERROR IF NO RAB
$FETCH T1,STS,0(R) ;GET STATUS
$FETCH T2,STV,0(R) ;AND STATUS VALUE
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;SUCCESS
; FUNCTION 4 - GET ADDRESS OF RETURNED FILESPEC BLOCK
GETFIL: MOVE T1,[2,,T2] ;SET UP UUO AC
$FETCH T2,JFN,0(F) ;GET TOPS-10 I/O CHANNEL NUMBER FROM FAB
HRLZS T2 ;PUT IN LH
HRRI T2,.FOFIL ;FILOP. UUO FUNCTION CODE
MOVE T3,[.FOFMX,,FFFIL] ;POINT TO DATA BLOCK
FILOP. T1, ;READ FILESPEC
POPJ P, ;RETURN
MOVEI T1,.FOFMX ;LENGTH OF BLOCK
MOVEI T2,FFFIL ;POINT TO BLOCK
DMOVEM T1,ARGS ;SAVE RESULTS
JRST .POPJ1 ;RETURN
;HERE AFTER EACH RMS OPERATION TO SEE IF THERE WAS AN ERROR
;RETURNS CPOPJ/CPOPJ1, IN EITHER CASE THE STS IS IN T1, THE STV IN T2.
ERRCKF: SKIPA T1,F ;POINT TO FAB AGAIN
ERRCKR: MOVE T1,R ;OR THE RAB
$FETCH T2,STV,0(T1) ;GET STATUS VALUE
$FETCH T1,STS,0(T1) ;AND ACTUAL STATUS
CAIGE T1,ER$MIN ;AN ERROR?
AOS (P) ;NO
POPJ P, ;RETURN
; CONTEXT SWITCH TO THE APPROPRIATE FILE
; THIS IS A CO-ROUTINE THAT MAY NOT BE CALLED RECURSIVELY
; TO SAVE 'N' SETS OF ACS.
; CALL: PUSHJ P,ENTA/ENTB/ENTC
; ALL
ENTX: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
SETZB F,R ;NO FAB OR RAB
JRST ENTCOM ;ENTER COMMON CODE
; FILE "A"
ENTA: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
MOVEI F,A.WFAB ;POINT TO FAB
MOVEI R,A.WRAB ;POINT TO RAB
JRST ENTCOM ;ENTER COMMON CODE
; FILE "B"
ENTB: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
MOVEI F,B.WFAB ;POINT TO FAB
MOVEI R,B.WRAB ;POINT TO RAB
JRST ENTCOM ;ENTER COMMON CODE
; FILE "C"
ENTC: AOSE SAVFLG ;ALREADY CONTEXT SWITCHED?
POPJ P, ;YES--THEN DO NOTHING
MOVEM 0,SAVACS+0 ;SAVE AC 0
MOVE 0,[1,,SAVACS+1] ;SET UP BLT
BLT 0,SAVACS+17 ;SAVE ACS 1 - 17
MOVEI F,C.WFAB ;POINT TO FAB
MOVEI R,C.WRAB ;POINT TO RAB
; JRST ENTCOM ;ENTER COMMON CODE
; COMMON ENTRY/EXIT CODE
ENTCOM: DMOVE T1,SAVACS+1 ;GET CALLER'S ARGUMENTS
DMOVEM T1,ARGS ;SAVE
MOVE T1,SAVACS+P ;GET OLD PDL POINTER
XMOVEI T1,@0(T1) ;GET CALLER'S ADDRESS
MOVE 0,T1 ;COPY ADDRESS
MOVE T1,SAVACS+T1 ;RELOAD T1
PUSHJ P,@0 ;CALL THE CALLER
TDZA T1,T1 ;INDICATE FALSE RETURN
HRROI T1,-1 ;INDICATE TRUE RETURN
MOVEM T1,SAVACS+0 ;SAVE IN AC 0
DMOVE T1,ARGS ;GET RESULTS
DMOVEM T1,SAVACS+1 ;STORE FOR CALLER
MOVE 0,[SAVACS+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,SAVACS+0 ;RELOAD AC 0
POP P,(P) ;PRUNE STACK
SETOM SAVFLG ;RESET CONTEXT FLAG
POPJ P, ;RETURN
LIT
RELOC 0
SAVACS: BLOCK 20 ;AC STORAGE
SAVFLG: BLOCK 1 ;NON-ZERO IF ACS SAVED
ACTLCK::0 ;ACCT FILE IS LOCKED FLAG
ARGS: BLOCK 2 ;CALLER'S ARGUMENTS
WLDNXT: BLOCK 1 ;ZERO IF SEARCHING FOR NEXT PROFILE
WLDCNT: BLOCK 1 ;COUNT OF RECURSIONS AND/OR CHARACTER MATCHES
SELBLK: BLOCK 1 ;COUNT OF SELECTION BLOCKS IN MESSAGE
SELPTR: BLOCK 1 ;AOBJN POINTER TO SELECTION DATA
SELFLG::BLOCK 1 ;NON-ZERO IF SELECTION ANALYSIS IN PROGRESS
CMPINS::BLOCK 4 ;COMPARE INSTRUCTIONS
BASNAM: BLOCK 12 ;BASE NAME FOR WILDCARD SEARCHES
TMPNAM: BLOCK .AANLW ;TEMP STG FOR UP-CASED USER NAME STRING(ASCIZ)
UPDNAM: BLOCK .AANLW ;TEMP STORAGE FOR USER NAME DURING UPDATE
LOAFLG: BLOCK 1 ;"LOAD MODE" FLAG
PROFIL: BLOCK .AEMAX ;INTERNAL PROFILE BLOCK
TEMP: BLOCK .AEMAX ;ANOTHER INTERNAL PROFILE FOR UPDATES
; FILE "A" STORAGE
A.ZBEG:! ;START OF BLOCK TO ZERO
A.WFAB: BLOCK FA$LNG ;WORKING FAB
A.WRAB: BLOCK RA$LNG ;WORKING RAB
A.WXA1: BLOCK XA$SXA ;WORKING XAB FOR AREA 1
A.WXA2: BLOCK XA$SXA ;WORKING XAB FOR AREA 2
A.WXA3: BLOCK XA$SXA ;WORKING XAB FOR AREA 3
A.WXK0: BLOCK XA$SXK ;WORKING XAB FOR KEY 0
A.WXK1: BLOCK XA$SXK ;WORKING XAB FOR KEY 1
A.ZEND:! ;END OF BLOCK TO ZERO
; FILE "B" STORAGE
B.ZBEG:! ;START OF BLOCK TO ZERO
B.WFAB: BLOCK FA$LNG ;WORKING FAB
B.WRAB: BLOCK RA$LNG ;WORKING RAB
B.WXA1: BLOCK XA$SXA ;WORKING XAB FOR AREA 1
B.WXA2: BLOCK XA$SXA ;WORKING XAB FOR AREA 2
B.WXA3: BLOCK XA$SXA ;WORKING XAB FOR AREA 3
B.WXK0: BLOCK XA$SXK ;WORKING XAB FOR KEY 0
B.WXK1: BLOCK XA$SXK ;WORKING XAB FOR KEY 1
B.ZEND:! ;END OF BLOCK TO ZERO
; FILE "C" STORAGE
C.ZBEG:! ;START OF BLOCK TO ZERO
C.WFAB: BLOCK FA$LNG ;WORKING FAB
C.WRAB: BLOCK RA$LNG ;WORKING RAB
C.WXA1: BLOCK XA$SXA ;WORKING XAB FOR AREA 1
C.WXA2: BLOCK XA$SXA ;WORKING XAB FOR AREA 2
C.WXA3: BLOCK XA$SXA ;WORKING XAB FOR AREA 3
C.WXK0: BLOCK XA$SXK ;WORKING XAB FOR KEY 0
C.WXK1: BLOCK XA$SXK ;WORKING XAB FOR KEY 1
C.ZEND:! ;END OF BLOCK TO ZERO
; XAB ADDRESS STORAGE FOR OPNINI
X.WXA1: BLOCK 1 ;ADDRESS OF WORKING XAB FOR AREA 1
X.WXA2: BLOCK 1 ;ADDRESS OF WORKING XAB FOR AREA 2
X.WXA3: BLOCK 1 ;ADDRESS OF WORKING XAB FOR AREA 3
X.WXK0: BLOCK 1 ;ADDRESS OF WORKING XAB FOR KEY 0
X.WXK1: BLOCK 1 ;ADDRESS OF WORKING XAB FOR KEY 1
; FILE FIXUP STORAGE
FFZBEG:! ;START OF BLOCK TO ZERO
FFFLG: BLOCK 1 ;NON-ZERO IF CALL TO OPNBLK SUCCESSFUL
FFFIL: BLOCK .FOFMX ;RETURNED FILESPEC BLOCK
FFFOP: BLOCK .FOMAX ;FILOP BLOCK
FFPTH: BLOCK .PTMAX ;PATH BLOCK
FFLKP: BLOCK .RBMAX+1 ;LOOKUP BLOCK
FFREN: BLOCK .RBMAX+1 ;RENAME BLOCK
FFZEND:! ;END OF BLOCK TO ZERO
RMS$$G::BLOCK 3K ;3 PAGES FOR RMS GLOBAL DATA
PRGEND
TITLE ACTPDF - PROFILE DEFAUTLING
SEARCH ACTPRM
MODULE (ACTPDF)
ENTRY A$PDEF
; THIS ROUTINE WILL CAUSE A USER PROFILE TO HAVE ITS DEFAULTED FIELDS
; FILLED IN FROM THE ALTERNATE PROFILE PROVIDED. IT IS EXPECTED THAT
; THE CALLER RESERVED .AEMAX WORDS FOR THE USER PROFILE BLOCK.
; CALL: MOVE T1, USER PROFILE ADDRESS
; MOVE T2, DEFAULT PROFILE ADDRESS
; PUSHJ P,A$PDEF
;
; TRUE RETURN, PROFILE'S DEFAULT FIELDS COPIED.
; FALSE RETURN, SOMETHING WENT WRONG (NO ROOM FOR EXTENSIBLE BLOCK?).
;
; CLOBBERS ONLY S1 & S2.
A$PDEF::PUSHJ P,.SAVE4 ;PRESERVE SOME ACS
$SAVE <T1,T2,T3,T4> ;AND SOME MORE
DMOVE P1,T1 ;SAVE THE ARGUMENTS
MOVE P3,[POINT 1,.AEMAP(P1)] ;EXAMINE THE USER'S DEFAULT MAP
MOVSI P4,-CHGLEN## ;FOR EXAMINING CHGTAB
PDEF.1: MOVE T4,CHGTAB##(P4) ;GET BITS FOR NEXT ENTRY
ILDB T3,P3 ;AND USER'S PROFILE BIT
JUMPE T3,PDEF.5 ;DON'T BOTHER IF NO DEFAULTING WANTED
TXNE T4,PD.CND ;CAN IT BE DEFAULTED?
JRST PDEF.4 ;NO, CLEAR THE BIT
TXNE T4,PD.EXT ;IS THIS AN EXTENSIBLE BLOCK?
JRST PDEF.3 ;YES, HANDLE DIFFERENTLY
LOAD T1,T4,PD.WRD ;NO, GET LENGTH OF SUB-BLOCK
JUMPE T1,PDEF.4 ;SKIP THIS WORD IF IT'S NOT FOR REAL
DMOVE S1,P1 ;COPY BLOCK ADDRESSES
ADDI S1,(P4) ;FORM OFFSET
ADDI S2,(P4) ;INTO EACH BLOCK
PDEF.2: MOVE T2,(S2) ;GET DEFAULT VALUE
MOVEM T2,(S1) ;STORE IN USER PROFILE
SOJLE T1,PDEF.5 ;DIFFERENT OVERHEAD AT END OF BLOCK
AOJ S1, ;ADVANCE PROFILE POINTER
AOJ S2, ;BOTH PROFILES
IDPB T3,P3 ;MAKE SURE DEFAULT BITS ARE CONSISTENT
AOBJN P4,PDEF.2 ;ADVANCE CHGTAB POINTER AND LOOP
$RETF ;SOMETHING'S WRONG IF IT WON'T FIT
PDEF.3: DMOVE T1,P1 ;COPY PROFILE ADDRESSES
ADDI T2,(P4) ;POINT TO ENTRY IN DEFAULT BLOCK
MOVE T2,(T2) ;GET THE RELATIVE BLOCK POINTER
HRRZ T3,T2 ;COPY THE OFFSET
SKIPE T3 ;IF THERE'S REALLY A SUB-BLOCK,
ADDI T3,(P2) ;GET ITS ADDRESS (NOT OFFSET)
HRRI T2,(P4) ;HERE'S THE PROFILE OFFSET WE'RE AFTER
SETO T4, ;DEFAULT BIT IS ALREADY ON, LEAVE IT
PUSHJ P,A$EBLK## ;DIDDLE THE EXTENSIBLE BLOCK
JUMPT PDEF.5 ;KEEP GOING IF ITS SUCCEEDS
$RET ;PROPAGATE FAILURE
PDEF.4: SETZ T3, ;GET A ZERO BIT
DPB T3,P3 ;THIS IS NOT EITHER A DEFAULTED FIELD
PDEF.5: AOBJN P4,PDEF.1 ;LOOP OVER ALL OF CHGTAB
$RETT ;IT WORKED!
LIT
PRGEND
TITLE ACTBLK - PROFILE MEMORY MANAGEMENT
SEARCH ACTPRM
MODULE (ACTBLK)
ENTRY A$EBLK
; THIS ROUTINE WILL ALLOCATE, DEALLOCATE, AND SHUFFLE EXTENSIBLE
; DATA BLOCKS WITHIN A PROFILE. IT IS EXPECTED THE CALLER HAS
; RESERVED .AEMAX WORDS FOR A PROFILE.
; CALL: MOVE T1, PROFILE ADDRESS
; MOVE T2, -LENGTH,,PROFILE OFFSET
; MOVE T3, ADDRESS OF BLOCK TO INSERT OR ZERO
; MOVE T4, FLAG
; PUSHJ P,A$EBLK
;
; FLAG: -1 = DO NOT UPDATE .AEMAP
; 0 = CLEAR .AEMAP BIT
; 1 = SET .AEMAP BIT
;
; TRUE RETURN: BLOCK INSERTED IF T3 NON-ZERO OR DELETED IF ZERO
; FALSE RETURN: NO ROOM TO INSERT BLOCK
A$EBLK::PUSHJ P,.SAVE4 ;SAVE SOME ACS
DMOVE P1,T1 ;COPY
DMOVE P3,T3 ; ARGS
HRRZ T1,P2 ;GET OFFSET
MOVX T2,PD.EXT ;BIT DENOTING EXTENSIBLE BLOCKS
CAIGE T1,.AEMIN ;IS IT IN THE RANGE OF VALID BLOCK TYPES?
TDNN T2,CHGTAB##(T1) ;AND IS IT EXTENSIBLE?
$RETF ;NO, FAIL BEFORE WE DO DAMAGE
JUMPE P3,DELBLF ;GO DELETE IF NO BLOCK GIVEN
ADDBLK: HRRZ T1,P2 ;GET OFFSET
ADDI T1,(P1) ;INDEX INTO PROFILE
SKIPN (T1) ;BETTER NOT BE IN USE
JRST ADDBL1 ;IT'S NOT
PUSHJ P,DELBLK ;FIRST DELETE WHAT'S THERE
HRRZ T1,P2 ;GET OFFSET AGAIN
ADDI T1,(P1) ;RESET INDEX INTO PROFILE
ADDBL1: HRRZ T3,P2 ;GET OFFSET AGAIN
LOAD T3,CHGTAB##(T3),PD.WRD ;GET MAX. BLOCK SIZE
MOVNS T3 ;NEGATE IT FOR COMPARISONS
HLRE T2,P2 ;GET -LENGTH
CAMGE T2,T3 ;BLOCK TOO LONG?
MOVE T2,T3 ;YES, ONLY USE OUR MAX. LENGTH
HRL P2,T2 ;UPDATE LENGTH
MOVMS T2 ;MAKE POSITIVE
HRRZ T3,.AEVRS(P1) ;GET LENGTH OF PROFILE SO FAR
ADDI T2,(T3) ;COMPUTE LAST WORD IN PROFILE
CAILE T2,.AEMAX ;WILL NEW BLOCK FIT?
$RETF ;NOPE
HRRM T2,.AEVRS(P1) ;UPDATE NEW PROFILE LENGTH
HLLM P2,(T1) ;STORE -WORD COUNT OF EXTENSIBLE BLOCK
HRRM T3,(T1) ;AND THE RELATIVE OFFSET IN PROFILE
ADDI T3,(P1) ;POINT TO END OF THE PROFILE NOW
HRLI T3,(P3) ;MAKE A BLT POINTER
ADDI T2,(P1) ;COMPUTE END OF BLT
BLT T3,-1(T2) ;COPY INTO THE PROFILE
EBLKRT: JUMPL P4,.RETT ;RETURN IF NO UPDATES TO .AEMAP WANTED
MOVE T1,P1 ;GET PROFILE ADDRESS
HRRZ T2,P2 ;GET PROFILE OFFSET FOR AOBJN POINTER
MOVE T3,P4 ;GET SET/CLEAR BIT
PJRST A$BMAP## ;GO TOGGLE BIT AND RETURN
DELBLF: PUSHJ P,DELBLK ;DELETE THE BLOCK
PJRST EBLKRT ;DO COMMON RETURN CODE
DELBLK: PUSHJ P,.SAVE4 ;PRESERVE ARGUMENTS
MOVSI T1,(P1) ;POINT TO PROFILE
HRRI T1,TEMP ;AND TO TEMP STORAGE
BLT T1,TEMP+.AEMAX-1 ;COPY PROFILE
MOVEI T1,.AEMIN ;MINIMUM LENGTH
HRRM T1,.AEVRS(P1) ;TRUNCATE ORIGINAL PROFILE
MOVSI T1,.AEMIN(P1) ;POINT TO END OF STATIC PROFILE
HRRI T1,.AEMIN+1(P1) ;MAKE A BLT POINTER
SETZM .AEMIN(P1) ;CLEAR FIRST WORD
BLT T1,.AEMAX-1(P1) ;ZERO OUT EXTENSIBLE DATA STORAGE
MOVSI P4,-EXTSIZ ;AOBJN POINTER
DELBL1: MOVE T1,EXTTBL(P4) ;GET PROFILE OFFSET
ADDI T1,(P1) ;INDEX INTO ORIGINAL PROFILE
SETZM (T1) ;ZERO EXTENSIBLE POINTER
AOBJN P4,DELBL1 ;LOOP FOR ALL POINTERS
MOVSI P4,-EXTSIZ ;AOBJN POINTER
HRRZ T1,P2 ;GET OFFSET OF POINTER TO BLOCK FOR DELETION
PUSH P,T1 ;SAVE
DELBL2: MOVE T1,EXTTBL(P4) ;GET AN OFFSET
CAME T1,(P) ;FOUND BLOCK TO DELETE?
SKIPN P2,TEMP(T1) ;NO--GET OFFSET TO EXTENSIBLE DATA
JRST DELBL3 ;THERE IS NONE
HRRZ P3,P2 ;GET RELATIVE INDEX INTO PROFILE
ADDI P3,TEMP ;POINT DIRECTLY TO IT
HRR P2,T1 ;WHERE TO STUFF NEW AOBJN POINTER
PUSH P,P4 ;SAVE AOBJN POINTER
MOVNI P4,1 ;IGNORE .AEMAP
PUSHJ P,ADDBLK ;RE-INSERT THE BLOCK
POP P,P4 ;RESTORE AOBJN POINTER
DELBL3: AOBJN P4,DELBL2 ;LOOP FOR ALL POSSIBLE DATA POINTERS
POP P,(P) ;PHASE STACK
POPJ P, ;RETURN
EXTTBL: EXTDAT ;TABLE OF EXTENSIBLE DATA BLOCK OFFSETS
EXTSIZ==.-EXTTBL ;NUMBER OF ACTUAL ENTRIES IN TABLE
LIT
RELOC 0
TEMP: BLOCK .AEMAX ;TEMPORARY PROFILE
PRGEND
TITLE ACTBIT - SET/CLEAR BITS IN .AEMAP
SEARCH ACTPRM
MODULE (ACTBIT)
ENTRY A$BMAP
; ROUTINE TO TOGGLE BITS IN .AEMAP BIT MAP
; CALL: MOVE T1, PROFILE ADDRESS
; MOVE T2, PROFILE OFFSET
; MOVE T3, FLAG (-1 = CHECK, 0 = CLEAR, 1 = SET)
; PUSHJ P,A$BMAP##
;
; TRUE RETURN: 1. FUNCTION = CHECK AND BIT IS SET
; 2. FUNCTION = SET/CLEAR AND OFFSET IS LEGAL
; FALSE RETURN: 1. FUNCTION = CHECK AND BIT IS CLEAR
; 2. FUNCTION = SET/CLEAR AND OFFSET IS ILLEGAL
;
; ON EITHER RETURN, T1 AND T2 REMAIN UNCHANGED AND T3 HAS THE POSSIBLY
; UPDATED STATUS OF THE BIT BEING CHECKED/SET/CLEARED. THIS IS SO THE
; CALLER MAY TURN AROUND AND IMMEDIATELY CHANGE THE STATUS OF THE BIT
; WITHOUT HAVING TO SETUP THE ACS AGAIN.
; THIS CODE WILL HAVE TO CHANGE IF EVER THERE IS A STATIC BLOCK WHICH IS
; DEFAULTABLE.
A$BMAP::CAIL T2,.AEMIN ;WITHIN RANGE OF BLOCK OFFSETS?
JUMPGE T3,.RETF ;NO, AND CHANGING, FAIL NOW
CAIL T2,.AEMIN ;CHECK AGAIN
JRST BMAP1 ;YES, AND CHECKING, IT'S DEFAULTED (FOR NOW)
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVE T4,T3 ;COPY CHECK/CLEAR/SET FLAG
IDIVI T2,^D36 ;COMPUTE WORD OFFSET IN .AEMAP
ADDI T2,.AEMAP(T1) ;INDEX INTO BIT MAP
MOVN T1,T3 ;NEGATE BIT POSITION
MOVSI T3,400000 ;INITIAL BIT
LSH T3,(T1) ;POSITION
JUMPGE T4,BMAP2 ;JUMP IF CHANGING STATUS
MOVE T4,T2 ;COPY BIT MAP ADDRESS
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
TDNN T3,(T4) ;CHECK BIT
BMAP0: TDZA T3,T3 ;BIT IS CLEAR
BMAP1: SKIPA T3,[EXP 1] ;BIT IT SET
$RETF ;RETURN
$RETT ;RETURN
BMAP2: ANDI T4,1 ;AVOID ILL MEM REFS
XCT [ANDCAM T3,(T2)
IORM T3,(T2)](T4)
MOVEI T3,(T4) ;GET STATE OF BIT
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
$RETT ;RETURN
PRGEND
TITLE ACTCHG - SELECTION/CHANGE TABLE
SEARCH ACTPRM
MODULE (ACTCHG)
ENTRY CHGTAB
CHGTAB::
DEFINE AE(NAM,LEN,BTS,RTN),<
BITS==0!<BTS>
IFE <LEN>+1,<BITS==BITS!PD.MSK>
IFL <LEN>+1,<BITS==BITS!PD.EXT>
IFL <LEN>,<BITS==BITS!FLD(<-<LEN>>,PD.WRD)>
IFG <LEN>,<BITS==BITS!FLD(<LEN>,PD.WRD)>
IFNB<RTN>,<BITS==BITS!PD.RTN>
IF2,< IFNB<RTN>,< .IF RTN,NEEDED,<EXTERN RTN> > >
IFN <LEN>,< EXP BITS!RTN >
BITS==<BITS&PD.CND>!PD.NMD!PD.NSL
IFG <LEN>-1,< REPEAT <LEN>-1,< EXP BITS > >
>
AEPROF
CHGLEN==:.-CHGTAB ;LENGTH OF THIS TABLE
IF1,< IFN CHGLEN-.AEMIN,<
PRINTX ? CHGTAB is wrong
>>
PRGEND
TITLE ACTSCD - SCDMAP.SYS ROUTINES
SEARCH ACTPRM
MODULE (ACTSCD)
ENTRY A$DSCD, A$FSCD, A$ISCD
ND SCDSIZ,^D128*2 ;SIZE OF SCDMAP.SYS DATA
; OPEN SCDMAP.SYS AND READ IN THE MAPS
; CALL: PUSHJ P,A$ISCD
;
; TRUE RETURN: SCDMAP.SYS IN CORE, S1 CONTAINS THE ADDRESS OF THE MAP
; FALSE RETURN: FAILED
A$ISCD::SKIPE SCDTBL ;POINTER THERE?
$RETT ;YES, JUST RETURN
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI S1,FOB.MZ ;FOB SIZE
MOVEI S2,SCDFOB ;FOB ADDRESS
PUSHJ P,F%IOPN ;OPEN FOR INPUT
$RETIF ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE IFN
MOVEI S1,SCDSIZ ;SIZE OF SCDMAP FILE
PUSHJ P,M%GMEM ;GET CORE
MOVEM S2,SCDTBL ;POINT TO THE CORE WE GOT
HRLI S2,-SCDSIZ ;MAKE AN AOBJN POINTER
MOVE P2,S2 ;COPY IT
MOVE S1,P1 ;GET IFN BACK
ISCD1: PUSHJ P,F%IBYT ;GET A WORD
JUMPF ISCD2 ;CHECK FOR ERRORS
MOVEM S2,(P2) ;PUT A WORD
AOBJN P2,ISCD1 ;LOOP THROUGH FILE
PUSHJ P,ISCD3 ;RELEASE THE CHANNEL
$RETT ;RETURN
ISCD2: PUSHJ P,A$DSCD ;DELETE MAP
ISCD3: MOVE S1,P1 ;GET IFN
PUSHJ P,F%RREL ;RELEASE THE CHANNEL
$RETF ;RETURN
; DELETE SCDMAP.SYS DATA
; CALL: PUSHJ P,A$CSCD
A$DSCD::MOVEI S1,SCDSIZ ;SIZE OF SCDMAP FILE
MOVE S2,SCDTBL ;ADDRESS OF MAP
PUSHJ P,M%RMEM ;RELEASE CORE
SETZM SCDTBL ;CLEAR POINTER
$RETT ;RETURN
; GET SCHEDULER TYPE AND CLASS
; CALL: MOVE S1, PROFILE BLOCK ADDRESS
; PUSHJ P,A$FSCD
A$FSCD::PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE P1,S1 ;POINT TO ENTRY
SKIPN P2,SCDTBL ;FIND OUT IF WE HAVE SCHEDULAR DATA
JRST FSCD1 ;NOPE, JUST GIVE THE RAW FILE DATA
LDB P2,[POINTR .AESCD(P1),AE.SCD] ;GET SCHEDULAR TYPE
IDIVI P2,4 ;GET INDEX INTO TABLE
ADD P2,SCDTBL ;ADD TABLE BASE ADDRESS
LDB S1,BYTTAB(P3) ;GET TIMESHARING CLASS
ADDI P2,SCDSIZ/2 ;POINT INTO BATCH END
LDB P2,BYTTAB(P3) ;GET BATCH CLASS
DPB S1,[POINTR P2,AE.SCT] ;TIMESHARING INFO
FSCD1: HRRM P2,.AESCD(P1) ;GET SCHEDULAR TYPE AND ENQ QUOTA
$RETT
BYTTAB: POINT 9,(P2),8 ;BYTE PTR FOR REMAINDER=0
POINT 9,(P2),17 ;REMAINDER=1
POINT 9,(P2),26 ;REMAINDER=2
POINT 9,(P2),35 ;REMAINDER=3
SCDFOB: $BUILD (FOB.MZ) ;BLOCK SIZE
$SET (FOB.FD,,SCDFD) ;FILE DESCRIPTOR
$SET (FOB.CW,FB.PHY,1) ;PHYSICAL I/O
$SET (FOB.CW,FB.BSZ,44);36-BIT BYTES
$EOB ;END OF BLOCK
SCDFD: $BUILD (FDXSIZ) ;BLOCK SIZE
$SET (.FDLEN,FD.LEN,FDXSIZ) ;BLOCK LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE TOPS-10 FILE
$SET (.FDSTR,,'SYS ');DEVICE
$SET (.FDNAM,,'SCDMAP');FILE NAME
$SET (.FDEXT,,'SYS ');EXTENSION
$EOB ;END OF BLOCK
LIT
RELOC 0
SCDTBL: BLOCK 1 ;POINTER TO SCDMAP DATA
PRGEND
TITLE ACTSUM - GENERATE SUMMARY TEXT
SEARCH ACTPRM
MODULE (ACTSUM)
ENTRY A$SWLD
; GENERATE SUMMARY TEXT FOLLOWING CALLS TO FETCH A PROFILE
; CALL: MOVE T1, WILDCARD MESSAGE BLOCK
; MOVE T2, BYTE POINTER TO ACK TEXT
; MOVE T3, TEXT
; MOVE T4, SUCCESS-COUNT,,FAILURE-COUNT
; PUSHJ P,A$SWLD
;
; TRUE RETURN: AT LEAST ON PROFILE FOUND
; FALSE RETURN: NO PROFILES FOUND
;
; ON EITHER RETURN, S1 CONTAINS THE ADDRESS OF THE GENERATED TEXT
A$SWLD::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;COPY TEXT TO INSERT
SKIPG UW$FND(T1) ;FOUND ANY MATCHES?
JRST SWLD1 ;NO
HLRZ TF,T4 ;GET SUCCESS COUNT
MOVEI S1,[ITEXT (<^D/T4,LHMASK/ users>)]
CAIN TF,0
MOVEI S1,[ITEXT (<no users>)]
CAIN TF,1
MOVEI S1,[ITEXT (<one user>)]
HRRZ TF,T4 ;GET FAILURE COUNT
MOVEI S2,[ITEXT (<; there were ^D/T4,RHMASK/ failures>)]
CAIN TF,0
MOVEI S2,[ITEXT (<>)]
CAIN TF,1
MOVEI S2,[ITEXT (<; there was one failure>)]
$TEXT (<-1,,SUMTXT>,<A total of ^I/(S1)/ ^T/(P1)/^I/(S2)/^0>)
MOVEI S1,SUMTXT ;POINT TO TEXT
$RETT ;RETURN
SWLD1: MOVE S1,UW$WST(T1) ;GET SEARCH TYPE
CAIN S1,1 ;WILD NAME?
JRST SWLD2 ;YES
CAIN S1,2 ;NON-WILD NAME?
JRST SWLD3 ;YES
CAIG S1,1 ;WILD PPN OR NAM?
MOVE S1,UW$PPM(T1) ;GET PPN MASK
AOJE S1,SWLD3 ;JUMP IF NOT WILD
SWLD2: MOVEI S2,[ITEXT (<No users matching ^Q/T2/>)]
SKIPE UW$SEL(T1) ;ANY SELECTION BLOCKS?
MOVEI S2,[ITEXT (<Users ^Q/T2/ rejected by constraints>)]
JRST SWLD4 ;FINISH UP
SWLD3: MOVEI S2,[ITEXT (<No such user ^Q/T2/>)]
SKIPE UW$SEL(T1) ;ANY SELECTION BLOCKS?
MOVEI S2,[ITEXT (<User ^Q/T2/ rejected by constraints>)]
SWLD4: $TEXT (<-1,,SUMTXT>,<^I/(S2)/^0>)
MOVEI S1,SUMTXT ;POINT TO TEXT
$RETF ;RETURN
LIT
RELOC 0
SUMTXT: BLOCK ^D30 ;ROOM FOR A LONG NAME + LOTS OF CRUFT
END