P#       SET      S:UFV(P#)+1
 TITLE '*** A N A L Y Z E   O V E R L A Y   S I X   D 0 0 ***'
         REF      UCBUF
         SYSTEM   SIG7FDP
         REF      J:JIT
KINBUF   EQU      UCBUF
         REF      GETADDR
         REF      MONFLAG
         SREF     S:DSPKEY          QUEUE FEATURE SWITCH IN ROOT
         REF      MBB
         REF      JITBUF
         REF      DUMPSOME
         SREF     ANSFLGS           TELLS IF ANSI TAPE MODE SYSTEM
         REF      BLANK1            PUTS OUT A BLANK LINE
         REF      GET1ADDR
         REF      M:SI,M:LO,M:LL,M:BI,JB:PRIV,PLD:ACT
         REF      PLH:SID,LPART,PLH:FLG,M:XX,J:TELFLGS
         REF      S:CUIS,S:BUIS,S:GUIS,S:OUIS,S:BFIS,S:BUAIS
         REF      STACK
         REF      SB:GJOBUN,S:GJOBTBL,AVRID,AVRTBL,AVRTBLSIZ
         REF      GRANRAD,GRANPACK,GRANSYM,PRDPRM,PRDCRM
         REF          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      KEYINBUF,T:GJOBSTRT,S:SET:,X1
*
*        SET B00 TO 1 FOR CPV-B00 SYSTEMS. SET TO 0 FOR C00 CPV.
*
B00      SET      0
*
*        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
         LIST     0
         LOCAL   CUR%
LF       EQU      %
CUR%     EQU      %                 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
         DATA     AF(2)             AND THE ROUTINE ADDRESS
         USECT   CUR%
         LIST     1
CMDTL    SET      CMDTL+1
         PEND
*
*
*
PUSH     CNAME    X'8'
PULL     CNAME    X'7'
         PROC
LF       EQU      %
X        SET      NUM(AF)
         DO       P#=1
         RES      X                 RESERVE SPACE FOR AF COUNT
         ELSE
         DO       X=2
         LCI      AF(1)&X'F'
         FIN
         GEN,1,7,4,3,17  0,NAME(1)+(X|1),AF(X),0,STACK
         FIN
         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     'END',ANEND
         :CMD     'GHOST',GHOST
         :CMD     'QUEUE',QUEUE
         :CMD     'BATCH',BATCH
         :CMD     'TAPES',TAPES
         :CMD     'DISC',DISC
         :CMD     'UPTIME',UPTIME
         :CMD     'USERS',USERS
         :CMD     'DI',DISPLAY
CMDALL   EQU      CMDTL-1           ALL CMDS UP TO HERE DONE ON ALL.
         :CMD     'ALL',DOALL
         :CMD     'ID',DISPLAY
         :CMD     'HELP',HELP
         :CMD     'AMIN',AMIN
         :CMD     'EVERY',EVERY
         :CMD     'USER',USER
         :CMD     'CFUS',CFUS
         :CMD     'PUNT',PUNT
         :CMD     'LIST',CLIST
         :CMD     'STAT',STAT
         :CMD     'STATS',STATS
         :CMD     'NAIL',NAIL
         :CMD     'KEYIN',KEYIN
         :CMD     'PRIOB',PRIOB
         :CMD     'RUE',RUE
         :CMD     'NULL',CODE       A NULL ENTRY MUST BE FIRST.
         :CMD     'SNAP',SNAPQ
         :CMD     'FREE',FREECH
         :CMD     'DUMP',DUMPQ
         :CMD     'WAIT',WAIT
         :CMD,*   'OFF',OFF
         :CMD     'ZZZ',ZZZ
         :CMD     'ENQU',PGMINIT    STARTS UP THE ENQUEUE PROCESS
         PAGE
*
*        REGISTER DEFINITIONS- IN NO PARTICULAR ORDER.
*
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
*
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
*
*        ENTRY FROM ANLZ ROOT - DISPLAY USER INFO AND START UP
*
         USECT    CODE              IN PROCEDURE AREA
*
         DEF      SNOOP
SNOOP    EQU      %                 ENTRY FROM ROOT OF ANALZ
         LI,R6    0
         STW,R6   UCBUF             CLEAR ANLZ'S COMMAND TO GET HERE
         CAL1,1   PROMPTX           SET PROMPT CHARACTER
START1   LC       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
START2   EQU      %
         BAL,15   DISPLAY           SHOW USER STUFF TO USER
STARTIT  BAL,15   WHUT
         LI,6     0
         BAL,15   0,7               DO THE COMMAND.
         B        STARTIT
PROMPTX  GEN,8,24 X'2C','-'
         PAGE
*
*        DOIT PROMPTS THE USER AND READS AND SCANS THE REPLY,
*        RETURNING THE COMMAND ADDRESS IN 7.
*
DOIT     PUSH  15                   CRAM LINK ONTO THE STACK.
         BAL,15   WHUT              GET US A COMMAND. RETURN ADDR IN 7
CMDX     PULL     15
         B  *15                     SPLIT.
*
*        OFF BRINGS YOU BACK TO ANLZ
*
OFF      EQU      %
         B        SCANNER           JUST RETURN TO ANLZ ROOT
         REF      SCANNER,OBUF
         PAGE
*
*        AMIN READS A COMMAND AND DOES IT ONCE A MINUTE.
*
AMIN     PUSH  15
         BAL,15   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,R2    6                 SIZE OF MSG
         BAL,R0   WRIT%BUF          WRITE OUT THE BUFFER
         STW,8    CMDARG            RESTORE SCANNING POINTERS
         LI,6     0
         BAL,15   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    PUSH  15
         BAL,15   ARGN
         BLE      EHX               WHAT'S THIS CRUD??
         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
         BAL,15   WHUT              FIND SOMETHING TO DO
         LW,8     CMDARG            GET SCAN POINTERS
         B        AMIN1             AND GO TO IT.....
         PAGE
*
*        INTERFACE TO ANLZ PRINT BUFFER ROUTINE
*
WRIT%BUF EQU      %
         LI,R6    0                 BUFER NOW EMPTY
         STW,R2   PTR               STORE SIZE
         B        BUFOUT            AND MERGE
         PAGE
*
*        UPTIME PRINTS THE TIME SINCE SYSTEM STARTUP.
*
UPTIME   PUSH  15
         LI,9     0
         LI,7     0
         LI,8     C:TIC             UPTIME IN TICKS
         BAL,15   LW
         LI,0     0
         DW,0     =30000            TO MINUTES
         STW,1    TRASH             SAVE THAT.
         LI,5     BA(UPT1)
         BAL,15   SLURP
         LI,0     0
         DW,0     =60
         BAL,15   SLURPN            PRINT OUT HOURS
         MW,0     =60
         SW,1     TRASH             -MINUTES
         LCW,1    1                 MINUTES
         BAL,15   SLURPN            PRINT MINUTES
         BAL,15   SLURPO            WRITE
         B        CMDX
         PAGE
*
*        HELP JUST TYPES A STRING TO SHOW THE USER WHAT TO DO.
*
HELP     PUSH  15
         LI,5     BA(HLPTXT)
HELP1    BAL,15   SLURP
         CI,6     10                HIT THE END YET?
         BLE      CMDX              IF SO,....
         BAL,15   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.
   TEXT  'NOTE- ONLY ENOUGH CHARACTERS TO UNIQUELY IDENTIFY THE %'
   TEXT  '      COMMAND ARE NEEDED- I.E. H, HE, HEL WILL ALL DO HELP.%'
   TEXT  'COMMAND                   ACTION%'
   TEXT  'HELP    TYPES THIS MESSAGE.%'
   TEXT  'END     RETURNS TO ANLZ.%'
   TEXT  'GHOST   PRINTS NAMES AND IDS OF RUNNING GHOSTS.%'
   TEXT  'BATCH   BATCH PARTITION ACTIVITY.%'
   TEXT  'QUEUE   BATCH AND SYMB QUEUE, IF FEATURE INSTALLED.%'
   TEXT  'TAPES   TAPE DRIVE USE AND AVAILABILITY.%'
   TEXT  'DISC    DISC SPACE AVAILABILITY%'
   TEXT  'UPTIME  TIME SINCE SYSTEM STARTUP%'
   TEXT  'USERS   NUMBER OF USERS ON SYSTEM%'
   TEXT  'DI      USER ID, TIME, AND PRIV LEVEL.%'
   TEXT  'ALL     DOES ALL THE ABOVE COMMANDS.%'
   TEXT  'USER #  TELLS YOU ABOUT USER WITH ID #.%'
   TEXT  'CFUS    DUMPS ALL IN USE CFU''S ON YOU.%'
   TEXT  'CFUS #  DUMPS CFUS ACTIVE FOR ACCOUNT #.%'
   TEXT  'PUNT    TRY IT, YOU WONT LIKE IT!%'
   TEXT  'STATS   GIVES SYSTEM STATUS SUMMARY.%'
   TEXT  'STATS # GIVES SUMMARY, AND STATUS OF JOB #.%'
   TEXT  'STAT    GIVES SUMMARY ONCE A MINUTE.%'
   TEXT  'STAT #  GIVES STATS # ONCE A MINUTE.%'
   TEXT  'AMIN    DOES THE NEXT COMMAND ONCE A MINUTE.%'
   TEXT  'EVERY # DOES THE NEXT COMMAND EVERY # TICKS.%'
   TEXT  'KEYIN   (PRIVILEGED)--SENDS MSG TO KEYIN GHOST.%'
   TEXT  'RUE #,N (PRIVILEGED)--REPORT EVENT N ON USER #.%'
   TEXT  'NAIL #  (PRIVILEGED)--LOGS SPECIFED USER OFF SYSTEM.%'
   TEXT  'PRIO #,N (PRIVILEGED)--SET PRIORITY FOR USER.%'
   TEXT  'ENQUEUE  INDICATES THAT WE WILL EXAMINE ENQU/DEQU TABLES.%'
   TEXT  'FREE     DISPLAY THE FREE ENQU/DEQU CHAIN.%'
   TEXT  'DUMP     DUMPS THE ACTIVE ENQU/DEQU CHAIN.%'
   TEXT  'SNAP     SNAPS THE ENTIRE ENQU/DEQU TABLES.%'
   TEXT  'WAIT #   WAITS SPECIFIED TIME - LOOKS FOR ACTIVITY',;
         ' IN THE ENQU/DEQU TABLES.%'
   TEXT  'ZZZ      SAYS TO SLEEP FOR A WHILE.%'
