         PCC      0
***** S U P E R 2 *****
*
* THIS IS THE SECOND OF THE THREE MODULES COMPRISING SUPER.
*
* HEREIN IS THE CODE FOR PROCESSING OPTIONS RELATING TO
* REMOTE WORKSTATION MANAGEMENT AND CODE ADDED
* FOR CP-V/A00 (GENERALIZED RESOURCE MANAGEMENT)
*
* IN JULY 1974, CONNECTORS WERE ADDED TO IMPLEMENT SOME
* NEW OPTIONS REQUIRED IN CPV-C00.  THESE ARE DOCEMENTED
* IN SUPER3.
*
***********************************************************
*
*        RICK SINATRA, MARCH 1973
         SPACE
*        THE FOLLOWING LOAD CONTROL CARDS ARE USED TO
*        FORM THE TEST VERSION OF SUPER
         SPACE
*!LOAD (LMN,SUPER),(PERM),(ABS),(NOSYSLIB),;
*! (MAP),;
*! (BIAS,C000),(NOTCB),(SL,F),(EF,;
*  (SUPER1BO),(SUPER2BO),(SUPER3BO),;
*! (SG:PNT,:SYS),(SG:RNT,:SYS),(SG:OPNM,:SYS),(SG:LNT,:SYS),(:J0,:SYS))
         SPACE
         PAGE
PROCEDURE  CSECT       1
         SPACE
         SYSTEM   SIG7
         SYSTEM   BPM
         SPACE
*        TWELVE SETS OF TABLES REGULATE INTERPRETATION
*        AND PLACEMENT OF SUPER COMMANDS RELATING TO
*        THE 'W' OPTION (WORKSTATION).
         SPACE
LISTOPT  EQU      1                 1=LIST PROCS, 0=DON'T
EXITC    CNAME
         PROC
EX%R     EQU      AF(1)
         BOUND    8
EX%D     DATA     EX%B
         GEN,1,15,1,15  0,AF(2),0,0
EX%D2    GEN,1,15,1,15  0,AF(2),0,0 TO RESET
EX%B     RES      AF(2)
         PEND
         SPACE
CALL     CNAME
         PROC
LF       BAL,EX%R AF
         PEND
         SPACE
ENTER    CNAME
         PROC
LF       PSW,EX%R EX%D
         PEND
         SPACE
RETURN   CNAME
         PROC
LF       PLW,EX%R EX%D
         LIST     LISTOPT
         DO       AF(1)>1
         AI,EX%R  AF(1)-1
         FIN
         B        *EX%R
         LIST     1
         PEND
         SPACE
*        PROC FOR RESETTING EXIT CONTROL
         SPACE
EXITCR   CNAME
         PROC
         LIST     LISTOPT
LF       LI,AF    EX%B
         STW,AF   EX%D
         LW,AF    EX%D2
         STW,AF   EX%D+1
         LIST     1
         PEND
         SPACE
ZERO     CNAME
         PROC
         LIST     LISTOPT
         BOUND    4
LF       EQU      %
         DO1      AF(1)
         DATA     0
         LIST     1
         PEND
NAME     CNAME
         PROC
ZZ       SET      S:UT(AF)
LF       GEN,8,8,16 ZZ(1),ZZ(2),0
         PEND
         TITLE
*        TABLE SEARCHING PROC
         SPACE
*        SEARCH,S TABLE,LENGTH,NAME,INDEXREG,WORKREG,ZEROALSO
*        NOT FOUND
*        FOUND
*        S=1 BYTE,  S=2 HW,  S=3 W
         SPACE
SEARCH   CNAME
         PROC
         LIST     LISTOPT
         LOCAL    LOOP,L
LF       LW,AF(5) AF(3)
         LW,AF(4) AF(2)
         BLEZ     L
         DO       CF(2)=1
LOOP     CB,AF(5) AF(1),AF(4)
         FIN
         DO       CF(2)=2
LOOP     CH,AF(5) AF(1),AF(4)
         FIN
         DO       CF(2)=3
LOOP     CW,AF(5) AF(1),AF(4)
         FIN
         DO       AF(6)
         BE       %+5
         ELSE
         BE       %+3
         FIN
         BDR,AF(4) LOOP
L        EQU      %
         DO       AF(6)             IF INDEX 0 INCLUDED
         MTW,0    AF(4)
         BEZ      LOOP
         FIN
         LOCAL
         LIST     1
         PEND
         PAGE
LOCK     CNAME    1
UNLOCK   CNAME    0
         PROC
         LIST     LISTOPT
         LI,R     NAME
I        DO       NUM(AF)
         LI,R1    AF(I)
         STB,R    LOCKS,R1
         FIN
         LIST     1
         PEND
         SPACE    3
FILL     CNAME
         PROC
         LIST     LISTOPT
         LOCAL    LOOP
LF       LI,R1    AF(2)
         LI,R     AF(4)
         DO       CF(2)=1
LOOP     STB,R    AF(1),R1
         FIN
         DO       CF(2)=2
LOOP     STH,R    AF(1),R1
         FIN
         DO       CF(2)=3
LOOP     STW,R    AF(1),R1
         FIN
         AI,R1    1
         CI,R1    AF(3)
         BLE      LOOP
         LOCAL
         LIST     1
         PEND
         PAGE
SAVE     CNAME    0
RESTORE  CNAME    1
         PROC
         LIST     LISTOPT
LF       LCI      0
         DO       NAME=0
         STM,0    AF(1)
         ELSE
         LM,0     AF(1)
         FIN
         LIST     1
         PEND
         SPACE
JUSTDO   CNAME    1
GO       CNAME    0
         PROC
         LIST     LISTOPT
         LOCAL    LIST,DONE
LF       LW,R1    CF(2)
         EXU      LIST,R1
         DO       NAME=1
         B        DONE
         FIN
LIST     EQU      %
I        DO       NUM(AF)
         DO       NAME=1
         EXU      AF(I)
         ELSE
         B        AF(I)
         FIN
         FIN
DONE     EQU      %
         LOCAL
         LIST     1
         PEND
RESET    CNAME
         PROC
         LIST     LISTOPT
LF       OR,CF(2) AF
         EOR,CF(2) AF
         LIST     1
         PEND
         PAGE
NONE     EQU      0
STRING   EQU      1
HEX      EQU      2
DEC      EQU      3
YES      EQU      1
NO       EQU      0
DUMMY    EQU      0                 TO FILL INDEX=0
SLAVE    EQU      1
MASTER   EQU      2
IN       EQU      1
OUT      EQU      2
ON       EQU      -1
OFF      EQU      0
IRBT     EQU      3
IRBT2780 EQU      4
MSTX     EQU      5                 KWX OF MST
OUTX     EQU      22                KWX OF OUT
INX      EQU      17                KWX OF IN
         SPACE    2
VM1      EQU      2
R,R0     EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6,KWX   EQU      6
R7,DX    EQU      7                 DEVICE INDEX
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
NORMAL   EQU      1
WFLAG    EQU      2
DFLAG    EQU      3
         PAGE
*        DEFAULT :RBLOG RECORD FOR TYPE=IRBT
         SPACE
DIRBT    DATA     0                 RBID
         DATA     X'02000000'       R:FLAG IRBT,MASTER,NXP1,
         DATA     0,0      RD:WSN          NSYS
         DATA     X'07000000'       RB:RP
         DATA     400               R:BUF
         TEXT     '        '        8 BLANKS
         DATA     X'0F000000'       RB:DSM,R:RMT
         DATA     0                 R:INRCB
         DATA     -1                R:HSX
         DATA     0                 R:OUTRCB
         ZERO     72                FILL OUT WITH ZEROS
         PAGE
         SPACE
*        DEFAULT :RBLOG RECORD FOR TYPE=7670
         SPACE
D7670    DATA     0,0,0,0           FIRST 4 SET BY SUPER
         DATA     X'07000000'
D:BUF    DATA     0
DD:WSN   TEXT     '        '        8 BLANKS
DB:DMS   EQU      %                 FROM R:BUF ON
D:RMT    GEN,8,24   X'FF',0         ----------------------------
D:INRCB  DATA     0
D:HSX    DATA     2
D:OUTRCB DATA     6
DH:DEV   EQU      %
         DATA,2   C'LP'
         DATA,2   C'CP'
         DATA,2   C'CR'
         DATA,2   0
         ZERO     6
DB:RCB     EQU    %
         DATA     X'06050400'
         ZERO     4
DH:F1    EQU      %
         DATA     X'00010000'
         ZERO     6
DH:F2    EQU      %
         DATA     X'11532210'
         DATA     X'02200000'
         ZERO     6
DH:SUS   ZERO     8
DB:MAX   EQU      %
         DATA     X'80505000'
         ZERO     3
DB:MIN   EQU      %
         DATA     X'27500100'
         ZERO     3
DB:PRIV  EQU      %
         DATA     X'40404000'
         ZERO     3
DB:TYPX  ZERO     4
         ZERO     20                FILL OUT WITH ZEROS
ND7670   EQU      WA(%)-WA(D7670)-1
         PAGE
*        DEFAULT RBLOG RECORD USED FOR TYPE=STND
         SPACE
*(AS THOUGH USER HAD ENTERED THE FOLLOWING OPTIONS)
         SPACE
*        TYPE=IRBT
*        DEV=OC;RCB=91;IRCB=92;SMD;SUS=40
*        DEV=CR;IN;RCB=93
*        DEV=LP;RCB=94;SUS=800;SRCB=P;LIST=S
*        DEV=CP;RCB=95;SUS=1;LIST=P
         SPACE
*        THE DEFUALT RECORD BEGINS AT :RBLOG+4 WITH:
         SPACE
STDRBRP  DATA     X'7000000'
         DATA     X'190'
         TEXT     '        '        RD:RWSN BLANKS
         DATA     X'0F000000'       RB:DSM
         DATA     X'92'             R:INRCB
         DATA     X'3'              R:HSX 4 DEVICES
         DATA     X'91'             R:OUTRCB
         TEXT     'OCCRLPCP'        RH:DEV
         DATA     0,0,0,0,0,0
         DATA     X'91939495'       RB:RCB
         DATA     0,0,0
         DATA     X'800A0009'       RH:F1
         DATA     X'80048008'       RH:F1
         DATA     0,0,0,0,0,0
         DATA     X'82100220'       RH:F2
         DATA     X'11512210'       RH:F2
         DATA     0,0,0,0,0,0
         DATA     X'00400000'       RH:SUS
         DATA     X'08000001'       RH:SUS
         DATA     0,0,0,0,0,0
         DATA     X'50508450'       RB:MAX
         DATA     0,0,0
         DATA     X'01012601'       RB:MIN
         DATA     0,0,0
         DATA     X'40404040'       RB:PRIV
         DATA     0,0,0,0,0,0,0
         ZERO     20                ZERO OUT REMAINDER OF REC
         TITLE    'MENU FOR :RBLOG RECORD'
         SPACE    2
RBLOG    EQU      INBUFF
RB:RBID  EQU      RBLOG+0    ID OF THIS WSN IN BYTE ZERO
R:FLAG   EQU      RBLOG+1    FLAG WORD (IRBT,SYS,SLV,XP1)
RD:WSN   EQU      RBLOG+2    DW WORK STATION NAME
RB:RP    EQU      RBLOG+4    MAX PRIORITY BYTE ZERO
R:BUF    EQU      RBLOG+5    MAX BYTES IN BLOCK THIS WORK STA
RD:RWSN  EQU      RBLOG+6    DW REMOTE WORK STA NAME
R:RMT    EQU      RBLOG+8    RMT NUMBER
RB:DSM   EQU      RBLOG+8           DSM MASK, BYTE 0
R:INRCB  EQU      RBLOG+9    OC INPUT RCB OR ZERO
R:HSX    EQU      RBLOG+10   HIGHEST DEVICE INDEX SO FAR
R:OUTRCB EQU      RBLOG+11   SMD OUTPUT RCB
RH:DEV   EQU      RBLOG+12   16*HW DEVICE NAME TABLE
RB:RCB   EQU      RBLOG+20   16*BY RCB TABLE
RH:F1    EQU      RBLOG+24   16*HW FLAG1 TABLE
RH:F2    EQU      RBLOG+32   16*HW FLAG2 TABLE
RH:SUS   EQU      RBLOG+40   16*HW SUSBIT TABLE
RB:MAX   EQU      RBLOG+48   16*BY MAXIMUM REC SIZE TABLE
RB:MIN   EQU      RBLOG+52   16*BY MINIMUM REC SIZE TABLE
RB:PRIV  EQU      RBLOG+56   16*BY PRIV. TABLE
RB:TYPX  EQU      RBLOG+60   16*BY TYPE INDEX OC OPTION
RD:GHOST EQU      RBLOG+64   TEXTC NAME OF GHOST
         PAGE
         SPACE
*        EXTERNAL TABLE NAMES
         SPACE
         DEF      WMOD,WOPTIONS
         DEF      WOPTCOUNT
         DEF      RCBTEST,WHK
         DEF      WVERIFY
         DEF      DEF7670
         DEF      LISTRB
         DEF      FL:ALL,FL:PL,FL:XO,FL:SE
         DEF      PRINTL,UDONE,LL
         SPACE    2
         REF      KWXI,LENGTH,PAS,CLL3,XACCT3
         REF      MCTEST,MCGEN,MCMSG
         REF      HEX2BIN,BCD2BIN
         REF      ERVALU9
         REF      ERVALU82,TMORE,INBUFF
         REF      M:LO,SH:RNM,SL:NAME,SV:LIM,SV:RSIZ
         REF      OH:NM,SH:SYMT,SV:FTYM,TYPMNSZ
         REF      RM4,BLK2,J:JIT,READ3
         REF      BIN2BCD,BIN2HEX,M:UC
         REF      CMOPPT,NAME,CMNDBUF,RMERRMES
         REF      DRET3,MRET3
         REF      MOREPRINT,XOROUT,PMROUT,RPROUT
         REF      SEROUT
         SPACE
         DEF      UMOD,UOPTIONS,UOPTCOUNT
         DEF      LOPTS,NLOPTS,LFLAGS,PRNTRT
         DEF      LINIT,GETN
         TITLE
