         SYSTEM   APTERYX
         SYSTEM   BPM
         DEF      LB,LH,LW,LD
         DEF      SLURP,SLURPN,SLURPH,SLURPR,SLURPC,SLURPT,SLURPO
         DEF      ARGO,ARGN,ARGH,ARGT,ARGC
         DEF      OBUF
         DEF      DATA
         DEF      USNFILE
         REF      M:UC,M:LO,M:LL,M:EI,JB:PRIV,PLD:ACT
         DEF      STATETXT
         REF      PLH:SID,LPART,PLH:FLG,M:XX,J:TELFLGS
         REF      S:CUIS,S:BUIS,S:GUIS,S:OUIS,S:BFIS,S:BUAIS
         REF      SB:GJOBUN,S:GJOBTBL,AVRID,AVRTBL,AVRTBLSIZ
         REF      GRANRAD,GRANPACK,GRANSYM,PRDPRM,PRDCRM
         REF      WAIT,C:TIC,PLB:USR,UB:APR,MAXG,UB:PCT,SMUIS,UB:OV
         REF      UB:ACP,P:SA,P:NAME,LB:UN,LNOL,UB:US,RCVRCNT
         REF      LASTCFU,ACNCFU,BGRCFU,E:OFF,S:CUN,T:RUE
         REF      UB:PRIO,UB:PRIOB,PNAMEND,S:GJOBACN
         REF      F:LOGD,MODE4,SL:OPRIO
         SREF     TIE
F:QUE    EQU      F:LOGD
         REF      J:JIT
         REF      NSCPU
         SREF     SB:STATE
         REF      KEYINBUF,T:GJOBSTRT,S:SET:,X1
         REF      J:XPSD,BLOCKER
         REF      M:SI,J:ACCN,J:UNAME
         REF      UB:ASP,UB:DB
         REF      JB:CCARS,J:CCBUF
         SREF     S:PCUN
         REF      SH:ROSUM,SH:RGSUM,SH:ROCU,SH:RGCU,SH:RNM,SV:RSIZ
         REF      S:OUAIS,S:GUAIS,S:DSPKEY
         REF      RBLIMS
         SREF     ACTBIT,LIPBIT,RB:FLAG,RBD:WSN,RBB:ID
         REF      MING
         REF       SH:RBCU,SH:RBSUM
         REF      BATAPE,DCT3,DCT16
         REF       AVRNOU,AVRTBLNE
         REF      MODE2,MODE4INIT
         REF      JOB,USRTHERE
         SREF     USERLOG
         SREF     E:QME,E:CRD,E:CIC
         SREF     E:CBL,E:CUB,E:CBK,E:CEC,E:ERR,E:WU,E:SL
         SREF     E:QA,E:ART,E:UQA,E:KO,E:AP,E:QE,E:IC,E:QFI
         SREF     E:NSYM,E:SYMF,E:NSYD,E:SYMD,E:OCR,E:NOCR
         SREF     E:CFB,E:CBA,E:ND,D:DPA,E:QFAC,E:UQFA,E:NQW,E:NQR
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         TITLE    'THE WHOLE ENCHILADA...'
*
*        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      10
*
*        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.
*
*        SET B00 TO 1 FOR CPV-B00 SYSTEMS. SET TO 0 FOR C00 CPV.
*
B00       SET      0      FOR CPV-C1A
*
*        NULL STATE FOR CPV-B00 AND C00
*
SNULL    EQU      X'1E'
         PAGE
CODE     CSECT    1
*
DATA     CSECT    0
*
CMDTXT   CSECT    1
CMDTV    CSECT    1
CMDTL    SET      0
*
:CMD     CNAME
         PROC
         DISP     CMDTL
         LIST     0
         LOCAL    L
L        SET      %                 TO REMEMBER WHERE WE WERE
         USECT    CMDTXT
         TEXTC    AF(1)             TEXT OF COMMAND NAME
         DO       S:NUMC(AF(1))<4
         TEXT     '    '            PAD OUT WITH BLANKS.
         FIN
         USECT    CMDTV
         DO1      NUM(CF)=2
         REF      AF(2)
         DATA     AF(2)             AND THE ROUTINE ADDRESS
         USECT    L
         LIST     1
CMDTL    SET      CMDTL+1
         PEND
         PAGE
*
*        THE COMMAND TABLES MUST APPEAR BEFORE THE SCANNER ROUTINE.
*        AND A DUMMY ENTRY MUST BE AT THE HEAD OF THE TABLE.
*        MAX COMMAND NAME IS 7 CHARACTERS........
*
         :CMD     'NULL',WTF        FILLER ENTRY-0
         :CMD     'Q',OKEXIT
         :CMD     'QUIT',OKEXIT
         :CMD     'END',OKEXIT
         :CMD      'PUNT',PUNT
         :CMD     'RES',RESCMD
         :CMD      'CFUS',CFUS
         :CMD     'RBSTAT',RBSTAT
         :CMD     'RAT',RAT
         :CMD     'GHOST',GHOST
         :CMD     'QUEUE',QUEUE
         :CMD     'BATCH',BATCH
         :CMD      'PACKS',PACKS
         :CMD     'TAPES',TAPES
         :CMD     'DISC',DISC
         :CMD     'UPTIME',UPTIME
         :CMD     'LUS',LINEUSE
         :CMD     'USERS',USERS
         :CMD     'DI',DISPLAY
         :CMD      'CORE',CORE1
         :CMD     'SCPU',SCPU
         :CMD,REF 'SPY',SPY
         :CMD     'COCMESS',UTSG
CMDALL   EQU      CMDTL-1           ALL CMDS UP TO HERE DONE ON ALL.
         :CMD     'ALL',DOALL
         :CMD     'ID',DISPLAY
         :CMD     'OFF',OFF
         :CMD     'LP',LP
         :CMD     '@',LINK
         :CMD     'UC',UC
         :CMD     'HELP',HELP
         :CMD     'AMIN',AMIN
         :CMD     'EVERY',EVERY
         :CMD     'CHK',CHK
         :CMD     'DELTA',GETDELTA
         :CMD     'PRINT',SCLOSE
         :CMD     'UNDELTA',UNDELTA
         :CMD     'GRAB',PCNT
         :CMD     'USER',USER
         :CMD     'LIST',CLIST
         :CMD     'PANES',DOPANES
         :CMD     'STAT',STAT
         :CMD     'STATS',STATS
         :CMD     'USE',USE
         :CMD      'MCORE',CORE
         :CMD     'GJOB',GJOB
         :CMD     'JPRIOR',JPRIOR
         :CMD     'NAIL',NAIL
         :CMD     'KEYIN',KEYIN
         :CMD     'PRIOB',PRIOB
         :CMD     'RUE',RUE
         :CMD     'ON',ON           LIST ONLINE USERS
         :CMD     'WATCH',WATCH     SPY ON A LINE
         :CMD     'CLEAR',CLEAR     UNSPY
         :CMD     'ACPL',ACPL
         :CMD     'RCPL',RCPL
         :CMD     'COUPLE',COUPLE
         :CMD     'DECOUP',DECOUPLE
         :CMD     'TIES',TIES
         :CMD     'PROC',PROCUSE
         :CMD     'E',OKEXIT
         :CMD     'CHEAT',CHEAT
         :CMD     'LAST',LASTCMD
         :CMD     'XEQ',XEQ
         :CMD,REF 'TRIES',TRIES
         :CMD     'ZZZ',ZZZ
         PAGE
*
*        REGISTER DEFINITIONS- IN NO PARTICULAR ORDER.
*
L        EQU      15
*
*        REGISTER USE
*
*        0        ARG FROM LTHING, ARG TO SLURPC
*        1        ARG FROM LTHING, ARG TO SLURP
*        2        WORK
*        3        WORK
*        4        WORK
*        5        STRING POINTER FOR SLURP
*        6        OUTPUT POINTER FOR SLURP
*        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       LINK REGISTER
         PAGE
*        VERIFY THAT PRIV LEVEL IS HIGH ENOUGH TO DO MCVM CAL,
*        CHECK TO MAKE SURE WE MATCH THE SYSTEM. IF WE ARE NOT
*        ONLINE, SET OUTPUT DCB TO M:LO AND GO DO ALL COMMAND
*        OTHERWISE SET UP TRAP AND BREAK CONTROL AND WAIT FOR COMMAND.
*
         USECT    CODE              IN PROCEDURE AREA
START    DEQU     %
         STW,8    HURRO             SAVE FOR POSSIBLE M:LINK.
         LB,1     JB:PRIV           HAVE TO HAVE PRIV LEVEL TO DO
         CI,1     X'80'             M:CVM CAL,
         BL       OKEXIT            OR WE'LL EXIT......
         M:TRAP   (IGNORE,BOTH)
         LI,R14   0
         LI,R15   USERLOG
         BEZ      %+2
         BAL,R15  USERLOG
         M:OPEN   M:SI,(DEVICE,'SI'),(IN) MAKE SURE WE READ FROM TERM
         LD,6     16BALLS           CLEAR THIS STUFF TO ZERO.
         BALL     VERIFY            GO VERIFY SYSTEM.
         M:CAL    (IA,CALPROC),MASTER
         BCR,8    %+2               WE CAN GO MASTER
         M:CAL    (IA,ALTCP),SLAVE  CAN'T GO MASTER
START1   LCF      J:JIT             AND SEE IF WE ARE ONLINE
         BCS,8    START2            YUP. LOOKS THAT WAY.
         LI,1     M:LO              IF NOT, OUTPUT THRU M:LO DCB
         STW,1    ODCB
         MTW,1    ONLIN             MARK THAT WE ARE NOT ONLINE.
         B        DOALL             AND GO DO EVERYTHING.
START2   EQU      %
         LW,R1    J:TELFLGS
         CI,1     X'80'             IF DELTA AROUND,
         BANZ     %+3               DON'T GET TRAP OR BREAK CONTROL
         CAL1,8   MTRAP             TRAP CONTROL TO OOPST
         CAL1,8   MINT              BREAK CONTROL TO OOPSB
         LB,R1    JB:CCARS          LOOK FOR COMMANDS IN J:CCBUF
         AI,R1    -1                KNOCK OF A CR OR LF
         LB,R3    J:CCBUF,R1
         CI,R3    X'40'
         BLE      %+2
         AI,R1    1
         LI,R2    0                 BEGIN SEACHING CCBUF
CC1      LB,R3    J:CCBUF,R2        FIRST FIND A NON-BLANK
         CI,R3    X'40'
         BNE      CC2
         AI,R2    1
         BDR,R1   CC1
         B        NOCCOM
CC2      LB,R3    J:CCBUF,R2        NOW FIND A BLANK
         CI,R3    X'40'
         BE       CC3
         AI,R2    1
         BDR,R1   CC2
         B        NOCCOM
CC3      LB,R3    J:CCBUF,R2        LASTLY WE LOOK FOR A NON BLANK
         CI,R3    X'40'
         BNE      CC4
         AI,R2    1
         BDR,R1   CC3
         B        NOCCOM
CC4      ANLZ,R2  CC3               GET BA OF WHERE WE ARE IN CCBUF
         LI,R3    BA(CMDBUF)+1
         STB,R1   R3
         MBS,R2   0                 MOVE REST OF CCBUF TO CMDBUF
         LI,R2    BA(L(';END'))     AND TACK ON AN END COMMAND
         OR,R3    =X'04000000'
         MBS,R2   0
         AI,R1    4
         STB,R1   CMDBUF
         B        STARTIT
NOCCOM   EQU      %
         BALL     DISPLAY           GO FLANGE THE USER.
STARTIT  BALL     WHUT
         LI,6     0
         BALL     0,7               DO THE COMMAND.
         B        STARTIT
MTRAP    GEN,8,24 X'14',OOPST
         DATA     X'003F8300'
MINT     GEN,8,24 X'E',OOPSB
         PAGE
CMDX     PULL     L
         BYE                        SPLIT.
*
*        OFF KICKS THE USER OFF THE SYSTEM.
*
OFF      CAL1,4   BYEDELTA          GET RID OF HANGERS ON.
         BALL     FREEM             GET RID OF PAGES,
         CAL1,8   GOODBYE           AND LOG OFF.
GOODBYE  DATA     X'03000002'
         TXTC     'LOGON'
         TXT      ':SYS    '
         PAGE
*        THE LP COMMAND DIRECTS OUTPUT THRU THE PRINTER.
*
LP       LI,1     M:LO
         STW,1    ODCB
         CAL1,1   GETLP             OPEN IT TO DEVICE LP
         CAL1,1   DEVTOP            AND DO TOP OF FORM
         LI,1     1
         STW,1    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,1     M:UC
         XW,1     ODCB              BACK TO UC.
         CI,1     M:UC              WAS IT SET TO UC BEFORE?
         BE       *L                YES- SPLIT.
         CAL1,1   CLOSELP           IF NOT, ISSUE CLOSE TO LP
         MTW,-1   ONLIN             AND RESET FLAG
         BYE                        NOW SPLIT.
CLOSELP  STD,0    M:LO              CLOSE LP
         DATA     0
         PAGE
*        AMIN READS A COMMAND AND DOES IT ONCE A MINUTE.
*
AMIN     PUSHL
         BALL     WHUT              GO GET ME SOMETHING TO DO.
         LW,8     CMDARG            WE MUST SAVE SCAN POINTERS TO
         LW,2     =X'0F000031'      SLEEP FOR 49 TICS.
         STW,2    ZZN
AMIN1    PUSH     3,7               REDO COMMANDS WITH ARGUMENTS.
         CAL1,8   DISPL1            TIME TO OBUF
         LI,1     OBUF
         LI,2     6
         CAL1,1   WRITEIT
         BALL     MAYBECR           FOR PG.........
         STW,8    CMDARG            RESTORE SCANNING POINTERS
         LI,6     0
         BALL     0,7               GO DO THE COMMAND
         CAL1,8   ZZN               SNOOZE FOR A WHILE
         PULL     3,7               RESTORE ADDRESS AND POINTERS, AND
         B        AMIN1             GO DO IT AGAIN.
*
*        EVERY #  DOES THE NEXT COMMAND EVERY # TICS.
*
EVERY    PUSHL
         BALL     ARGN
         BE       EHX
         CI,1     X'7FFF'           LONGER THAN THIS??
         BLE      %+2
         LI,1     X'7FFF'           THIS IS LONG ENOUGH.
         OR,1     =X'0F000000'      MAKE IT A SLEEP FPT
         STW,1    ZZN
         BALL     WHUT              FIND SOMETHING TO DO
         LW,8     CMDARG            GET SCAN POINTERS
         B        AMIN1             AND GO TO IT.....
         PAGE
*        UPTIME PRINTS THE TIME SINCE SYSTEM STARTUP.
*
UPTIME   PUSHL
         LI,9     0
         LI,7     0
         LI,8     C:TIC             UPTIME IN TICKS
         BALL     LW
         LI,0     0
         DW,0     =30000            TO MINUTES
         STW,1    TRASH             SAVE THAT.
         LI,5     BA(UPT1)
         BALL     SLURP
         LI,0     0
         DW,0     =60
         BALL     SLURPN            PRINT OUT HOURS
         MW,0     =60
         SW,1     TRASH             -MINUTES
         LCW,1    1                 MINUTES
         BALL     SLURPN            PRINT MINUTES
         BALL     SLURPO            WRITE
         B        CMDX
         PAGE
*        HELP JUST TYPES A STRING TO SHOW THE USER WHAT TO DO.
*
HELP     PUSHL
         LI,5     BA(HLPTXT)
HELP1    BALL     SLURP
         CI,6     10                HIT THE END YET?
         BLE      CMDX              IF SO,....
         BALL     SLURPO            WRITE THE LINE
         LB,14    0,5               WE HAVE TO MOVE TO THE
         CI,14    ' '               NEXT NON-BLANK TO GET FROM
         BNE      HELP1             LINE TO LINE.
         AI,5     1
         B        %-4
         B        CMDX              RETURN.
