         SYSTEM   TRIGO
DATA     CSECT    0
CODE     CSECT    1
*
*        WATCH AND WARP COUPLING ON D00 SYSTEMS
*
         DEF      VERMSG            THE VERSION TEXT
VERMSG   TXTC     '...Grindel-VII...'
*
*        SYSTEM AND SCANNER REFERENCES
*
         REF      ACNCFU            CFU AREA
         REF      ARGC              GET TEXTC ARGUMENT ROUTINE
         REF      ARGH              GET HEX ARGUMENT ROUTINE
         REF      ARGN              GET DECIMAL ARG ROUTINE
         REF      ARGT              GET TEXT ARGUMENT ROUTINE
         REF      AVRID             TAPE TABLES IN ROOT
         REF      AVRTBL            MORE TAPE TABLES
         REF      AVRTBLSIZ         AND HOW BIG THEY ARE
         REF      BGRCFU            CFU ADDRESSES
         REF      BLOCKER           MP BLOCK TO MASTER IN ROOT
         REF      C:TIC             TIME IN ROOT
         REF      COCLN             COC LINE NUMBER OFFSET IN M:UC
         REF      DECOUPLE%         LINE DECOUPLING ROUTINE IN ROOT
         REF      E:OFF             SCHED OFF EVENT
         REF      E:SL              SCHED SLEEP EVENT
         REF      GRANPACK          #PACK SPACE LEFT
         REF      GRANRAD           #RAD SPACE REMAINING
         REF      GRANSYM           #SYMBIONT SPACE REMAINING
         REF      HUH               SCANNER COMPLAIN ROUTINE
         REF      J:INTENT          BREAK INTERRUPT ADDRESS IN JIT
         REF      J:JIT             THE JIT'S ADDRESS
         REF      J:TELFLGS         FLAGS AND GOODIES
         REF      J:XPSD            XPSD BLOCK FOR CAL3
         REF      JB:PRIV           PRIVELIGE BYTE
         REF      KEYINBUF          KEYIN BUFFER IN ROOT
         REF      LB:UN             COC LINE TO USER # ROOT TABLE
         REF      LNOL              #COC LINES IN SYSTEM
         REF      LPART             # OF BATCH PARTITIONS
         REF      M:DO              GRIPE DCB
         REF      M:EI              FILE DCB
         REF      M:LL              OUT DCB
         REF      M:LO              OUT DCB
         REF      M:UC              TERMINAL DCB
         REF      M:XX              FUNNY DCB IN JIT
         REF      MAXG              # OF GHOSTS MAX IN SYSTEM
         REF      MODE2             COC TABLES
         REF      MODE4             COC TABLES
         REF      MODE5             COC TABLES
         REF      NEWQ              ROOT IO DRIVER
         REF      OBUF              SCANNER OUTPUT BUFFER
         REF      P:NAME            SHARED PROC/OV NAME TABLES
         REF      PLB:USR           PARTITION/USER ROOT TABLE
         REF      PLD:ACT           PARTITION/ACCOUNT TABLE
         REF      PLH:SID           PARTITION/SYSID TABLE
         REF      PNAMEND           END OF P:NAME TABLE
         REF      PRDCRM            JIT DISC SPACE FOR USER
         REF      PRDPRM            JIT RAD SPACE
         REF      QUEUE1            ROOT I/O ROUTINE
         REF      RCVRCNT           RECOVER COUNT/MONDMP NUMBER
         REF      S:BFIS            #BATCH FILES WAITING
         REF      S:BUAIS           # BATCH USERS ALLOWED
         REF      S:BUIS            # BATCH JOBS RUNNING
         SREF     S:COUP            MAGIC COUPLING CELL
         REF      S:CUIS            # OF USERS IN SYSTEM
         REF      S:CUN             CURRENT USER # ON THIS CPU
         REF      S:DSPKEY          RBBAT QUEUE DISPLAY NAME
         REF      S:GJOBACN         TABLE OF GJOB ACCOUNTS
         REF      S:GJOBTBL         TABLE OF GHOST NAMES IN ROOT
         REF      S:GUIS            # OF GHOSTS RUNNING
         REF      S:OUIS            # OF ONLINE USERS
         REF      S:SET:            I DONT REMEMBER.
         REF      SB:GJOBUN         GHOST USER #'S
         REF      SMUIS             MAX # OF USERS IN SYSTEM
         REF      SNULL             SCHED NULL STATE
         REF      T:GJOBSTRT        SCHED START GHOST ROUTINE
         REF      T:REG             SCHED REPORT EVENT AND GIVE UP
         REF      T:RUE             SCHED REPORT USER EVENT
         SREF     TIE               COUPLING TABLE
         REF      TSTACK            STACK IN THE JIT
         REF      U:MISC            SLEEP TIME FOR WAITING
         REF      UB:ACP            USER COMMAND PROC # TABLE
         REF      UB:APR            USER PROCESSOR # TABLE
         REF      UB:OV             USER MON OVERLAY # TABLE
         REF      UB:PCT            USER PAGE COUNT
         REF      UB:PRIO           USER EXECUTION PRIO
         REF      UB:PRIOB          USER BASE EXECUTION PRIORITY
         REF      UB:US             USER STATE TABLE
         REF      WAIT              WAIT ROUTINE (ROOT?)
         REF      WHUT              SCANNER COMPLAINT ROUTINE
*
*        MASKS
*
         REF      X1,Y03,M7,M8,M9,M15,M17
         TITLE    'WATCH AND WARP COUPLING ON D00 SYSTEMS'
*
*
*        CAL3 PROCS FOR MODE SWITCHING
*
MASTER   CNAME    0
SLAVE    CNAME    1
ENABLE   CNAME    2
DISABLE  CNAME    3
BLOCK    CNAME    4
         PROC
LF       EQU,0    %
         DO       NUM(AF)=0
         CAL3,NAME %+1              DEFAULT ADDRESS IS %+1
         ELSE
         CAL3,NAME AF(1)            OR RETURN TO ADDRESS GIVEN.
         FIN
         PEND
         PAGE
CRAB     CNAME    0
SCREAM   CNAME    1
MUMBLE   CNAME    2
         PROC
         LOCAL    CRAP
LF(1)    LI,D3    CRAP              ADDRESS OF THING
         LIST     0
         LI,D4    S:NUMC(AF(1))     TEXT COUNT
         DO       NAME=2
         CAL1,1   WRTLO             MUMBLE THRU LO
         ELSE
         CAL1,1   WRTDO             SCREAM AND CRAB THRU DO.
         FIN
         DO1      NAME=1
         CAL1,9   3                 DIE RIGHT HERE FOR SCREAM.
         USECT    DATA
CRAP,LF(2) TEXT   AF(1)             PUT IN THE TEXT.
         USECT    CODE
         LIST     1
         PEND
*
*
WRTDO    GEN,8,24 X'11',M:DO
         DATA     X'34000000'       BUF,SIZE,BTD
         GEN,1,31,1,31 1,D3,1,D4    BUF AND SIZE
         DATA     0
WRTLO    GEN,8,24 X'11',M:LO
         DATA     X'34000000'
         GEN,1,31,1,31 1,D3,1,D4
         DATA     0
         PAGE
*
*        SOME DATA AREAS, AND USEFUL CONSTANTS...
*
         USECT    DATA
STIE     REZ      64                SPACE FOR 255 LINES.
SMODE4   REZ      64                AND THE SAME FOR MODE4.
*
*        BYFLG    SEZ TO PRINT NUMBERS OR NAMES....
*
BYFLG    DATA     1                 0=NUMBER, 1=NAME.
*
GRABFLG  DATA     0                 GRAB/SPY FLAG
OBP      DATA     0                 OUTPUT BUFFER POINTER
*
*        NOTE THAT THE FOLLOWING BOUND FORCES BYBUF+1 TO DWORD BOUNDARY....
*
         BOUND    8
TONAME   REZ      2                 THIS IS DWORD, SO IS BYBUF+1,2....
KEY      REZ      1                 THE KEY
*
BYBUF    REZ      20                BUFFER FOR :LOGD RECORD
*
*        THE FOLLOWING TABLES ARE USED TO REDUCE THE # OF READS WE DO
*        TO THE :LOGD FILE BY REMEMBERING USER NAMES BY LINE AND USER #...
*
         BOUND    8
L:UNAME  RES      256*2             MAX 256 USERS, 2 WDS FOR NAME.
L:UN     RES      64                BYTE TABLE OF USER # PER LINE
U:LN     RES      64                BYTE TABLE OF LINE # PER USER #
         USECT    CODE
         BOUND    8
CTIE     DATA     BA(TIE)           COMPARE OR COPY TIE AND STIE
         GEN,8,24 LNOL,BA(STIE)
CMODE4   DATA     BA(MODE4)
         GEN,8,24 LNOL,BA(SMODE4)
         PAGE
*
*        PGMINIT
*                 SETS UP THINGS. WE MUST BE ABLE TO GO MASTER, AND
*        BE LOADED ON THE RIGHT SYSTEM, AND SUCH STUFF. WE INIT THE
*        COPIES OF MODE4 AND TIE ALSO.....
*
         DEF      PGMINIT
PGMINIT  EQU      %                 THIS IS THE START OF THINGS.
         LI,R     0
         STW,R    MFLAG             CLEAR MASTER PERMISSION FLAG
         LI,RU1   512+128
         STW,R    L:UNAME-1,RU1
         BDR,RU1  %-1               ZAP OUT TABLES....
         M:TRAP   (IGNORE,BOTH)     TURN OFF THESE PESKY THINGS.
         M:CAL    (IA,CAL3S),MASTER CONNECT CAL3 HANDLER.
         BCR,8    PGM1              B/OK TO HERE.
PGMB     M:CAL    (IA,CAL3X),SLAVE  SLAVE CAL3 HANDLER
         PUSH     L                 SAVE RETURN POINT
         B        SPYINIT           AND GO INIT SPY SECTION
*
PGM1     CI,SR2   QUEUE1            ARE THINGS THE SAME??
         BNE      PGMB
         CI,SR3   NEWQ
         BNE      PGMB              VERIFY STUFF...
         PUSH     L                 SAVE RETURN
         MTW,-1   MFLAG             REMEMBER WE CAN GO MASTER.
         LI,L     SPYINI1           RETURN THRU PHASE 2 INIT
         BLOCK    CPYTIE1           GO MASTER BLOCKED TO COPY TIE.
         PAGE
*
*        CAL3S
*                 IS THE CAL3 SERVICE ROUTINE. THE SERVICES SUPPORTED
*        ARE:
*                 MASTER (R=0)      GO TO ADDR IN MASTER MODE
*                 SLAVE  (R=1)      GO TO ADDR IN SLAVE MODE
*                 ENABLE (R=2)      GO TO ADDR ENABLED
*                 DISABLE(R=3)      GO TO ADDR DISABLED
*                 BLOCK  (R=4)      INSURE RUNNING ON MASTER CPU
*        THE MASTER CAL RETURNS ENABLED. THE R FIELD OF THE CAL3 GETS
*        US THE FUNCTION INDEX, WHICH WE TURN INTO A PSD ADDRESS.
*        THE SERVICE ROUTINE IS ENTERED MASTER DISABLED.
*
CAL3S    PUSH     4,0               SAVE R0-R3 FOR WORKING ROOM.
         LW,R     *J:XPSD           GET THE CAL3 INSTRUCTION
         LW,1     =X'00F00000'      R MASK
         AND,1    R
         SLS,1    -20
         CI,1     4                 SEE IF TOO BIG
         BLE      %+2
         LI,1     1                 IF IT IS, RETURN SLAVE.....
         LI,0     PSDM              BLOCK RETURNS MASTER.......
         EXU      CAL3F,1           SET UP FOR DOING IT
         LI,RU1   X'1FFFF'          STS MASK
         STS,R    *0                STORE IN NEW IA IN PSD
         STW,0    J:XPSD+1          SAVE THIS THING
         PULL     4,0
         LPSD,0   *J:XPSD+1         AND SPLIT.
CAL3F    LI,0     PSDM
         LI,0     PSDS
         LI,0     PSDM
         LI,0     PSDD
         BAL,1    BLOCKER           MP BLOCK TO MASTER CPU
         PAGE
         USECT    DATA
         BOUND    8
*
*        PSD BLOCKS- THE INSTRUCTION ADDRESS IS POKED IN.
*
PSDM     DATA     X'00400000',0     MASTER MAPPED
PSDS     DATA     X'00C00000',0     SLAVE MAPPED
PSDD     DATA     X'00400000',X'07000000'  MASTER MAPPED INHIBITED
         USECT    CODE
*
*        CAL3X
*                 IS ENTERED IF THE USER DOES NOT HAVE MASTER MODE
*        PRIVELIGE. IF THE CAL WAS A SLAVE REQUEST, WE WILL HONOR IT,
*        AND IF NOT, WE ASSUME AN ADDRESS IN L AND WE RETURN ON THAT.
*
CAL3X    PUSH     2,0               SAVE 0 AND 1
         LW,0     *J:XPSD           GET THE OFFENDING INSTRUCTION
         STW,0    TRASH             SAVE TARGET ADDR IN CAL3
         LW,1     =X'00F00000'
         CS,0     SLVCAL            IS OFFENDING ONE A SLAVE CAL?
         BE       CAL3XS            B/YES, WE CAN DO THAT....
         PULL     2,0
         B        0,L               TAKE A LEAP IF NOT.
CAL3XS   PULL     2,0               WE'RE SLAVE ANYWAY, SO
         B        *TRASH            HONOR THE REQUEST.
SLVCAL   SLAVE                      COMPARE AGAINST THIS ONE.
         PAGE
*
*        CPYTIE
*                 SEE IF TIE HAS CHANGED.
*        IF SO, RETURN TO BAL+2 AFTER COPYING IN NEW TABLES. IF UNCHANGED,
*        RETURN TO BAL+1.
*
CPYTIE   DISABLE                    DONT BUG ME.
         LD,R     CTIE              WE WANT TO SEE IF TIE HAS CHANGED
         CBS,R    0
         BE       0,L               RETURN TO BAL+1 IF STILL SAME.
         AI,L     1                 RETURN TO BAL+2
CPYTIE1  DISABLE                    INTERNAL ENTRY-INSURE MASTER MODE
         LD,R     CTIE              THIS ONE RETURNS TO BAL+1
         MBS,R    0                 COPY IN NEW TIE
         LD,R     CMODE4
         MBS,R    0                 AND NEW MODE4
         B        0,L               RETURN TO BAL+2
*
*        SET TO REJECT
*
DONTCOUP M:RCPL                     THIS MAY ALSO DECOUPLE US.
         B        0,L
*
*        DECOUPLE
*
DECPL    M:DECOUPLE
         B        0,L               SPLIT.
         PAGE
*
*        DECOUPLE
*                 DECOUPLE US, OR ANYBODY ELSE FOR THAT MATTER.
*
DECOUPLE PUSH     L
         BAL,L    ARGH
         BCR,8    DECPL1
         EXU      DECPL             JUST DECOUPLE US, I GUESS.
         SLAVE    CMDX              PULL AND SPLIT.
DECPL1   CI,O     LNOL-1            LEGAL LINE #
         BLE      DECPL2
         CRAB     '?'
         B        DECPLL            TO LOOP END
DECPL2   MASTER
         LW,R     O                 COPY LINE #
         CB,O     TIE,O             IS IT REALLY COUPLED????
         BE       %+2
         BAL,SR4  DECOUPLE%         GO TO COC CODE TO DECOUPLE.
DECPLL   BAL,L    ARGH
         BCR,8    DECPL1            LOOP ON ARGS PRESENT
         SLAVE    CMDX              AND SPLIT WHEN THRU.
         PAGE
*
*        ACPLS
*                 ACCEPT COUPLES-CAN FORCE SOMEBODY ELSE INTO ACCEPTING
*        STATE, OR IF NO ARGUMENT(S), SET US TO ACCEPT.
*
ACPL     M:ACPL                     ACCEPT COUPLES CAL FOR US.
ACPLS    PUSH     L
         BAL,L    ARGH              GET HEX ARG
         BCR,8    ACPLS1            B/GOT SOMETHING TO WORK ON.
         EXU      ACPL              ELSE SET US TO.
ACPLX    SLAVE    CMDX              AND SPLIT.
ACPLS1   CI,O     LNOL-1            LEGAL LINE #
         BLE      ACPLS2            B/YUP, GUESS SO.
ACPLSC   CRAB     '?'               WTF WAS THAT????
         B        ACPLSL            B TO LOOP END.
ACPLS2   LC       MODE5,O           CHECK FOR TP LINE
         BCR,8    ACPLS3            B/NOPE
         CRAB     'TP'              COMPLAIN THAT IT'S A TP LINE
         B        ACPLSL            AND GO TO LOOP
ACPLS3   LB,R     LB:UN,O           CHECK FOR USER #
         BE       ACPLSC            BE/CRAB, NO USER
         LC       MODE4,O           SEE IF ACCEPTING NOW
         BCS,8    ACPLSL            B/YUP, INDEED.
         BCS,4    ACPLS4            IF REJECTED, CAN GO SET ACCEPT.
         LC       MODE2,O           CHECK FOR 2741
         BCR,1    ACPLS4            B/OK, NOT 2741
         CRAB     '2741'
         B        ACPLSL