****************************************************************
           TEXT   'THAT''S ALL...%%%%%%%%%%%%%%%%%%%%'
         PAGE
*
*        THE USERS COMMAND PRINTS A SUMMARY OF THE USERS ON THE
*        SYSTEM IN THE FORM
*         % USERS- % ONLINE + % GHOST + % BATCH + % WAITING.
*
USERS    PUSH  15
         LI,5     BA(USERSM)
         LI,9     0                 AS MANY AS THERE ARE DIGITS.
         LD,6     16BALLS
         BAL,15   SLURP
         LI,8     S:CUIS            CURRENT USERS IN SYSTEM
         BAL,15   LW
         BAL,15   SLURPN
         LI,8     S:OUIS
         BAL,15   LW
         BAL,15   SLURPN
         LI,8     S:GUIS
         BAL,15   LW
         BAL,15   SLURPN
         LI,8     S:BUIS
         BAL,15   LW
         BAL,15   SLURPN
         LI,8     S:BFIS
         BAL,15   LW
         BAL,15   SLURPN
         BAL,15   SLURPO
         B        CMDX              RETURN THROUGH WRITE.
         PAGE
*
*        COMMAND END GETS YOU BACK TO ANLZ
*
ANEND    EQU      %
         B        SCANNER
         PAGE
*
*        THE CFU COMMAND  DUMPS THE  IN USE CFU'S
*
CFUS     PUSH  15
         LI,1     0
         STW,1    TRASH             USED CFU'S
         STW,1    TRASH1            UNUSED CFU'S
         STW,1    TRASH2            ACCOUNT SEARCH FLAG
         BAL,15   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
         BAL,15   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
         BAL,15   LW                IS IN THERE
         CW,11    1
         BL       LOOKCFU           NOPE.
         LI,5     BA(CFUM3)
         LI,6     0
         LI,9     0
         LW,1     TRASH
         BAL,15   SLURPN            THIS MANY IN USE CFU'S
         LW,1     TRASH1
         BAL,15   SLURPN            AND THIS MANY UNUSED
         AW,1     TRASH             THIS MANY TOTAL.
         BAL,15   SLURPN
         BAL,15   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
         BAL,15   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'
         BAL,15   SLURPC            SHOVEL THAT IN.
         AI,8     2                 SPACE TO ACCT/NAME INDEX
         BAL,15   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      %+3               NOPE
         LD,0     CFUPRPK           IF SO,LOAD THE TEXT
         B        CFUSAS            AND GO TO ACCOUNT SLURP POINT.
         LH,3     1                 THE ACCOUNT DWORD OFFSET
         SLS,3    1                 SHIFT TO WORD INDEX
         LI,8     ACNCFU+13         ACCT ENTRY START
         BAL,15   LW                GET THAT
         LW,8     1
         AW,8     3                 ADD IN THE DISPLACEMENT IN CFU.
         BAL,15   LW
         LW,2     1                 I DONT THINK ITS ON A
         AI,8     1                 DOUBLEWORD BOUNDARY, SO I'LL
         BAL,15   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   BAL,15   SLURPC            ENTRY
         DO       B00=1
         LI,8     ACNCFU+15         BUT YOU WASTE A LOT OF CFU SPACE
         BAL,15   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
         BAL,15   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
         BAL,15   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    BAL,15   SLURPO            PRINTIT.
         B        NXTCFU            NEXT!
CFUSTAR  LD,0     8BLNKS            FOR STAR FILES IN B00, WE DONT
         BAL,15   SLURPC            KNOW THE ACCOUNT
CFUSTAR1 LI,5     BA(CFUM2)         THE HEADER TO USE.
         BAL,15   SLURP             PUMP OUT FIRST PART,
         LI,9     8                 8 CHARACTERS, PLEEZE
         BAL,15   SLURPH            AND DUMP OUT HEX.
         B        CFUSO             THAT'S THAT.
CFUSREL  LD,0     CFUSRELS          THE FILE IS TO BE RELEASED.
         BAL,15   SLURPC            SO TELL THEM ABOUT IT ALREADY.
         B        CFUSO
         BOUND    8
FMSG    TEXT      'IN  OUT INOUT   OUTIN' CFU FUNCTION CODE TEXTS.
CFUPRPK TEXT      'PRIV PAK'        PRIVATE PACK FILE.....
CFUSRELS TEXT     ' (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
         PUSH  15
         BAL,15   ARGH              GO GET HEX ARGUMENT
         BGE      STAT2             LESS THAN 0 IS ERROR RETURN.
STATEH   BAL,15   EH                WHAT WAS THAT??
         B        CMDX              I DONT KNOW....
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)
         BAL,15   SLURP
         LW,1     JID               IF THER'S AN ID PRESENT,
         BE       %+3
         LI,9     4                 WE'LL PRINT IT OUT AS A FOUR
         BAL,15   SLURPH            DIGIT HEX NUMBER.
         BAL,15   SLURPO
         LI,5     BA(STATM2)
         BAL,15   SLURP
         MTW,0    JID               IS IT THERE??
         BE       %+2               NOPE
         BAL,15   SLURP             CONTINUE HEADER OF IT IS
         BAL,15   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,R7    0                 NO INDEXING
         LI,R8    S:CUIS            CURRENT TOTAL USERS IN SYSTEM
         BAL,R15  LW
         BAL,R15  SLURPN
*
         LI,R8    S:OUIS            ONLINE USERS IN SYSTEM
         BAL,R15  LW
         BAL,R15  SLURPN
*
         LI,R8    S:GUIS            GHOST USERS IN SYSTEM
         BAL,R15  LW
         BAL,R15  SLURPN
*
         LI,R8    S:BUIS            BATCH USERS IN SYSTEM
         BAL,R15  LW
         BAL,R15  SLURPN
*
         LI,R8    S:BFIS            BATCH FILES IN SYSTEM
         BAL,R15  LW
         BAL,R15  SLURPN
*
         LI,9     6                 6 DIGITS FOR STORAGE SUM.
         LI,7     0
         LI,8     GRANRAD
         BAL,15   LW
         STW,1    TRASH
         LI,8     GRANPACK
         BAL,15   LW
         AW,1     TRASH
         BAL,15   SLURPN            STORAGE AVAILABLE.
         LI,9     4                 FOR SYMBIONT STORE
         LI,8     GRANSYM
         BAL,15   LW
         BAL,15   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
         BAL,15   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
         BAL,15   SLURPN            FOR PARTITION AND STAR.
         LI,0     '*'               AND PUT A MARKER AFTER IT
         STB,0    0                 TO DENOTE PARTITION NUMBER
         BAL,15   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.
         BAL,15   SLURPN
         B        STAT6
STAT5    LW,1     8                 THE STATUS
         LW,0     MJOBS,1           JOB STATUS TEXT.
         LI,1     0
         BAL,15   SLURPC
STAT6    BAL,15   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   TEXT      '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    EQU      %
         PUSH     R15
         LI,R8    S:DSPKEY          IS FEATURE INSTALLED
         BEZ      NOQ               NOPE--TELL USER
         LI,R7    0                 SET FOR NO INDEXING
         BAL,R15  LW                PICK IT UP
         STW,R1   LDEVBIFO          STICK IT IN FORM SLOT
         LI,1     X'0020'
         CH,1     M:BI              IS THE DCB OPEN NOW??
         BAZ      %+2
         CAL1,1   CLOSEBI           NOPE....
         CAL1,8   LDEVBI            M:LDEV 'C2' TO NAKNAKNAKNAK.
         CAL1,1   OPNBIC2           OPEN BI TO C2.
QREAD    CAL1,1   READQ             READ IN SOME CRUD
         LH,2     M:BI+4
         SLS,2    -1
         BAL,R0   WRIT%BUF
         B        QREAD
QUEUEX   CAL1,1   CLOSEBI           CLOSE THE DCB
         B        CMDX
NOQ      LI,1     NOQUEM            NO GOT. THE RBBAT SHAFTED US.
         LI,2     18
         CAL1,1   WRITEIT
         LI,1     X'0020'
         CH,1     M:BI
         BAZ      CMDX
         B        QUEUEX            CLEAN UP AND SPLIT.
CLOSEBI  GEN,8,24 X'15',M:BI
         GEN,1,31,32  1,0,2
*
         USECT    DATA
LDEVBI   LCD,0    0                 M:LDEV
         DATA     X'90100000'
         DATA     X'C3F2'           C2
         DATA     0                 ITS IN.
LDEVBIFO EQU      %
         PLM,0    X'A0A',5          FORM,'(NAK)(NAK)(NAK)(NAK)'
         USECT    CODE
*
OPNBIC2  GEN,8,24 X'14',M:BI        OPEN M:BI
         DATA     X'C1040000'
         DATA     NOQ,NOQ           ERROR AND ABN
         DATA     1                 IN
         DATA     X'C3F2'           DEVICE,C2
*
READQ    GEN,8,24 X'10',M:BI
         DATA     X'F0000010'
         DATA     QUEUEX,QUEUEX     ERR AND ABN
         DATA     OBUF,140          BUFFER AND SIZE
*
NOQUEM  TEXT      'RBBAT SEZ NO DICE.'
         PAGE
*
*
*              RAD   PACK  TOTAL
*        USER XXXXX XXXXX XXXXXX
*        SYS  XXXXX XXXXX XXXXXX
*        SYMB             XXXXXX
*
DISC     PUSH  15
         LI,5     BA(DIS1)
         BAL,15   SLURP
         BAL,15   SLURPO
         LI,9     5
         LI,1     0
         STW,1    TRASH
         LI,5     BA(DIS2)
         BAL,15   SLURP
         LW,1     J:JIT+PRDCRM
         AWM,1    TRASH
         BAL,15   SLURPN
         LW,1     J:JIT+PRDPRM
         AWM,1    TRASH
         BAL,15   SLURPN
         LI,9     6                 SIX DIGITS FOR TOTAL
         LI,1     0
         XW,1     TRASH
         BAL,15   SLURPN
         BAL,15   SLURPO
         LI,5     BA(DIS3)
         LI,9     5
         BAL,15   SLURP
         LI,7     0                 NO INDEX
         LI,8     GRANRAD
         BAL,15   LW
         AWM,1    TRASH
         BAL,15   SLURPN
         LI,8     GRANPACK
         BAL,15   LW
         AWM,1    TRASH
         BAL,15   SLURPN
         LI,9     6
         LI,1     0
         XW,1     TRASH
         BAL,15   SLURPN
         BAL,15   SLURPO
         LI,5     BA(DIS4)
         BAL,15   SLURP
         LI,8     GRANSYM
         BAL,15   LW
         BAL,15   SLURPN
         BAL,15   SLURPO
         B        CMDX
         PAGE