*
*        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     'PACKS   PRIVATE DISK DRIVE USAGE.%'
 TXT     'CFUS    DUMPS ALL IN USE CFU''S ON YOU.%'
 TXT     'CORE    CURRENT & TOTAL BATCH CORE (K).%'
 TXT     'LUS     COC LINE USAGE STATUS.%'
 TXT     'RES     TELLS HOW MUCH IS LEFT FOR BATCH%'
 TXT     'RAT     DISPLAY RESOURCE ALLOCATION TABLES%'
 TXT     'RBSTAT  DISPLAY STATUS OF REMOTE BATCH STATIONS%'
 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     'CHK #   GIVES STATUS OF JOB #.  EXITS ''EVERY'' LOOP WHEN',;
         ' ALL DONE.%'
 TXT     'SPY     TELLS ABOUT ALL THE USERS ON THE SYSTEM%'
 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     'MCORE   USE RUNNING MONITOR FOR INPUT.%'
 TXT     'GJOB NAME   INITIATE GHOST JOB.%'
 TXT     '@ N,A,P DOES M:LINK TO N.A.P- A AND P MAY BE NULL.%'
         TXT      'SCPU    DISPLAY SLAVE CPU STATUS%'
         TXT      'COCMESS COC PAGE HEADING%'
         TXT      'LIST    LIST ALL COMMANDS%'
         TXT      'JPRIOR  CHANGE JIT PRIORITY%'
         TXT      'NAIL    ABORT SPECIFIED USER(S)%'
         TXT      'KEYIN   ISSUE OPERATOR KEYIN%'
         TXT      'PRIOB   CHANGE USERS BASE EXECUTION PRIORITY%'
         TXT      'RUE     REPORT RANDOM EVENT ON A USER%'
         TXT      'ON      LIST ONLINE USERS%'
         TXT      'WATCH   ONE WAY COUPLE TO A LINE (FORCIBLY)%'
         TXT      'CLEAR   CLEAR THE WATCH%'
 TXT     'ACPL #  SET ACCEPT COUPLES BIT FOR LINE #%'
 TXT     'RCPL #  RESET ACCEPT COUPLES BIT FOR LINE #%'
 TXT     'COUPLE #   COUPLE TO LINE #%'
 TXT     'DECOUP  ISSUE DECOUPLE CAL%'
 TXT     'TRIES # SET NUMBER OF TIMES SPY WILL ''TRYCORE''%'
         TXT      'TIES    DISPLAY THE TIE TABLES%'
 TXT     'PROC #  LISTS ALL USERS ASSOCIATED WITH PROCESSOR #%'
         TXT      'CHEAT   DISPLAY USERS WITH UNUSUAL PRIORITY%'
         TXT      'LAST    RE-DO THE LAST COMMAND LINE%'
 TXT     'XEQ N,A,P  READ COMMANDS FROM FILE N.A.P%'
         TXT      'AMIN    DO THE NEXT COMMAND ONCE A MINUTE%'
         TXT      'EVERY # DO THE NEXT COMMAND EVERY # 1.2 SEC. TICKS%'
****************************************************************
         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    PUSHL
         LI,5     BA(USERSM)
         LI,9     0                 AS MANY AS THERE ARE DIGITS.
         LD,6     16BALLS           NO FANCY INDEXING OR THE LIKE.
         BALL     SLURP
         LI,8     S:CUIS            CURRENT USERS IN SYSTEM
         BALL     LW
         BALL     SLURPN
         LI,8     S:OUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:GUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:BUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:BFIS
         BALL     LW
         BALL     SLURPN
         BALL     SLURPO
         B        CMDX              RETURN THROUGH WRITE.
         SPACE    3
ZZZ      M:WAIT   9999
         B        ZZZ
         PAGE
*        THE @ COMMAND DOES A M:LINK TO A SPECIFIED FILE.
*        ACCOUNT AND PASSWORD MAY BE GIVEN, SEPARATED BY
*        WHATEVER THE SCANNER LIKES FOR DELIMITERS......
*
LINK     PUSHL
         BALL     ARGC              GET TEXTC NAME
         BE       EHX               B/OOPS....NO NAME...NO GOOD...
         LCI      2
         STM,0    MLINK+1           SAVE THE TEXTC NAME
         BALL     ARGT              AN ACCOUNT????
         CD,R0    8BLNKS
         BNE      %+2
         LD,0     SYSACCT           NO ACCOUNT => :SYS           JTA D0A
         CW,0     ='.   '           '.' => CURRENT ACCOUNT
         BNE      %+3
         LCI      2
         LM,R0    J:ACCN            USE LOGON ACCOUNT
         LCI      2
         STM,0    MLINK+3           POKE AWAY ACCOUNT
         LI,1     2
         STS,1    MLINK             SET ACCOUNT PRESENT
         BALL     ARGT              PASSWORD MAYBE????
         CD,R0    8BLNKS
         BE       LINKG             B/NOPE, DOIT..
         LCI      2
         STM,0    MLINK+5
         LI,3     1
         STS,3    MLINK             SET PASSWORD PRESENT
LINKG    BALL     FREEM             MUST GET RID OF CVM PAGES....
         LW,2     MLINK+2           SEE IF NAME WAS SHORT.....
         CW,2     BLANKS
         BNE      %+4               B/NOPE.....
         LCI      5
         LM,0     MLINK+3           OUT THE BLANK WORD
         STM,0    MLINK+2           TO ALLOW ACCOUNT TO BE HANDLED.
         LB,R1    CMDARG            GET REMAINING BYTES IN COMMAND
         BEZ      LINK20
         LI,R3    BA(WHOSAVE)+1
         STB,R1   R3                MOVE THAT MANY BYTES
         LW,R2    CMDARG
         AI,R2    BA(CMD)
         MBS,R2   0
LINK20   STB,R1   WHOSAVE           SHOVE IN BYTE COUNT OF CCBUF
         CAL1,8   MLINK             DO THE M:LINK CAL.
         B        CMDX              WHEN WE RETURN.
         PAGE
*        THE CFU COMMAND DUMPS THE IN USE CFU'S ON YOU.
*
CFUS     PUSHL
         LI,1     0
         STW,1    TRASH             USED CFU'S
         STW,1    TRASH1            UNUSED CFU'S
         STW,1    TRASH2            ACCOUNT SEARCH FLAG
         BALL     ARGT              GO SEE IF TEXT ARG AVAILABLE
         BE       %+3               B/NOPE.
         STD,0    CFUACCT           SAVE IT AS THE ACCOUNT TO LOOK FOR
         MTW,1    TRASH2            AND SET THE FLAG.
         LI,11    BGRCFU            FIRST CFU LOC TO LOOK AT
LOOKCFU  LW,8     11                GET ADDRESS OF CFU TO LOOK AT
         LI,7     0                 NO INDEXING
         BALL     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,11    8                 B00 CFU SIZE
         LI,8     ACNCFU+13         LAST WORD OF CFU SPACE
         LI,7     0
         BALL     LW                IS IN THERE
         CW,11    1
         BL       LOOKCFU           NOPE.
         LI,5     BA(CFUM3)
         LI,6     0
         LI,9     0
         LW,1     TRASH
         BALL     SLURPN            THIS MANY IN USE CFU'S
         LW,1     TRASH1
         BALL     SLURPN            AND THIS MANY UNUSED
         AW,1     TRASH             THIS MANY TOTAL.
         BALL     SLURPN
         BALL     SLURPO
         B        CMDX              AND THAT'S THE END.
INUSE    MTW,1    TRASH             BUMP IN USE COUNTER
         LW,2     1                 SAVE THESE GOODIES FOR A WHILE
         SLS,1    -17               GET A USAGE COUNT
         AND,1    =X'7F'
         LI,5     BA(CFUM1)
         LI,6     0
         LI,9     0
         BALL     SLURPN            PRINT NUMBER OF DCB'S USING IT
         LD,0     8BLNKS            PRESET TO BLANKS.
         CI,2     X'100'            AND LOOK AT THE FUNCTION BITS
         BAZ      %+2               IN WORD 0 OF THIS CFU
         LW,0     FMSG              IT SEZ 'IN'
         CI,2     X'200'
         BAZ      %+2
         LW,0     FMSG+1            IT SEZ 'OUT'
         CI,2     X'400'
         BAZ      %+2
         LD,0     FMSG+2            'INOUT'
         CI,2     X'800'
         BAZ      %+2
         LD,0     FMSG+3            'OUTIN'
         BALL     SLURPC            SHOVEL THAT IN.
         AI,8     2                 SPACE TO ACCT/NAME INDEX
         BALL     LW                AND GET THAT.
         BE       CFUSREL           IF ZERO, OUTPUT RELEASE FILE.
         LB,0     1
         CI,0     3                 IS THIS A STAR FILE?????
         BE       CFUSTAR           YUP. TAKE CARE OF THAT.
         STH,1    12                SAVE NAME DISPLACEMENT.
         CI,2     X'10000'          IS THIS A PRIVATE PACK FILE?
         BAZ      NOTPRIV           NOT PRIVATE PACK FILE
         LH,8     1                 GET DCT INDEX OF PACK
         AND,8    =X'3F'
         SLS,8    1                 AVRTABLE IS DOUBLE WORD
         AI,8     AVRTBL-BATAPE-BATAPE
         BALL     LW                GET PACK SN
         LW,0     CFUPRPK           GET TEXT
         B        CFUSAS            AND GO TO ACCOUNT SLURP POINT
NOTPRIV  EQU      %
         LH,3     1                 THE ACCOUNT DWORD OFFSET
         SLS,3    1                 SHIFT TO WORD INDEX
         LI,8     ACNCFU+13         ACCT ENTRY START
         BALL     LW                GET THAT
         LW,8     1
         AW,8     3                 ADD IN THE DISPLACEMENT IN CFU.
         BALL     LW
         LW,2     1                 I DONT THINK ITS ON A
         AI,8     1                 DOUBLEWORD BOUNDARY, SO I'LL
         BALL     LW                DO THIS LITTLE SONG AND DANCE
         LW,0     2                 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   BALL     SLURPC            ENTRY
         DO       B00=1
         LI,8     ACNCFU+15         BUT YOU WASTE A LOT OF CFU SPACE
         BALL     LW                IN A00 WITH SHORT FILENAMES.
         LW,8     1
         AH,8     12                ADD IN NAME DISPLACEMENT.
         ELSE                       FOR C00
         LH,8     12                NAME IS RIGHT HERE.....
         FIN
         BALL     LB                GET C FROM TEXTC
         LW,9     1                 AND COPY IT.
         CI,9     31                HOW BIG DID YOU SAY?
         BLE      %+2
         LI,9     31                BULLFEATHERS......
         LI,7     1                 BYTE INDEX
         BALL     LB                FETCH A BYTE
         STB,1    OBUF,6            POKE IT AWAY
         AI,6     1
         AI,7     1                 BUMP VARIOUS POINTERS
         BDR,9    %-4               AND COPY THE STRING
CFUSO    BALL     SLURPO            PRINTIT.
         B        NXTCFU            NEXT!
CFUSTAR  LD,0     8BLNKS            FOR STAR FILES IN B00, WE DONT
         BALL     SLURPC            KNOW THE ACCOUNT
CFUSTAR1 LI,5     BA(CFUM2)         THE HEADER TO USE.
         BALL     SLURP             PUMP OUT FIRST PART,
         LI,9     8                 8 CHARACTERS, PLEEZE
         BALL     SLURPH            AND DUMP OUT HEX.
         B        CFUSO             THAT'S THAT.
CFUSREL  LD,0     CFUSRELS          THE FILE IS TO BE RELEASED.
         BALL     SLURPC            SO TELL THEM ABOUT IT ALREADY.
         B        CFUSO
         BOUND    8
FMSG     TXT      'IN  OUT INOUT   OUTIN' CFU FUNCTION CODE TEXTS.
CFUPRPK  TXT      ' DP#    '
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,1    STAT1
STAT     BAL,1    STAT1
STAT1    AI,1     -STAT             THIS SONG AND DANCE SETS ZZFLG
         STW,1    ZZFLG             TO 0 FOR STATS, AND 1 FOR STAT.
         LW,1     =X'0F000031'
         STW,1    ZZN
         PUSHL
         BALL     ARGH              GO GET HEX ARGUMENT
         BG       STAT2             THERE WAS AN ARG
         LI,R1    0
STAT2    STW,1    JID               SAVE THE ARG, IF ANY.
         LI,1     0                 SET PARTITION NUMBER TO ZERO
         STW,1    TRASH1            FOR USE LATER ON
         LI,5     BA(STATM1)
         BALL     SLURP
         LW,1     JID               IF THER'S AN ID PRESENT,
         BE       %+3
         LI,9     4                 WE'LL PRINT IT OUT AS A FOUR
         BALL     SLURPH            DIGIT HEX NUMBER.
         BALL     SLURPO
         LI,5     BA(STATM2)
         BALL     SLURP
         MTW,0    JID               IS IT THERE??
         BE       %+2               NOPE
         BALL     SLURP             CONTINUE HEADER OF IT IS
         BALL     SLURPO            WRITE THE THING OUT.
STAT4    CAL1,8   DISPL1            GET TIME INTO OBUF
         LI,6     6                 POINT AFTER THE ACTUAL TIME.
         LI,5     BA(STATM3)
         LI,9     2                 SOME 2 DIGIT NUMBERS.
         LI,7     0                 NO INDEXING
         LI,8     S:CUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:OUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:GUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:BUIS
         BALL     LW
         BALL     SLURPN
         LI,8     S:BFIS
         BALL     LW
         BALL     SLURPN
         LI,9     6                 6 DIGITS FOR STORAGE SUM.
         LI,7     0
         LI,8     GRANRAD
         BALL     LW
         STW,1    TRASH
         LI,8     GRANPACK
         BALL     LW
         AW,1     TRASH
         BALL     SLURPN            STORAGE AVAILABLE.
         LI,9     4                 FOR SYMBIONT STORE
         LI,8     GRANSYM
         BALL     LW
         BALL     SLURPN
         LW,8     JID               A JOB TO CHECK UP ON??
         BE       STAT6             NOPE.
STAT40   CAL1,1   MJOB              WHAT'S THE STATUS OF THIS JOB?
         CI,8     1                 IS IT RUNNING??
         BNE      STAT42            GUESS NOT.
         LW,1     TRASH1            IF IT IS, DO WE HAVE PARTITION #?
         BNE      STAT41            ITS IN TRASH IF WE DO.
         LI,8     PLH:SID           IF IT ISNT,
         LI,7     LPART             WE JUST HAVE TO LOOK THRU
         BALL     LH                THE PARTITION TABLES TO
         CW,1     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,1     TRASH1            CHANGE DURING JOB EXECUTION.....
STAT41   LI,9     2                 SQUASH FIELD TO 2 DIGITS
         BALL     SLURPN            FOR PARTITION AND STAR.
         LI,0     '*'               AND PUT A MARKER AFTER IT
         STB,0    0                 TO DENOTE PARTITION NUMBER
         BALL     SLURPC
         B        STAT6             AND GO WRITE THIS CRUD OUT.
STAT42   CI,8     2                 IS IT WAITING??
         BNE      STAT5             NOPE.
         LW,1     10                IF IT IS, PRINT ITS POSITION
         BE       STAT5             IF NEXT, SAY SO.
         BALL     SLURPN
         B        STAT6
STAT5    LW,1     8                 THE STATUS
         LW,0     MJOBS,1           JOB STATUS TEXT.
         LI,1     0
         BALL     SLURPC
STAT6    BALL     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    PUSHL
         LI,R2    0
         STW,R2   SHORTFLAG
         STW,R2   QACCN
         BALL     ARGT              LOOK FOR AN ACCOUNT
         BEZ      %+2
         STD,R0   QACCN             STORE ACCOUNT
         LI,R1    -1
         LI,R3    X'20'
         CH,R3    F:QUE             IS THE DCB OPEN NOW
         BAZ      %+2
,CLSQUE  M:CLOSE  F:QUE,SAVE
         CAL1,8   LDEVEI            M:LDEV 'C2' TO NAKNAKNAKNAK.
         CAL1,1   OPNEIC2           OPEN EI TO C2.
QREAD    CAL1,1   READQ             READ IN SOME CRUD
         AI,R1    1
         LI,R9    3
         LI,R5    BA(FMTSPACE)
         LI,R6    0
         BALL     SLURPN
         LH,R2    F:QUE+4
         SLS,2    -1
         AI,R2    4                 ADD IN SPACE FOR NUM
         BALL     SHORTEN
         MTW,0    QACCN             IS ACCOUNT SPECED
         BE       QUE10
         LD,R4    QACCNCBS
         AW,R4    R2
         CBS,R4   0
         BNE      QREAD
QUE10    EQU      %
         LW,R6    R2
         BALL     SLURPO
         B        QREAD
QUEUEX   CAL1,1   CLSQUE            CLOSE THE DCB
         B        CMDX
NOQ      LI,R8    S:DSPKEY          LET'S LOOK AT THE DISPLAY KEY
         LI,R7    0
         BALL     LW
         LI,R5    BA(NOQUEM)        ASSUME NOTHING TO DISPLAY
         CW,R1    =X'0A0A0A0A'      IS THE KEY OK?
         BE       %+2               B/ YEP
         LI,R5    BA(NODICE)
         BALL     SLURP
         BALL     SLURPO
         LI,R3    X'20'
         CH,R3    F:QUE
         BAZ      CMDX
         B        QUEUEX            CLEAN UP AND SPLIT.
