         PAGE
*
***** S U P E R 3 *****
*
* THIS IS ONE OF THE THREE MODULES COMPRISING SUPER.THIS
* SECTION CONTAINS THE SUBROUTINES AND DATA NECESSARY TO
* IMPLEMENT FEATURES ADDED FOR CP-V/C00 IN JULY 1974. RICK SINATRA
*
* NEW FEATURES:
*                 RESTRICTED PROCESSOR LIST WITH :PROCS FILE
*                 EXECUTE ONLY :SYS PROCESSORS (NEW BIT IN :USERS)
*                 SECURITY CHECK CORE AND GRANULES
*
*
         SYSTEM   SIG7
         SYSTEM   BPM
         PCC      0
         PAGE
*        M E T A S Y M B O L   P R O C E D U R E S
         SPACE
*        SUBROUTINE CALL/RETURN PROCEDURES
         SPACE
EXITC    CNAME
         PROC
EX%R     EQU      AF(1)
         BOUND    8
EX%D     DATA     EX%B
         GEN,1,15,1,15  0,AF(2),0,0
EX%D2    GEN,1,15,1,15  0,AF(2),0,0 TO RESET
EX%B     RES      AF(2)             SAVE STACK FOR BAL'S
         PEND
         SPACE
LISTOPT  EQU      1
CALL     CNAME
         PROC
LF       BAL,EX%R AF
         PEND
         SPACE
ENTER    CNAME
         PROC
LF       PSW,EX%R EX%D
         PEND
         SPACE
RETURN   CNAME
         PROC
LF       PLW,EX%R EX%D
         LIST     LISTOPT
         DO       AF(1)>1
         AI,EX%R  AF(1)-1
         FIN
         B        *EX%R
         LIST     1
         PEND
         SPACE
         PAGE
*        PROC TO FILL MEMORY AREA AS SPECIFIED
         SPACE
FILL     CNAME
         PROC
         LIST     LISTOPT
         LOCAL    LOOP
         STD,R    HOLDR0R1          SAVE REGS
LF       LI,R1    AF(2)
         LI,R     AF(4)
         DO       CF(2)=1           BYTE
LOOP     STB,R    AF(1),R1
         FIN
         DO       CF(2)=2           HALF WORDS
LOOP     STH,R    AF(1),R1
         FIN
         DO       CF(2)=3           WORDS
LOOP     STW,R    AF(1),R1
         FIN
         AI,R1    1
         CI,R1    AF(3)
         BLE      LOOP
         LD,R     HOLDR0R1
         LOCAL
         LIST     1
         PEND
         PAGE
*        S W A P O U T   D A T A   S E C T I O N
         SPACE
         BOUND    8
PROCBUF  DATA     4                 INITIAL BANNER WORD
         RES,1    2044              A WHOLE GRANULE
         BOUND    8
PROCITEM RES,1    24
         BOUND    8
NEXT     DATA     0
ILENGTH  DATA     0
PLENGTH  DATA     0
DEFBUF   DATA     0                 TO HOLD WA(DEFAULT BUFFER)
HOLDFLAG DATA     0
RSW      DATA     0
PSIZE    DATA     0                 :PROCS RECORD SIZE FOR WRITE
         BOUND    8
HOLDR0R1 DATA     0,0               FOR 'FILL' PROC
SAVEREG1 RES      16
         EXITC    15,5
HOLDPL   DATA     0                 HOLD PLENGTH
         PAGE
*        E X T E R N A L   R E F / D E F
         SPACE    2
         REF      TXCSUB,RESTART,KEY,KILLP,PDEFSW,TMORE
         REF      ERVALU9,M:BO,PMODWRIT,PWRITERC,UDONE,:USERS
         REF      FL:ALL,FL:XO,FL:PL,FL:SE,DMODE
         REF      R10BUF,NTERMS,TERMS,ERVALU7,LL,PRINTL,LENGTH
         SPACE    3
         DEF      PDEF2BUF,PBUF2DEF,PWRITE,PMODWR
         DEF      XOROUT,PMROUT,RPROUT,SEROUT
         DEF      MOREPRINT,BUILDKEY,PP,PSIZE,PERABN,MCERROR
         DEF      MCTEST,MCGEN,MCMSG
         DEF      PROCBUF
         PAGE
*        R E G I S T E R   A S S I G N M E N T S
         SPACE
R,R0     EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8,SR1   EQU      8
R9,SR2   EQU      9
R10,SR3  EQU      10
R11,SR4  EQU      11
R12,SR5  EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         SPACE    3
*        D A T A   C O N S T A N T S
         SPACE
PP       CSECT    1                 PROCEDURE SECTION
ABIT     DATA     X'10000000'       ACCT PRESENT BIT
PBIT     DATA     X'08000000'       PARTIAL PROCESSOR NAME BIT
BBIT     DATA     X'80000000'       BATCH BIT
OBIT     DATA     X'40000000'       ONLINE BIT
GBIT     DATA     X'20000000'       GHOST BIT
BOGBITS  DATA     X'E0000000'       ALL THREE
         PAGE
         SPACE