*
*        TAPES COMMAND DISPLAYS THE STATUS OF THE TAPE DRIVES
*        IN THE SYSTEM USING INFORMATION GLEANED FROM THE AVR TABLES.
*
TAPES    PUSH  15
         LI,R1    TAPMSG
         LI,R2    17
         CAL1,1   WRITEIT           PUT OUT HEADER
         LI,7     AVRTBLSIZ-1       # OF DRIVES ON THIS BEAST.
TAPE1    LI,5     BA(STATM3)        HEADER TO USE
         BAL,15   SLURP             POKE OUT A SPACE.
         LI,8     AVRTBL            GET THE INFO ON THIS ONE.
         BAL,15   LD                ITS A DOUBLEWORD.
         LD,2     0                 SAVE FOR A MINUTE.
         LI,8     AVRID             LETS LOOK AT AVRID TOO
         BAL,15   LH                WHILE WE'RE AT IT.
         LW,3     1                 SAVE THAT TOO....
         LW,1     7                 PRINT OUT DRIVE NUMBER FIRST.
         LI,9     2                 AS TWO DIGITS.
         BAL,15   SLURPN
         LW,1     3                 NOW GET THE AVR ID
         LI,9     4                 AND PRINT IN 4 HEX DIGITS
         BAL,15   SLURPH
         LI,R8    ANSFLGS           IS THIS AN ANSI TAPE SYSTEM
         BEZ      TAPE11            NOPE
         BAL,R15  LB                GET THE BYTE
         CI,R1    X'80'             IS ANSI REEL
         BAZ      TAPE11            NOPE
         BAL,R15  ANSI              YEP--BUST IT TO EBCDIC
         B        TAPE12            AND MERGE
TAPE11   EQU      %
         LW,R0    R2                MOVE REEL EBCDIC TO R0
         LI,R1    0                 INDICATE ONLY 4 BYTE WORTH
TAPE12   EQU      %                 MERGE POINT FOR ANSI REELS
         AI,R6    3                 SPACE REEL NUMBER OVER
         BAL,15   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
         BAL,15   SLURPC
TAPE2    BAL,15   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.
TAPMSG   TEXT     'UNIT   U#   TAPE#'
         PAGE
*
*        CURRENT REEL IS ANSI TYPE
*
ANSI     EQU      %
         PUSH     5,R2              SAVE R2 THRU R6
         SLD,R2   -20
         SLS,R3   -12
         LW,R5    R3
         LI,R6    6
ANSI1    EQU      %
         SLD,R2   -2
         SLS,R3   -26
         LI,R4    0
         DW,R4    =10
         OR,R3    R4
         BEZ      %+2
         AI,R3    X'80'
         AI,R3    X'40'
         SLD,R0   -8                ASSEMBLING INTO R0
         STB,R3   R0
         BDR,R6   ANSI1
         PULL     5,R2
         B        *R15              AND RETURN
         PAGE
*
*        THE USER COMMAND TELLS YOU ABOUT THE SUPPLIED USER ID.
*
*        NOTE THAT YOU CAN SUPPLY LISTS---IE;
*
*        USER 1,2,3,4,5,6,7,8,9,A.....ETC....
*
*
USER     PUSH  15
         BAL,15   ARGH              GO GET USER NUMBER
         BLE      STATEH            NOTHING. GRIPE.
         B        USER01            HOP DOWN.
USER00   BAL,15   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.
         BAL,15   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
         BAL,15   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
         BAL,15   LB                BEING USED.
         CI,1     SNULL             CHECK FOR NULL STATE.
         BE       USER00            NULL--GET NEXT IN LIST
         BAL,R0   BLANK1            BLANK LINES BETWEEN EM
         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
         BAL,15   SLURP             OUTPUT BEGINNING
         STW,1    TRASH             SAVE THAT ID FOR LATER
         BAL,15   SLURPH            PUT IT OUT
         BAL,15   USERIS            GO TELL ME IF HE GHOST OR WHAT.
         BAL,15   SLURPO            SPIT IT OUT
         LI,5     BA(USERM2)        HEADER TO USE FOR SIZE AND STATE
         LW,7     TRASH             USE ID AS INDEX
         BAL,15   SLURP             FIRST PART OF HEADER
         LI,8     UB:PCT            GET PAGE COUNT
         BAL,15   LB
         BAL,15   SLURPN            SPIT THAT OUT
         LI,8     UB:US
         BAL,15   LB                GET CURRENT STATE
         LW,0     STATETXT,1        GET THE TEXT FOR THE STATE
         BAL,15   SLURPC            AND PRINT THAT OUT.
         LI,8     UB:PRIO           CURRENT EXECUTION PRIO
         BAL,15   LB                FETCH THAT,
         BAL,15   SLURPH            AND PUMP OUT AS HEX
         LI,8     UB:PRIOB
         BAL,15   LB                BASE EXECUTION PRIO
         BAL,15   SLURPH            AND DUMP THAT TOO.
         LI,8     UB:ACP            LOOK AT COMMAND PROC.
         BAL,15   LB
         BE       USER2             NOPE.
         LI,5     BA(USERM3)        IF THERE IS, WE'LL
         BAL,15   USRSUB            GO POKE OUT P:NAME ENTRY.
USER2    LW,7     TRASH             GET USER ID BYTE BACK
         LI,8     UB:APR            LOOK AT ASSOCIATED PROCESSOR
         BAL,15   LB
         BE       USER3             NO GOT......
         LI,5     BA(USERM4)
         BAL,15   USRSUB            THE USER'S APR.
USER3    LW,7     TRASH
         LI,8     UB:OV             MON OVERLAY NEEDED
         BAL,15   LB
         BE       USER4
         LI,5     BA(USERM5)
         BAL,15   USRSUB            THE USER'S MON OVERLAY.
USER4    BAL,15   SLURPO            THE END......
         B        USER00            BYE..........
USRSUB   PUSH  15                   SAVE LINK
         BAL,15   SLURP             HEADER INFO
         LW,7     1
         LI,8     P:NAME
         BAL,15   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...
         BAL,15   SLURPC
         LI,7     MAXG              MAX NUMBER OF GHOSTS THERE CAN BE
         LI,8     SB:GJOBUN         AND THE ID TABLE
         BAL,15   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.
         BAL,15   LB
         CW,1     2
         BE       USERISB           FOUND IT.
         BDR,7    %-3               OR KEEP LOOKING.
USERISO  LI,5     BA(USROM)         MUST BE ONLINE, I GUESS...
         BAL,15   SLURP
         LI,8     LB:UN             SO WE'LL SEARCH LB:UN TO FIND
         LI,7     LNOL              OUT WHAT COC LINE IT IS.
         BAL,15   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.
         BAL,15   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
         BAL,15   SLURP
         LI,8     S:GJOBTBL         FIND THE NAME OF THIS GHOST
         BAL,15   LD
         BAL,15   SLURPT
         B        USERISX           THAT'S ALL FOR GHOSTS.
USERISB  LI,5     BA(USRBM)         FOR BATCH USERS.
         BAL,15   SLURP
         LW,1     7
         BAL,15   SLURPN            PUT OUT PARTITION NUMBER
         LI,8     PLD:ACT           AND GO GET THE ACCOUNT
         BAL,15   LD
         BAL,15   SLURPC
         LI,8     PLH:SID           AND THE SYSID FOR IT.
         BAL,15   LH
         B        USERISX-1         THAT'S ALL......
         PAGE
*
*        PUNT.... WHEN IN DOUBT, PUNT.....
*
PUNT     PUSH  15
         BAL,15   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
         BAL,15   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
         BAL,15   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
         LI,1     DIS1              NULL WRITE IF NOT ONLINE OUTPUT.
         CAL1,1   WRITEIT
         LI,5     BA(DOOM1)
         BAL,15   SLURP
         LD,0     CMDTXT,7          COMMAND NAME
         BAL,15   SLURPT
         BAL,15   SLURPO
         PUSH     7
         LW,5     CMDTV,7
         CI,5     SNOOP             IF LOWER THAN HERE,
         BLE      %+3               UNDEFINED COMMAND
         CI,5     =60               LOWER THAN TOP OF PROCEDURE
         BL       %+2               YUP. OK...
         LI,5     EH
         BAL,15   *5
         PULL     7
         BDR,7    DOALL1
*
*        EH SPITS OUT A USEFUL AND INFORMATIVE ERROR MESSAGE.....
*
EHX      PULL 15                    RESTORE OLD LINK FOR EXIT.
EH       LI,1     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     15                SAUSAGE........
         LI,7     0
         LI,8     S:BUIS
         BAL,15   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?
         BAL,15   LW
         LI,5     BA(BAT1)
         BAL,15   SLURP
         LI,9     0                 HOWEVER MANY YOU WANT.
         BAL,15   SLURPN
         BAL,15   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)
         BAL,15   SLURP
         BAL,15   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
         BAL,15   LH                TO SEE IF A JOB IS RUNNING
         BE       BATCH3-1          NOPE. CHECK NEXT PARTITION.
         LW,3     1                 SAVE ID
         BAL,15   SLURP
         LW,1     7                 PARTITION NUMBER
         BAL,15   SLURPN
         LW,1     3                 SYSID
         BAL,15   SLURPH
         LI,8     PLB:USR           GET USER NUMBER FOR THIS THING
         BAL,15   LB
         LW,11    1                 REMEMBER THIS FOR A WHILE....
         BAL,15   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
         BAL,15   LB                TO GET USER PAGE SIZE
         BAL,15   SLURPN
         LI,8     UB:US             GET CURRENT USER STATE
         BAL,15   LB
         LW,0     STATETXT,1        TEXT FOR IT
         BAL,15   SLURPC            AND SPIT IT OUT
         LW,7     12                RESTORE PARTITION NUMBER
         LI,8     PLD:ACT           ACCOUNT
         BAL,15   LD
         BAL,15   SLURPC            8 CHARACTERS.
         LW,7     11                REMEMBER THAT USER ID??
         LI,8     UB:APR            LETS PRINT OUT THE PROCESSOR
         BAL,15   LB                THATS BEING USED.
         LW,7     1
         LI,8     P:NAME
         BAL,15   LD
         BAL,15   SLURPT
         BAL,15   SLURPO            THATS THAT LINE.
         LW,7     12                LOOK AT THE
         AI,7     1                 NEXT PARTITION