*        LIST OF LEGAL KEY WORDS
         SPACE
WOPTIONS DATA     DUMMY
         NAME      'TYPE     '      OPTION NAMES MUST
         NAME      'DEVICE   '      BE UNIQUE IN FIRST
         NAME      'IRCB     '      TWO CHARACTERS
         NAME      'PRIV     '
         NAME      'BUFF     '      WARNING: ADD NEW OPTIONS
         NAME      'MSTER    '      AT END OF LIST. MAKE SURE
         NAME      'SLAVE    '      ALL TWELVE TABLES ARE MODIFIED
         NAME      'RMT      '      TOGETHER FOR NEW OPTIONS
         NAME      'RWSN     '
         NAME      'X1       '
         NAME      'NX       '
         NAME      'X2       '
         NAME      'N2       '
         NAME      'RCB      '
         NAME      'SRCB     '
         NAME      'MAXREC   '
         NAME      'MINREC   '
         NAME      'DIRECT   '
         NAME      'NDIRECT  '
         NAME      'IN       '
         NAME      'SUSBIT   '
         NAME      'CTL      '
         NAME      'NCTL     '
         NAME      'DC       '
         NAME      'OUT      '
         NAME      'LIST     '
         NAME      'SMD      '
         NAME      'NSMD     '
         NAME      'BINARY   '
         NAME      'NBINARY  '
         NAME      'TRP      '
         NAME      'NTRP     '
         NAME      'SYSTEM   '
         NAME      'NSYSTEM  '
         NAME      'RP       '
         NAME      'DSM      '
         NAME      'DD       '      DELETE DEVICE
         NAME      'LW       '      LIST WORK STATION
         NAME      'MRB      '
         NAME      'NMRB     '
         NAME      'GJOB     '
         NAME      'MCP      '
         NAME      'MLP      '
         NAME      'EM       '
         NAME      'NEM      '
         NAME      'LPP      '
         NAME      'KEEP     '      KEEP SYMB FILE
NWOPTIONS EQU     WA(%)-WA(WOPTIONS)-1
         PAGE
*        OPTION INDICES             THIS TABLE COMPRISES EACH
XTYPE    EQU      1                 OPTION NAME PRECEDED WITH
XDEV     EQU      2                 AN 'X', AND IS CONSECUTIVE
XIRCB    EQU      3
XPRIV    EQU      4
XBUF     EQU      5
XMST     EQU      6
XSLV     EQU      7
XRMT     EQU      8
XRWSN    EQU      9
XX1      EQU      10
XN1      EQU      11
XX2      EQU      12
XN2      EQU      13
XRCB     EQU      14
XSRCB    EQU      15
XMAXREC  EQU      16
XMINREC  EQU      17
XDIR     EQU      18
XNDIR    EQU      19
XIN      EQU      20
XSUSBIT  EQU      21
XCTL     EQU      22
XNCTL    EQU      23
XDC      EQU      24
XOUT     EQU      25
XLIST    EQU      26
XSMD     EQU      27
XNSMD    EQU      28
XBIN     EQU      29
XNBIN    EQU      30
XTRP     EQU      31
XNTRP    EQU      32
XSYS     EQU      33
XNSYS    EQU      34
XRP      EQU      35
XDSM     EQU      36
XDD      EQU      37
XLW      EQU      38
XMRB     EQU      39
XNMRB    EQU      40
XGJOB    EQU      41
XMCP     EQU      42
XMLP     EQU      43
XEM      EQU      44
XNEM     EQU      45
XLPP     EQU      46
XKEEP    EQU      47
         TITLE    'TYPE DEPENDANCE TABLE'
         SPACE
*        TYPE CODES: IRBT=1,2780=2,7670=4
*        SHOWS WHICH OPTIONS ARE LEGAL FOR EACH TYP
         BOUND    4
TYP      DATA,1   DUMMY
         DATA,1   7                 TYPE
         DATA,1   1                 DEV
         DATA,1   1                 IRCB
         DATA,1   1                 PRIV
         DATA,1   1                 BUF
         DATA,1   1                 MST
         DATA,1   1                 SLV
         DATA,1   1                 RMT
         DATA,1   1                 RWSN
         DATA,1   1                 X1
         DATA,1   1                 N1
         DATA,1   1                 X2
         DATA,1   1                 N2
         DATA,1   1                 RCB
         DATA,1   1                 SRCB
         DATA,1   1                 MAXREC
         DATA,1   1                 MINREC
         DATA,1   1                 DIR
         DATA,1   1                 NDIR
         DATA,1   1                 IN
         DATA,1   1                 SUSBIT
         DATA,1   1                 CTL
         DATA,1   1                 NCTL
         DATA,1   1                 DC
         DATA,1   1                 OUT
         DATA,1   1                 LIST
         DATA,1   1                 SMD
         DATA,1   1                 NSMD
         DATA,1   1                 BIN
         DATA,1   1                 NBIN
         DATA,1   7                 TRP
         DATA,1   7                 NTRP
         DATA,1   7                 SYS
         DATA,1   7                 NSYS
         DATA,1   7                 RP
         DATA,1   1                 DSM
         DATA,1   1                 DELETE DEV
         DATA,1   7                 LW
         DATA,1   2                 MRB
         DATA,1   2                 NMRB
         DATA,1   7                 GJOB
         DATA,1   6                 MCP
         DATA,1   6                 MLP
         DATA,1   6                 EM
         DATA,1   6                 NEM
         DATA,1   6                 LPP
         DATA,1   1                 KEEP
         TITLE    'DEVICE DEPENDANCE TABLE'
         SPACE
*        'YES' IF A DEVICE MUST BE SPECIFIED BEFORE
*        A PARTICULAR OPTION IS LEGAL
         SPACE
         BOUND    4
DEV      DATA,1   DUMMY
         DATA,1   NO                TYPE
         DATA,1   NO                DEV
         DATA,1   YES               IRCB
         DATA,1   YES               PRIV
         DATA,1   NO                BUF
         DATA,1   NO                MST
         DATA,1   NO                SLV
         DATA,1   NO                RMT
         DATA,1   NO                RWSN
         DATA,1   NO                X1
         DATA,1   NO                N1
         DATA,1   NO                X2
         DATA,1   NO                N2
         DATA,1   YES               RCB
         DATA,1   YES               SRCB
         DATA,1   YES               MAXREC
         DATA,1   YES               MINREC
         DATA,1   YES               DIR
         DATA,1   YES               NDIR
         DATA,1   YES               IN
         DATA,1   YES               SUSBIT
         DATA,1   YES               CTL
         DATA,1   YES               NCTL
         DATA,1   YES               DC
         DATA,1   YES               OUT
         DATA,1   YES               LIST
         DATA,1   YES               SMD
         DATA,1   YES               NSMD
         DATA,1   YES               BIN
         DATA,1   YES               NBIN
         DATA,1   NO                TRP
         DATA,1   NO                NTRP
         DATA,1   NO                SYS
         DATA,1   NO                NSYS
         DATA,1   NO                RP
         DATA,1   NO                DSM
         DATA,1   NO                DELETE DEV
         DATA,1   NO                LW
         DATA,1   NO                MRB
         DATA,1   NO                NMRB
         DATA,1   NO                GJOB
         DATA,1   NO                MCP
         DATA,1   NO                MLP
         DATA,1   NO                EM
         DATA,1   NO                NEM
         DATA,1   NO                LPP
         DATA,1   YES               KEEP
         TITLE    'CONVERSION MODE'
         BOUND    4
CMODE    DATA,1   DUMMY
         DATA,1   STRING            TYPE
         DATA,1   STRING            DEV
         DATA,1   HEX               IRCB
         DATA,1   HEX               PRIV
         DATA,1   DEC               BUF
         DATA,1   NONE              MST
         DATA,1   NONE              SLV
         DATA,1   STRING            RMT
         DATA,1   STRING            RWSN
         DATA,1   NONE              X1
         DATA,1   NONE              N1
         DATA,1   NONE              X2
         DATA,1   NONE              N2
         DATA,1   HEX               RCB
         DATA,1   STRING            SRCB
         DATA,1   DEC               MAXREC
         DATA,1   DEC               MINREC
         DATA,1   NONE              DIR
         DATA,1   NONE              NDIR
         DATA,1   NONE              IN
         DATA,1   HEX               SUSBIT
         DATA,1   NONE              CTL
         DATA,1   NONE              NCTL
         DATA,1   STRING            DC
         DATA,1   NONE              OUT
         DATA,1   STRING            LIST
         DATA,1   NONE              SMD
         DATA,1   NONE              NSMD
         DATA,1   NONE              BIN
         DATA,1   NONE              NBIN
         DATA,1   NONE              TRP
         DATA,1   NONE              NTRP
         DATA,1   NONE              SYS
         DATA,1   NONE              NSYS
         DATA,1   HEX               RP
         DATA,1   HEX               DSM
         DATA,1   STRING            DELETE DEV
         DATA,1   STRING            LW (OPTIONAL '=ALL')
         DATA,1   NONE              MRB
         DATA,1   NONE              NMRB
         DATA,1   STRING            GJOB
         DATA,1   DEC               MCP
         DATA,1   DEC               MLP
         DATA,1   NONE              EM
         DATA,1   NONE              NEM
         DATA,1   DEC               LPP
         DATA,1   NONE              KEEP
         TITLE    'MINIMUM VALUE'
         BOUND    4
MIN      DATA     DUMMY
         DATA     4                 TYPE
         DATA     2                 DEV
         DATA     0                 IRCB
         DATA     0                 PRIV
         DATA     1                 BUF
         DATA     0                 MST
         DATA     0                 SLV
         DATA     1                 RMT
         DATA     1                 RWSN
         DATA     0                 X1
         DATA     0                 N1
         DATA     0                 X2
         DATA     0                 N2
         DATA     1                 RCB
         DATA     1                 SRCB
         DATA     1                 MAXREC
         DATA     1                 MINREC
         DATA     0                 DIR
         DATA     0                 NDIR
         DATA     0                 IN
         DATA     1                 SUSBIT
         DATA     0                 CTL
         DATA     0                 NCTL
         DATA     2                 DC
         DATA     0                 OUT
         DATA     1                 LIST
         DATA     0                 SMD
         DATA     0                 NSMD
         DATA     0                 BIN
         DATA     0                 NBIN
         DATA     0                 TRP
         DATA     0                 NTRP
         DATA     0                 SYS
         DATA     0                 NSYS
         DATA     0                 RP
         DATA     1                 DSM
         DATA     2                 DELETE DEV
         DATA     0                 LIST WORK STATION
         DATA     0                 MRB
         DATA     0                 NMRB
         DATA     1                 GJOB
         DATA     1                 MCP
         DATA     1                 MLP
         DATA     0                 EM
         DATA     0                 NEM
         DATA     1                 LPP
         DATA     0                 KEEP
         TITLE    'MAXIMUM VALUE'
         BOUND    4
MAX      DATA     DUMMY
         DATA     4                 TYPE
         DATA     2                 DEV
         DATA     X'FF'             IRCB
         DATA     X'FF'             PRIV
         DATA     400               BUF
         DATA     0                 MST
         DATA     0                 SLV
         DATA     2                 RMT
         DATA     8                 RWSN
         DATA     0                 X1
         DATA     0                 N1
         DATA     0                 X2
         DATA     0                 N2
         DATA     X'FF'             RCB
         DATA     1                 SRCB
         DATA     255               MAXREC
         DATA     255               MINREC
         DATA     0                 DIR
         DATA     0                 NDIR
         DATA     0                 IN
         DATA     X'FFFF'           SUSBIT
         DATA     0                 CTL
         DATA     0                 NCTL
         DATA     2                 DC
         DATA     0                 OUT
         DATA     1                 LIST
         DATA     0                 SMD
         DATA     0                 NSMD
         DATA     0                 BIN
         DATA     0                 NBIN
         DATA     0                 TRP
         DATA     0                 NTRP
         DATA     0                 SYS
         DATA     0                 NSYS
         DATA     X'FF'             RP
         DATA     X'FF'             DSM
         DATA     2                 DELETE DEV
         DATA     3                 LW
         DATA     0                 MRB
         DATA     0                 NMRB
         DATA     7                 GJOB
         DATA     255               MCP
         DATA     255               MLP
         DATA     0                 EM
         DATA     0                 NEM
         DATA     255               LPP
         DATA     0                 KEEP
         TITLE    'ACCESS MASKS'
         SPACE
MASK     DATA     DUMMY
         DATA     NONE              TYPE
         DATA     NONE              DEV
         DATA     NONE              IRCB
         DATA     NONE              PRIV
         DATA     NONE              BUF
         DATA     X'01000000'       MST
         DATA     X'01000000'       SLV
         DATA     NONE              RMT
         DATA     NONE              RWSN
         DATA     X'00400000'       X1
         DATA     X'00400000'       N1
         DATA     X'80'             X2
         DATA     X'80'             N2
         DATA     NONE              RCB
         DATA     NONE              SRCB
         DATA     NONE              MAXREC
         DATA     NONE              MINREC
         DATA     X'00004000'       DIR
         DATA     X'00004000'       NDIR
         DATA     NONE              IN
         DATA     NONE              SUSBIT
         DATA     X'00008000'       CTL
         DATA     X'00008000'       NCTL
         DATA     NONE              DC
         DATA     NONE              OUT
         DATA     NONE              LIST
         DATA     NONE              SMD
         DATA     NONE              NSMD
         DATA     X'00000008'       BIN
         DATA     X'00000008'       NBIN
         DATA     NONE              TRP
         DATA     NONE              NTRP
         DATA     X'00001000'       SYS
         DATA     X'00001000'       NSYS
         DATA     X'000000FF'       RP
         DATA     NONE              DSM
         DATA     NONE              DELETE DEVICE
         DATA     NONE              LW
         DATA     X'FF000000'       MRB
         DATA     X'FF000000'       NMRB
         DATA     NONE              GJOB
         DATA     NONE              MCP
         DATA     NONE              MLP
         DATA     X'00000002'       EM
         DATA     X'00000002'       NEM
         DATA     NONE              LPP
         DATA     X'00001000'       KEEP
         TITLE    'SPECIAL-CASE SUBROUTINES'
         BOUND    4