*        SUBROUTINE TO MOVE THE CURRENT PROCITEM, LENGTH
*        'PLENGTH', TO THE END OF THE RECORD CURRENTLY
*        IN THE PROCBUF.  ADJUST COUNTS ACCORDINGLY.
         SPACE
ADDPROC  ENTER
         LW,R5    PROCBUF           BANNER WORD
         AND,R5   =X'FFFF'          R5=INDEX OF NEXT FREE BYTE
         ANLZ,R3  BANEXT            MBS 'TO'
         LW,R1    R5
         AW,R1    PLENGTH           IS IT GOING TO FIT
         CI,R1    2047              MAX BYTES IN RECORD
         BG       RETURN            NO FIT. RETURN TO CALL+1
         LW,R5    PLENGTH
         OR,R5    =X'10000'         TO INCREMENT ITEM COUNT
         AWM,R5   PROCBUF           MODIFY BANNER WORD
         SPACE
         LI,R2    BA(PROCITEM)      MBS 'FROM'
         LW,R     PLENGTH           BYTE COUNT
         STB,R    R3                MBS 'COUNT'
         MBS,R2   0                 MOVE ITEM TO BUFFER
         RETURN   2                 NORMAL RETURN CALL+2
BANEXT   LB,R     PROCBUF,R5        NOT EXECUTED - FOR ANLZ ONLY
         PAGE
*        THIS SUBROUTINE COMPUTES BA(NEXTITEM) AND
*        ITS LENGTH 'PLENGTH'
         SPACE
*        IF 'NEXT' = 0, THIS IS THE FIRST TIME FOR THIS RECORD
*        ELSE 'NEXT' HAS THE BA(LASTITEM) AND 'PLENGTH', ITS LENGTH
         SPACE
*  IF 'NEXT' > 0, PLENGTH=NEXT+2+TEXTC+('A'BIT)*8
*                 NEXT=NEXT+PLENGTH
         SPACE
*  IF 'NEXT' = 0, PLENGTH=4+TEXTC+('A'BIT)*8
         SPACE
SETBS    ENTER
         LW,R7    PROCBUF           BANNER WORD
         AND,R7   =X'1FF0000'       IS ITEM COUNT ZERO
         BCR,3    RETURN            TO CALL+1, IT'S EMPTY
         LW,R4    NEXT              INITIALIZED
         BNEZ     SB1               NO, COMPUTE IT
         LI,R3    2                 R3 TO BE 2 OR 10
         LH,R4    PROCBUF+1         R='FLAG'TEXTC'
         CW,R4    =X'1000'          'A' BIT (ACCT)
         BAZ      %+2               NO
         LI,R3    10                ADD ACCT LENGTH
         AND,R4   =X'FF'            R='0'TEXTC'
         AW,R4    R3
         STW,R4   PLENGTH
         LI,R4    BA(PROCBUF)+4     INITIAL VALUE FOR NEXT
         STW,R4   NEXT
         RETURN   2                 NORMAL RETURN, CALL+2
         SPACE
SB1      LW,R5    PROCBUF           IS 'NEXT' ALREADY AIMED AT LAST
         AND,R5   =X'FFFF'
         AI,R5    BA(PROCBUF)
         LW,R6    NEXT
         AW,R6    PLENGTH
         CW,R6    R5
         BGE      RETURN
         SPACE
*        COMPUTE NEXT NEXT FROM LAST NEXT  (DID HE SAY THAT?)
         SPACE
SB2      LI,R3    2                 TO BE 2 OR 10
         LW,R4    NEXT              CALCULATE NEW VALUE FOR NEXT
         AW,R4    PLENGTH
         STW,R4   NEXT
         LB,R1    0,R4              NEXT FLAG BYTE
         CI,R1    X'10'  (A BIT)    ACCOUNT PRESENT
         BAZ      %+2               NO, LEAVE THE 2
         LI,R3    10                YES, MAKE IT 10
         AI,R4    1                 TO AIM AT TEXTC BYTE
         LB,R1    0,R4              NEXT TEXTC VALUE
         AW,R1    R3
         STW,R1   PLENGTH
         CI,R4    BA(PROCBUF)+2045  BEYOND THE EDGE?
         BLE      RETURN2           OK, NORMAL RETURN
         RETURN   1                 NOT OK. RETURN CALL+1
         PAGE
*        H A N D L E   E R R O R   M E S S A G E S
         SPACE
TOOLONG  LI,R12   TOOLONGM
PANDM    BAL,R11  TXCSUB
         BAL,R11  UNSTACK           RESET STACK
         B        TMORE             PROCESS NEXT OPTION
         SPACE
PROCFULL LI,R12   FULLMSG
PANDQ    BAL,R11  TXCSUB
         BAL,R11  UNSTACK           RESET STACK
         B        RESTART           PROCESS NEXT 'MAIN' COMMAND
         SPACE
NOPAGE   LI,R12   NOPMSG
         B        PANDQ
         SPACE
SYNTAX   LI,R12   SYNTAXM
         B        PANDM
         SPACE
MCERROR  LI,R12   MCMSG
         B        PANDM
         SPACE
BADCH    LI,R12   BADCM
         B        PANDM
         SPACE