BATCH3   BDR,13   BATCH2            KEEP LOOKING THROUGH PARTITIONS.
         B        CMDX              ALL DONE.
         PAGE
*
*        GHOST GIVES THE NAMES AND SYSIDS OF RUNNING GHOSTS.
*
GHOST    PUSH  15
         LI,7     0
         LI,8     S:GUIS
         BAL,15   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)
         BAL,15   SLURP
         BAL,15   SLURPO            HEADER.
         LI,13    MAXG
GHOST2   LW,7     13
         LI,8     SB:GJOBUN         CHECK FOR A JOB NUMBER
         BAL,15   LB
         BE       GHOST3            NOT RUNNING HERE.....
         LI,6     0
         LI,5     BA(STATM3)
         LI,9     4
         BAL,15   SLURPH            ID
         LI,8     S:GJOBACN         WHAT IS THE ACCOUNT??
         BAL,15   LD
         BAL,15   SLURPC
         LI,8     S:GJOBTBL
         BAL,15   LD                GET THE NAME
         BAL,15   SLURPT
         BAL,15   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.)
*
ID       EQU      %                 ANOTHER COMMAND ENTRY.
DISPLAY  PUSH  15
         CAL1,8   DISPL1            GET THE TIME AND SUCH.
         LI,2     16
         BAL,R0   WRIT%BUF
         LI,5     BA(DISPM1)
         BAL,15   SLURP             SPACE OVER
         LCI      5
         LM,0     J:JIT+1           LOAD NAME AND ACCOUNT.
         BAL,15   SLURPC            NAME-TWO WORDS.
         LD,0     2                 FIRST TWO OF ACCT.
         BAL,15   SLURPC
         LW,0     4
         LI,1     0
         BAL,15   SLURPC
         LI,9     2
         LB,1     JB:PRIV           PRIV LEVEL
         BAL,15   SLURPH
         LW,1     J:JIT
         AND,1    =X'FF'            INCLUDE USER ID IN THE MESSAGE.
         BAL,15   SLURPH
         BAL,15   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:SI IS DONE. THAT INPUT IS
*        SHOVELED INTO THE SYSTEM KEYIN BUFFER, AND THE KEYIN GHOST
*        IS KICKED. OTHER THAN MAKING SURE THERE IS A LINE FEED TERMINATING
*        THE INPUT LINE, NO OTHER CHECKING IS DONE ON THE USER INPUT.
*
KEYIN    PUSH  15
         LC       J:JIT             ARE WE ONLINE USER??
         BCR,8    EHX               B/NOPE, GET LOST......
         CAL1,1   =X'2C00005A'      M:PC '!'
         CAL1,1   READUC            READ THE TERMINAL.
         CAL1,1   PROMPTX           RESET PROMPT CHAR
         LI,R2    0                 INDEX INTO BUFFER
         LI,R3    80                MAX LENGTH THRU BUFFER
KEYIN0   EQU      %
         LB,R0    KINBUF,R2
         CI,R0    13                CARRAIGE RETURN
         BE       KEYIN1            GOTCHA
         CI,R0    X'15'             OR NEW LINE
         BE       KEYIN1            GOTCHA
         AI,R2    1
         BDR,R3   KEYIN0            KEEP LOOKING
         B        WTF               DONT KNOW WHAT WENT WRONG
KEYIN1   EQU      %
         LI,4     X'15'             NEW LINE CHARACTER
         STB,4    KINBUF,R2         PUT AT END OF TEXT.
         AI,R2    1                 ADVANCE COUNT TO INCLUDE N/L
         BAL,15   GOPRIV
         LD,6     KMOVE             LOAD MBS CONTROL STUFF
         STB,2    7                 MOVE ONLY WHAT'S NEEDED.
         MBS,6    0                 MOVE IT IN.
         LI,R6    0
         STW,R6   KINBUF            SUPPRESS OLD CONTENTS OF INPUT BUF
         LD,0     TCKEYN            TEXTC FOR KEYIN
         BAL,10   T:GJOBSTRT        KICK THE GHOST
         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:SI
         DATA     X'30000010'
         DATA     KINBUF,80
         BOUND    8
KMOVE    DATA     BA(KINBUF)
         DATA     BA(KEYINBUF)
TCKEYN   TEXTC    'KEYIN'           FOR T:GJOBSTRT
TLATER  TEXT      'LATER!'
         PAGE
*
*        RUE      IS A PRIVELIGED COMMAND THAT ALLOWS THE USER TO REPORT
*                 SOME RANDOM EVENT ON ANOTHER USER. THE FORM IS
*        RUE ID,EVENT               EVENT= 'OFF,QFI, ETC...
*        THE TRANSITION IS CHECKED TO MAKE SURE IT WILL NOT CAUSE
*        A SC-02 BEFORE WE DO IT........
*
RUE      PUSH  15
         BAL,15   GUN               GET USER NUMBER.
         PUSH     1                 AND STASH FOR A WHILE.
         BAL,15   ARGT              GO GET EVENT TEXT
         PLW,R3   STACK             PUT USER # IN R3
         CI,R2    0                 DID WE PICK UP A STATE TEXT
         BE       BADEVNT           WHAT'S THIS TRASH????
         LI,2     LEVENT            LAST EVENT
         CW,R0    TEVENT,2          SEARCH THE TABLE OF EVENTS
         BE       %+3               B/FOUND IT.
         BDR,2    %-2
         B        BADEVNT           TELL HIM BAD EVENT TEXT
         BAL,15   GOPRIV            GO MASTER
         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
         B        NAILX             EXIT....
         PAGE
*
*        ILLEGAL EVENT TEXT GIVEN
*
BADEVNT  EQU      %
         LI,R1    EVNT%MSG
         BAL,R0   MBB
         B        CMDX              RETURN TO SCAN...
EVNT%MSG TEXTC    '**THAT IS AN UNKNOWN EVENT CODE'
*
*        CONTINUE ON CONTINUATION IN SCHED TABLES
*
SC02M   TEXT      'NOPE! SC/02..'
*
TRCE2    AI,3     1                 NEXT ENTRY
         B        TRCE1             CONTINUE
TRCE3    EQU      %
         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  TEXT      'IIP QMF CRD CIC CBL CUB CBK CEC ERR OFF WU  SL  '
        TEXT      'QA  ART UQA KO  AP  QE  IC  QFI NSYMSYMFNSYDSYMD'
        TEXT      'OCR NOCRCFB CBA ND  DPA QFACUQFANQW NQR'
LEVENT   EQU      X'31'             LAST ONE IN C00......
         PAGE
*
*        PRIOB    IS A PRIVELIGED COMMAND THAT ALLOWS THE USER TO
*                 MODIFY THE BASE EXECUTION PRIORITY (UB:PRIOB) OF
*        ANY USER IN THE SYSTEM. THE FORMAT OF THE COMMAND IS:
*                 PRIOB UID,NPRIO
*        UID=     USER ID, MAY BE BATCH ID.
*        NPRIO=   NEW PRIORITY BASE VALUE, X'FE'=> NPRIO => X'20'
*                 NOTE THAT PRIORITIES WITH VALUES LESS THAN X'C0'
*                 ARE NOT RECCOMENDED......FAIR WARNING......
*
PRIOB    PUSH  15
         BAL,15   GOPRIV            RETURN MASTER MAPPED
         BAL,15   GUN               GET USER NUMBER.
PRIOB1   PUSH     1                 SAVE THAT FOR A WHILE....
         BAL,15   ARGH              AND GO GET NEW BASE PRIO.
         BNE      PRIOB2            B/LOOKS OK, SO FAR....
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...
         LI,2     USER0             WE WANT TO GO HERE.
         LI,3     X'1FFFF'          BUT WE WANT TO BE SLAVE.....
         STS,2    SPSD
         LPSD,0   SPSD              TO TELL ABOUT THE USER WE BUMPED.
         PAGE
*
*        NAIL IS A PRIVELIGED COMMAND THAT WILL NAIL A SELECTED
*        GROUP OF USERS ON THE SYSTEM, EXCEPT THIS PROGRAM.
*        THE ARGUMENT TO NAIL IS:
*                 GHOST             NAIL ALL GHOSTS, EXCEPT 2,3,4
*                 BATCH             ALL BATCH USERS
*                 ONLINE            ALL ONLINE USERS
*                 ALL               EVERYBODY BUT ME
*                 NAME              ALL USERS ASSOCIATED WITH NAME, WHERE
*                                   NAME IS IN THE SHARED PROC TABLES.
*                 #                 USER #
*                 #,#,#             SELECTED USERS.
*
*        WE NAIL PEOPLE BY REPORTING AN ABORT EVENT ON THEM TO THE
*        SCHEDULER THRU T:RUE.
*
NAIL     PUSH  15
         BAL,15   GOPRIV            RETURN MASTER MAPPED
NAIL0    BAL,15   ARGC              GO GET TEXTC ARGUMENT
         BNE      %+3               LOOKS OK.
NAILX    LI,15    CMDX
         B        GOSLV             RETURN TO SLAVE AND SPLIT.
         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      %+3
NAILEH   LI,15    EHX
         B        GOSLV             CANT BE USER NUMBER.
         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     4
         BLE      %+2               DONT NAIL 'CAT, RBBAT....
         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.
*
GOPRIV   LW,0     15
         LB,1     JB:PRIV           BEFORE WE TRY, CAN WE DO IT??
         CI,1     X'C0'
         BL       PRIV%PROB         B/NO DICE. WON'T WORK.....
         LI,1     X'1FFFF'
         STS,0    RPSD
         CAL1,6   =X'08000000'
         LPSD,0   RPSD
*
*        GOSLV RETURNS IN SLAVE MODE
*
GOSLV    LW,0     15
         LI,1     X'1FFFF'
         STS,0    SPSD
GOSLV1   LPSD,0   SPSD              LOOK AT TRAP HANDLER.......
*
         USECT    DATA
         BOUND    8
RPSD     DATA     X'00400000',0     FOR GOING MASTER
SPSD     DATA     X'00C00000',0     FOR GOING SLAVE AGAIN.
         USECT    CODE
         BOUND    8