SUBR     NOP      DUMMY
         CALL     TYPESUB           TYPE
         CALL     DEVSUB            DEV
         CALL     OR80              IRCB
         NOP      NONE              PRIV
         NOP      NONE              BUF
         CALL     MSTSUB            MST
         CALL     SLVSUB            SLV
         NOP      NONE              RMT
         NOP      NONE              RWSN
         NOP      NONE              X1
         NOP      NONE              N1
         NOP      NONE              X2
         NOP      NONE              N2
         CALL     OR80              RCB
         CALL     SRCBSUB           SRCB
         MTW,1    MAXSW             MAXREC
         MTW,1    MINSW             MINREC
         NOP      NONE              DIR
         NOP      NONE              NDIR
         CALL     INSUB             IN
         NOP      NONE              SUSBIT
         CALL     CTLSUB            CTL
         CALL     NCTLSUB           NCTL
         CALL     DCSUB             DC
         CALL     OUTSUB            OUT
         CALL     LISTSUB           LIST
         CALL     SMDSUB            SMD
         CALL     NSMDSUB           NSMD
         NOP      NONE              BIN
         NOP      NONE              NBIN
         NOP      NONE              TRP
         NOP      NONE              NTRP
         NOP      NONE              SYS
         NOP      NONE              NSYS
         NOP      NONE              RP
         CALL     DSMSUB            DSM
         CALL     DESUB             DELETE DEV
         CALL     LWSUB             LIST WORK STATION
         NOP      NONE              MRB
         NOP      NONE              NMRB
         CALL     GJOBSUB           GJOB
         CALL     MCPSUB            MCP
         CALL     MLPSUB            MLP
         NOP      NONE              EM
         NOP      NONE              NEM
         CALL     LPPSUB            LPP
         NOP      NONE              KEEP
         TITLE    'FLAG VALUE'
         BOUND    4
FLAGV    DATA     DUMMY
         DATA     OFF               TYPE
         DATA     OFF               DEV
         DATA     OFF               IRCB
         DATA     OFF               PRIV
         DATA     OFF               BUF
         DATA     OFF               MST
         DATA     ON                SLV
         DATA     OFF               RMT
         DATA     OFF               RWSN
         DATA     ON                X1
         DATA     OFF               N1
         DATA     ON                X2
         DATA     OFF               N2
         DATA     OFF               RCB
         DATA     ON                SRCB
         DATA     OFF               MAXREC
         DATA     OFF               MINREC
         DATA     ON                DIR
         DATA     OFF               NDIR
         DATA     ON                IN
         DATA     OFF               SUSBIT
         DATA     OFF               CTL
         DATA     ON                NCTL
         DATA     OFF               DC
         DATA     OFF               OUT
         DATA     OFF               LIST
         DATA     OFF               SMD
         DATA     OFF               NSMD
         DATA     ON                BIN
         DATA     OFF               NBIN
         DATA     OFF               TRP
         DATA     OFF               NTRP
         DATA     ON                SYS
         DATA     OFF               NSYS
         DATA     OFF               RP
         DATA     OFF               DSM
         DATA     OFF               DELETE DEV
         DATA     OFF               LW
         DATA     ON                MRB
         DATA     X'01000000'       NMRB
         DATA     OFF               GJOB
         DATA     OFF               MCP
         DATA     OFF               MLP
         DATA     OFF               EM
         DATA     ON                NEM
         DATA     OFF               LPP
         DATA     ON                KEEP
         TITLE    'ACCESS MODE LIST'
         SPACE
*        SHOWS THE MODE IN WHICH THE VALUE IS PLACED IN :RBLOG
         SPACE
*        NORMAL=EXU PUTIT,KWX
*        WFLAG =WORD FLAG
*        DFLAG =HALFWORD FLAG
         SPACE
PUTMODE  DATA,1   DUMMY
         DATA,1   NONE              TYPE
         DATA,1   NORMAL            DEV
         DATA,1   NORMAL            IRCB
         DATA,1   NORMAL            PRIV
         DATA,1   NORMAL            BUF
         DATA,1   WFLAG             MST
         DATA,1   WFLAG             SLV
         DATA,1   NORMAL            RMT
         DATA,1   NORMAL            RWSN
         DATA,1   WFLAG             X1
         DATA,1   WFLAG             N1
         DATA,1   WFLAG             X2
         DATA,1   WFLAG             N2
         DATA,1   NORMAL            RCB
         DATA,1   DFLAG             SRCB
         DATA,1   NORMAL            MAXREC
         DATA,1   NORMAL            MINREC
         DATA,1   DFLAG             DIR
         DATA,1   DFLAG             NDIR
         DATA,1   NONE              IN
         DATA,1   NORMAL            SUSBIT
         DATA,1   DFLAG             CTL
         DATA,1   DFLAG             NCTL
         DATA,1   NORMAL            DC
         DATA,1   NONE              OUT
         DATA,1   DFLAG             LIST
         DATA,1   NONE              SMD
         DATA,1   NONE              NSMD
         DATA,1   DFLAG             BIN
         DATA,1   DFLAG             NBIN
         DATA,1   NONE              TRP
         DATA,1   NONE              NTRP
         DATA,1   WFLAG             SYS
         DATA,1   WFLAG             NSYS
         DATA,1   NORMAL            RP
         DATA,1   NONE              DSM
         DATA,1   WFLAG             DELETE DEV
         DATA,1   NONE              LW
         DATA,1   WFLAG             MRB
         DATA,1   WFLAG             NMRB
         DATA,1   NORMAL            GJOB
         DATA,1   NORMAL            MCP
         DATA,1   NORMAL            MLP
         DATA,1   WFLAG             EM
         DATA,1   WFLAG             NEM
         DATA,1   NORMAL            LPP
         DATA,1   DFLAG             KEEP
         TITLE    'PLACEMENT LIST'
         BOUND    4
PUTIT    DATA     DUMMY
         NOP                        TYPE
         STH,R10  RH:DEV,DX
         STW,R10  R:INRCB
         STB,R10  RB:PRIV,DX
         STW,R10  R:BUF
         STS,R10  R:FLAG
         STS,R10  R:FLAG
         CALL     STRMT             2ND HW IN WD
         CALL     RWSNSUB
         STS,R10  R:FLAG
         STS,R10  R:FLAG
         STS,R10  R:FLAG            X2
         STS,R10  R:FLAG            N2
         STB,R10  RB:RCB,DX
         STH,R10  RH:F1,DX
         STB,R10  RB:MAX,DX
         STB,R10  RB:MIN,DX
         STH,R10  RH:F2,DX
         STH,R10  RH:F2,DX
         NOP                        IN INSUB
         STH,R10  RH:SUS,DX
         STH,R10  RH:F1,DX
         STH,R10  RH:F1,DX
         STB,R10  RB:TYPX,DX
         NOP                        IN OUTSUB
         STH,R10  RH:F1,DX
         NOP                        IN SMDSUB
         NOP                        IN NSMDSUB
         STH,R10  RH:F2,DX
         STH,R10  RH:F2,DX
         NOP                        NTRP
         NOP                        NTRP
         STS,R10  R:FLAG
         STS,R10  R:FLAG
         STB,R10  RB:RP
         NOP                        DSM
         NOP                        BY DESUB
         NOP                        LW
         STS,R10  R:BUF             MRB
         STS,R10  R:BUF             NMRB
         STD,R10  RD:GHOST          GJOB
         STB,R10  RB:MAX,DX         MCP
         STB,R10  RB:MAX,DX         MLP
         STS,R10  R:FLAG            EM
         STS,R10  R:FLAG            NEM
         STB,R10  RB:MIN,DX         LPP
         STH,R10  RH:F1,DX          KEEP
         TITLE
*        'EXUED' SUBROUTINE TO STORE RMT IN RIGHT HW
*        OF R:RMT.
         SPACE
STRMT    ENTER
         SPACE
*        PUT RMT VALUE LJBF IN R:RMT
         SCS,R10  -16               INTO RIGHT HALF
         SPACE
         LI,R1    1
         STH,R10  R:RMT,R1
         RETURN
         PAGE
*        WMOD HOUSKEEPING ENTERED WHEN 'W' IS ENTERED
         SPACE
*        BAL,R14  WHK FROM SUPER MODULE
         SPACE
WHK      SAVE     SAVEREG1
         FILL,1   LOCKS,0,NWOPTIONS,0
         RESTORE  SAVEREG1
         B        *R14              BACK TO SUPER
         TITLE
         SPACE
*        WHEN ENTERED, KWX IS INDEX TO NAME;
*        R10-R11 CONTAINS USER-SPECIFIED VALUE OR BLANKS;
*        LENGTH IS SET TO NUMBER OF BYTES IN VALUE.
         SPACE
WMOD     EQU      %
         CW,R10   ='    '           IS VALUE BLANK
         BNE      %+2               NO, LENGTH IS ACCURATE
         LI,R1    -1                NULL LENGTH
         STW,R1   LENGTH            LENGTH INDEX OF VALUE
         LW,R1    LENGTH            OF INPUT NAME
         CI,R1    8                 MAXIMUM IS 7
         BGE      ERVALU9           ERROR MESSAGE
         AI,R1    1                 CONV INDEX TO COUNT
         STW,R1   LENGTH
         SPACE
         SAVE     SAVEREG1
         EXITCR                     RESET EXIT CONTROL
         CALL     CONVLIMS          CONV GERM LENGTHS
         LW,KWX   KWXI
         LW,DX    HOLDDX
         SPACE
*        DETERMINE WORKSTATION TYPE FROM :RBLOG RECORD
*        AND SET TYPSW ACCORDINGLY.
         SPACE
*        TYPSW= 1 IRBT   =2 2780   =4 7670
         SPACE
         LI,R     1                 IRBT CODE
         LW,R1    =X'02000000'      IRBT FLAG BIT
         CS,R1    R:FLAG
         BNE      TRY2780
         STW,R    TYPSW             TYPE IS IRBT
         B        LTEST
         SPACE
TRY2780  LI,R     2                 2780 CODE
         LW,R1    =X'00200000'      2780 FLAG BIT
         CS,R1    R:FLAG
         BE       %+2
         LI,R     4                 NOT 2780, MUST BE 7670
         STW,R    TYPSW
         SPACE
LTEST    MTB,0    LOCKS,KWX
         BNEZ     ER1
         SPACE
TTEST    LB,R     TYP,KWX
         BEZ      DTEST
         SPACE
*        IS THIS OPTION ALLOWED FOR SPECIFIED TYPE
         SPACE
         SPACE
         LW,R     TYPSW
         CB,R     TYP,KWX
         BANZ     DTEST             OK
         CI,R     1
         BE       ER2               NG
         LB,R     TYP,KWX
         CI,R     4
         BNE      ER2               NG
         SPACE
DTEST    MTB,0    DEV,KWX
         BEZ      CONVERT
         MTW,0    DEVSW             HAS DEVICE BEEN SPECIFIED
         BEZ      ER3               NO,ERROR
         SPACE
         SPACE
CONVERT  LB,R1    CMODE,KWX
         GO,R1    C0,C1,C2,C3
         SPACE
C0       CW,R10   ='    '           BLANKS
         BNE      ER6
         B        DOSUB
         SPACE
C1       LW,R     LENGTH            OF STRING
         CW,R     MIN,KWX
         BL       ER7
         CW,R     MAX,KWX
         BG       ER8
         B        DOSUB
         SPACE
C2       CALL     BCDHEX            HEX VALUE GIVEN
         LW,R10   HEXOUT
TVAL     CW,R10   MIN,KWX
         BL       ER9
         CW,R10   MAX,KWX
         BG       ER10
         B        DOSUB
         SPACE
C3       CALL     BCDBIN
         LW,R10   BINOUT
         B        TVAL              GO TO TEST LIMITS
         SPACE
DOSUB    MTW,0    SUBR,KWX
         BEZ      STORE
         EXU      SUBR,KWX          TO BAL TO SUBROUTINE
         SPACE
STORE    LB,R1    PUTMODE,KWX
         GO,R1    RET,PM1,PM2,PM3
         SPACE
PM1      EXU      PUTIT,KWX
         B        RET
         SPACE
PM2      LW,R11   MASK,KWX
         LW,R10   FLAGV,KWX         ONES OR ZEROS
         EXU      PUTIT,KWX         INTO R:FLAG OR R:BUF
         B        RET
         SPACE
PM3      LW,R2    PUTIT,KWX         A STH INSTR.
         SW,R2    =X'03000000'      MODIFY TO LH INSTR.
         EXU      R2                R10 HAS FLAG TO ALTER
         LW,R1    MASK,KWX          WHICH FLAG BIT TO ALTER
         LW,R     FLAGV,KWX         ONES OR ZEROS
         STS,R    R10               ALTERED
         EXU      PUTIT,KWX         BACK IN FLAG TABLE
         SPACE