UNSTACK  LI,R12   EX%B
         STW,R12  EX%D
         LW,R12   EX%D2
         STW,R12  EX%D+1
         B        *R11
         PAGE
*        D I A G N O S T I C   M E S S A G E S
         SPACE    2
BADCM    TEXTC    '***** ILLEGAL CHARACTER IN NAME/ACCT'
         DATA     X'15000000'
         SPACE
TOOLONGM TEXTC    '***** PROCESSOR NAME OR ACCOUNT TOO LONG'
         DATA     X'15000000'
FULLMSG  TEXTC    '***** :PROC RECORD FULL. NAME REJECTED'
         DATA     X'15000000'
SYNTAXM  TEXTC    '***** SYNTAX ERROR IN COMMAND'
         DATA     X'15000000'
NOPMSG   TEXTC    '****CAN''T GET PAGE FOR DEFAULT OPTION'
         DATA     X'15000000'
MCMSG    TEXTC    '***** OPTION DISALLOWED BECAUSE MC SPECIFIED'
         DATA     X'15000000'
         PAGE
         SPACE
*        THIS SUBROUTINE SCANS THROUGH ALL THE ITEMS
*        IN PROCBUF FOR THE EQUAL ITEM IN PROCITEM AND EXITS
*        TO CALL+1 IF NOT PRESENT OR CALL+2 IF PRESENT.
         SPACE
*        THE BYTE ADDRESS OF THE FIRST BYTE IS LEFT IN 'NEXT' AND
*        ITS LENGTH IN 'PLENGTH'
         SPACE
FINDPROC ENTER
         LW,R     PROCITEM          FLAG BYTE
         STW,R    HOLDFLAG          SAVE IT
         SPACE
         LI,R     0
         STW,R    NEXT              INITIALIZE SETBS SUBROUTINE
         LW,R     PLENGTH           KEEP LENGTH FOR REFERANCE
         STW,R    ILENGTH
         SPACE
FP2      CALL     SETBS             GET BA(NEXTITEM) AND PLENGTH
         B        NO:HIT            NO MORE, RESTORE AND QUIT
         LW,R     ILENGTH           GOT NEXT ITEM
         CW,R     PLENGTH           TEST LENGTHS
         BNE      FP2               MISMATCH, TRY NEXT ITEM
         SPACE
*        ITEM SIZE IDENTICAL. SET UP FOR CBS BY MOVING 'BOG' BITS
*        FROM BUFFER ITEM TO PROCITEM SINCE THESE ARE IRREVELENT
*        FOR ITEM COMPARISON.
         SPACE
         LW,R5    NEXT              BA(BUFFER ITEM)
         LI,R3    X'E0'             BOG BITS MASK
         LB,R2    0,R5              FLAGBYTE OF BUFFER ITEM
         LB,R4    HOLDFLAG          ORIGINAL FLAG BYTE
         STS,R2   R4                ALTER BOG BITS
         STB,R4   PROCITEM          BOG NOW SAME
         SPACE
*        SET UP CBS PARAMETERS
         SPACE
         LI,R2    BA(PROCITEM)      CBS 'FROM'
         LW,R3    NEXT              CBS 'TO'
         STB,R    R3                CBS  'COUNT'
         CBS,R2   0                 COMPARE  ITEMS
         BNE      FP2               NO HIT, TRY NEXT ITEM
         LW,R     HOLDFLAG          HIT. RESTORE AND RETURN
         STW,R    PROCITEM          RESTORE
         RETURN   2                 RETURN TO CALL+2 (HIT)
         SPACE
NO:HIT    LW,R    HOLDFLAG          RESTORE
         STW,R    PROCITEM
         RETURN                     RETURN TO CALL+1 (NO HIT)
         PAGE
         SPACE
*        SUBROUTINE TO PROCESS 'RP' COMMAND IN R10BUF
*        AND BUILD PROCITEM
         SPACE
BUILDPROC ENTER
         LI,R1    0                 INPUT INDEX
         LI,R2    2                 OUTPUT INDEX
         STW,R1   PROCITEM          FIRST 2 BYTES 0, REST BLANK
         FILL,1   PROCITEM,2,20,' ' BLANK BYTES 2-20
         LW,R4    LENGTH OF R10BUF
         AI,R4    1
         STB,R1   R10BUF,R4         PLACE END MARKER
         STB,R1   RSW               RESET 'REMOVE' SWITCH
         LI,R4    0                 TEXTC COUNT ACCUMULATOR
         LI,R5    0                 ACCOUNT COUNT ACCUMULATOR
         SPACE
BP1      LB,R     R10BUF,R1         GET NEXT BYTE
         BEZ      BOG4              END MARKER DETECTED
         AI,R1    1                 STEP INPUT INDEX
         SPACE
         CI,R     ' '               BLANK
         BE       BP1               IGNORE BLANK
         CI,R     '/'               SLASH
         BE       BPSLASH           SLASH DETECTED
         CI,R     ','               COMMA
         BE       BOG               BOG OR R TO FOLLOW
         CI,R     '.'               PERIOD
         BE       BPERIOD           ACCOUNT TO FOLLOW
         SPACE