NGT      TEXTC    'GHOST'
NBT      TEXTC    'BATCH'
NOLT     TEXTC    'ONLINE'
NAT      TEXTC    'ALL'
        TEXT      '    '            PAD TO 8 CHRS FOR CD.
NMT      TEXTC    'ME'              FOR 'NAIL ME'
        TEXT      '    '            WE WILL COMPLY......
         PAGE
*
*        PRIVILEGE TOO LOW TO GO MASTER MODE
*
PRIV%PROB EQU     %
         LI,R6    0
         STW,R6   KINBUF            SUPPRESS OLD CONTENTS OF UCBUF
         LI,R1    PRIV%MSG
         BAL,R0   MBB
         B        CMDX
PRIV%MSG TEXTC    '**YOUR PRIVILEGE LEVEL IS TOO LOW'
         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      PUSH  15
         BAL,15   ARGH              GO GET NUMBER
         BE       GUNE              B/GROSS...NOT THERE.
         CI,1     0
         BE       GUNE
         CI,1     SMUIS             IS IT LEGAL???
         BLE      CMDX              B/YES.
         PUSH     4,2               SAVE THESE FOR A WHILE.
         LW,R4    R1                USER # WE'RE LOOKING FOR
         LI,R7    LPART             SIZE OF PARTITION TABLES
         LI,R8    PLH:SID           TABLE THAT CONTAINS BATCH ID'S
         BAL,R15  LH                GO GET TABLE
         CW,R4    R1                IS ZIS IT
         BE       GUN1              GOTCHA
         BDR,R7   %-3
         PULL     4,2               NOT FOUND.
GUN1     EQU      %
         LI,R8    PLB:USR           TABLE THAT HASS USER NUMS
         BAL,R15  LB                GO GET EM
         PULL     4,2
         B        CMDX              AND RETURN TO CALLER.
         PAGE
*
*        INVALID USER # GIVEN
*
GUNE     EQU      %
BAD%USR  EQU      %
         LI,R1    BAD%USRMSG
         BAL,R0   MBB               PUT OUT MSG
         B        CMDX              AAND SCAN AGAIN
BAD%USRMSG TEXTC '**INVALID USER #'
         PAGE
*
*        LTHING IS USED TO FETCH DATA - USAGE;
*
*        ENTRY
*        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   EQU      %
         STW,R15  RET%LINK          SAVE RETURN LINK
         AI,R1    -LH               CHANGE R1 TO AN INDEX
         PUSH     4,R4              SAVE R4 THRU R7
         ANLZ,R4  INST,R1           RESOLVE ADDRESSING TYPE
         EXU      LTYPES,R1         POSITION R4 CORRECCTLY
         LW,R5    R1                HOLD ADDRESSING TYPE IN R5
         LW,R1    R4                MOVE WORD ADDRESS TO R1
         SLS,R1   -9                MAKE IT A PAGE #
         BAL,R0   GET1ADDR          GO PICK UP ONE PAGE
         AND,R4   =X'1FF'           CHANGE ADDRS TO PAGE INDEX
         AW,R15   R4                AND ADD TO WINDOW PAGE ADDRSS
         AND,R7   LMSK,R5           MASK INDEX IF NECESSARY
         EXU      INST1,R5          EXECUTE THE LOAD INSTRUCTION
         PULL     4,R4              RESTORE R4 THRU R7
         CI,R1    0                 SET CONDITIONS
         B        *RET%LINK         RETURN TO CALLER
LTYPES   EQU      %
         SLS,R4   -2                BYTE INDEXING TO WORD
         SLS,R4   -1                HALF WORD INDEXING
         NOP      %                 WORD INDEXING
         SLS,R4   1                 DLB-WORD INDEXING
INST     EQU      %
         LB,1     *8,7
         LH,1     *8,7
         LW,1     *8,7              I THINK I DETECT A PATTERN...
         LD,0     *8,7
INST1    EQU      %
         LB,1     *15,7
         LH,1     *15,7
         LW,1     *15,7
         LD,0     *15,7
LMSK     EQU      %
         DATA     3                 FOR BYTE ADDRESSING
         DATA     1                 FOR HALF-WORD INDEXING
         DATA     0                 WORD INDEXING
         DATA     0                 DLB-WORD INDEXING
         PAGE
*
*        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     15                SAVE THE LINK AND THEN
         BAL,15   SLURPO            GO EMPTY THE BUFFER
         B        CMDX              BYE......
*
*        WRITE OUT THE BUFFER- EITHER ON COMMAND, OR WHEN IT GETS FULL
*
SLURPO   EQU      %
         PUSH     2,1
         LW,2     6                 GET CHAR COUNTER
         BEZ      SLURPO1           NOTHING TO WRITE
         STW,2    PTR               SAVE CHARACTER SIZE
         BAL,0    BUFOUT            PRINT BUFFER/CLEAR IT
SLURPO1  EQU      %
         LI,R6    0                 BUFER NOW EMPTY
         PULL     2,1
         B        *15               AND EXIT
         REF      PTR,BUFOUT
*
*        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.
         PAGE
*
*
*        SLURP N,H AND R OUTPUT NUMBER IN R1 USING 10 FOR A
*        RADIX FOR SLURPN, 16 FOR A RADIX FOR SLURPH, AND THE
*        CONTENTS OF R0 FOR A RADIX FOR SLURPR. THE NUMBER OF DIGITS
*        WANTED IS IN R9. THE FIELD IS BLANK FILLED, AND THEN THE
*        REQUIRED NUMBER OF CHARACTERS ARE POKED IN. TRUNCATION MAY OCCUR,
*
SLURPR   STW,0    RADIX
         B        SLURPS
SLURPN   LI,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......
         BE       SLURPS4
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...
         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
         USECT    DATA
*
*        FIXED DATA AREA
*
WHUTECB  DATA     0                 ECB WORD FOR M:KEYIN
*
CMDBUF   EQU      UCBUF
CMDARG   DATA     0                 LENGTH, PTR TO ARGUMENT
CMD      RES      20                INDIVIDUAL COMMAND FOR PARSING
         PAGE
*        CONSTANTS IN PROCEDURE AREA
*
         USECT    CODE
BLANKS  TEXT      '    '
MWHUT    TEXTC    'HOWDY.'
MEH      TEXTC    ' EH?'
MAMBIG   TEXTC    ' WHAT?'
MQ       TEXTC    '-'
MDIG     TEXTC    'ILLEGAL DIGIT'
MRAN     TEXTC    'VALUE OUT OF RANGE'
MHUH     TEXTC    'UNREGOCNIZED VALUE'
MTL      TEXTC    'STRING TOO LONG'
MCR      DATA     X'010D0000'       A CR FOR MISC USEAGE.
*
MKEYIN   GEN,8,24 4,0
         DATA     X'F0000000'       M:KEYIN
         PZE      *1                OUT MSG IS POINTED TO BY R1
         DATA     CMDBUF,80         INPUT BUFFER AND MAX LENGTH
         DATA     WHUTECB           AND ECB TO POST.
*
ZZ1      XPSD,0   1                 SLEEP FOR 1 TIC
ZZ10     XPSD,0   10                SLEEP FOR 10 TICS
*
TYPEIT   GEN,8,24 2,0               M:TYPE TO OPERATOR
         PZE      *0
         PZE      *1                ADDR OF MSG IS IN R1.
         PAGE
*
*        HUH IS THE ENTRY POINT FOR INPUTTING FROM THE USER.
*
HUH      LI,1     MQ                QUERY MESSAVE
         LI,2     0
         STW,2    WHUTECB           CLEAR ECB
         CAL1,2   MKEYIN            HOWDY...WHATCHA WANT??
         MTW,0    WHUTECB           DONE TYPING YET??
         BE       %+3               B/YUP, GO PROCESS
         CAL1,8   ZZ1
         B        %-3
         LB,2     CMDBUF            GET BYTE COUNT
         LB,3     CMDBUF,2          LOOK AT LAST CHARACTER
         CI,3     X'15'
         BE       %+3               NASTY OLD NL......
         CI,3     X'D'
         BNE      %+3               OR NASTY OLD CR.....
         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....
         B        %+2               HOP OVER PUSH.
         PAGE
*
*        WE THINK THERE IS A COMMAND IN THE BUFFER NOW.
*
WHUT     PUSH  15
         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
         LI,6     0
         STW,6    CMDBUF            DONT DO ANY REMAINING CMDS ON LINE
         B        HUH               BUT GO GET MORE:
*
*        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
         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,2     0
         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
         LI,2     1                 IN CASE LAST DIGIT WAS ZERO....
         B        *15               BYE......
*
ARGT     LI,14    0                 STRAIGHT TEXT
         B        ARGC+1
ARGC     LI,14    1                 RETURN TEXTC
         LW,0     BLANKS
         LW,1     BLANKS
         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
*
*        LIST ALL COMMANDS
*
CLIST    PUSH  15
         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
         BOUND    8
8BLNKS  TEXT      '        '        8 BLANKS FOR SETUP AND SUCH.
16BALLS  DATA     0,0
EMSG    TEXT      'EH?'             ERROR MESSAGE...SNICKER....
DOOM1   TEXT      '-%%'             FOR 'ALL'
NOMATCHM TEXT     'PROGRAM DOES NOT MATCH SYSTEM- I QUIT!'
HEX     TEXT      '0123456789ABCDEFGHIJ'
USERSM  TEXT      '% USERS-% ONLINE, % GHOST, % BATCH AND ',;
                  '% WAITING.%'
DIS1    TEXT      '       RAD  PACK  TOTAL%'
DIS2    TEXT      'USER % % %%'
DIS3    TEXT      'SYS  % % %%'
DIS4    TEXT      'SYMB             %%'
NOBATCH TEXT      'NO BATCH JOBS RUNNING, '
BAT1    TEXT      '% BATCH ALLOWED.%'
BAT2 TEXT 'PART QID ID PC STATE ACCOUNT  APR%%'
BAT3 TEXT  '% %% % S% % % % %'
         BOUND    8                 MUST BE ON DW BOUNDARY!