*
SHORTEN  EQU      %
         MTW,0    SHORTFLAG
         BE       SHORT10
         CW,R2    SHORTSIZE
         BLE      *R15
SHORT05  LD,R2    SHORTMBS
         MBS,R2   0
         LW,R2    SHORTSIZE
         B        *R15
SHORT10  EQU      %
         LW,R3    OBUF+1
         CW,R3    =X'C05CD7D9'      CHECK FOR HEADER LINE
         BNE      *R15              NOT YET
         LI,R15   QUE10             ALWAYS SPIT OUT THE HEADER
         LW,R1    ='*NUM'
         STW,R1   OBUF
         LI,R1    -1
         M:TS2                      GET PLATEN WIDTH
         AND,R11  =X'FC00'
         SLS,R11  -8
         CW,R2    R11
         BLE      *R15              NOTHING TO DO
         STW,R11  SHORTSIZE
         AI,R2    -7*4              GET BEG. OF REQIRED PART
         AI,R2    BA(OBUF)
         STW,R2   SHORTMBS
         AI,R11   -7*4              WE NEED THIS MANY ON THE END
         LI,R3    BA(OBUF)          WE START HERE
         AW,R3    R11
         LI,R2    7*4               NUMBER OF BYTES TO MOVE
         STB,R2   R3                NUMBER OF BYTES TO MOVE
         STW,R3   SHORTMBS+1        STORE DESTINATION ADDRESS
         MTW,1    SHORTFLAG
         B        SHORT05
*
LDEVEI   LCD,0    0                 M:LDEV
         DATA     X'90100000'
         DATA     X'C3F2'           C2
         DATA     0                 ITS IN.
         PLM,0    X'A0A',5          FORM,'(NAK)(NAK)(NAK)(NAK)'
*
OPNEIC2  GEN,8,24 X'14',F:QUE
         DATA     X'C1040000'
         DATA     NOQ,NOQ           ERROR AND ABN
         DATA     1                 IN
         DATA     X'C3F2'           DEVICE,C2
*
READQ    GEN,8,24 X'10',F:QUE
         DATA     X'F0000010'
         DATA     QUEUEX,QUEUEX     ERR AND ABN
         DATA     OBUF+1,136
*
NOQUEM   TXT      'NOTHING TO DISPLAY%'
NODICE   TXT      'RBBAT SEZ NO DICE%'
FMTSPACE TXT      ' %%%'
         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     PUSHL
         LI,5     BA(DIS1)
         BALL     SLURP
         BALL     SLURPO
         LI,9     5
         LI,1     0
         STW,1    TRASH
         LI,5     BA(DIS2)
         BALL     SLURP
         LW,1     J:JIT+PRDCRM
         AWM,1    TRASH
         BALL     SLURPN
         LW,1     J:JIT+PRDPRM
         AWM,1    TRASH
         BALL     SLURPN
         LI,9     6                 SIX DIGITS FOR TOTAL
         LI,1     0
         XW,1     TRASH
         BALL     SLURPN
         BALL     SLURPO
         LI,5     BA(DIS3)
         LI,9     5
         BALL     SLURP
         LI,7     0                 NO INDEX
         LI,8     GRANRAD
         BALL     LW
         AWM,1    TRASH
         BALL     SLURPN
         LI,8     GRANPACK
         BALL     LW
         AWM,1    TRASH
         BALL     SLURPN
         LI,9     6
         LI,1     0
         XW,1     TRASH
         BALL     SLURPN
         BALL     SLURPO
         LI,5     BA(DIS4)
         BALL     SLURP
         LI,8     GRANSYM
         BALL     LW
         BALL     SLURPN
         BALL     SLURPO
         B        CMDX
*
*        PCOUNT GIVES THE NUMBER OF TIMES WE HAVE MOVED THE
*        WINDOW PAGE AROUND, AND RESETS THAT COUNT TO ZERO.
*
PCNT     PUSHL
         LI,9     0
         LI,5     BA(PCNT1)
         BALL     SLURP
         LI,1     0
         XW,1     PCOUNT
         BALL     SLURPN
         BALL     SLURPO
         B        CMDX
         PAGE
*        TAPES COMMAND DISPLAYS THE STATUS OF THE TAPE DRIVES
*        IN THE SYSTEM USING INFORMATION GLEANED FROM THE AVR TABLES.
*
TAPES    PUSHL
         LI,7     AVRTBLSIZ-1       # OF DRIVES ON THIS BEAST.
TAPE1    LI,5     BA(STATM3)        HEADER TO USE
         BALL     SLURP             POKE OUT A SPACE.
         LI,8     AVRTBL            GET THE INFO ON THIS ONE.
         BALL     LD                ITS A DOUBLEWORD.
         LD,2     0                 SAVE FOR A MINUTE.
         LI,8     AVRID             LETS LOOK AT AVRID TOO
         BALL     LH                WHILE WE'RE AT IT.
         LW,3     1                 SAVE THAT TOO....
         LI,8     DCT16+BATAPE+BATAPE
         BALL     LD                GET DRIVE NAME
         SLD,0    24                GET RID OF THAT CRUD IN FRONT
         BALL     SLURPC            AND SPIT IT OUT
         LW,1     3                 NOW GET THE AVR ID
         LI,9     4                 AND PRINT IN 4 HEX DIGITS
         BALL     SLURPH
         LW,0     2                 GET LABEL, IF ANY
         LI,1     0
         BALL     SLURPC            AND PRINT THAT OUT.
         LB,3     3                 JUSTIFY STATUS BITS
         CI,3     X'10'             CHECK FOR SCRATCH
         BAZ      TAPE2
         LD,0     TAPEM1            SCRATCH TEXT
         BALL     SLURPC
TAPE2    BALL     SLURPO
         BDR,7    TAPE1             FOR EACH DRIVE IN SYSTEM
         CI,7     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     PUSHL
         BALL     ARGH              GO GET USER NUMBER
         BLE      EHX               NOTHING. GRIPE
         B        USER01            HOP DOWN.
USERXX   PUSHL
         B        USER0
USER00   BALL     ARGH              GET ANOTHER USER NUMBER
         BE       CMDX              NO MORE TO BE HAD.
USER01   CI,1     SMUIS             IS IT LEGAL?
         BLE      USER02            BL/GOOD ID, LOOK FOR STUFF
         LW,9     1                 LETS BE NICE ABOUT IT, AND LOOK FOR
         LI,8     PLH:SID           A BATCH ID LIKE THIS BEFORE CALLING
         LI,7     LPART             THIS AN ERROR.
         BALL     LH
         CW,1     9                 IS IT THIS ONE??
         BE       %+3               B/YUP, FOUND IT.
         BDR,7    %-3               LOOK THRU BATCH TABLES.
         B        USER00            NUTS. NOT THERE.....
         LI,8     PLB:USR
         BALL     LB                FETCH THE USER ID BYTE,
USER02   LW,7     1                 USE IT AS AN INDEX INTO
         LI,8     UB:US             STATE TABLE TO SEE IF ITS
         BALL     LB                BEING USED.
         CI,1     SNULL             CHECK FOR NULL STATE.
         BE       USER00            NO STATE MEANS NO USER. BYE.
         LW,1     7                 PUT IT BACK.
USER0    LI,9     0                 ENTRY USED BY JIT, LONG USERS CMDS
         LI,5     BA(USERM1)        HEADER TO USE
         LI,6     0
         BALL     SLURP             OUTPUT BEGINNING
         STW,1    TRASH             SAVE THAT ID FOR LATER
         BALL     SLURPH            PUT IT OUT
         BALL     USERIS            GO TELL ME IF HE GHOST OR WHAT.
         BALL     SLURPO            SPIT IT OUT
         LI,5     BA(USERM2)        HEADER TO USE FOR SIZE AND STATE
         LW,7     TRASH             USE ID AS INDEX
         BALL     SLURP             FIRST PART OF HEADER
         LI,8     UB:PCT            GET PAGE COUNT
         BALL     LB
         BALL     SLURPN            SPIT THAT OUT
         LI,8     UB:US
         BALL     LB                GET CURRENT STATE
         LW,0     STATETXT,1        GET THE TEXT FOR THE STATE
         BALL     SLURPC            AND PRINT THAT OUT.
         LI,8     UB:PRIO           CURRENT EXECUTION PRIO
         BALL     LB                FETCH THAT,
         BALL     SLURPH            AND PUMP OUT AS HEX
         LI,8     UB:PRIOB
         BALL     LB                BASE EXECUTION PRIO
         BALL     SLURPH            AND DUMP THAT TOO.
         LI,8     UB:ACP            LOOK AT COMMAND PROC.
         BALL     LB
         BE       USER2             NOPE.
         LI,5     BA(USERM3)        IF THERE IS, WE'LL
         BALL     USRSUB            GO POKE OUT P:NAME ENTRY.
USER2    LW,7     TRASH             GET USER ID BYTE BACK
         LI,8     UB:APR            LOOK AT ASSOCIATED PROCESSOR
         BALL     LB
         BE       USER3             NO GOT......
         LI,5     BA(USERM4)
         BALL     USRSUB            THE USER'S APR.
USER3    LW,7     TRASH
         LI,8     UB:OV             MON OVERLAY NEEDED
         BALL     LB
         BE       USER4
         LI,5     BA(USERM5)
         BALL     USRSUB            THE USER'S MON OVERLAY.
USER4    BALL     SLURPO            THE END......
         B        USER00            BYE..........
USRSUB   PUSHL                      SAVE LINK
         BALL     SLURP             HEADER INFO
         LW,7     1
         LI,8     P:NAME
         BALL     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,7              SAVE ALL BUT 6, THE OUTPUT PTR.
         LW,2     1                 SAVE USER ID
         LI,1     X'FF'             LETS SEE IF THIS USER ID
         AND,1    J:JIT             HAPPENS TO BE MINE.....
         CW,1     2
         BNE      %+3
         LW,0     =' YOU'           IT IS....LET PEOPLE KNOW...
         BALL     SLURPC
         LI,7     MAXG              MAX NUMBER OF GHOSTS THERE CAN BE
         LI,8     SB:GJOBUN         AND THE ID TABLE
         BALL     LB                GET ONE
         CW,1     2                 ARE THEY EQUAL?
         BE       USERISG           YUP, GOT 'EM.......
         BDR,7    %-3               KEEP LOOKING
         CI,7     0                 SLOT ZERO IN TABLE.
         BE       %-5
         LI,7     LPART             NOW WE CHECK PARTITION TABLES
         LI,8     PLB:USR           TO SEE IF ITS BATCH.
         BALL     LB
         CW,1     2
         BE       USERISB           FOUND IT.
         BDR,7    %-3               OR KEEP LOOKING.
USERISO  LI,5     BA(USROM)         MUST BE ONLINE, I GUESS...
         BALL     SLURP
         LI,8     LB:UN             SO WE'LL SEARCH LB:UN TO FIND
         LI,7     LNOL              OUT WHAT COC LINE IT IS.
         BALL     LB
         CW,2     1
         BE       %+2               BUT IF I DONT FIND IT,
         BDR,7    %-3               I WONT BE BUGGED.
         LW,1     7                 WE WANT THE LINE NUMBER INDEX.
         BALL     SLURPH            I'LL JUST SPIT OUT A ZERO.
USERISX  PULL     15,7              RESTORE ALL
         B        *L                AND SPLIT.
USERISG  LI,5     BA(USRGM)         HEADER FOR GHOST USER
         BALL     SLURP
         LI,8     S:GJOBTBL         FIND THE NAME OF THIS GHOST
         BALL     LD
         BALL     SLURPT
         B        USERISX           THAT'S ALL FOR GHOSTS.
USERISB  LI,5     BA(USRBM)         FOR BATCH USERS.
         BALL     SLURP
         LW,1     7
         BALL     SLURPN            PUT OUT PARTITION NUMBER
         LI,8     PLD:ACT           AND GO GET THE ACCOUNT
         BALL     LD
         BALL     SLURPC
         LI,8     PLH:SID           AND THE SYSID FOR IT.
         BALL     LH
         B        USERISX-1         THAT'S ALL......
         PAGE
CHK      PUSHL
         BALL     JOB
         MTW,0    USRTHERE
         BEZ      RESTART
         B        CMDX
         PAGE
*        PUNT.... WHEN IN DOUBT, PUNT.....
*
PUNT     PUSHL
         BALL     USERS             JUST FOR WARMUPS....
         LI,7     SMUIS             MAX NUMBER OF USERS IN SYSTEM
         STW,7    TRASH             A GOOD PLACE TO STASH IT.
         B        PUNT2
PUNT1    LW,7     TRASH
         LI,8     UB:US
         BALL     LB                THIS USER ID ACTIVE???
         CI,1     SNULL             CHECK FOR NULL STATE.
         BE       PUNTER            NOPE. SCRAM.
         LI,1     PUNT2             GROSS CODE TO GET AROUND NOT
         PUSH     1                 HAVING CLEAN ENTRY TO USER
         LW,1     TRASH
         B        USER0             ROUTINE. ENTER THRU SIDE DOOR.
PUNT2    LB,0     8BLNKS            LOAD A BLANK
         STB,0    OBUF              POKE INTO THE BUFFER
         LI,6     1
         BALL     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,7     CMDALL            NUMBER OF ENTRIES AHEAD OF ALL.
DOALL1   LI,2     2
         MTW,0    ONLIN             ARE WE ONLINE??
         BE       %+3               YUP. HOP DOWN
         LI,1     DIS1              NULL WRITE IF NOT ONLINE OUTPUT.
         CAL1,1   WRITEIT
         LI,5     BA(DOOM1)
         BALL     SLURP
         LD,0     CMDTXT,7          COMMAND NAME
         BALL     SLURPT
         BALL     SLURPO
         PUSH     7
         LW,5     CMDTV,7
         BALL     *5
         PULL     7
         BDR,7    DOALL1
*
*        EH SPITS OUT A USEFUL AND INFORMATIVE ERROR MESSAGE.....
*
EHX      PULLL                      RESTORE OLD LINK FOR EXIT.
EH       SLAVE                      JUST IN CASE
         LI,R1    EMSG
         LI,2     3
         CAL1,1   WRITEIT
         B        *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,7     0
         STW,7     TPC       ZERO OUT TOTAL PAGE COUNTER..   DCS7APR75
         LI,8     S:BUIS
         BALL     LW                SEE IF ANY BATCH RUNNING NOW.
         BG       BATCH1            GUESS SO.
         LI,1     NOBATCH           IF NOT, PRINT OUT A
         LI,2     22                REASONABLE MESSAGE
         CAL1,1   WRITEIT
         LI,7     0
         LI,8     S:BUAIS           HOW MANY BATCH USERS ALLOWED?
         BALL     LW
         LI,5     BA(BAT1)
         BALL     SLURP
         LI,9     0                 HOWEVER MANY YOU WANT.
         BALL     SLURPN
         BALL     SLURPO            OUTPUT IT.
         B        CMDX              SPLIT.
BATCH1   LI,13    LPART             NUMBER OF PARTITIONS IN SYS.
         LI,7     1                 STARTING PARTITION NUMBER
         LI,5     BA(BAT2)
         BALL     SLURP
         BALL     SLURPO            WRITE HEADER
BATCH2   LI,6     0                 POKE BACK TO ZERO
         LI,5     BA(BAT3)          FORMATTER
         LI,9     3                 4 DIGIT NUMBERS
         LI,8     PLH:SID           CHECK SYSID FOR NONZERO
         BALL     LH                TO SEE IF A JOB IS RUNNING
         BE       BATCH3-1          NOPE. CHECK NEXT PARTITION.
         LW,3     1                 SAVE ID
         BALL     SLURP
         LW,1     7                 PARTITION NUMBER
         BALL     SLURPN
         LW,1     3                 SYSID
         BALL     SLURPH
         LI,8     PLB:USR           GET USER NUMBER FOR THIS THING
         BALL     LB
         LW,11    1                 REMEMBER THIS FOR A WHILE....
         BALL     SLURPH            GO SPIT THAT OUT TOO.
         LW,12    7                 SAVE PARTITION NUMBER
         LI,8     UB:PCT            LOOK AT UB:US
         LW,7     1                 INDEXED BY USER NUMBER
         BALL     LB                TO GET USER PAGE SIZE
         AWM,1     TPC       SUM TOTAL PAGE COUNT (PC)
         BALL     SLURPN
         LI,8     UB:US             GET CURRENT USER STATE
         BALL     LB
         LW,0     STATETXT,1        TEXT FOR IT
         BALL     SLURPC            AND SPIT IT OUT
         LW,7     12                RESTORE PARTITION NUMBER
         LI,8     PLD:ACT           ACCOUNT
         BALL     LD
         BALL     SLURPC            8 CHARACTERS.
         LW,7     11                REMEMBER THAT USER ID??
         LI,8     UB:APR            LETS PRINT OUT THE PROCESSOR
         BALL     LB                THATS BEING USED.
         LW,7     1
         LI,8     P:NAME
         BALL     LD
         BALL     SLURPT
         BALL     SLURPO            THATS THAT LINE.
         LW,7     12                LOOK AT THE
         AI,7     1                 NEXT PARTITION