*        IS THIS BYTE LEGAL FOR PROCESSOR NAME
         SPACE
         LI,R7    NTERMS            NR. OF ILLEGAL CHARACTERS
         CB,R     TERMS,R7
         BE       BADCH             ILLEGAL CHARACTER MESSAGE
         BDR,R7   %-2               LOOP
         SPACE
         STB,R    PROCITEM,R2       GOOD BYTE. STORE IT IN ITEM
         AI,R4    1                 INCREMENT TEXTC
         AI,R2    1                 INCREMENT OUTPUT INDEX
         CI,R4    11                TEST LENGTH OF NAME
         BG       TOOLONG           LENGTH ERROR MESSAGE
         B        BP1               HAVE ANOTHER LOOP
         SPACE
*        END MARKER DETECTED
         SPACE
BPEND    LI,R7    1                 INDEX TO STORE TEXTC BYTE
         STB,R4   PROCITEM,R7       INTO PROCITEM
         MTW,0    R4                ANY CHARACTERS IN NAME
         BEZ      SYNTAX            ERROR MESSAGE
         SPACE
*        SET PLENGTH = TEXTC+2 IF NO 'A' BIT, OR
*                      TEXTC+10 IF 'A' BIT SET
         SPACE
         AI,R4    2                 BASIC PLENGTH
         LW,R1    ABIT              WAS ACCT SPECIFIED
         CW,R1    PROCITEM
         BAZ      %+2               YES
         AI,R4    8                 PLENGTH+8
         STW,R4   PLENGTH           TOTAL LENGTH OF ITEM
         SPACE
         MTB,0    RSW               WAS REMOVE OPTION GIVEN
         BNEZ     RETURN            YES, GO TO CALL+1
RETURN2  RETURN   2                 NO, GO TO CALL+2
RETURN   RETURN
         SPACE
*        SLASH DETECTED IN NAME INDICATING PARTIAL NAME SPECIFIED
         SPACE
BPSLASH  LW,R7    PROCITEM          FLAG WORD
         OR,R7    PBIT              SET 'P' BIT IN FLAG
         STW,R7   PROCITEM
         SPACE
BPS2     LB,R     R10BUF,R1         GET NEXT BYTE
         AI,R1    1                 INCREMENT INPUT INDEX
         CI,R     ' '               BLANK
         BE       BPS2              IGNORE BLANKS
         CI,R     ','               COMMA
         BE       BOG               PROCESS BOG OPTIONS
         CI,R     '.'               ACCOUNT PRESENT
         BE       BPERIOD           YES
         CI,R     0                 END MARKER
         BNE      SYNTAX            ILLEGAL CHARACTER DETECTED
         B        BOG4              END MARKER DETECTED
         SPACE
*        PROCESS ACCOUNT FIELD
         SPACE
BPERIOD  LW,R7    PROCITEM          FLAG WORD
         OR,R7    ABIT              SET 'A' (ACCT) BIT IN FLAG
         STW,R7   PROCITEM
         SPACE
BPER2    LB,R     R10BUF,R1         GET NEXT BYTE
         AI,R1    1                 INCREMENT INPUT INDEX
         CI,R     ' '               BLANK
         BE       BPER2             IGNORE BLANK
         CI,R     ','               END OF ACCT WITH BOG TO FOLLOW
         BE       BPER4             YES
         CI,R     0                 END MARKER
         BE       BPER6             YES
         LI,R7    NTERMS            TEST CHARACTER LEGALITY
         CB,R     TERMS,R7          FOR ACCOUNT NAME
         BE       BADCH             ILLEGAL CHARACTER MESSAGE
         BDR,R7   %-2               LOOP
         STB,R    PROCITEM,R2       GOOD BYTE, STORE IT IN ITEM
         AI,R2    1                 INCREMENT OUTPUT INDEX
         AI,R5    1                 INCREMENT ACCT ACCUMULATOR
         CI,R5    8                 TEST ACCT LENGTH
         BG       TOOLONG           MORE THAN 8. ERR MESSAGE
         B        BPER2             LOOP
         SPACE
BPER4    CI,R5    0                 ANY CHARACTERS IN ACCT FIELD
         BE       SYNTAX            NO. ERROR MESSAGE
         B        BOG               OK. PROCESS BOG OPTIONS
         SPACE
BPER6    CI,R5    0                 ANY CHARACTERS IN ACCT FIELD
         BE       SYNTAX            NO. ERROR MESSAGE
         B        BOG4              GO SET BOG BITS
         SPACE
*        PROCESS BOG/R OPTIONS AND SET FLAG BITS
         SPACE
BOG      LB,R     R10BUF,R1         GET NEXT BYTE
         BEZ      BOG4              END MARKER DETECTED
         AI,R1    1                 INCREMENT INPUT INDEX
         CI,R     ','               COMMA
         BE       BOG               IGNORE COMMA
         CI,R     ' '               BLANK
         BE       BOG               IGNORE BLANK
         CI,R     'B'
         BE       SETB
         CI,R     'O'
         BE       SETO
         CI,R     'G'
         BE       SETG
         CI,R     'R'               'REMOVE' OPTION
         BNE      SYNTAX            ILLEGAL OPTION
         LW,R1    BOGBITS           R GIVEN. BOG GIVEN ALSO
         CW,R1    PROCITEM
         BANZ     SYNTAX            BOTH BOG AND R. ERROR
         MTB,1    RSW               SET 'REMOVE' SWITCH
         B        BPEND
         SPACE