ACPLS4   WD,0     X'37'             DISABLE
         STB,O    TIE,O             CLEAR OUT ANY REJECTS
         LB,T     MODE4,O
         AND,T    =~X'C0'           CLEAR ATTEMPTED AND ALLOW
         AI,T     X'80'             SET ACCEPT
         STB,T    MODE4,O
         WD,0     X'27'             ENABLE
ACPLSL   BAL,L    ARGH              LOOK FOR ANOTHER
         BCR,8    ACPLS1            B/SOMETHING TO DO
         SLAVE    CMDX              B/NOTHING TO DO BUT SPLIT.
         PAGE
*
*        BYNAME
*                 SET TO RUN CHAINS BY NAME
*
BYNAME   LI,R     X'0020'           SEE IF DCB OPEN.
         CH,R     F:WHO
         BANZ     BYNAME1           B/ITS OPEN....
OPNFWHO  M:OPEN   F:WHO,(ERR,WHAM),(ABN,WHAM),(IN,SHARE)
BYNAME1  LI,R     1
         STW,R    BYFLG             OK, WE'RE USING THE FILE.
         B        0,L
WHAM     LI,R     -1
         STW,R    BYFLG             IF OPEN ERRORS, WE CAN'T DO IT.
         PUSH     L
         LI,S     0
         BAL,L    PTC
         TXTC     '...FILE WON''T OPEN, CODE='
         LB,T     SR3
         BAL,L    PHB
         EXU      BCP               PRINT THE CODE.
         B        0,L
*
*        BYNUMBER
*                 SET TO RUN CHAINS BY NUMBER.
*
BYNUMBER LW,R     BYFLG
         BLE      0,L               ALREADY FIXED, SPLIT...
         LI,R     0
         STW,R    BYFLG             SET BACK TO RUN BY # AGAIN.
         B        0,L
         PAGE
*
*        WHODAT
*                 GET THE NAME+ACCT FOR AN ONLINE USER BY LINE #
*        FROM THE :LOGD FILE
*
WHODAT   LI,R     X'0020'
         CH,R     F:WHO             IS THE DCB OPEN????
         BANZ     %+2               B/YUP.
         EXU      OPNFWHO           DOIT ALREADY.
         PUSH     L
WHO1     BAL,L    ARGH              GET USER #
         BCR,8    WHO2
         SLAVE    CMDX              SPLIT IF NO STUFF.
WHO2     CI,O     LNOL-1
         BL       WHO3              LOOKS GOOD SO FAR.
WHOF     CRAB     '?'               WHAT'S THAT????
         B        WHO1              & LOOP PROCESSING ARGS.
WHO3     LB,T     LB:UN,O           GET USER # FOR THAT ONE.
         BE       WHOF              B/NOGOOD.
         OR,T     Y03               MAKE INTO A KEY
         STW,T    KEY
         LI,R     WHOF
         STW,R    F:WHO+3           SET ERR AND ABN THE HARD WAY
         STW,R    F:WHO+4           (BUT DEPENDABLE)
         EXU      READFWHO          READ RECORD INTO BYBUF
         STB,O    U:LN,T            STORE LN BY USER #
         STB,T    L:UN,O            STORE USER # BY LN
         LD,SR1   BYBUF+1
         STD,SR1  L:UNAME,O         AND NAME BY LINE #
         M:WRITE  M:DO,(BUF,BYBUF+1),(SIZE,8)
         B        WHO1              AND LOOK AT NEXT ONE.
         PAGE