BATCH3   BDR,13   BATCH2            KEEP LOOKING THROUGH PARTITIONS.
         LI,5      BA(TOTALPC)
         LD,6      16BALLS         INITILIZE OUTPUT
         BALL      SLURP
         LI,9      3         4 DIGIT NUMBERS..
         LW,1      TPC
         BALL      SLURPN
         BALL      SLURPO
         B        CMDX              ALL DONE.
         PAGE
*
*        THE RAT COMMAND DISPLAYS THE RESOURCE ALLOCATION TABLES
*
RAT      PUSHL
         LI,R1    0
         STH,R1   WHOSAVE
         BALL     ARGT              LOOK FOR OPTIONS
         BE       RAT02             NO MORE ARGS
         SLS,R0   -16
         MTH,1    WHOSAVE
         LH,R1    WHOSAVE
         STH,R0   WHOSAVE,R1
         B        %-6               LOOK FOR MORE
RAT02    EQU      %
         LI,R5    BA(RATHDR1)
         BALL     SLURP
         BALL     SLURPO
         LI,R5    BA(RATHDR2)
         BALL     SLURP
         BALL     SLURPO
         LI,R1    X'FE440'
         BALL     CHKRES
         BE       RAT03             DON'T DISPLAY USERS
         BALL     SLURPC
         LI,R7    0
         LI,R8    S:BUAIS
         BALL     LW                NO OF BATCH USERS ALLOWED
         BALL     SLURPN
         LI,R8    S:BUIS            CUR. NO OF BATCH USERS
         BALL     LW
         BALL     SLURPN
         LI,R8    S:OUAIS           NO OF ONLINE USERS ALLOWED
         BALL     LW
         BALL     SLURPN
         LI,R8    S:OUIS            CUR. NO OF ONLINE USERS
         BALL     LW
         BALL     SLURPN
         LI,R8    S:GUAIS           NO OF GHOSTS ALLOWED
         BALL     LW
         BALL     SLURPN
         LI,R8    S:GUIS            CUR. NO OF GHOSTS
         BALL     LW
         BALL     SLURPN
         BALL     SLURPO
RAT03    EQU      %
         LI,R7    SV:RSIZ           NUMBER OF RAT ENTRIES
RAT10    EQU      %
         LI,R8    SH:RNM
         BALL     LH
         BALL     CHKRES            DO WE DISPLAY THIS ONE?
         BE       RAT20             B/ NOPE.
         BALL     SLURPC            OUTPUT RESOURCE NAME
         LI,R8    SH:RBSUM
         BALL     LH
         BALL     SLURPN            OUTPUT TOTAL BATCH
         LI,R8    SH:RBCU
         BALL     LH
         BALL     SLURPN            OUTPUT CURRENT BATCH
         LI,R8    SH:ROSUM
         BALL     LH
         BALL     SLURPN            OUTPUT TOTAL ONLINE
         LI,R8    SH:ROCU
         BALL     LH
         BALL     SLURPN            OUTPUT CURRENT ONLINE
         LI,R8    SH:RGSUM
         BALL     LH
         BALL     SLURPN            OUTPUT TOTAL GHOST
         LI,R8    SH:RGCU
         BALL     LH
         BALL     SLURPN            OUTPUT CURRENT GHOST
         BALL     SLURPO
RAT20    BDR,R7   RAT10
         B        CMDX
CHKRES   EQU      %
         LH,R2    WHOSAVE           GET NO OF OPTIONS
         BG       %+2
         LI,R2    -1
         CH,R1    WHOSAVE,R2
         BE       %+2
         BDR,R2   %-2
         SLD,R0   48
         LI,R5    BA(RATFMT)
         LI,R9    5                 DISPLAY 5 DIGITS
         LI,R6    0
         AI,R2    0
         B        *R15
RATHDR1  TXT      'RES  BTRES  BCRES  OTRES  OCRES  GTRES  GCRES%'
RATHDR2  TXT      '---  -----  -----  -----  -----  -----  -----%'
RATFMT   TXT      '   %  %  %  %  %  %%%'
         PAGE
*
*        THE RES COMMAND TELLS HOW MUCH IS LEFT FOR BATCH JOBS
*
RESCMD   PUSHL
         LI,R7    1                 START AT FIRST RAT ENTRY
         LI,R9    0                 PRINT '0' DIGITS
         LI,R6    0                 INIT BUFFER
RES10    EQU      %
         LI,R5    BA(RESFMT)
         LI,R8    SH:RNM            GET RESOURCE NAME
         BALL     LH
         SLD,R0   48
         BALL     SLURPC            OUTPUT RESOURCE NAME
         LI,R8    SH:RBCU           GET CURRENT BATCH USAGE
         BALL     LH
         LW,R3    R1                SAVE IT FOR A WHILE
         LI,R8    SH:RBSUM          GET TOTAL BATCH ALLOWED
         BALL     LH
         SW,R1    R3                FIND WHAT'S LEFT
         BALL     SLURPN            AND SPIT IT OUT
         AI,R7    1
         CI,R7    SV:RSIZ           ANY MORE RESOURCES?
         BLE      RES10             B/ YES
         LI,R7    0
         LI,R8    S:BUIS            GET CURRENT BATCH USERS
         BALL     LW
         LW,R3    R1
         LI,R8    S:BUAIS           GET ALLOWED BATCH USERS
         BALL     LW
         SW,R1    R3
         LI,R5    BA(RESFMT2)
         BALL     SLURP
         BALL     SLURPN            OUTPUT REMAINING BATCH USERS
         BALL     SLURPO            OUTPUT THE STUFF
         B        CMDX
RESFMT   TXT      '=%,%%'
RESFMT2  TXT      'UL=%%%'
         PAGE
RBSTAT   PUSHL                      RBSTAT COMMAND
         LI,R8    RBLIMS
         LI,R7    0
         BALL     LD
         CW,R0    R1
         BG       RBNONE
         STW,R1   TRASH
         LW,R7    R0                MOVE DCTX TO R7
RBLOOP   EQU      %
         LI,R5    BA(RBFMT)
         LI,R8    DCT16
         BALL     LD                GET DEVICE NAME
         SLD,R0   8*3
         BALL     SLURPC
         LI,R8    RBD:WSN           GET WORKSTATION NAME
         BALL     LD
         BALL     SLURPC
         LI,R8    RBB:ID            GET WORKSTATION ID
         BALL     LB
         AI,R1    0
         BE       RBEMPTY
         LI,R9    2
         BALL     SLURPH
         LI,R8    RB:FLAG           GET FLAG WORD
         BALL     LW
         CI,R1    LIPBIT            IS WSN LOGGING ON?
         BAZ      %+3               B/ NOPE
         LI,R5    BA(LIPTXT)
         B        RB10
         CI,R1    ACTBIT            IS WSN THERE?
         BAZ      %+3
         LI,R5    BA(ACTTXT)
         B        RB10
         LI,R5    BA(IIDLTXT)
RB10     BALL     SLURP
RB20     BALL     SLURPO
         AI,R7    1
         CW,R7    TRASH
         BLE      RBLOOP
         B        CMDX
RBNONE   EQU      %
         LI,R5    BA(FMTRBNONE)
         BALL     SLURP
         BALL     SLURPO
         B        CMDX
FMTRBNONE TXT     'NONE%'
RBEMPTY  EQU      %
         LI,R6    8                 FAKE OUT SLURP
         LI,R5    BA(FMTRBEMTY)
         BALL     SLURP
         B        RB20
RBFMT    TXT      ' - % ID=%,  STATUS=%%%'
LIPTXT   TXT      'LOGGING ON%%%'
ACTTXT   TXT      'ACTIVE%%%'
IIDLTXT  TXT      'IDLE%%%'
FMTRBEMTY TXT     'EMPTY%%%'
         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 PUSHL                                                          JTA D0A
         CAL1,4   ASSOCDELTA                                            JTA D0A
DELXIT   B        RESTART
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     DELXIT                                                JTA D0A
         DATA     %+1               LMNLOC
         TXT      ':SYS    '        USE MONSTK IN :SYS
         DATA     0,0               NO PASSWORD, I HOPE..
         TXTC     'M:MON'
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
*        3, THE LINK IS 4. THE VALUS IS RETURNED IN 3. WE CALL
*        LOADTHING TO DO THE DIRTYWORK.
*
DGET     PUSH     10,5
         LI,7     0
         LW,8     3                 THE THING TO GET
         BALL     LW                GO GET IT ALREADY.
         LW,3     1                 PUT IT IN THE RIGHT SPOT
         PULL     10,5
         B        *4                AND SPLIT.
*
*        DPUT IS THE DELTA PUT ROUTINE. WE GRIPES AND RETURNS.
*
DPUT     LI,1     DPUTM
         LI,2     4                 I'M NOT GOING TO POKE INTO
         CAL1,1   WRITEIT           THE MONITOR.....
         B        *4                RETURN TO DELTA