SETB     LW,R7    BBIT
         B        SET
SETO     LW,R7    OBIT
         B        SET
SETG     LW,R7    GBIT
SET      STS,R7   PROCITEM          INTO FLAG
         B        BOG               LOOP FOR ANOTHER OPTION
         SPACE
BOG4     LW,R7    PROCITEM          IF NO BOG BITS ARE SET,
         AND,R7   BOGBITS           SET ALL THREE BY DEFAULT
         BCR,3    %+2               BRANCH IF AND RESULTS IN ZERO
         B        BPEND
         LW,R7    PROCITEM
         OR,R7    BOGBITS           SET BOG
         STW,R7   PROCITEM
         B        BPEND
         PAGE
*        SUBROUTINE TO REMOVE THE ITEM REFERED TO BY 'NEXT'
*        AND SQUEEZE RECORD BACK INTO SHAPE
         SPACE
SQUEZPROC ENTER
         LW,R     PROCBUF           BANNER WORD WITH ITEM COUNT
         AND,R    =X'01FF0000'      JUST ITEM COUNT NEEDED
         SW,R     =X'00010000'      DECREMENT ITEM COUNT
         BEZ      SQ4               IF THIS WAS LAST
         LW,R1    =X'01FF0000'
         STS,R    PROCBUF           UPDATED BANNER RETURNED
         SPACE
*        SET UP REGISTERS TO SQUEZE OUT ITEM
*          R2=TO=NEXT
*          R3=FROM=NEXT+PLENGTH
*          R4=END=WHEN FROM=BA(LASTBYTE IN BUF)+1
         SPACE
         LW,R2    NEXT              R2= BA(TO)
         LW,R3    PLENGTH
         AW,R3    NEXT              R3= BA(FROM)
         LW,R4    PROCBUF
         AND,R4   =X'FFFF'
         AI,R4    BA(PROCBUF)       R4=END BA
         SPACE
SQ2      CW,R3    R4                DONE YET
         BGE      SQ3               YES, GO CHANGE COUNT
         LB,R     0,R3
         STB,R    0,R2
         AI,R3    1
         AI,R2    1
         B        SQ2               LOOP
         SPACE
SQ3      LW,R     PROCBUF
         SW,R     PLENGTH           NEW BANNER INDEX=OLD-PLENGTH
         STW,R    PROCBUF
         RETURN   2                 NORMAL RETURN; CALL+2
         SPACE
SQ4      LI,R     4
         STW,R    PROCBUF           CLEAR BANNER
         RETURN                     'DONE' RETURN, CALL+1
         PAGE
MCTEST   ENTER
         LI,R     X'10'             MC BIT 27 IN :USERS+5
         CW,R     :USERS+5          IS MC BIT SET
         BAZ      RETURN2           NO, RETURN TO CALL+2
         RETURN                     YES, RETURN TO CALL+1
         SPACE    2
MCGEN    ENTER
         LCI      0
         STM,R    SAVEREG1
         LI,R3    X'1C'             BITS 27,28,29  (MC,XO AND RP)
         LI,R2    -1                ONE BITS
         STS,R2   :USERS+5          INTO USERS RECORD
         LCI      8                 MOVE THE DEFAULT :PROC ITEM
         LM,R     MC:PROC
         STM,R    PROCBUF
         LCI      0
         LM,R     SAVEREG1
         RETURN
         SPACE
*        THE DEFAULT :PROC ITEM GENERATED AS A RESULT OF
*        ISSUING THE MC OPTION AS A RESOURCE
         SPACE
*        AS IF: RP=ANLZ,O;RP=DELTA,O;RP=ELLA,O;RP=OLTEST,O
         SPACE
MC:PROC  DATA     X'0004001F'
         DATA     X'4004C1D5'
         DATA     X'D3E94005'
         DATA     X'C4C5D3E3'
         DATA     X'C14004C5'
         DATA     X'D3D3C140'
         DATA     X'06D6D3E3'
         DATA     X'C5E2E300'
         PAGE
*        THIS SUBROUTINE LISTS ALL THE ITEMS CURRENTLY IN PROCBUF
         SPACE
PRINTPROC ENTER
         LI,R     0
         STW,R    NEXT              INITIAL SETBS SUBROUTINE
PP2      CALL     SETBS             GET BA(NEXTITEM)
         B        RETURN            NONE OR DONE, RETURN TO CALL+1
         FILL,1   LL,0,70,' '       BLANK OUT PRINT BUFFER
         LW,R7    NEXT              R7=BA(NEXTITEM)
         LB,R6    0,R7              FLAG BYTE
         LB,R2    0,R7              FLAG BYTE OF NEXT ITEM
         SLS,R2   -5                ISOLATE BOG BITS AS INDEX
         LW,R1    BOGLIST,R2
         STW,R1   LL                BOG OPTIONS INTO PRINT BUFFER
         SPACE
         LI,R2    5                 OUTPUT INDEX
         AI,R7    1                 R7=BA(TEXTC BYTE)
         LB,R3    0,R7              INTO R3 FOR COUNTER
         LW,R4    NEXT              R4=BA(NEXTITEM)
         AI,R4    2                 INPUT INDEX