*        AN OPTION HAS BEEN PROCESSED TO COMPLETION AND
*        THE :RBLOG RECORD HAS BEEN UPDATED
         SPACE
RET      EQU      %                 PREPARE TO RETURN
         STW,DX   HOLDDX            DEVICE INDEX
         RESTORE  SAVEREG
         B        TMORE             BACK INTO SUPER MAIN MODULE
         TITLE
         SPACE
SRCBSUB  ENTER
         SPACE
*        RESET SRCB BITS
         SPACE
         LH,R     RH:F2,DX
         RESET,R  =X'700'
         STH,R    RH:F2,DX
         SPACE
         LH,R     RH:F1,DX
         RESET,R  =X'C'
         STH,R    RH:F1,DX
         SPACE
         LB,R     R10               P, U, OR C
TRYP     CI,R     'P'
         BNE      TRYU
         LI,R1    X'4'
         LI,R3    X'100'
         B        SRST
         SPACE
TRYU     CI,R     'U'
         BNE      TRYC
         SPACE
*        IF SRCB=U AND LIST=S OR P, ERROR
         SPACE
         LH,R     RH:F2,DX
         LI,R1    X'3000'
         CS,R     =0
         BNE      ER13
         SPACE
         LI,R1    X'0'
         LI,R3    X'400'
         B        SRST
         SPACE
TRYC     CI,R     'C'
         BNE      TRYX
         LI,R1    X'8'
         LI,R3    X'200'
         B        SRST
         SPACE
TRYX     CI,R     'X'               IF SRCB=X, SET BOTH
         BNE      ER12              SRCB=P AND SRCB=C
         LI,R1    X'C'
         LI,R3    X'300'
         SPACE
         SPACE
SRST     LH,R     RH:F1,DX
         STS,R1   R
         STH,R    RH:F1,DX
         LH,R     RH:F2,DX
         STS,R3   R
         STH,R    RH:F2,DX
         RETURN
         PAGE
*        SUBROUTINE TO REMOVE NAMED DEVICE FROM :RBLOG
         SPACE
DESUB    ENTER
         LH,R     R10               NAME OF DEVICE
         SEARCH,2 RH:DEV,R:HSX,R,R1,R2,1   INDEX 0 INCLUDED
           B      ER18              NOT THERE
         LW,DX    R:HSX             AND R1 IS INDEX TO DEV
         SPACE
*        IS THE DELETED DEVICE THE SMD
         SPACE
         LB,R     RB:RCB,R1
         CW,R     R:OUTRCB
         BNE      DES1
         LI,R     0                 YES, CLEAR IT OUT
         STW,R    R:OUTRCB
DES1     CW,R1    DX                IF THIS THE LAST DEV IN REC
         CW,R1    DX                IS IT THE LAST ONE
         BE       DES2              YES.  JUST DEC. R:HSX
         SPACE
*        MOVE HIGHEST INDEXED DEVICE (DX) INTO
*        INTO NEWLY VACATED SLOT (R1)
         SPACE
         LH,R     RH:DEV,DX
         STH,R    RH:DEV,R1
         LB,R     RB:RCB,DX
         STB,R    RB:RCB,R1
         LH,R     RH:F1,DX
         STH,R    RH:F1,R1
         LH,R     RH:F2,DX
         STH,R    RH:F2,R1
         LH,R     RH:SUS,DX
         STH,R    RH:SUS,R1
         LB,R     RB:MAX,DX
         STB,R    RB:MAX,R1
         LB,R     RB:MIN,DX
         STB,R    RB:MIN,R1
         LB,R     RB:PRIV,DX
         STB,R    RB:PRIV,R1
         LB,R     RB:TYPX,DX
         STB,R    RB:TYPX,R1
DES2     LI,R     0
         STH,R    RH:DEV,DX         ZERO DELETED DEV NAME
         STW,R    DEVSW             RESET CURRECT DEVICE CODE
         STB,R    RB:RCB,DX
         MTW,-1   R:HSX             NEW HIGHEST INDEX
         RETURN
         PAGE
SMDSUB   ENTER
         MTB,0    RB:RCB,DX
         BEZ      ER22
         MTW,0    R:OUTRCB
         BNEZ     ER23
         LB,R     RB:RCB,DX
         STW,R    R:OUTRCB
         RETURN
         SPACE    4
NSMDSUB  ENTER
         LI,R     0
         STW,R    R:OUTRCB
         RETURN
         PAGE
INSUB    ENTER
         UNLOCK   XCTL,XNCTL,XDC
         LOCK     XLIST,XSMD,XNSMD,XSUSBIT
         LH,R     RH:F1,DX
         OR,R     =X'1'
         RESET,R  =X'8000'          RESET BIT 0
         STH,R    RH:F1,DX
         LH,R2    RH:F2,DX
         LI,R1    X'30'             MASK
         LI,R     X'20'             BITS FOR 'IN'
         STS,R    R2
         STH,R2   RH:F2,DX          BACK IN RECORD
         RETURN
         SPACE
OUTSUB   ENTER
         UNLOCK   XLIST,XSMD,XSUSBIT
         LOCK     XCTL,XNCTL,XDC
         LH,R     RH:F1,DX
         RESET,R  =X'1'
         STH,R    RH:F1,DX          BACK IN REC
         SPACE
         LH,R2    RH:F2,DX
         LI,R1    X'30'             2 BIT MASK
         LI,R     X'10'             BITS FOR 'OUT'
         STS,R    R2
         STH,R2   RH:F2,DX          BACK IN REC
         RETURN
         SPACE    2
MSTSUB   ENTER
         LOCK     XSLV,XRMT,XRWSN
         RETURN
         SPACE
SLVSUB   ENTER
         UNLOCK   XSLV,XRMT,XRWSN
         RETURN
         PAGE
         SPACE
MCPSUB   ENTER                      PUT VALUE IN MAXREC OF DEV=CP
         LW,R     MINUSCP           'CP' WITH MINUS SIGN
MCP2     SEARCH,2 RH:DEV,R:HSX,R,R1,R2,1
           B      ER18              NOT PRESENT (IMPOSSIBLE)
         LW,DX    R1                SET INDEX
         RETURN
         SPACE    2
LPPSUB   ENTER                      PUT VALUE IN MINREC OF DEV=LP
         MTW,1    MINSW             SET SWITCH TO KEEP VALUE THERE
         B        MLP2
         SPACE    2
MLPSUB   ENTER                      PUT VALUE IN MAXREC OF DEV=LP
         MTW,1    MAXSW
MLP2     LW,R     MINUSLP           'LP' WITH MINUS SIGN
         B        MCP2
         SPACE    2
GJOBSUB  ENTER                      NAME INTO TEXTC INTO RD:GHOST
         SLD,R10  -8
         LW,R1    LENGTH            NUMBER OF BYTES IN NAME
         STB,R1   R10
         STD,R10  RD:GHOST          INTO RECORD
         RETURN
MINUSCP  DATA,2   X'FFFF','CP'
MINUSLP  DATA,2   X'FFFF','LP'
         SPACE
         PAGE
         SPACE    2
*        DEVICE SUBROUTINE
         SPACE
DEVSUB   ENTER
         SPACE
*        MAKE SURE THAT RCB HAS BEEN SPECIFIED ON
*        ALL DEVICES THUS FAR CREATED
         SPACE
         BAL,R14  RCBTEST
           B      RET               NO GOOD. MSG HAS BEEN TPD
         SPACE
         LH,R10   R10               DEVICE NAME HW
         SEARCH,2 RH:DEV,R:HSX,R10,R1,R2,1
           B      %+2
           B      ER16
         LW,DX    R:HSX             SET DEVICE INDEX
         AI,DX    1                 UPDATE FOR NEW DEVICE
         STW,DX   R:HSX
         MTW,1    JMSW              SAYS DEV JUST MADE
         LI,R     0
         STW,R    MINSW             RESET MIN/MAX SO WE CAN FIND
         STW,R    MAXSW             OUT IF EXPLICITLY SET
         MTW,1    DEVSW             NON ZERO IN DEV(0)
         CALL     SETDEV            INSTALL DEFAULTS
         LOCK     XIRCB             LOCK IRCB UNLESS DEV=OC
         AND,R10  =X'FFFF'          RID EXTD SIGN
         SPACE
         CI,R10   'OC'              IS DEVICE OC
         BNE      RETURN
         LH,R     RH:F2,DX          YES, RESET BIT ZERO FLAG 1
         OR,R     =X'8000'
         STH,R    RH:F2,DX
         SPACE
         LH,R     RH:F1,DX
         OR,R     =X'2'
         STH,R    RH:F1,DX          ALLOWED FOR DEV=OC
         UNLOCK   XIRCB             ALLOWED FOR DEV=OC
RETURN   RETURN
         PAGE
*        RCB PRESENCE VERIFICATION SUBROUTINE.
*        CALLED VIA BAL,R14.  ALSO CALLED FROM
*        EXTERNAL SUPER MODULE
         SPACE
RCBTEST  EQU      %
         SPACE
*        SEE IF A DEVICE WAS JUST CREATED
         SPACE
         MTW,0    JMSW              NON ZERO IF FRESHLY MADE DEV
         BEZ      RCBT3             NO, JUST DO RCB TEST
         SPACE
*        IF(LIST=Y OR LIST=S) AND MINREC WAS NOT EXPLICITLY
*        SPECIFIED, SET MINREC TO SPECIAL DEFAULT VALUE 38.
*        SIMILARLY, MAXREC=132
         SPACE
         LW,R2    R:HSX             INDEX OF NEW DEVICE
         LH,R     RH:F2,R2          R2 IS DEV INDEX
         LI,R1    1                 BIT 15 (HW) MASK
         CS,R1    R                 LIST= Y OR S?
         BNE      RCBT3             NOT Y OR S
         MTW,0    MINSW             WAS MIN EXPLICITLY SET
         BNEZ     %+3               NO CHECK MAX
         LI,R     38                SPECIAL DEFAULT VALUE
         STB,R    RB:MIN,R2         INTO RECORD
         MTW,0    MAXSW             WAS MAX EXPLICITLY SET
         BNEZ     %+3               NO, JUST RESET ALL SWITCHES
         LI,R     132               SPECIAL DEFAULT VALUE
         STB,R    RB:MAX,R2         INTO RECORD
         SPACE
         LI,R     0
         STW,R    JMSW
RCBT3    EQU      %                 TEST RCB
         SEARCH,1 RB:RCB,R:HSX,=0,R1,R2,1
         B        R14P1             ALL IS WELL
         LH,R2    RH:DEV,R1         THE OFFENDING DEVICE NM
         STH,R2   V1M               INTO MESSAGE
,DATA    M:WRITE  M:LO,(BUF,V1),(SIZE,32),(BTD,0)
         B        *R14
R14P1    AI,R14   1                 TO BAL + 1
         B        *R14
         PAGE
OR80     ENTER
         OR,R10   =X'80'
         CI,R10   X'F'
         BAZ      ER19              ILLEG RCB VALUE
         RETURN
         SPACE    5
DSMSUB   ENTER
         CI,R10   X'FF'
         BG       ER10              BIGGER THAN BYTE
         STB,R10  RB:DSM            INTO BYTE 0
         RETURN
         SPACE    5
DCSUB    ENTER
         LH,R     R10
         SEARCH,2 SH:SYMT,SVTYM,R,R1,R2
           B      ER15
         SEARCH,2 OH:NM,TYPMN,R,R1,R2
           B      ER14
         LW,R10   R1                INDEX TO VALUE
         RETURN
         PAGE
LISTSUB  ENTER
         LH,R1    RH:F2,DX
         RESET,R1 =X'3041'          RESET BITS 2,3,9,15
         LB,R     R10
         CI,R     'Y'
         BNE      LS2
         OR,R1    =X'41'            BITS 9,15
LS1      STH,R1   RH:F2,DX
         RETURN
         SPACE
LS2      CI,R     'S'
         BNE      LS3
         LW,R9    LISTS             FLAG BIT
         CALL     TESTL             SEE IF ALREADY SPECIFIED
         OR,R1    =X'1041'          BITS 3,9,15
         STH,R1   RH:F2,DX
         B        LS4
LS3      CI,R     'P'
         BNE      LS8
         LW,R9    LISTP
         CALL     TESTL             SEE IF ALREADY SPECIFIED
         OR,R1    =X'2000'          SET BIT 2
         STH,R1   RH:F2,DX
         SPACE
*        IF LIST=S OR P AND SRCB=U, ERROR
         SPACE
LS4      LI,R3    X'400'            SRCB=U BIT
         CS,R3    R1
         BE       ER13
         RETURN
         SPACE
LS8      CI,R     'N'               IF LIST=N, JUST LEAVE BITS
         BNE      ER20              RESET; ELSE ERROR
         B        LS1               STORE AND RETURN
         SPACE
TESTL    ENTER
         LI,R2    -1                INDEX
LS5      AI,R2    1                 STEP INDEX
         CW,R2    R:HSX
         BGE      RETURN            ALL IS WELL
         LH,R8    RH:F2,R2
         CS,R8    =0
         BE       LS5
         B        ER21
LISTS    DATA     X'1000'           LIST=S FLAG BIT
LISTP    DATA     X'2000'           LIST=P FLAG BIT
         TITLE
TYPESUB  ENTER
         LI,R     0
         STW,R    JMSW              RESET JUST MADE SWITCH
         STW,R    DEVSW             RESET DEV(0)
         CW,R10   ='IRBT'
         BNE      TYS2
         BAL,R14  DEFIRBT
         RETURN
         SPACE
TYS2     CW,R10   ='7670'
         BNE      TYS4
         BAL,R14  DEF7670
         RETURN
         SPACE