BAT4    TEXT      '*LOCKED*'
UPT1    TEXT      'UP FOR % HOURS % MINUTES.%'
*
GHOSTM1 TEXT      'NO GHOSTS!'
GHOSTM2 TEXT      '  ID ACCOUNT  GHOST%'
DISPM1  TEXT      ' %,%% PRIV=%, ID=% %'
STATM1  TEXT      ' TIME UT  O  G  B  W  STORE SYMB %%%'
STATM2  TEXT      '----- -- -- -- -- -- ------ ----% ----%%'
STATM3  TEXT      ' % % % % % % % % % % % %'
TAPEM1  TEXT      'SCRATCH'         FOR TAPE DRIVE STATUS
USERM1  TEXT      ' USER ID % IS % % % % %'
USROM   TEXT      'ON LINE % %'     FOR USER COMMAND
USRGM   TEXT      '% GHOST  %%'
USRBM   TEXT      'BATCH PART % ACCT % SYSID % %%'
USERM2  TEXT      ' SIZE=% STATE=S% PRIO/B=%/%%'
USERM3  TEXT      ' ACP=%%'
USERM4  TEXT      ' APR=%%'
USERM5  TEXT      ' OV=%%'
STATETXT  TEXT    'GASPRT  C0  C1  C2  C3  C4  C5  C6  C7  C8  C9  '
        TEXT      'C10 CU  TOB TOBOIOW IOMFW   QA  QR  QRO TI  TIO '
        TEXT      'QFI ?19 ?1A ?1B ?1C ?1D NULLNSTS?20 ?21 ?22 ?23 '
CFUM1   TEXT      ' DCBS, % ACCT=% NAME=%%'
CFUM2   TEXT      'X''%''%%'        FOR PRINTING X'STUFF'......
CFUM3   TEXT      ' CFU''S IN USE, % EMPTY, % CFU''S TOTAL.%'
         USECT    DATA
RET%LINK DATA     0
*        OUTPUT BUFFER AND CONTROL WORDS FOR SLURP
*
RADIX    DATA     10                OUTPUT RADIX
ARG      RES      8                 DIGIT PREPARATION AREA
*
*        WORD FOR DISC SUMMARY AND OTHER SCRATCH.
*
TRASH    DATA     0
TRASH1   DATA     0                 MORE TRASH
TRASH2   DATA     0
*
*
*
*        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:LO              DCB TO DO OUTPUT THRU.
         BOUND    8
CFUACCT  RES      2                 FOR CFU ACCOUNT SCAN.
LITS     EQU      %
         USECT    CODE              DUMP LITS IN PROCEDURE PAGES.
         PAGE
*
*        ENQ/DEQ DELOUSING PROGRAM
*
         SREF     QT                QUEUE TABLE ADDRESS (DW)
         SREF     PFSRARM           NEXT TABLE IN CORE (KLUDGE)
         REF      M:DO              DUMP DCB
         REF      J:INTENT          INTERRUPT CONTROL ENTRY.
         REF      JB:PCW
*
*
CRAB     CNAME    0                 GRIPE ABOUT SOMETHING.
SCREAM   CNAME    1                 GRIPE LOUDER AND DIE!
MUMBLE   CNAME    2                 JUST MENTION IT IN PASSING.
         PROC
         LOCAL    CRAP              THE MESSAGE.
LF(1)    LI,R14   CRAP              ADDRESS OF THING
         LIST     0
         LI,R15   S:NUMC(AF(1))     AND THE COUNT
         DO       NAME=2
         CAL1,1   WRTLO             WRITE THRU LO FOR MUMBLE
         ELSE
         CAL1,1   WRTDO             ELSE THRU M:DO
         FIN
         DO1      NAME=1
         CAL1,9   3                 IF SCREAM, DIE RIGHT HERE.
         USECT    DATA
CRAP     EQU      %
LF(2)    TEXT     AF(1)
         USECT    CODE              BACK TO CODE CSECT
         LIST     1
         PEND
*
WRTDO    GEN,8,24 X'11',M:DO
         DATA     X'30000010'       BUF,SIZE,WAIT
         DATA     X'80000000'+R14
         DATA     X'80000000'+R15
WRTLO    GEN,8,24 X'11',M:LO
         DATA     X'30000010'
         DATA     X'80000000'+R14
         DATA     X'80000000'+R15
         PAGE
*
PCHR     CNAME    0
PTXT     CNAME    1
         PROC
LF       EQU      %
         DO       NAME=0
         LI,R2    AF(1)
         ELSE
         LOCAL    GNURR
         LI,R2    GNURR
         FIN
         LIST     0
         DO       NAME=0
         BAL,R6   PCIB
         ELSE
         BAL,R6   PTIB
         USECT    DATA
GNURR    TEXTC    AF(1)
         USECT    CODE
         FIN
         LIST     1
         PEND
*
PBLK     CNAME
         PROC
LF       EQU      %
         PUSH     6,R2              PROLOGUE FOR BLOCK PRINTING
         LIST     0
         LW,R2    R7
         BAL,R6   PHIB              THE BLOCK NUMBER
         PTXT     AF(1)             FOLLOWED BY THE BLOCK ID
         LIST     0
         BAL,R6   PWD               AND THEN THE FIRST WORD OF THE BLOCK
         LI,R2    ','
         BAL,R6   PCIB              AND A COMMA
         LIST     1
         PEND
         PAGE
*
DTC      CNAME
         PROC                       GENERATE TEXTC ON DWORD BOUND.
         BOUND    8
LF       EQU      %
         LIST     0
         TEXTC    AF(1)
         DO1      S:NUMC(AF(1))<4
         TEXT     '    '            PAD WITH BLANKS.
         LIST     1
         PEND
*
*        KEYWORDS
*
DTALL    DTC      'ALL'
DTSTEP   DTC      'STEP'
DTJOB    DTC      'JOB'
DTEXCL   DTC      'EXCL'
DTSH     DTC      'SHARE'
DTTST    DTC      'TEST'
DTNULL   DTC      'NULL'
DTRES    DTC      'RES'
DTPRG    DTC      'PURGE'
         PAGE
*
*        A RANDOM PROC TO MAKE LIFE EASIER
*
IFITS    CNAME
         PROC
LF       EQU      %
         LIST     0                 YOU DONT WANT TO SEE THIS...
         CD,CF(2) AF(1)             IF ITS THIS KEYWORD,
         BNE      %+3               B/IF ITS NOT.
         DO       AF(2)>X'1FFFF'
         LW,15    =AF(2)
         ELSE
         LI,15    AF(2)             TO DO THE RIGHT THING.
         FIN
         STS,15   AF(3)             TO SET THAT BIT IN AF(2)
         LIST     1
         PEND
         PAGE
*
*        MQT, PGMINIT
*                 IS CALLED TO MAP ONTO THE QUEUE TABLE AREA.
*        NO PARAMETERS NEEDED, RETURNS IF SUCCESSFUL, DIES IF NOT.
*
*        ENTRY FROM CMDSCN FOR INITIALIZATION
*
PGMINIT  EQU      %
MQT      EQU      %
         PSW,R15  STACK
         LI,R14   QT                IS THIS A ENQUEUE SYSTEM
         BEZ      NOTQT             NOPE
         BAL,R0   GETADDR           MAP ONTO QT TABLES
         LI,R7    PFSRARM-QT+1      CHECK SIZE
         CI,R7    512               WILL BE TOO BIG
         BG       QT%BIG            YUP
         LW,R7    JITBUF            GOT A BUFFER
         BLEZ     NO%BUFFER         NOPE
         MTW,1    INIT%OK           SEEMS TO BE OK
         BAL,R6   SNAGM             MOVE EM INTO OUR BUFFER
         NOP
         B        CMDX              RETURN FOR NEXT COMMAND
         PAGE
*
*        WE DONT HAVE A BUFFER FOR THIS COMMAND
*
NO%BUFFER EQU     %
         LI,R1    BUF%MSGR
         BAL,R0   MBB
         B        CMDX
BUF%MSGR TEXTC    '**CANT GET A PAGE TO MAP ONTO TABLES'
         PAGE
*
*        CANT LOOK AT ENQUEUE IN AN NON-ENQUEU SYSTEM
*
NOTQT    EQU      %
         LI,R1    NOTQTM
         BAL,R0   MBB
         B        CMDX              GO SCAN SOME MORE
NOTQTM   TEXTC    '** THIS SYSTEM DOES NOT CONTAIN ENQUEUE/DEQUEUE'
         PAGE
*
*        ENQUEUE TABLES ARE TOO BIG TO LATCH ONTO
*
QT%BIG   EQU      %
         LI,R1    QBIGMSG
         BAL,R0   MBB
         B        CMDX
QBIGMSG  TEXTC    '** ENQUEUE TABLES EXCEED SIZE OF ANLZ BUFFER'
         PAGE
*
*        WE FAILED TO INIT THE QT MAPPED WINDOWS
*
NO%INIT  EQU      %
         LI,R1    INIT%MSG
         BAL,R0   MBB
         B        SCANNER           CRASH OUT OF HERE
INIT%MSG TEXTC    '** YOU MUST USE INIT COMMAND BEFORE LOOKING',;
                  ' AT ENQUEUE TABLES'
         PAGE
*
*        SNAG
*                 SEE IF THE QT AREA HAS CHANGED. IF IT HAS, COPY IT
*        INTO THE VQT AREA THRU THE WQT WINDOW, AND TAKE SKIP RETURN.
*        IF NOTHING HAS CHANGED, TAKE RETURN TO BAL+1.
*
*        SNAGI COPIES THE AREA FOR INTITIALIZATION.
*
SNAG     EQU      %
         MTW,0    INIT%OK           SEE IF WE MAPPED ONTO EM OK
         BEZ      NO%INIT           NOPE
         LI,R7    PFSRARM-QT+1      LOOP COUNT
         LI,R5    0                 INDEXING W/R5
         LI,R14   QT
         BAL,R0   GETADDR           GO MAP ONTO EM
SNAG0    EQU      %
         LW,R0    *R15,R5
         CW,R0    *JITBUF,R5
         BNE      SNAGM             SOMETHING CHANGED
         AI,R5    1
         BDR,R7   SNAG0             KEEP LOOKING
         B        0,R6              RETURN NOT SKIPPING
SNAGM    EQU      %
         LI,R14   QT
         BAL,R0   GETADDR           MAP ONTO EM
         LI,R7    PFSRARM-QT+1
         LI,R5    0
         LW,R0    *R15,R5
         STW,R0   *JITBUF,R5
         AI,R5    1
         BDR,R7   %-3
         B        1,R6              SKIP BACK INDICATES CHANGES...
*
         PAGE