PP4      LB,R     0,R4              NEXT BYTE OF NAME FIELD
         AI,R4    1                 STEP
         STB,R    LL,R2             INTO PRINT BUFFER
         AI,R2    1                 STEP INDEX
         AI,R3    -1                DECREMENT TEXTC VALUE
         BGZ      PP4               GET ANOTHER BYTE
         CI,R6    8   (P-BIT)       IS IT PARTIAL NAME
         BAZ      PP8               NO
         LI,R     '/'               YES, PRINT SLASH AFTER NAME
         STB,R    LL,R2
         AI,R2    1                 STEP
PP8      CI,R6    X'10'  (A-BIT)    IS ACCOUNT FIELD PRESENT
         BAZ      PP12              NO, PRINT LINE
         LI,R3    8                 YES, 8 BYTES MORE
         LI,R     '.'               PRINT PERIOD BEFORE ACCOUNT
         STB,R    LL,R2
         AI,R2    1                 STEP OUTPUT INDEX
PP10     LB,R     0,R4              GET BYTE OF ACCT FIELD
         AI,R4    1                 STEP
         STB,R    LL,R2             INTO PRINT BUFFER
         AI,R2    1                 STEP
         AI,R3    -1                DECREMENT
         BGZ      PP10              MORE BYTES IN ACCT FIELD
PP12     CALL     PRINTL            PRINT THE LINE AND CLEAR IT
         B        PP2               GO FOR ANOTHER ITEM
         SPACE
BOGLIST  TEXT     '    '            NO BITS SET, ERROR IN PROGRAM
         TEXT     ' ..G'            1
         TEXT     ' .O.'            2
         TEXT     ' .OG'            3
         TEXT     ' B..'            4
         TEXT     ' B.G'            5
         TEXT     ' BO.'            6
         TEXT     ' BOG'            7
         PAGE
*        O P T I O N   H A N D L E R S
         SPACE
*        PROCESS XOS OPTION AND SET BIT 28 IN :USERS+5
         SPACE
XOROUT   EQU      %
         CALL     MCTEST            HAS MC BEEN SAID
           B      MCERROR           YES, PRINT MESSAGE
         LI,R3    X'8'              BIT 28 MASK
XY       LI,R2    -1                ONE BITS FOR 'Y'
         LB,R     R10               Y OR N
         CI,R     'Y'
         BE       SETXO             SET BIT 28=1
         CI,R     'N'
         BNE      ERVALU9           ILLEGAL PARAMETER
         LI,R2    0                 SET BIT 28=0
SETXO    STS,R2   :USERS+5          INTO USERS RECORD
         B        UDONE             BACK TO CONTROL MODULE
         SPACE
*        PROCESS SE OPTION SETTING BIT 30 OF :USERS+5
         SPACE
SEROUT   LI,R3    X'2'              BIT 30 MASK
         B        XY                PROCESS AS IN XO OPTION
         SPACE
*        PROCESS PM OPTION SETTING BIT 0 OF :PROCS BANNER WORD
         SPACE
PMROUT   EQU      %
         CALL     MCTEST            HAS MC BEEN SAID
           B      MCERROR           YES, PRINT MESSAGE
         LI,R2    0
         LB,R     R10               ALLOWED OR DISALLOWED (A OR D)
         CI,R     'A'
         BE       SETPM             SET PM BIT TO ZERO
         LI,R2    -1                ONE BITS
         CI,R     'D'
         BNE      ERVALU9           ILLEGAL PARAMETER
SETPM    LW,R3    =X'80000000'      PM BIT MASK
         STS,R2   PROCBUF           INTO :PROCS BANNER WORD
         B        UDONE             BACK TO CONTROL MODULE
         PAGE
*        PROCESS RP OPTION, ADDING,MODIFYING OR DELETING
*        PROCESSOR NAME FROM :PROCS RECORD IN PROCBUF
         SPACE
RPROUT   EQU      %
         CALL     MCTEST            HAS MC BEEN SAID
           B      MCERROR           YES, PRINT MESSAGE
         CALL     BUILDPROC         FROM COMMAND LINE TO PROCITEM
         B        REMPROC           'R' OPTION SPECIFIED. REMOVE IT
         LW,R1    PLENGTH           HOLD IT
         STW,R1   HOLDPL
         CALL     FINDPROC          IS IT ALREADY IN RECORD
         B        ADDNEW            NOT PRESENT, ADD IT TO END
         LW,R1    NEXT              R1=BA(LOCATED ITEM)
         LB,R     PROCITEM          BOG BYTE OF ITEM TO MODIFY
         STB,R    0,R1              MODIFY EXISTING ITEM
         B        UDONE             BCK TO CONTROL MODULE
         SPACE
ADDNEW   EQU      %
         LW,R1    HOLDPL
         STW,R1   PLENGTH
         CALL     ADDPROC           ADD ITEM TO END OF RECORD
         B        PROCFULL          NO MORE SPACE. NOT ADDED
         LI,R2    -1                ONE BITS
         B        SETRP             SET THE PROC PRESENT BIT
         SPACE