TYS4     CW,R10   ='STND'           STANDARD IRBT
         BE       TYS41
         SPACE
         CW,R10   ='2780'
         BNE      ER17              ILLEGAL TYP
         BAL,R14  DEF7670           INSTALL TYP 7670 DEFAULT REC
         UNLOCK   XMRB,XNMRB        UNLOCK 2780 OPTIONS
         LI,R1    1
         STB,R1   R:BUF             DEFAULT = NMRB
         LI,R1    120               DEFAULT MAXREC
         STB,R1   RB:MAX            FOR LP
         LW,R1    =X'00200000'      TYPE 2780 FLAG BIT
         STW,R1   R:FLAG
         LW,R1    =X'80008000'      DEFAULT RH:FLAG FOR DEVICES
         STS,R1   RH:F1             IN 1ST 2 FIELDS (HW)
         RETURN
         SPACE
*        MOVE THE STANDARD RECORD TO :RBLOG
         SPACE
TYS41    LI,R1    4                 INITIAL INDEX
TYS5     LW,R     STDRBRP-4,R1
         STW,R    RB:RP-4,R1
         AI,R1    1                 STEP INDEX
         CI,R1    80
         BL       TYS5
         LW,R     =X'02000000'      TYPE=IRBT FLAG
         STW,R    R:FLAG            INTO RECORD
         RESTORE  SAVEREG1          PREPARE TO LEAVE MODULE
         B        *R6               GO WRITE :RBLOG
         SPACE
         SPACE
*        THE FOLLOWING TWO SUBROUTINES MOVE
*        DEFAULT :RBLOG RECORDS INTO THE BUFFER
*        NOTE THAT R14 IS USED TO BAL BECAUSE THESE
*        ROUTINES MIGHT BE CALLED FROM THE SUPER MODULE
         SPACE
DEFIRBT  EQU      %
         SAVE     SAVEREG2
         LB,R10   RB:RBID           SAVE RBID
         LD,R12   RD:WSN
         LI,R1    80                LENGTH OF :RBLOG
         LW,R2    DIRBT-1,R1
         STW,R2   RBLOG-1,R1
         BDR,R1   %-2
         STB,R10  RB:RBID           RESTORE RBID
         STD,R12  RD:WSN
         FILL,1   LOCKS,0,NWOPTIONS,0
         LOCK     XRMT,XRWSN,XCTL,XNCTL,XDC
         RESTORE  SAVEREG2
         B        *R14
         SPACE    2
DEF7670  EQU      %
         SAVE     SAVEREG2
         LD,R12   RD:WSN
         LB,R10   RB:RBID           SAVE RBID
         LI,R1    80                LENGTH OF :RBLOG
         LW,R2    D7670-1,R1
         STW,R2   RBLOG-1,R1
         BDR,R1   %-2
         STB,R10  RB:RBID           RESTORE RBID
         STD,R12  RD:WSN
         RESTORE  SAVEREG2
         B        *R14
         PAGE
*        LIST WORKSTATION SUBROUTINE
         SPACE
LWSUB    ENTER
         RESTORE  SAVEREG1
         B        RM4               INTO SUPER
         SPACE
CTLSUB   ENTER
         LH,R     RH:F1,DX
         RESET,R  =X'8000'
CTLR     STH,R    RH:F1,DX
         RETURN
         SPACE
NCTLSUB  ENTER
         LH,R     RH:F1,DX
         OR,R     =X'8000'
         B        CTLR
         SPACE
RWSNSUB  ENTER                      IF USER SAID WSN=LOCAL
         CW,R10   ='LOCA'           IGNORE COMMAND
         BNE      RWSS1
         CW,R11   ='L   '
         BE       RETURN
RWSS1    STD,R10  RD:RWSN           STORE IN RBLOG
         RETURN
         PAGE
*        ROUTINE TO LIST :RBLOG RECORD. CALLED BROM
*        SUPER MODULE
         SPACE
LISTRB   EQU      %
         SAVE     SAVEREG3
         MTW,0    J:JIT
         BLZ      LISTRB2           SKIP PAGE SEPARATOR
         FILL,1   LL,0,70,'*'       FILLERS
         CALL     PRINTL            PRINT SEP RATOR
LISTRB2  EQU      %
         FILL,1   LL,0,70,' '
         CALL     PRINTL            SKIP LINE
         LB,R3    RB:RBID
         BAL,R8   BIN2BCD
         BAL,R8   BLK2              ZERO SUPPRESS
         SCS,R7   8
         STW,R7   LL+1
         LD,R2    RD:WSN
         STD,R2   LL+2
         LW,R1    ='ID= '
         STW,R1   LL
         CALL     PRINTL
         LW,R7    ='2780'
         LW,R1    =X'00200000'
         CS,R1    R:FLAG
         BE       LISTRB3
         SPACE    2
         LW,R7    ='IRBT'
         LW,R1    =X'02000000'      IRBT BIT
         CS,R1    R:FLAG
         BE       LISTRB3
         LW,R7    ='7670'
LISTRB3  LW,R6    ='TYP='
         STD,R6   LL
         CALL     PRINTL
         SPACE    2
         LW,R7    ='MODE'
         STW,R7   LL
         LW,R7    ='=SLV'
         LW,R1    =X'01000000'      SLAVE BIT
         CS,R1    R:FLAG
         BE       %+2
         LW,R7    ='=MST'
         STW,R7   LL+1
         CALL     PRINTL
         SPACE    2
         LW,R1    =X'00400000'      X1
         CS,R1    R:FLAG
         BNE      PX2
         LW,R7    ='X1  '
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
PX2      LI,R1    X'80'             X2
         CS,R1    R:FLAG
         BNE      PSY
         LW,R7    ='X2  '
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
PSY      LI,R1    X'1000'           SYS
         CS,R1    R:FLAG
         BNE      PDSM
         LW,R7    =':SYS'
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
PDSM     LB,R2    RB:DSM
         BAL,R8   BIN2HEX
         STW,R4   LL+1
         LW,R7    ='DSM='
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
         LB,R2    RB:RP
         BAL,R8   BIN2HEX
         STW,R4   LL+1
         LW,R7    ='RP= '
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
         LW,R6    RD:RWSN
         CW,R6    ='    '           DON'T PRINT IF BLANK
         BE       PIRCB
         LW,R6    ='RMT '
         LW,R7    ='WSN='
         STD,R6   LL
         LD,R6    RD:RWSN
         STD,R6   LL+2
         CALL     PRINTL
         SPACE    2
PIRCB    EQU      %
         LI,R1    1
         MTH,0    R:RMT,R1          IS IT THERE
         BEZ      PINR
         LW,R7    R:RMT
         STH,R7   LL+1
         LW,R7    ='RMT='
         STW,R7   LL
         CALL     PRINTL
         SPACE    2
PINR     LW,R2    R:INRCB
         AND,R2   =X'FF'
         MTW,0    R2
         BEZ      PSMD
         BAL,R8   BIN2HEX
         STW,R4   LL+1
         LW,R7    ='IRCB'
         STW,R7   LL
         LI,R7    '='
         STB,R7   LL+1
         CALL     PRINTL
         SPACE    2
PSMD     LW,R2    R:OUTRCB
         BEZ      PMRB
         AND,R2   =X'FFFF'
         SEARCH,1 RB:RCB,R:HSX,R2,R4,R8,1
           B      PMRB              SHOULDN'T HAPPEN
         LH,R7    RH:DEV,R4         THE SMD DEVICE NAME
         LI,R2    1
         STH,R7   LL+1,R2           IN 2ND HALF
         LW,R7    ='SMD='
         STW,R7   LL
         CALL     PRINTL
         SPACE
PMRB     LB,R1    R:BUF             MRB VALUE
         CI,R1    X'FF'
         BNE      PEM               IF NOT PRESENT
         LW,R7    ='MRB '
         STW,R7   LL
         CALL     PRINTL
         SPACE
PEM      LI,R1    2                 EM BIT
         CS,R1    R:FLAG
         BNE      PGHOST            BIT SET IF NEM
         LW,R7    ='NEM '
         STW,R7   LL
         CALL     PRINTL
         SPACE
PGHOST   MTW,0    RD:GHOST
         BEZ      PD0               NOT PRESENT
         LW,R6    ='GJOB'
         STW,R6   LL
         LD,R6    RD:GHOST
         STW,R6   LL+1
         STW,R7   LL+2
         LI,R1    '='
         STB,R1   LL+1              '=' OVER TEXTC COUNT
         CALL     PRINTL
         SPACE    2
PD0      LW,R1    =X'02000000'      IRBT BIT
         CS,R1    R:FLAG
***      BNE      PDR               NOT IRBT, DON'T PRINT DEV
         LW,R3    R:HSX             DEVICE COUNT
         AI,R3    1
         BAL,R8   BIN2BCD
         BAL,R8   BLK2
         STW,R7   LL+2
         LW,R6    ='DEVI'
         LW,R7    ='CES '
         STD,R6   LL
         CALL     PRINTL
         CALL     PRINTL            SKIP LINE
         SPACE    2
         MTW,0    R:HSX
         BLZ      PDR               NO DEVICES (NEVER HAPPEN)
         LD,R2    MBSH
         MBS,R2   0                 DEVICE HEADER LINE
         CALL     PRINTL            PRINT DEVICE HEADER
         SPACE
*        PRINT DEVICE DATA
         SPACE
         LI,R5    -1
PD1      AI,R5    1
         CW,R5    R:HSX
         BLE      PD1A              ANY MORE DEVICES
PDR      MTW,0    J:JIT
         BLZ      PDRR              RETURN
         FILL,1   LL,0,70,'*'
         CALL     PRINTL            PRINT FILLERS IF OFF LINE
PDRR     RESTORE  SAVEREG3
         B        *R11
         B        *R11
PD1A     EQU      %
         SPACE
         LH,R7    RH:DEV,R5
         AND,R7   =X'FFFF'
         SCS,R7   8
         OR,R7    =X'40000040'      SURROUND WITH BLANKS
         STW,R7   LL
         SPACE
PD2      LB,R2    RB:RCB,R5
         STW,R5   HOLD5
         BAL,R8   BIN2HEX
         LW,R5    HOLD5
         OR,R4    =X'40400000'
         SCS,R4   8
         STW,R4   LL+1
         SPACE
PD3      LH,R1    RH:F2,R5
         SLS,R1   -8
         AND,R1   =X'7'
         LB,R7    UCPL,R1           ISOLATE 3 BITS
         OR,R7    =X'40404000'
         SCS,R7   8
         STW,R7   LL+2
         SPACE
PD4      LH,R2    RH:SUS,R5
         AND,R2   =X'FFFF'
         LW,R7    R2
         SLS,R7   -8                GET HI 2 CHARS
         STW,R5   HOLD5
         BAL,R8   BIN2HEX
         STW,R4   LL+3
         LW,R2    R7                HI 2
         BAL,R8   BIN2HEX           CONV HI 2
         STH,R4   LL+3              INTO PRINT LINE
         LW,R5    HOLD5             RESTORE 5
         SPACE
PD5      LW,R7    ='  IN'
         LH,R2    RH:F2,R5
         LI,R1    X'20'             IN BIT
         CS,R1    R2
         BE       %+2
         LW,R7    =' OUT'
         STW,R7   LL+4
         SPACE
PD6      LH,R     RH:F2,R5
         LW,R1    =X'3041'
         CS,R     =0
         BE       PLN
         LW,R1    =X'2000'          BIT 2
         CS,R     R1
         BE       PLP
         LW,R1    =X'1000'
         CS,R     =0
         BE       PLY
         LI,R7    'S'
         B        PPUT
PLN      LI,R7    'N'
         B        PPUT
PLP      LI,R7    'P'
         B        PPUT
PLY      LI,R7    'Y'
PPUT     LI,R1    3                 INDEX
         STB,R7   LL+5,R1
         SPACE    2
PD7      LW,R7    ='   Y'
         LH,R     RH:F1,R5
         LW,R1    =X'8000'
         CS,R     R1
         BNE      %+2
         LW,R7    ='   N'
         STW,R7   LL+6
         SPACE    2
PD8      LW,R7    ='   N'
         LH,R     RH:F2,R5
         LI,R1    X'8'
         CS,R     R1
         BNE      %+2
         LW,R7    ='   Y'
         STW,R7   LL+7
         SPACE    2
PD9      LW,R7    ='   N'
         LW,R1    =X'1000'
         LH,R     RH:F1,R5          FOR KEEP OPTION
         CS,R     R1
         BNE      %+2
         LW,R7    ='   Y'
         STW,R7   LL+8
         SPACE    2
PD9A     LB,R2    RB:PRIV,R5
         STW,R5   HOLD5
         BAL,R8   BIN2HEX
         LW,R5    HOLD5
         STW,R4   LL+9
         SPACE    2
PD10     LB,R2    RB:TYPX,R5
         STW,R5   HOLD5
         BAL,R8   BIN2HEX
         LW,R5    HOLD5
         LI,R1    1
         STW,R4   LL+10
         SPACE    2
PD11     LB,R3    RB:MAX,R5
         BAL,R8   BIN2BCD
         BAL,R8   BLK2
         STW,R7   LL+11
         SPACE    2
PD12     LB,R3    RB:MIN,R5
         BAL,R8   BIN2BCD
         BAL,R8   BLK2
         STW,R7   LL+12
         SPACE
         CALL     PRINTL            PRINT DEV LINE
         B        PD1               GO FOR MORE
         PAGE
*        SUBROUTINE TO PRINT ONE LISTING LINE
         SPACE
PRINTL   ENTER
         SAVE     SAVEREG4
         MTW,0    J:JIT
         BLZ      PONLINE
         M:WRITE  M:LO,(BUF,LL),(SIZE,70),(BTD,0)
         B        BLANKIT