*
*        COUPLE   (TO A LINE #)
*
COUPLE   PUSH     L
         BAL,L    ARGH              GET HEX ARG INTO 0
         BCR,8    CPL1
         EXU      ACPL              DEFAULT ACTION IS TO ACCEPT COUPLES.
         B        CMDX
CPL1     CI,O     LNOL
         BG       CPLBL             B/BAD LINE #
         CI,O     0
         BL       CPLBL
         LI,R     X'FF'
         AND,R    M:UC+COCLN
         CW,O     R                 COUPLE SELF????
         BNE      CPL2              B/NOPE, LOOKS OK.
CPLBL    CRAB     'GAAAK....PHOOEY!!!'
         B        CPL3
CPL2     OR,O     =X'1D000000'      MAKE IT A COUPLE FPT
         CAL1,8   O                 ISSUE THE COUPLE REQUEST.
         BCS,4    CPLNT             B/NOT ON OR 2741
         BCS,8    CPLNG             B/REJECTING COUPLES.
         B        CPL3              WE'RE COUPLED NOW.
CPLNT    CRAB     '...NOBODY HOME...'
         B        CPL3
CPLNG    CRAB     '...WONT TALK TO YOU...'
*
CPL3     BAL,L    ARGH              GET ANOTHER MAYBE????
         BCR,8    CPL1              IF MORE ARGS THERE, DOIT...
         B        CMDX              ELSE SPLIT.
         PAGE
*
*        SPY
*                 IS LIKE COUPLE, EXCEPT WE DO IT WITHOUT BENEFIT OF
*        THE CALS....VERY USEFUL TO SPY ON TERMINALS....BREAK CONTROL
*        IS SET UP TO YANK US OUT OF THE COUPLED STATE, BY DECOUPLING...
*
SPY      LI,R     0
         B        SPY0
*
*        GRAB
*                 IS THE SAME, MORE OR LESS, AS SPY, EXCEPT THAT IT
*        SETS US UP READY TO TALK, IN ESC-Z MODE.
*
GRAB     LI,R     1
SPY0     STW,R    GRABFLG           SET THE FLAG VALUE
         PUSH     L                 AND SAVE RETURN.
         BAL,L    ARGH
         BCS,8    CPLBL             THE TOP IS THE SAME AS IN COUPLE...
         CI,O     LNOL-1
         BG       CPLBL             B/BAD
         LI,R     X'FF'
         AND,R    M:UC+COCLN
         CW,R     O
         BE       CPLBL             CRAB IF COUPLE SELF....
         LB,T     MODE2,O           SEE IF TARGET LINE IS A 2741
         CI,T     X'10'
         BANZ     CPLNG             B/YUP, WE WON'T DO IT.
         LB,T     LB:UN,O           GET USER NUMBER ASSOCIATED W LINE
         BE       CPLNT             B/NOBODY HOME.
         MTW,0    GRABFLG           GRAB OR SPY??
         BG       SPY1              B/GRAB, DONT FIDDLE INT ADDR.
         LI,RU1   X'1FFFF'
         LI,R     0
         LW,R     J:INTENT          REMEMBER OLD INT ADDR
         PSW,R    TSTACK            SO WE CAN GET IT BACK LATER.
         LI,R     SPYX
         STS,R    J:INTENT          UPDATE.
SPY1     WD,0     X'37'             DON'T BOTHER ME FOR A WHILE, I'M
         LI,R     X'FF'             BUSY......
         AND,R    M:UC+COCLN        OUR LINE #
         LC       MODE4,O           SEE IF TARGET LINE HAS REJECT POSTED
         BCR,4    %+2
         STB,O    TIE,O             'CAUSE THAT COMPLICATES MATTERS...
         LB,T     TIE,O             TARGET LINE
         LB,TU1   TIE,R             OUR LINE
         STB,T    TIE,R
         STB,TU1  TIE,O             SWAP 'EM.
         LB,T     MODE4,O
         LB,TU1   MODE4,R
         AND,T    =~X'C0'
         AND,TU1  =~X'C0'           CLEAR COUPLE AND ATTEMPT BITS
         AI,T     X'80'
         AI,TU1   X'80'             SET COUPLED.
         STB,T    MODE4,O
         STB,TU1  MODE4,R           WE ARE NOW COUPLED...
         WD,0     X'27'             OK........YOU CAN LOOK NOW....
SPY2     BAL,L    ARGH              ANY MORE TO GRAB ONTO????
         BCS,8    SPY3              B/NOPE, GO ON....
         CI,O     LNOL-1            LEGAL LINE???
         BG       SPY2              B/NOPE, LOOK FOR MORE.
         LB,T     MODE2,O           SEE IF 2741
         CI,T     X'10'
         BANZ     SPY2              B/2741
         LB,T     LB:UN,O
         BE       SPY2              B/NO USER
         B        SPY1              LOOKS OK, HOOK 'EM UP.....
SPY3     MTW,0    GRABFLG           WELL, WHAT DO WE DO??
         BG       SPY4              B/GRAB, GO SET ESC-Z
         M:WAIT   99999             SLEEP, ON SPY ENTRY.
         B        CMDX              BETTER NOT LET SLEEP EXPIRE...
SPY4     LCI      8
         STCF     M:UC+14           SET ESC-Z BIT IN M:UC
         B        CMDX              AND SPLIT.
SPYX     EXU      DECPL             YANK US OUT.
         PLW,T    TSTACK            GET INT ADDRESS BACK.
         LI,TU1   X'1FFFF'
         STS,T    J:INTENT          AND RESTORE IT.
         M:TRTN                     AND SPLIT.
         PAGE
*
*        CHAIN
*                 RUNS AND PRINTS THE COUPLING CHAINS, USING MODE4
*        AND TIE TABLES COPIED INTO STIE AND SMODE4.
*
CHAIN    PUSH     L
         BAL,L    CPYTIE1           MAKE SURE WE HAVE A RECENT COPY.
         LI,D2    LNOL-1            START WITH LAST LINE #
CHN1     LI,S     0                 BUFFER POINTER.
         LW,R     D2                LINE # TO LOOK AT.
         CB,R     STIE,R            SHOULD WE LOOK ANY FURTHER
         BE       CHNEL             NO, GO TO END LOOP.
         LI,T     X'80'
         CB,T     SMODE4,R          IS THE COUPLED BIT SET????
         BANZ     CHN2              B/WE HAVE A CHAIN TO RUN
         LW,T     R
         BAL,L    PID               PUMP OUT THE HEX BYTE
         BAL,L    PTC               FOLLOWED BY THIS TEXTC
         TXTC     ' < '
         LB,T     STIE,R
         BAL,L    PID               AND THE ATTEMPTING LINE #
         STB,R    STIE,R            BLOT OUT THAT LINE #
         B        CHNEL             AND GO TO END.
CHN2     LW,T     R
         BAL,L    PID               STARTING LINE #
         LW,RU1   R
CHN3     LB,T     STIE,RU1          LOOKY AT NEXT ELEMENT
         CW,T     R                 HIT THE END OF THE CHAIN??
         BE       CHN4              B/YUP.
         CW,T     RU1               DOES IT POINT TO ITSELF????
         BE       CHNF              B/YUP, A BUM DEAL.
         BAL,L    PTC
         TXTC     ' > '
         LB,T     STIE,RU1
         STB,RU1  STIE,RU1          TO REMEMBER WE'VE BEEN HERE.
         LW,RU1   T                 FOR FINDING SUCESSOR
         BAL,L    PID
         B        CHN3
CHNF     BAL,L    PTC               CIRCULAR END ON CHAIN.....
         TXTC     ' > %'            MARK IT AS SUCH, FALL INTO CHNEL.
CHN4     STB,R    STIE,R            RAN ANOTHER CHAIN.
         STB,RU1  STIE,RU1          FIX UP LAST ONE IN CHAIN.
CHNEL    LW,L     OBP               ANYTHING TO PRINT?
         BL       %+4
         LI,R     0
         STW,R    OBP               RESET THE POINTER/LENGTH WORD AND
         EXU      BCP               PRINT THE REST.
         AI,D2    -1                DECR LINE #
         BGE      CHN1              AND CHECK THAT LINE.
         LD,R     CTIE
         MBS,R    0                 COPY TIE TABLE BACK.
         B        CMDX              AND SPLIT.
*
*        PHB
*                 CALLED TO PUT THE HEX BYTE IN T INTO THE BUFFER.
*
THEX     TXT      '0123456789ABCDEF'
*
PHB      PUSH     L
         SLD,T    -4
         LB,T     THEX,T            GET HEX TEXT
         BAL,L    BC                BUFFER CHARACTER
         LI,T     0
         SLD,T    4
         LB,T     THEX,T
         BAL,L    BC
         B        CMDX              SPLIT.
         PAGE
*
*        PID
*                 PRINT LINE NUMBER AND SYSID, AND IF BYFLG SET, PRINT
*        USER NAME FROM :LOGD FILE, OR ACP NAME. ENTER WITH LINE# IN T.
*
PTXT     TXT      '\/()'            FOR SEPARATOR BYTES....
PID      PUSH     L
         PUSH     3,R               SAVE SOME STUFF.
         LW,R     T                 ENTERED WITH T=LINE NUMBER.
         BAL,L    PHB               PRINT THE LINE NUMBER
         LI,T     ':'
         BAL,L    BC                A COLON
         LB,T     LB:UN,R
         BAL,L    PHB               AND THE USER ID
         MTW,0    BYFLG             ANYTHING ELSE????
         BG       PID1              B/YUP
PIDX     PULL     3,R
         B        CMDX
PID1     LW,L     R                 SAVE THE LINE NUMBER HERE
         LB,R     LB:UN,L           AND GET USER # BACK AGAIN.
         LI,RU1   X'FF'
         CS,R     J:JIT             IS THIS US???
         BNE      %+3               B/NOPE
         LI,RU1   0
         B        PID1A
         LI,RU1   0                 CLEAR IF NOT ME ALSO....
         LC       MODE4,L           LOOK AT COUPLE STATUS
         BCS,8    %+3               B/MAYBE COUPLED
         LI,RU1   3                 REJECTING OR OTHER
         B        PID1A
         CB,L     TIE,L             IS IT COUPLED????
         BNE      %+2               B/YUP
         AI,RU1   1                 +2 FOR ACCEPT
         AI,RU1   1                 +1 FOR COUPLED.
PID1A    LB,T     PTXT,RU1          PICK THE SEPARATOR
         PUSH     L                 SAVE LINE #
         BAL,L    BC                PUMP OUT SEPARATOR
         PULL     L                 RESTORE LINE #
         CB,R     L:UN,L            SEE IF CACHE TABLE HAS THE ENTRY
         BNE      %+4               B/NOPE, MUST READ IT.
         LD,SR1   L:UNAME,L         IF IN CACHE,
         STD,SR1  BYBUF+1           MOVE TO RECORD AREA
         B        PID1C             AND FOOL PAST THE READ.
         OR,R     Y03               MAKE INTO A KEY
         STW,R    KEY
         LI,RU1   PID2
         STW,RU1  F:WHO+3
         STW,RU1  F:WHO+4           INSURE ERR/ABN!!!!
READFWHO M:READ   F:WHO,(BUF,BYBUF),(SIZE,80),(KEY,KEY),(WAIT)
         LD,SR1   BYBUF+1
         STD,SR1  L:UNAME,L         UPDATE CACHE
         STB,R    L:UN,L
         STB,L    U:LN,R
PID1C    LI,R     8
         LI,RU1   0
PID1B    LB,T     BYBUF+1,RU1
         CI,T     ' '
         BLE      PIDX
         BAL,L    BC
         AI,RU1   1
         BDR,R    PID1B
         B        PIDX
PID2     LI,R     X'FF'
         AND,R    KEY
         LB,R     UB:ACP,R          COMMAND PROCESSOR
         SLS,R    1                 AS DOUBLEWORD
         AI,R     P:NAME            POINT TO TEXTC IN TABLES
         LCI      2
         LM,T     0,R
         STM,T    BYBUF+1           POKE IN AS NAME
         LI,T     ' '
         STB,T    BYBUF+3           FORCE TERMINATION
         LI,T     '?'               PRECEED ACP WITH FLAG
         STB,T    BYBUF+1           SO WE KNOW IT'S WEIRD...
         B        PID1B-2
         PAGE
*
*        PTC
*                 BUFFER THE TEXTC FOLLOWING THE BAL.
*
PTC      PUSH     L
         PUSH     RU1
         LB,RU1   *L                THE COUNT
         LW,TU1   L
         SLS,TU1  2
         AI,TU1   1                 STARTING INDEX
         LB,T     0,TU1             GET A BYTE.
         BAL,L    BC                BUFFER IT
         AI,TU1   1
         BDR,RU1  %-3               DO ALL CHRS.
         PULL     RU1
         PULL     L                 RETURN ADDR
         AI,TU1   3                 ROUND UP BYTE ADDR
         SLS,TU1  -2                TO NEXT WORD ADDRESS
         B        0,TU1             AND RETURN AFTER TEXTC.
*
*        BC
*                 BUFFER A CHARACTER
*
BC       XW,L     OBP               PICK UP BUF POINTER
         STB,T    OBUF,L            POKE AWAY
         AI,L     1
         CI,L     79
         BL       %+3               RETURN IF BUFFER NOT BLOWN.
BCP      M:WRITE  M:DO,(BUF,OBUF),(SIZE,*L),(WAIT),(BTD,0)
         LI,L     0
         XW,L     OBP               SWAP LINK AND LENGTH AGAIN
         B        0,L
         PAGE
*
*        WATCH
*                 EVERY 1.2 SECONDS, SEE IF THERE ARE ANY NEW COUPLING
*        CHAINS, AND IF SO, DUMP THE WHOLE MESS.
*
WATCH    PUSH     L
         BAL,L    CHAIN             DUMP CHAINS.
         LI,T     1
         LW,1     S:CUN
         STW,T    U:MISC,1
         LI,6     E:SL
         BAL,11   T:REG
         BAL,L    CPYTIE
         B        %-6               B/NOT CHANGED
         CRAB     '*'               INDICATION OF NEW LISTING.
         B        WATCH+1           IF CHANGED, DUMP CHAINS
         PAGE
*
*        UID
*                 PRINT USER ID ASSOCIATED WITH A LINE #
*
UID      PUSH     L
         LI,S     0
UID1     BAL,L    ARGH              GET A #
         BCS,8    UIDX              B/SCRAM
         CI,O     LNOL-1            LEGAL????
         BLE      UID2              B/YUP
UIDN     BAL,L    PTC
         TXTC     '??'
         B        UID3
UID2     LB,T     LB:UN,O           GET USER ??
         BE       UIDN              B/NO USER
         LC       MODE5,O           IS IT TP??
         BCS,8    UIDT              B/YUP, TP LINE
         BAL,L    PHB
         B        UID3
UIDT     BAL,L    PTC
         TXTC     'TP'
UID3     BAL,L    PTC
         TXTC     ','
         B        UID1
UIDX     BDR,S    %+2
         B        %+2
         EXU      BCP
         PULL     L
         B        0,L
         PAGE
*
*        ON
*                 LISTS THE ONLINE USERS, BY COC LINE # AND NAME.
*
ON       LI,R     X'0020'
         CH,R     F:WHO             DCB OPEN???
         BANZ     %+2               B/YUP, OK.
         EXU      OPNFWHO           ELSE TRY TO OPEN.
         PUSH     L
         LI,S     0
         STW,S    OBP               CLEAR BUF POINTER
         LW,R     BYFLG
         PUSH     R                 SAVE FLAG VALUE
         AI,R     0
         BL       %+2               IF NEGATIVE, LEAVE ALONE...
         MTW,6    BYFLG             WILL MAKE IT POSITIVE.
         LI,D1    0                 START WITH LINE # 0
ON1      LW,L     OBP
         CI,L     15
         BAZ      ON2
         LI,T     ' '
         BAL,L    BC
         B        ON1               TO FAKE TABS....FORM COLUMNS...
ON2      LW,T     D1                THE LINE #
         LB,R     LB:UN,T           LOOKY AT USER ## ASSOCIATED
         BE       ONL               B/NONE.
         LB,L     UB:US,R           EXAMINE STATE FOR THAT USER
         CI,L     SNULL             NULL SEZ NO USER,
         BE       ONL               AND WE'LL IGNORE IT.
         LC       MODE2,T           SEE IF LOGGING ON OR OFF
         BCS,8    ONL               B/DONT LOOK IF SO.
         LC       MODE5,T           SEE IF TP LINE.
         BCS,8    ONL               B/YUP.
         BAL,L    PID               IF NOT, PUMP OUT THE ID.
         LW,L     OBP
         CI,L     50
         BLE      ONL
         EXU      BCP
         LI,L     0
         STW,L    OBP               CLEAR BUF HEADER
ONL      AI,D1    1
         CI,D1    LNOL
         BL       ON1               LOOP THRU LINES
         LW,L     OBP
         CI,L     0
         BE       %+4
         EXU      BCP               PRINT REMAINING STUFF
         LI,L     0
         STW,L    OBP               AND CLEAR BUF HEADER
         PULL     R
         STW,R    BYFLG             RESTORE THE FLAG
         PULL     L
         B        0,L               AND RETURN.
         PAGE
*
*        COMMAND TABLES
*
CMDTXT   CSECT    1
CMDTV    CSECT    1
CMDTL    SET      0
*
:CMD     CNAME    0
:MCMD    CNAME    1                 MASTER MODE COMMAND ENTRY
         PROC
         DISP     CMDTL
         LIST     0
         USECT    CMDTXT
         TEXTC    AF(1)
         DO       S:NUMC(AF(1))<4
         TEXT     '    '
         FIN
         USECT    CMDTV
         DO       NUM(CF)=2
         REF      AF(2)
         FIN
         DO       NAME=0
         BAL,L    AF(2)
         ELSE
         BLOCK    AF(2)
         FIN
         LIST     1
CMDTL    SET      CMDTL+1
         PEND
         PAGE
*
*        THE ACTUAL STUFF.
*
         :CMD     'NULL',CODE       NULL ONE FIRST.
         :CMD,*   'PRINT',PRINT
         :CMD,*   'END',SPLIT
         :CMD,*   '@',LINK
         :CMD,*   'XXX',XXX
         :CMD,*   'OFF',OFF
         :CMD,*   'LIST',CLIST
         :CMD,*   'READ',READ
         :CMD,*   'AMIN',AMIN
         :CMD,*   'EVERY',EVERY
         :CMD,*   'AGAIN',AGAIN
         :CMD     'COUPLE',COUPLE
         :CMD     'DONT',DONTCOUP
         :CMD     'DECOUP',DECOUPLE
         :CMD     'ACCEPT',ACPLS
         :CMD     'WATCH',WATCH
         :CMD     'CHAIN',CHAIN
         :MCMD    'SPY',SPY
         :MCMD    'GRAB',GRAB
         :CMD     'BYNAME',BYNAME
         :CMD     'BYNUMB',BYNUMBER
         :MCMD    'WHO',WHODAT
         :CMD     'ID',UID
         :MCMD    'ON',ON
         :CMD     'END',SPLIT
         :CMD     'GHOST',GHOST
         :CMD     'QUEUE',QUEUE
         :CMD     'BATCH',BATCH
         :CMD     'TAPES',TAPES
         :CMD     'DISC',DISC
         :CMD     'UPTIME',UPTIME
         :CMD     'SIZE',SIZE
         :CMD     'USERS',USERS
         :CMD,*   'TIME',TIME
*
CMDALL   EQU      CMDTL-1           ALL CMDS UP TO HERE DONE ON ALL.
*
         :CMD     'DI',DISPLAY
         :CMD     'ALL',DOALL
         :CMD     'ID',DISPLAY
         :CMD     'LP',LP
         :CMD     'UC',UC
         :CMD     'HELP',HELP
         :CMD     'DELTA',GETDELTA
         :CMD     'UNDELTA',UNDELTA
         :CMD     'GRAB',PCNT
         :CMD     'USER',USER
         :CMD     'U',USER          ABBREVIATION FOR 'USER'
         :CMD     'CFUS',CFUS
         :CMD     'PUNT',PUNT
         :CMD     'PANES',DOPANES
         :CMD     'STAT',STAT
         :CMD     'STATS',STATS
         :CMD     'USE',USE
         :CMD     'CORE',CORE
         :MCMD    'NAIL',NAIL
         :MCMD    'KEYIN',KEYIN
         :MCMD    'PRIOB',PRIOB
         :MCMD    'RUE',RUE
*
*        THIS IS THE END.
*
         DEF      CMDTL,CMDTXT,CMDTV
         PAGE
*
*        THE DCB USED TO FIND NAMES.....
*
F:WHO    DSECT    1
F:WHO    M:DCB    (FILE,':LOGD',':SYS'),(KEYED),(IN,SHARE),;
                  (ERR,WHAM),(ABN,WHAM),(DIRECT),(SAVE)
         TITLE    'THE WHOLE ENCHILADA...'
*
*        PROGRAM INIT AND FREE VIRTUAL ROUTINES
*
         DEF      SPYINIT,FREEVM
*
*        NOTES---
*
*        PANES IS THE NUMBER OF PAGES IN THE WINDOW
*        USED BY THE PROGRAM. MAXPANES IS ITS MAXIMUM. PANES MAY
*        BE CHANGED DYNAMICALLY FROM 1 TO MAXPANES USING THE PANES
*        COMMAND.
*
MAXPANES EQU      20
*
PANES    EQU      16
*
*        WINDOWPG IS THE START OF THE WINDOW AREA THAT MONITOR PAGES
*        ARE MAPPPED INTO. THE TOP OF THE WINDOW IS WINDOWT.
*
WINDOWPG EQU      X'10000'
WINDOWT  EQU      WINDOWPG+MAXPANES**9
*
*
*        80 PRIVELIGE IS REQUIRED TO USE THE PROGRAM, AS IT USES
*        THE M:CVM (M:SAD) CAL TO EXAMINE THE MONITOR AND ITS TABLES.
         PAGE
*
*        REGISTER DEFINITIONS- IN NO PARTICULAR ORDER.
*
*        REGISTER USE
*
*        0        ARG FROM LTHING, ARG TO SLURPC
*        1        ARG FROM LTHING, ARG TO SLURP
*        2        WORK
*        3        WORK
*        4        OUTPUT POINTER FOR SLURP
*        5        STRING POINTER FOR SLURP
*        6        LINK REGISTER
*        7        INDEX FOR LOADTHING
*        8        WORD ADDRESS FOR LOADTHING
*        9        NUMBER OF DIGITS FOR SLURP
*        10       WORK
*        11       WORK
*        12       WORK
*        13       WORK
*        14       CHARACTER PUSHING-USUALLY TRASH
*        15       WORK
         PAGE
*
*        SPYINIT
*                 VERIFY THAT PRIVELIGE LEVEL IS HIGH ENOUGH TO USE
*        THE M:CVM CAL, AND THAT THE PROGRAM MATCHES THE SYSTEM. TRAP AND
*        BREAK CONTROL ARE SET UP FOR ONLINE USE.
*
         USECT    CODE              IN PROCEDURE AREA
SPYINIT  LB,R     JB:PRIV
         CI,R     X'80'             MUST HAVE 80 TO DO CVM CAL.
         BL       SPLIT             AND IF YOU DONT, SO LONG...
SPYINI1  LD,T     16BALLS           CLEAR THIS STUFF TO ZERO.
         BAL,L    VERIFY            GO VERIFY SYSTEM.
         LCF      J:JIT             AND SEE IF WE ARE ONLINE
         BCS,8    START2            YUP. LOOKS THAT WAY.
         LI,R     M:LO              IF NOT, OUTPUT THRU M:LO DCB
         STW,R    ODCB
         MTW,1    ONLIN             MARK THAT WE ARE NOT ONLINE.
CMDX     PULL     L
         B        0,L               AND RETURN.....
START2   LW,R     J:TELFLGS         IS DELTA ASSOCIATED?
         CI,R     X'80'             IF IT IS, DONT GET
         BANZ     %+2               TRAP CONTROL.....
         CAL1,8   MTRAP             TRAP CONTROL TO OOPST
         B        INITDIS           RETURN THRU INITIAL DISPLAY CODE.
*
MTRAP    GEN,8,24 X'14',OOPST
         DATA     X'003F8300'
         PAGE
*
*        THE LP COMMAND DIRECTS OUTPUT THRU THE PRINTER.
*
LP       LI,R     M:LO
         STW,R    ODCB
         CAL1,1   GETLP             OPEN IT TO DEVICE LP
         CAL1,1   DEVTOP            AND DO TOP OF FORM
         LI,R     1
         STW,R    ONLIN             SET SWITCH FOR REASONABLE OUTPUT
         B        DISPLAY           SPLIT THRU DISPLAY CODE FOR HEADER.
GETLP    GEN,8,24 X'14',M:LO        DO AN OPEN.
         DATA     X'01040000'
         DATA     2                 OUT MODE, OF COURSE
         DATA     X'D3D7'           'LP' FOR P14- TEXT OPLABEL
DEVTOP   CAL1,0   M:LO              TOP OF FORM......
*
*        LIKEWISE, UC DIRECTS OUTPUT TO THE TERMINAL.
*
UC       LI,R     M:UC
         XW,R     ODCB              BACK TO UC.
         CI,R     M:UC              WAS IT SET TO UC BEFORE?
         BE       0,L               YES- SPLIT.
         CAL1,1   CLOSELP           IF NOT, ISSUE CLOSE TO LP
         MTW,-1   ONLIN             AND RESET FLAG
         B        0,L               NOW SPLIT.
*
CLOSELP  STD,0    M:LO              CLOSE LP
         DATA     0
         PAGE
*
*        UPTIME PRINTS THE TIME SINCE SYSTEM STARTUP.
*
UPTIME   PUSH     L
         LI,SR2   0
         LI,S     0
         LI,SR1   C:TIC             UPTIME IN TICKS
         BAL,L    LW
         LI,0     0
         DW,0     =30000            TO MINUTES
         STW,O    TRASH             SAVE THAT.
         LI,TU1   BA(UPT1)
         BAL,L    SLURP
         LI,0     0
         DW,0     =60
         BAL,L    SLURPN            PRINT OUT HOURS
         MW,0     =60
         SW,O     TRASH             -MINUTES
         LCW,O    O                 MINUTES
         BAL,L    SLURPN            PRINT MINUTES
         BAL,L    SLURPO            WRITE
         B        CMDX
         PAGE
*
*        HELP JUST TYPES A STRING TO SHOW THE USER WHAT TO DO.
*
HELP     PUSH     L
         LI,TU1   BA(HLPTXT)
HELP1    BAL,L    SLURP
         CI,T     10                HIT THE END YET?
         BLE      CMDX              IF SO,....
         BAL,L    SLURPO            WRITE THE LINE
         LB,R     0,TU1             WE HAVE TO MOVE TO THE
         CI,R     ' '               NEXT NON-BLANK TO GET FROM
         BNE      HELP1             LINE TO LINE.
         AI,TU1   1
         B        %-4
*
*        EACH ENTRY IN HLPTXT IS FOR THE ASSOCIATED COMMAND.
*        EACH LINE BETTER END WITH A %, AND THE LAST LINE BETTER END
*        WITH TWO. ('%%' OR SO.)
*
HLPTXT   EQU      %                 HERE IT COMES.
 TXT     'NOTE- ONLY ENOUGH CHARACTERS TO UNIQUELY IDENTIFY THE %'
 TXT     '      COMMAND ARE NEEDED- I.E. H, HE, HEL WILL ALL DO HELP.%'
 TXT     'COMMAND                   ACTION%'
 TXT     'HELP    TYPES THIS MESSAGE.%'
 TXT     'END     EXITS THE PROGRAM. SO DOES Q.%'
 TXT     'GHOST   PRINTS NAMES AND IDS OF RUNNING GHOSTS.%'
 TXT     'BATCH   BATCH PARTITION ACTIVITY.%'
 TXT     'QUEUE   BATCH AND SYMB QUEUE, IF FEATURE INSTALLED.%'
 TXT     'TAPES   TAPE DRIVE USE AND AVAILABILITY.%'
 TXT     'DISC    DISC SPACE AVAILABILITY%'
 TXT     'UPTIME  TIME SINCE SYSTEM STARTUP%'
 TXT     'USERS   NUMBER OF USERS ON SYSTEM%'
 TXT     'DI      USER ID, TIME, AND PRIV LEVEL.%'
 TXT     'ALL     DOES ALL THE ABOVE COMMANDS.%'
 TXT     'LP      DIRECT OUTPUT TO LINE PRINTER.%'
 TXT     'UC      DIRECT OUTPUT TO TERMINAL.%'
 TXT     'PRINT   SAME AS PRINT IN TEL.%'
 TXT     'USER #  TELLS YOU ABOUT USER WITH ID #.%'
 TXT     'CFUS    DUMPS ALL IN USE CFU''S ON YOU.%'
 TXT     'CFUS #  DUMPS CFUS ACTIVE FOR ACCOUNT #.%'
 TXT     'PUNT    TRY IT, YOU WONT LIKE IT!%'
 TXT     'DELTA   GET ANLZ DELTA FOR LOOKING AT MON%'
 TXT     'UNDELTA GETS RID OF DELTA, IF AROUND%'
 TXT     'OFF     LOGS YOU OFF.%'
 TXT     'STATS   GIVES SYSTEM STATUS SUMMARY.%'
 TXT     'STATS # GIVES SUMMARY, AND STATUS OF JOB #.%'
 TXT     'STAT    GIVES SUMMARY ONCE A MINUTE.%'
 TXT     'STAT #  GIVES STATS # ONCE A MINUTE.%'
 TXT     'USE #   USE MONDMP# FOR INPUT-USE 8 USES LAST FILE.%'
 TXT     'CORE    USE RUNNING MONITOR FOR INPUT.%'
 TXT     'READ N.A.P   USE FILE N.A.P FOR COMMAND INPUT.%'
 TXT     'COUPLE  COUPLE TO LINE # OR #S SPECIFIED.%'
 TXT     'DONT    DONT ACCEPT COUPLES%'
 TXT     'DECOUP  DECOUPLE TERMINAL.%'
 TXT     'ACCEPT  SET TO ACCEPT COUPLES%'
 TXT     'CHAIN   PRINT COUPLING CHAINS%'
 TXT     'SPY     SPY ON LINE%'
 TXT     'GRAB    FORCE COUPLE TO LINE #%'
 TXT     'ON      SHOW ONLINE USERS%'
 TXT     'SIZE    DISPLAY MEMORY USE PER USER%'
 TXT     'KEYIN   DO OPERATOR KEYIN%'
 TXT     'NAIL    BUMP OFF USER OR USERS%'
 TXT     'PRIOB   SET USER BASE EXECUTION PRIORITY%'
 TXT     'AMIN    DOES THE NEXT COMMAND ONCE A MINUTE.%'
 TXT     'EVERY # DOES THE NEXT COMMAND EVERY # TICKS.%'
 TXT     '@ N,A,P DOES M:LINK TO N.A.P- A AND P MAY BE NULL.%'
****************************************************************
         TXT      'THAT''S ALL...%%%%%%%%%%%%%%%%%%%%'
         PAGE
*
*        THE USERS COMMAND PRINTS A SUMMARY OF THE USERS ON THE
*        SYSTEM IN THE FORM
*         % USERS- % ONLINE + % GHOST + % BATCH + % WAITING.
*
USERS    PUSH     L
         LI,TU1   BA(USERSM)
         LI,SR2   0                 AS MANY AS THERE ARE DIGITS.
         LI,S     0                 NO INDEXING USED.
         LI,T     0
         BAL,L    SLURP
         LI,SR1   S:CUIS            CURRENT USERS IN SYSTEM
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:OUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:GUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:BUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:BFIS
         BAL,L    LW
         BAL,L    SLURPN
         BAL,L    SLURPO
         B        CMDX              RETURN THROUGH WRITE.
         PAGE
*
*        SIZE GIVES MIN, MAX, AVERAGE, AND VARIANCE ON USER SIZES
*
SIZE     PUSH     L
         LI,S     SMUIS+1           MAX INDEX VALUE
         LI,D1    0                 SUM OF X
         LI,D2    0                 SUM OF (X*X)
         LI,D3    1000              MINIMUM
         LI,D4    -1                MAXIMUM
         LI,TU1   0                 N
SIZE1    LI,SR1   UB:US             WE DO SUMMATION FOR ALL U SUCH
         BAL,L    LB                THAT UB:US(I) .NE. SNULL
         CI,O     SNULL
         BE       SIZE3             B/DONT LIKE THIS ONE.
         LI,SR1   UB:PCT
         BAL,L    LB                GET USER SIZE
         AI,TU1   1                 BUMP N
         AW,D1    O                 SUM OF N
         CW,O     D3                MIN
         BGE      %+2
         LW,D3    O
         CW,O     D4
         BLE      %+2
         LW,D4    O                 UPDATE MIN AND MAX
         MW,O     O
         AW,D2    O                 SUM OF N SQUARED
SIZE3    BDR,S    SIZE1             LOOP ON # USERS.
         LW,O     D2                SUM SQUARED
         MW,O     TU1               TIMES N
         LW,RU1   D1
         MW,RU1   D1                (SUM) SQUARED
         SW,O     RU1               N*SUM(X*X)-(SUM (X))*(SUM( X))
         LW,RU1   TU1               N
         AI,RU1   -1                N-1
         MW,RU1   TU1               N(N-1)
         LI,0     0
         DW,0     RU1               (MESS IN O)/(N(N-1)) IS VARIANCE.
         LI,R     0                 CLOSE YOUR EYES, THIS IS GOING TO
         LW,RU1   R                 HURT.....
         MW,RU1   RU1               WOULD YOU BELIEVE WE ARE LOOKING
         CW,RU1   O                 FOR THE SQUARE ROOT THE (VERY)
         BG       %+3               HARD WAY????
         AI,R     1
         B        %-5
         AI,R     -1
         PUSH     R                 STACK THE STANDARD DEVIATION.
         PUSH     D4                STACK MAXIMUM
         LW,R     D1
         SLD,R    -32
         DW,R     TU1               COMPUTE AVERAGE
         PUSH     RU1               AND STACK IT
         PUSH     D3                STACK MINIMUM
         LI,S     0
         LI,SR1   S:BFIS            CLEAR INDEXING,
         BAL,L    LW                GO GET # OF FILES WAITING
         PUSH     O
         LI,SR1   S:BUIS
         BAL,L    LW
         PUSH     O                 BATCH USERS
         LI,SR1   S:OUIS
         BAL,L    LW
         PUSH     O                 ONLINE USERS
         LI,SR1   S:GUIS
         BAL,L    LW
         PUSH     O                 GHOST USERS
         PUSH     TU1               TOTAL # OF USERS FROM EARLIER.
         LI,TU1   BA(SIZEM)         THE MESSAGE
         LI,SR2   0                 OUTPUT FIELD WIDTH
         LI,D4    9                 # OF ITEMS
         BAL,L    SLURP             TO START
SIZE4    PULL     O
         BAL,L    SLURPN            PULL AND PRINT
         BDR,D4   SIZE4             THE ITEMS ON THE STACK
         BAL,L    SLURPO            OUTPUT THE STUFF
         B        CMDX              AND SPLIT.
         PAGE
*
*        THE CFU COMMAND DUMPS THE IN USE CFU'S ON YOU.
*
CFUS     PUSH     L
         LI,S     0
         STW,S    TRASH             USED CFU'S
         STW,S    TRASH1            UNUSED CFU'S
         STW,S    TRASH2            ACCOUNT SEARCH FLAG
         LI,SR1   8
         LI,S     CFUACCT           PUT THE BODY HERE.
         LD,R     8BLNKS
         STD,R    CFUACCT           PRESET TO BLANKS
         BAL,L    ARGT              GO SEE IF TEXT ARG AVAILABLE
         BCS,8    %+2               B/NOPE.
         MTW,1    TRASH2            AND SET THE FLAG.
         LI,SR4   BGRCFU            FIRST CFU LOC TO LOOK AT
LOOKCFU  LW,SR1   SR4               GET ADDRESS OF CFU TO LOOK AT
         LI,S     0                 NO INDEXING
         BAL,L    LW
         LC       1                 IS IT IN USE?
         BCS,8    %+2               SKIP IF CLOSING.....
         BCS,4    INUSE             YUP-GO DUMP IT
         MTW,1    TRASH1            IF NOT, BUMP EMPTY COUNTER
NXTCFU   EQU      %
         AI,SR4   8                 B00 CFU SIZE
         LI,SR1   ACNCFU+13         LAST WORD OF CFU SPACE
         LI,S     0
         BAL,L    LW                IS IN THERE
         CW,SR4   O
         BL       LOOKCFU           NOPE.
         LI,TU1   BA(CFUM3)
         LI,T     0
         LI,SR2   0
         LW,O     TRASH
         BAL,L    SLURPN            THIS MANY IN USE CFU'S
         LW,O     TRASH1
         BAL,L    SLURPN            AND THIS MANY UNUSED
         AW,O     TRASH             THIS MANY TOTAL.
         BAL,L    SLURPN
         BAL,L    SLURPO
         B        CMDX              AND THAT'S THE END.
INUSE    MTW,1    TRASH             BUMP IN USE COUNTER
         LW,R     O                 SAVE THESE GOODIES FOR A WHILE
         SLS,O    -17               GET A USAGE COUNT
         AND,O    M7
         LI,TU1   BA(CFUM1)
         LI,T     0
         LI,SR2   0
         BAL,L    SLURPN            PRINT NUMBER OF DCB'S USING IT
         LD,0     8BLNKS            PRESET TO BLANKS.
         CI,R     X'100'            AND LOOK AT THE FUNCTION BITS
         BAZ      %+2               IN WORD 0 OF THIS CFU
         LW,0     FMSG              IT SEZ 'IN'
         CI,R     X'200'
         BAZ      %+2
         LW,0     FMSG+1            IT SEZ 'OUT'
         CI,R     X'400'
         BAZ      %+2
         LD,0     FMSG+2            'INOUT'
         CI,R     X'800'
         BAZ      %+2
         LD,0     FMSG+3            'OUTIN'
         BAL,L    SLURPC            SHOVEL THAT IN.
         AI,SR1   2                 SPACE TO ACCT/NAME INDEX
         BAL,L    LW                AND GET THAT.
         BE       CFUSREL           IF ZERO, OUTPUT RELEASE FILE.
         LB,0     O
         CI,0     3                 IS THIS A STAR FILE?????
         BE       CFUSTAR           YUP. TAKE CARE OF THAT.
         STH,O    D1                SAVE NAME DISPLACEMENT.
         CI,R     X'10000'          IS THIS A PRIVATE PACK FILE?
         BAZ      %+3               NOPE
         LD,0     CFUPRPK           IF SO,LOAD THE TEXT
         B        CFUSAS            AND GO TO ACCOUNT SLURP POINT.
         LH,RU1   O                 THE ACCOUNT DWORD OFFSET
         SLS,RU1  1                 SHIFT TO WORD INDEX
         LI,SR1   ACNCFU+13         ACCT ENTRY START
         BAL,L    LW                GET THAT
         LW,SR1   O
         AW,SR1   RU1               ADD IN THE DISPLACEMENT IN CFU.
         BAL,L    LW
         LW,R     O                 I DONT THINK ITS ON A
         AI,SR1   1                 DOUBLEWORD BOUNDARY, SO I'LL
         BAL,L    LW                DO THIS LITTLE SONG AND DANCE
         LW,0     R                 TO GET THE TWO WORD ACCOUNT
         MTW,0    TRASH2            ANY PARTICULAR ACCOUNT IN MIND
         BE       %+3               NO, ANYTHING WILL DO.
         CD,0     CFUACCT           PICKY, ARE YOU....
         BNE      NXTCFU            WELL, THIS ONE ISN'T IT.
CFUSAS   BAL,L    SLURPC            ENTRY
         LH,SR1   D1                NAME IS RIGHT HERE.....
         BAL,L    LB                GET C FROM TEXTC
         LW,SR2   O                 AND COPY IT.
         CI,SR2   31                HOW BIG DID YOU SAY?
         BLE      %+2
         LI,SR2   31                BULLFEATHERS......
         LI,S     1                 BYTE INDEX
         BAL,L    LB                FETCH A BYTE
         STB,O    OBUF,T            POKE IT AWAY
         AI,T     1
         AI,S     1                 BUMP VARIOUS POINTERS
         BDR,SR2  %-4               AND COPY THE STRING
CFUSO    BAL,L    SLURPO            PRINTIT.
         B        NXTCFU            NEXT!
CFUSTAR  LD,0     8BLNKS            FOR STAR FILES IN B00, WE DONT
         BAL,L    SLURPC            KNOW THE ACCOUNT
CFUSTAR1 LI,TU1   BA(CFUM2)         THE HEADER TO USE.
         BAL,L    SLURP             PUMP OUT FIRST PART,
         LI,SR2   8                 8 CHARACTERS, PLEEZE
         BAL,L    SLURPH            AND DUMP OUT HEX.
         B        CFUSO             THAT'S THAT.
CFUSREL  LD,0     CFUSRELS          THE FILE IS TO BE RELEASED.
         BAL,L    SLURPC            SO TELL THEM ABOUT IT ALREADY.
         B        CFUSO
         BOUND    8
FMSG     TXT      'IN  OUT INOUT   OUTIN' CFU FUNCTION CODE TEXTS.
CFUPRPK  TXT      'PRIV PAK'        PRIVATE PACK FILE.....
CFUSRELS TXT      ' (REL) '
         PAGE
*
*        STAT AND STATS GIVE A SYSTEM SUMMARY. STAT GIVES THIS
*        SUMMARY ONCE A MINUTE, WHILE STATS IS A ONE SHOT DEAL.
*        STAT OR STATS CAN HAVE AN OPTIONAL ARGUMENT, A HEX
*        JOB NUMBER. THIS IS SCANNED BY ARGH, AND IF PRESENT,
*        DENOTES A BATCH JOB TO BE CHECKED.
*
STATS    BAL,O    STAT1
STAT     BAL,O    STAT1
STAT1    AI,O     -STAT             THIS SONG AND DANCE SETS ZZFLG
         STW,O    ZZFLG             TO 0 FOR STATS, AND 1 FOR STAT.
         LW,O     =X'0F000031'
         STW,O    ZZN
         PUSH     L
         BAL,L    ARGH              GO GET HEX ARGUMENT
         BCR,8    STAT2             LESS THAN 0 IS ERROR RETURN.
STATEH   BAL,L    EH                WHAT WAS THAT??
         B        CMDX              I DONT KNOW....
STAT2    STW,O    JID               SAVE THE ARG, IF ANY.
         LI,O     0                 SET PARTITION NUMBER TO ZERO
         STW,O    TRASH1            FOR USE LATER ON
         LI,TU1   BA(STATM1)
         BAL,L    SLURP
         LW,O     JID               IF THER'S AN ID PRESENT,
         BE       %+3
         LI,SR2   4                 WE'LL PRINT IT OUT AS A FOUR
         BAL,L    SLURPH            DIGIT HEX NUMBER.
         BAL,L    SLURPO
         LI,TU1   BA(STATM2)
         BAL,L    SLURP
         MTW,0    JID               IS IT THERE??
         BE       %+2               NOPE
         BAL,L    SLURP             CONTINUE HEADER OF IT IS
         BAL,L    SLURPO            WRITE THE THING OUT.
STAT4    CAL1,8   DISPL1            GET TIME INTO OBUF
         LI,T     6                 POINT AFTER THE ACTUAL TIME.
         LI,TU1   BA(STATM3)
         LI,SR2   2                 SOME 2 DIGIT NUMBERS.
         LI,S     0                 NO INDEXING
         LI,SR1   S:CUIS            CURRENT # USERS IN SYSTEM
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:OUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:GUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:BUIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR1   S:BFIS
         BAL,L    LW
         BAL,L    SLURPN
         LI,SR2   6                 6 DIGITS FOR STORAGE SUM.
         LI,S     0
         LI,SR1   GRANRAD
         BAL,L    LW
         STW,O    TRASH
         LI,SR1   GRANPACK
         BAL,L    LW
         AW,O     TRASH
         BAL,L    SLURPN            STORAGE AVAILABLE.
         LI,SR2   4                 FOR SYMBIONT STORE
         LI,SR1   GRANSYM
         BAL,L    LW
         BAL,L    SLURPN
         LW,SR1   JID               A JOB TO CHECK UP ON??
         BE       STAT6             NOPE.
STAT40   CAL1,1   MJOB              WHAT'S THE STATUS OF THIS JOB?
         CI,SR1   1                 IS IT RUNNING??
         BNE      STAT42            GUESS NOT.
         LW,O     TRASH1            IF IT IS, DO WE HAVE PARTITION #?
         BNE      STAT41            ITS IN TRASH IF WE DO.
         LI,SR1   PLH:SID           IF IT ISNT,
         LI,S     LPART             WE JUST HAVE TO LOOK THRU
         BAL,L    LH                THE PARTITION TABLES TO
         CW,O     JID               FIND THE JOB'S SYSID.
         BE       %+3               GOT IT......
         BDR,7    %-3
         B        STAT40            STRANGE. NOT THERE. LOOK AGAIN...
         STW,7    TRASH1            REMEMBER THAT- NOT LIKELY TO
         LW,O     TRASH1            CHANGE DURING JOB EXECUTION.....
STAT41   LI,SR2   2                 SQUASH FIELD TO 2 DIGITS
         BAL,L    SLURPN            FOR PARTITION AND STAR.
         LI,0     '*'               AND PUT A MARKER AFTER IT
         STB,0    0                 TO DENOTE PARTITION NUMBER
         BAL,L    SLURPC
         B        STAT6             AND GO WRITE THIS CRUD OUT.
STAT42   CI,SR1   2                 IS IT WAITING??
         BNE      STAT5             NOPE.
         LW,O     SR3               IF IT IS, PRINT ITS POSITION
         BE       STAT5             IF NEXT, SAY SO.
         BAL,L    SLURPN
         B        STAT6
STAT5    LW,O     SR1               THE STATUS
         LW,0     MJOBS,O           JOB STATUS TEXT.
         LI,O     0
         BAL,L    SLURPC
STAT6    BAL,L    SLURPO            WRITE ALL THAT CRUD OUT.
         MTW,0    ZZFLG             ARE WE SUPPOSED TO SLEEP??
         BE       CMDX              NOPE. BYE.
         CAL1,8   ZZN               SLEEP FOR A WHILE.
         B        STAT4             AND DO IT AGAIN.
MJOB     GEN,8,24 X'2F',M:XX
         DATA     0                 GET STATUS OF JID IN 8.
         BOUND    8
MJOBS    TXT      'DONEBLUGNEXTHUH? LPQ'
         PAGE
*
*        THE QUEUE COMMAND ATTEMPTS TO READ A SPECIAL NCTL
*        FILE WITH FORM NAME= (NAK) (NAK) (NAK) (NAK). IF THE
*        RBBAT IS PATCHED FOR THIS, IT RETURNS THE OPERATOR'S
*        'DISPLAY' FILE TO US. THE M:EI DCB IS USED, AND WE LDEV TO
*        THE C2 STREAM TO TRY AND READ THE FILE. ANY ERRORS, AND WE
*        QUIT FAST.
*
QUEUE    PUSH     L
         LI,O     X'0020'
         CH,O     M:EI              IS THE DCB OPEN NOW??
         BAZ      %+2
         CAL1,1   CLOSEEI           NOPE....
         LI,SR1   S:DSPKEY
         LI,S     0
         BAL,L    LW                WHAT'S THE MAGIC FORM NAME??
         BNE      QUEUEUE           B/HERE IT IS.
         LI,L     CMDX              FIX IF WE CAN, SPLIT IF WE CANT..
         MASTER
         LW,O     =X'0A0A0A0A'
         STW,O    S:DSPKEY          KAPOW.
         SLAVE
QUEUEUE  STW,O    QUEFN             SAVE QUEUE FORM NAME.
         CAL1,8   LDEVEI            M:LDEV 'C2' TO NAKNAKNAKNAK.
         CAL1,1   OPNEIC2           OPEN EI TO C2.
         MTW,0    USNFILE           WERE WE USING A FILE FOR MON IMAGE
         BE       %+4               NOPE.
         LI,O     FMREAL
         LI,R     22
         CAL1,1   WRITEIT           TELL 'EM FROM RUNNING MONITOR.
QREAD    CAL1,1   READQ             READ IN SOME CRUD
         LH,R     M:EI+4
         SLS,R    -1
         LI,O     OBUF
         LI,RU1   M:UC
         CW,RU1   ODCB              WRITE THRU M:UC??
         BNE      %+4               NOPE. DONT HAVE TO DO THIS M.MOUSE
         LI,RU1   X'15'             IF M:UC, MUST POKE IN 'CR' AT END
         STB,RU1  OBUF,R            OF LINE. LIKE I SAID, MICKEY
         AI,R     1                 MOUSE..........
         CAL1,1   WRITEIT
         B        QREAD
QUEUEX   CAL1,1   CLOSEEI           CLOSE THE DCB
         B        CMDX
NOQ      LI,O     X'0020'
         CH,O     M:EI
         BAZ      CMDX
         B        QUEUEX            CLEAN UP AND SPLIT.
*
OPNEIC2  GEN,8,24 X'14',M:EI        OPEN M:EI
         DATA     X'C1040000'
         DATA     NOQ,NOQ           ERROR AND ABN
         DATA     1                 IN
         DATA     X'C3F2'           DEVICE,C2
*
READQ    GEN,8,24 X'10',M:EI
         DATA     X'F0000010'
         DATA     QUEUEX,QUEUEX     ERR AND ABN
         DATA     OBUF,140          BUFFER AND SIZE
FMREAL   TXT      '(RUNNING SYSTEM USED)'
*
         USECT    DATA
*
LDEVEI   LCD,0    0                 M:LDEV
         DATA     X'90100000'
         DATA     X'C3F2'           C2
         DATA     0                 ITS IN.
QUEFN    PLM,0    X'A0A',5          FORM,'(NAK)(NAK)(NAK)(NAK)'
         USECT    CODE
         PAGE
*
*        DISC GIVES A SUMMARY OF DISC AVAILABILITY IN THE FORM
*              RAD   PACK  TOTAL
*        USER XXXXX XXXXX XXXXXX
*        SYS  XXXXX XXXXX XXXXXX
*        SYMB             XXXXXX
*
DISC     PUSH     L
         LI,TU1   BA(DIS1)
         BAL,L    SLURP
         BAL,L    SLURPO
         LI,SR2   5
         LI,R     0
         STW,R    TRASH
         LI,TU1   BA(DIS2)
         BAL,L    SLURP
         LW,O     J:JIT+PRDCRM
         AWM,O    TRASH
         BAL,L    SLURPN
         LW,O     J:JIT+PRDPRM
         AWM,O    TRASH
         BAL,L    SLURPN
         LI,SR2   6                 SIX DIGITS FOR TOTAL
         LI,O     0
         XW,O     TRASH
         BAL,L    SLURPN
         BAL,L    SLURPO
         LI,TU1   BA(DIS3)
         LI,SR2   5
         BAL,L    SLURP
         LI,S     0                 NO INDEX
         LI,SR1   GRANRAD
         BAL,L    LW
         AWM,O    TRASH
         BAL,L    SLURPN
         LI,SR1   GRANPACK
         BAL,L    LW
         AWM,O    TRASH
         BAL,L    SLURPN
         LI,SR2   6
         LI,O     0
         XW,O     TRASH
         BAL,L    SLURPN
         BAL,L    SLURPO
         LI,TU1   BA(DIS4)
         BAL,L    SLURP
         LI,SR1   GRANSYM
         BAL,L    LW
         BAL,L    SLURPN
         BAL,L    SLURPO
         B        CMDX
*
*        PCOUNT GIVES THE NUMBER OF TIMES WE HAVE MOVED THE
*        WINDOW PAGE AROUND, AND RESETS THAT COUNT TO ZERO.
*
PCNT     PUSH     L
         LI,SR2   0
         LI,TU1   BA(PCNT1)
         BAL,L    SLURP
         LI,O     0
         XW,O     PCOUNT
         BAL,L    SLURPN
         BAL,L    SLURPO
         B        CMDX
         PAGE
*
*        TAPES COMMAND DISPLAYS THE STATUS OF THE TAPE DRIVES
*        IN THE SYSTEM USING INFORMATION GLEANED FROM THE AVR TABLES.
*
TAPES    PUSH     L
         LI,S     AVRTBLSIZ-1       # OF DRIVES ON THIS BEAST.
TAPE1    LI,TU1   BA(STATM3)        HEADER TO USE
         BAL,L    SLURP             POKE OUT A SPACE.
         LI,SR1   AVRTBL            GET THE INFO ON THIS ONE.
         BAL,L    LD                ITS A DOUBLEWORD.
         LD,R     0                 SAVE FOR A MINUTE.
         LI,SR1   AVRID             LETS LOOK AT AVRID TOO
         BAL,L    LH                WHILE WE'RE AT IT.
         LW,RU1   O                 SAVE THAT TOO....
         LW,O     S                 PRINT OUT DRIVE NUMBER FIRST.
         LI,SR2   2                 AS TWO DIGITS.
         BAL,L    SLURPN
         LW,O     RU1               NOW GET THE AVR ID
         LI,SR2   4                 AND PRINT IN 4 HEX DIGITS
         BAL,L    SLURPH
         LW,0     R                 GET LABEL, IF ANY
         LI,O     0
         BAL,L    SLURPC            AND PRINT THAT OUT.
         LB,RU1   3                 JUSTIFY STATUS BITS
         CI,RU1   X'10'             CHECK FOR SCRATCH
         BAZ      TAPER
         LD,0     TAPEM1            SCRATCH TEXT
         BAL,L    SLURPC
TAPER    BAL,L    SLURPO
         BDR,S    TAPE1             FOR EACH DRIVE IN SYSTEM
         CI,S     0                 THERE IS A DRIVE ZERO, YOU KNOW.
         BE       TAPE1             SO WE'D BETTER CHECK IT TOO..
         B        CMDX              THAT'S IT.
         PAGE
*
*        THE USER COMMAND TELLS YOU ABOUT THE SUPPLIED USER ID.
*
USER     PUSH     L
         BAL,L    ARGH              GO GET USER NUMBER
         BCS,8    STATEH            NOTHING. GRIPE.
         B        USER01            HOP DOWN.
USER00   BAL,L    ARGH              GET ANOTHER USER NUMBER
         BCS,8    CMDX              NO MORE TO BE HAD.
USER01   CI,O     SMUIS             IS IT LEGAL?
         BLE      USER02            BL/GOOD ID, LOOK FOR STUFF
         LW,SR2   1                 LETS BE NICE ABOUT IT, AND LOOK FOR
         LI,SR1   PLH:SID           A BATCH ID LIKE THIS BEFORE CALLING
         LI,S     LPART             THIS AN ERROR.
         BAL,L    LH
         CW,O     SR2               IS IT THIS ONE??
         BE       %+3               B/YUP, FOUND IT.
         BDR,S    %-3               LOOK THRU BATCH TABLES.
         B        USER00            NUTS. NOT THERE.....
         LI,SR1   PLB:USR
         BAL,L    LB                FETCH THE USER ID BYTE,
USER02   LW,S     O                 USE IT AS AN INDEX INTO
         LI,SR1   UB:US             STATE TABLE TO SEE IF ITS
         BAL,L    LB                BEING USED.
         CI,O     SNULL             CHECK FOR NULL STATE.
         BE       USER00            NO STATE MEANS NO USER. BYE.
         LW,O     S                 PUT IT BACK.
USER0    LI,SR2   0                 ENTRY USED BY JIT, LONG USERS CMDS
         LI,TU1   BA(USERM1)        HEADER TO USE
         LI,T     0
         BAL,L    SLURP             OUTPUT BEGINNING
         STW,O    TRASH             SAVE THAT ID FOR LATER
         BAL,L    SLURPH            PUT IT OUT
         BAL,L    USERIS            GO TELL ME IF HE GHOST OR WHAT.
         BAL,L    SLURPO            SPIT IT OUT
         LI,TU1   BA(USERM2)        HEADER TO USE FOR SIZE AND STATE
         LW,S     TRASH             USE ID AS INDEX
         BAL,L    SLURP             FIRST PART OF HEADER
         LI,SR1   UB:PCT            GET PAGE COUNT
         BAL,L    LB
         BAL,L    SLURPN            SPIT THAT OUT
         LI,SR1   UB:US
         BAL,L    LB                GET CURRENT STATE
         LW,0     STATETXT,O        GET THE TEXT FOR THE STATE
         BAL,L    SLURPC            AND PRINT THAT OUT.
         LI,SR1   UB:PRIO           CURRENT EXECUTION PRIO
         BAL,L    LB                FETCH THAT,
         BAL,L    SLURPH            AND PUMP OUT AS HEX
         LI,SR1   UB:PRIOB
         BAL,L    LB                BASE EXECUTION PRIO
         BAL,L    SLURPH            AND DUMP THAT TOO.
         LI,SR1   UB:ACP            LOOK AT COMMAND PROC.
         BAL,L    LB
         BE       USER2             NOPE.
         LI,TU1   BA(USERM3)        IF THERE IS, WE'LL
         BAL,L    USRSUB            GO POKE OUT P:NAME ENTRY.
USER2    LW,S     TRASH             GET USER ID BYTE BACK
         LI,SR1   UB:APR            LOOK AT ASSOCIATED PROCESSOR
         BAL,L    LB
         BE       USER3             NO GOT......
         LI,TU1   BA(USERM4)
         BAL,L    USRSUB            THE USER'S APR.
USER3    LW,S     TRASH
         LI,SR1   UB:OV             MON OVERLAY NEEDED
         BAL,L    LB
         BE       USER4
         LI,TU1   BA(USERM5)
         BAL,L    USRSUB            THE USER'S MON OVERLAY.
USER4    BAL,L    SLURPO            THE END......
         B        USER00            BYE..........
USRSUB   PUSH     L                 SAVE LINK
         BAL,L    SLURP             HEADER INFO
         LW,S     O
         LI,SR1   P:NAME
         BAL,L    LD                GO GET P:NAME TEXTC
         LI,L     CMDX              RETURN THRU EXIT LOGIC
         B        SLURPT            GO SLURP IT IN.
         PAGE
*
*        USERIS DETERMINES IF THE ISER ID IN 1 IS GHOST,BATCH
*        OR ONLINE BY SEARCHING PLB:USER TO SEE IF IT IS IN BATCH,
*        THEN SEARCHING SB:GJOBUN TO SEE IF IT IS A GHOST. IF BOTH
*        SEARCHES FAIL, IT MUST BE ONLINE. THE INFO IS PUT INTO THE
*        BUFFER
*
USERIS   PUSH     15,TU1            SAVE ALL BUT T, THE OUTPUT PTR.
         LW,2     1                 SAVE USER ID
         LI,O     X'FF'             LETS SEE IF THIS USER ID
         AND,O    J:JIT             HAPPENS TO BE MINE.....
         CW,O     R
         BNE      %+3
         LW,0     =' YOU'           IT IS....LET PEOPLE KNOW...
         BAL,L    SLURPC
         LI,S     MAXG              MAX NUMBER OF GHOSTS THERE CAN BE
         LI,SR1   SB:GJOBUN         AND THE ID TABLE
         BAL,L    LB                GET ONE
         CW,O     R                 ARE THEY EQUAL?
         BE       USERISG           YUP, GOT 'EM.......
         BDR,S    %-3               KEEP LOOKING
         CI,S     0                 SLOT ZERO IN TABLE.
         BE       %-5
         LI,S     LPART             NOW WE CHECK PARTITION TABLES
         LI,SR1   PLB:USR           TO SEE IF ITS BATCH.
         BAL,L    LB
         CW,O     R
         BE       USERISB           FOUND IT.
         BDR,S    %-3               OR KEEP LOOKING.
USERISO  LI,TU1   BA(USROM)         MUST BE ONLINE, I GUESS...
         BAL,L    SLURP
         LI,SR1   LB:UN             SO WE'LL SEARCH LB:UN TO FIND
         LI,S     LNOL              OUT WHAT COC LINE IT IS.
         BAL,L    LB
         CW,R     O
         BE       %+2               BUT IF I DONT FIND IT,
         BDR,S    %-3               I WONT BE BUGGED.
         LW,O     S                 WE WANT THE LINE NUMBER INDEX.
         BAL,L    SLURPH            I'LL JUST SPIT OUT A ZERO.
USERISX  PULL     15,TU1            RESTORE ALL
         B        0,L               AND SPLIT.
USERISG  LI,TU1   BA(USRGM)         HEADER FOR GHOST USER
         BAL,L    SLURP
         LI,SR1   S:GJOBTBL         FIND THE NAME OF THIS GHOST
         BAL,L    LD
         BAL,L    SLURPT
         B        USERISX           THAT'S ALL FOR GHOSTS.
USERISB  LI,TU1   BA(USRBM)         FOR BATCH USERS.
         BAL,L    SLURP
         LW,O     S
         BAL,L    SLURPN            PUT OUT PARTITION NUMBER
         LI,SR1   PLD:ACT           AND GO GET THE ACCOUNT
         BAL,L    LD
         BAL,L    SLURPC
         LI,SR1   PLH:SID           AND THE SYSID FOR IT.
         BAL,L    LH
         B        USERISX-1         THAT'S ALL......
         PAGE
*
*        PUNT.... WHEN IN DOUBT, PUNT.....
*
PUNT     PUSH     L
         BAL,L    USERS             JUST FOR WARMUPS....
         LI,S     SMUIS             MAX NUMBER OF USERS IN SYSTEM
         STW,S    TRASH             A GOOD PLACE TO STASH IT.
         B        PUNT2
PUNT1    LW,S     TRASH
         LI,SR1   UB:US
         BAL,L    LB                THIS USER ID ACTIVE???
         CI,O     SNULL             CHECK FOR NULL STATE.
         BE       PUNTER            NOPE. SCRAM.
         LI,O     PUNT2             GROSS CODE TO GET AROUND NOT
         PUSH     O                 HAVING CLEAN ENTRY TO USER
         LW,O     TRASH
         B        USER0             ROUTINE. ENTER THRU SIDE DOOR.
PUNT2    LB,0     8BLNKS            LOAD A BLANK
         STB,0    OBUF              POKE INTO THE BUFFER
         LI,T     1
         BAL,L    SLURPO            ALL THIS TO SPIT OUT A BLANK LINE.
PUNTER   MTW,-1   TRASH             ANY MORE TO GO???
         BG       PUNT1             YUP. KEEP GOING
         B        CMDX              ALL DONE. BYE......
         PAGE
*
*        DOALL IS CALLED BY THE 'ALL' COMMAND, AND DOES ALL
*        THE COMMANDS PRECEEDING IT IN THE CMDTV VECTOR.
*        THE LAST ONE IT DOES IS OKEXIT, WHICH EXITS THE PROGRAM.
*
DOALL    LI,S     CMDALL            NUMBER OF ENTRIES AHEAD OF ALL.
DOALL1   LI,R     2
         MTW,0    ONLIN             ARE WE ONLINE??
         BE       %+3               YUP. HOP DOWN
         LI,O     DIS1              NULL WRITE IF NOT ONLINE OUTPUT.
         CAL1,1   WRITEIT
         LI,TU1   BA(DOOM1)
         BAL,L    SLURP
         LD,0     CMDTXT,S          COMMAND NAME
         BAL,L    SLURPT
         BAL,L    SLURPO
         PUSH     S
         LW,5     CMDTV,S
         CI,TU1   X'A000'           IF LOWER THAN HERE,
         BG       %+2               IT'S PROBABLY UNDEFINED.
         LI,TU1   EH
         LI,T     0
         BAL,L    0,TU1
         PULL     S
         BDR,7    DOALL1
*
*        EH SPITS OUT A USEFUL AND INFORMATIVE ERROR MESSAGE.....
*
EHX      PULL     L                 RESTORE OLD LINK FOR EXIT
EH       LI,O     EMSG
         LI,R     3
         CAL1,1   WRITEIT
         B        0,L               SNICKER.........
         PAGE
*
*        BATCH DISPLAYS THE STATUS OF BATCH PARTITIONS,
*        EITHER LOCKED, OR THE SYSID, SIZE AND ACCOUNT
*        OF THE BATCH JOB.
*
BATCH    PUSH     L                 SAUSAGE........
         LI,S     0
         LI,T     0
         LI,SR1   S:BUIS
         BAL,L    LW                SEE IF ANY BATCH RUNNING NOW.
         BG       BATCH1            GUESS SO.
         LI,O     NOBATCH           IF NOT, PRINT OUT A
         LI,R     22                REASONABLE MESSAGE
         CAL1,1   WRITEIT
         LI,S     0
         LI,SR1   S:BUAIS           HOW MANY BATCH USERS ALLOWED?
         BAL,L    LW
         LI,TU1   BA(BAT1)
         BAL,L    SLURP
         LI,SR2   0                 HOWEVER MANY YOU WANT.
         BAL,L    SLURPN
         BAL,L    SLURPO            OUTPUT IT.
         B        CMDX              SPLIT.
BATCH1   LI,D2    LPART             NUMBER OF PARTITIONS IN SYS.
         LI,S     1                 STARTING PARTITION NUMBER
         LI,TU1   BA(BAT2)
         BAL,L    SLURP
         BAL,L    SLURPO            WRITE HEADER
BATCH2   LI,T     0                 POKE BACK TO ZERO
         LI,TU1   BA(BAT3)          FORMATTER
         LI,SR2   4                 4 DIGIT NUMBERS
         LI,SR1   PLH:SID           CHECK SYSID FOR NONZERO
         BAL,L    LH                TO SEE IF A JOB IS RUNNING
         BE       BATCH3-1          NOPE. CHECK NEXT PARTITION.
         LW,RU1   O                 SAVE ID
         BAL,L    SLURP
         LW,O     S                 PARTITION NUMBER
         BAL,L    SLURPN
         LW,O     RU1               SYSID
         BAL,L    SLURPH
         LI,SR1   PLB:USR           GET USER NUMBER FOR THIS THING
         BAL,L    LB
         LW,SR4   O                 REMEMBER THIS FOR A WHILE....
         BAL,L    SLURPH            GO SPIT THAT OUT TOO.
         LW,D1    S                 SAVE PARTITION NUMBER
         LI,SR1   UB:PCT            LOOK AT UB:US
         LW,S     O                 INDEXED BY USER NUMBER
         BAL,L    LB                TO GET USER PAGE SIZE
         BAL,L    SLURPN
         LI,SR1   UB:US             GET CURRENT USER STATE
         BAL,L    LB
         LW,0     STATETXT,O        TEXT FOR IT
         BAL,L    SLURPC            AND SPIT IT OUT
         LW,S     D1                RESTORE PARTITION NUMBER
         LI,SR1   PLD:ACT           ACCOUNT
         BAL,L    LD
         BAL,L    SLURPC            8 CHARACTERS.
         LW,S     SR4               REMEMBER THAT USER ID??
         LI,SR1   UB:APR            LETS PRINT OUT THE PROCESSOR
         BAL,L    LB                THATS BEING USED.
         LW,S     O
         LI,SR1   P:NAME
         BAL,L    LD
         BAL,L    SLURPT
         BAL,L    SLURPO            THATS THAT LINE.
         LW,S     D1                LOOK AT THE
         AI,S     O                 NEXT PARTITION
BATCH3   BDR,D2   BATCH2            KEEP LOOKING THROUGH PARTITIONS.
         B        CMDX              ALL DONE.
         PAGE
*
*        GETDELTA ASSOCIATES DELTA TO THE PROGRAM AND ALLOWS
*        THE USER TO EXAMINE THE MONITOR AS WITH ANALZ DELTA.
*        I EVEN POINT DELTA AT THE SYSTEM SYMBOL TABLE.
*
GETDELTA MTW,0    DELTAHERE         IS IT ASSOCIATED NOW??
         BG       0,L               YUP. NOT A LOT TO DO.
         CAL1,4   ASSOCDELTA        ASSOCIATE DELTA
         BCS,8    EH                OOPS...NOT THERE...
         MTW,1    DELTAHERE         REMEMBER ITS AROUND...
         B        0,L               AND RETURN.
ASSOCDELTA EQU    %
         GEN,8,7,17 4,1,DELTAS      FOR B00, ENTER DELTA DIRECTLY.
         TXTC     'DELTA'           GET DELTA, PLEASE.
         DATA     0                 I DONT TRUST ME.
DELTAS   DATA     DGET              DELTA GET ROUTINE
         DATA     DPUT              DELTA PUT ROUTINE
         DATA     WHUT              EXIT LOC
         DATA     %+1               LMNLOC
         TXT      ':SYS    '        USE MONSTK IN :SYS
         DATA     0,0               NO PASSWORD, I HOPE..
         TXTC     'MONSTK'          THE NAME..
BYEDELTA GEN,8,24 5,0               GET RID OF DELTA IF ASSOCIATED.
         TXTC     'DELTA'
         PAGE
*
*        DGET IS THE GET ROUTINE FOR DELTA. THE WORD ADDRESS IS IN
*        RU1, THE LINK IS T. THE VALUE IS RETURNED IN RU1. WE CALL
*        LOADTHING TO DO THE DIRTYWORK.
*
DGET     PUSH     10,TU1
         LI,S     0
         LW,SR1   RU1               THE THING TO GET
         BAL,L    LW                GO GET IT ALREADY.
         LW,RU1   O                 PUT IT IN THE RIGHT SPOT
         PULL     10,TU1
         B        0,T               AND SPLIT.
*
*        DPUT IS THE DELTA PUT ROUTINE. WE GRIPES AND RETURNS.
*
DPUT     LI,O     DPUTM
         LI,R     4                 I'M NOT GOING TO POKE INTO
         CAL1,1   WRITEIT           THE MONITOR.....
         B        0,T               RETURN TO DELTA
DPUTM    TXT      'NOPE'            (I WONT DO IT.
*
*        UNDELTA IS CALLED EITHER BY THE COMMAND 'UNDELTA'
*        OR BY OKEXIT TO GET RID OF DELTA. IF DELTA ISNT AROUND,
*        WE GRIPE.
*
UNDELTA  CAL1,4   BYEDELTA          GET RID OF HIM
         BCS,T    EH                IT WASNT THERE!!!!!!
         B        0,L
         PAGE
*
*        GHOST GIVES THE NAMES AND SYSIDS OF RUNNING GHOSTS.
*
GHOST    PUSH     L
         LI,T     0
         LI,S     0
         LI,SR1   S:GUIS
         BAL,L    LW
         BG       GHOST1            GHOSTS RUNNING. GO DISPLAY 'EM.
         LI,O     GHOSTM1           SORRY, BUB, NO GHOSTS AROUND
         LI,R     10                HERE NOW..PROBABLY NEVER HAPPEN...
         CAL1,1   WRITEIT
         B        CMDX              BYE........
GHOST1   LI,TU1   BA(GHOSTM2)
         BAL,L    SLURP
         BAL,L    SLURPO            HEADER.
         LI,D1    MAXG
GHOST2   LW,S     D1
         LI,SR1   SB:GJOBUN         CHECK FOR A JOB NUMBER
         BAL,L    LB
         BE       GHOST3            NOT RUNNING HERE.....
         LI,T     0
         LI,TU1   BA(STATM3)
         LI,SR2   4
         BAL,L    SLURPH            ID
         LI,SR1   S:GJOBACN         WHAT IS THE ACCOUNT??
         BAL,L    LD
         BAL,L    SLURPC
         LI,SR1   S:GJOBTBL
         BAL,L    LD                GET THE NAME
         BAL,L    SLURPT
         BAL,L    SLURPO            PRINT THE STUFF
GHOST3   BDR,D1   GHOST2
         B        CMDX              POOF..........
         PAGE
*
*        DISPLAY SHOWS THE TIME OF DAY, THE USER'S NAME AND
*        ACCOUNT, AND THE PRIV LEVEL (=> X'80' WE KNOW.)
*
DISPLAY  PUSH     L
         CAL1,8   DISPL1            GET THE TIME AND SUCH.
         LI,O     OBUF
         LI,R     16
         CAL1,1   WRITEIT           AND SPEW IT OUT.
INITDIS  LI,T     0                 INITIAL DISPLAY BY SPYINIT
         LI,TU1   BA(DISPM1)
         BAL,L    SLURP             SPACE OVER
         LCI      4
         LM,0     J:JIT+1           LOAD NAME AND ACCOUNT.
         BAL,L    SLURPC            NAME-TWO WORDS.
         LD,0     2                 FIRST TWO OF ACCT.
         BAL,L    SLURPC
         LW,0     J:JIT+5
         LI,O     0
         BAL,L    SLURPC
         LI,SR2   2
         LB,O     JB:PRIV           PRIV LEVEL
         BAL,L    SLURPH
         LW,O     J:JIT
         AND,O    M8                INCLUDE USER ID IN THE MESSAGE.
         BAL,L    SLURPH
         BAL,L    SLURPO            WRITE IT OUT
         B        CMDX
DISPL1   GEN,8,24 X'10',OBUF        M:TIME CAL TO OBUF.
         PAGE
*
*        KEYIN    IS A PRIVELIGED COMMAND THAT HAS MUCH THE EFFECT
*                 THAT THE NAME SUGGESTS. FOR ONLINE USERS ONLY, THE
*        USER IS PROMPTED, AND A READ OF M:UC IS DONE. THAT INPUT IS
*        SHOVELED INTO THE SYSTEM KEYIN BUFFER, AND THE KEYIN GHOST
*        IS KICKED. OTHER THAN MAKING SURE THERE IS A LINE FEED TERMINATING
*        THE INPUT LINE, NO OTHER CHECKING IS DONE ON THE USER INPUT.
*
KEYIN    PUSH     L
         LC       J:JIT             ARE WE ONLINE USER??
         BCR,8    EHX               B/NOPE, GET LOST......
         CAL1,1   =X'2C00005A'      M:PC '!'
         CAL1,1   READUC            READ THE TERMINAL.
         CAL1,1   =X'2C000060'      M:PC '-'
         LH,2     M:UC+4
         SLS,2    -1
         CI,R     1                 ANYTHING TYPED IN??
         BLE      NAILX             B/NOPE, BUG OUT.
         LW,RU1   R                 COPY LENGTH
         AI,RU1   -1
         LI,T     X'15'             NEW LINE CHARACTER
         STB,T    OBUF,RU1          PUT AT END OF TEXT.
         LD,L     KMOVE             LOAD MBS CONTROL STUFF
         STB,R    S                 MOVE ONLY WHAT'S NEEDED.
         MBS,L    0                 MOVE IT IN.
         LD,0     TCKEYN            TEXTC FOR KEYIN
         BAL,SR3  T:GJOBSTRT        KICK THE GHOST
         BCS,8    KLATER            HE SAY BUZZ OFF...
         SLAVE    CMDX
KLATER   LI,O     TLATER            LATER...
         LI,R     6
         CAL1,1   WRITEIT           SPEW.....
         SLAVE    CMDX              AND QUIT SLAVE MODE.
*
READUC   GEN,8,24 X'10',M:UC
         DATA     X'30000010'
         DATA     OBUF,80
         BOUND    8
KMOVE    DATA     BA(OBUF)
         DATA     BA(KEYINBUF)
TCKEYN   TXTC     'KEYIN'           FOR T:GJOBSTRT
TLATER   TXT      'LATER!'
         PAGE
*
*        RUE      IS A PRIVELIGED COMMAND THAT ALLOWS THE USER TO REPORT
*                 SOME RANDOM EVENT ON ANOTHER USER. THE FORM IS
*        RUE ID,EVENT               EVENT= 'OFF,QFI, ETC...
*        THE TRANSITION IS CHECKED TO MAKE SURE IT WILL NOT CAUSE
*        A SC-02 BEFORE WE DO IT........
*
RUE      PUSH     L
         BAL,L    GUN               GET USER NUMBER.
         PUSH     1                 AND STASH FOR A WHILE.
         LI,S     0
         LI,SR1   8
         BAL,L    ARGT              GO GET EVENT TEXT
         BCS,8    NAILEH            WHAT'S THIS TRASH????
         LI,R     LEVENT            LAST EVENT
         CW,0     TEVENT,2          SEARCH THE TABLE OF EVENTS
         BE       %+3               B/FOUND IT.
         BDR,2    %-2
         B        NAILEH            GROSS....NOT FOUND...
         PULL     3                 EVENT IN 2, USER # IN 3.
         PUSH     2,2               STASH ON STACK FOR A WHILE.
         DISABLE                    DONT BUG ME...I'M BUSY....
         LB,5     UB:US,3           GET USER'S CURRENT STATE.
         LW,6     X1,5              BIT CORRESPONDING TO IT
TRCE1    CW,6     S:SET:,2          ARE WE AT THE RIGHT PLACE
         BANZ     TRCE3             YES
         LW,7     S:SET:,2          CHECK FOR CONTINUATION
         BLZ      TRCE2             YES
         ENABLE
         LI,O     SC02M             YOU WIN A SC-02.....
         LI,R     13                LENGTH
         CAL1,1   WRITEIT
         PULL     2,0
         SLAVE    CMDX              EXIT SLAVE MODE
SC02M    TXT      'NOPE! SC/02..'
*
TRCE2    AI,3     1                 NEXT ENTRY
         B        TRCE1             CONTINUE
TRCE3    PULL     2,2               REALLY NEVER NEEDED TO SAVE 'EM...
         LW,5     3                 USER IN 5
         LW,6     2                 EVENT IN 6
         BAL,SR4  T:RUE             GO REPORT EVENT.
         SLAVE    CMDX              AND EXIT SLAVE.
*
*        NOTE THAT THE RCE CODE WAS LIFTED FROM C00 SCHED- MAY NOT WORK
*        ON B00 SYSTEMS.....(I WOULDN'T EVEN TRY.....)
*        LIKEWISE, THE EVENT TABLE IS LIFTED FROM C00.....
*
TEVENT   TXT      'IIP QMF CRD CIC CBL CUB CBK CEC ERR OFF WU  SL  '
         TXT      'QA  ART UQA KO  AP  QE  IC  QFI NSYMSYMFNSYDSYMD'
         TXT      'OCR NOCRCFB CBA ND  DPA QFACUQFANQW NQR'
LEVENT   EQU      X'31'             LAST ONE IN C00......
         PAGE
*
*        PRIOB    IS A PRIVELIGED COMMAND THAT ALLOWS THE USER TO
*                 MODIFY THE BASE EXECUTION PRIORITY (UB:PRIOB) OF
*        ANY USER IN THE SYSTEM. THE FORMAT OF THE COMMAND IS:
*                 PRIOB UID,NPRIO
*        UID=     USER ID, MAY BE BATCH ID.
*        NPRIO=   NEW PRIORITY BASE VALUE, X'FE'=> NPRIO => X'20'
*                 NOTE THAT PRIORITIES WITH VALUES LESS THAN X'C0'
*                 ARE NOT RECCOMENDED......FAIR WARNING......
*
PRIOB    PUSH     L
         BAL,L    GUN               GET USER NUMBER.
PRIOB1   PUSH     1                 SAVE THAT FOR A WHILE....
         BAL,L    ARGH              AND GO GET NEW BASE PRIO.
         BCR,8    PRIOB2            B/LOOKS OK, SO FAR....
PRIOBN   PULL     1                 GET RID OF THIS TRASH
         B        NAILEH            AND RETURN GRIPING.
PRIOB2   CI,O     X'FE'             IS IT SMALL ENOUGH??
         BG       PRIOBN            BG/NOPE, ITS NOT...
         CI,O     X'20'             IS IT TOO SMALL????
         BL       PRIOBN            BL/YES. DONT DO IT.....
         PULL     R
         WD,0     X'37'             DONT BUG ME FOR A WHILE.....
         STB,O    UB:PRIOB,R
         WD,0     X'27'             JUST FOR ONE INSTRUCTION, BUT NEEDED.
         LW,O     R                 MOVE USER NUMBER DOWN TO 1...
         SLAVE    USER0             GO SLAVE TO INFORMING ROUTINE
         PAGE
*
*        NAIL IS A PRIVELIGED COMMAND THAT WILL NAIL A SELECTED
*        GROUP OF USERS ON THE SYSTEM, EXCEPT THIS PROGRAM.
*        THE ARGUMENT TO NAIL IS:
*                 GHOST             NAIL ALL GHOSTS, EXCEPT 2,3,4
*                 BATCH             ALL BATCH USERS
*                 ONLINE            ALL ONLINE USERS
*                 ALL               EVERYBODY BUT ME
*                 NAME              ALL USERS ASSOCIATED WITH NAME, WHERE
*                                   NAME IS IN THE SHARED PROC TABLES.
*                 #                 USER #
*                 #,#,#             SELECTED USERS.
*
*        WE NAIL PEOPLE BY REPORTING AN ABORT EVENT ON THEM TO THE
*        SCHEDULER THRU T:RUE.
*
NAIL     PUSH     L
NAIL0    LI,S     TRASH             PUT THE BODY HERE.
         LD,R     8BLNKS
         STD,R    TRASH             PRE-BLANK THE BUFFER.
         LI,SR1   7
         BAL,L    ARGC              GO GET TEXTC ARGUMENT
         BCR,8    %+2               LOOKS OK.
NAILX    SLAVE    CMDX              SPLIT SLAVE MODE.
         LD,0     TRASH             PICK UP THE ARGUMENT
         CD,0     NGT               GHOST?
         BE       NAILG             GO NAIL GHOSTS
         CD,0     NBT
         BE       NAILB             GO NAIL BATCH
         CD,0     NOLT
         BE       NAILO             NAIL ONLINE USERS
         CD,0     NAT
         BE       NAILA             GO NAIL EVERYBODY....
         CD,0     NMT               A WISE GUY???
         BE       OFF               SAID 'NAIL ME'.....CON GUSTO.....
         LI,S     PNAMEND
         CD,0     P:NAME,S          SEE IF WANTED TO NAIL PROCESSOR
         BE       NAILS             B/NAIL ANYBODY ATTACHED TO THIS
         BDR,S    %-2               SEARCH PROCESSORS+MON OVERLAYS
         LB,R     0
         BE       NAILX
         CI,R     2
         BLE      %+2
NAILEH   SLAVE    EHX               CAN'T BE USER NUMBER.
         LI,RU1   1
         LI,TU1   0                 USER # TO NAIL
NAIL2    LB,O     0,RU1
         CI,O     '9'
         BG       NAILEH
         CI,O     '0'
         BGE      %+2
         AI,O     X'39'
         AI,O     -'0'
         BL       NAILEH            BAD DIGIT
         CI,O     16
         BGE      NAILEH            DITTO.
         SLS,TU1  4
         AW,TU1   O                 ADD IN HEX DIGIT
         AI,RU1   1
         BDR,2    NAIL2             GO COLLECT NUMBER
         BAL,SR4  NAILU             GO NAIL THIS USER
         B        NAIL0             AND LOOK FOR MORE.
*
*        NAILU NAILS THE USER NUMBER PASSED IN TU1 IF IT IS LEGAL,
*                 A LOGGED ON USER, AND NOT ME.
*
NAILU    CI,TU1   SMUIS
         BG       *11               NOPE.
         CI,TU1   0
         BE       *11
         LB,6     UB:US,5
         CI,6     SNULL
         BE       *11               NOT ON. BYE....
         LI,6     E:OFF
         BLOCK    T:RUE             NAIL......
*
*        NAILA    NAIL ALL USERS IN SYSTEM.
*
NAILA    LI,TU1   SMUIS
         CI,TU1   4
         BLE      NAIL0             DONT NAIL 'CAT OR RBBAT.
         PUSH     TU1
         BAL,SR4  NAILU
         PULL     TU1
         BDR,TU1  NAILA+1
*
NAILB    LI,S     LPART             NUMBER OF PARTITIONS
         PUSH     S
         LB,TU1   PLB:USR,S         GET USER NUMBER, IF ANY
         BAL,SR4  NAILU
         PULL     S
         BDR,S    NAILB+1
         B        NAIL0             LOOK FOR MORE TROUBLE.
*
NAILG    LI,S     MAXG
         PUSH     S
         LB,TU1   SB:GJOBUN,S
         CI,TU1   4
         BLE      %+2               DONT NAIL 'CAT, RBBAT....
         BAL,SR4  NAILU
         PULL     S
         BDR,S    NAILG+1
         B        NAIL0
*
NAILO    LI,S     LNOL
         PUSH     S
         LB,TU1   LB:UN,S
         BAL,SR4  NAILU
         PULL     S
         BDR,S    NAILO+1
         LB,TU1   LB:UN
         BAL,SR4  NAILU
         B        NAIL0
*
*        NAILS    NAIL ALL USERS ASSOC. WITH P:NAME ENTRY IN R7.
*
NAILS    LW,SR3   S                 SAVE THE INDEX UP HERE
         LI,TU1   SMUIS             NUMBER OF USERS IN SYSTEM
NAILS0   CB,SR3   UB:OV,TU1
         BE       NAILS1            B/YUP, GET THIS ONE
         CB,SR3   UB:ACP,TU1
         BE       NAILS1
         CB,SR3   UB:APR,TU1
         BNE      NAILS2            B/NO, LEAVE THIS ONE ALONE.
NAILS1   PUSH     SR3               SAVE MAGIC INDEX
         PUSH     TU1               AND USER NUMBER
         BAL,SR4  NAILU             GO BLITZ THE USER
         PULL     TU1
         PULL     SR3
NAILS2   CI,TU1   4                 GOT DOWN TO NITTY GRITTY YET??
         BLE      NAIL0             DONT NAIL 'CAT OR RBBAT....
         BDR,TU1  NAILS0
         BOUND    8
NGT      TXTC     'GHOST'
NBT      TXTC     'BATCH'
NOLT     TXTC     'ONLINE'
NAT      TXTC     'ALL'
         TXT      '    '            PAD TO 8 CHRS FOR CD.
NMT      TXTC     'ME'              FOR 'NAIL ME'
         TXT      '    '            WE WILL COMPLY......
         PAGE
*
*        GUN      IS A SUBROUTINE USED BY PRIVELIGED FUNCTION
*                 TO GET A USER NUMBER. THE NUMBER IS COLLECTED USING
*        ARGH, AND CHECKED TO BE LEGAL; IF HIGHER THAN SMUIS, THE
*        BATCH PARTITIONS ARE SEARCHED. IF FOUND, THE USER ID IS RETURNED
*        IN R1, IF NOT, WE EXIT THRU EHX.
*
GUN      PUSH     L
         BAL,L    ARGH              GO GET NUMBER
         BCS,8    GUNE              B/GROSS...NOT THERE.
         CI,O     0
         BE       GUNE
         CI,O     SMUIS             IS IT LEGAL???
         BLE      CMDX              B/YES.
         PUSH     4,R               SAVE THESE FOR A WHILE.
         LW,RU1   O                 THE NUMBER WE'RE HUNTING FOR.
         LI,T     LPART             # OF PARTITIONS
         CH,RU1   PLH:SID,T         ASSUME RUNNING MASTER.....
         BE       GUN1              B/FOUND IT.
         BDR,T    %-2               SEARCH 'EM ALL.
         PULL     4,R               NOT FOUND.
GUNE     PULL     L
         SLAVE    EHX               SPLIT COMPLAINING.
GUN1     LB,O     PLB:USR,T         LOAD THE ID
         PULL     4,R
         B        CMDX              AND RETURN TO CALLER.
         PAGE
*
*        THE CORE COMMAND DIRECTS THE PROGRAM TO USE THE RUNNING
*        MONITOR FOR INPUT. THIS IS THE DEFAULT MODE.
*
CORE     PUSH     L
         MTW,0    USNFILE           WERE WE USING A FILE?
         BGE      CMDX              NOPE. BYE......
         BAL,L    FREEM             IF SO, FREE ALL PAGES
         LI,O     1
         STW,O    USNFILE           WE ARENT USING THE FILE ANYMORE.
         CAL1,1   CLOSEEI           CLOSE THE THING.
         B        CMDX
*
CLOSEEI  GEN,8,24 X'15',M:EI        CLOSE M:EI
         GEN,O,31,32 1,0,2          WITH SAVE.
         PAGE
*
*        THE USE COMMAND DIRECTS THE PROGRAM TO USE AS INPUT
*        (FOR LTHING) A MONDMP FILE SPECIFIED. THE ARGUMENT IS
*        EXPECTED TO BE IN THE RANGE 0<N<7 BUT IF 10 IS INPUT,
*        THE LAST FILE CREATED WILL BE USED.
*        M:EI IS OPENED TO THE SPECIFIED FILE, ALL PANES IN THE
*        VIRTUAL WINDOW ARE FREED, CPANES IS SET TO 10, AND
*        REAL PAGES WE CAN STORE INTO ARE OBTAINED.
*
USE      PUSH     L
         BAL,L    ARGN              GO GET AN ARGUMENT
         BCS,8    EHX               ERROR. GRIPE.
         CI,O     8                 BETTER BE LESS THAN 8
         BG       EHX               OR ITS OUT OF RANGE.
         BL       USE1              LAST NOT SPECIFIED.
         LI,S     0                 WE WANT THE LAST FILE,
         LI,SR1   RCVRCNT           SO LETS LOOK IN RECOVER COUNT
         BAL,L    LW
         AND,O    LMSK              AND IT DOWN QUITE A BIT
         LI,TU1   BA(USENFN)
         BAL,L    SLURP
         LI,SR2   1
         BAL,L    SLURPN            TELL THEM WHICH MONDMP IN USE.
         BAL,L    SLURPO
USE1     AI,O     '0'               MAKE THAT A CHARACTER
         LI,R     3
         STB,O    UFNAME+1,2        AND POKE INTO THE OPEN FPT
         LI,O     X'0020'
         CH,O     M:EI              IS EI OPEN????
         BAZ      %+2
         CAL1,1   CLOSEEI           NOT NOW.......
         CAL1,1   OPNDMP            TRY TO OPEN THE FILE
         BAL,L    FREEM             GOT IT! CLEAN OUT WINDOW
         LI,R     10
         STW,R    CPANES            SET UP CPANES
         LI,O     -1
         STW,O    USNFILE           AND THE FLAG WORD
         CAL1,8   MGVP-1,R          GET A PAGE FOR BUFFER
         BCS,8    LTHINGQ           OOPS....DIDNT GET IT
         BDR,R    %-2               AND FILL UP THE WINDOW AREA
         CAL1,1   SETERRS           SET ERROR AND ABN TO USEOOPS
         BAL,L    VERIFY            GO SEE IF THIS FILE MAKES SENSE.
         B        CMDX              BYE......
USENF    LI,O     USENFM
         LI,R     20                ERR/ABN ON OPEN. GRIPE
         CAL1,1   WRITEIT
         BAL,L    CORE
         B        CMDX
*
*        ERROR/ABNORMAL HANDLER FOR MONDMP FILE READS.
*
USEOOPS  EQU      %
         LI,TU1   BA(USENFO)
         LI,T     0                 SQUASH ANYTHING IN BUFFER NOW.
         BAL,L    SLURP
         LW,O     MCVM              PRINT OUT OFFENDING KEY
         LI,SR2   0
         BAL,L    SLURPH
         LW,O     SR3               AND ERROR CODE/SUBCODE
         BAL,L    SLURPH
         BAL,L    SLURPO
         BAL,L    FREEM             THE MAP IS SCREWED UP NOW.
         BAL,L    RESTART           BECAUSE WE DIDNT GET THAT PAGE.
USENFM   TXT      'CAN''T OPEN THE FILE!'
USENFN   TXT      '( USING MONDMP% )%'
USENFO   TXT      'CAN''T GET PAGE! KEY=X''%'', CODE=%%%'
SETERRS  GEN,8,24 6,M:EI            M:SETDCB CAL FOR ERR/ABN ADDRESSES.
         DATA     X'C0000000',USEOOPS,USEOOPS
         PAGE
*
*        THE PANES COMMAND IS USED TO CHANGE THE SIZE OF THE
*        WINDOW THAT LTHING USES. THE ARGUMENT MUST BE IN THE RANGE
*        1 < ARG < MAXPANES OR WE WILL GRIPE. CHANGING WINDOW SIZE
*        CLEARS GRAB COUNT AND FREES ALL PAGES IF WINDOW GETS SMALLER.
*
DOPANES  PUSH     L
         BAL,L    ARGN              GET US A NUMBER
         MTW,0    USNFILE           ARE WE USING MONDMP FILE?
         BGE      %+2               NOPE.
         LW,O     CPANES            IF WE ARE, YOU CANT CHANGE THINGS.
         CI,O     1
         BL       EHX               GOT TO BE AT LEAST ONE
         CI,O     MAXPANES
         BG       EHX               AND NOT GREATER THAN MAXPANES.
         LW,SR4   REPL              LOAD FOR USE COUNT LATER.
         BG       %+2               IF VALUE IS ZERO, REAL VALUE
         LW,SR4   CPANES            IS CPANES VALUE.
         CW,O     CPANES            HOW DO THAT LOOK?
         BE       PANESE            EQUAL- JOKE. EASY TO DO....
         BL       PANESL            SMALLER- SOME WORK TO DO.
PANESG   XW,O     CPANES            NEW VALUE GREATER. SWAP 'EM.
PANESE   LI,TU1   BA(PANESM1)
         BAL,L    SLURP
         LI,SR2   0
         BAL,L    SLURPN            PRINT OLD VALUE
         LW,O     CPANES
         BAL,L    SLURPN            AND NEW VALUE
         LW,O     11                HOW MANY WERE IN USE?
         BAL,L    SLURPN
         BAL,L    SLURPO            PRINT THE LINE
         B        PCNT+1            SPLIT THRU PAGE GRAB COUNT LOGIC.
PANESL   BAL,L    FREEM             EASY WAY OUT- GET RID OF 'EM ALL..
         LI,R     0
         STW,R    REPL              RESET NEXT PAGE TO BE REPLACED.
         B        PANESG
         TITLE    'ENCHILADA-LOAD THING......'
*
*        LOAD THING LOADS INTO THE 0,O PAIR THE CONTENTS OF THE
*        THING IN PHYSICAL MEMORY DETERMINED AS LTHING,0(1) *SR1,S.
*        IF WE CAN GO MASTER, AND FLAG USNFILE IS ZERO, WE GO MASTER
*        AND LOAD THE VALUE DIRECTLY. IF WE CAN'T GO MASTER, WE USE
*        THE CVM CAL TO WINDOW THE DESIRED PAGE. IF USNFILE IS NEGATIVE,
*        WE ARE INPUTTING FROM A MONDMP FILE (SEE 'USE' COMMAND)
*        AND WE READ IN THE SPECIFIED KEYED RECORD FROM THE FILE.
*        ENTRY    RESULT
*        LB       BYTE IN REGISTER 1
*        LH       HALFWORD IN REGISTER 1
*        LW       WORD IN REGISTER 1
*        LD       DOUBLEWORD IN (0,O)
*
LB       BAL,O    LTHING            WE USE 1 TO TELL WHAT KIND
LH       BAL,O    LTHING            OF REFERENCE THIS IS
LW       BAL,O    LTHING            BYTE, HALFWORD, WORD
LD       BAL,O    LTHING            OR DOUBLEWORD.
LTHING   AI,O     -LH               NEET EASILY UNDERSTOOD CODE...
         MTW,0    NOPE              DO WE DO IT????
         BL       VERIFX            NOPE.......BYE.......
         PUSH     14,R
         MTW,0    USNFILE           READING FROM FILE??
         BL       LTHIN             B/YUP, MUST DO THAT.
         MTW,0    MFLAG             CAN WE GO MASTER MODE?
         BE       LTHIN             B/NOPE
         MASTER   LTHIM             IF WE CAN, DO IT.
LTHIN    ANLZ,T   INST,O            RIDDLE ME THIS.....
         B        %+1,O             RESOLVE TO WORD ADDRESS
         SLS,T    -1                BYTE TO HALFWORD
         SLS,T    -1                HALFWORD TO WORD
         B        %+2               A WORD IS A WORD.
         SLS,T    1                 DOUBLEWORD TO WORD.
         LW,TU1   T                 THIS IS EWA.
         SLS,TU1  -9                MAKE IT A PAGE NUMBER
         AND,S    LMSK,O            MASK DOWN INDEX VALUE
         LW,L     CPANES            HOW MANY PANES IN WINDOW NOW?
         CW,TU1   WINDOW-1,L        LOOK FOR THAT PAGE IN THE MAP
         BE       LTHING1           FOUND IT.
         BDR,L    %-2               KEEP LOOKING.
         B        LTHINGP           BLAH. CAN'T FIND IT.
LTHING1  AND,T    M9                MASK DOWN TO DISPLACEMENT
         AW,T     MFVP-1,L          ADD IN PROPER WINDOW PAGE ADDR
         LW,R     0,T               FIRST WORD
         OR,T     LMSK+1            OR WITH 1
         LW,RU1   0,T
         EXU      INST1,O           GET WHAT WE NEED FROM THAT.
LTHINGX  PULL     14,R
         CI,O     0                 SET CC'S FOR RETURN CHECKS.
         B        0,L               BYE......
LTHINGP  MTW,1    PCOUNT            WE'RE GRABBING ANOTHER PAGE..
         LW,L     REPL              THIS IS THE SLOT TO USE.
         STW,TU1  WINDOW,L          AND THIS IS THE PAGE IT REPRESENTS
         SLS,TU1  9
         STW,TU1  MCVM              POKE WORD ADDR INTO FPT
         LW,R     MFVP,L            GET OUR PAGE ADDRESS
         STW,R    MCVM+1
         LW,R     REPL              UPDATE NEXT PAGE TO REPLACE POINTER
         AI,R     1
         CW,R     CPANES
         BLE      %+2
         LI,R     0
         STW,R    REPL
         MTW,0    USNFILE           ARE WE READING FROM A FILE????
         BL       LTHINGF           YUP.
         CAL1,8   MFVP,L            IF NOT, FREE THE PAGE IN USE
         LI,R     7
         STB,R    MCVM              MAKE THAT THING PROPER FPT
         AI,L     1                 FOR LTHING CODE INDEXING.....
         CAL1,8   MCVM              GET THE PAGE
         BCR,8    LTHING1           GOT IT.
LTHINGQ  LI,O     LTHINGM           OOPS....CANT GET THE PAGE.
         LI,R     27
         CAL1,1   WRITEIT           SCREAM
         CAL1,9   3                 AND ABORT.
LTHINGF  LW,R     MCVM
         SLS,R    -9                MAKE IT PAGE NUMBER AGAIN
         OR,R     Y03               AND MAKE IT A KEY.
         STW,R    MCVM
         CAL1,1   RDPAGE            READ IN A PAGE
         AI,L     1                 WE GOT IT. CONGRATULATIONS.
         B        LTHING1
LTHIM    EXU      INST,O            DO THE LOAD FROM MAPPED MEMORY
         SLAVE    LTHINGX           AND SPLIT FORTHWITH.
INST     LB,O     *SR1,S            INSTRUCTIONS FOR THE ANALYZE
         LH,O     *SR1,S
         LW,O     *SR1,S            I THINK I DETECT A PATTERN...
         LD,0     *SR1,S
INST1    LB,O     R,S               INSTRUCTIONS FOR LOADING THE
         LH,O     R,S               WANTED WHATEVER FROM THE
         LW,O     R                 EFFECTIVE WORD IN 2
         LD,0     R
LMSK     DATA     3,O,0,0           MASKS FOR INDEX QUANTITIES
         PAGE
MFVP     EQU      %                 FREE PAGE FPT LIST
I1       DO       MAXPANES
         DATA     X'05000000'+WINDOWPG+I1**9
         FIN
MGVP     EQU      %                 GET PAGES FOR FILE INPUT
I2       DO       MAXPANES
         DATA     X'04000000'+WINDOWPG+I2**9
         FIN
RDPAGE   GEN,8,24 X'10',M:EI        READ PAGE FROM MONDMP FILE
         DATA     X'F8000010'       P1-5, WAIT.
         DATA     LTHINGQ,LTHINGQ   ERR AND ABN.
         GEN,1,31 1,MCVM+1          BUFFER ADDRESS
         DATA     512*4             A PAGE WORTH OF DATA.
         DATA     MCVM              KEY ADDRESS.
*
*        FREEM FREES ALL THE PAGES CURRENTLY IN THE WINDOW.
*
FREEVM   EQU      %
*
FREEM    LI,R     MAXPANES
         LI,RU1   -1                WE'LL ZORP THE MAP TOO......
         STW,RU1  WINDOW-1,R        SO AS NOT TO CONFUSE ANYBODY.
         CAL1,8   MFVP-1,R          ISSUE FREE PAGE CAL
         BDR,R    %-2               ON ALL OF THEM
         B        0,L               AND SPLIT.
         TITLE    'ENCHILADA- SLURP'
*
*        THE SLURP ROUTINES HANDLE ALL OUTPUT FOR THE PROGRAM
*        IN ONE WAY OR ANOTHER. THE VARIOUS ROUTINES THAT MAKE
*        UP SLURP, AND THEIR FUNCTIONS, ARE:
*        SLURP    COPY CHARACTERS INTO BUFFER UNTIL '%' HIT
*        SLURPN   OUTPUT DECIMAL NUMBER IN 1, THEN SLURP
*        SLURPH   OUTPUT HEX NUMBER IN 1, THEN SLURP
*        SLURPR   OUTPUT NUMBER IN 1 BY RADIX IN 0, THEN SLURP
*        SLURPC   OUTPUT CHRS IN 0,O PAIR
*        SLURPT   OUTPUT TEXTC IN 0,O PAIR
*        SLURPO   WRITE OUT THE OUTPUT BUFFER
*
*        REGISTERS L,T,TU1,D3 ARE CLOBBERED.
*
SLURP    LB,D3    0,TU1             GET A CHARACTER
         BE       0,L               0 MEANS WE'RE DONE.
         AI,TU1   1                 BUMP.
         CI,D3    '%'               MARKER HIT.....
         BE       0,L               YUP. LEAVE.
         STB,D3   OBUF,T            POKE AWAY
         AI,T     1
         CI,T     140               BUFFER FULL???
         BNE      SLURP             NO, KEEP GOING
         PUSH     L                 SAVE THE LINK AND THEN
         BAL,L    SLURPO            GO EMPTY THE BUFFER
         B        CMDX              BYE......
*
*        WRITE OUT THE BUFFER- EITHER ON COMMAND, OR WHEN IT GETS FULL
*
SLURPO   PUSH     2,O
         LI,O     OBUF
         LW,R     T                 CHR COUNT=BUFFER POINTER.
         BE       %+3               NO BUFEE, NO WRITEE.......
         LI,T     0                 BUFFER IS EMPTY.
         CAL1,1   WRITEIT           TAKE THAT!
         MTW,0    ONLIN             ARE WE ONLINE????
         BNE      %+4               IF NOT, NO CR TO MESS UP LISTING.
         LI,R     1
         LI,O     PROMPTM           AND A CR FOR YOU ONLINE FOLKS..
         CAL1,1   WRITEIT
         PULL     2,O
         B        0,L               BYE Y'ALL..........
*
*        SLURPT USES SLURPC TO SHOVEL IN A TEXTC IN 0,O.
*
SLURPT   PUSH     4,0
         LI,R     1                 START WITH BYTE ONE
         LB,RU1   0                 THIS IS THE COUNT.
         B        SLURPC1           THAT'S ALL THERE IS TO IT.
*
*        SLURPC SHOVELS 8 CHARACTERS FROM (0,O) TO THE BUFFER.
*
SLURPC   PUSH     4,0
         LI,R     0                 LOAD PTR
         LI,RU1   8                 COUNTER
SLURPC1  LB,D3    0,R
         BE       %+5               WHAT NULL.. I DIDN'T SEE A NULL...
         STB,D3   OBUF,T
         AI,T     1
         AI,R     1
         BDR,RU1  %-5
         PULL     4,0
         B        SLURP             AND SPLIT.
         PAGE
*
*        SLURP N,H AND R OUTPUT NUMBER IN R1 USING 10 FOR A
*        RADIX FOR SLURPN, 16 FOR A RADIX FOR SLURPH, AND THE
*        CONTENTS OF R0 FOR A RADIX FOR SLURPR. THE NUMBER OF DIGITS
*        WANTED IS IN R9. THE FIELD IS BLANK FILLED, AND THEN THE
*        REQUIRED NUMBER OF CHARACTERS ARE POKED IN. TRUNCATION MAY OCCUR,
*
SLURPR   STW,0    RADIX
         B        SLURPS
SLURPN   LI,D3    10
         STW,D3   RADIX
         B        SLURPS
SLURPH   LI,D3    16
         STW,D3   RADIX
SLURPS   PUSH     4,0
         PUSH     TU1               SAVE 0-RU1,TU1
         PUSH     SR2
         LI,R     ' '
         STB,R    OBUF,T            POKE THE FIELD FULL OF BLANKS
         AI,T     1
         BDR,SR2  %-2
         PULL     SR2
         PUSH     T
         PUSH     SR2
         AI,T     -1                THE FIRST ONE GOES HERE.
         LI,TU1   0                 CHARACTER COUNTER
         LAW,RU1  1                 ONLY POSITIVE NUMBERS......
         BE       SLURPS4
SLURPS1  LI,R     0                 REMAINDER GOES HERE.
         DW,R     RADIX             GIMMIE A DIGIT
         LB,R     HEX,2             A CHARACTER.
         STB,R    ARG,TU1           POKE AWAY FOR LATER
         AI,TU1   1
         CI,RU1   0                 DONE YET???
         BG       SLURPS1           NOPE. KEEP GOING.
         LI,RU1   0                 COPY POINTER.
SLURPS2  CI,SR2   0                 NO DIGITS WANTED?
         BE       SLURPS5           IF 0, SPECIAL CASE.
         LB,D3    ARG,RU1
         STB,D3   OBUF,T            POKE AWAY
         AI,RU1   1
         CW,RU1   TU1               LAST DIGIT IN NUMBER?
         BE       SLURPS3           YUP. ALL DONE
         AI,T     -1
         BDR,SR2  %-6
SLURPS3  PULL     SR2
         PULL     T
         PULL     TU1
         PULL     4,0               RESTORE TU1, 0-RU1
         B        SLURP             GO SLURP TO FINISH UP.
SLURPS4  CI,SR2   0                 NO DIGITS WANTED?
         BE       %+3               YUP. SHOVEL IN 'NO'
         CI,SR2   2                 IF ONLY ONE OR TWO DIGITS,
         BLE      SLURPS1           WE'LL PLUG IN ZEROS.
         LI,R     'O'
         STB,R    ARG,TU1
         AI,TU1   1
         LI,R     'N'
         STB,R    ARG,TU1
         AI,TU1   1
         B        SLURPS2-1         AND FILL INTO BUFFER
SLURPS5  PULL     SR2
         PULL     T
         AI,T     -1                BACK IT UP
         LW,R     TU1
         AI,TU1   -1
         LB,D3    ARG,TU1           GET LEADING DIGIT
         STB,D3   OBUF,T            PUT AWAY.
         AI,T     1
         BDR,R    %-4               ARG DIGITS ARE IN REVERSE ORDER
         B        SLURPS3+2         BYE...
         TITLE    'ENCHILADA--SUBROUTINES'
*
*        VERIFY CHECKS THE SYSTEM WE'RE LOOKING AT TO SEE IF ITS
*        THE SAME AS THE ONE WE WERE LOADED WITH..(OR SOMETHING.)
*        GRIPES VOCIFEROUSLY IF THINGS LOOK WEIRD.
*
VERIFY   PUSH     L
         LI,SR1   WAIT
         LI,S     0
         STW,S    NOPE              TO LET LTHING WORK.
         BAL,L    LW                CHECK THIS HOLE.
         CW,O     WAITX             IS IT RIGHT???
         BE       CMDX              OK, GO AHEAD.
         AI,SR1   1                 SO MAYBE THIS IS C00-CPV
         BAL,L    LW                AND THE WAIT IS ONE AFTER THAT.
         CW,O     WAITX
         BE       CMDX              THAT'S BETTER......
VERIFX   LI,O     VERIFNGM
         LI,R     30
         CAL1,1   WRITEIT           FLANGE
         MTW,-1   NOPE              NOT GOING TO GET FAR.
         B        RESTART           POP OUT.
VERIFNGM TXT      'PROGRAM DOESN''T MATCH SYSTEM.'
WAITX    WAIT,0   0                 WHAT WE'RE LOOKING FOR.
*
*        RESTART BALANCES OFF STACK AND GOES BACK TO SCANNER.
*
RESTART  LI,O     3
         LH,O     *J:TCB,O          GET SPACE COUNT
         AND,O    M15               MASK IT DOWN
         LCW,O    O
         MSP,O    *J:TCB            THAT JUST MIGHT WORK.
         B        HUH-1             BYE........
         PAGE
*
PROMPTM  DATA     X'155A0000'       A CR AND A BANG, JUST LIKE TEL.
*
*        STANDARD WRITE THRU OUTPUT DCB. BUF IN 1, LENGTH IN 2.
*
WRITEIT  GEN,O,7,24 1,X'11',ODCB    OUTPUT THRU DCB ADDR IN ODCB
         DATA     X'34000000'       BUF,LENGTH,AND BTD OF 0.
         GEN,O,31,O,31 1,O,O,2
         DATA     0                 BTD TO USE.
         PAGE
*
*        OOPST, ENTERED FROM A TRAP, COMPLAINS AND EXITS.
*
OOPST    LI,T     0
         LI,TU1   BA(OOPSM1)
         BAL,L    SLURP
         LW,O     *O                SAVE TRAP ADDRESS
         AND,O    M17               ADDRESS MASK
         LI,SR2   0
         LW,R     O                 SAVE THAT, BECAUSE WE WANT TO PRINT
         AI,O     -CODE             THE DISPLACEMENT ADDRESS.
         BAL,L    SLURPH            DUMP THE ADDRESS OUT
         LW,O     *2
         BAL,L    SLURPH            AND THE OFFENDING INSTRUCTION
         BAL,L    SLURPO
         CAL1,8   BYEDELTA
         CAL1,9   3                 ABORT.
OOPSM1   TXT      '....OOPS!...CODE+%/%.%.%'
         PAGE
         TITLE    'ENCHILADA-TEXT STRINGS'
         BOUND    8
8BLNKS   TXT      '        '        8 BLANKS FOR SETUP AND SUCH.
16BALLS  DATA     0,0               16 BALLS FOR SIMILAR PURPOSES.
EMSG     TXT      'EH?'             ERROR MESSAGE...SNICKER....
DOOM1    TXT      '-%%'             FOR 'ALL'
LTHINGM  TXT      'CAN''T GET THE PAGE. I QUIT.'
NOMATCHM TXT      'PROGRAM DOES NOT MATCH SYSTEM- I QUIT!'
HEX      TXT      '0123456789ABCDEFGHIJ'
USERSM   TXT      '% USERS-% ONLINE, % GHOST, % BATCH AND ',;
                  '% WAITING.%'
DIS1     TXT      '       RAD  PACK  TOTAL%'
DIS2     TXT      'USER % % %%'
DIS3     TXT      'SYS  % % %%'
DIS4     TXT      'SYMB             %%'
NOBATCH  TXT      'NO BATCH JOBS RUNNING, '
BAT1     TXT      '% BATCH ALLOWED.%'
BAT2 TXT ' PART  QID  ID   PC STATE ACCOUNT  APR%%%'
BAT3 TXT '%  %% % S% % % % %'
         BOUND    8                 MUST BE ON DW BOUNDARY!
UPT1     TXT      'UP FOR % HOURS % MINUTES.%'
PCNT1    TXT      ' % PAGES GRABBED.%'
*
GHOSTM1  TXT      'NO GHOSTS!'
GHOSTM2  TXT      '  ID ACCOUNT  GHOST%'
DISPM1   TXT      ' %,%% PRIV=%, ID=% %'
STATM1   TXT      ' TIME UT  O  G  B  W  STORE SYMB %%%'
STATM2   TXT      '----- -- -- -- -- -- ------ ----% ----%%'
STATM3   TXT      ' % % % % % % % % % % % %'
TAPEM1   TXT      'SCRATCH'         FOR TAPE DRIVE STATUS
USERM1   TXT      ' USER ID % IS % % % % %'
USROM    TXT      'ON LINE % %'     FOR USER COMMAND
USRGM    TXT      '% GHOST  %%'
USRBM    TXT      'BATCH PART % ACCT % SYSID % %%'
USERM2   TXT      ' SIZE=% STATE=S% PRIO/B=%/%%'
USERM3   TXT      ' ACP=%%'
USERM4   TXT      ' APR=%%'
USERM5   TXT      ' OV=%%'
STATETXT TXT      'GASPRT  C0  C1  C2  C3  C4  C5  C6  C7  C8  C9  '
         TXT      'C10 CU  TOB TOBOIOW IOMFW   QA  QR  QRO TI  TIO '
         TXT      'QFI ?19 ?1A ?1B ?1C ?1D NULLNSTS?20 ?21 ?22 ?23 '
PANESM1  TXT      ' WAS % NOW IS %, % PANES WERE IN USE.%%'
CFUM1    TXT      ' DCBS, % ACCT=% NAME=%%'
CFUM2    TXT      'X''%''%%'        FOR PRINTING X'STUFF'......
CFUM3    TXT      ' CFU''S IN USE, % EMPTY, % CFU''S TOTAL.%'
SIZEM    TXT      ' N=% (G=%, O=%, B=%, W=%) MIN=% AVG=% MAX=% STD=%.%'
         TITLE    'ENCHILADA--DATA AREA'
         USECT    DATA
*
*        COMMAND BUFFER AND LENGTH WORD
*
*
*        CELLS FOR LOAD THING
*
WINDOW   EQU      %                 WINDOW MAP AREA
         DO1      MAXPANES          ONE WORD FOR EACH PANE IN WINDOW
         DATA     -1
USNFILE  DATA     0                 -1 IF INPUT FROM FILE.
REPL     DATA     0                 PANE TO BE REPLACED NEXT.
CPANES   DATA     PANES             CURRENT NUMBER OF PANES BEING USED.
*
MCVM     DATA     0                 CVM FPT
         DATA     WINDOWPG
*
*        OPEN FPT FOR MONDMP FILE
*
OPNDMP   GEN,8,24 X'14',M:EI
         DATA     X'C7480009'       P1,2,6,7,8,10,13,F9,F12
         DATA     USENF,USENF       P1,P2 ERR AND ABN
         DATA     2,2,1             KEYED,DIRECT,IN
         DATA     2,3               SAVE,KEYM=3
         DATA     X'01000202'
UFNAME   TXTC     'MONDMPN'         FILE NAME- N IS FILLED IN.
         DATA     X'02010202'
         TXT      ':SYS '           AND THE ACCOUNT.
*
*        DELTA IS ASSOCIATED- 0 IF NOT, 1 IF YES.
*
DELTAHERE DATA    0
*
*        FLAG THAT TELLS IF WE CAN GO MASTER (NONZERO IF WE CAN)
*
MFLAG    DATA     0
*
*        OUTPUT BUFFER AND CONTROL WORDS FOR SLURP
*
RADIX    DATA     10                OUTPUT RADIX
ARG      RES      8                 DIGIT PREPARATION AREA
*
*        WORD FOR DISC SUMMARY AND OTHER SCRATCH.
*
         BOUND    8                 ON DWORD FOR SOME PEOPLE....
TRASH    DATA     0
TRASH1   DATA     0                 MORE TRASH
TRASH2   DATA     0
*
*        PAGE GRAB COUNT
*
PCOUNT   DATA     -1
*
*        STUFF FOR STAT/STATS AND ANYBODY ELSE.
*
ZZN      DATA     X'0F000000'       M:WAIT FPT FOR SNOOZING.
ZZFLG    DATA     0                 TO SLEEP OR NOT TO SLEEP
JID      DATA     0                 JOB ID TO CHECK........
ODCB     DATA     M:UC              DCB TO DO OUTPUT THRU.
ONLIN    DATA     0                 0 IF ONLINE, 1 IF NOT.
NOPE     DATA     -1                0 IF PGM AND SYSTEM MATCH.
         BOUND    8
CFUACCT  RES      2                 FOR CFU ACCOUNT SCAN.
         USECT    CODE              DUMP LITS IN PROCEDURE PAGES.
         END