DPUTM    TXT      'NOPE'            (I WONT DO IT.
*
*        SCLOSE, CALLED BY 'PRINT' DOES A SUPERCLOSE.
*
SCLOSE   CAL1,9   6                 CLOSE SYMBIONTS
         B        *L                AND SPLIT.
         PAGE
*        OKEXIT EXITS TO THE REAL TEL AFTER CLEANING UP AS
*        REQUIRED. EVERYTHING THAT WANTS TO EXIT SHOULD DO SO
*        THROUGH OKEXIT, ALTHOUGH IF YOU WANT TO ABORT,
*        THAT'S YOUR OWN PROBLEM.......
*
OKEXIT   CAL1,4   BYEDELTA          GET RID OF DELTA, IF AROUND
         BALL     FREEM             GET RID OF ATTACHED PAGES
         BALL     CLEAR             CLEAR TIES
         MTW,0    HURRO             WERE WE M:LINKED TO?
         BE       %+2               GUESS NOT.
         CAL1,8   MLDTRC            IF SO, M:LDTRC BACK.
         CAL1,9   1                 AND EXIT.
*
*        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,4    EH                IT WASNT THERE!!!!!!
         CAL1,8   MINT                                                  JTA D0A
         B        *L
         PAGE
*        GHOST GIVES THE NAMES AND SYSIDS OF RUNNING GHOSTS.
*
GHOST    PUSHL
         LI,7     0
         LI,8     S:GUIS
         BALL     LW
         BG       GHOST1            GHOSTS RUNNING. GO DISPLAY 'EM.
         LI,1     GHOSTM1           SORRY, BUB, NO GHOSTS AROUND
         LI,2     10                HERE NOW..PROBABLY NEVER HAPPEN...
         CAL1,1   WRITEIT
         B        CMDX              BYE........
GHOST1   LI,5     BA(GHOSTM2)
         BALL     SLURP
         BALL     SLURPO            HEADER.
         LI,13    MAXG
GHOST2   LW,7     13
         LI,8     SB:GJOBUN         CHECK FOR A JOB NUMBER
         BALL     LB
         BE       GHOST3            NOT RUNNING HERE.....
         LI,6     0
         LI,5     BA(STATM3)
         LI,9     4
         BALL     SLURPH            ID
         LI,8     S:GJOBACN         WHAT IS THE ACCOUNT??
         BALL     LD
         BALL     SLURPC
         LI,8     S:GJOBTBL
         BALL     LD                GET THE NAME
         BALL     SLURPT
         BALL     SLURPO            PRINT THE STUFF
GHOST3   BDR,13   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  PUSHL
         CAL1,8   DISPL1            GET THE TIME AND SUCH.
         LI,1     OBUF
         LI,2     16
         CAL1,1   WRITEIT           AND SPEW IT OUT.
         LI,5     BA(DISPM1)
         BALL     SLURP             SPACE OVER
         LCI      5
         LM,0     J:JIT+1           LOAD NAME AND ACCOUNT.
         BALL     SLURPC            NAME-TWO WORDS.
         LD,0     2                 FIRST TWO OF ACCT.
         BALL     SLURPC
         LW,0     4
         LI,1     0
         BALL     SLURPC
         LI,9     2
         LB,1     JB:PRIV           PRIV LEVEL
         BALL     SLURPH
         LW,1     J:JIT
         AND,1    =X'FF'            INCLUDE USER ID IN THE MESSAGE.
         BALL     SLURPH
         LW,1     M:UC+COCLN
         AND,1    =X'FF'
         BALL     SLURPH
         REF      COCLN
         BALL     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    PUSHL
         LC       J:JIT             ARE WE ONLINE USER??
         BCR,8    EHX               B/NOPE, GET LOST......
         PRIV     EHX
         CAL1,1   =X'2C00005A'      M:PC '!'
         CAL1,1   READUC            READ THE TERMINAL.
         CAL1,1   =X'2C000000'      RESET PROMPT TO NULL
         LH,2     M:UC+4
         SLS,2    -1
         CI,2     1                 ANYTHING TYPED IN??
         BLE      NAILX             B/NOPE, BUG OUT.
         LW,3     2                 COPY LENGTH
         AI,3     -1
         LI,4     X'15'             NEW LINE CHARACTER
         STB,4    KINBUF,3          PUT AT END OF TEXT.
         LD,6     KMOVE             LOAD MBS CONTROL STUFF
         STB,2    7                 MOVE ONLY WHAT'S NEEDED.
         MBS,6    0                 MOVE IT IN.
         CAL1,6   MGJOB             KICK KEYIN
         BCS,8    KLATER            HE SAY BUZZ OFF...
         B        NAILX
KLATER   LI,1     TLATER            LATER...
         LI,2     6
         CAL1,1   WRITEIT           SPEW.....
         B        NAILX             AND QUIT.
*
READUC   GEN,8,24 X'10',M:UC
         DATA     X'30000010'
         DATA     KINBUF,80
         BOUND    8
KMOVE    DATA     BA(KINBUF)
         DATA     BA(KEYINBUF)
MGJOB    GEN,8,24 6,0               NOTE: TCKEYIN MUST FOLLOW IMMEDIATLY
TCKEYN   TXTC     'KEYIN'           FOR T:GJOBSTRT
TLATER   TXT      'LATER!'
         USECT    DATA
KINBUF   RES      40
         USECT    CODE
         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      PUSHL
         PRIV     EHX
         BALL     GUN               GET USER NUMBER.
         PUSH     1                 AND STASH FOR A WHILE.
         BALL     ARGT              GO GET EVENT TEXT
         BE       NAILEH            WHAT'S THIS TRASH????
         LI,2     LEVENT            LAST EVENT
         CW,0     TEVENT,2                                       JTA D0A
         BE       FNDEVNT
         BDR,2    %-2
         PULL     3
         B        EHX
FNDEVNT  EQU      %
         PULL     3                 EVENT IN 2, USER # IN 3.
         LB,2     EVENTTBL,2                                     JTA D0A
         BEZ      NAILEH                                         JTA D0A
         PUSH     2,2               STASH ON STACK FOR A WHILE.
         WD,0     X'37'             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
         WD,0     X'27'             TURN ON INTERRUPTS AGAIN
         LI,1     SC02M             YOU WIN A SC-02.....
         LI,2     13                LENGTH
         CAL1,1   WRITEIT
         PULL     2,0
         B        NAILX             EXIT....
SC02M    TXT      'NOPE! SC/02..'
*
TRCE2    AI,2     1                 NEXT ENTRY                   JTA D0A
         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,11   T:RUE             GO REPORT EVENT.
         B        NAILX             AND EXIT.
*
*        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......
EVENTTBL EQU      %                 TABLE OF EVENTS
         DATA,1   0,E:QME,E:CRD,E:CIC
         DATA,1   E:CBL,E:CUB,E:CBK,E:CEC,E:ERR,E:OFF,E:WU,E:SL
         DATA,1   E:QA,E:ART,E:UQA,E:KO,E:AP,E:QE,E:IC,E:QFI
         DATA,1   E:NSYM,E:SYMF,E:NSYD,E:SYMD,E:OCR,E:NOCR
         DATA,1   E:CFB,E:CBA,E:ND,D:DPA,E:QFAC,E:UQFA,E:NQW,E:NQR
         BOUND    4
         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    PUSHL
         PRIV     EHX
         BALL     GUN               GET USER NUMBER.
PRIOB1   PUSH     1                 SAVE THAT FOR A WHILE....
         BALL     ARGH              AND GO GET NEW BASE PRIO.
         BG       PRIOB2
         PULL     1
PRIOB3   LW,1     S:CUN
         PUSH     1
         LW,1     WHOSAVE
         B        PRIOB2
PRIOBN   PULL     1                 GET RID OF THIS TRASH
         B        NAILEH            AND RETURN GRIPING.
PRIOB2   CI,1     X'FE'             IS IT SMALL ENOUGH??
         BG       PRIOBN            BG/NOPE, ITS NOT...
         CI,1     X'20'             IS IT TOO SMALL????
         BL       PRIOBN            BL/YES. DONT DO IT.....
         PULL     2
         WD,0     X'37'             DONT BUG ME FOR A WHILE.....
         STB,1    UB:PRIOB,2
         WD,0     X'27'             JUST FOR ONE INSTRUCTION, BUT NEEDED.
         LW,1     2                 MOVE USER NUMBER DOWN TO 1...
         SLAVE
         B        USER0
         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     PUSHL
         PRIV     EHX
NAIL0    BALL     ARGC              GO GET TEXTC ARGUMENT
         BG       %+3
NAILX    SLAVE
         B        CMDX
         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,7     PNAMEND
         CD,0     P:NAME,7          SEE IF WANTED TO NAIL PROCESSOR
         BE       NAILS             B/NAIL ANYBODY ATTACHED TO THIS
         BDR,7    %-2               SEARCH PROCESSORS+MON OVERLAYS
         LB,2     0
         BE       NAILX
         CI,2     2
         BLE      NAILUSER
         LI,5     MAXG              GET # GHOSTS AVAILABLE
         CD,0     S:GJOBTBL,5       LOOK UP GHOST NAME
         BNE      %+4
         LB,5     SB:GJOBUN,5       GET GHOSTS USER #
         BAL,11   NAILU             NAIL HIM
         B        NAIL0             CONTINUE
         AI,5     -1
         CI,5     MING              CHECK FOR SYSTEM GHOST
         BGE      %-7
NAILEH   SLAVE
         B        EHX
NAILUSER EQU      %
         LI,3     1
         LI,5     0                 USER # TO NAIL
NAIL2    LB,1     0,3
         CI,1     '9'
         BG       NAILEH
         CI,1     '0'
         BGE      %+2
         AI,1     X'39'
         AI,1     -'0'
         BL       NAILEH            BAD DIGIT
         CI,1     16
         BGE      NAILEH            DITTO.
         SLS,5    4
         AW,5     1                 ADD IN HEX DIGIT
         AI,3     1
         BDR,2    NAIL2             GO COLLECT NUMBER
         BAL,11   NAILU             GO NAIL THIS USER
         B        NAIL0             AND LOOK FOR MORE.
*
*        NAILU NAILS THE USER NUMBER PASSED IN 5 IF IT IS LEGAL,
*                 A LOGGED ON USER, AND NOT ME.
*
NAILU    CI,5     SMUIS
         BG       *11               NOPE.
         CI,5     0
         BE       *11
         CW,5     S:CUN
         BE       *11               THAT'S ME YOU'RE TRYING TO KILL!!
         LB,6     UB:US,5
         CI,6     SNULL
         BE       *11               NOT ON. BYE....
         LI,6     E:OFF
         B        T:RUE             NAIL......
*
*        NAILA    NAIL ALL USERS IN SYSTEM.
*
NAILA    LI,5     SMUIS
         CI,5     4
         BLE      NAIL0             DONT NAIL 'CAT OR RBBAT.
         PUSH     5
         BAL,11   NAILU
         PULL     5
         BDR,5    NAILA+1
*
NAILB    LI,7     LPART             NUMBER OF PARTITIONS
         PUSH     7
         LB,5     PLB:USR,7         GET USER NUMBER, IF ANY
         BAL,11   NAILU
         PULL     7
         BDR,7    NAILB+1
         B        NAIL0             LOOK FOR MORE TROUBLE.
*
NAILG    LI,7     MAXG
         PUSH     7
         LB,5     SB:GJOBUN,7
         CI,5     MING              CHECK FOR SYSTEM GHOST
         BL       %+2               DONT NAIL IF IT IS
         BAL,11   NAILU
         PULL     7
         BDR,7    NAILG+1
         B        NAIL0
*
NAILO    LI,7     LNOL
         PUSH     7
         LB,5     LB:UN,7
         BAL,11   NAILU
         PULL     7
         BDR,7    NAILO+1
         LB,5     LB:UN
         BAL,11   NAILU
         B        NAIL0
*
*        NAILS    NAIL ALL USERS ASSOC. WITH P:NAME ENTRY IN R7.
*
NAILS    LW,10    7                 SAVE THE INDEX UP HERE
         LI,5     SMUIS             NUMBER OF USERS IN SYSTEM
NAILS0   CB,10    UB:OV,5
         BE       NAILS1            B/YUP, GET THIS ONE
         CB,10    UB:ACP,5
         BE       NAILS1
         CB,10    UB:APR,5
         BNE      NAILS2            B/NO, LEAVE THIS ONE ALONE.
NAILS1   PUSH     10                SAVE MAGIC INDEX
         PUSH     5                 AND USER NUMBER
         BAL,11   NAILU             GO BLITZ THE USER
         PULL     5
         PULL     10
NAILS2   CI,5     4                 GOT DOWN TO NITTY GRITTY YET??
         BLE      NAIL0             DONT NAIL 'CAT OR RBBAT....
         BDR,5    NAILS0
*
*        GOPRIV RETURNS TO THE USER MASTER MAPPED.
*
         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 NAILEH.
*
GUN      PUSHL
         BALL     ARGH              GO GET NUMBER
         BE       GUNE              B/GROSS...NOT THERE.
         STW,1    WHOSAVE
         CI,1     0
         BE       GUNE
         CI,1     SMUIS             IS IT LEGAL???
         BLE      CMDX              B/YES.
         PUSH     4,2               SAVE THESE FOR A WHILE.
         LW,3     1                 THE NUMBER WE'RE HUNTING FOR.
         LI,4     LPART             # OF PARTITIONS
         CH,3     PLH:SID,4         ASSUME RUNNING MASTER.....
         BE       GUN1              B/FOUND IT.
         BDR,4    %-2               SEARCH 'EM ALL.
         PULL     4,2               NOT FOUND.
GUNE     PULLL
         CI,15    PRIOB1
         BE       PRIOB3
         B        NAILEH            SPLIT.
GUN1     LB,1     PLB:USR,4         LOAD THE ID
         PULL     4,2
         B        CMDX              AND RETURN TO CALLER.
         PAGE
*        GJOB WILL INITIATE THE GHOST JOB NAMED
*
GJOB     EQU      %
         PUSHL
         LCI      15
         STM,0    WHOSAVE           SAVE THE REGISTERS
         BALL     ARGC              GET THE LM NAME
         BEZ      EHX               NO LM NAME!
         PUSH     2,0               SAVE IT FOR LATER
         BALL     ARGT              GO GET ACCOUNT
         BG       %+2
         LD,0     SYSACCT           NO ACCOUNT SPECIFIED SO WE
*                                   WILL USE :SYS
         PUSH     2,0               SAVE THE ACCOUNT FOR LATER
         PRIV     EHX
         LI,15    X'FA'             GIVE THE GHOST SOME PRIORITY
         PULL     2,8               GET THE ACCOUNT
         PULL     2,0               GET THE LM NAME
         BAL,10   T:GJOB            THIS DOES THE TRICK
         REF      T:GJOB
         BCR,10   GJOB1
         LI,15    EHX               IT DIDN'T WORK
         B        GJOB6
GJOB1    BCS,4    GJOB2             B/TASK AWAKENED
         LI,15    CMDX
GJOB6    SLAVE
         LCI      15
         LM,R0    WHOSAVE
         B        *R15
GJOB2    SLAVE
         LCI      15
         LM,0     WHOSAVE
         LI,5     BA(AWAKE)
         BALL     SLURP
         BALL     SLURPO
         B        CMDX
AWAKE    TXT      '            TASK AWAKENED%%%%%'
         PAGE
*        THE PRIORITY COMMAND CHANGED THE USERS JIT
*        PRIORITY OR THE USERS EXECUTION PRIORITY.
*        A RANGE FROM 0 TO F CHANGED JIT PRIORITY
*        A RANGE FROM F0 TO FF CHANGES THE EXECUTION PRIORITY
JPRIOR   PUSHL
         BALL     ARGH
         BE       EHX
         CI,1     X'F'
         BG       EHX
         B        PRIORJIT
OLDPRIOR EQU      %
         SLAVE
         LW,1     4                 GET OLD VALUE
         LI,5     BA(WAS)
         BALL     SLURP
         BALL     SLURPH
         BALL     SLURPO
         B        CMDX
PRIORJIT EQU      %
         LW,2     1
         LI,3     X'F'
         SLD,2    20
         PRIV     EHX
         LW,4     J:ABC             GET PREVIOUS PRIORITY
         AND,4    3                 MASK IT
         SLS,4    -20               AND SHIFT DOWN
         STS,2    J:ABC
         LI,9     1                 OUTPUT 1 DIGIT
         B        OLDPRIOR
*
         REF      J:ABC
         PAGE
ON       PUSHL
         M:TS2
         AND,R11  =X'FF00'
         SLS,R11  -8
         CI,R11   140
         BLE      %+2
         LI,R11   140
         STW,R11  SHORTSIZE         STORE PLATEN SIZE
         LI,R2    X'20'
         CH,R2    F:LOGD            CHECK FOR F:LOGD OPEN
         BAZ      %+2
         M:CLOSE  F:LOGD,SAVE
         M:OPEN   F:LOGD,(FILE,':LOGD',':SYS'),IN,KEYED,;
                  (ABN,EHX)
ON10     M:READ   F:LOGD,(BUF,WHOSAVE),(SIZE,80),(ABN,ENDON),WAIT
         LI,R1    3
         LB,R1    WHOSAVE,R1
         CI,R1    '*'
         BNE      ON10
         LW,R7    *F:LOGD+10        GET USER NUMBER
         AND,R7   =X'FFFF'
         LI,R8    UB:US
         BALL     LB
         CI,R1    SNULL
         BE       ON10              USER NOT THERE
         LW,R1    R7
         LI,R5    BA(SLASH)
         LI,R9    3
         BALL     SLURPH
         LW,R0    WHOSAVE
         AND,R0   =X'FFFFFF00'
         BALL     SLURPC
         LCI      2
         LM,R0    WHOSAVE+1
         BALL     SLURPC
         LW,R2    R6
         AI,R2    20
         CW,R2    SHORTSIZE
         BLE      ON10
         BALL     SLURPO
         B        ON10
ENDON    M:CLOSE  F:LOGD
         AI,R6    0
         BE       %+2
         BALL     SLURPO
         B        CMDX
SLASH    TXT      '/%%    %'
         PAGE
WATCH    PUSHL
         LI,R7    TIE
         BE       NOCOUPLE
         MTW,0    SPYLINE           ARE WE ALREADY WATCHING SOMEONE
         BNE      EHX
         PRIV     EHX
         BALL     ARGH
         BE       NAILEH
         CI,R1    LNOL
         BGE      NAILEH            ILLEGAL LINE NUMBER
         LW,R2    M:UC+COCLN        GET OUR LINE NUMBER
         AND,R2   =X'FF'
         CW,R1    R2
         BE       NAILEH            CAN'T SPY ON OURSELF
         LB,R3    TIE,R2            CHECK TO SEE IF WE ARE COUPLED
         CW,R3    R2
         BNE      NAILEH            WE ARE ALREADY COUPLED
         LB,R3    TIE,R1
         CW,R3    R1
         BNE      NAILEH            HE IS ALREADY COUPLED
         DISABLE
         LB,R3    MODE4,R1          PICK UP HIS MODE4
         STW,R1   SPYLINE           SAVE HIS LINE
         OR,R3    =1                MAKE SURE IT IS NON-ZERO
         STB,R3   SPYLINE           AND HIS MODE4
         OR,R3    =X'80'            SET ALLOW COUPLES BIT
         STB,R3   MODE4,R1
         STB,R2   TIE,R1            TIE US UP
         STB,R1   TIE,R2
         ENABLE
         B        NAILX
NOCOUPLE LI,R5    BA(NCPLMSG)
         BALL     SLURP
         BALL     SLURPO
         B        CMDX
NCPLMSG  TEXT     'NO COUPLING ON THIS SYSTEM%'
         PAGE
CLEAR    PUSHL
         MTW,0    SPYLINE
         BE       CMDX              WE ARE NOT COUPLED
         PRIV     CMDX
         LW,R2    M:UC+COCLN        GET OUR LINE NUMBER
         AND,R2   =X'FF'
         DISABLE
         LW,R1    SPYLINE
         AND,R1   =X'FFFFFF'        GET LINE WE ARE TIED TO
         LB,R3    SPYLINE           GET OLD MODE4
         LB,R4    MODE4,R1          GET CURRENT MODE4
         AND,R4   =X'7F'            GET RID OF ACPL BIT
         AND,R3   =X'80'            MASK ACPL BIT
         OR,R3    R4                SET NEW MODE4
         STB,R3   MODE4,R1          RESTORE HIS MODE4
         STB,R1   TIE,R1            RESTORE TIE TABLE
         STB,R2   TIE,R2
         ENABLE
         LI,R3    0
         STW,R3   SPYLINE
         B        NAILX
         PAGE
ACPL     PUSHL                      SET ACPL BIT FOR A LINE
         LI,R7    TIE
         BE       NOCOUPLE
         BALL     ARGH
         BE       ACPLME            NO ARG, DO ME
         CI,R1    LNOL
         BGE      EHX               ILLEGAL LINE #
         PRIV     EHX
         DISABLE
         LB,R2    LB:UN,R1          GET USER #
         LB,R2    UB:US,R2          GET USER STATE
         CI,R2    SNULL             IS HE NULL
         BE       ACPLX
         LB,R2    MODE4,R1
         OR,R2    =X'80'
         STB,R2   MODE4,R1          SET ACPL BIT
         ENABLE
         SLAVE
         B        CMDX
ACPLX    ENABLE
         SLAVE
         B        EHX
ACPLME   M:ACPL
         B        CMDX
RCPL     PUSHL                      RESET ALLOW COUPLES BIT
         LI,R7    TIE
         BE       NOCOUPLE
         BALL     ARGH
         BE       RCPLME            NO ARG, DO ME
         CI,R1    LNOL
         BGE      EHX               ILLEGAL LINE #
         PRIV     EHX
         DISABLE
         LB,R2    LB:UN,R1
         LB,R2    UB:US,R2          GET USERS STATE
         CI,R2    SNULL
         BE       ACPLX
         LB,R2    MODE4,R1
         AND,R2   =X'7F'            CLEAR ACPL BIT
         STB,R2   MODE4,R1
         ENABLE
         SLAVE
         B        CMDX
RCPLME   M:RCPL
         B        CMDX
COUPLE   PUSHL                      COUPLE TO LINE
         BALL     ARGH
         BE       EHX
         OR,1     =X'1D000000'      OR IN FPT CODE
         CAL1,8   1                 ISSUE COUPLE CAL
         BCR,12   CMDX
         LI,R5    BA(CPLREJ)
         BALL     SLURP
         BALL     SLURPO
         B        CMDX
CPLREJ   TXT      'COUPLE REFUSED%'
DECOUPLE PUSHL                      ISSUE DECOUPLE CAL
         M:DECOUPLE
         B        CMDX
         PAGE
TIES     PUSHL
         LI,R7    TIE
         BE       NOCOUPLE
         LI,R7    LNOL-1
TIES10   LI,R8    MODE4
         BALL     LB
         CI,R1    X'80'
         BAZ      TIES20
         LI,R8    TIE
         BALL     LB
         CW,R7    R1
         BE       TIES20
         LI,R5    BA(TIEPTR)
         LI,R9    2
         BALL     SLURPH
         LW,R1    R7
         BALL     SLURPH
         BALL     SLURPO
TIES20   BDR,R7   TIES10
         B        CMDX
TIEPTR   TEXT     ' < -- > %%'
         PAGE
CHEAT    PUSHL
         BALL     ARGT              CLEAR ANY ARGUMENTS
         BG       EHX
         LI,R7    0
         LI,R8    SL:OPRIO          ONLINE PRIORITY DEFAULT
         BALL     LW
         STW,R1   WHOSAVE
         LI,R7    SMUIS
CHEAT20  LI,R8    UB:PRIOB
         BALL     LB
         CW,R1    WHOSAVE
         BE       CHEAT30
         BALL     CHKUSR
         BCS,6    CHEAT30           DONT PRINT GHOSTS
         LW,R1    R7
         PUSH     3,R7
         BALL     USERXX
         PULL     3,R7
CHEAT30  BDR,R7   CHEAT20
         B        CMDX
*
* CHKUSR SETS CC1 AND CC2 AS IF AN LC J:JIT HAD BEEN DONE FOR THE
* USER # IN R7.  CC3 IS SET IF USERS STATE IS SNULL.
*
CHKUSR   PUSHL
         PUSH     9,R0              GET SOME REGS TO WORK WITH
         LI,R8    UB:US
         BALL     LB
         CI,R1    SNULL
         BE       NULLUSR
         LW,R6    R7
         LI,R7    MAXG
         LI,R8    SB:GJOBUN
CHKUSR10 BALL     LB
         CW,R6    R1
         BE       CHKGHST
         BDR,R7   CHKUSR10
         LI,R7    LPART
         LI,R8    PLB:USR
CHKUSR20 BALL     LB
         CW,R6    R1
         BE       CHKBTCH
         BDR,R7   CHKUSR20
         PULL     9,R0
         PULLL
         LCI      8                 ASSUME ONLINE
         BYE
CHKGHST  PULL     9,R0
         PULLL
         LCI      4
         BYE
CHKBTCH  PULL     9,R0
         PULLL
         LCI      0
         BYE
NULLUSR  PULL     9,R0
         PULLL
         LCI      2
         BYE
         PAGE
PROCUSE  PUSHL                      LIST USERS ASSOCIATED WITH PROCESSOR
         LW,R1    CMDARG            SAVE THIS FOR A WHILE
         STW,R1   TRASH
         BALL     ARGC              GET PROCESSOR NAME
         BEZ      EHX               OOPS/ NO ARG
         LI,R7    PNAMEND           # SHARED PROCESSOR ENTRIES
         LD,R4    R0                PROCESSOR WE ARE LOOKING FOR
         LI,R8    P:NAME
FPROC    BALL     LD                SEARCH PNAME TABLE FOR PROCESSOR
         CD,R4    R0
         BE       PROC10
         BDR,R7   FPROC
         LW,R1    TRASH             PROCESSOR NAME NOT FOUND
         STW,R1   CMDARG            RESCAN ARGUMENT
         BALL     ARGH              ASSUME A HEX PROCESSOR #
         BEZ      EHX
         LW,R7    R1
PROC10   EQU      %                 WE NOW HAVE PROCESSOR # IN R7
         STW,R7   TRASH             A CONVINIENT PLACE TO SAVE IT
         LI,R7    SMUIS
PROC20   EQU      %                 SEARCH USER TABLES FOR PROCESSOR #
         LI,R8    UB:APR
         BALL     LB
         CW,R1    TRASH
         BE       PROC30
         LI,R8    UB:ACP            ASSOCIATED COMMAND PROCESSOR
         BALL     LB
         CW,R1    TRASH
         BE       PROC30
         LI,R8    UB:ASP            ASSOCIATED SPECIAL PROCESSOR
         BALL     LB
         CW,R1    TRASH
         BE       PROC30
         LI,R8    UB:DB             ASSOCIATED DEBUGGER
         BALL     LB
         CW,R1    TRASH
         BE       PROC30
         BDR,R7   PROC20            DO NEXT USER #
ENDPROC  AI,R6    0                 CHECK FOR CHARS IN BUFFER
         BE       CMDX              NONE
         BALL     SLURPO            DUMP BUFFER
         B        CMDX               BYE
PROC30   EQU      %                 DUMP A USER NUMBER
         LW,R1    R7                GET USER # FOR SLURPH
         LI,R5    BA(PROCFMT)
         LI,R9    2                 2 DIGITS
         BALL     SLURPH
         BDR,R7   PROC20            LOOK AT NEXT USER
         B        ENDPROC           NO MORE USERS
PROCFMT  TXT      '   %'
         PAGE
SCPU     PUSHL
         LI,R7    0
         CI,R7    NSCPU
         BE       NOSLAVE
SCPU10   AI,R7    1
         CI,R7    NSCPU
         BG       CMDX
         LI,R5    BA(SCPUFMT)
         BALL     SLURP
         LW,R1    R7
         LI,R9    1
         BALL     SLURPH
         LI,R8    SB:STATE
         BALL     LB
         LD,R0    T:SCPU,R1
         BALL     SLURPC
         LI,R8    S:PCUN
         BALL     LW
         LI,R9    0
         BALL     SLURPH
         BALL     SLURPO
         B        SCPU10
NOSLAVE  LI,R5    BA(T:NOSLV)
         BALL     SLURP
         BALL     SLURPO
         B        CMDX
T:NOSLV  TXT      'THIS IS NOT A MULTI-PROCESSOR SYSTEM%'
SCPUFMT  TXT      'CPU % - %  CUN = %%%'
         BOUND    8
T:SCPU   TXT      'STOPPED'
         TXT      'IDLE '
         TXT      'ACTIVE'
         PAGE
*        THE CORE COMMAND DIRECTS THE PROGRAM TO USE THE RUNNING
*        MONITOR FOR INPUT. THIS IS THE DEFAULT MODE.
*
CORE     PUSHL
         MTW,0    USNFILE           WERE WE USING A FILE?
         BGE      CMDX              NOPE. BYE......
         BALL     FREEM             IF SO, FREE ALL PAGES
         LI,1     1
         STW,1    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,1,31,32 1,0,2          WITH SAVE.
         SPACE     2
CORE1    PUSHL
         LI,5      BA(CORETOT)
         LI,9      3         4DIGIT NUMBERS..
         LD,6      16BALLS       ZERO OUT R6 AND R7..
         BALL      SLURP     INITILIZE OUTPUT..
         LI,7      1     2ND HALF WORD IN SH:RBSUM
         LI,8      SH:RBSUM     TOTAL BATCH CORE (BTCO)..
         BALL      LH
         BALL      SLURPN
         LI,7      1         2ND HALF WORD IN SH:RBCU
         LI,8      SH:RBCU   CURRENT BATCH CORE (BCCO).
         BALL      LH
         BALL      SLURPN
         BALL      SLURPO
         LI,5     BA(SYSCORE)       PICK UP SL:CORE AND S:PCORE
         LI,9     3
         LD,6     16BALLS
         BALL     SLURP
         LI,7     0
         LI,8     SL:CORE
         REF      SL:CORE
         BALL     LW                GET SL:CORE
         SLS,1    -1                GET IT IN K
         BALL     SLURPN
         LI,7     0
         LI,8     S:PCORE
         REF      S:PCORE
         BALL     LW                GET S:PCORE
         SLS,1    -1                GET IT IN K
         BALL     SLURPN
         BALL     SLURPO
         B         CMDX
         PAGE
*        THE PACKS COMMAND DISPLAYS STATUS OF PRIVATE DISC PACK DRIVES
*
*
PACKS    EQU      %
         PUSHL
         LI,7     AVRTBLSIZ
PACK1    LI,8     AVRTBL
         BALL     LD
         AI,0     0                 CHECK IF SN PRESENT
         BNEZ     PACK4             YES, PRINT IT OUT
         AI,1     0
         BGEZ     PACK3             NOT SYSTEMS, GIVE STATUS
PACK2    EQU      %
         AI,7     1
         CI,7     AVRTBLNE
         BL       PACK1             NOT DONE YET
         B        CMDX              RETURN
*
*        PACK IS NOT IN USE, SEE IF AVAILABLE
*
PACK3    EQU      %
         LW,3     7                 SAVE AVRINDEX
         AI,7     BATAPE            GET DCTINDEX
         LI,8     DCT16             GET NAEM OF PACK
         BALL     LD
         LI,5     BA(PACKM2)        PACK IS AVAILABLE
*        GET DCT3 AND SEE IF PARTITIONED
         BALL     SLURP
         SLD,0    16
         MTB,5    0                 SET BYTE COUNT
         BALL     SLURPT            ENDTER TEXTC NAME
         BALL     SLURPO            FINISH UP LINE
         LW,7     3                 RESTORE AVRINDEX
         B        PACK2
*
*        PACK IS MOUNTED, GET USAGE STATUS
*
PACK4    EQU      %
         LD,2     0                 SAVE AVR INFO
         LI,5     BA(PACKM1)
         BALL     SLURP
         SLD,0    -8
         MTB,4    0                 SET BYTE COUNT
         BALL     SLURPT            MOVE SN
         LI,0     'P'               ASSUME PUBLIC
         AI,3     0
         BLZ      PACK5             YES
         LI,8     AVRID             GET ID TO SEE
         BALL     LH                IF USAGE IS EXCLUSIVE
         LI,0     'X'
         AI,1     0
         BNEZ     %+2               YES
         LI,0     'S'
PACK5    EQU      %
         SLS,0    16
         MTB,1    0
         BALL     SLURPT            ADD USAGE
         LI,8     AVRNOU
         BALL     LH                GET AVRNOU
         LI,9     3
         BALL     SLURPN
         BALL     SLURPO
         B        PACK2
         PAGE
*        THE LUS COMMAND DISPLAYS COC LINE USAGE BY LINE TYPE
*        GIVING THE NUMBER OF LINES UNUSED, IN USE, AND TOTAL
*
LINEUSE  EQU      %
         PUSHL
         LI,5     BA(LUS1)
         BALL     SLURP
         BALL     SLURPO
         LI,1     #TYPES
         LI,0     0
         STW,0    NLINES-1,1
         STW,0    NINUSE-1,1
         BDR,1    %-2
         LI,7     0                 LOAD COC INDEX
LINEUSE1 EQU      %
         LI,8     MODE2
         BALL     LB                GET MODE2
         LI,2     #2741             LOAD 2741 TYPE
         CI,1     X'10'
         BANZ     LINEUSE2          2741
         LI,8     MODE4INIT
         BALL     LB                GET MODE4INIT
         AND,1    =7
         LW,2     1                 GET RATE INDEX
LINEUSE2 EQU      %
         MTW,1    NLINES,2          COUNT UP NUMBER OF LINES
         LI,8     LB:UN
         BALL     LB                GET USER NUMBER
         BEZ      %+3               NO USER
         MTW,1    NINUSE,2          COUNT UP LINES IN USE
         MTW,1    NINUSE+#TOTAL     AND TOTAL IN USE
         AI,7     1
         CI,7     LNOL
         BL       LINEUSE1
         STW,7    NLINES+#TOTAL
         LI,2     0
LINEUSE3 EQU      %
         MTW,0    NLINES,2          ANY LINES OF THIS TYPE
         BEZ      LINEUSE4          NOPE
         LI,5     BA(LUS2)
         BALL     SLURP
         LD,0     LUSRATE,2         GET LINE TYPE
         BALL     SLURPT
         LW,1     NLINES,2
         SW,1     NINUSE,2          GET UNUSED LINES
         LI,9     7
         BALL     SLURPN
         LW,1     NINUSE,2
         LI,9     7
         BALL     SLURPN
         LW,1     NLINES,2
         LI,9     7
         BALL     SLURPN
         BALL     SLURPO
LINEUSE4 EQU      %
         AI,2     1
         CI,2     #TOTAL
         BLE      LINEUSE3
         B        CMDX
         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      PUSHL
         BALL     ARGN              GO GET AN ARGUMENT
         BE       EHX
         CI,1     8                 BETTER BE LESS THAN 8
         BG       EHX               OR ITS OUT OF RANGE.
         BL       USE1              LAST NOT SPECIFIED.
         LI,7     0                 WE WANT THE LAST FILE,
         LI,8     RCVRCNT           SO LETS LOOK IN RECOVER COUNT
         BALL     LW
         AND,1    LMSK              AND IT DOWN QUITE A BIT
         LI,5     BA(USENFN)
         BALL     SLURP
         LI,9     1
         BALL     SLURPN            TELL THEM WHICH MONDMP IN USE.
         BALL     SLURPO
USE1     AI,1     '0'               MAKE THAT A CHARACTER
         LI,2     3
         STB,1    UFNAME+1,2        AND POKE INTO THE OPEN FPT
         LW,1     =X'00200000'      IS A FILE OPEN ON M:EI NOW??
         AND,1    M:EI
         BE       %+2
         CAL1,1   CLOSEEI           NOT NOW.......
         CAL1,1   OPNDMP            TRY TO OPEN THE FILE
         BALL     FREEM             GOT IT! CLEAN OUT WINDOW
         LI,2     10
         STW,2    CPANES            SET UP CPANES
         LI,1     -1
         STW,1    USNFILE           AND THE FLAG WORD
         CAL1,8   MGVP-1,2          GET A PAGE FOR BUFFER
         BCS,8    LTHINGQ           OOPS....DIDNT GET IT
         BDR,2    %-2               AND FILL UP THE WINDOW AREA
         CAL1,1   SETERRS           SET ERROR AND ABN TO USEOOPS
         BALL     VERIFY            GO SEE IF THIS FILE MAKES SENSE.
         B        CMDX              BYE......
USENF    LI,1     USENFM
         LI,2     20                ERR/ABN ON OPEN. GRIPE
         CAL1,1   WRITEIT
         BALL     CORE
         B        CMDX
*
*        ERROR/ABNORMAL HANDLER FOR MONDMP FILE READS.
*
USEOOPS  EQU      %
         LI,5     BA(USENFO)
         LI,6     0                 SQUASH ANYTHING IN BUFFER NOW.
         BALL     SLURP
         LW,1     MCVM              PRINT OUT OFFENDING KEY
         LI,9     0
         BALL     SLURPH
         LW,1     10                AND ERROR CODE/SUBCODE
         BALL     SLURPH
         BALL     SLURPO
         BALL     FREEM             THE MAP IS SCREWED UP NOW.
         BALL     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
UTSG     EQU      %
         PUSHL
         REF      COCMESS
         LI,R8    COCMESS
         LI,R7    0
         BALL     LB
         LW,R6    R1
         LW,R7    R1
         BALL     LB
         AI,R7    -1
         STB,R1   OBUF,R7
         AI,R7    0
         BG       %-4
         BALL     SLURPO
         B        CMDX
         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  PUSHL
         BALL     ARGN              GET US A NUMBER
         BE       EHX
         MTW,0    USNFILE           ARE WE USING MONDMP FILE?
         BGE      %+2               NOPE.
         LW,1     CPANES            IF WE ARE, YOU CANT CHANGE THINGS.
         CI,1     1
         BL       EHX               GOT TO BE AT LEAST ONE
         CI,1     MAXPANES
         BG       EHX               AND NOT GREATER THAN MAXPANES.
         LW,11    REPL              LOAD FOR USE COUNT LATER.
         BG       %+2               IF VALUE IS ZERO, REAL VALUE
         LW,11    CPANES            IS CPANES VALUE.
         CW,1     CPANES            HOW DO THAT LOOK?
         BE       PANESE            EQUAL- JOKE. EASY TO DO....
         BL       PANESL            SMALLER- SOME WORK TO DO.
PANESG   XW,1     CPANES            NEW VALUE GREATER. SWAP 'EM.
PANESE   LI,5     BA(PANESM1)
         BALL     SLURP
         LI,9     0
         BALL     SLURPN            PRINT OLD VALUE
         LW,1     CPANES
         BALL     SLURPN            AND NEW VALUE
         LW,1     11                HOW MANY WERE IN USE?
         BALL     SLURPN
         BALL     SLURPO            PRINT THE LINE
         B        PCNT+1            SPLIT THRU PAGE GRAB COUNT LOGIC.
PANESL   BALL     FREEM             EASY WAY OUT- GET RID OF 'EM ALL..
         LI,2     0
         STW,2    REPL              RESET NEXT PAGE TO BE REPLACED.
         B        PANESG
         TITLE    'ENCHILADA-LOAD THING......'
*        LOAD THING LOADS INTO THE 0,1 PAIR THE CONTENTS OF THE
*        THING IN PHYSICAL MEMORY DETERMINED AS LTHING,0(1) *8,7.
*        IF FLAG USNFILE IS ZERO, THE M:CVM CAL IS USED TO
*        WINDOW ONTO THE PAGE DESIRED. 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,1)
*
LB       BAL,1    LTHING            WE USE 1 TO TELL WHAT KIND
LH       BAL,1    LTHING            OF REFERENCE THIS IS
LW       BAL,1    LTHING            BYTE, HALFWORD, WORD
LD       BAL,1    LTHING            OR DOUBLEWORD.
LTHING   AI,1     -LH               NEET EASILY UNDERSTOOD CODE...
         MTW,0    NOPE              DO WE DO IT????
         BL       VERIFX            NOPE.......BYE.......
         PUSH     14,2
         ANLZ,4   INST,1            RIDDLE ME THIS.....
         B        %+1,1             RESOLVE TO WORD ADDRESS
         SLS,4    -1                BYTE TO HALFWORD
         SLS,4    -1                HALFWORD TO WORD
         B        %+2               A WORD IS A WORD.
         SLS,4    1                 DOUBLEWORD TO WORD.
         LW,5     4                 THIS IS EWA.
         SLS,5    -9                MAKE IT A PAGE NUMBER
         MTW,0    USNFILE           IF WE ARE READIN FROM FILE,
         BL       %+3               EVEN PAGE ZERO NEEDS TO BE READ.
         CI,5     0                 IS THIS PAGE ZERO???
         BE       LTHINGZ           IF YES, SPECIAL CASE.
         AND,7    LMSK,1            MASK DOWN INDEX VALUE
         LW,6     CPANES            HOW MANY PANES IN WINDOW NOW?
         CW,5     WINDOW-1,6        LOOK FOR THAT PAGE IN THE MAP
         BE       LTHING1           FOUND IT.
         BDR,6    %-2               KEEP LOOKING.
         B        LTHINGP           BLAH. CAN'T FIND IT.