PONLINE  LI,R3    70
POL2     LB,R4    LL,R3
         BEZ      POL3              RID TRAILING ZEROS
         CI,R4    ' '
         BE       POL3              RID TRAILING BLANKS
         CI,R4    ','
         BE       POL3              RID TRAILING COMMAS
         B        POL4
POL3     AI,R3    -1
         BGZ      POL2
POL4     AI,R3    1
         LI,R2    X'15'
         STB,R2   LL,R3
         AI,R3    1
         M:WRITE  M:UC,(BUF,LL),(SIZE,*R3),(WAIT),(BTD,0)
BLANKIT  FILL,1   LL,0,70,' '       BLANK LINE
         RESTORE  SAVEREG4
         RETURN
         PAGE
DHEAD    TEXT     'DEV RCB SRCB SUS I/O LIST CT'
         TEXT     'L BIN KP  PRV DC MAX MIN    '
         BOUND    8
MBSH     DATA     BA(DHEAD)
         GEN,8,24 56,BA(LL)
UCPL     TEXT     'NPCXU000'        SRCB LIST VALUES
         PAGE
*        SET UP DEVICE DEFAULTS FOR IRBT DEVICE
         SPACE
*        INSERT DEFAULT OPTIONS FOR DEVICE:
*          OUT, SRCB=C,NBIN,NDIR,MST,NSMD
         SPACE
SETDEV   ENTER
         LI,R1    X'0210'
         STH,R1   RH:F2,DX
         SPACE
*        SET OPTIONS: NCTL,SRCB=C IN RH:F1
         SPACE
         LI,R1    X'8008'
         STH,R1   RH:F1,DX
         SPACE
*        SET OPTIONS: MIN=255,MAX=255,PRIV=X'40'
         SPACE
         LI,R1    1
         STB,R1   RB:MIN,DX
         LI,R1    80
         STB,R1   RB:MAX,DX
         LI,R1    X'40'
         STB,R1   RB:PRIV,DX
         SPACE
         SPACE
*        PREVENT AND 'IN' OPTIONS FOR THIS DEVICE
         SPACE
         LOCK     XRMT,XRWSN,XCTL,XNCTL,XDC
         UNLOCK   XIN,XMST,XSLV,XSUSBIT,XLIST
         RETURN
         PAGE
*        SUBROUTINE INTERFACE TO EXTERNAL CONVERSIONS
         SPACE
BCDHEX   ENTER
         SAVE     SAVEREG4
         MTW,1    REST4             SET RESTORE4 SW
         BAL,R1   HEX2BIN           IN SUPER
         STW,R5   HEXOUT
RRET     LI,R1    0
         STW,R1   REST4             RESET RESTORE4 SW
         RESTORE  SAVEREG4
         RETURN
         SPACE    2
BCDBIN   ENTER
         SAVE     SAVEREG4
         LW,R7    LENGTH            OF BCD STRING
         MTW,1    REST4             SET RESTORE4 SW
         BAL,R1   BCD2BIN
         STW,R5   BINOUT
         B        RRET
         SPACE    2
BINBCD   ENTER
         SAVE     SAVEREG4
         BAL,R8   BIN2BCD           IN OTHER MODULE
         BAL,R8   BLK2              ZERO SUPPRESS
         STD,R6   BCDOUT            2 WD RESULT
         B        RRET
         SPACE
         DEF      EVAL3R
         REF      ERVALU3
         SPACE
EVAL3R   MTW,0    REST4             NEED TO RESTORE4
         BEZ      ERVALU3           NO
         LI,R1    0
         STW,R1   REST4             RESET RESTORE4 SW
         B        GER9
         SPACE
*        CONVERT GERM TABLE LENGTHS TO INDICES
         SPACE
CONVLIMS ENTER
         LI,R     SV:LIM+1
         AI,R     -1
         STW,R    SVLIM
         LI,R     SV:RSIZ+1
         AI,R     -1
         STW,R    SVRSIZ
         LI,R     SV:FTYM+1
         AI,R     -1
         STW,R    SVTYM
         LI,R     TYPMNSZ
         AI,R     -1
         STW,R    TYPMN
         RETURN
         PAGE
*        THIS SUBROUTINE IS ENTERED JUST BEFORE THE
*        MODIFIED :RBLOG RECORD IS WRITTEN IN ORDER
*        TO VERIFY THAT AN RCB HAS BEEN SPECIFIED FOR
*        ALL DEVICES AND THAT SMD IS SPECIFIED IF IN
*        MASTER MODE.
         SPACE    2
WVERIFY  STW,R14  NHW               HOLD RETURN ADDRESS
         LW,R1    =X'02000000'      IRBT BIT
         CS,R1    R:FLAG
         BNE      VOK               NOT IRBT. NO CHECKS NEEDED
         SPACE
         MTW,0    R:HSX             ANY DEVICES SPECIFIED
         BLZ      NODEV
         BAL,R14  RCBTEST
           B      *NHW              ERROR RETURN
         SPACE
         LW,R1    =X'01000000'      SLAVE BIT
         CS,R1    R:FLAG
         BE       VOK               B IF SLAVE
         MTW,0    R:OUTRCB          SMD SPECIFIED
         BNEZ     VOK                 YES
         M:WRITE  M:LO,(BUF,WARN),(SIZE,25),(BTD,0)
VOK      MTW,1    NHW               NORMAL RETURN
         B        *NHW
WARN     TEXT     'WARNING: NO SMD SPECIFIED'
         SPACE    2
NODEV    M:WRITE  M:LO,(BUF,NDEVM),(SIZE,19),(BTD,0)
         B        *NHW              ERROR RETURN
NDEVM    TEXT     'NO DEVICE SPECIFIED'
         TITLE    'ERROR HANDLING SECTION'
         SPACE
ER1      LI,R1    ER1M
         B        ERX
ER2      LI,R1    ER2M
         B        ERX
ER3      LI,R1    ER3M
         B        ERX
ER4      LI,R1    ER4M
         B        ERX
ER5      LI,R1    ER5M
         B        ERX
ER6      LI,R1    ER6M
         B        ERX
ER7      LI,R1    ER7M
         B        ERX
ER8      LI,R1    ER8M
         B        ERX
ER9      LI,R1    ER9M
         B        ERX
ER10     LI,R1    ER10M
         B        ERX
ER11     LI,R1    ER11M
         B        ERX
ER12     LI,R1    ER12M
         B        ERX
ER13     LI,R1    ER13M
         B        ERX
ER14     LI,R1    ER14M
         B        ERX
ER15     LI,R1    ER15M
         B        ERX
ER16     LI,R1    ER16M
         B        ERX
ER17     LI,R1    ER17M
         B        ERX
ER18     LI,R1    ER18M
         B        ERX
ER19     LI,R1    ER19M
         B        ERX
ER20     LI,R1    ER20M
         B        ERX
ER21     LI,R1    ER21M
         B        ERX
ER22     LI,R1    ER22M
         B        ERX
ER23     LI,R1    ER23M
         B        ERX
         SPACE
ERX      EQU      %
         B        JUSTWRITE         TEMP PATCH ******
         LW,R8    WOPTIONS,KWX
         LW,R9    =X'FFFF0000'
         STS,R8   PREM+6            STORE OPTION NAME
         M:WRITE  M:LO,(BUF,PREM),(SIZE,33),(BTD,0)
JUSTWRITE EQU     %
         LB,R2    *R1
         M:WRITE  M:LO,(BUF,*R1),(SIZE,*R2),(BTD,1)
         B        RET
ER1M     TEXTC    'THIS OPTION ILLEGAL AT THIS TIME'
ER2M     TEXTC    'NOT ALLOWED FOR TYP SPECIFIED'
ER3M     TEXTC    'ILLEGAL OPTION FOR SPECIFIED DEVICE'
ER4M     TEXTC    'MASTER/SLAVE CONFLICT'
ER5M     TEXTC    'IN/OUT CONFLICT'
ER6M     TEXTC    'SYNTAX - UNEXPECTED EQUALS'
ER7M     TEXTC    'STRING TOO SHORT'
ER8M     TEXTC    'STRING TOO LONG'
ER9M     TEXTC    'SPECIFIED VALUE TOO SMALL'
ER10M    TEXTC    'SPECIFIED VALUE TOO BIG'
ER11M    TEXTC    'ILLEGAL CHARACTER IN HEX FIELD'
ER12M    TEXTC    'ILLEGAL SRCB VALUE'
ER13M    TEXTC    'SRCB INCONSISTANCY'
ER14M    TEXTC    'INVALID DEVICE NAME'
ER15M    TEXTC    'NOT A SYMBIONT DEVICE'
ER16M    TEXTC    'DEVICE NAME ALREADY SPECIFIED IN RECORD'
ER17M    TEXTC    'UNRECOGNIZED TYPE NAME'
ER18M    TEXTC    'NO SUCH DEVICE IN RECORD'
ER19M    TEXTC    'ILLEGAL RCB VALUE'
ER20M    TEXTC    'ILLEGAL VALUE SPECIFIED'
ER21M    TEXTC    'ALREADY SPECIFIED FOR ANOTHER DEVICE'
ER22M    TEXTC    'RCB NOT YET SPECIFIED'
ER23M    TEXTC    'SMD ALREADY SPECIFIED'
         TITLE
*        MENU FOR :USERS RECORD
         SPACE
:USERS   EQU      INBUFF            IN SUPER MODULE
UB:BILL  EQU      :USERS+15
UB:PRIV  EQU      :USERS+16
:UNML    EQU      :USERS+30
:UBML    EQU      :USERS+46
:UOML    EQU      :USERS+62
:UGML    EQU      :USERS+78
:UNMR    EQU      :USERS+94
:UBMR    EQU      :USERS+102
:UOMR    EQU      :USERS+106
:UGMR    EQU      :USERS+110
:UNMP    EQU      :USERS+114
:UPFLGS  EQU      :USERS+122
         PAGE
*        TABLES FOR SUPER 'U' OPTION
         SPACE
UOPTIONS DATA     0                 INDEX 0 UNUSED
         NAME     'BM      '
         NAME     'BP      '
         NAME     'B%      '
         NAME     'OM      '
         NAME     'OP      '
         NAME     'O%      '
         NAME     'GM      '
         NAME     'GP      '
         NAME     'G%      '
         NAME     'NONE    '
         NAME     'ALL     '
         NAME     'PASSWORD'
         NAME     'CALL    '
         NAME     'XACCT   '
         NAME     'READ    '
         NAME     'EXPIRE  '
         NAME     'MAXEXPIR'
         NAME     'XO      '        EXEC ONLH :SYS PROCESSORS
         NAME     'PM      '        PROCESSOR MODE
         NAME     'RP      '        RESTRICTED PROCESSOR
         NAME     'SE      '        SECURITY CHECK
NUOPTIONS EQU     WA(%)-WA(UOPTIONS)-1
UOPTCOUNT DATA    NUOPTIONS
         SPACE
BOG      DATA,1   DUMMY             INDEX 0 UNUSED
         DATA,1    0
         DATA,1    0
         DATA,1    0
         DATA,1    1
         DATA,1    1
         DATA,1    1
         DATA,1    2
         DATA,1    2
         DATA,1    2
         DATA,1    X'F'
         DATA,1    X'F'
         DATA,1    X'F'
         DATA,1    X'F'
         DATA,1    X'F'
         DATA,1   X'F'              READ ALL/NONE
         DATA,1   X'F'              EX
         DATA,1   X'F'              MA
         DATA,1   X'F'              XO
         DATA,1   X'F'              PM
         DATA,1   X'F'              RP
         DATA,1   X'F'              SE
         BOUND    4
MP%      DATA,1   DUMMY             INDEX 0 UNUSED
         DATA,1    0
         DATA,1    1
         DATA,1    2
         DATA,1    0
         DATA,1    1
         DATA,1    2
         DATA,1    0
         DATA,1    1
         DATA,1    2
         DATA,1    0
         DATA,1    1
         DATA,1    2
         DATA,1    3
         DATA,1    4
         DATA,1   5                 READ ALL/NONE
         DATA,1   6                 EX
         DATA,1   7                 MA
         DATA,1   8                 XO
         DATA,1   9                 PM
         DATA,1   10                RP
         DATA,1   11                SE
         BOUND    4
         SPACE
         PAGE
*        N O N - S W A P O U T   D A T A   S E C T I O N
         SPACE
         SPACE
*        THIS LIST OPTION NAME LIST PARALLELS THE FLAG BUFFER
*        AT 'LFLAGS'  FLAGS ARE SET WHEN OPTION REQUESTED
         SPACE
LOPTS    DATA     0
         NAME     'ALL     '
         NAME     'PASSWORD'
         NAME     'CALL    '
         NAME     'XACCT   '
         NAME     'READ    '
         NAME     'EXPIRE  '
         NAME     'MAXEXPIR'
         NAME     'XO      '        EXEC ONLH :SYS PROCESSORS
         NAME     'PL      '        PROCESSOR LIST
         NAME     'SE      '        SECURITY CHECK
         SPACE
NLOPTS   EQU      WA(%)-WA(LOPTS)-1
X        EQU      5
UX       EQU      7                 SAME AS DX IN WMOD
RENONE   TEXT     'READ=NONE   '
         SPACE
         PAGE
*        'UMOD' IS CALLED AS AN EXTERNAL ROUTINE BY SUPER
*        ENTRY ENVIRONMENT IS IDENTICAL TO THAT OF 'WMOD'
         SPACE
UMOD     SAVE     SAVEREG1
         EXITCR
         CALL     CONVLIMS          CONVERT GERM LENGTHS
         SPACE