*
*        SNAPQ
*                 DOES AN M:SNAP OF THE QUEUE AREA.
*
SNAPQ    CAL1,8   TIMEFPT           MOVE TIME INTO PRINT BUF
         PUSH    R15
         BAL,R6   SNAG              COPY THE AREA.
         NOP      %
         LI,R1    QTAREAMSG
         BAL,R0   MBB
         LI,R14   QT                START OF TABLES
         BAL,R0   GETADDR           PICK EM UP
         LW,R8    R15               MOVE BUF ADDRS TO DUMP ROUTINE REG
         LI,R7    PFSRARM-QT+1      LENGTH OF TABLES
         BAL,R0   DUMPSOME          DUMP EM OUT
         B        CMDX              RETURN TO SCANNER
QTAREAMSG TEXTC   '** ENQUEUE/DEQUEUE TABLE AREA **'
         PAGE
*
*        ZZZ
*                 WE GO COMATOSE
*
ZZZ      EQU      %
         PSW,R15  STACK
         BAL,R5   SAVE%BRK          SAVE CURRENT BREAK ADDRESS
         CAL1,8   NEW%BRK           SET NEW BREAK CONTROL
         CAL1,8   WAIT%MAX          DO A MAX WAIT CAL
         NOP
         B        RES%BRK           RESTORE OLD BREAK ADDRS--EXIT
ZWKUP    CAL1,8   =X'06100000'      RESET BREAK COUNT
         MTW,1    ZFLG              SAY BRK HAPPENDED
         CAL1,9   5                 AND GO BACK TO WHERE WE WERE
         PAGE
*
*        WAIT
*                 WAITS FOR SOMETHING TO HAPPEN IN THE ENQUEUE
*                 TABLES...THE TIME WE WAIT MAY BE SPECIFIED
*
*
WAIT     PUSH     R15
         BAL,R15  ARGN              SEE IF INTERVAL SPECIFIED
         BNEZ     %+2               YUP
         LI,R1    20                ELSE TAKE DEFAULT
         STW,R1   ZFPT              STORE IT
         LI,R1    15                NOW LETS
         STB,R1   ZFPT              MAKE IT A WAIT FPT
         BAL,R5   SAVE%BRK          SAVE CURRENT BRK ADDRS
         CAL1,8   NEW%BRK           SET UP NEW ONE
         B        %+3               AND DUMP TABLES INITIALLY
WTLOOP   BAL,R6   SNAG              CHECK FOR CHANGE
         B        %+2               NONE YET
         BAL,R15  DUMPQ             ELSE DUMP EM
         CAL1,8   ZFPT              RETURN TO SLEEEP
         LI,R2    0
         XW,R2    ZFLG              DID WE GET AWAKENDE
         BEZ      WTLOOP            NO--SCAN ON FOR AN EVENT
RES%BRK  EQU      %
         CAL1,8   OLD%BRK           RESTORE OLD BREAK ADDRS
         B        CMDX              GO SCAN
         PAGE
*
*        GET AND SAVE CURRENT M:INT ADDRESS
*
SAVE%BRK EQU      %
         LW,R6    J:INTENT
         LI,R7    X'1FFFF'
         STS,R6   OLD%BRK           STORE IT AWAY
         LI,R2    0
         STW,R2   ZFLG              RESET BRK HAPPENED FLAG
         B        0,R5              AND RETURN
         PAGE
*
*        FREECH   DUMPS THE FREE CHAIN
*
FREECH   PUSH     R15
         BAL,R6   SNAG
         BAL,R6   PLINE
         MUMBLE   '...FREE CHAIN...'
         BAL,R6   PLINE
         LI,R2    THEAD
         BAL,R6   PTIB              PUT THAT IN BUFFER
         LI,R4    0                 STARTING INDEX
         LW,R2    *JITBUF           LOOK AT THE HEAD
         CI,R2    X'FFFF'           TO SEE IF ANYTHING IS GOING ON
         BANZ     FREEL             YUP, SOMETHING HAPPENING
         LI,R2    TDOTS             PUT IN SOME DOTS
         BAL,R6   PTIB
         LD,R2    *JITBUF,R4        GET THE PAIR
         LH,R2    R2
         BE       %+3
         LW,R4    R2
         B        %-4               SEARCH FOR THE END
         AI,R4    -1                DECREMENT IT TO GET TAIL PTR
FREEL    LD,R2    *JITBUF,R4        GET DWORD
         LH,R2    R2                THIS IS THE FLINK
         BE       FREEN             B/THE END
         BAL,R6   PHIB              PUT IN HEX
         LW,R4    R2
         LI,R2    TSEP
         BAL,R6   PTIB              PUMP THAT IN.
         B        FREEL             AND LOOP FOR A WHILE.
FREEN    LI,R2    TEND
         BAL,R6   PTIB              PUT THAT IN
         BAL,R6   PBUF              PRINT IT
         BAL,R6   PLINE             AND A BLANK LINE
         B        CMDX              RETURN TO SCANNER
         PAGE
*
*        CHECK INDEX IN R7 FOR VALIDITY
*
CHK%DX   EQU      %
         CI,R7    PFSRARM-QT+1      WILL FIT TABLE SIZE
         BG       CHK%ERR           NOPE
         CI,R7    0
         BL       CHK%ERR
         LD,R2    *JITBUF,R7        SEEMS TO BE OK TO USE
         B        *R0
*
*        INDEX IS IN ERROR
*
CHK%ERR  EQU      %
         LI,R1    XERRMSG
         BAL,R0   MBB
         B        SCANNER           BAIL OUT
XERRMSG  TEXTC    '**INVALID ENTRY FOUND IN ENQUEUE TABLES'
         PAGE
*
*        DUMPQ    DUMPS THE QT AREA IN A SEMI-INTELLIGIBLE FASHION.
*
DUMPQ    PUSH     R15
         BAL,R6   SNAG
         NOP      %
         LI,R7    0
         CAL1,8   TIMEFPT           DUMP CURRENT TIME INTO BUFFER
,DQTT    MUMBLE   ' QT HH:MM MON DD,.YY.'
         BAL,R6   PLINE
         BAL,R6   PHEAD             PRINT THE HEAD
         BAL,R6   PBUF              PRINT THAT
         LI,R2    X'FFFF'           LET'S CHECK FOR ANYTHING ON Q.
         AND,R2   *JITBUF
         BNE      DUMPQ1
DUMPQX   BAL,R6   PLINE
         PULL     R15
         B        *R15              BYE......
DUMPQ1   LW,R7    R2
*
DMQE     PTXT     '     '           A SPACER.
         BAL,R6   PQE               PRINT THE QUEUE ENTRY
         BAL,R6   PBUF              PRINT THE BUFFER
         PUSH     R7                SAVE WHERE WE ARE NOW.
         BAL,R0   CHK%DX
         LI,R7    X'FFFF'
         AND,R7   R2                MOVE TO FIRST U HEADER
         PUSH     R7                REMEMBER THAT SPOT TOO.
         PTXT     '      '          6 SPACES
         BAL,R6   PUH               PRINT U HEADER BLOCK
         BAL,R6   PBUF              DUMP BUFFER
         BAL,R0   CHK%DX
         LI,R7    X'FFFF'
         AND,R7   R2                MOVE ALONG TO SE BLOCK
DMSE     PTXT     '       '         7 SPACES
         BAL,R6   PSE               PRINT SE BLOCK
         BAL,R6   PBUF              DUMP BUFFER
         BAL,R0   CHK%DX            GET THE DOUBLEWORD
         LH,R7    R2                AND CHAIN ALONG BLINK
         BNE      DMSE              FOLLOW TO END OF SE CHAIN.
         PULL     R7                U HEADER SPOT.
         BAL,R0   CHK%DX            GET U HEADER BLOCK
         LH,R7    R2                AND GO TO UE BLOCK
DMUE     PUSH     R7
         PTXT     '      '          6 SPACES
         BAL,R6   PUE               PRINT UE BLOCK
         BAL,R6   PBUF              AND DUMP BUFFER
DMSQ     BAL,R0   CHK%DX            UE/SQ BLOCK
         LI,R7    X'FFFF'
         AND,R7   R2                MOVE ALONG FLINK
         PTXT     '       '         7 AGAIN
         BAL,R6   PSQE              PRINT SQ ENTRY
         BAL,R6   PBUF
         BAL,R0   CHK%DX            GET THE BLOCK
         CI,R2    X'FFFF'           IS THERE A FLINK???
         BANZ     DMSQ+1            B/YES.
         PULL     R7                UE BLOCK AGAIN.
         BAL,R0   CHK%DX            LOOK AT IT
         LH,R7    R2                CHECK FOR ANOTHER UE CHAIN
         BNE      DMUE              B/YUP, GO DUMP IT.
         PULL     R7                RESTORE QE POINTER.
         BAL,R0   CHK%DX
         LH,R4    R2                LOOK AT NEXT Q ENTRY
         BE       DUMPQX            NULL SEZ WE'RE ALL DONE.
         LW,R7    R4
         B        DMQE              DUMP THE NEXT ONE IN LINE..
         PAGE
*
*        PWD      PRINT BLOCK WORD AT S AS TWO HALFWORDS
*
PWD      PUSH     6,R2              SAVE R-S
         BAL,R0   CHK%DX            LOAD THE WORD
         SLD,R2   -32
         SLD,R2   16
         BAL,R6   PHIB              PRINT HALFWORD
         PCHR     ','               AND A COMMA
         LI,R2    0
         SLD,R2   16
         BAL,R6   PHIB              THE OTHER HALFWORD
         PULL     6,R2
         B        0,R6
*
*        PHEAD    PRINT THE HEAD BLOCK. EXPECTS S=0.
*
PHEAD    PBLK     ':HEAD('
         BAL,R0   CHK%DX
         LI,R2    0
         SLD,R2   16
         BAL,R6   PHIB
         PCHR     ','
         LI,R2    0
         SLD,R2   16
         BAL,R6   PHIB
PTE      PCHR     ')'               CLOSING PAREN
         PULL     6,R2
         B        0,R6              AND RETURN.
*
*        PQE      PRINT Q-ENTRY BLOCK POINTED TO BY S.
*
PQE      PBLK     ':QE('
         BAL,R6   PRN               PRINT RESOURCE NAME
         B        PTE               AND CLOSE OUT ENTRY
*
*        PUH      PRINT U-HEADER BLOCK POINTED TO BY S.
*
PUH      PBLK     ':UH('
         BAL,R0   CHK%DX
         LW,R2    R3                GET NEXT WORD
         BAL,R6   PHIB              PRINT IT
         B        PTE               AND FINISH UP