REMPROC  CALL     FINDPROC          IS IT THERE TO REMOVE
         B        UDONE             NO, BACK TO CONTROL
         CALL     SQUEZPROC         YES, DELETE AND REPACK RECORD
         B        NOWEMPTY          NONE LEFT AFTER REMOVAL
         B        UDONE             DONE OK. BACK TO CONTROL
         SPACE
NOWEMPTY LI,R2    0                 RESET THE PM BIT
         CAL1,1   KILLP             DELETE :PROC RECORD IF PRESENT
SETRP    LI,R3    4                 BIT 29 (RP) MASK
         STS,R2   :USERS+5          INTO USERS RECORD
         B        UDONE             BACK TO CONTROL MODULE
         PAGE
*        THIS SUBROUTINE CALLED FROM SUPER1 DURING EXECUTION
*        OF THE PRINT OPTION.  IT PRINTS THE DATA FOR THE
*        NEW FEATURES: XO, TP, RP AND SE
         SPACE
MOREPRINT ENTER                     FROM SUPER2
         SPACE    2
PXO      MTW,0    FL:ALL
         BNEZ     PXO2
         MTW,0    FL:XO             EXECUTE  ONLY SYSTEM PROCESSORS
         BEZ      PSE               NO, GO TO NEXT OPTION
PXO2     LW,R     :USERS+5          USERS FLAG WORD
         LW,R1    ='XO=Y'
         CI,R     X'8'              XO BIT 28
         BANZ     %+2
         LW,R1    ='XO=N'
         STW,R1   LL                INT PRINT BUFFER
         CALL     PRINTL            PRINT AND CLEAR BUFFER
         SPACE
PSE      MTW,0    FL:ALL
         BNEZ     PSE2
         MTW,0    FL:SE
         BEZ      PRP
PSE2     LW,R     :USERS+5
         LW,R1    ='SE=Y'
         CI,R     X'2'              SE BIT 30
         BANZ     %+2
         LW,R1    ='SE=N'
         STW,R1   LL
         CALL     PRINTL
         SPACE
PRP      MTW,0    FL:ALL
         BNEZ     PRP2
         MTW,0    FL:PL             PROCESSOR LIST
         BEZ      RETURN            NO, BACK TO SUPER2
PRP2     LW,R     :USERS+5          USERS FLAG WORD
         CI,R     X'4'              RP BIT 29
         BANZ     PRP4
         LCI      7                 NO PROCESSOR LIST FOR THIS USER
         LM,R     NOPROC
         STM,R    LL
         CALL     PRINTL            PRINT AND CLEAR BUFFER
         RETURN                     BACK TO SUPER2
PRP4     LW,R     PROCBUF           :PROCS BANNER WORD
         CW,R     =X'80000000'      PM BIT 0 IN PROCBUF
         BAZ      PALLOW
         LCI      6
         LM,R     DISA              'DISALLOWED PROCESSORS'
PRP6     STM,R    LL                INTO PRINT BUFFER
         CALL     PRINTL            PRINT AND CLEAR BUFFER
         CALL     PRINTPROC         PRINT THE PROCESSOR LIST
         RETURN                     BACK TO SUPER3
PALLOW   LCI      5
         LM,R     ALLOW             'ALLOWED PROCESSORS'
         B        PRP6              STORE,PRINT AND RETURN
DISA     TEXT     'DISALLOWED PROCESSORS: '
ALLOW    TEXT     'ALLOWED PROCESSORS: '
NOPROC   TEXT     'NO PROCESSOR CONTROL ENTRIES'
         PAGE
*        SUBROUTINE CALLED FRPM SUPER1 TO MOVE :PROCS DEFAULT
*        BUFFER INTO PROCBUF.  IF THERE IS NO DEFAULT BUFFER,
*        CREATE ONE AND RETURN AN INITIALIZED PROCBUF
         SPACE
PDEF2BUF ENTER
         MTW,0    DMODE             HAS DEFAULT CMND BEEN ISSUED
         BEZ      PD2               NO, SEND INITIALIZED PROCBUF
         MTW,0    DEFBUF            HAS DEFBUF BEEN INITIALIZED
         BNEZ     MV                YES, MOVE BUFFER
         SPACE
         M:GP     1                 GET PAGE FOR DEFAULT BUFFER
         BCS,8    NOPAGE            ERROR MESSAGE IF NO PAGE
         STW,SR2  DEFBUF            =WA(DEFAULT BUFFER)
PD2      LI,R2    4                 INITIAL VALUE FOR PROCBUF
         STW,R2   PROCBUF
         RETURN                     BACK TO SUPER1
         SPACE
MV       LW,R2    *DEFBUF           BANNER WORD OF PROC RECORD
         AND,R2   =X'FFFF'          SAVE ONLY BYTE COUNT
         SPACE
         LW,R3    DEFBUF            =WA(DEFAULT BUFFER)
         OR,R3    LBR3              R3= LB,R DEFBUF,R2
         SPACE