*        REPLACE TRAILING ZEROS IN 'NAME' WITH BLANKS
         SPACE
         LI,R1    ' '
         LI,X     7
         MTB,0    NAME,X
         BNEZ     %+4
         STB,R1   NAME,X
         MTW,-1   X
         BGEZ     %-4
         LW,KWX   KWXI
         LB,X     BOG,KWX           WHICH TYPE
         CI,X     X'F'
         BNE      UB
         LB,X     MP%,KWX           INDEX OF SPECIAL
         LW,R1    BLIST,X           WHERE TO GO
         STW,R1   HEXOUT            TEMP LOC
         RESTORE  SAVEREG1
         B        *HEXOUT           GO THERE
         SPACE
BLIST    DATA     CMOPPT,UALL,PAS,CLL3,XACCT3,READ3
         DATA     DRET3,MRET3
         DATA     XOROUT,PMROUT,RPROUT,SEROUT
         SPACE
UALL     MTB,0    LISTMODE
         BEZ      GER82             FOR ERR MSG
         MTW,1    ALLSW
         B        UDONE
         PAGE
UB       LW,R     LENGTH            OF INPUT NAME
         CI,R     8                 MAXIMUM IS 7
         BGE      GER9              FOR ERR MSG
         MTW,1    LENGTH            CONVERT TO LENGTH FM INDEX
         SPACE
         LI,R     0
         STW,R    T                 T = 0
         LH,R     NAME
         STW,R    NHW               NAME-HALF-WORD
         LB,X     MP%,KWX           TABLE TYPE
         GO,X     UBM,UBP,UB%
         SPACE
UBM      SEARCH,3 :UNML,=15,NAME,UX,R1
           B      UBM2              NOT FOUND
         MTW,1    T                 T = 1
         B        UBA
         SPACE
UBM2     SEARCH,2 :UNMR,=15,NHW,UX,R1
           B      UBM3
         MTW,2    T                 T = 2
         B        UBA
         SPACE
UBP      LB,R     R10               VALUE ENTERED
         CI,R     'N'               PERMISSION=NO
         BE       UBP1
         CI,R     'Y'               PERMISSION=YES
         BNE      GER9              ILLEGAL VALUE ER MSG
         LW,R10   ='1   '           YES
         B        UBP1+1
UBP1     LW,R10   ='0   '           NO
         LI,R     1
         STW,R    LENGTH            MODIFY LENGTH FOR Y,N
UBP2     SEARCH,2 :UNMP,=15,NHW,UX,R1
           B      UBM3              NOT FOUND
         MTW,3    T                 T = 3
         B        UBA
         PAGE
UB%      LB,X     BOG,KWX
         CALL     BCDHEX            INTO HEXOUT
         LW,R     BINOUT
         CI,R     X'FF'
         BG       V2BIG
         LH,R1    NAME              FIRST TWO CHARACTERS
         AND,R1   =X'FFFF'          RID EXT SIGN
         CI,R1    'BI'              BILLING OPTION
         BE       UB%4
         CI,R1    'PR'              PRIVELEDGE OPTION
         BE       UB%6
         B        BADNAME
         SPACE
UB%4     STB,R    UB:BILL,X
         B        UDONE
         SPACE
UB%6     STB,R    UB:PRIV,X
         B        UDONE
         PAGE
UBM3     CW,R10   ='DELE'
         BE       UDONE
         LI,UX    0                 RESET UX FOR SETUX SUBR.
UBM6     LB,X     BOG,KWX           X=0,1,2 : B,O,G
         CALL     BCDBIN
         LW,R1    NAME              IF NAME IS CO (CORE) CONVERT
         AND,R1   =X'FFFF0000'      SAVE FIRST TWO CHARACTERS
         CW,R1    =X'C3D60000'      IS IT CO (CORE)
         BNE      %+4               BINARY VALUE TO K
         LW,R1    BINOUT            BY SHIFTING 1 BIT
         SLS,R1   1
         STW,R1   BINOUT
UBM8     EQU      %
         CW,R1    =X'D4C30000'      IS IT MC
         BNE      UBM9              NO, CARRY ON
         CALL     MCTEST            HAS MC ALREADY BEEN SAID
         B        UBM9              YES
         CALL     MCGEN             GENERATE :PROCS RECORD
UBM9     EQU      %
         LI,R1    0
         STW,R1   T                 RESET T
         LB,R1    MP%,KWX
         GO,R1    UCM,UCP
         SPACE
UCM      SEARCH,3 SL:NAME,SVLIM,NAME,R3,R1
           B      UCM2              NOT FOUND
         MTW,1    T                 T = 1
         B        UP
         SPACE
UCM2     SEARCH,2 SH:RNM,SVRSIZ,NHW,R3,R1
           B      UP                NOT FOUND
         MTW,2    T                 T = 2
         B        UP
         SPACE
UCP      SEARCH,2 SH:SYMT,SVTYM,NHW,R3,R1
           B      UP
         MTW,3    T                 T = 3
         B        UP
         PAGE
UBA      CW,R10   ='DELE'
         BNE      UBM6
         SPACE
*        PREVENT DELETION OF MC OPTION
         SPACE
         CW,R1    =X'D4C34040'      IS IT MC
         BNE      UBA1              NO
         LI,R1    MCMSG             CAN'T DO IT.  PRINT MESSAGE
         LB,R2    *R1
         M:WRITE  M:LO,(BUF,*R1),(SIZE,*R2),(BTD,1)
         B        UDONE
UBA1     EQU      %
         LI,R     0
         JUSTDO,T EML,EML,EMR,EMP
         B        UDONE
EML      STW,R    :UNML,UX          T=1
EMR      STH,R    :UNMR,UX          T=2
EMP      STH,R    :UNMP,UX          T=3
         PAGE
UP       LW,R3    NAME
         LW,R4    NHW
         LW,R9    BINOUT
         GO,T     BADNAME,UT1,UT2,UT3
         SPACE
UT1      LI,R1    0                 PARAMETER FOR SUBR.
         CALL     SETUX
         STW,R3   :UNML,UX
         JUSTDO,X SUBML,SUOML,SUGML
         B        UDONE
         SPACE
UT2      LI,R1    1                 PARAMETER FOR SUBR.
         CALL     SETUX
         CI,R9    X'FF'
         BG       V2BIG
         STH,R4   :UNMR,UX
         JUSTDO,X SUBMR,SUOMR,SUGMR
         B        UDONE
         SPACE
UT3      LI,R1    2                 PARA.
         CALL     SETUX
         LB,R2    :UPFLGS,UX        GET THE FLAG BYTE
         STH,R4   :UNMP,UX
         JUSTDO,X L80,L40,L20       B,O, OR G BIT INTO R8
         MTW,0    BINOUT            0=RESET, 1=SET
         BEZ      URESET
         OR,R2    R8                SET (PERMISSION GRANTED)
         B        USTFL
URESET   RESET,R2 R8                RESET (NO PERMISSION)
USTFL    STB,R2   :UPFLGS,UX        BACK INTO :USERS
UDONE    RESTORE  SAVEREG1
         B        TMORE             BACK TO SUPER
         SPACE
SUBML    STW,R9   :UBML,UX
SUOML    STW,R9   :UOML,UX
SUGML    STW,R9   :UGML,UX
         SPACE
SUBMR    STB,R9   :UBMR,UX
SUOMR    STB,R9   :UOMR,UX
SUGMR    STB,R9   :UGMR,UX
         SPACE
*  RESTORE REGISTERS AND RETURN TO OTHER MODULE TO
*  SEND ERROR MESSAGE
         SPACE
GER82    RESTORE  SAVEREG1
         B        ERVALU82
         SPACE
GER9     RESTORE  SAVEREG1
         B        ERVALU9
         PAGE
*        SUBROUTINE TO PRINT :USER RECORD ACCORDING
*        TO LIST OPTION FLAGS SET IN 'LFLAGS'
         SPACE
*        BAL,R13  PRNTRT            FROM SUPER MODULE
         SPACE
PRNTRT   EQU      %
         SAVE     SAVEREG2
BLNKOUT  FILL,1   LL,0,70,' '
         CALL     PRINTL            SKIP A LINE
         SPACE
         SPACE
*        ACCOUNT, NAME
         SPACE
         LW,R1    ='ID= '
         STW,R1   LL
         LCI      2
         LM,0     :USERS
         STM,0    LL+1
         SPACE
         LCI      3
         LM,0     :USERS+2          NAME
         STM,0    LL+4
         CALL     PRINTL
         SPACE
*        PASSWORD
         SPACE
         MTW,0    FL:ALL
         BNEZ     DOPA
         MTW,0    FL:PA
         BEZ      PXA
DOPA     LW,R     :USERS+6
         BEZ      PCA               IF NOT PRESENT
         STW,R    LL+1
         LW,R     :USERS+7
         STW,R    LL+2
         LW,R     ='PA= '
         STW,R    LL
         CALL     PRINTL
         SPACE
*        AUTOCALL
         SPACE
PCA      MTW,0    FL:ALL
         BNEZ     DOPCA
         MTW,0    FL:CALL
         BEZ      PXA
DOPCA    MTW,0    :USERS+10         ANY AUTO-CALL THERE
         BEZ      PXA               NO, GO ON
         LCI      2                 YES, EDIT CALL
         LM,0     :USERS+10
         STM,0    LL+1
         LW,R     ='CA= '
         STW,R    LL
         SPACE
*        AUTO-CALL NAME
         SPACE
         LI,R2    BA(:USERS+12)+1
         LI,R3    BA(LL+4)
         LB,R     :USERS+12         BYTE COUNT
         STB,R    R3
         MBS,R2   0                 MOVE CALL NAME
         SPACE
*        AUTO-CALL PASSWORD
         SPACE
         LW,R     :USERS+8
         BEZ      PCA2              NO PASSWORD
         STW,R    LL+8
         LW,R     :USERS+9
         STW,R    LL+9
PCA2     CALL     PRINTL
         SPACE
*        EXTENDED ACCOUNTING
         SPACE
PXA      MTW,0    FL:ALL
         BNEZ     DOPXA
         MTW,0    FL:XA
         BEZ      PRE               SKIP IT
DOPXA    MTW,0    :USERS+24
         BEZ      PRE               NOT PRESENT
         LCI      6
         LM,0     :USERS+24
         STM,0    LL+1
         LW,R     ='XA= '
         STW,R    LL
         CALL     PRINTL
         SPACE
*        READ NONE OPTION
         SPACE
PRE      MTW,0    FL:ALL
         BNEZ     DOPRE
         MTW,0    FL:READ
         BEZ      PBI               SKIP IT
DOPRE    MTB,0    :USERS+5
         BEZ      PBI
         LCI      3
         LM,0     RENONE
         STM,0    LL
         CALL     PRINTL
         SPACE
*        BILLING
         SPACE
PBI      MTW,0    FL:ALL
         BNEZ     DOPBI
         MTW,0    BILLSW
         BEZ      PPR               SKIP IT
DOPBI    LW,R     ='BI= '
         STW,R    LL
         SPACE
         LI,R6    0                 B,O,G INDEX
PBI2     LB,R2    UB:BILL,R6
         BAL,R8   BIN2HEX
         SCS,R4   16                LJBF
         STW,R4   LL+1,R6
         AI,R6    1
         CI,R6    3
         BL       PBI2
         CALL     PRINTL
         SPACE
*        PRIVELEDGE
         SPACE
PPR      MTW,0    FL:ALL
         BNEZ     DOPPR
         MTW,0    PRIVSW
         BEZ      PM                SKIP IT
DOPPR    LI,R6    0                 B,O,G INDEX
PPR2     LB,R2    UB:PRIV,R6
         BAL,R8   BIN2HEX
         SCS,R4   16                LJBF
         STW,R4   LL+1,R6           INTO B,O,G POSN OF LINE
         AI,R6    1
         CI,R6    3
         BL       PPR2
         LW,R1    ='PR= '
         STW,R1   LL
         CALL     PRINTL
PM       MTW,0    FL:ALL
         BEZ      PM22
         MTW,1    ALLMSW            SET TO PRINT ALL
         B        PMINIT
         SPACE
PM22     MTW,0    ALLMSW
         BNEZ     PMINIT
         MTW,0    MCOUNT
         BLZ      PP
         SPACE
PMINIT   LI,X     -1
PML1     AI,X     1
         CI,X     16
         BGE      PML5
         LW,R10   :UNML,X
         BEZ      PML1
         MTW,0    ALLMSW
         BNEZ     PML2
         SEARCH,3 MLIST,MCOUNT,R10,R2,R11,1 IS IT THERE
           B      PML1                     NO
         SPACE
PML2     LW,R11   :UBML,X
         LW,R12   :UOML,X
         LW,R13   :UGML,X
         CALL     PRINTM
         B        PML1
         SPACE
PML5     LI,X     -1
PML6     AI,X     1
         CI,X     16
         BGE      PP                NEXT SECTION
         LH,R10   :UNMR,X
         BEZ      PML6              NOT PRESENT
         SLS,R10  16
         AI,R10   '  '              LJBF
         MTW,0    ALLMSW
         BNEZ     PML8
         SEARCH,3 MLIST,MCOUNT,R10,R2,R11,1 IS IT THERE
           B      PML6                   NO
         SPACE
PML8     LB,R11   :UBMR,X
         LB,R12   :UOMR,X
         LB,R13   :UGMR,X
         CALL     PRINTM
         B        PML6
         PAGE
PP       MTW,0    FL:ALL            PRINT ALL REQUESTED
         BEZ      PP2               NO, SEE WHAT WAS
         MTW,1    ALLPSW            YES, SET TO PRINT SECTION
         B        PPINIT
         SPACE
PP2      MTW,0    ALLPSW            PRINT P SECTION
         BNEZ     PPINIT            YES
         MTW,0    PCOUNT            PRINT ANY INDIVIDUALLY
         BLZ      PPDUN             NO, QUIT
         SPACE