LTHING1  AND,4    =X'1FF'           MASK DOWN TO DISPLACEMENT
         AW,4     MFVP-1,6          ADD IN PROPER WINDOW PAGE ADDR
         LW,2     0,4               FIRST WORD
         OR,4     LMSK+1            OR WITH 1
         LW,3     0,4
         EXU      INST1,1           GET WHAT WE NEED FROM THAT.
LTHINGX  PULL     14,2
         CI,1     0                 SET CC'S FOR RETURN CHECKS.
         B        *L                BYE......
LTHINGZ  EXU      INST,1            FOR PAGE ZERO, JUST DO IT.
         B        LTHINGX
LTHINGP  MTW,1    PCOUNT            WE'RE GRABBING ANOTHER PAGE..
         LW,6     REPL              THIS IS THE SLOT TO USE.
         STW,5    WINDOW,6          AND THIS IS THE PAGE IT REPRESENTS
         SLS,5    9
         STW,5    MCVM              POKE WORD ADDR INTO FPT
         LW,2     MFVP,6            GET OUR PAGE ADDRESS
         STW,2    MCVM+1
         LW,2     REPL              UPDATE NEXT PAGE TO REPLACE POINTER
         AI,2     1
         CW,2     CPANES
         BLE      %+2
         LI,2     0
         STW,2    REPL
         MTW,0    USNFILE           ARE WE READING FROM A FILE????
         BL       LTHINGF           YUP.
         CAL1,8   MFVP,6            IF NOT, FREE THE PAGE IN USE
         LI,2     7
         STB,2    MCVM              MAKE THAT THING PROPER FPT
         AI,6     1                 FOR LTHING CODE INDEXING.....
         CAL1,8   MCVM              GET THE PAGE
         BCR,8    LTHING1           GOT IT.
