UNIVERSAL ACTPRM - PARAMETER FILE FOR THE ACCOUNTING SUBROUTINE PACKAGE ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 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. ; VERSION NUMBERS APRVER==1 ;VERSION NUMBER APRMIN==1 ;MINOR VERSION NUMBER APREDT==11 ;EDIT NUMBER APRWHO==0 ;WHO EDITED LAST %%ACTP==: 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. 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, ;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
),<.ERR. ("?",PFX,,DAT,RET)> DEFINE WARN (PFX,TXT,DAT,RET<.+1>),<.ERR. ("%",PFX,,DAT,RET)> DEFINE INFO (PFX,TXT,DAT,RET<.+1>),<.ERR. ("[",PFX,,DAT,RET)> DEFINE .ERR. (CHR,PFX,TXT,DAT,RET),< PUSHJ P,[PUSHJ P,A$ERRM## XWD CHR,''PFX'' XWD RET,[ITEXT ()] IFB ,< EXP 0> IFNB ,< 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 ()] XWD 'IAL',[ITEXT ()] XWD 'IFC',[ITEXT ()] XWD 'NFC',[ITEXT ()] XWD 'ADC',[ITEXT (
)] XWD 'CNR',[ITEXT ()] XWD 'EFO',[ITEXT ()] XWD 'IMO',[ITEXT ()] XWD 'NPV',[ITEXT ()] XWD 'NRA',[ITEXT ()] 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,[%CNDAE] ;GETTAB ARGUMENT GETTAB S1, ;GET MONITOR VERSION SETZ S1, ;ANCIENT MONITOR HRRZS S1 ;STRIP OFF THE SIXBIT STUFF 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 ,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 ; 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 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,] ;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, ;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 ;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! IFE +1, IFL +1, IFL ,>,PD.WRD)> IFG ,,PD.WRD)> IFNB, IF2,< IFNB,< .IF RTN,NEEDED, > > IFN ,< EXP BITS!RTN > BITS==!PD.NMD!PD.NSL IFG -1,< REPEAT -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 ()] CAIN TF,1 MOVEI S1,[ITEXT ()] 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>,) 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 ()] SKIPE UW$SEL(T1) ;ANY SELECTION BLOCKS? MOVEI S2,[ITEXT ()] JRST SWLD4 ;FINISH UP SWLD3: MOVEI S2,[ITEXT ()] SKIPE UW$SEL(T1) ;ANY SELECTION BLOCKS? MOVEI S2,[ITEXT ()] 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