PPINIT   LI,X     -1
PPL1     AI,X     1                 STEP INDEX
         CI,X     16                DONE YET
         BGE      PPMA
         LH,R10   :UNMP,X           PERIPHERAL NAME
         BEZ      PPL1              NOT PRESENT
         SLS,R10  16
         AI,R10   '  '              LJBF NAME
         MTW,0    ALLPSW            PRINT ANYWAY
         BNEZ     PPL2              YES
         SEARCH,3 PLIST,PCOUNT,R10,R2,R11,1 NO, CHECK FOR NAME IN LIST
           B      PPL1              NOT THERE, TRY ANOTHER
PPL2     LW,R     ='  P '
         STW,R    LL                HEADER
         STW,R10  LL+1              HEADER NAME
         LB,R1    :UPFLGS,X         PERMISSION BYTE
         SLS,R1   -5                MAKE AN INDEX
         LD,R10   ONOFF,R1
         STW,R10  LL+2
         STW,R11  LL+3
         CALL     PRINTL
         B        PPL1              LOOP
PPMA     MTW,0    FL:ALL
         BNEZ     DOPPMA
         MTW,0    FL:EX
         BEZ      PPEX
DOPPMA   MTH,0    INBUFF+20         ANY MAX EXPIRE
         BEZ      PPEX              NO
         LW,R3    INBUFF+20
         SLS,R3   -16               INTO POSITION
         BAL,R8   BIN2BCD
         BAL,R8   BLK2
         STW,R6   LL+1
         STW,R7   LL+2
         LW,R     ='EX= '
         STW,R    LL
         CALL     PRINTL            PRINT MA
         SPACE
PPEX     MTW,0    FL:ALL
         BNEZ     DOPPEX
         MTW,0    FL:MA
         BEZ      PPDUN
DOPPEX   LI,R3    1                 INDEX
         MTH,0    INBUFF+20,R3      EX VALUE PRESENT
         BEZ      PPDUN             NO
         LI,R3    X'FFFF'           MASK
         AND,R3   INBUFF+20         CAPUTRE EX
         BAL,R8   BIN2BCD
         BAL,R8   BLK2
         STW,R6   LL+1
         STW,R7   LL+2
         LW,R     ='MA= '
         STW,R    LL
         CALL     PRINTL            PRINT EX
         SPACE
PPDUN    CALL     MOREPRINT         INTO SUPER3 TO LIST :PROCS
         MTW,0    J:JIT
         BLZ      PPD2              IN BATCH MODE
         FILL,1   LL,0,70,'*'
PPD2     CALL     PRINTL
         RESTORE  SAVEREG2
         SPACE
         B        *R13              RETURN TO OTHER MODULE
         SPACE
         BOUND    8
ONOFF    TEXT     ' N,N,N  '
         TEXT     ' N,N,Y  '
         TEXT     ' N,Y,N  '
         TEXT     ' N,Y,Y  '
         TEXT     ' Y,N,N  '
         TEXT     ' Y,N,Y  '
         TEXT     ' Y,Y,N  '
         TEXT     ' Y,Y,Y  '
         SPACE
PRINTM   ENTER
         LW,R     ='  M '
         STW,R    LL
         STW,R10  LL+1              NAME
         LI,R1    9                 LL INDEX
         LW,R3    R11
         CALL     EDIT
         CALL     COMMA             PLACE COMMA IN LINE
         LW,R3    R12
         CALL     EDIT
         CALL     COMMA             PLACE COMMA IN LINE
         LW,R3    R13
         CALL     EDIT
         CALL     PRINTL
         RETURN
         PAGE
EDIT     ENTER
         LW,R2    R10               IF EDITING CORE, CONVERT
         CW,R2    ='CO  '           VALUE
         BNE      %+2
         SLS,R3   -1
         CALL     BINBCD            INTO R6-R7
         LI,R2    -1                INDEX
PRM2     AI,R2    1
         CI,R2    8
         BGE      RETURN
         LB,R     BCDOUT,R2
         CI,R     ' '               LEADING BLANK
         BE       PRM2              SKIP LEADING BLANKS
         STB,R    LL,R1
         AI,R1    1
         B        PRM2
         SPACE
COMMA    ENTER                      PLACE COMMA IN LINE
         LI,R     ','
         STB,R    LL,R1             COMMA TO SEPARATE
         AI,R1    1                 PREPARE FOR NEXT LOOP
         RETURN
         PAGE
*        SUBROUTINE TO FIND EMPTY SLOT IN USER
*        TABLE AND SET UX ACCORDINGLY.  IF UX IS NOT -1,
*        JUST RETURN SINCE SLOT HAS ALREADY BEEN FOUND
         SPACE
SETUX    ENTER
         CI,UX    0
         BNE      RETURN
SETUX2   AI,UX    1                 STEP INDEX
         CI,UX    15                REACHED END YET
         BG       UFULL             YES, ERROR MESSAGE
         JUSTDO,R1 TUNML,TUNMR,TUNMP WHICH TABLE TO SEARCH
         BNEZ     SETUX2            NOT ZERO, TRY ANOTHER
         RETURN                     FOUND AN EMPTY ONE
         SPACE
TUNML    MTW,0    :UNML,UX
TUNMR    MTH,0    :UNMR,UX
TUNMP    MTH,0    :UNMP,UX
         SPACE
UFULL    LW,R1    WHICH,R1          PREPARE MESSAGE
         B        PRINT
         SPACE
WHICH    DATA     MLFULL,MRFULL,MPFULL
MLFULL   TEXTC    ':UNML FULL'
MRFULL   TEXTC    ':UNMR FULL'
MPFULL   TEXTC    ':UNMP FULL'
         SPACE
L80      LI,R8    X'80'
L40      LI,R8    X'40'
L20      LI,R8    X'20'
         PAGE
*        SUBROUTINE TO EVALUATE OPTIONS FOR LIST
*        COMMAND.  CALLED FROM SUPER VIA BAL,R1 GETN
         SPACE
GETN     EQU      %
         CW,R2    =X'D7D30000'      IS IT THE 'PL' OPTION
         BNE      GETN2             NO
         AI,R1    1                 YES, RETURN TO BAL+2
         B        *R1
GETN2    EQU      %
         LCI      5
         STM,0    SAVERL
         LB,R1    R2                FIRST CHAR OF OPTION
         CI,R1    'M'
         BE       GOTM
         CI,R1    'P'
         BE       GOTP
         CI,R1    '%'
         BE       GOT%
         MTW,1    SAVERL+1          SET TO EXIT TO BAL+2
GNDUN    LCI      5
         LM,0     SAVERL
         B        *R1               BACK TO SUPER
         SPACE
GOTP     BAL,R5   GETNM             NAME INTO R4
           B      ALLP              NO NAME GIVEN
         CW,R4    ='A   '           PART OF 'PASSWORD'
         BE       GNDUN-1           NORMAL RETURN
         CW,R4    ='AS  '
         BE       GNDUN
         CW,R4    ='ASS '           PART OF 'PASSWORD'
         BE       GNDUN-1           NORMAL RETURN
         CW,R4    ='ASSW'           PART OF 'PASSWORD'
         BE       GNDUN-1           NORMAL RETURN
         MTW,1    PNAMES            STEP POINTER
         MTW,1    PCOUNT
         LW,R5    PNAMES            TEST POINTER FOR MAX
         CI,R5    PLIST+16
         BGE      TOOMANY           ERROR
         STW,R4   *PNAMES           STORE NAME IN LIST
         B        GNDUN             BACK TO SUPER
         SPACE
ALLP     MTW,1    ALLPSW            SET SWITCH FOR ALL P LIST
         B        GNDUN
         SPACE
GOTM     BAL,R5   GETNM
           B      ALLM              NO NAME GIVEN
         MTW,1    MNAMES            STEP POINTER
         MTW,1    MCOUNT
         LW,R5    MNAMES            TEST POINTER FOR MAX
         CI,R5    MLIST+16
         BGE      TOOMANY           ERROR MESSAGE
         STW,R4   *MNAMES           NAME INTO LIST
         B        GNDUN
         SPACE
ALLM     MTW,1    ALLMSW            SET SWITCH FOR ALL M
         B        GNDUN
         SPACE
GOT%     BAL,R5   GETNM             GET OPTION NAME INTO R4
           B      ALL%              NO NAME GIVEN
         LH,R5    R4                GET 1ST 2 CHAR
         AND,R5   =X'FFFF'          RID EXT SIGN
         CI,R5    'BI'              BILLING
         BE       SETBI
         CI,R5    'PR'
         BNE      WRONG%            IF NO BILLING
         MTW,1    PRIVSW            SET PRIVELEDGE SW
         B        GNDUN
         SPACE
SETBI    MTW,1    BILLSW            SET BILLING SWITCH
         B        GNDUN
         SPACE
ALL%     MTW,1    PRIVSW            SET BILLING SW
         B        SETBI             GO TO SET BILLING SW
         PAGE
*        SUBROUTINE TO CAPTURE LISTING OPTION NAME, IF
*        PRESENT, AND STICK IT IN R4 LJBF. EXIT
*        TO BAL+2 IF NAME, ELSE BAL+1
         SPACE
GETNM    EQU      %
         LW,R4    ='    '           BLANKS
         LI,R1    0                 INDEX
GETNMLP  EQU      %
         LB,R     CMNDBUF+21,R3     THE NEXT BYTE OF OPTION
         CI,R     ' '               BLANK
         BE       GTST              YES, QUIT
         CI,R     ';'               SEMI
         BE       GTST              YES, QUIT
         CI,R     X'15'
         BE       GTST              YES, QUIT
         STB,R    R4,R1
         MTW,1    R3
         MTW,1    R1
         CI,R1    4
         BGE      GTST
         B        GETNMLP
         SPACE
GTST     CW,R4    ='    '           ANY NAME THERE
         BE       *R5               NO EXIT BAL+1
         MTW,1    R5                YES, EXIT TO
         B        *R5               BAL+2
         PAGE
*        SUBROUTINE CALLED FROM SUPER VIA BAL,R7 TO
*        RESET ALL USER LISTING OPTIONS
         SPACE
LINIT    EQU      %
         FILL,3   ALLMSW,0,3,0
         FILL,3   MLIST,0,15,0
         FILL,3   PLIST,0,15,0
         FILL,3   LFLAGS,0,NLOPTS,0
         LI,R1    MLIST-1
         STW,R1   MNAMES            RESET POINTER
         LI,R1    PLIST-1
         STW,R1   PNAMES            RESET POINTER
         LI,R     -1
         STW,R    PCOUNT
         STW,R    MCOUNT
         B        *R7               BACK TO SUPER
         SPACE    3
TOOMANY  LI,R1    MANYMSG
         B        RMERRMES          GO TO PRINT
MANYMSG  TEXTC    'TOO MANY OPTION NAMES. RE-DO LIST CMND'
         SPACE
WRONG%   LI,R1    UMSG1
         B        RMERRMES          GO TO PRINT ERR MSG
         SPACE
         PAGE
BADNAME  LI,R1    UMSG1
         B        PRINT
         SPACE
V2BIG    LI,R1    UMSG2
         SPACE
PRINT    LB,R2    *R1
         M:WRITE  M:LO,(BUF,*R1),(SIZE,*R2),(BTD,1)
         B        UDONE
         SPACE    2
UMSG1    TEXTC    'UNRECOGNIZED NAME'
UMSG2    TEXTC    'VALUE TOO BIG'
         TITLE
*        S W A P O U T   D A T A   S E C T I O N
         SPACE
         USECT    DATA
         SPACE
SAVEREG  RES      16
SAVEREG1 EQU      SAVEREG
SAVEREG2 RES      16
SAVEREG3 RES      16
SAVEREG4 RES      16
         BOUND    8
BCDOUT   DATA     0,0               2 WD RESULT OF CONV
LL       RES,1    70
         BOUND    4
PREM     TEXT     ' ERROR WHILE PROCESSING XX OPTION'
         EXITC    15,5              CALL/RETURN PROC
LOCKS    RES,1    NWOPTIONS
         BOUND    4
WOPTCOUNT DATA    NWOPTIONS
DEVSW    DATA     0
TYPSW    DATA     0
MINSW    DATA     0
MAXSW    DATA     0
JMSW     DATA     0                 'DEV JUST MADE 0 OR R:HSX'
HEXOUT   DATA     0
BINOUT   EQU      HEXOUT
HOLDDX   DATA     -1
HOLD5    DATA     0                 HOLD R5 DURING BIN2HEX
V1       TEXT     'NO RCB SPECIFIED FOR DEVICE '
V1M      TEXT     '    '            FILLED IN LATER
LFLAGS   RES,4    NLOPTS+1          LIST OPTION FLAGS
FL:ALL   EQU      LFLAGS+1
FL:PA    EQU      LFLAGS+2
FL:CALL  EQU      LFLAGS+3
FL:XA    EQU      LFLAGS+4
FL:READ  EQU      LFLAGS+5
FL:EX    EQU      LFLAGS+6
FL:MA    EQU      LFLAGS+7
FL:XO    EQU      LFLAGS+8
FL:PL    EQU      LFLAGS+9
FL:SE    EQU      LFLAGS+10
         SPACE
ALLSW    DATA     0
LISTMODE DATA     0                 1=LIST
T        DATA     0
NHW      DATA     0                 NAME-HALF-WORD
ALLMSW   DATA     0
ALLPSW   DATA     0
BILLSW   DATA     0
PRIVSW   DATA     0
REST4    DATA     0                 SAVE REG4 SW
PCOUNT   DATA     -1
MCOUNT   DATA     -1
MNAMES   DATA     MLIST-1
PNAMES   DATA     PLIST-1
MLIST    RES,4    16
PLIST    RES,4    16
SVLIM    DATA
SVRSIZ   DATA
SVTYM    DATA
TYPMN    DATA
SAVERL   RES,5    4
         END