*
*        PUE      PRINT U-ENTRY BLOCK POINTED TO BY S.
*
PUE      PBLK     ':UE('
         BAL,R0   CHK%DX
         LI,R2    0
         SLD,R2   8                 BLOCK/WHATEVER
         BAL,R6   PHIB              PUT THAT AWAY
         PCHR     ','               COMMA
         LI,R2    0
         SLD,R2   16                DOCCUMENT SEZ UNUSED, SO I'LL
         BAL,R6   PHIB              PRINT IT.....
         PCHR     ','
         LI,R2    0
         SLD,R2   8                 USER #
         BAL,R6   PHIB              PRINT THAT
         B        PTE               AND FINISH UP.
*
*        PSE      PRINT S-ENTRY BLOCK POINTED TO BY S.
*
PSE      PBLK     ':SE('
         BAL,R6   PRN               PRINT RESOURCE NAME
         B        PTE               AND CLEAN UP.
*
*        PSQE     PRINT SQ-ENTRY BLOCK POINTED TO BY S.
*
PSQE     PBLK     ':SQE('
         BAL,R0   CHK%DX
         LI,R2    0
         SLD,R2   16
         BAL,R6   PHIB
         PCHR     ','
         LB,R4    R3                FLAGS
         CI,R4    X'80'
         BAZ      PSQE1
         PTXT     'QECB,'
PSQE1    CI,R4    X'40'
         BAZ      PSQE2
         PTXT     'ALLOC,'
PSQE2    CI,R4    X'20'
         BAZ      PSQE3
         PTXT     'NOWAIT,'
PSQE3    CI,R4    X'10'
         BAZ      PSQE4
         PTXT     'ZZZ,'
PSQE4    CI,R4    8
         BAZ      PSQE5
         PTXT     'BLOCK,'
PSQE5    CI,R4    4
         BAZ      PSQE6
         PTXT     'JOB,'
PSQE6    CI,R4    2
         BAZ      PSQE7
         PTXT     'SHARE,'
PSQE7    CI,R4    1
         BAZ      PSQE8
         PTXT     'UPGRADE,'
PSQE8    SLD,R2   8
         LI,R2    0
         SLD,R2   8
         BAL,R6   PHIB
         B        PTE
*
*        PQECB    PRINT QECB ENTRY POINTED TO BY S.
*
PQECB    PBLK     ':QECB('
         BAL,R0   CHK%DX
         LW,R2    R3
         BAL,R6   PHIB              PRINT THE ADDRESS
         B        PTE               AND CLEAN UP.
*
*        PRN      PRINT RESOURCE NAME POINTED TO BY S.
*
PRN      PUSH     6,R2              STACK GETTING MIGHTY BIG....
         BAL,R0   CHK%DX            GET IT
         LW,R2    R3                THE SECOND WORD IS WHAT WE WANT
         BL       PRNI              HORSE OF ANOTHER COLOUR.....
         BE       PTE+2             SCRAM IF ZERO....
         LB,R4   R2
         CI,R4    X'7F'             DOES IT SAY ALL????
         BNE      PRN1              B/NOPE
         PTXT     'ALL'
         B        PTE+2
PRN1     CI,R4    X'40'             HOW ABOUT NULL????
         BNE      PRN2
         PTXT     'NULL'
         B        PTE+2             SAY NULL IF SO.
PRNI     AND,R2   =X'7FFFFFFF'      TURN OFF INDIRECT BIT
         SLS,R2   -2                BA => WA
         AI,R2    -QT               RELATIVE DISP FROM BASE OF QT
         AW,R2    JITBUF            ADD ADDRESS OF OUR BUFFER
         LB,R5    *R2               GET THE BYTE COUNT...
         LW,R6    R2                SAVE WORD ADDRESS OF THING.
         LW,R3    R2                KEEP IT HERE TOO.
         B        PRN20
PRN2     LW,R3    R7                DWORD INDEX
         SLS,R3   1                 MAKE WORD INDEX
         AW,R3    JITBUF            ADD BUFFER WINDOW ADDRESS
         LB,R5    *R3               GET THE BYTE COUNT
         LW,R6    R3                SAVE THE WORD ADDRESS
PRN20    SLS,R3   2                 MAKE THAT MESS A BYTE ADDRESS
         AI,R3    1                 AND POINT OVER THE COUNT BYTE.
         LI,R2    BA(TRNTB)         TRANSLATE TABLE
         LI,R4    X'F'
         STB,R4   R2                POKE IN MASK
         STB,R5   R3                POKE IN COUNT
         TTBS,R2  0                 CHECK FOR UNPRINTABLE CHARACTERS
         BCS,1    PRN3              FOUND ONE. PRINT THING IN HEX.
         LW,R2    R6                REMEMBER WHERE THAT TEXTC WAS??
         BAL,R6   PTIB              PUT TEXTC IN BUFFER
         B        PTE+2             AND SPLIT.
PRN3     LW,R4    R6                SAVE THE TEXTC WORD ADDRESS
         PCHR     'X'
         LI,R2    X'7D'             QUOTE MARK
         BAL,R6   PCIB
         SLS,R4   2                 MAKE BYTE VALUE
         AI,R4    1                 POINT PAST COUNT BYTE.
         LB,R2    0,R4              GET A BYTE
         BAL,R6   PHIB              PUT IN BUFFER
         AI,R4    1                 NEXT BYTE
         BDR,R5   %-3               ALL BYTES IN TEXTC FORMAT
         LI,R2    X'7D'
         BAL,R6   PCIB              CLOSING QUOTE
         B        PTE+2             AND SPLIT.
         PAGE
*
*        BUF
*                 THE OUTPUT BUFFER AND ITS ASSOCIATED MANAGEMENT CODE
*
         USECT    DATA
PLATEN   DATA     72                PLATEN SIZE
OBP      DATA     0                 BUFFER POINTER/COUNT
BUF      RES      40                AND THE BUFFER
         USECT    CODE
*
*        PBUF     IS CALLED TO PRINT THE BUFFER (THRU M:LO)
*
PBUF     LI,R14   BUF               THE BUFFER
         LI,R15   0
         XW,R15   OBP               FETCH AND CLEAR COUNT
         BLE      %+2
         CAL1,1   WRTLO             DO THE WRITE
         B        0,R6              AND RETURN.
*
*        PCIB     PUTS THE CHARACTER IN R INTO THE BUFFER
*
PCIB     PUSH     R3
         LW,R3    OBP
         CW,R3    PLATEN            HAVE WE BLOWN IT YET??
         BL       %+5
         PUSH     R6
         BAL,R6   PBUF              PRINT THE THING
         PULL     R6
         LW,R3    OBP
         STB,R2   BUF,R3
         MTW,1    OBP
         PULL     R3
         B        0,R6              RETURN
         PAGE
*
*        PHIB     PUT HEX NUMBER IN R IN THE BUFFER
*
PHIB     PUSH     5,R2              R-S
         LW,R4    PLATEN
         SW,R4    OBP               # POSITIONS LEFT IN BUFFER
         LI,R5    0
         CI,R2    X'FFFF'
         BG       %+8
         CI,R2    X'FFF'
         BG       %+7
         CI,R2    X'FF'
         BG       %+6
         CI,R2    X'F'
         BG       %+5
         B        %+5
         AI,R5    1
         AI,R5    1
         AI,R5    1
         AI,R5    1
         AI,R5    1
         CW,R5    R4                BIGGER THAN REMAINING ROOM??
         BLE      %+2
         BAL,R6   PBUF              IF SO, PRINT BUFFER.
         LI,R5    8                 # OF NIBBLES
         SLD,R2   -32               MOVE IT OVER, CLEARING R
         SLD,R2   4                 GIMMIE A NIBBLE
         CI,R2    0
         BNE      PHIB1             WE GOT ONE.
         BDR,R5   %-3
PHIB1    LB,R2    HEX,R2            GET CHR
         BAL,R6   PCIB              AND PUT AWAY
         LI,R2    0
         SLD,R2   4                 GET NEXT NIBBLE
         BDR,R5   PHIB1             AND POKE THAT AWAY.
         PULL     5,R2              RESTORE ENVIRONMENT
         B        0,R6              AND GOODBYE.
*
*        PLINE    PRINTS A BLANK LINE.
*
PLINE    MUMBLE   '    '
         B        0,R6              PRETTY SIMPLE......
*
*        PTIB     PUT TEXTC POINTED TO BY R IN BUFFER
*
PTIB     PUSH     4,R2
         PUSH     R6
         LW,R5    R2
         LB,R4    *R5               GET THE BYTE COUNT
         LI,R3    1                 AND THE STARTING GIZZIE.
         LB,R2    *R5,R3            FETCH A BYTE
         BAL,R6   PCIB              POKE INTO BUFFER
         AI,R3    1
         BDR,R4   %-3               AND COPY THE WHOLE THING.
         PULL     R6
         PULL     4,R2
         B        0,R6              RETURN TO CALLER.
*
*        THIS MUST BE AT THE END.
*
         DEF      CMDTL,CMDTXT,CMDTV
         USECT    CODE
         PAGE
*
THEAD    TEXTC    ' HEAD > '
TSEP     TEXTC    ' > '
TDOTS    TEXTC    '... '            AND SO ON...
TEND     TEXTC    'TAIL'
*
*        TTBS TABLE FOR DETECTING NON-PRINTING CHARACTERS
*
TRNTB    EQU      %
         LIST     0
         TEXT     '11111111111111111111111111111111'
         TEXT     '11111111111111111111111111111111'
         TEXT     '01111111111000000111111111000001'
         TEXT     '00111111111001011111111111000000'
         TEXT     '11111111111111111111111111111111'
         TEXT     '11111111111111111111111111111111'
         TEXT     '10000000001111111000000000111111'
         TEXT     '11000000001111110000000000111111'
         LIST     1
         USECT    DATA
*
*        ZFLG
         BOUND    8
*                 IS NON-ZERO IF WE HAVE BEEN INTERRUPTED.
*
ZFLG     DATA     0
*
*        A SLEEP FPT (M:WAIT) IS BUILT HERE.
*
ZFPT     DATA     0
*
OLD%BRK  LPSD,0   0
NEW%BRK  LPSD,0   ZWKUP
WAIT%MAX XPSD,0   X'FFFF'
*
TIMEFPT  GEN,8,24 X'10',DQTT+1
INIT%OK  DATA     0
         USECT    CODE              DUMP LITS IN PROC PAGES
         END      SNOOP