LTHINGQ  LI,1     LTHINGM           OOPS....CANT GET THE PAGE.
         LI,2     27
         CAL1,1   WRITEIT           SCREAM
         CAL1,9   3                 AND ABORT.
LTHINGF  LW,2     MCVM
         SLS,2    -9                MAKE IT PAGE NUMBER AGAIN
         OR,2     =X'03000000'      AND MAKE IT A KEY.
         STW,2    MCVM
         CAL1,1   RDPAGE            READ IN A PAGE
         AI,6     1                 WE GOT IT. CONGRATULATIONS.
         B        LTHING1
INST     LB,1     *8,7              INSTRUCTIONS FOR THE ANALYZE
         LH,1     *8,7
         LW,1     *8,7              I THINK I DETECT A PATTERN...
         LD,0     *8,7
INST1    LB,1     2,7               INSTRUCTIONS FOR LOADING THE
         LH,1     2,7               WANTED WHATEVER FROM THE
         LW,1     2                 EFFECTIVE WORD IN 2
         LD,0     2
LMSK     DATA     3,1,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.
*
FREEM    LI,2     MAXPANES
         LI,3     -1                WE'LL ZORP THE MAP TOO......
         STW,3    WINDOW-1,2        SO AS NOT TO CONFUSE ANYBODY.
         CAL1,8   MFVP-1,2          ISSUE FREE PAGE CAL
         BDR,2    %-2               ON ALL OF THEM
         BYE                        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,1 PAIR
*        SLURPT   OUTPUT TEXTC IN 0,1 PAIR
*        SLURPO   WRITE OUT THE OUTPUT BUFFER
*
*        REGISTERS L,5,6,14 ARE CLOBBERED.
*
SLURP    LB,14    0,5               GET A CHARACTER
         BE       *L                0 MEANS WE'RE DONE.
         AI,5     1                 BUMP.
         CI,14    '%'               MARKER HIT.....
         BE       *L                YUP. LEAVE.
         STB,14   OBUF,6            POKE AWAY
         AI,6     1
         CI,6     140               BUFFER FULL???
         BNE      SLURP             NO, KEEP GOING
         PUSH     L                 SAVE THE LINK AND THEN
         BALL     SLURPO            GO EMPTY THE BUFFER
         B        CMDX              BYE......
*
*        WRITE OUT THE BUFFER- EITHER ON COMMAND, OR WHEN IT GETS FULL
*
SLURPO   PUSH     2,1
         LI,1     OBUF
         LW,2     6                 CHR COUNT=BUFFER POINTER.
         BE       %+3               NO BUFEE, NO WRITEE.......
         LI,6     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,2     1
         LI,1     PROMPTM           AND A CR FOR YOU ONLINE FOLKS..
         CAL1,1   WRITEIT
         LW,1     =140**24+BA(OBUF)
         MBS,0    BLANKS            BLANK OUTPUT BUFFER
         PULL     2,1
         B        *L                BYE Y'ALL..........
*
*        SLURPT USES SLURPC TO SHOVEL IN A TEXTC IN 0,1.
*
SLURPT   PUSH     4,0
         LI,2     1                 START WITH BYTE ONE
         LB,3     0                 THIS IS THE COUNT.
         B        SLURPC1           THAT'S ALL THERE IS TO IT.
*
*        SLURPC SHOVELS 8 CHARACTERS FROM (0,1) TO THE BUFFER.
*
SLURPC   PUSH     4,0
         LI,2     0                 LOAD PTR
         LI,3     8                 COUNTER
SLURPC1  LB,14    0,2
         BE       %+5               WHAT NULL.. I DIDN'T SEE A NULL...
         STB,14   OBUF,6
         AI,6     1
         AI,2     1
         BDR,3    %-5
         PULL     4,0
         B        SLURP             AND SPLIT.
*
*        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,14    10
         STW,14   RADIX
         B        SLURPS
SLURPH   LI,14    16
         STW,14   RADIX
SLURPS   PUSH     6,0
         PUSH     9
         LI,2     ' '
         STB,2    OBUF,6            POKE THE FIELD FULL OF BLANKS
         AI,6     1
         BDR,9    %-2
         PULL     9
         PUSH     6
         PUSH     9
         AI,6     -1                THE FIRST ONE GOES HERE.
         LI,5     0                 CHARACTER COUNTER
         LAW,3    1                 ONLY POSITIVE NUMBERS......
SLURPS1  LI,2     0                 REMAINDER GOES HERE.
         DW,2     RADIX             GIMMIE A DIGIT
         LB,2     HEX,2             A CHARACTER.
         STB,2    ARG,5             POKE AWAY FOR LATER
         AI,5     1
         CI,3     0                 DONE YET???
         BG       SLURPS1           NOPE. KEEP GOING.
         LI,4     0                 COPY POINTER.
SLURPS2  CI,9     0                 NO DIGITS WANTED?
         BE       SLURPS5           IF 0, SPECIAL CASE.
         LB,14    ARG,4
         STB,14   OBUF,6            POKE AWAY
         AI,4     1
         CW,4     5                 LAST DIGIT IN NUMBER?
         BE       SLURPS3           YUP. ALL DONE
         AI,6     -1
         BDR,9    %-6
SLURPS3  PULL     9
         PULL     6
         PULL     6,0
         B        SLURP             GO SLURP TO FINISH UP.
SLURPS4  CI,9     0                 NO DIGITS WANTED?
         BE       %+3               YUP. SHOVEL IN 'NO'
         CI,9     2                 IF ONLY ONE OR TWO DIGITS,
         BLE      SLURPS1           WE'LL PLUG IN ZEROS.
         LI,2     'O'
         STB,2    ARG,5
         AI,5     1
         LI,2     'N'
         STB,2    ARG,5
         AI,5     1
         B        SLURPS2-1         AND FILL INTO BUFFER
SLURPS5  PULL     9
         PULL     6
         AI,6     -1                BACK IT UP
         LW,2     5
         AI,5     -1
         LB,14    ARG,5             GET LEADING DIGIT
         STB,14   OBUF,6            PUT AWAY.
         AI,6     1
         BDR,2    %-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   PUSHL
         LI,8     WAIT
         LI,7     0
         STW,7    NOPE              TO LET LTHING WORK.
         BALL     LW                CHECK THIS HOLE.
         CW,1     WAITX             IS IT RIGHT???
         BE       CMDX              OK, GO AHEAD.
         AI,8     1                 SO MAYBE THIS IS C00-CPV
         BALL     LW                AND THE WAIT IS ONE AFTER THAT.
         CW,1     WAITX
         BE       CMDX              THAT'S BETTER......
VERIFX   LI,1     VERIFNGM
         LI,2     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,1     3
         LH,1     *J:TCB,1          GET SPACE COUNT
         AND,1    =X'7FFF'          MASK IT DOWN
         LCW,1    1
         MSP,1    *J:TCB            THAT JUST MIGHT WORK.
         B        STARTIT           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,1,7,24 1,X'11',ODCB    OUTPUT THRU DCB ADDR IN ODCB
         DATA     X'34000000'       BUF,LENGTH,AND BTD OF 0.
         GEN,1,31,1,31 1,1,1,2
         DATA     0                 BTD TO USE.
         PAGE
*
*        THE ENTRIES OOPST AND OOPSB HANDLE TRAP AND BREAK CONTROL.
*        OOPST, ENTERED FROM A TRAP, COMPLAINS AND EXITS.
*        OOPSB, FOR BREAK KEY INTERRUPT, RESTARTS AT STARTIT.
*
OOPSB    LI,2     RESTART           HERES WHERE WE WANT TO GO.
         LI,3     1
         STH,2    *1,3              STUFF INTO THE STACK
         CAL1,8   =X'06100000'      RESET BREAK COUNT
         CAL1,9   5                 M:TRTN.
OOPST    LI,6     0
         LI,5     BA(OOPSM1)
         BALL     SLURP
         LW,1     *1                SAVE TRAP ADDRESS
         AND,1    =X'1FFFF'         ADDRESS MASK
         LI,9     0
         LW,2     1                 SAVE THAT, BECAUSE WE WANT TO PRINT
         AI,1     -START            THE DISPLACEMENT ADDRESS.
         BAL,L    SLURPH            DUMP THE ADDRESS OUT
         LW,1     *2
         BALL     SLURPH            AND THE OFFENDING INSTRUCTION
         BALL     SLURPO
         CAL1,8   BYEDELTA
         CAL1,9   3                 ABORT.
OOPSM1   TXT      '....OOPS!...START+%/%.%.%'
         PAGE
         PAGE
         USECT    DATA
*
*        FIXED DATA AREA
*
WHUTECB  DATA     0                 ECB WORD FOR M:KEYIN
*
CMDBUF   DATA     0                 INPUT FROM M:KEYIN
         RES      20
CMDBUF1  TEXTC    'ALL'
         RES      20
CMDBUF2  TEXTC    'ALL'
         RES      20
CMDARG   DATA     0                 LENGTH, PTR TO ARGUMENT
CMD      RES      20                INDIVIDUAL COMMAND FOR PARSING
         BOUND    8
MC1      DATA     BA(CMDBUF)
         GEN,8,24 81,BA(CMDBUF1)
MC2      DATA     BA(CMDBUF1)
         GEN,8,24 81,BA(CMDBUF2)
MC3      DATA     BA(CMDBUF2)
         GEN,8,24 81,BA(CMDBUF)
MC4      DATA     BA(CMDBUF2)
         GEN,8,24 81,BA(CMDBUF1)
MC5      DATA     BA(CMDBUF1)+1
         GEN,8,24 80,BA(CMDBUF)+1
         PAGE
*        CONSTANTS IN PROCEDURE AREA
*
         USECT    CODE
BLANKS   TXT      '    '
MEH      TXTC     ' EH?'
MAMBIG   TXTC     ' WHAT?'
MDIG     TXTC     'ILLEGAL DIGIT'
MTL      TXTC     'STRING TOO LONG'
MCR      DATA     X'010D0000'       A CR FOR MISC USEAGE.
*
TYPEIT   GEN,8,24 2,0               M:TYPE TO OPERATOR
         PZE      *0
         PZE      *1                ADDR OF MSG IS IN R1.
         BOUND    8
LUSRATE  EQU      %
         TXTC     '  110'
         TXTC     '  150'
         TXTC     '  300'
         TXTC     '  600'
         TXTC     ' 1200'
         TXTC     ' 2400'
         TXTC     ' 4800'
         TXTC     ' 9600'
         TXTC     ' 2741'
         TXTC     'TOTAL'
         PAGE
*
*        HUH IS THE ENTRY POINT FOR INPUTTING FROM THE USER.
*
HUH      EQU      %
         M:PC     '-'
         LD,R2    MC5
         MBS,R2   0                 MOVE LAST CMD BACK TO BUFFER
         M:READ   M:SI,(BUF,CMDBUF),(SIZE,80),(BTD,1),(ABN,SIABN)
         LW,R2    M:SI+4            GET ARS
         SLS,R2   -17
         LB,R3    CMDBUF,R2         CHECK LAST CHARACTER
         CI,R3    X'40'
         BGE      %+2               LOOKS LEGAL
         AI,2     -1                BUMP OFF CRUD CHARACTERS
         STB,2    CMDBUF            AND POKE LENGTH BACK
         LI,1     CMDBUF
         LB,2     CMDBUF
         BE       HUH               NULL INPUT LINE....
         LD,R2    MC2
         MBS,R2   0
         LD,R2    MC1
         MBS,R2   0
         B        %+2               HOP OVER PUSH.
         PAGE
*        WE THINK THERE IS A COMMAND IN THE BUFFER NOW.
*
WHUT     PUSHL
         LB,5     CMDBUF            HOW MUCH IN BUFFER??
         BE       HUH               NOT ENOUGH- GO READ MORE.
*
*        SKIP OVER LEADING BLANKS AND THEN MOVE THE COMMAND INTO
*        CMD, STOPPING IF A ';' IS HIT, OR RUN OUT OF STRING.
*        REMOVE ANY TRAILING BLANKS FROM COMMAND, AND SHUFFLE DOWN
*        REMAINING BYTES OF CMDBUF, READJUSTING THE COUNT.
*
         LI,7     1                 LOAD PTR FROM CMDBUF
         LI,6     1                 STORE PTR INTO CMD
         LB,1     CMDBUF,7
         CI,1     ' '
         BNE      WHUT1+1           FOUND A NON-BLANK.
         AI,7     1
         BDR,5    %-4               LOOK FOR NON-BLANKS.
         B        HUH               A LINE FULL OF BLANKS. CUTE....
*
*        MOVE STUFF UNTIL DELIMITER OR END HIT.
*
WHUT1    LB,1     CMDBUF,7
         CI,1     ';'               DELIMITER
         BE       WHUT2-1           B/YUP.
         STB,1    CMD,6             ELSE POKE THE BYTE AWAY
         AI,6     1
         AI,7     1                 BUMP POINTERS
         BDR,5    WHUT1             KEEP COPYING
         AI,7     -1                RE-BUMP POINTERS TO MAKE SANE
         AI,6     -1
WHUT2    LB,1     CMD,6             EXAMINE LAST CHR IN CMD
         CI,1     ' '
         BNE      %+2               B/NONBLANK
         BDR,6    WHUT2             KEEP LOOKING
         STB,6    CMD               LENGTH WITHOUT TRAILING BLNKS.
         CI,5     0                 WAS THERE ANYTHING LEFT?
         BE       WHUT3             B/NOPE
         LI,3     BA(CMDBUF)+1
         LI,2     BA(CMDBUF)+1
         AW,2     7
         AI,5     -1
         STB,5    3
         MBS,2    0                 SHUFFLE DOWN REMAINING STRING
WHUT3    STB,5    CMDBUF            SAVE REMAINING BYTE COUNT
         CI,6     0                 COMMAND LENGTH NON-ZERO??
         BE       WHUT+1            NOPE. LOOK SOME MORE.
*
*        ASSEMBLE UP TO 7 CHARACTERS OF COMMAND NAME AS A BLANK FILLED
*        TEXTC IN R8 AND R9 FOR COMPARISON.
*
         LB,6     CMD               LENGTH OF CMD
         LW,8     BLANKS
         LW,9     BLANKS            PRESET
         LI,7     1                 LOAD/STORE/COUNT REGISTER