MV2      EXU      R3  (LB,R DEFBUF,R2)
         STB,R    PROCBUF,R2
         BDR,R2   MV2
         LW,R     *DEFBUF
         STW,R    PROCBUF
         MTW,1    PDEFSW            SET SWITCH TO BYPASS :PROC READ
         RETURN
LBR3     LB,R     0,R2
         PAGE
*        SUBROUTINE CALLED FROM SUPER1 TO MOVE CURRENT RECORD
*        IN PROCBUF INTO ITS DEFAULT BUFFER
PBUF2DEF ENTER
         LW,R2    PROCBUF           BANNER WORD
         AND,R2   =X'FFFF'          SAVE ONLY BYTE COUNT
         SPACE
         LW,R3    DEFBUF            R3=WA(DEFAULT BUFFER)
         OR,R3    STBR3             BUILD INSTR FOR LATER
         SPACE
PB2      LB,R     PROCBUF,R2
         EXU      R3  (STB,R DEFBUF,R2)
         BDR,R2   PB2
         LW,R     PROCBUF
         STW,R    *DEFBUF
         RETURN
STBR3    STB,R    0,R2
         PAGE
*        ERROR/ABNORMAL ROUTINE FOR :PROCS FILE (VIA M:BO DCB)
         SPACE
PERABN   LB,R2    SR3               ERROR CODE
         CI,R2    X'4C'             FILE BUSY
         BE       PWAIT             YES, WAIT A WHILE AND TRY AGAIN
         CI,R2    X'06'             END OF FILE
         BE       RPB               YES, FAKE A NULL RECORD
         CI,R2    X'43'             NO SUCH KEY IN FILE
         BE       RPB               NONE, FAKE IT WITH NULL RECORD
         CI,R2    X'03'             NO SUCH FILE AS :PROCS
         BE       MAKEP             NONE, GO BUILD IT
         M:MERC                     LET MONITOR PRINT MESSAGE
         M:EXIT
PWAIT    M:WAIT   10                ONE SECOND NAP
PW1      AI,SR1   -1                SR1=WA(OFFENDING CAL)
         B        *SR1              BACK TO THE CAL
         SPACE
RPB      LI,R2    X'04'             INITIAL :PROCS BANNER
         STW,R2   PROCBUF           IT'LL THINK ITS GOT A NULL REC.
         B        *SR1              RETURN TO CAL+1
         SPACE
MAKEP    M:OPEN   M:BO,(FILE,':PROCS',':SYS'),;
                  (KEYED),(DIRECT),(OUT),(SAVE),;
                  (ABN,PERABN),(ERR,PERABN),(KEYM,21)
         M:CLOSE  M:BO,(SAVE)
         B        PW1               RETURN TO THE CAL
         PAGE
*        SUBROUTINES CALLED FROM SUPER1 TO WRITE :PROCS FILE
         SPACE
PWRITE   ENTER
         STD,R    HOLDR0R1
         LW,R1    WR
         B        WRX
         SPACE
PMODWR   ENTER
         STD,R    HOLDR0R1
         LW,R1    WRM
WRX      LW,R     PROCBUF
         AND,R    =X'FFFF'
         CI,R     X'4'              INITIAL (EMPTY) VALUE
         BE       WRET              EMPTY, DON'T WRITE
         STW,R    PSIZE
         EXU      R1                DO THE PROPER CAL
WRET     LD,R     HOLDR0R1
         RETURN
WR       CAL1,1   PWRITERC          WRITE NEW
WRM      CAL1,1   PMODWRIT          WRITE MODIFIED
         RETURN
         PAGE
*        SUBROUTINE CALLED FROM SUPER1 TO CONSTRUCT A FILE
*        KEY FOR READING THE :PROCS FILE.  :USERS HAS THE
*        NAME AND ACCOUNT
         SPACE
BUILDKEY ENTER
         LCI      4
         STM,R    SAVEREG1
         LI,R1    BA(:USERS)        INPUT INDEX
         LI,R2    1                 INITIAL INDEX FOR 'KEY'
         LI,R3    8                 MAX BYTES IN FIELD
         CALL     GKSUB             MOVE IN NAME
         SPACE
         LI,R1    BA(:USERS+2)      ACCT FIELD IN :USERS
         LI,R3    11                MAX BYTES IN ACCOUNT
         CALL     GKSUB             MOVE OVER THE ACCOUNT
         AI,R2    -2                CONVERT INDEX TO TEXTC COUNT
         STB,R2   KEY               INTO KEY TEXTC BYTE
         LCI      4
         LM,R     SAVEREG1
         RETURN                     BACK TO SUPER1
         SPACE
GKSUB    LB,R     0,R1              GET NEXT BYTE
         STB,R    KEY,R2            INTO KEY
         AI,R1    1
         AI,R2    1                 INCREMENT INDICES
         CI,R     ' '               FIELD DELIMITER
         BE       *R15              YES, BACK TO BUILDKEY DRIVER
         BDR,R3   GKSUB             HAVE ANOTHER BYTE IF MORE
         LI,R     ' '               END OF FIELD. FOLLOW WITH BLANK
         STB,R    KEY,R2
         AI,R2    1                 INCREMENT OP INDEX
         B        *R15              RETURN TO DRIVER
         SPACE
**************************************************************
         SPACE
         END