WHUT4    LB,1     CMD,7
         CI,1     ' '               STOP ON BLANKS
         BE       WHUT5
         CI,1     '='               OR EQUAL SIGN
         BE       WHUT5
         STB,1    8,7
         AI,7     1
         CI,7     8
         BG       WTF               A FUNNY.....LOOOOOOONNNNNGGGGG CMD.
         BDR,6    WHUT4
WHUT5    AI,7     -1
         STB,7    8                 POKE BACK COUNT TO MAKE TEXTC
         CI,6     0                 ANYTHING LEFT
         BE       WHUT7             NOPE.
         AI,7     1                 POINT AT THE DELIMITER AGAIN
WHUT6    LB,1     CMD,7
         CI,1     ' '               SKIP OVER BLANKS AND =
         BE       %+3
         CI,1     '='
         BNE      WHUT8             ARG START FOUND
         AI,7     1
         BDR,6    WHUT6
WHUT7    LI,6     0
         STW,6    CMDARG            NO ARG.
         B        %+3
WHUT8    STW,7    CMDARG            FIRST ARG BYTE HERE
         STB,6    CMDARG            AND ARG LENGTH
         PAGE
*        WE NOW SCAN THE TABLE CMDTXT FOR THE STRING IN 8-9. IF WE
*        FIND IT, GREAT. IF NOT, WE SEARCH THE ENTIRE COMMAND TEXT
*        TABLE TO TRY AND MATCH ON JUST THOSE CHARACTERS IN 8-9. IF
*        ONLY ONE MATCH IS FOUND, IT MUST BE THE COMMAND, AND WE DO IT.
*
WHUTS    LI,7     CMDTL             LENGTH OF THE TABLE
         CD,8     CMDTXT,7
         BE       WHUTHIT           A HIT! HOORAH.....
         BDR,7    WHUTS+1
         LI,4     BA(CMDTXT)+1       GET SNEEKY. START LOOKIN HERE
         LI,5     33                =BA(R8)+1 TO IGNORE COUNT BYTES.
         LB,6     8                 THE LENGTH
         STB,6    5                 FOR THE CBS
         LI,6     0                 MATCH FLAG AND MATCH INDEX
         LI,7     0                 AND SEARCH INDEX
WHUTS1   AI,4     8                 LOOK AT NEXT DWORD ENTRY
         AI,7     1
         CI,7     CMDTL             RUN OUT OF LIST YET?
         BG       WHUTS2            YUP. SEE IF WE FOUND SOMETHING.
         LD,2     4
         CBS,2    0                 DONT CLOBBER THE SET UP REGS.
         BNE      WHUTS1            NOT THIS ONE. LOOK MORE.
         CI,6     0
         BG       WHUTSA            OOPS. SECOND MATCH HIT IN TABLE.
         LW,6     7                 SAVE MATCH INDEX IF FIRST...
         B        WHUTS1            AND LOOK SOME MORE.
WHUTSA   LI,5     MAMBIG            AMBIGUOUS COMMAND.
         B        OYEAH
WHUTS2   CI,6     0
         BE       WTF               NO GOOD STUFF FOUND. GRIPE
         LW,7     6                 OF ONE, GET INDEX BACK.
WHUTHIT  LW,7     CMDTV,7           PICK UP ROUTINE ADDRESS
         BE       WTF               IF UNDEFINED......
         B        CMDX              PULL LINK AND RETURN.
         PAGE
*        WTF- WTF DOES THIS MEAN????
*
WTF      LI,5     MEH               GROUSE MSG
*
*        OYEAH IS THE GENERAL GROUSE. THE GROUSE MSG PTR
*                 IS IN 5. IT GROUSES, LOGGS THINGS, AND THAT GOOD STUFF.
*
OYEAH    LI,1     CMD
         CAL1,2   TYPEIT            TYPE THE CRUD
         BAL,15   MAYBECR
         LW,1     5
         CAL1,2   TYPEIT            TAKE THAT!!
         BAL,15   MAYBECR
         B        RESTART
*
*        MAYBECR SPITS OUT A CR IF WE ARE RUNNING ONLINE.
*
MAYBECR  MTW,0    J:JIT
         BG       *15
         LI,1     MCR
         CAL1,2   TYPEIT
         B        *15
*
SIABN    EQU      %
         LB,R2    R10               GET ABN CODE
         CI,R2    7                 IS IT LOST DATA
         BE       *R8               YEP, WE DON'T CARE
         STW,R8   TRASH
         LI,R2    X'20'             CHECK FOR M:SI OPEN
         CH,R2    M:SI
         BAZ      %+2
         M:CLOSE  M:SI,SAVE
         M:OPEN   M:SI,(DEVICE,'ME'),IN REOPEN INPUT TO TERM
         MTW,-1   TRASH             GO RE-EXECUTE CAL
         B        *TRASH
*
XEQ      PUSHL                      PROCESS XEQ COMMAND
         BALL     ARGC              GET FILENAME
         BEZ      EHX               NO FILENAME
         LCI      2
         STM,R0   XEQFILE           PUT FILENAME IN FPT
         BALL     ARGT              GET ACCOUNT
         CD,R0    8BLNKS            CHECK FOR NULL ACCT
         BNE      %+3
         LCI      2
         LM,R0    J:ACCN            USE LOGON ACCOUNT
         LCI      2
         STM,R0   XEQACCN           PUT ACCOUNT IN FPT
         BALL     ARGT              GET PASSWORD
         LCI      2
         STM,R0   XEQPASS           PUT ANY GARBAGE IN HERE
XEQ20    EQU      %
         LI,R2    X'20'
         CH,R2    M:SI
         BAZ      %+2
         M:CLOSE  M:SI,SAVE
         CAL1,1   OPENSI
         M:SETDCB M:SI,(ABN,SIABN),(ERR,SIABN)
         B        CMDX              BYE
*
         USECT    DATA
OPENSI   GEN,8,24 X'14',M:SI
         DATA     X'1000009'        MODE,ASN=1,VLPS
         DATA     1                 INPUT
         DATA     X'01000203'
XEQFILE  DATA     0,0,0
         DATA     X'02000202'
XEQACCN  DATA     0,0
         DATA     X'03010202'
XEQPASS  DATA     0,0
         USECT    CODE
LASTCMD  EQU      %
         LD,R2    MC3               MOVE LAST COMMAND INTO CMDBUF
         MBS,R2   0
         LD,R2    MC4               AND INTO CMDBUF1
         MBS,R2   0
         BYE
         PAGE
*
*        THE ARGUMENT COLLECTION ROUTINES ARE:
*
*        ARGO     OCTAL NUMBER, VALUE RETURNED IN R1
*        ARGN     DECIMAL NUMBER, VALUE RETURNED IN R1
*        ARGH     HEX NUMBER, VALUE RETURNED IN R1
*        ARGT     TEXT STRING, UP TO 8 CHRS ZERO FILLED IN R0-1
*        ARGC     TEXTC STRING, UP TO 7 CHRS ZERO FILLED IN R0-1
*
*        THE NUMERIC ROUTINES MAY DECLARE AN ERROR ON ILLEGAL DIGITS,
*        THE CHARACTER ROUTINES DECLARE ERROR ON TOO LONG STRING.
*        ARGUMENTS ARE TERMINATED BY SPACES OR COMMAS OR END OF STRING
*        IF NO ARGUMENT WAS THERE TO BE LOOKED AT, R2 IS RETURNED ZERO,
*        AND WILL BE NON-ZERO WHEN AN ARGUMENT IS RETURNED.
*
ARGO     LI,14    8                 LOAD OCTAL BASE
         B        ARGM
ARGN     LI,14    10
         B        ARGM
ARGH     LI,14    16
*
ARGM     LI,R1    0                 RETURN 0 IF NOTHING THERE
         LW,7     CMDARG            ANYTHING FOR US TO LOOK AT?
         BE       *15               NOPE. BYE.....
         LI,1     0
         LB,6     CMDARG            # OF BYTES REMAINING
ARGM1    LB,2     CMD,7
         CI,2     ' '
         BE       ARGM2             END OF ARG HIT
         CI,2     ','
         BE       ARGM2
         CI,2     '9'
         BLE      %+3
ARGMD    LI,5     MDIG              DIGIT OUT OF PERMISSIBLE RANGE
         B        OYEAH
         CI,2     '0'
         BGE      %+2
         AI,2     X'39'
         AI,2     -'0'              CONVERT TO X'0'-X'F'
         BL       ARGMD             OOPS. ROTTEN APPLE
         CW,2     14
         BGE      ARGMD             MUST BE LESS THAN RADIX.
         MW,1     14
         AW,1     2                 ADD IN NEW DIGIT
         AI,7     1
         BDR,6    ARGM1
         LI,7     0
         B        ARGM3             OUT OF STUFF.
ARGM2    LB,2     CMD,7
         CI,2     ' '               DID WE END ON A SPACE
         BE       %+3               B/YUP, SKIP SPACES
         CI,2     ','               BUT IF WE COME TO A COMMA,
         BE       %+5               DONT SKIP OVER THAT.
         AI,7     1
         BDR,6    ARGM2
         LI,7     0
         B        ARGM3
         AI,7     1                 COMMA HIT. BEWARE NULL ARG ',,'
         AI,6     -1
         BG       ARGM3             IF STUFF LEFT, OK.
         LI,7     0
ARGM3    STW,7    CMDARG            THIS IS WHATS LEFT
         STB,6    CMDARG
         LCI      2
         B        *15               BYE......
*
ARGT     LI,14    0                 STRAIGHT TEXT
         LD,R0    8BLNKS            RETURN BLANKS IF NOTHING THERE
         B        ARGCX
ARGC     LI,14    1                 RETURN TEXTC
         LD,R0    8BLNKS
         SLD,R0   -8
ARGCX    EQU      %
         LI,2     0
         LW,7     CMDARG
         BE       *15               NOTHING TO DO...
         LB,6     CMDARG
         CI,14    0
         BE       %+2
         LI,2     1                 STARTING STORE INDEX FOR TEXTC
ARGC1    LB,3     CMD,7
         CI,3     ','
         BE       ARGC2
         CI,3     ' '
         BE       ARGC2
         STB,3    0,2
         AI,2     1
         CI,2     8
         BG       ARGCL             TOOOOO LONG.....
         AI,7     1
         BDR,6    ARGC1
         LI,7     0
         CI,14    0
         BE       ARGM3             GO CLEAN UP.
         AI,2     -1
         STB,2    0                 IF TEXTC, PLUG IN COUNT
         B        ARGM3             AND GO CLEAN UP.
ARGC2    CI,14    0
         BE       ARGM2             GO FIND NEXT ARG START, IF ANY.
         AI,2     -1
         STB,2    0
         B        ARGM2
ARGCL    LI,5     MTL               TOOOO LOOOOONNNNNGGG.
         B        OYEAH
         PAGE
*
CLIST    PUSHL
         LI,5     CMDTL             NUMBER OF DEFINED COMMANDS
         LI,3     CMDTXT            NAMES OF COMMANDS
         AI,3     2
         LW,1     3                 ADDR OF TEXT STRING
         CAL1,2   TYPEIT
         BAL,15   MAYBECR           MAYBE SPIT OUT A CR.
         BDR,5    CLIST+3           FOR ALL COMMANDS IN TABLE
         B        CMDX
         PAGE
*
*        PROVIDE FAST MODE SWITCHING
*
CALPROC  EQU      %
         PUSH     2,R0
         LW,R1    *J:XPSD           GET CAL3 INSTRUCTION
         AND,R1   =X'F00000'        MASK R FIELD
         SLS,R1   -20
         CI,R1    3                 MAX R FIELD
         BGE      ALTRET            ILLEGAL INSTRUCTION
         B        %+1,R1            BRANCH ON R FIELD
         B        GOSLAVE
         B        GOPRIV
         B        GOMASTER
ALTRET   EQU      %                 ALTRET ADR IS SPECIFIED IN
         LW,R0    *J:XPSD           REF ADDRESS FIELD OF CAL3
         LI,R1    X'1FFFF'          MASK FOR STS
         AND,R0   R1                MAKE SURE ALTRET SPECIFIED
         BNE      %+2               OK
         LI,R0    BADRET            NO ALTRET SPECIFIED
         STS,R0   J:XPSD            STORE NEW INSTRUCTION ADDRESS
         MTW,-1   J:XPSD            FIX ADDRESS
GOSLAVE  EQU      %
         LW,R1    =X'800000'        SLAVE BIT
         STS,R1   J:XPSD            SET SLAVE BIT
GOBACK   MTW,1    J:XPSD            INCREMENT INSTRUCTION ADDRESS
         PULL     2,R0
         LPSD,0   J:XPSD            BYE
GOPRIV   EQU      %                 GO MASTER ONLY IF WE HAVE THE STUFF
         LB,R1    JB:PRIV
         CI,R1    X'C0'
         BL       ALTRET            NO GO
GOMASTER MTW,0    NOPE              DO WE MATCH SYSTEM
         BNE      ALTRET            RELOAD
         BAL,R1   BLOCKER           INSURE WE ARE RUNNING ON MASTER CPU
         LI,R0    0
         LW,R1    =X'800000'        SLAVE BIT
         STS,R0   J:XPSD            CLEAR SLAVE BIT
         B        GOBACK            WERE DONE
BADRET   EQU      %                 ERROR AND NO ALTRET SPECIFIED
         BALL     EH                COMPLAIN
         B        RESTART           AND RESTART PROGRAM
*
*        CAL3 HANDLER IF WE CAN'T GET MASTER MODE
*
ALTCP    EQU      %
         PUSH     R1
         LW,R1    *J:XPSD           GET CAL3 INSTRUCTION
         CW,R1    =X'F00000'        CHECK FOR SLAVE CAL
         BAZ      SLVOK             WE FORGIVE ON A SLAVE
         AND,R1   =X'1FFFF'         MASK ADDRESS
         BNE      %+2               ADDRESS SPECIFIED
         LI,R1    BADRET            NO ALTRET SPECIFIED
         STW,R1   ALTCPRET          SAVE RETURN ADDRESS
ALTCPX   PULL     R1
         LCF      J:XPSD            RESTORE OLD CC AND FC
         B        *ALTCPRET         GO TO ALTRET ADDRESS
SLVOK    LW,R1    J:XPSD            GET OLD IA
         AI,R1    1                 INCREMENT PAST CAL
         STW,R1   ALTCPRET
         B        ALTCPX            THAT'S ALL
         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.'
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 SID 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=%, LINE=% %'
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.%'
TOTALPC  TXT       'TOTAL CURRENT PAGE COUNT (PC) = %%'
CORETOT  TXT   'TOTAL BATCH CORE = %,  CURRENT BATCH CORE = %%'
PACKM1   TXT      'PACK SN= %  USAGE= %  #DCBS+USERS= %'
PACKM2   TXT      '%-AVAILABLE'
PACKM3   TXT      '%-PARTITIONED'
LUS1     TXT      ' TYPE UNUSED IN USE  TOTAL%'
LUS2     TXT      '%%%%%'
SYSCORE  TXT      'SL:CORE = %, S:PCORE = %%'
WAS      TXT      'WAS %%'
         BOUND    8
SYSACCT  TXT      ':SYS   '
         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
         BOUND    4
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.
*
*        OUTPUT BUFFER AND CONTROL WORDS FOR SLURP
*
RADIX    DATA     10                OUTPUT RADIX
ARG      RES      8                 DIGIT PREPARATION AREA
OBUF     RES,1    140               OUTPUT BUFFER
*
*        WORD FOR DISC SUMMARY AND OTHER SCRATCH.
*
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.
MLDTRC   GEN,8,24 3,0
HURRO    DATA     0,0               FOR POSSIBLE M:LDTRC CAL.
MLINK    GEN,8,24 2,X'1F'           ERROR,EXIT AND CMD
         RES      6
         DATA     WHOSAVE
TPC      DATA      0         SUM OF CURRENT PAGE COUNT (PC).
*
#2741    EQU      8
#TOTAL   EQU      9
#TYPES   EQU      10
NLINES   RES      #TYPES
NINUSE   RES      #TYPES
WHOSAVE  RES      20                SAVE REGISTERS FOR WHO? CMD
         BOUND    8
CFUACCT  RES      2                 FOR CFU ACCOUNT SCAN.
SHORTFLAG DATA    0
SHORTSIZE DATA    0
         BOUND    8
SHORTMBS DATA     0,0
QACCN    DATA     0,0
QACCNCBS GEN,32,8,24 BA(OBUF)-26,8,BA(QACCN)
SPYLINE  DATA     0
ALTCPRET DATA     BADRET
         USECT    START             DUMP LITS IN PROCEDURE PAGES.
PATCH    DEQU     %                 50 WORDS OF ZEROED PATCH SPACE
         LIST     0
         DO1      50
         DATA     0
         LIST     1
         END      START
