*****************
*M*      SYSCN -- PERFORM PARTITIONING ON-LINE/GHOST
*****************
         TITLE    'SYSCON PROCESSOR - RESOURCE PARTITIONING'
*P***************
*P*      NAME:    SYSCN
*P*      PURPOSE: TO PERFORM PARTITIONING, RETURNING, &
*P*               DISPLAYING STATUS OF PERIPHERALS
*P*               WITHIN CP-V. ALSO BUILDS, UPDATES, &
*P*               DISPLAYS CONTENTS OF DESIRED M:MODNUM FILE.
*P*      DESCRIPTION: THIS MODULE BECOMES A PROCESSOR NAMED,
*P*               SYSCON, AND REQUIRES A0 OR GREATER PRIVILEGE
*P*               IN ORDER TO RUN.
*P*               SYSCON MUST BE RUN AS AN ON-LINE OR GHOST
*P*               USER WHEN PARTITIONING OR RETURNING
*P*               PERIPHERALS. HOWEVER, IT CAN BE RUN IN
*P*               BATCH, AS WELL AS ON-LINE/GHOST, WHEN
*P*               DISPLAYING PERIPHERAL STATUS & MAINTAINING
*P*               THE M:MODNUM FILE.
*P*               THE M:MODNUM FILE IS A LMN CONTAINING THE
*P*               VALID COMBINATIONS OF DEVICE VS CONTROLLER
*P*               MODEL NUMBERS AS DEFINED BY ENGINEERING &
*P*               MARKETING. M:MODNUM IS USED BY SYSGEN &
*P*               BOOT-TIME RECONFIGURATION FOR VERIFYING
*P*               DEVICE/CONTROLLER MODEL NUMBER DEFINITIONS.
*P*               SYSCN OBTAINS M:MODNUM FROM :SYS ACCOUNT
*P*               UNLESS M:MODNUM HAS BEEN ASSIGNED/SET TO
*P*               SOME OTHER ACCOUNT.
*P*               WHEN PARTITIONING OR RETURNING PERIPHERALS,
*P*               ONLY PARTITIONABLE TYPE PERIPHERALS ARE
*P*               HONORED, SUCH AS, CARD READER/PUNCH, TAPES,
*P*               PRIVATE DISK PACKS, LINE PRINTER, AND ASSOCIATED
*P*               CONTROLLERS. PERIPHERALS SUCH AS COC, PUBLIC
*P*               DISK PACKS, RADS, TELETYPES, & ASSOCIATED
*P*               CONTROLLERS ARE NOT PARTITIONABLE.
*P*      REFERENCE:  SPECS.DWG.# 703198,703240.
*P***************
         PAGE
********
* CODE FOR DEBUGGING ONLY.....
****
TEST     SET      0                 =0, NO TEST MODE CODE
*                                   =1, TEST MODE(ON-LINE DEBUGGING)
****
CALL     CNAME
         PROC
         DO       TEST=1
LF       BAL,R0   SIM:CAL
         FIN
         PEND
****
GO       CNAME
         PROC
         DO       TEST=1
LF       B        AF(1)
         FIN
         PEND
****
         DO       TEST=1
         DEF      TSTACK            TEMP STACK
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      TIME              REL.TIME
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      S:MBSF            SCHEDULAR FLAG
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      J:JIT             DEFINE JIT
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      J:BASE            LOC.IN JIT
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      JB:PRIV           PRIV.LEVEL IN JIT
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      ERRLOG            ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      CALBAD            ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      CHKBIT0           ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      CHKBIT            ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      PUSHALL           ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      PULLALLEXIT       ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      T:SELFDESTRUCT    ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
         DEF      ACTBIT            CONSTANT X'200'
         DEF      LIPBIT            CONSTANT X'8'
         DEF      OFFBIT            CONSTANT X'20000'
         REF      FISH              ROUTINE
*,*                           USED DURING ON-LINE DEBUGGING ONLY.....
********
         FIN
         PAGE
         SYSTEM   UTS
         SYSTEM   BPM
         SYSTEM   DIAG
SIGMA    SET      1                 =1 SIGMA, =0 TAURUS
WANT:VAL SET      0                 =0 NO 'VALUE' ON TAURUS OUTPUT
*                                   =1 'VALUE' ON TAURUS OUTPUT
*****************
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*****************
         PAGE
         DO       TEST=1
********
* CODE FOR DEBUGGING ONLY.....
****
*        TO LOAD SYSCON FOR DEBUGGING, DO AS FOLLOWS:
*  !LOAD (LMN,SYSCON),(NOSYSLIB),(PERM),(NOTCB),(MAP),(SL,F),;
*  !     (EF,(RDERLOG:BO),(SYSCN:BO),(GETFIELD:BO),(LITERALS:BO),;
*  !     (IOTABLE),(SG:RTY),(SG:FLG),(SG:OPNM),(SG:RCT))
*  !ASSIGN M:EI,(FILE,SYSCON),(INOUT)
*  !SYMCON
*  BUILD (LIB)
*  END
**********
         CSECT    0
TSTACKSZ EQU      100
         BOUND    8
TSTACK   PZE      %+1
         GEN,16,16  TSTACKSZ,0
         RES      TSTACKSZ
TIME     DATA     X'12345678'
S:MBSF   DATA     0
J:JIT    EQU      X'8C00'
J:BASE   DATA     0
         DATA     0
JB:PRIV  EQU      X'43'**2
CALLRTRN GEN,4,28 0,0
LOGBUFSZ EQU      100*3
LOGBUF   PZE      %-2
         RES      LOGBUFSZ
ACTBIT   EQU      X'200'
LIPBIT   EQU      X'8'
OFFBIT   EQU      X'20000'
********
         PAGE
********
ERRLOG   EQU      %
         LCI      3
         PSM,R13  STACK
ERRLOG0  EQU      %
         LW,R4    LOGBUF
         AI,R4    3
         CI,R4    LOGBUF+LOGBUFSZ-2
         BL       ERRLOG1
         LI,R4    LOGBUF-2
         STW,R4   LOGBUF
         B        ERRLOG0
*-------
ERRLOG1  EQU      %
         STW,R4   LOGBUF
         LCI      3
         LM,R13   *R6
         STM,R13  *R4
         LCI      3
         PLM,R13  STACK
         B        *R5
*-------
T:SELFDESTRUCT  EQU  %
         B        *R11
*-------
PULLALLEXIT  EQU  %
         PLW,R2   TSTACK
         CW,R2    TSTACK
         BNE      PULLALLEXIT
         LCI      7
         PLM,R5   TSTACK
         LCI      0
         PLM,R0   TSTACK
         LCI      3
         PLM,R0   TSTACK
         LC       R0
         STCF     CALLRTRN
         LI,R0    STACK
         LC       CALLRTRN
         B        *CALLRTRN
*-------
PUSHALL  EQU      %
         LCI      7
         PSM,R5   TSTACK
         LW,R0    TSTACK
         PSW,R0   TSTACK
         B        *R1
*-------
CALBAD   EQU      %
         LI,R12   MXX
         BAL,R11  MSG
         B        %
         B        CALBAD
MXX      TEXTC    'BAD  CAL1,6'
*-------
CHKBIT0  EQU      %
         LI,R13   X'1FFFF'
         LW,R14   0,R7
         LI,R1    X'80001'
CHKBIT   EQU      %
         SLS,R14  1
         BEV      1,R2
         LW,R12   *R7,R1
         BGEZ     %+2
         LW,R12   *R12
         BIR,R1   0,R2
*-------
SIM:CAL  EQU      %
         STW,R0   CALLRTRN          BAL+1 = ORIGINAL CAL1,6
         MTW,1    CALLRTRN          BAL+2 = RETURN POINT
         LCI      3
         PSM,R0   TSTACK
         LCI      0
         PSM,R0   TSTACK
         LW,R6    *R0
         LW,R7    R6
         AI,R7    1
         AND,R7   L(X'1FFFF')
         LW,R6    *R6
         BGEZ     %+2
         LW,R6    *R6
         AND,R6   L(X'FFFF')
         LI,R0    3                 REL.ENTRY INTO FISH
         B        FISH
*-------
CL2PA    EQU      %
         MTW,0    TAURUS
         BNEZ     X560
         AI,R8    -'A'
         BLZ      BADLETTER
         CI,R8    7
         BG       BADLETTER
XIT:CNVT EQU      %
         LCI      0
         B        *R15
X560     EQU      %
         LI,R3    #CLUNT
         LI,R2    0
NXT:C:U  EQU      %
         CB,R8    CLUSUNT,R2
         BE       FND:C:U
         AI,R2    2
         BDR,R3   NXT:C:U
         B        BADLETTER
FND:C:U  EQU      %
         AI,R2    1
         LB,R8    CLUSUNT,R2
         B        XIT:CNVT
BADLETTER  EQU    %
         LCI      1
         B        *R15
*-------
         FIN
         PAGE
*****************
*  DEF'S
***
         DEF      SYSCON            ENTRY INTO SYSCON PROCESSOR
*,*                                 ALSO NAME OF MODULE
         PAGE
********
*  REF'S
***
         DO       TEST=0
         REF      J:JIT             INPUT BITS 0-1
*,*                           CHECK ON-LINE VS GHOST VS BATCH MODE
         REF      JB:PRIV           INPUT BYTE
*,*                           CHECK PRIVILEGE LEVEL => A0
         FIN
         REF      IOTABLE           INPUT
*,*                           USED TO MAP INTO SYSCON, BASE ADDR.
         REF      IOTBLSIZ          INPUT
*,*                           TOTAL SIZE OF IOTABLE
         REF      DCT1              INPUT HALF WORD
*,*                           SEARCH FOR DEV.ADDR.(SINGLE ACCESS)
         REF      DCT1P             INPUT HALF WORD
*,*                           SEARCH FOR PRIM.DEV.ADDR.(DUAL)
         REF      DCT1A             INPUT HALF WORD
*,*                           SEARCH FOR ALT.DEV.ADDR.(DUAL)
         REF      DCTSIZ            INPUT
*,*                           TOTAL SIZE OF DCT TABLES
         REF      DCT2              INPUT BYTE
*,*                           SEARCH FOR DEV.IN SAME CHANNEL
         REF      DCT3              INPUT BYTE BIT 2
*,*                           CHECK IF DEV.ALREADY PARTITIONED
         REF      DCT4              INPUT BYTE
*,*                           OBTAIN DEV.TYPE INDEX
         REF      DCT5              INPUT BYTE BITS 0-1,3-4
*,*                           CHECK IF DEV.IS BUSY
         REF      DCT9              INPUT WORD BITS 3-4
*,*                           CHECK FOR PARTITIONED CONTROLLER PATH
         REF      DCT16             INPUT DOUBLE WORD
*,*                           OBTAIN DEV. 'YYNDD'
         REF      DCT24             INPUT BYTE BITS 1-7
*,*                           CHECK IF DEV.NOT PARTITIONABLE,
*,*                             OR NOT PRESENT.
*,*                           CHECK IF CONT.PARTITIONED,
*,*                             OR NOT PRESENT, OR
*,*                             NOT PARTITIONABLE.
*,*                           CHECK IF DEV.DOWN BY OLD
*,*                             DIAGNOSTIC CAL'S.
         REF      CIT3              INPUT BYTE BIT 4
*,*                           CHECK IF CHANNEL IS DUAL ACCESS
         REF      OH:NM             INPUT HALF WORD
*,*                           SEARCH FOR DEV.TYPE MNEMONIC
         REF      TB:FLGS           INPUT BYTE
*,*                           VALIDATE DEV.TYPE AS
*,*                             PARTITIONABLE TYPE DEV./CONT.
         REF      TYPMNSZ           INPUT
*,*                           SIZE OF OH:NM TABLES DEV.MNEMONICS
         REF      AVRTBL            INPUT DOUBLE WORD BIT 32
*,*                           CHECK FOR PUBLIC VS PRIVATE
         REF      AVRID             INPUT HALF WORD
*,*                           OBTAIN USER'S ID
         REF      AVRTBLSIZ         INPUT
*,*                           # TAPE ENTRIES IN AVRTBL
         REF      BATAPE            INPUT
*,*                           MODIFY DCT INDEX TO AVRTBL INDEX
         REF      AVRTBLNE          INPUT
*,*                           SIZE OF AVRTBL TABLE
         REF      M:SDEV            INPUT
*,*                           USED TO MAP SYSCON INTO MONITOR
         REF      M:SDEVSZ          INPUT
*,*                           SIZE OF M:SDEV
         REF      SNDDX             INPUT BYTE
*,*                           SEARCH FOR DEV.BEING SYMBIONT
         REF      NAMSCAN           ROUTINE
*,*                           OBTAIN NEXT NAME FIELD FROM COMMAND
         REF      HEXSCAN           ROUTINE
*,*                           OBTAIN NEXT FIELD FROM COMMAND,
*,*                             & IT MUST BE HEXADECIMAL.
         REF      M:UC              DCB
*,*                           USED FOR INPUT/OUTPUT WHEN
*,*                             RUNNING AS GHOST OR ON-LINE.
*****************
         PAGE
*****************
*  SPECIAL PROCS
*****************
READ     CNAME
WRITE    CNAME
         PROC
LF       CAL1,1   AF(1)
         PEND
*****************
CLUNT    CNAME
         PROC
LF       GEN,8,2,3,3  AF(1),AF(2),AF(3),AF(4)
         PEND
*****************
         PAGE
*****************
*  DCBS
*****************
M:EI     DSECT    1
M:EI     M:DCB    (FILE,'M:MODNUM',':SYS'),(KEYED),;
                  (DIRECT),(IN),(SAVE),(TRIES,10)
********
M:EO     DSECT    1
M:EO     M:DCB    (FILE,'M:MODNUM'),(KEYED),;
                  (DIRECT),(OUT),(SAVE),(TRIES,10)
********
M:SI     DSECT    1
M:SI     M:DCB    (DEVICE,'SI'),(IN),(TRIES,3),;
                  (RECL,80),(FILE),(SAVE)
         ORG      M:SI
         DATA     3                 FORCE TO DEVICE ASSIGNMENT
M:LO     DSECT    1
M:LO     M:DCB    (DEVICE,'LO'),(OUT),(TRIES,3),;
                  (RECL,80),(FILE),(SAVE)
         ORG      M:LO
         DATA     3                 FORCE TO DEVICE ASSIGNMENT
*****************
         PAGE
         CSECT    0                 DATA SECTION
         SPACE    3
*****************
*  DATA
*****************
         SPACE    2
********
MONTBLS  EQU      %                 TABLES IN MONITOR WHICH NEED TO
*                                     BE MAPPED INTO SYSCON
IOTBL    EQU      %
DCT1X    EQU      %-MONTBLS+RELADDR
         PZE      DCT1
DCT1AX   EQU      %-MONTBLS+RELADDR
         PZE      DCT1A
DCT1PX   EQU      %-MONTBLS+RELADDR
         PZE      DCT1P
DCT2X    EQU      %-MONTBLS+RELADDR
         PZE      DCT2
DCT3X    EQU      %-MONTBLS+RELADDR
         PZE      DCT3
DCT4X    EQU      %-MONTBLS+RELADDR
         PZE      DCT4
DCT5X    EQU      %-MONTBLS+RELADDR
         PZE      DCT5
DCT9X    EQU      %-MONTBLS+RELADDR
         PZE      DCT9
DCT16X   EQU      %-MONTBLS+RELADDR
         PZE      DCT16
DCT24X   EQU      %-MONTBLS+RELADDR
         PZE      DCT24
CIT3X    EQU      %-MONTBLS+RELADDR
         PZE      CIT3
TYPMNEX  EQU      %-MONTBLS+RELADDR
         PZE      OH:NM
TB:FLGSX EQU      %-MONTBLS+RELADDR
         PZE      TB:FLGS
AVRTBLX  EQU      %-MONTBLS+RELADDR
         PZE      AVRTBL
AVRIDX   EQU      %-MONTBLS+RELADDR
         PZE      AVRID
SNDDXX   EQU      %-MONTBLS+RELADDR
         PZE      SNDDX
**
#MAPTBLS EQU      %-MONTBLS         # ENTRIES IN TABLE
********
RELADDR  EQU      NEWADDR
NEWADDR  EQU      %                 PARALLEL TABLE TO MONTBLS
*                                   CONTAINS ADDRESS IN
*                                     VIRTUAL PAGE OF SPECIFIED
*                                     TABLES ORIGIN
         DO1      #MAPTBLS
         PZE      0
IOTBLA   EQU      IOTBL-MONTBLS+NEWADDR
********
#PGS1    DATA     0                 # PAGES OBTAINED FOR IOTABLE
PGADDR1  PZE      0                 ADDR.1-ST PAGE FOR IOTABLE
********
         PAGE
********
         DATA,3   0
         DATA,1   '>'               BATCH TEST PROMPT
#INCHAR  EQU      80                MAX.# CHAR.IN INPUT COMMAND
UCBUF    RES      #INCHAR/4+1       INPUT COMMAND BUFFER
********
SYSTYP2B EQU      X'2B'             MONITOR LOC.IDENTIFYING SYSTEM INFO
TAURFLG  EQU      X'C0'             FLAG IN LOC.X'2B' FOR TAURUS(BOTH=1)
MINPRIV  EQU      X'A0'             MINIMUM PRIVILEGE LEVEL FOR SYSCON
B0       EQU      X'80000000'
B1       EQU      X'40000000'
M:ADDR   EQU      X'7FE00'-(X'60000'*SIGMA)
EOB      EQU      X'26'             END OF BUFFER CODE(CHAR.SCAN S.R.)
NL       EQU      X'15'             NEW LINE CHAR.
CR       EQU      X'0D'             CARRIAGE RETURN CHAR.
BADCONT  EQU      X'FF'             BAD CONTINUATION CODE
FLP      EQU      6                 DISPLACEMENT IN DCB OF FLP
ACNT#    EQU      2                 FPARAM CODE FOR ACCOUNT #
ENTSIZ   EQU      2                 # WORDS PER ENTRY IN M:MODNUM FILE
DVBUSYFG EQU      X'D8'             DEV.BUSY FLAGS (DCT5)
OLDWND   EQU      X'40'             OLD DIAG.DOWN FLAG(DCT24)
PART:DV  EQU      X'01000000'       DEV.PART.BY SELF, NOT IN CONT.
DOWND    EQU      X'20'             DEV.PARTITIONED FLAG (DCT3)
DOWNCP   EQU      X'08'             PRIM.CONT.PART.FLAG (DCT9)
DOWNCA   EQU      X'10'             ALT.CONT.PART.FLAG (DCT9)
NOPARTD  EQU      X'01'             DEV.NOT PART.FLAG (DCT24)
NOPARTC  EQU      X'20'             CONT.NOT PART.FLAG (DCT24)
PERDWND  EQU      X'02'             DEV.PERM.DOWN FLAG (DCT24)
DUALACS  EQU      X'08'             DUAL ACCESS CONT. (CIT3)
SC1      EQU      X'01'             SUB:CHANNEL 1 (SC1) ONLY
SC2      EQU      X'02'             SEB:CHANNEL 2 (SC2) ONLY
PERDWNCP EQU      X'08'             PRIM.CONT.DOWN FLAG (DCT24)
PERDWNCA EQU      X'10'             ALT.CONT.DOWN FLAG (DCT24)
MIOPMASK EQU      X'80'             MASK TO CHK.4 MIOP VS.SIOP
MIOPCNTM EQU      X'3FF0'           IOP/CONT.PART OF DEV.ADDR.
SIOPCNTM EQU      X'3F80'           IOP/CONT.PART OF DEV.ADDR.
********
         PAGE
********
TAURUS   DATA     0                 =0 SIGMA, =1 TAURUS
BATCH    DATA     0                 =0 NOT BATCH, =1 BATCH TEST
ONLINE   DATA     0                 =0 GHOST, =1 ONLINE
LIST:LP  DATA     0                 =0 LIST ON UC, >0 LIST ON LO
CNTFLG   DATA     0                 =1 CONT OPTION, =0 OTHER OPTIONS
CONTFLG  DATA     0                 =0 PART.DEV., =1 PART.DEV.IN CONT.
PARTDUN  DATA     0                 =0 DO PART.CONT.CAL
*                                   =1 DONT DO PART.CONT.CAL
RETDUN   DATA     0                 =0 DO RET.CONT.CAL
*                                   =1 DONT DO RET.CONT.CAL
ALL:OK   DATA     0                 =0 ACCEPT ALL 'YY', & 'NDD'
*                                   =1 ACCEPT ONLY PART.TYPES
NOFLG    DATA     0                 =1 DEVICE SUSPENDED
PRIMC    DATA     0                 =0 PRIM.CONT., =1 ALT.CONT.
DISPFLG  DATA     0                 =0 MODNUM NO DISP.
*                                   =1 MODNUM DISPLAY OPTION
DEVADDR  DATA     0                 CONTAINS DEVICE ADDR.
DEV:AD   DATA     0                 CONTAINS DEV.ADDR.IN CONT.
CONTADR  DATA     0                 CONTAINS CONTROLLER ADDR.
DEVMOD#  DATA     0                 DEVICE MODEL #
CNTMOD#  DATA     0                 CONTROLLERS MODEL #
MOD200   DATA     X'7FE00'-(X'60000'*SIGMA)
IDL      TEXT     'IDLE'
         BOUND    8
UP       TEXT     'UP      '
PRT      TEXT     'PART    '
NONPRT   TEXT     'NON-PART'
PRIM     TEXT     'PRIM'
ALT      TEXT     'ALT '
********
         BOUND    8
STACKSZ  EQU      48
STACK    PZE      %+1
         GEN,16,16  STACKSZ,0
         RES      STACKSZ
********
TAPE     TEXT     'TAPE'
PACK     TEXT     'PACK'
********
MNEW     TEXT     'NEW'
MUPDATE  TEXT     'UPDATE'
MDISP    TEXT     'DISP'
********
BLNKS    TEXT     '        '
CONTR    TEXT     'CONT.-  '
DEVC     TEXT     'DEV.-   '
********
         PAGE
*****************
*  CHARACTER SCAN ROUTINE PLISTS
********
SCNPLST  EQU      %
         GEN,8,24 #DEL,BA(DEL)   -0-#D,CLD
         GEN,8,24 0,NOCONT       -1-CNTC,CONTR
         PZE      0              -2-OUTR
CCP      EQU      3                 REL.WORD OF CCP IN SCNPLST
         DATA     0              -3-CCP
FLGS     EQU      4                 REL.WORD OF FLAGS IN SCNPLST
         GEN,8,24 0,UCBUF        -4-FLAGS,CBUF
CSL      EQU      5                 REL.WORD OF CSL IN SCNPLST
         DATA     0              -5-CSL
         DATA     0              -6-PCCP
CHSTRG   EQU      7                 REL.WORD OF BUFFER IN SCNPLST
         RES      9              -7-36 CHAR.BUFFER
********
DEL      EQU      %                 LEGITIMATE DELIMITERS
         DATA,1   ','               , COMA
         DATA,1   ' '                 BLANK
         DATA,1   ':'               : COLON
         DATA,1   X'15'               NEW LINE
         DATA,1   X'0D'               RETURN
         DATA,1   X'08'               END-OF-MESSAGE
         DATA,1   X'26'               END-OF-BUFFER
         DATA,1   X'FF'               ILLEGAL CONTINUATION
#DEL     EQU      BA(%)-BA(DEL)     # DELIMITORS
         BOUND    4
*****************
         PAGE
*****************
DEVTYP   EQU      %                 TYPE MNEMONIC TABLE FLAGS
*                                   FOR UN-ACCEPTABLE DEV. TYPES
         DATA,2   X'FF'          -0-NULL
         DATA,2   X'30'          -1-NO
         DATA,2   X'73'          -2-TY
         DATA,2   X'C0'          -3-DC
         DATA,2   X'3B'          -4-ME
#DEVTYP  EQU      HA(%)-HA(DEVTYP)-1   # ENTRIES IN TABLE
         BOUND    4
********
UIDTYPS  EQU      %                 MOUNTABLE DEVICE TYPE MNEMONIC
*                                   TABLE FLAGS
         DATA,2   X'FF'          -0-NULL
         DATA,2   X'BC'          -1-9T
         DATA,2   X'B8'          -2-7T
         DATA,2   X'F0'          -3-DP
#UIDTYPS EQU      HA(%)-HA(UIDTYPS)-1   # ENTRIES IN TABLE
         BOUND    4
********
CLUSUNT  EQU      %                 TAURUS CLUSTER/UNIT CONVERSION FOR N
*                                     THIS TABLE IS A MATRIX OR VECTOR
*                                     GIVING AN INTERNAL DESIGNATION
*                                     CODE FOR CLUSTER/UNIT WHEN GIVEN
*                                     AN EXTERNAL CHARACTER DESIGNATION
         CLUNT    'A',0,0,0
         CLUNT    'B',0,1,0
         CLUNT    'C',0,1,1
         CLUNT    'D',0,1,2
         CLUNT    'E',0,1,3
         CLUNT    'F',0,1,4
         CLUNT    'G',0,1,5
         CLUNT    'H',0,2,0
         CLUNT    'I',0,2,1
         CLUNT    'J',0,2,2
         CLUNT    'K',0,2,3
         CLUNT    'L',0,2,4
         CLUNT    'M',0,2,5
         CLUNT    'N',0,3,0
         CLUNT    'O',0,3,1
         CLUNT    'P',0,3,2
         CLUNT    'Q',0,3,3
         CLUNT    'R',0,3,4
         CLUNT    'S',0,3,5
         CLUNT    'T',0,4,0
         CLUNT    'U',0,4,1
         CLUNT    'V',0,4,2
         CLUNT    'W',0,4,3
         CLUNT    'X',0,4,4
         CLUNT    'Y',0,4,5
         CLUNT    'Z',0,5,0
         CLUNT    '0',0,5,1
         CLUNT    '1',0,5,2
         CLUNT    '2',0,5,3
         CLUNT    '3',0,5,4
         CLUNT    '4',0,5,5
         CLUNT    '5',0,6,0
         CLUNT    '6',0,6,1
         CLUNT    '7',0,6,2
         CLUNT    '8',0,6,3
         CLUNT    '9',0,6,4
         CLUNT    X'6D',0,6,5
         CLUNT    '%',0,0,1
         CLUNT    '#',0,0,2
         CLUNT    '@',0,0,3
         CLUNT    ':',0,0,4
#CLUNT   EQU      HA(%)-HA(CLUSUNT)
         BOUND    4
*****************
         PAGE
*****************
2CHNMS   EQU      %                 COMMAND NAME TABLE (2 CHAR.ID'S)
         DATA,2   '  '           -0-NULL
         DATA,2   'DI'           -1-DISPLAY
         DATA,2   'PA'           -2-PARTITION
         DATA,2   'RE'           -3-RETURN
         DATA,2   '  '           -4-END (2 CHAR.ID ILLEGAL)
         DATA,2   'MO'           -5-MODNUM
#2CHNMS  EQU      HA(%)-HA(2CHNMS)-1 #2 CHAR.ID'S
         BOUND    4
********
NMS      EQU      %                 COMMAND NAME TABLE
         TEXT     'DISPLAY  '    -1-DISPLAY
NMSZ     EQU      %-NMS             # WORDS PER NAME
         TEXT     'PARTITION'    -2-PARTITION
         TEXT     'RETURN   '    -3-RETURN
         TEXT     'END      '    -4-END
         TEXT     'MODNUM   '    -5-MODNUM
         TEXT     'LIST     '    -6-LIST
         TEXT     'NOLIST   '    -7-NOLIST
ENDNMS   EQU      %-NMS             # ENTRYS IN TABLE * NMSZ
********
ROUTENT  EQU      %                 ROUTINE ENTRY VECTOR
         B        DISP           -1-DISPLAY
         B        PART           -2-PARTITION
         B        RET            -3-RETURN
         B        END            -4-END
         B        MOD            -5-MODNUM
         B        LIST           -6-LIST
         B        NOLIST         -7-NO LIST
*****************
SBCMNDS  EQU      %                 SUB-COMMANDS FOR MODNUM
         TEXT     'D'            -1-
         TEXT     'I'            -2-
         TEXT     'STOP'         -3-
#SBCMNDS EQU      %-SBCMNDS
********
SUBCMNDV EQU      %                 SUB-COMMAND VECTOR
         B        DELETE         -1-
         B        INSERT         -2-
         B        STOP           -3-
*****************
         PAGE
*****************
KEYS     EQU      %                 COMMAND KEYS
         TEXT     'CONT'         -1-CONTROLLER KEY
         TEXT     'PART'         -2-PARTITION KEY
         TEXT     'ALL '         -3-ALL KEY
#DIKEY   EQU      %-KEYS            # ENTRIES IN TABLE
********
KEYENT   EQU      %                 KEY PROCESSOR ENTRIES
         B        DICONT         -1-CONTROLLER
         B        DIPART         -2-PARTITION
         B        DIALL          -3-ALL
*****************
PERMDWNC EQU      %
         DATA     PERDWNCP       -0-SINGLE ACCESS
         DATA     PERDWNCP       -1-PRIMARY
         DATA     PERDWNCA       -2-ALTERNATE
********
DOWNC    EQU      %
         DATA     DOWNCP**24     -0-SINGLE ACCESS (PRIMARY)
         DATA     DOWNCP**24     -1-DUAL ACCESS (PRIMARY)
         DATA     DOWNCA**24     -2-DUAL ACCESS (ALTERNATE)
********
GETDEVAD EQU      %
         LH,R8    *DCT1PX,R5     -0-SINGLE ACCESS
         LH,R8    *DCT1PX,R5     -1-PRIMARY
         LH,R8    *DCT1AX,R5     -2-ALTERNATE
********
GETMSG1  EQU      %
         LM,R12   BLNKS          -0-BLANKS
         LM,R12   CONTR          -1-'CONT.-'
         LM,R12   DEVC           -2-'DEV.-'
         LM,R12   CONTR          -3-'CONT.-'
*****************
         PAGE
*****************
*  MESSAGES
*****************
HERE     EQU      %
         DATA,1   HERESZ-1
         DATA,11  'SYSCON HERE'
         DATA,1   X'15'             NEW LINE
HERESZ   EQU      BA(%)-BA(HERE)
         BOUND    4
********
BACHUSR  EQU      %
         DATA,1   BACHSZ-1
         DATA,6   'CANNOT'
         DATA,8   ' RUN AS '
         DATA,5   'BATCH'
         DATA,4   ' JOB'
         DATA,1   X'15'             NEW LINE
BACHSZ   EQU      BA(%)-BA(BACHUSR)
         BOUND    4
********
PRIVLVL  EQU      %
         DATA,1   PRIVSZ-1
         DATA,12  'INSUFFICIENT'
         DATA,10  ' PRIVILEGE'
         DATA,1   X'15'             NEW LINE
PRIVSZ   EQU      BA(%)-BA(PRIVLVL)
         BOUND    4
********
NEWLINE1 EQU      %
         DATA,1   1
         DATA,1   X'15'             NEW LINE
         BOUND    4
********
NEWLINE2 EQU      %
         DATA,1   2
         DATA,2   X'1515'           2 NEW LINES
         BOUND    4
********
NAMBAD   EQU      %
         DATA,1   NAMBADSZ-1
         DATA,7   'UNKNOWN'
         DATA,11  ' KEYWORD OR'
         DATA,6   ' VALUE'
         DATA,1   X'15'
NAMBADSZ EQU      BA(%)-BA(NAMBAD)
         BOUND    4
********
%MSG%    EQU      %                 BLANK BUFFER FOR '%'
         DO1      21
         TEXT     '    '
********
TERMBAD  EQU      %
         DATA,1   TERMSZ-1
         DATA,8   'INVALID '
         DATA,10  'TERMINATOR'
         DATA,1   X'15'
TERMSZ   EQU      BA(%)-BA(TERMBAD)
         BOUND    4
********
PARAMBAD EQU      %
         DATA,1   PARMSZ-1
         DATA,8   'UNKNOWN '
         DATA,9   'PARAMETER'
         DATA,1   X'15'
PARMSZ   EQU      BA(%)-BA(PARAMBAD)
         BOUND    4
********
CONTINU  EQU      %
         DATA,1   CONTINSZ-1
         DATA,13  'CONTINUATION '
         DATA,7   'ILLEGAL'
         DATA,1   X'15'
CONTINSZ EQU      BA(%)-BA(CONTINU)
         BOUND    4
********
LNG      EQU      32/4              # CHAR.IN FORMATTED LINE IN WORDS
ASTER    EQU      %
         DATA,1   ASTRSZ-1
         DO1      LNG
         DATA,4   '****'
         DATA,1   X'15'             NEW LINE
ASTRSZ   EQU      BA(%)-BA(ASTER)
         BOUND    4
********
TITL     EQU      %
         DATA,1   TITLSZ-1
         DATA,12  '  RESOURCE  '
         DO1      3
         DATA,4   '    '
         DATA,6   'STATUS'
         DATA,1   X'15'             NEW LINE
TITLSZ   EQU      BA(%)-BA(TITL)
         BOUND    4
********
DASH     EQU      %
         DATA,1   DASHSZ-1
         DO1      LNG
         DATA,4   '----'
         DATA,1   X'15'
DASHSZ   EQU      BA(%)-BA(DASH)
         BOUND    4
********
TITLMOD  EQU      %
         DATA,1   TITLMSZ-1
         DATA,8   '  DEVICE'
         DATA,9   '         '
         DATA,10  'CONTROLLER'
         DATA,1   X'15'             NEW LINE
TITLMSZ  EQU      BA(%)-BA(TITLMOD)
         BOUND    4
********
DEVMSG   EQU      %
         DATA,1   DVMS2SZ-1
DV1      EQU      BA(DEVMSG)+3      START OF YYNNDD
         DATA,8   '  YYNNDD'        YYNDD OR YYVALUE
         DATA,9   '         '
DV2      EQU      BA(DEVMSG)+18     START OF XXXX
         DATA,4   'XXXX'            UID, IDLE, OR PART
         DATA,1   X'15'             NEW LINE (MAY BE SET TO BLANK)
DVMS1SZ  EQU      BA(%)-BA(DEVMSG)
         DATA,8   'NON-PART'
         DATA,1   X'15'             NEW LINE
DVMS2SZ  EQU      BA(%)-BA(DEVMSG)
         BOUND    4
********
CNTMSG   EQU      %
         DATA,1   CTMS1SZ-1
CT1      EQU      BA(CNTMSG)+8      START OF YYNNDD
         DATA,16  '  CONT,YYNNDD   ' YYNDD OR YYVALUE
CT2      EQU      BA(CNTMSG)+18     START OF XXXXXXXX
         DATA,9   ' XXXXXXXX'       PART, UP, OR NON-PART
CT3      EQU      BA(CNTMSG)+30
         DATA,5   ' XXXX'           BLANK OR 'DUAL'
         DATA,1   X'15'             NEW LINE
CTMS1SZ  EQU      BA(%)-BA(CNTMSG)
         BOUND    4
********
NOPARTN  EQU      %
         TEXTC    'NON-PARTITIONABLE'
********
PERMDWN  EQU      %
         TEXTC    'NOT PRESENT'
********
ALREDYPT EQU      %
         TEXTC    'ALREADY PARTITIONED'
********
CANTPART EQU      %
         DATA,1   CANTSZ-1
         DATA,16  'CANNOT PARTITION'
         DATA,1   ','
CP0      EQU      BA(CANTPART)+18
         DATA,5   'YYNDD'
CP1      EQU      BA(CANTPART)+24
         DATA,1   ' '
         DATA,16  'XXXXXXXXXXXXXXXX'
         DATA,12  'XXXXXXXXXXXX'
CPSZ     EQU      BA(%)-CP1         # POSITIONS IN 'XX---X' PART
         DATA,1   X'15'
CANTSZ   EQU      BA(%)-BA(CANTPART)
         BOUND    4
********
SOM:DEVP EQU      %
         DATA,1   SOMDEVPS-1
         DATA,12  'SOME DEV.IN '
         DATA,15  'CONTROLLER MAY '
         DATA,14  'BE PARTITIONED'
         DATA,1   X'15'
SOMDEVPS EQU      BA(%)-BA(SOM:DEVP)
         BOUND    4
********
PKTPRT   EQU      %
         DATA,1   PKTPRTSZ-1
         DATA,3   '***'
PKTP1    EQU      WA(PKTPRT)+1
         DATA,4   'XXXX'
         DATA,2   '  '
PKTP2    EQU      HA(PKTPRT)+5
         DATA,2   'YY'
PKTP3    EQU      WA(PKTPRT)+3
         DATA,4   'XXXX'
         DATA,14  ' PARTITIONED, '
         DATA,6   'DIAL  '
PKTP4    EQU      WA(PKTPRT)+9
         DATA,4   'XXXX'
         DATA,14  ' NOT AVAILABLE'
         DATA,1   X'15'
PKTPRTSZ EQU      BA(%)-BA(PKTPRT)
         BOUND    4
********
ITEMPART EQU      %
         DATA,1   ITMPRTSZ-1
IT0      EQU      BA(ITEMPART)+1
         DATA,5   'YYNDD'
         DATA,12  ' PARTITIONED'
         DATA,1   X'15'             1 NEW LINE
ITMPRTSZ EQU      BA(%)-BA(ITEMPART)
         BOUND    4
********
SYMBTERM EQU      %
         DATA,1   SYMBSZ-1
         DATA,9   'SYMBIONT '
SYM1     EQU      HA(SYMBTERM)+5
         DATA,2   'YY'
SYM2     EQU      WA(SYMBTERM)+3
         DATA,4   'NDD '
         DATA,10  'TERMINATED'
         DATA,1   X'15'             NEW LINE
SYMBSZ   EQU      BA(%)-BA(SYMBTERM)
         BOUND    4
********
RETRND   EQU      %
         DATA,1   RETSZ-1
         DATA,12  'PARTITIONED '
RT0      EQU      BA(RETRND)+13
         DATA,5   'YYNDD'
         DATA,9   ' RETURNED'
         DATA,1   X'15'             1 NEW LINE
RETSZ    EQU      BA(%)-BA(RETRND)
         BOUND    4
********
CANTRET  EQU      %
         DATA,1   CNTRETSZ-1
         DATA,15  'CANNOT RETURN  '
CANTRT1  EQU      WA(CANTRET)+4
         DATA,6   'XXXXXX'
CANTRT2  EQU      BA(CANTRET)+22
         DATA,6   'YYNNDD'
         DATA,1   X'15'
CNTRETSZ EQU      BA(%)-BA(CANTRET)
         BOUND    4
********
BSYCNT   EQU      %
         DATA,1   BSYCNTSZ-1
         DATA,11  'CONTROLLER '
         DATA,15  'HAS BUSY DEVICE'
         DATA,1   X'15'
BSYCNTSZ EQU      BA(%)-BA(BSYCNT)
         BOUND    4
********
NOPRVPCK EQU      %
         DATA,1   NOPRVSZ-1
NPRV0    EQU      BA(NOPRVPCK)+1
         DATA,5   'YYNDD'
         DATA,5   ' NOT '
         DATA,12  'PRIVATE PACK'
         DATA,1   X'15'
NOPRVSZ  EQU      BA(%)-BA(NOPRVPCK)
         BOUND    4
********
MAPMSG   EQU      %
         DATA,1   MAPMSGSZ-1
         DATA,16  'CANNOT MAP INTO '
         DATA,7   'MONITOR'
         DATA,1   X'15'
MAPMSGSZ EQU      BA(%)-BA(MAPMSG)
         BOUND    4
********
OCMSG    EQU      %
         DATA,1   0                 SUPPLIED BY CODE
         DATA,16  '                '
         DATA,16  '                '
         BOUND    4
********
OCPRTDM  EQU      %
         TEXTC    'DEV.PART.-'
********
OCPRTCM  EQU      %
         TEXTC    'CONT.PART.FOR-'
********
OCPRTSDM EQU      %
         TEXTC    'SYMB.DEV.TERMINATED-'
********
OCRETDM  EQU      %
         TEXTC    'DEV.RET.-'
********
OCRETCM  EQU      %
         TEXTC    'CONT.RET.FOR-'
********
I:O:MSG  EQU      %
         DATA,1   IOMSGSZ-1
         DATA,1   '*'
         DATA,12  'CANNOT OPEN '
         DATA,12  'M:MODNUM IN '
         DATA,6   ':SYS  '
         DATA,4   'XXXX'
         DATA,1   X'15'
IOMSGSZ  EQU      BA(%)-BA(I:O:MSG)
         BOUND    4
********
OPNMSG   TEXT     ' OPEN M:'
********
READMSG  TEXT     ' READ M:'
********
I:O:MSG1 EQU      %
         DATA,1   IOMSG1SZ-1
         DATA,1   '*'
         DATA,13  'CANNOT OPEN  '
         DATA,9   'M:MODNUM '
         DATA,4   'XXXX'
         DATA,1   X'15'
IOMSG1SZ EQU      BA(%)-BA(I:O:MSG1)
         BOUND    4
********
OPNMSG1  TEXT     ' OPEN  M'
********
WRITMSG1 TEXT     ' WRITE M'
********
COMABRT  EQU      %
         DATA,1   ABRTSZ-1
         DATA,15  'MODNUM COMMAND '
         DATA,7   'ABORTED'
         DATA,1   X'15'
ABRTSZ   EQU      BA(%)-BA(COMABRT)
         BOUND    4
********
         PAGE
********
HDKEY    TEXTC    'HEAD'            HEAD KEY
********
TRKEY    TEXTC    'TREE'            TREE KEY
********
SECT0KEY DATA,1   9                 SECTION 00 KEY
         DATA,8   'M:MODNUM'
         DATA,1   X'03'
         BOUND    4
********
RLDCTKEY DATA,1   9                 RELDICT 00 KEY
         DATA,8   'M:MODNUM'
         DATA,1   X'02'
         BOUND    4
********
RFDFKEY  DATA,1   9                 RFDFSTK KEY
         DATA,8   'M:MODNUM'
         DATA,1   X'00'
         BOUND    4
********
EXPRKEY  DATA,1   9                 EXPRSTK KEY
         DATA,8   'M:MODNUM'
         DATA,1   X'01'
         BOUND    4
********
         PAGE
********
HEAD     EQU      %                 HEAD BUFFER
         DATA     X'8100FF30'
         DATA     X'40000000'
         DATA     0
SIZU     DATA,2   0,0               SIZE SET BEFORE WRITE
         DATA     0
* RFDFU
         DATA,2   RFDFSZ,TRSZ/4
         DATA     0,0,0,0,0,0
HDSZ     EQU      BA(%)-BA(HEAD)
********
TREE     EQU      %                 TREE BUFFER
         DATA     TRSZ/4
         TEXTC    'M:MODNUM'
         DATA     0,0
00SIZE   DATA,2   0,0               SIZE SET BEFORE WRITE
* RFDFSIZE
         DATA,2   RFDFSZ,0
         DATA     0
* EXPRSIZE
         DATA,2   EXPRSZ,0
         DATA     0,0
TRSZ     EQU      BA(%)-BA(TREE)
********
RFDF     EQU      %                 REF/DEF STACK BUFFER
         DATA     X'03060000'
         DATA     0
         DATA     X'100'
         DATA     X'06000000'
         DATA     0
         DATA     X'100'
NM       DATA,1   NMSIZ
         DATA,8   'M:MODNUM'
NMSIZ    EQU      BA(%)-BA(NM)-1
         DATA,3   0
         BOUND    4
RFDFSZ   EQU      %-RFDF
********
EXPR     EQU      %                 EXPR STACK BUFFER
         DATA     X'06040122'
         DATA     X'02000000'
         DATA     3
         DATA     0
         DATA     0
         DATA     0
EXPRSZ   EQU      %-EXPR
********
         PAGE
********
RELDICT  EQU      %                 RELDICT 00 BUFFER
         DO1      512/8
         DATA     X'EEEEEEEE'       ABS RELOCATION
********
         PAGE
********
*  OPEN M:MODNUM FPT
********
,OPNFPT  M:OPEN,L M:EI,(FILE,'M:MODNUM'),(IN),(KEYED),;
                  (DIRECT),(KEYM,11),(ERR,ERRO),(ABN,ABNO)
********
         PAGE
*----------------
         CSECT    1                 PURE-PROCEDURE SECTION
         SPACE    1
*****************
*DO*
*F*      NAME:    SYSCON
*  S Y S C O N    P R O C E S S O R
*
*        PURPOSE: PERIPHERAL AVAILABILITY CONTROL &
*                 M:MODNUM FILE MAINTENANCE.
*        DESCRIPTION:
*        THE SYSCON PROCESSOR IS USED BY THE OPERATOR OR AN ON-LINE
*        USER WITH SUFFICIENT PRIVILEGE TO:
*                 1. PARTITION RESOURCES FROM CP-V SYSTEM,
*                 2. RETURN PARTITIONED RESOURCES BACK TO CP-V SYSTEM
*                 3. REQUEST RESOURCE STATUS
*                 4. BUILD M:MODNUM FILE
*                 5. UPDATE M:MODNUM FILE
*                 6. DISPLAY M:MODNUM FILE
*        THE USER MUST HAVE A PRIVILEGE LEVEL => A0.
*
*        THE SYSTEM MUST BE:
*                 1. CP-V
*                 2. SIGMA 6,7,9, OR 560(TAURUS).
*        SYSCON CANNOT BE RUN AS A BATCH JOB,
*        EXCEPT FOR M:MODNUM FILE MANIPULATION & DISPLAYING
*        PARTITION INFORMATION.
*FIN*
*****************
         PAGE
*****************
*DO*
*F*      NAME:    SYSCON (CONTINUED)
*
*        DESCRIPTION (CONTINUED):
*        THE FOLLOWING INPUT IS PROCESSED BY SYSCON:
*                 1. DISPLAY        DISPLAY RESOURCE STATUS
*                 2. PARTITION      PARTITION RESOURCE FROM SYSTEM
*                 3. RETURN         RETURN RESOURCE TO SYSTEM
*                 4. MODNUM         BUILD,UPDATE OR DISPLAY
*                                   MODEL # FILE
*                    A. D     DELETE DEVICE TYPES
*                             DELETE CONTROLLER TYPES
*                    B. I     INSERT DEVICE/CONTROLLER TYPES
*                    C. STOP  TERMINATE MODNUM COMMAND.
*                 5. LIST           OUTPUT MESSAGES TO LO DEVICE
*                 6. NOLIST         OUTPUT MESSAGES TO UC DEVICE
*                 7. END            TERMINATE SYSCON, RETURN TO TEL
*
*        REFERENCE:
*  EXTERNAL SPEC. # 703198
*
*  INTERNAL SPEC. # 703240
*
*
*FIN*
*****************
         PAGE
SYSCON   EQU      %           <---  ENTRY
         LI,R0    STACK             INITIALIZE R0 TO STACK ADDR
         LB,R1    J:JIT
         CI,R1    (B0+B1)**-24      CHECK FOR
         BAZ      SET:BACH    YES--   BATCH USER
         LI,R2    0           NO--- RESET ONLINE FLAG
         STW,R2   ONLINE              INDICATES GHOST
         CI,R1    B1**-24           CHECK FOR
         BANZ     PRIVOK      YES--   GHOST JOB
BACH:ENT EQU      %           NO--- ONLINE
         MTW,1    ONLINE            SET ONLINE FLAG
         LB,R1    JB:PRIV           ON-LINE USER, GET PRIVILEGE LEVEL
         CI,R1    MINPRIV
         BL       EXITP       NO--- SUFFICIENT PRIVILEGE LEVEL
PRIVOK   EQU      %           YES--
         LI,R12   HERE              'SYSCON XXX HERE'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R2    X'1FE00'          MODULO 200(16) FOR SIGMA
         LI,R5    TAURFLG           CHECK FOR TAURUS SYSTEM
         CS,R5    SYSTYP2B          CP-V MONITOR INFO WORD, LOC.X'2B'
         BNE      %+3         YES-- SIGMA
         MTW,1    TAURUS      NO--- TAURUS, SET FLAG
         LI,R2    X'7FE00'          MODULO 200(16) FOR TAURUS
         STW,R2   MOD200            SET MASK
********
* CODE FOR DEBUGGING ONLY.....
****
         GO       XXX0
********
         LI,R2    IOTABLE+IOTBLSIZ-1
         CI,R2    M:SDEV
         BG       %+2               FIND AREA OF CORE
         LI,R2    M:SDEV+M:SDEVSZ-1
         CI,R2    TB:FLGS             WITH THE HIGHEST
         BG       %+2                   ADDRESS
         LI,R2    TB:FLGS+511
         AI,R2    511               TO NEXT HIGHEST PAGE
         AND,R2   MOD200            MODULO 512
         SLS,R2   -9                PAGE ADDRESS = # PAGES
         M:GP     *R2         ****  GET 'N' PAGES
         BCR,8    GOTPGS1     YES-- GET THE PAGES
*                             NO---
         M:FP     *R8         ****  FREE PAGES OBTAINED
         B        MAPBAD            'CANNOT MAP INTO MONITOR'
*----------------
GOTPGS1  EQU      %
         STW,R8   #PGS1             SAVE # PAGES
         STW,R9   PGADDR1             & ADDR. OF 1-ST PAGE
********
* CODE FOR DEBUGGING ONLY.....
****
XXX0     EQU      %
********
         LI,R2    #MAPTBLS          # ADDR. NEEDED
         LI,R1    0                 BASE ADDR. (MOD.512)
NXTBL1   EQU      %
         LW,R3    IOTBL-1,R2        GET TABLE ADDR.
         SW,R3    R1                REL. POSITION IN ORIGINAL AREA
         AW,R3    PGADDR1           ADDR.IN NEW VIRTUAL AREA
         STW,R3   IOTBLA-1,R2       NEW ADDR.
         BDR,R2   NXTBL1      NO--- DONE
*                             YES--
********
* CODE FOR DEBUGGING ONLY.....
****
         GO       XXX1
********
         LW,R2    #PGS1             # PAGES
         LW,R9    PGADDR1             & ADDR.OF 1-ST PAGE (VIRTUAL)
         LI,R1    0                 BASE ADDR.MODIFIER
MAPG1    EQU      %
         M:FVP    *R9         ****  FREE VIRTUAL PAGE
*
         M:CVM    *R1,*R9     ****  MAP REAL INTO VIRTUAL
         BCS,8    MAPBAD      EEEE  MAP CHANGE DOES NOT WORK (ABORT)
         AI,R1    X'200'            NEXT REAL PAGE ADDR.
         AI,R9    X'200'            NEXT VIRTUAL PAGE ADDR.
         BDR,R2   MAPG1       NO--- DONE
********
* CODE FOR DEBUGGING ONLY.....
****
XXX1     EQU      %
         DO       TEST=1
         LI,R1    DCTSIZ
DCTLOOP  EQU      %
         LH,R8    *DCT1X,R1
         SLS,R8   16
         SLD,R8   -24
         BAL,R15  CL2PA
         BCS,1    %
         SLD,R8   8
         STH,R8   *DCT1X,R1
         STH,R8   *DCT1PX,R1
         LW,R9    DCT1AX
         CW,R9    DCT1PX
         BE       NONPOOL
         LH,R8    *DCT1AX,R1
         SLS,R8   16
         SLD,R8   -24
         BAL,R15  CL2PA
         BCS,1    %
         SLD,R8   8
NONPOOL  EQU      %
         STH,R8   *DCT1AX,R1
         BDR,R1   DCTLOOP
         FIN
********
         B        NXTCMND     YES--
*----------------
*  'IOTABLE' & 'M:SDEV' NOW MAPPED INTO SYSCONS VIRTUAL MAP
*
*        PROCEED TO INPUT COMMANDS
*
*****************
         PAGE
*****************
*D*
*D*      NAME:    NXTCMND
*D*      ENTRY:   EXIT
*D*      DESCRIPTION:
*D*         INPUT CONTROL COMMANDS & EXIT PROCEDURES.
*D*      INTERFACE:  MSG,NAMSCAN,BACH:RED,SYNTAX-ERROR-ROUTINES
*D*      REGISTERS:  R0 IS SACRED WITHIN SYSCON, &
*D*               BE CAREFUL WITH R7 AS IT IS REQUIRED
*D*               BY CHARACTER SCAN ROUTINES (FPT ADDRESS).
*D*
********
,RDFPT   M:READ,L M:UC,(BUF,UCBUF),(SIZE,#INCHAR),(BTD,0),(WAIT)
NXTCMND  EQU      %
         M:PC     '>'         ****  SET MAIN COMMAND PROMPT CHAR.
         MTW,0    ONLINE
         BEZ      NXTCMND1    YES-- GHOST, NO NEW LINES
         LI,R12   NEWLINE2    NO--- ONLINE, '2 NEW LINES'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
NXTCMND1 EQU      %
         LI,R7    #INCHAR/4
         LW,R8    L(C'    ')
         STW,R8   UCBUF-1,R7        SET INPUT BUFFER TO BLANKS
         BDR,R7   %-1
         MTW,0    BATCH
         BEZ      NOBACH1     NO--- IN BATCH TEST MODE
         LI,R8    '>'         YES--
         STW,R8   UCBUF-1           SET PROMPT CHAR.
         BAL,R8   BACH:RED    ****  READ/OUTPUT COMMAND
         B        %+2
NOBACH1  EQU      %
         READ     RDFPT       ****  OUTPUT PROMPT(>)& REQUEST INPUT
         LI,R7    SCNPLST           CHAR.SCAN PLIST ADDRESS
         LI,R8    0                 INITIALIZE
         STW,R8   SCNPLST+CCP         SCAN
         STB,R8   SCNPLST+FLGS        PLIST
         STW,R8   SCNPLST+CSL         VALUES
         BAL,R11  NAMSCAN     ****  GET COMMAND NAME
         BCS,8    NULLIN1     EEEE  BAD NAME, OR NOTHING INPUT
         CI,R8    BADCONT
         BE       NXTCMND     YES-- CONTINUATION FOUND
         LW,R6    SCNPLST+CSL       # CHAR.IN NAME
         CI,R6    2
         BNE      CHKNM       NO--- NAME CONTAIN =2 CHAR.
*                             YES--
         LH,R12   SCNPLST+CHSTRG    GET 1-ST 2 CHAR.OF NAME
         LI,R5    #2CHNMS           # NAME TYPES (2 CHAR.ID'S)
NXT2CHNM EQU      %
         CH,R12   2CHNMS,R5
         BE       NMFND       YES-- FIND NAME
         BDR,R5   NXT2CHNM    NO--- DONE LOOKING
         B        NAMERR      EEEE  BAD NAME
*----------------
NULLIN1  EQU      %
         MTW,0    SCNPLST+CSL       # CHAR.FOUND
         BNEZ     NAMERR      EEEE  BAD NAME
         B        NXTCMND     --->  NOTHING INPUT, GET NEXT COMMAND
*----------------
CHKNM    EQU      %
         LI,R5    0
CHKNM1   EQU      %
         LI,R12   BA(NMS)           SOURCE
         AW,R12   R5                  ENTRY #
         LI,R13   BA(SCNPLST+CHSTRG)  DESTINATION
         LI,R14   NMSZ*4
         STB,R14  R13               NAME SIZE
         CBS,R12  0                 DISPLACEMENT =0
         BE       CHKNM2      YES-- FIND NAME
         AI,R5    NMSZ*4      NO--- TO NEXT NAME
         CI,R5    ENDNMS*4
         BL       CHKNM1      NO--- END OF CHECKING
*                             YES--
         B        NAMERR      EEEE  BAD NAME
*----------------
CHKNM2   EQU      %
         LI,R10   NMSZ*4            DETERMINE
         DW,R5    R10                 ENTRY #
         AI,R5    1
NMFND    EQU      %                 NAME FOUND, R5 = INDEX OF NAME
         EXU      ROUTENT-1,R5 -->  EXIT TO COMMAND PROCESSOR
*                                       DISP,PART,RET,END
*----------------
         PAGE
*****************
EXITB    EQU      %                 BATCH USER EXIT
         M:MESSAGE  (MESS,BACHUSR) **'CANNOT RUN AS BATCH JOB' TO OC
         LB,R2    BACHUSR           SIZE OF MESSAGE
         AI,R2    -1                ELIMINATE NL
         M:WRITE  M:LO,(BUF,BACHUSR),(SIZE,*R2),(BTD,1)
         B        EXIT              NOP FOR QUAC TEST IN BATCH MODE
********---------
SET:BACH EQU      %
         MTW,1    BATCH             SET BATCH FLAG
         LI,R1    1
         STB,R1   NEWLINE1          MESS.SIZE=1, ENDS UP =0
         STB,R1   NEWLINE2          MESS.SIZE=1, ENDS UP =0
         M:OPEN   M:SI,(SAVE)
OPN:LO   M:OPEN   M:LO,(SAVE)
         EXU      BACH:RED    ****  READ !SYSCON COMMAND
         B        BACH:ENT          ENTER SYSCON AS BATCH/ONLINE
*----------------
EXITP    EQU      %                 PRIVILEGE LEVEL VIOLATION EXIT
         MTW,0    BATCH
         BEZ      DO:EXITP    NO--- BATCH MODE
         EXU      CLS:SI      YES-- CLOSE & SAVE
         EXU      CLS:LO              DCBS
DO:EXITP EQU      %
         LI,R12   PRIVLVL           'INSUFFICIENT PRIVILEGE'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         DO       TEST=1
         B        PRIVOK
         FIN
         B        EXIT
*----------------
EXIT     EQU      %
         MTW,0    LIST:LP
         BNEZ     CLS:LO      YES-- WAS OUTPUT TO LO
*                             NO--- TO UC
         MTW,0    BATCH
         BEZ      DO:EXIT     NO--- BATCH MODE
CLS:SI   M:CLOSE  M:SI,(SAVE) YES-- CLOSE & SAVE
CLS:LO   M:CLOSE  M:LO,(SAVE)         DCBS
DO:EXIT  EQU      %
         M:EXIT   0           --->  EXIT
*----------------
         PAGE
*****************
*D*
*D*      NAME:    LIST
*D*      ENTRY:   NOLIST
*D*      DESCRIPTION:
*D*  LIST - FOR ON-LINE & GHOST, OUTPUT GOES TO LO.
*D*  NOLIST - FOR ON-LINE & GHOST, OUTPUT GOES TO UC.
*D*
*D*      SYNTAX OF COMMANDS:
*D*
*D*               LIST
*D*               NOLIST
*D*
*D*      REGISTERS:  R15 USED
*D*      INTERFACE:  NXTCMND.
*D*
*****************
         SPACE    3
LIST     EQU      %           <---  ENTER
         MTW,0    BATCH
         BNEZ     NXTCMND     --->  IGNORE 'LIST', IN BATCH MODE
         MTW,0    LIST:LP
         BNEZ     NXTCMND     --->  IGNORE, ALREADY FOUND 'LIST'
         EXU      OPN:LO      ****  OPEN M:LO DCB
         MTW,1    LIST:LP           SET OUTPUT TO LO FLAG
         B        NXTCMND     --->  EXIT
*----------------
NOLIST   EQU      %           <---  ENTER
         MTW,0    BATCH
         BNEZ     NXTCMND     --->  IGNORE 'NOLIST', IN BATCH MODE
         MTW,0    LIST:LP
         BEZ      NXTCMND     --->  IGNORE, NOT IN LIST MODE
         EXU      CLS:LO      ****  CLOSE M:LO DCB
         LI,R15   0
         STW,R15  LIST:LP           SET OUTPUT TO UC FLAG
         B        NXTCMND     --->  EXIT
*----------------
         PAGE
*****************
*D*
*D*      NAME:    BACH:RED
*D*      DESCRIPTION:
*D*         INPUT & OUTPUT COMMANDS IN BATCH MODE.
*D*
*D*      CALL:    R8 = LINK
*D*
*D*      REGISTERS:  R1-R2 SAVED
*D*
*****************
         SPACE    3
BACH:RED EQU      %           <---  ENTER
         M:READ   M:SI,(BUF,UCBUF),(SIZE,#INCHAR),(BTD,0),(WAIT)
         LCI      R2-R1+1
         PSM,R1   *R0               SAVE INFO
         LI,R1    ' '
         LI,R2    #INCHAR-1
         CB,R1    UCBUF,R2          SEARCH FOR
         BNE      %+2                 CHAR.POSITION
         BDR,R2   %-2                   FOR NEW LINE
         AI,R2    3
         M:WRITE  M:LO,(BUF,UCBUF-1),(SIZE,*R2),(BTD,3),(WAIT)
         AI,R2    -2
         LI,R1    NL
         STB,R1   UCBUF,R2          INSERT NEW LINE
         LCI      R2-R1+1
         PLM,R1   *R0               RESTORE INFO
         B        *R8         --->  RETURN
*----------------
         PAGE
*****************
*D*
*D*      NAME:    END
*D*      DESCRIPTION:
*D*         'END' COMMAND PROCESSOR.
*D*         EXIT BACK TO CP-V MONITOR.
*D*
*****************
         SPACE    3
END      EQU      EXIT        <---  ENTER
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    GETPARAM
*        DESCRIPTION:
*  GETPARAM ROUTINE
*
*        PROCESS THE PARAMETER FIELD & SET UP A PARAMETER TYPE
*        INDEX IN R1 & OTHER INFO IN R12
*
*        OUTPUT:
*             R1  = INDEX INDICATING TYPE OF PARAMETER, AS FOLLOWS :
*                 = 1    YYNDD
*                 = 1    YYVALUE
*                 = 1    CONT,YYNDD
*                 = 1    CONT,YYVALUE
*                 = 1    NDD
*                 = 1    VALUE
*                 = 1    CONT,NDD
*                 = 1    CONT,VALUE
*                 = 2    YY
*                 = 3    CONT
*                 = 4    ALL
*                 = 4    NO PARAMETER
*                 = 5    PART
*
*             R4  = 'YY' WHEN R1 = 2
*
*             R12 = CONVERTED'NDD'OR 'VALUE' - BITS 16-31
*                 = DCT INDEX - BITS 2-15
*                 = CONT./DEV.FLAG - BIT 0,  =0 DEVICE, =1 CONTROLLER
*                 = PRIM.CONT./ALT.CNT.FLAG-BIT 1, =0 PRIM., =1 ALT.
*
*                   DEVICE REQUIRES DCT INDEX
*                   CONTROLLER REQUIRES CIT INDEX EVENTUALLY
*
*        DEVADDR  = DEVICE ADDRESS
*        DEV:AD   = DEVICE ADDRESS
*        CONTADR  = DEVICE ADDRESS WITHIN CONTROLLR
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  NAMSCAN,HEXSCAN,HEXEHEX,SYNTAX-ERROR-ROUTINES,
*                 NXTCMND.
*        REGISTERS:  R1-R5,R8,R10-R13 USED
*FIN*
********
         SPACE    3
GETPARAM EQU      %           <---  ENTER
         LW,R10   R11               SAVE RETURN
         LI,R3    0
         STW,R3   CNTFLG            RESET 'CONT' OPTION FLAG
NXTFLD   EQU      %
         LI,R8    0                 RESET CURRENT CHAR.
         BAL,R11  NAMSCAN     ****  GET FIELD  (KEY)
         BCS,8    CHKNOPAR    YES-- 'NO PARAMETER' TYPE
         CI,R8    BADCONT     NO---
         BE       NXTCMND     YES-- BAD CONTINUATION
ALLNUM   EQU      %           NO---
         LW,R3    SCNPLST+CHSTRG    GET KEY
         LI,R2    #DIKEY            # KEYS POSSIBLE
NXTKEY   EQU      %
         CW,R3    KEYS-1,R2
         BE       KEYFND      YES-- FIND KEY:'CONT','PART', OR 'ALL'
         BDR,R2   NXTKEY      NO--- DONE SEARCH
         LH,R4    R3          YES-- KEEP'YY'
         LI,R2    TYPMNSZ           # DEVICE TYPES
         LW,R11   R10               RESTORE RETURN
NXTYY    EQU      %
         CH,R4    *TYPMNEX,R2       TYPES 'YY','YYNDD',OR 'YYVALUE'
         BE       CHK4DEV     YES-- FIND DEVICE TYPE
         BDR,R2   NXTYY       NO--- DONE SEARCH
NOTYY    EQU      %           YES-- 'NDD' OR 'VALUE' TYPE
         LW,R5    SCNPLST+CSL       # CHAR.
         CI,R5    3
         BNE      GETVAL      YES-- 'VALUE' TYPE (TAURUS)
*                             NO--- 'NDD' TYPE (TAURUS OR SIGMA)
         LW,R13   R3                GET 'NDD'
         B        CNVTHEX
*----------------
CHKNOPAR EQU      %
         CI,R8    BADCONT
         BE       NXTCMND     YES-- BAD CONTINUATION
         LW,R1    SCNPLST+CSL NO---
         BNEZ     ALLNUM      YES-- ALL NUMERIC FIELD
*                             NO---
         CI,R8    EOB
         BE       DIALL             'NO PARAMETER' OR 'ALL' PARAMETER
         CI,R8    NL
         BE       DIALL             'NO PARAMETER' OR 'ALL' PARAMETER
         CI,R8    CR
         BNE      TERMERR     EEEE  UNKNOWN TERMINATOR
DIALL    EQU      %                 'NO PARAMETER' OR 'ALL' PARAMETER
         LI,R1    4                 PARAMETER TYPE INDEX
DIPARTX  EQU      %
         MTW,0    CNTFLG
         BEZ      *R10        --->  RETURN, NOT 'CONT' TYPE
         B        TERMERR     EEEE  OPTION MISSING
*----------------
DIPART   EQU      %
         LI,R1    5                 PARAMETER TYPE INDEX
         B        DIPARTX
*----------------
DICONT   EQU      %                 'CONT' PARAMETER
         MTW,1    CNTFLG            SET 'CONT' OPTION FLAG
         CI,R8    ','
         BE       NXTFLD      NO--- 'CONT' PARAMETER ALONE
         LI,R1    3           YES--
         B        *R10        --->  RETURN
*----------------
KEYFND   EQU      %                 'CONT','PART',OR 'ALL' PARAMETER
*                                     R2 = INDEX OF KEY
         MTW,0    CNTFLG
         BNEZ     NAMERR      EEEE  'CONT' TYPE, KEY CANNOT BE
         LW,R5    SCNPLST+CSL
         CI,R5    4                 MAX.# CHAR. IN LONGEST NAME
         BG       NAMERR      EEEE  BAD NAME
         EXU      KEYENT-1,R2 --->  EXIT TO KEYWORD PROCESSOR
*                                       DICONT,DIPART, OR DIALL
*----------------
GETVAL   EQU      %                 'VALUE' PARAMETER
         MTW,0    TAURUS            CHECK FOR TAURUS SYSTEM VS. SIGMA
         BEZ      NAMERR      EEEE  'VALUE' ACCEPTED ONLY IN TAURUS
         CI,R5    4
         BNE      NAMERR      EEEE  'VALUE' BAD, MUST BE 4 CHAR.
         LW,R10   R11               SAVE RETURN
         LW,R11   L(X'20000000')    SET SCAN BUFFER
         STS,R11  SCNPLST+FLGS        STILL FULL FLAG
         BAL,R11  HEXSCAN     ****  CHECK 'VALUE'
         BCS,8    NAMERR      EEEE  BAD'VALUE'
         LW,R11   R10               RESTORE RETURN
         LW,R13   SCNPLST+CHSTRG    CHAR. IN FIELD
         LW,R5    SCNPLST+CSL       # CHAR.
CNVTHEX  EQU      %
         BAL,R10  HEXEHEX     ****  CONVERT HEX.EBCDIC TO HEX.
*
*  RETURN     R14 = CONVERTED VALUE
*
*        CNTFLG = 0 FOR NON-CONTROLLER
*               = 1 FOR CONTROLLER ('CONT' OPTION)
*
         LI,R12   0
         STW,R12  PRIMC             PRIMARY CONTROLLR FLAG
         STW,R14  DEVADDR           DEVICE ADDRESS
         STW,R14  DEV:AD            DEVICE ADDRESS
         STW,R14  CONTADR           CONTROLLER ADDRESS
         LW,R12   R14               DEVICE ADDR. ('NDD' OR 'VALUE')
         LI,R1    DCTSIZ            DCT1 TABLE SIZE (DCT1A & DCT1P)
NXTDCT1P EQU      %
         CH,R14   *DCT1PX,R1        SEARCH PRIMARY FIRST
         BE       FNDEVAD     YES-- FIND DEVICE
         BDR,R1   NXTDCT1P    NO--- DONE SEARCH
         LI,R1    DCT1A       YES--
         CI,R1    DCT1P
         BE       NAMERR      EEEE  SAME TABLES, BAD DEV.ADDR.
         MTW,1    PRIMC             SET TO ALTERNATE CONTROLLER
         LI,R1    DCTSIZ
NXTDCT1A EQU      %
         CH,R14   *DCT1AX,R1        SEARCH ALTERNATE NEXT
         BE       FNDEVAD     YES-- FIND DEVICE
         BDR,R1   NXTDCT1A    NO--- DONE SEARCH
*                             YES--
         B        NAMERR      EEEE  BAD DEV.ADDR.
*----------------
CHK:PRTA EQU      %
         MTW,0    ALL:OK
         BNEZ     NAMERR      EEEE  CANT ACCEPT DEV.TYPE
         B        ACCEPTA     YES-- ACCEPT ALL TYPES
*----------------
FNDEVAD  EQU      %
*
*     R1 = DCT INDEX
*
         LB,R3    *DCT4X,R1         GET TYPMNE INDEX
         LB,R3    *TB:FLGSX,R3      GET DEVICE TYPE FLAGS
         LI,R5    #DEVTYP           # DEVICE TYPES
NXTYPMNE EQU      %
         CH,R3    DEVTYP,R5
         BE       CHK:PRTA    NO--- LEGITIMATE DEV., BUT MAYBE
*                             YES--
         BDR,R5   NXTYPMNE    NO--- DONE SEARCH
ACCEPTA  EQU      %           YES--
         MTW,0    CNTFLG
         BEZ      %+2         NO--- 'CONT' PARAMETER
         AI,R1    X'8000'     YES-- SET 'CONT' FLAG, ENDS UP AS BIT-0
         MTW,0    PRIMC
         BEZ      %+2         YES-- PRIMARY CONTROLLER
         AI,R1    X'4000'     NO--- ALTERNATE, SET FLAG
         STH,R1   R12               DCT INDEX OF 'NDD' OR 'VALUE'
         LI,R1    1                 PARAMETER TYPE INDEX
         B        *R11        --->  RETURN
*----------------
CHK:PRTT EQU      %
         MTW,0    ALL:OK
         BNEZ     NOTYY       NO--- CANT ACCEPT DEV.TYPE
         B        ACCEPTT     YES-- ACCEPT ALL TYPES
*----------------
CHK4DEV  EQU      %                 'YY','YYNDD',OR'YYVALUE' PARAMETER
*                                     R2 = DEVICE TYPE INDEX
         LB,R12   *TB:FLGSX,R2      GET DEVICE TYPE FLAGS
         LI,R5    #DEVTYP           # DEVICE TYPES
CHK4DEV1 EQU      %
         CH,R12   DEVTYP,R5
         BE       CHK:PRTT    NO--- LEGITIMATE DEV., BUT MAYBE
*                             YES--
         BDR,R5   CHK4DEV1    NO--- DONE SEARCH
ACCEPTT  EQU      %           YES--
         LW,R5    SCNPLST+CSL
         CI,R5    2
         BG       GETNDD      YES-- 'YYNDD' OR 'YYVALUE' TYPE
*                             NO--- 'YY' TYPE
         MTW,0    CNTFLG
         BNEZ     NAMERR      EEEE  'YY' FIELD ILLEGAL FOR 'CONT' TYPE
         LI,R1    2                 PARAMETER TYPE INDEX
         B        *R11        --->  RETURN
*----------------
GETNDD   EQU      %                 'YYNDD' OR 'YYVALUE' TYPE
         LW,R5    SCNPLST+CSL       # CHAR.
         CI,R5    6
         BG       NAMERR      EEEE  BAD 'YYNDD' OR 'YYVALUE'
         LCI      2
         LM,R12   SCNPLST+CHSTRG    GET 'YYNDD' OR 'YYVALUE'
         SLD,R12  -16               PUT 'NDD' OR 'VALUE' INTO R13
         AI,R5    -2                # CHAR. -2 (EXCLUDE 'YY')
         B        CNVTHEX
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    DISP
*        DESCRIPTION:
*  'DISPLAY' COMMAND PROCESSOR
*
*        DISPLAY STATUS OF RESOURCES (I.E., PARTITIONED)
*
*        SYNTAX OF COMMAND :
*
*                (<(YY)<NDD  >       >)
*                (<    <VALUE>       >)
*                (<                  >)
*                (<YY                >)
*                (<                  >)
*      DI(SPLAY) (<CONT(,(YY)<NDD  >)>)
*                (<    (     <VALUE>)>)
*                (<                  >)
*                (<PART              >)
*                (<                  >)
*                (<ALL               >)
*
*        INTERFACE:  GETPARAM,NEWLINE,MSG,DIDEV,DICNT,
*                 SYNTAX-ERROR-ROUTINES,NXTCMND.
*FIN*
*****************
         PAGE
DISP     EQU      %           <---  ENTER TO PROCESS 'DISPLAY'
         LI,R11   0
         STW,R11  ALL:OK            ALL DEV.TYPES ACCEPTED
         BAL,R11  GETPARAM    ****  OBTAIN PARAMETER INFO
*
*  UPON RETURN :
*             R1  = INDEX INDICATING TYPE OF PARAMETER, SEE TYPES BELOW
*             R4  = 'YY' WHEN R1 = 2
*             R12 = CONVERTED 'NDD' OR 'VALUE' - BITS 16-31
*                 = DCT INDEX - BITS 2-15
*                 = CONT./DEV. FLAG - BIT 0,   = 0 DEVICE, =1 CONTROLLER
*                 = PRIM.CONT./ALT.CONT.FLAG-BIT 1, =0 PRIM., =1 ALT.
*                   DEVICE REQUIRES DCT INDEX
*                   CONTROLLER REQUIRES CIT INDEX EVENTUALLY
*        PARAMETER TYPE INDEXES ARE :
*                 = 1    YYNDD
*                 = 1    YYVALUE
*                 = 1    CONT,YYNDD
*                 = 1    CONT,YYVALUE
*                 = 1    NDD
*                 = 1    VALUE
*                 = 1    CONT,NDD
*                 = 1    CONT,VALUE
*                 = 2    YY
*                 = 3    CONT
*                 = 4    ALL
*                 = 4    NO PARAMETERS
*                 = 5    PART
*
*        DEVADDR  = DEVICE ADDRESS
*        DEV:AD   = DEVICE ADDRESS
*        CONTADR  = DEVICE ADDRESS WITHIN CONTROLLER
*
         SPACE    2
         CI,R1    5
         BNE      DO:DISP     NO--- DISPLAY PARTITIONED ITEMS
         LI,R2    DCTSIZ      YES--
LOOK@NXD EQU      %
         LB,R13   *DCT3X,R2
         CI,R13   DOWND
         BANZ     DO:DISP     YES-- DEVICE PARTITIONED
         BDR,R2   LOOK@NXD    NO--- DONE LOOKING
         LI,R2    DCTSIZ      YES--
LOOK@NXC EQU      %
         LW,R13   *DCT9X,R2
         LB,R13   R13
         CI,R13   DOWNCP+DOWNCA     CHECK PRIM./ALT.PARTIONED
         BANZ     DO:DISP     YES-- CONTROLLER PARTITIONED
         BDR,R2   LOOK@NXC    NO--- DONE LOOKING
*                             YES-- NOTHING IS PARTITIONED
         BAL,R11  NEWLINE     ****  OUTPUT NEW LINE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*----------------
DO:DISP  EQU      %
         PSW,R12  *R0               SAVE PARAMETER INFO
         BAL,R11  NEWLINE     ****  OUTPUT NEW LINE IF ONLINE
         LI,R12   ASTER             '**---*'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R12   TITL              'RESOURCE STATUS'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R12   DASH              '----'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         PLW,R12  *R0               RESTORE PARAMETER INFO
         EXU      %,R1        ****
         B        DIDEVCT        -1-DEVICE/CONTROLLER ADDRESS
         B        DIDEVTP        -2-DEVICE TYPE MNEMONIC
         B        DICONTP        -3-CONTROLLERS
         B        DIALLTP        -4-ALL/NO PARAMETER
         B        DIPARTP        -5-PART
*-----------------
DIDEVCT  EQU      %                 DISPLAY DEVICE OR CONTROLLER STATUS
         STH,R12  R13               DEV.ADDR.
         LH,R2    R12
         AND,R2   L(X'3FFF')        DCT INDEX
         CI,R12   0
         BLZ      DICNTRL     YES-- 'CONT' TYPE STATUS REQUEST
*                             NO--- DEVICE TYPE STATUS REQUEST
         LI,R15   0                 DISPLAY ALL FLAG
         BAL,R11  DIDEV       ****  DISPLAY DEVICE STATUS
DIDEVCT1 EQU      %
         BAL,R11  NEWLINE     ****  OUTPUT NEW LINE IF ONLINE
         LI,R12   ASTER             '***--*'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*-----------------
DICNTRL  EQU      %                 DISPLAY CONTROLLER STATUS
         LI,R15   0                 DISPLAY ALL FLAG
         BAL,R11  DICNT       ****  DISPLAY CONTROLLER STATUS
         B        DIDEVCT1
*-----------------
DIDEVTP  EQU      %                 DISPLAY ALL YY DEVICES STATUS
         LI,R5    TYPMNSZ           # TYPE MNEMONICS
NXTMNEM  EQU      %
         CH,R4    *TYPMNEX,R5
         BE       FNDTYPMN    YES-- FIND TYPE MNEMONIC
         BDR,R5   NXTMNEM     NO--- DONE SEARCH
         B        NAMERR      EEEE
*-----------------
FNDTYPMN EQU      %
         LI,R2    1                 ENTRY # INTO DCT
         LI,R3    DCTSIZ            # DEVICES
NXTDCTEN EQU      %
         CB,R5    *DCT4X,R2
         BE       FNDCTENT    YES-- FIND DEVICE FOR TYPE MNEMONIC
NXTENTR  EQU      %           NO---
         AI,R2    1                 NEXT ENTRY INTO DCT
         BDR,R3   NXTDCTEN    NO--- DONE SEARCH
         B        DIDEVCT1    YES--
*-----------------
FNDCTENT EQU      %
         LH,R12   *DCT1X,R2         GET DEV.ADDR.
         STH,R12  R13
         LCI      R5-R2+1
         PSM,R2   *R0               SAVE INFO
         LI,R15   0                 DISPLAY ALL FLAG
         BAL,R11  DIDEV       ****  DISPLAY DEVICE STATUS
         LCI      R5-R2+1
         PLM,R2   *R0               RESTORE INFO
         B        NXTENTR
*-----------------
DICONTP  EQU      %                 DISPLAY ALL CONTROLLERS STATUS
         LI,R15   0                 DISPLAY ALL FLAG
DICONTPX EQU      %
         LI,R11   PERDWND           SET SPECIAL FLAG
         LI,R2    1                 ENTRY # INTO DCT
         LI,R3    DCTSIZ            # DEVICES
NXTCNT   EQU      %
         PSW,R11  *R0               SAVE SPECIAL FLAG
         LH,R12   *DCT1PX,R2
         STH,R12  R13               GET DEV.ADDR.
         LI,R12   0                 PRIMARY CONTROLLER FLAG
         LCI      R3-R2+1
         PSM,R2   *R0               SAVE INFO
         BAL,R11  DICNT       ****  DISPLAY CONTROLLER STATUS
         LCI      R3-R2+1
         PLM,R2   *R0               RESTORE INFO
         LI,R6    DCT1A
         CI,R6    DCT1P
         BE       SETFLG      NO--- DUAL ACCESS SYSTEM
         LH,R12   *DCT1AX,R2  YES-- GET ALTERNATE CONT.ADDR.
         CH,R12   *DCT1PX,R2
         BE       SETFLG            SAME DEV., DON'T DISPLAY AGAIN
         STH,R12  R13
         LW,R12   L(B1)             ALTERNATE CONTROLLER FLAG
         LCI      R3-R2+1
         PSM,R2   *R0               SAVE INFO
         BAL,R11  DICNT       ****  DISPLAY CONTROLLER STATUS
         LCI      R3-R2+1
         PLM,R2   *R0               RESTORE INFO
SETFLG   EQU      %
         PLW,R11  *R0               RESTORE SPECIAL FLAG
         LB,R8    *DCT24X,R2        GET PERM.DOWN FLAG
         AND,R11  R8                SET SPECIAL FLAG ACCORDINGLY
*                                     =0, NON-PERM.DOWN DEV.FOUND
*                                     =N, STILL PERM.DOWN DEV.
CHKNXTCT EQU      %
         LB,R6    *DCT2X,R2         THIS DCT ENTRYS CIT INDEX
         LH,R8    *DCT1X,R2         DEVICE ADDRESS
         AI,R2    1                 NEXT ENTRY INTO DCT
         LB,R5    *DCT2X,R2         NEXT DCT ENTRYS CIT INDEX
         CW,R5    R6
         BNE      NEWCNT      NO--- SAME CONTROLLER
*                             YES-- MAYBE
         LI,R9    MIOPCNTM          MIOP MASK
         LI,R12   MIOPMASK          MASK TO CHECK 4 MIOP
         CW,R12   R8
         BANZ     %+2         YES-- MIOP TYPE
         LI,R9    SIOPCNTM    NO--- SIOP, SIOP MASK
         LH,R12   *DCT1X,R2         NEXT DEVICE ADDRESS
         CS,R8    R12
         BNE      NEWCNT      NO--- DEV.IN SAME CONTROLLER
         CI,R11   0           YES-- WHEN SPECIAL FLAG =0,
*                                     THEN A DEVICE WITHIN
*                                     A CONTROLLER HAS BEEN
*                                     FOUND AS NON-PERM.DOWN
         BNEZ     NEWCNTX     YES-- FURTHER DEV.IN CONT.CHECKS
         BDR,R3   CHKNXTCT    NO--- DONE
         B        DIDEVCT1    YES--
*-----------------
NEWCNT   EQU      %
         LI,R11   PERDWND           SET SPECIAL FLAG
NEWCNTX  EQU      %
         BDR,R3   NXTCNT      NO--- DONE WITH DCT/CIT
         B        DIDEVCT1    YES--
*-----------------
DIALLTP  EQU      %                 DISPLAY ALL DEVICES & CONTROLLERS ST
         LI,R15   0                 DISPLAY ALL FLAG
DIALLTPX EQU      %
         LI,R2    1                 ENTRY # INTO DCT
         LI,R3    DCTSIZ            # DEVICES
NXTDEVAL EQU      %
         LH,R12   *DCT1X,R2
         STH,12   R13               GET PRIMARY DEV.ADDR.
         LCI      R3-R2+1
         PSM,R2   *R0               SAVE INFO
         BAL,R11  DIDEV       ****  DISPLAY DEVICE STATUS
         LCI      R3-R2+1
         PLM,R2   *R0               RESTORE INFO
         AI,R2    1                 NEXT DCT ENTRY
         BDR,R3   NXTDEVAL    NO--- DONE WITH DEVICES
         CI,R15   0           YES--
         BNE      DICONTPX    YES-- DISPLAY PARTITIONED ONLY
         B        DICONTP     NO--- DISPLAY ALL CONTROLLERS STATUS NEXT
*-----------------
DIPARTP  EQU      %                 DISPLAY ALL PARTITIONED RESOURCES
         LI,R15   1                 DISPLAY PARTITIONED ONLY FLAG
         B        DIALLTPX
*-----------------
         PAGE
******************
*DO*
*D*      NAME:    NEWLINE
*        DESCRIPTION:
*  NEWLINE ROUTINE
*
*        OUTPUT NEWLINE PRIOR TO MESSAGE ONLY WHEN ONLINE.
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  MSG.
*        REGISTERS:  R12 USED, R11 SAVED
*FIN*
******************
         SPACE    3
NEWLINE  EQU      %           <---  ENTER
         MTW,0    ONLINE
         BEZ      *R11        --->  RETURN, NOT ONLINE
         PSW,R11  *R0               SAVE RETURN
         LI,R12   NEWLINE1
         BAL,R11  MSG         ****  OUTPUT
         PLW,R11  *R0               RESTORE RETURN
         B        *R11        --->  RETURN
*-----------------
         PAGE
*****************
*DO*
*D*      NAME:    PART
*        DESCRIPTION:
*  'PARTITION' COMMAND PROCESSOR
*
*        PARTITION A RESOURCE FROM THE CP-V SYSTEM
*
*        SYNTAX OF COMMAND :
*
*                <(YY)<NDD  >     >
*                <    <VALUE>     >
*    PA(RTITION) <                >
*                <CONT,(YY)<NDD  >>
*                <         <VALUE>>
*
*        INTERFACE:  GETPARAM,PRIVPACK,MVTOMSG,MSG,MSG%,
*                 HEXHEXE,OCPRTD,OCPRTC,SYMBMSG,PART6,
*                 SYNTAX-ERROR-ROUTINES,NXTCMND.
*FIN*
*****************
         PAGE
PART     EQU      %           <---  ENTER TO PROCESS 'PARTITION'
         MTW,0    BATCH
         BNEZ     EXITB       YES-- IN BATCH MODE
*                             NO--- CONTINUE O.K.
         MTW,1    ALL:OK            ACCEPT ONLY PART.TYPE DEV.
         BAL,R11  GETPARAM    ****  OBTAIN PARAMETER INFO
*
*  UPON RETURN :
*             R1  = INDEX INDICATING TYPE OF PARAMETER, SEE TYPES BELOW
*             R12 = CONVERTED 'NDD' OR 'VALUE' - BITS 16-31
*                 = DCT INDEX - BITS 2-15
*                 = CONT./DEV. FLAG- BIT 0,  = 0 DEVICE, =1 CONTROLLER
*                 = PRIM.CONT./ALT.CNT.FLAG-BIT 1, =0 PRIM., =1 ALT.
*                   DEVICE REQUIRES DCT INDEX
*                   CONTROLLER REQUIRES CIT INDEX EVENTUALLY
*        PARAMETER TYPE INDEXES ARE :
*                 = 1    YYNDD
*                 = 1    YYVALUE
*                 = 1    CONT,YYNDD
*                 = 1    CONT,YYVALUE
*                 = 1    NDD
*                 = 1    VALUE
*                 = 1    CONT,NDD
*                 = 1    CONT,VALUE
*
*                 ALL OTHER INDEXES ARE ILLEGAL
*
*        DEVADDR  = DEVICE ADDRESS
*        DEV:AD   = DEVICE ADDRESS
*        CONTADR  = DEVICE ADDRESS WITHIN CONTROLLER
*
         SPACE    2
         B        %,R1        ****
         B        PADEVCT        -1-DEVICE/CONTROLLER ADDRESS
         NOP      1           EEE-2-DEVICE TYPE MNEMONIC
         NOP      2           EEE-3-CONTROLLERS
         NOP      3           EEE-4-ALL/NO PARAMETER
         B        BADPARAM       -5-PART
*----------------
PADEVCT  EQU      %
         LI,R2    0
         STW,R2   PARTDUN           RESET DO PART.CAL FLAG
         LH,R2    R12               GET DCT INDEX
         AND,R2   L(X'3FFF')        REMOVE CONTROLLER FLAG
         CI,R12   0
         BLZ      PACNT       YES-- CONTROLLER REQUEST
*                             NO--- DEVICE REQUESTED
         LB,R4    *DCT2X,R2
         LB,R5    *CIT3X,R4
         CI,R5    DUALACS
         BANZ     DEVOK       YES-- DUAL ACCESS SYSTEM
         CW,R12   L(B1)       NO--- DEV.ADDR.CANNOT BE ALTERNATE
         BANZ     NOTAVAIL    YES-- DEV.ADDR.FOUND TO BE ALTERNATE
DEVOK    EQU      %           NO---
         LH,R13   *DCT1X,R2         GET DEV.ADDR.
         STH,R13  R13
         BAL,R11  PRIVPACK    ****  CHECK FOR PRIVATE DISK PACK
*
*  NO RETURN IF PUBLIC DISK PACK
*
         LI,R5    0
         STW,R5   CONTFLG           PARTITION DEVICE FLAG
         PAGE
*****************
*DO*
*D*      NAME:    PART2
*        DESCRIPTION:
*  PART2 ROUTINE  (SUB-ENTRY TO PART ROUTINE).
*        PARTITION DEVICES WITHIN A CONTROLLER IF NON-POOLED,
*        & IF POOLED WHEN THE OTHER CONTROLLER IS ALREADY
*        PARTITIONED.
*
*        INPUT:
*             R2  = DCT INDEX
*        CONTFLG  = 1
*        DEVADDR  = DEVICE ADDRESS
*        DEV:AD   = DEVICE ADDRESS
*        CONTADR  = CONTROLLERS DEVICE ADDRESS
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  MVTOMSG,MSG,MSG%,HEXHEXE,SYMBMSG,GETYYNDD,PUTVAL,
*                 SYNTAX-ERROR-ROUTINES,NXTCMND.
*        REGISTERS:  R1,R4-R6,R8-R10,R12-R13 USED, R11 SAVED
*FIN*
*****************
         SPACE    3
PART2    EQU      %           <---  ENTER FROM CONT OPTION
         LB,R5    *DCT24X,R2
         MTW,0    CONTFLG
         BNEZ     DEVINCNT    YES-- PART.DEV.WITHIN A CONT.PAR.REQUEST
         CI,R5    PERDWND     NO---
         BAZ      CHKDWND     NO--- DEVICE NON EXISTANT
NOTAVAIL EQU      %           YES--
         LI,R6    PERMDWN     YES-- 'NOT PRESENT'
OUTMSG   EQU      %
         BAL,R11  MVTOMSG     ****  SET UP MESSAGE
         BAL,R10  MSG%              '%'
         LW,R13   CONTADR           CURRENT DEV.ADDR.
         STH,R13  R13
         LI,R3    CP0
         BAL,R10  GETYYNDD    ****  FIX MESSAGE
         LI,R12   CANTPART          'CANNOT PART. - - - '
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  EXIT & GET NEXT COMMAND
*----------------
CHKDWND  EQU      %
         LB,R4    *DCT3X,R2
         CI,R4    DOWND
         BAZ      CKNOTPRT    NO--- DEV.ALREADY PART.
PARTNOW  EQU      %           YES--
         LI,R6    ALREDYPT          'ALREADY PART.'
         B        OUTMSG
*----------------
CKNOTPRT EQU      %
         CI,R5    NOPARTD
         BAZ      DOPARTD     NO--- DEV.NON-PARTITIONABLE
NOTPART  EQU      %           YES--
         LI,R6    NOPARTN           'NON-PART.'
         B        OUTMSG
*----------------
DOPARTD  EQU      %
         CALL
         M:DPART  (DEV,*DEVADDR) ***PARTITION DEVICE
         BCS,X'C' NOTPART     NO--- PARTITIONING SUCCESSFULL
*                             YES--
RESPART  EQU      %
         STCF     PARTDUN           SAVE CC'S FOR LATER USE
         BCS,1    CHKEXT      YES-- PART.PATH OF DUAL ONLY
NOCC4CKP EQU      %           NO--- PART.DEV.ALSO
         LC       PARTDUN           GET PREVIOUS CC'S
         BCS,1    CHKEXT      YES-- PART.PATH OF DUAL ONLY
*                             NO--- PART.DEVICE(S) ALSO
         LB,R4    *SNDDXX           SYMBIONT TABLE SIZE
NXTSNDX1 EQU      %
         CB,R2    *SNDDXX,R4        CHECK DCT INDEX
         BE       PARTSYMD    YES-- SYMBIONT DEVICE
         BDR,R4   NXTSNDX1    NO--- DONE SEARCH
         LW,R13   CONTADR     YES-- CURRENT DEV.ADDR.
         STH,R13  R13
         LI,R3    IT0
         BAL,R10  GETYYNDD    ****  FIX MESSAGE
         LI,R12   ITEMPART          'ITEM PART.'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         BAL,R11  OCPRTD      ****  MESSAGE TO OC
         LW,R4    R2                RESTORE DCT INDEX
         AI,R4    -BATAPE
         BLZ      CHKEXT            NOT DISK OR TAPE
         CI,R4    AVRTBLNE
         BGE      CHKEXT            NOT DISK OR TAPE
* PART7                             DISK OR TAPE
         LW,R12   TAPE              'TAPE'
         CI,R4    AVRTBLSIZ
         BL       %+2               TAPE
         LW,R12   PACK              PACK
         LD,R8    *DCT16X,R2        GET '   YYNDD'
         SLD,R8   8                 R8='--YY', R9='NDD-'
         AI,R9    ' '
         LI,R5    4
         LW,R13   DEV:AD            DEV.ADDR.
         SLS,R13  16
         BAL,R10  HEXHEXE     ****  CONVERT TO EBCDIC
*
*  R14 = EBCDIC DEVICE ADDRESS
*
         STW,R12  PKTP1             'PACK' / 'TAPE'
         LI,R5    PKTP2
         STH,R8   0,R5              'YY'
         STW,R9   PKTP3             'NDD'
         STW,R9   PKTP4             'NDD'
         DO       WANT:VAL=1
         MTW,0    TAURUS
         BEZ      OC:MSG            SIGMA
         STW,R14  PKTP3             TAURUS -- 'VALUE'
         STW,R14  PKTP4             'VALUE'
         FIN
OC:MSG   EQU      %
         MTW,0    BATCH
         BEZ      MESSG1      NO--- IN BATCH TEST MODE
         PSW,R11  *R0         YES-- SAVE RETURN
         LI,R12   PKTPRT
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         PLW,R11  *R0               RESTORE RETURN
         B        CHKEXT
*----------------
MESSG1   EQU      %
         M:MESSAGE  (MESS,PKTPRT) **MESSAGE TO OC
CHKEXT   EQU      %
         MTW,0    CONTFLG
         BEZ      NXTCMND     --->  EXIT, PART.DEV.
         PLW,R11  *R0               RESTORE RETURN, PART.CONT.
         B        *R11        --->  RETURN
*----------------
PARTSYMD EQU      %
         BAL,R1   SYMBMSG     ****  OUTPUT SYMBIONT MESSAGES
         B        CHKEXT
*----------------
DEVINCNT EQU      %
         CI,R5    PERDWND
*                             YES-- DEV.NON-EXISTANT
         BANZ     *R11        --->  RETURN
         PSW,R11  *R0         NO--- DEV.EXISTS, SAVE RETURN
         MTW,0    PARTDUN
         BNEZ     NOCC4CKP    YES-- PART.CONT.CAL DONE
         MTW,1    PARTDUN     NO--- SET FLAG & DO CAL
         CALL
         M:DPART  (CONT,*CONTADR) **PARTITION DEV.& CONT.
         BCR,X'C' RESPART     YES-- PARTITIONING SUCCESSFULL
         LI,R6    NOPARTN     NO--- 'NON-PART.'
         BAL,R11  MVTOMSG     ****  SET UP MESSAGE
         BAL,R10  MSG%        ****  OUTPUT '%'
         LW,R13   CONTADR           CURRENT DEV.ADDR.
         STH,R13  R13
         LI,R3    CP0
         BAL,R10  GETYYNDD    ****  FIX MESSAGE
         LI,R12   CANTPART          'CANNOT PART.----'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R12   SOM:DEVP          'SOME DEV.MAY BE PART.---'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         PLW,R11  *R0               RESTORE RETURN
         MTW,1    NOFLG             SET NO PART.FLAG
         B        *R11        --->  RETURN
*----------------
PACNT    EQU      %
         LB,R4    *DCT2X,R2
         LB,R5    *CIT3X,R4
         CI,R5    DUALACS
         BANZ     PACNTDUL    YES-- DUAL ACCESS CONT.
         LI,R1    0           NO--- SINGLE ACCESS CONT.INDEX
         CW,R12   L(B1)             DEV.ADDR.CANNOT BE ALTERNATE
         BANZ     NOTAVAIL    YES-- DEV.ADDR.FOUND TO BE ALTERNATE
*                             NO--- PRIM.ADDR.
CMNCONT  EQU      %
         LW,R6    *DCT9X,R2
         LB,R4    *DCT24X,R2
         CW,R4    PERMDWNC,R1
         BANZ     NOTAVAIL    NO--- CONT.EXIST
         CW,R6    DOWNC,R1    YES--
         BANZ     PARTNOW     YES-- CONT.ALREADY PART.
         CI,R4    NOPARTC     NO---
         BANZ     NOTPART     YES-- CONT.NOT PARTITIONABLE
*                             NO---
         LB,R6    *DCT2X,R2
*
*  IF A PACK CONTROLLER,
*    LOOK AT ALL DEVICES WITHIN CONTROLLER FOR PRIVATE
*
         LI,R7    0                 1ST DCT(I) FOR DEVICE
         LI,R5    1                 DCT INDEX
CHK4CIT  EQU      %
         LB,R12   *DCT2X,R5
         CW,R12   R6
         BE       CITSAME     YES-- FIND DEV.IN CNT.
CKNXTCIT EQU      %           NO--
         AI,R5    1                 TO NEXT DCT
         CI,R5    DCTSIZ
         BG       ENDCTCHK    YES-- END IF DCTS
         B        CHK4CIT     NO---
*----------------
CITSAME  EQU      %
         LI,R9    MIOPCNTM          MIOP MASK
         LI,R12   MIOPMASK          MASK TO CHK.4 MIOP
         CW,R12   CONTADR
         BANZ     %+2         YES-- MIOP TYPE
         LI,R9    SIOPCNTM    NO--- SIOP, SIOP MASK
         EXU      GETDEVAD,R1       GET APPROPRIATE DEV.ADDR.
         CS,R8    CONTADR
         BNE      CKNXTCIT    NO--- FIND A MATCH ON CONTROLLER
*                             YES--
         MTW,0    R7
         BNEZ     %+2         YES-- 1ST DCT(I) FOR DEV.FOUND
         STW,R5   R7          NO--- SAVE 1ST DCT(I) FOR DEV.
         CI,R1    0
         BE       NO:POOL     NO--- DUAL ACCESS POOLED DEV.
         LB,R12   *DCT3X,R5   YES--
         AND,R12  L(SC1+SC2)        KEEP FLAGS FOR PATHS
         CI,R12   SC1+SC2
         BE       CKNXTCIT    YES-- TRUE POOLED DEV.
NO:POOL  EQU      %           NO--- LOOK AT CONT.DEVICES
         LH,R13   *DCT1X,R5
         STH,R13  R13
         STW,R2   R12               SAVE DCT INDEX
         LW,R2    R5                CURRENT DCT INDEX
         BAL,R11  PRIVPACK    ****  CHECK FOR PRIVATE PCK
*
*  NO RETURN IF PUBLIC DISK PACK
*
         LW,R2    R12               RESTORE DCT INDEX
         LB,R12   *DCT24X,R5        CANNOT PARTITION CONTROLLER
         CI,R12   NOPARTD             IF A DEVICE WITHIN IT IS
         BANZ     NOTPART             NOT PARTITIONABLE
*                                   ALL'S OK
         B        CKNXTCIT
*----------------
ENDCTCHK EQU      %
         LI,R12   1
         STW,R12  CONTFLG           SET CNTROLLER FLAG
         PSW,R2   *R0               SAVE DCT INDEX
         BAL,R11  PART6       ****  PART.ALL DEV. IN CONT.& CONT.
         PLW,R2   *R0               RESTORE DCT INDEX
         MTW,0    NOFLG
         BEZ      ENDCNT      NO--- ANY DEVICES NON-PARTITIONABLE
         LI,R12   0           YES--
         STW,R12  NOFLG             RESET FLAG
         B        NXTCMND     --->  GET NEXT COMMAND
*----------------
ENDCNT   EQU      %
         LCI      2
         LM,R8    CONTR             'CONT.-'
         SCD,R8   -24
         LI,R3    IT0
         BAL,R10  PUTVAL      ****  FIX MESSAGE
         LI,R12   ITEMPART          'ITEM PARTITIONED'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         BAL,R11  OCPRTC      ****  MESSAGE TO OC
         B        NXTCMND     --->  EXIT
*----------------
PACNTDUL EQU      %
         LB,R1    *DCT3X,R2
         AND,R1   L(SC1+SC2)        KEEP FLAGS FOR PATHS
         BEZ      PRM:ALTP    NO--- SC1 OR SC2, NEITHER (00)
         CI,R1    SC1+SC2     YES--
         BNE      NOTPOOLP    NO--- TRUELY POOLED, NO (01/10)
PRM:ALTP EQU      %           YES-- POSSIBLY, (00/11)
         LI,R1    2                 ALT.CONT.INDEX
         CW,R12   L(B1)
         BANZ     CMNCONT     YES-- ALT.PATH
PACNTPRM EQU      %           NO--- PRIM.PATH
         LI,R1    1                 PRIM.CONT.INDEX
         B        CMNCONT
*----------------
NOTPOOLP EQU      %                 SC1/SC2, (01/10)
         LW,R6    *DCT9X,R2
         LB,R6    R6                GET FLAGS
         CI,R1    SC2
         BANZ     ALTP        YES-- SC2 ONLY (10)
         CW,R12   L(B1)       NO--- SC1 ONLY (01)
         BAZ      PACNTPRM    YES-- PRIM.PATH
         CI,R6    DOWNCA      NO--- ALT.PATH
         BANZ     PARTNOW     YES-- ALREADY PARTITIONED
         B        NOTAVAIL    NO---
*----------------
ALTP     EQU      %                 SC2 ONLY (10)
         CW,R12   L(B1)
         BANZ     PACNTALT    YES-- ALT.PATH
         CI,R6    DOWNCP      NO--- PRIM.PATH
         BANZ     PARTNOW     YES-- ALREADY PARTITIONED
         AND,R12  L(X'FFFF')  NO--- KEEP DEV.ADDR.ONLY
         CH,R12   *DCT1AX,R2
         BNE      NOTAVAIL    NO--- ADDR.ALSO ALT.ADDR.PATH,NO ERR.
*                             YES--
PACNTALT EQU      %
         LI,R1    2                 ALTERNATE CONTROLLER INDEX
         B        CMNCONT
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    PART6
*        DESCRIPTION:
*  PART6 ROUTINE
*
*    USED TO PARTITION CONTROLLER & ALL DEVICES
*        WITHIN A CONTROLLER, IF DEVICES ARE IN SINGLE ACCESS PATH.
*        COULD BE THAT THEY WERE ORIGINALLY DUAL (I.E., POOLED)
*        BUT ONE PATH HAS BEEN PARTITIONED ALREADY.
*
*        INPUT:
*              R1 = INDEX IDENTIFYING SINGLE/DUAL ACCESS(PRIM/ALT)
*              R7 = DCT INDEX OF 1ST DEVICE IN CONTROLLER
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  PART2.
*        REGISTERS:  R2,R5,R8-R9 USED, R1,R7,R11 SAVED
*FIN*
*****************
         SPACE    3
PART6    EQU      %           <---  ENTRY
         PSW,R11  *R0               SAVE RETURN
PART6A   EQU      %
         LW,R2    R7
         LW,R5    R2
         EXU      GETDEVAD,R1       GET APPROPRIATE DEV.ADDR.
         LI,R9    MIOPCNTM          MIOP TYPE MASK
         LI,R11   MIOPMASK          MIOP MASK
         CW,R11   CONTADR
         BANZ     %+2         YES-- MIOP TYPE
         LI,R9    SIOPCNTM    NO--- SIOP TYPE, SIOP MASK
         CS,R8    CONTADR
         BNE      PART6AX     NO--- THIS CONT.THE ONE
*                             YES--
         STW,R8   CONTADR           SET UP DEV.ADDR.
         STW,R8   DEV:AD            DEV.ADDR.WITHIN CONT.
         PSW,R1   *R0               SAVE DCT INDEX
         PSW,R7   *R0               SAVE DCT INDEX
         BAL,R11  PART2       ****  PARTITION DEVICE
         PLW,R7   *R0               RESTORE DCT INDEX
         PLW,R1   *R0               RESTORE DCT INDEX
         MTW,0    NOFLG
         BNEZ     PART6AX     NO--- CAN PART.CONT.CONTINUE
*                             YES--
         AI,R7    1                 TO NEXT DCT INDEX
         LB,R8    *DCT2X,R7
         CB,R8    *DCT2X,R2
         BE       PART6A      NO--- END OF DEV.IN CONT.
PART6AX  EQU      %           YES--
         PLW,R11  *R0               RESTORE RETURN
         B        *R11        --->  RETURN
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    RET
*        DESCRIPTION:
*  'RETURN' COMMAND PROCESSOR
*
*        RETURN A PARTITIONED RESOURCE BACK TO THE CP-V SYSTEM
*
*        SYNTAX OF COMMAND :
*
*                <(YY)<NDD  >     >
*                <    <VALUE>     >
*       RE(TURN) <                >
*                <CONT,(YY)<NDD  >>
*                <         <VALUE>>
*
*        INTERFACE:  GETPARAM,GETYYNDD,MSG,OCRETD,OCRETC,
*                 SYNTAX-ERROR-ROUTINES,NXTCMND.
*FIN*
*****************
         PAGE
RET      EQU      %           <---  ENTER TO PROCESS 'RETURN'
         MTW,0    BATCH
         BNEZ     EXITB       YES-- IN BATCH MODE
*                             NO--- CONTINUE O.K.
         LI,R11   0
         STW,R11  ALL:OK            ALL DEV.TYPES ACCEPTED
         BAL,R11  GETPARAM    ****  OBTAIN PARAMETER INFO
*
*  UPON RETURN :
*             R1  = INDEX INDICATING TYPE OF PARAMETER, SEE TYPES BELOW
*             R12 = CONVERTED 'NDD' OR 'VALUE' - BITS 16-31
*                 = DCT INDEX - BITS 2-15
*                 = CONT./DEV. FLAG - BIT 0, = 0 DEVICE, =1 CONTROLLER
*                 = PRIM.CONT./ALT.CONT.FLAG-BIT 1, =0 PRIM., =1 ALT.
*                   DEVICE REQUIRES DCT INDEX
*                   CONTROLLER REQUIRES CIT INDEX EVENTUALLY
*        PARAMETER TYPE INDEXES ARE :
*                 = 1    YYNDD
*                 = 1    YYVALUE
*                 = 1    CONT,YYNDD
*                 = 1    CONT,YYVALUE
*                 = 1    NDD
*                 = 1    VALUE
*                 = 1    CONT,NDD
*                 = 1    CONT,VALUE
*
*                 ALL OTHER INDEXES ARE ILLEGAL
*
*        DEVADDR  = DEVICE ADDRESS
*        DEV:AD   = DEVICE ADDRESS
*        CONTADR  = DEVICE ADDRESS WITHIN CNTROLLER
*
         SPACE    2
         B        %,R1        ****
         B        REDEVCT        -1-DEVICE/CONTROLLER ADDRESS
         NOP      1           EEE-2-DEVICE TYPE MNEMONIC
         NOP      2           EEE-3-CONTROLLERS
         NOP      3           EEE-4-ALL/NO PARAMETER
         B        BADPARAM       -5-PART
*----------------
REDEVCT  EQU      %
         LI,R1    0                 FLAG FOR NO RETURN
         STW,R1   RETDUN            RESET RETURN CAL DONE FLAG
         LH,R2    R12               GET DCT INDEX
         AND,R2   L(X'3FFF')        REMOVE FLAGS
         LB,R5    *DCT2X,R2
         LB,R5    *CIT3X,R5
         CI,R5    DUALACS           CHECK FOR DUAL ACCESS
         BANZ     RETRN       YES-- DUAL ACCESS, CONTINUE
         CW,R12   L(B1)       NO--- DEV.ADDR.=ALTERNATE
         BANZ     NORETRN     YES-- ALTERNATE BAD NOT DUAL ACCESS
RETRN    EQU      %           NO--- CONTINUE RETURN CHECKING
         CI,R12   0
         BLZ      RETCNT      YES-- CONTROLLER REQUEST
*                             NO--- DEVICE REQUESTED
         LI,R1    2                 DEV.REQUEST FLAG
         LW,R5    *DCT9X,R2
         LB,R5    R5
         LI,R13   SC2               ALT.PATH FLAG
         LI,R11   DOWNCP            PRIM.PATH PART.FLAG
         CW,R12   L(B1)
         BAZ      %+3         YES-- PRIM.ADDR.
         LI,R11   DOWNCA      NO--- ALT.ADDR., ALT.PATH PART.FLAG
         LI,R13   SC1               PRIM.PATH FLAG
         CW,R5    R11
         BANZ     NORETRNX    YES-- CONT.DOWN, CHECK FURTHER
         LB,R10   *DCT3X,R2   NO---
         LI,R11   DOWNCA
         LI,R13   SC1
         CW,R12   L(B1)
         BAZ      %+3         YES-- PRIM.ADDR.
         LI,R11   DOWNCP      NO--- ALT.
         LI,R13   SC2
         CW,R5    R10
         BANZ     CHKMORR     YES-- IS SUB-CHAN.AVAIL.,NOT PART.
         CW,R5    R11         NO--- CHECK OTHER PATH PART.
         BANZ     NORETRN     YES-- DONT RET.DEV.
CHKMORR  EQU      %           NO--- RET.RESOURCE
         LB,R5    *DCT24X,R2
         CI,R5    OLDWND
         BANZ     DO:RET      YES-- OLD DIAG.FLAG SET
*                             NO---
         LB,R5    *DCT3X,R2
         CI,R5    DOWND
         BAZ      NORETRN     NO--- DEVICE PARTITIONED
DO:RET   EQU      %           YES--
         CALL
         M:DRET   (DEV,*DEVADDR) ***RETURN PARTITIONED DEVICE
CHKRETCC EQU      %
         BCR,X'C' RETOK       YES-- RETURN SUCCESSFULL
NORETRN  EQU      %           NO---
         LCI      2
         EXU      GETMSG1,R1        GET APPROPRIATE MESSAGE INFO
         STM,R12  CANTRT1           PUT INTO MESSAGE
         LW,R13   CONTADR
         STH,R13  R13               DEV.ADDR.IN LEFT HALF
         LI,R3    CANTRT2
         LCI      R7-R1+1
         PSM,R1   *R0               SAVE INFO
         BAL,R10  GETYYNDD    ****  PUT YYNDD INTO MESSAGE
         LCI      R7-R1+1
         PLM,R1   *R0               RESTORE INFO
         LI,R12   CANTRET           'CANNOT RETURN'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         CI,R1    3
         BGE      CNTBUSY     YES-- DEV.WITHIN CONT.BUSY
*                             NO---
         B        NXTCMND     --->  EXIT
*----------------
NORETRNX EQU      %
         LB,R5    *DCT3X,R2         GET FLAGS
         CW,R5    R13
         BAZ      NORETRN     NO--- OTHER PATH AVAIL.,ERROR IF NOT
         B        CHKMORR     YES-- CONTINUE
*----------------
RETOK    EQU      %
         STCF     RETDUN            SAVE CC'S FOR LATER USE
         BCS,1    NXTCITR     YES-- RET.PATH OF DUAL CONT.ONLY
NOCC4CKR EQU      %           NO--- RET.DEV.ALSO
         LC       RETDUN            GET PREVIOUS CC'S
         BCS,1    NXTCITR     YES-- RET.PATH ONLY
         LW,R13   CONTADR     NO--- CORRENT ADDR.
         STH,R13  R13
         CI,R1    3
         BL       GIVMSG      YES-- DEV.IN CONT.
         LW,R3    *DCT9X,R5   NO---
         CW,R3    L(PART:DV)
         BANZ     NXTCITR     YES-- DEV.PART.ALONE, NOT IN CONT.
GIVMSG   EQU      %           NO--- PART.IN CONT.
         LI,R3    RT0
         BAL,R10  GETYYNDD    ****  FIX MESSAGE
         LI,R12   RETRND            'ITEM RETURNED'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         BAL,R11  OCRETD      ****  OCRETD/OCRETC, MESS.TO OC
         CI,R1    3
         BGE      NXTCITR     YES-- DEV.WITHIN CONT.
*                             NO---
         B        NXTCMND     --->  EXIT
*----------------
RETCNT   EQU      %
         LI,R1    3                 CONTROLLER REQUEST FLAG
         LI,R7    0                 SINGLE ACCESS PATH INDEX
         LB,R4    *DCT2X,R2
         LB,R5    *CIT3X,R4
         CI,R5    DUALACS
         BAZ      RETCNT1     NO--- DUAL ACCESS
         LB,R6    *DCT3X,R2   YES--
         AND,R6   L(SC1+SC2)        KEEP PATH FLAGS
         BEZ      PRM:ALTR    NO--- SC1/SC2 PATH, NEITHER (00)
         CI,R6    SC1+SC2     YES--
         BE       NORETCNT    YES-- POOLED, NO (00)
*                             NO---
NOTPOOLR EQU      %                 (01/10)
         LI,R7    2                 ALT.CONT.INDEX
         CI,R6    SC2
         BANZ     ALTR        YES-- SC2 ONLY (10)
         CW,R12   L(B1)       NO--- SC1 ONLY (01)
         BANZ     RETCNT1     YES-- ALT.ADDR.
         AND,R12  L(X'FFFF')  NO--- PRIM.
         CH,R12   *DCT1AX,R2
         BE       RETCNT1     YES-- PRIM.ADDR.=ALT.ADDR.
         B        NORETCNT    NO--- ERROR
*----------------
ALTR     EQU      %                 (10)
         LI,R7    1                 PRIM.CONT.INDEX
         CW,R12   L(B1)
         BANZ     NORETCNT    YES-- ALT.ADDR., ERROR
*                             NO---
RETCNT1  EQU      %
         LW,R6    *DCT9X,R2
         CW,R6    DOWNC,R7
         BANZ     RETCNT2     YES-- CONTROLLER PARTITIONED
NORETCNT EQU      %           NO---
         LI,R1    1                 RETURN TYPE FLAG
         B        NORETRN
*----------------
CNTBUSY  EQU      %
         LI,R12   BSYCNT            'DEV.IN CONT.BUSY'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  EXIT
*----------------
PRM:ALTR EQU      %                 (00)
         LI,R7    2                 ALT.CONT.INDEX
         CW,R12   L(B1)
         BANZ     %+2         YES-- ALT.ADDR.
         LI,R7    1           NO--- PRIM., PRIM.CONT.INDEX
         LW,R6    *DCT9X,R2
         CW,R6    DOWNC,R7
         BANZ     RETCNT2     YES-- CONT.PART.
         CW,R12   L(B1)       NO---
         BANZ     NORETCNT    YES-- ALT.ADDR., NO RET.
         LH,R6    *DCT1PX,R2  NO--- PRIM.ADDR.
         CH,R6    *DCT1AX,R2
         BNE      NORETCNT    NO--- PRIM.ADDR.=ALT.ADDR., NO, NO RET.
*                             YES--
RETCNT2  EQU      %
         LB,R6    *DCT2X,R2
         LI,R5    1                 DCT INDEX
CHK4CITR EQU      %
         LB,R12   *DCT2X,R5
         CW,R12   R6
         BE       CITSAMER    YES-- FIND DESIRED ENTRY
NXTCITR  EQU      %           NO---
         AI,R5    1                 NEXT DCT INDEX
         CI,R5    DCTSIZ
         BG       OCNTMSG     YES-- DONE
         B        CHK4CITR    NO---
*----------------
CITSAMER EQU      %
         LI,R9    MIOPCNTM          MIOP CONT.MASK
         LI,R12   MIOPMASK          MIOP MASK
         CW,R12   CONTADR
         BANZ     %+2         YES-- MIOP TYPE
         LI,R9    SIOPCNTM    NO--- SIOP TYPE, SIOP MASK
         EXU      GETDEVAD,R7       GET APPROPRIATE DEV.ADDR.
         CS,R8    CONTADR
         BNE      NXTCITR     NO--- FIND DESIRED ENTRY
         STW,R8   CONTADR     YES-- SAVE DEV.ADDR.
         LB,R2    *DCT24X,R5
         CI,R2    PERDWND
         BANZ     NXTCITR     YES-- DEV.PERM.DOWN, GET NEXT DEV.
*                             NO---
         LW,R2    R5
         MTW,0    RETDUN
         BNEZ     NOCC4CKR    YES-- RET.CONT.CAL DONE
         MTW,1    RETDUN      NO--- SET FLAG & DO CAL
         CALL
         M:DRET   (CONT,*CONTADR) **RETURN CONTROLLER & DEVICE
         B        CHKRETCC
*----------------
OCNTMSG  EQU      %
         LCI      2
         LM,R8    CONTR             'CONT.-'
         SCD,R8   -24
         LI,R3    RT0
         BAL,R10  PUTVAL      ****  FIX MESSAGE
         LI,R12   RETRND            'ITEM RETURNED'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         BAL,R11  OCRETC      ****  MESSAGE TO OC
         B        NXTCMND     --->  EXIT
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    DIDEV
*        DESCRIPTION:
*  DIDEV ROUTINE
*
*        DISPLAY STATUS FOR A GIVEN DEVICE
*
*        INPUT:
*             R2  = DCT INDEX
*             R13 = DEV.ADDR.(LEFT JUSTIFIED)
*             R15 = 0, DISP.ALL,  =1, DISP.PART.ONLY
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  SETYYNDD,MSGCMN,HEXHEXE.
*        REGISTERS:  R1-R3,R5-R6,R8-R10,R12-R14 USED, R11 SAVED
*FIN*
*****************
         SPACE    3
DIDEV    EQU      %           <---  ENTER
         LB,R5    *DCT24X,R2        GET DEV.FLAGS
         CI,R5    PERDWND
*                             YES-- DEV. PERMANENTLY DOWN
         BANZ     *R11        --->  RETURN
         LI,R3    DV1         NO---
         BAL,R10  SETYYNDD    ****  PUT YYNNDD INTO MESSAGE
         LI,R13   DVMS1SZ-1         MESSAGE SIZE
         LI,R6    X'15'             NEW LINE CHAR.FOR MESSAGE
         LB,R5    *DCT3X,R2         GET DEV.FLAGS
         CI,R5    DOWND
         BAZ      NOTPRT      NO--- DEVICE PARTITIONED
         LW,R14   PRT         YES-- 'PART'
CMNMVEDV EQU      %
         LI,R5    4
         LI,R3    DV2
NXTCHDV  EQU      %
         SCS,R14  8                 PUT INFO
         STB,R14  0,R3                INTO
         AI,R3    1                   MESSAGE
         BDR,R5   NXTCHDV     NO--- DONE
         LI,R5    DVMS1SZ-1   YES--
         STB,R6   DEVMSG,R5         PUT BLANK/NEW LINE INTO MESSAGE
         LI,R12   DEVMSG            MESSAGE ADDR.
         PSW,R11  *R0               SAVE RETURN
         BAL,R11  MSGCMN      ****  OUTPUT MESSAGE
         PLW,R11  *R0               RESTORE RETURN
         B        *R11        --->  RETURN
*----------------
NOTPRT   EQU      %                 IDLE OR BUSY
         CI,R15   0
         BNEZ     *R11        --->  EXIT IF DISP.PART.ONLY
         LB,R5    *DCT24X,R2
         CI,R5    NOPARTD
         BAZ      CHKBUSY     NO--- NON-PARTITIONABLE
         LI,R13   DVMS2SZ-1   YES-- MESSAGE SIZE
         LI,R6    ' '               BLANK CHAR.FOR MESSAGE
CHKBUSY  EQU      %
         LB,R5    *DCT5X,R2         GET DEV.FLAGS
         CI,R5    DVBUSYFG
         BANZ     CHK4UID     YES-- DEVICE BUSY
         LW,R14   IDL         NO--- 'IDLE'
         B        CMNMVEDV          PUT INFO INTO MESSAGE & DISPLAY
*----------------
CHK4UID  EQU      %
         LB,R3    *DCT4X,R2         GET TYPE
         LB,R3    *TB:FLGSX,R3         MNEMONIC FLAGS
         LI,R1    #UIDTYPS
NXTUIDTP EQU      %
         CH,R3    UIDTYPS,R1
         BE       GETUID      YES-- FIND UID TYPE MNEMONIC
         BDR,R1   NXTUIDTP    NO--- DONE SEARCH
BLNKUID  EQU      %           YES--
         LW,R14   L(C'    ')        BLANK UID
         B        CMNMVEDV          PUT INFO INTO MESSAGE & DISPLAY
*----------------
GETUID   EQU      %
         AI,R2    -BATAPE           INDEX INTO AVR TABLES
         LD,R8    *AVRTBLX,R2       GET AVR INFO
         CI,R9    0
         BLZ      BLNKUID     YES-- PUBLIC DISK PACK
*                             NO--- PRIVATE DISK PACK OR TAPE
         PSW,R13  *R0               SAVE DEV.ADDR.
         LH,R13   *AVRIDX,R2        GET USER'S ID
         STH,R13  R13               LEFT JUSTIFY IT
         LI,R5    4                 # CHAR. TO CONVERT
         BAL,R10  HEXHEXE     ****  CONVERT HEX.TO HEX.EBCDIC
*
*  RETURN     R14 = CONVERTED VALUE
*
         PLW,R13  *R0               RESTORE DEV.ADDR.
         B        CMNMVEDV          PUT UID INTO MESSAGE
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    DICNT
*        DESCRIPTION:
*  DICNT ROUTINE
*
*        DISPLAY STATUS FOR A GIVEN CONTROLLER
*
*        INPUT:
*             R2  = DCT INDEX OF DEVICE FOR CONTROLLER
*             R12 = PRIM./ALT.CONT.FLAG(BIT 1), =0 PRIM., =1 ALT.
*             R13 = DEV.ADDR.(LEFT JUSTIFIED)
*             R15 = 0 DISP.ALL,  = 1 DISP.PART.ONLY
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  GETYYNDD,MSGCMN.
*        REGISTERS:  R3,R5,R10,R12-R14 USED, R11,R15 SAVED
*FIN*
*****************
         SPACE    3
DICNT    EQU      %           <---  ENTER
         LH,R5    R13
         CI,R5    -1
         BE       *R11        --->  RETURN, DEV.ADDR.NO EXIST
         LB,R5    *DCT24X,R2        GET CONT.& DEV.FLAGS
         LI,R3    PERDWNCP
         CW,R12   L(B1)
         BAZ      %+2         YES-- PRIMARY CONTROLLER
         LI,R3    PERDWNCA    NO--- ALTERNATE CONTROLLER
         CW,R5    R3
*                             YES-- CONT.PERMANENTLY DOWN
         BANZ     *R11        --->  RETURN
         PSW,R15  *R0               SAVE INFO
         LI,R3    CT1         NO---
         BAL,R10  GETYYNDD    ****  PUT YYNDD INTO MESSAGE
         LW,R5    *DCT9X,R2
         LB,R5    R5
         LW,R15   BLNKS             BLANKS
         LI,R14   DOWNCP            PRIM.CONT.PATH FLAGS
         LB,R3    *DCT2X,R2
         LB,R3    *CIT3X,R3
         CI,R3    DUALACS
         BAZ      SNGL        NO--- DUAL ACCESS
         LW,R15   ASTER+1     YES--
         LH,R3    *DCT1PX,2
         CH,R3    *DCT1AX,R2
         BE       SNGL        NO--- POOLED DEVICES
         LW,R15   PRIM        YES-- 'PRIM'
         CW,R12   L(B1)
         BAZ      SNGL        YES-- PRIM.ADDR.
         LI,R14   DOWNCA      NO--- ALT.ADDR.
         LW,R15   ALT               'ALT'
SNGL     EQU      %
         LI,R12   4
         LI,R3    CT3
NXTCH    EQU      %
         STB,R15  0,R3              PUT BLANK OR 'DUAL' INTO MSG.
         SCS,R15  -8
         AI,R3    -1
         BDR,R12  NXTCH       NO--- DONE
         LI,R3    CT2         YES--
         CW,R5    R14
         BANZ     ISPRT       YES-- CONT.PART.
         CI,R5    0           NO---
         BEZ      CHKNOPRT    NO--- CONT.PART.
         CI,R14   DOWNCP      YES--
         BAZ      CHKNOPRT    NO--- PRIM.CONT.DOWN
         LH,R12   *DCT1PX,R2  YES--
         CH,R12   *DCT1AX,R2
         BNE      CHKNOPRT    NO--- PRIM.ADDR.=ALT.ADDR.
         CI,R5    DOWNCA      YES--
         BAZ      CHKNOPRT    NO--- ALT.CONT.PART.
ISPRT    EQU      %           YES--
         LD,R14   PRT               'PART'
CMNMVECT EQU      %
         LI,R5    8
NXTCHCNT EQU      %
         SCD,R14  8                 PUT INFO
         STB,R15  0,R3                INTO
         AI,R3    1                   MESSAGE
         BDR,R5   NXTCHCNT    NO--- DONE
*                             YES--
         LI,R12   CNTMSG            MESSAGE ADDR.
         LI,R13   CTMS1SZ-1         SIZE
         PSW,R11  *R0               SAVE RETURN
         BAL,R11  MSGCMN      ****  OUTPUT MESSAGE
         PLW,R11  *R0               RESTORE RETURN
         PLW,R15  *R0               RESTORE INFO
         B        *R11        --->  RETURN
*----------------
CHKNOPRT EQU      %
         PLW,R15  *R0               RESTORE INFO
         CI,R15   0
         BNEZ     *R11        --->  EXIT IF DISP.PART.ONLY
         PSW,R15  *R0               SAVE INFO
         LB,R5    *DCT24X,R2
         CI,R5    NOPARTC
         BAZ      CHKUP       NO--- NON-PARTITIONABLE
         LD,R14   NONPRT      YES-- 'NON-PART'
         B        CMNMVECT          PUT INFO INTO MESSAGE
*----------------
CHKUP    EQU      %
         LD,R14   UP                'UP'
         B        CMNMVECT          PUT INFO INTO MESSAGE
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    MOD
*        ENTRY:   STOP
*        ENTRY:   DELETE
*        ENTRY:   INSERT
*        ENTRY:   NXTSUBCM
*        DESCRIPTION:
*    MOD,STOP,DELETE,INSERT,NXTSUBCM ROUTINES
*
*    THIS ROUTINE DISPLAYS, UPDATES, OR BUILDS THE FILE M:MODNUM.
*    THE FILE CONTAINS DEV. AND CONT. MODULE #'S.
*    WHEN DIPLAY OR UPDATE, M:MODNUM IS OBTAINED FROM :SYS ACCOUNT.
*
*    COMMAND SYNTAX :
*
*           <NEW   >
*  MO(DNUM) <UPDATE>
*           <DISP  >
*
*        SUB-COMMAND SYNTAX :
*
*        D        <DVVVV>
*                 <VVVV >
*
*        I        DVVVV,VVVV
*
*        STOP
*
*        INTERFACE:  NAMSCAN,BACH:RED,GETFELD,NEWLINE,
*                 MSG,I/O-SYNTAX-ERROR-ROUTINES,
*                 SYNTAX-ERROR-ROUTINES,NXTCMND,NXTSUBCM.
*FIN*
******************
         SPACE    3
MOD      EQU      %           <---  ENTER
         LI,R7    SCNPLST
         LI,R15   0                 NO DISPLAY FLAG
         STW,R15  DISPFLG             INITIALIZED
         BAL,R11  NAMSCAN     ****  GET KEY WORD
         BCS,8    NAMERR      EEEE  BAD NAME
         LW,R3    SCNPLST+CHSTRG
         CW,R3    MNEW
         BE       BUILD       YES-- KEY = 'NEW'
         CW,R3    MDISP       NO---
         BE       DISPLAY     YES-- KEY = 'DISP'
         CW,R3    MUPDATE     NO---
         BNE      NAMERR      EEEE  UNKNOWN KEY
         LW,R3    SCNPLST+CHSTRG+1
         CW,R3    MUPDATE+1
         BNE      NAMERR      EEEE  UNKNOWN KEY
DISPUPDT EQU      %                 'DISP' / 'UPDATE'
         M:GP     1           ****  GET WORK AREA
         BCS,8    %-1               NO SPACE AVAILABLE, WAIT
         STW,R9   PGADDR1           SAVE ADDRESS OF WORK AREA
         LW,R1    M:EI+FLP          DCBS FILE PARAMETER LIST ADDR.
FPRAM0   EQU      %
         LB,R8    *R1               PARAMETER TYPE CODE
         CI,R8    ACNT#
         BE       FPRAM1      YES-- FIND ACCOUNT CODE
         LI,R2    1           NO---
         LB,R8    *R1,R2
         BNEZ     DOOPN       YES-- END OF PARAMETER LIST
         LI,R2    3           NO---
         LB,R8    *R1,R2
         AI,R8    1
         AW,R1    R8                TO NEXT PARAMETER
         B        FPRAM0
*----------------
FPRAM1   EQU      %
         LI,R2    1
         STB,R2   OPNFPT+8,R2       OPEN FPT WITH NO ACCNT.FIELD
DOOPN    EQU      %
         M:OPEN,E OPNFPT      ****  OPEN TO M:MODNUM IN :SYS/OTHER
         M:SETDCB M:EI,(ERR,ERRR),(ABN,ABNR)
         M:READ   M:EI,(BUF,*PGADDR1),(SIZE,512*4),;
                  (KEY,SECT0KEY),(WAIT),;
                  (ERR,ERRR),(ABN,ABNR)
         M:CLOSE  M:EI,(SAVE)
NEWUPDAT EQU      %
         LW,R1    *PGADDR1          # ENTRIES
         LW,R2    PGADDR1           TABLE ORIGIN
         AI,R2    ENTSIZ            TO 1ST ENTRY
         MTW,0    DISPFLG
         BNEZ     DISPMOD#    YES-- DISPLAY OPTION
*                             NO--- UPDATE OR NEW OPTIONS
NXTSUBCM EQU      %
         M:PC     '.'         ****  SUBCOMMAND PROMPT
         LI,R7    #INCHAR/4         BUFFER SIZE (WORDS)
         LW,R8    L(C'    ')
         STW,R8   UCBUF-1,R7        BLANK OUT INPUT BUFFER
         BDR,R7   %-1
         MTW,0    BATCH
         BEZ      NOBACH2     NO--- IN BATCH TEST MODE
         LI,R8    '.'         YES--
         STW,R8   UCBUF-1           SET PROMPT CHAR.
         BAL,R8   BACH:RED    ****  READ/OUTPUT COMMAND
         B        %+2
NOBACH2  EQU      %
         READ     RDFPT       ****  GET SUB-COMMAND
         LI,R7    SCNPLST           CHARACTER ROUTINES PLIST ADDR.
         LI,R8    0
         STW,R8   SCNPLST+CCP       INITIALIZE
         STB,R8   SCNPLST+FLGS        PLIST
         STW,R8   SCNPLST+CSL           FLAGS
         BAL,R11  NAMSCAN     ****  GET SUB-COMMAND TYPE
         BCS,8    NULLIN2     EEEE  BAD FIELD, OR NOTHING INPUT
         CI,R8    BADCONT
         BE       NXTSUBCM    YES-- CONTINUATION BAD
         LW,R6    SCNPLST+CHSTRG
         LI,R5    #SBCMNDS          # SUB-COMMANDS
CHKSUBCM EQU      %
         CW,R6    SBCMNDS-1,R5
         BE       SUBCMNDF    YES-- FIND SUB-COMMAND
         BDR,R5   CHKSUBCM    NO--- DONE SEARCH
         B        IDERR       EEEE  BAD NAME
*----------------
NULLIN2  EQU      %
         MTW,0    SCNPLST+CSL       # CHAR.FOUND
         BNEZ     IDERR       EEEE  BAD FIELD
         B        NXTSUBCM    --->  NOTHING INPUT, GET NEXT COMMAND
*----------------
SUBCMNDF EQU      %
         EXU      SUBCMNDV-1,R5 ****EXIT TO APPROPRIATE ROUTINE
*----------------
         PAGE
STOP     EQU      %           <---  ENTER
         M:OPEN   M:EO,(FILE,'M:MODNUM'),(OUT),(SAVE),(KEYED),;
                  (DIRECT),(KEYM,11),;
                  (ERR,ERROO),(ABN,ABNOO)
         M:SETDCB M:EO,(ERR,ERRW),(ABN,ABNW)
         LW,R3    *PGADDR1          GET # ENTRIES IN TABLE
         MI,R3    ENTSIZ            # WORDS
         AI,R3    ENTSIZ            TOTAL # WORDS
         LW,R2    R3
         AI,R2    1
         SLS,R2   -1                # DOUBLE WORDS
         STH,R2   SIZU              PUT INTO HEAD
         STH,R2   00SIZE            PUT INTO TREE
         M:WRITE  M:EO,(BUF,HEAD),(SIZE,HDSZ),(KEY,HDKEY),(ONEWKEY),;
                  (ERR,ERRW),(ABN,ABNW)
         M:WRITE  M:EO,(BUF,TREE),(SIZE,TRSZ),(KEY,TRKEY),(ONEWKEY),;
                  (ERR,ERRW),(ABN,ABNW)
         M:WRITE  M:EO,(BUF,RFDF),(SIZE,RFDFSZ*4),(KEY,RFDFKEY),;
                  (ONEWKEY),(ERR,ERRW),(ABN,ABNW)
         M:WRITE  M:EO,(BUF,EXPR),(SIZE,EXPRSZ*4),(KEY,EXPRKEY),;
                  (ONEWKEY),(ERR,ERRW),(ABN,ABNW)
         SLS,R3   2                 (BYTES)
         M:WRITE  M:EO,(BUF,*PGADDR1),(SIZE,*R3),;
                  (KEY,SECT0KEY),(ONEWKEY),;
                  (ERR,ERRW),(ABN,ABNW)
         AI,R3    31                CALCULATE SIZE OF RELDICT 00
         DW,R3    L(32)
         SLS,R3   2                 SIZE (BYTES)
         M:WRITE  M:EO,(BUF,RELDICT),(SIZE,*R3),;
                  (KEY,RLDCTKEY),(ONEWKEY),(WAIT),;
                  (ERR,ERRW),(ABN,ABNW)
         M:CLOSE  M:EO,(SAVE)
         M:FP     1           ****  FREE WORK AREA
         B        NXTCMND     --->  EXIT
*----------------
         PAGE
DISPLAY  EQU      %           <---  ENTER
         LI,R15   1                 SET
         STW,R15  DISPFLG             DISPLAY FLAG
         B        DISPUPDT
*----------------
         PAGE
BUILD    EQU      %           <---  ENTER
         M:GP     1           ****  GET WORK AREA
         BCS,8    %-1               NO SPACE AVAILABLE, WAIT
         STW,R9   PGADDR1           SAVE WORK AREA ADDRESS
         LI,R1    0                 0'S TO WORK AREA
         LI,R2    512-1
         STW,R1   *R9,R2
         BDR,R2   %-1
         STW,R1   *R9
         B        NEWUPDAT
*----------------
         PAGE
DELETE   EQU      %           <---  ENTER
         BAL,R4   GETFELD     ****  PROCESS OPTION FIELDS
*
*  RETURN +0      DEVICE TYPE MODEL #
*         +1      CONTROLLER TYPE MODEL #
*        R12 = MODEL #
*  NO RETURN IF ERROR FOUND
*
         B        SETDELDV
         B        SETDELCN
*----------------
SETDELDV EQU      %                 LOOK AT DEVICE ENTRY
         LI,R15   0                 INDEX MODIFIER
         B        CHK#ENT
*----------------
SETDELCN EQU      %
         AI,R2    1                 LOOK AT CONTROLLER ENTRY
         LI,R15   1                 INDEX MODIFIER
         SCD,R12  -8                R12 = 'VVVV'
CHK#ENT  EQU      %
         CI,R1    0
         BEZ      NXTSUBCM    NO--- ANY ENTRIES IN TABLE
         LI,R4    0           YES--
NXTMOD#  EQU      %
         CW,R12   *R2,R4
         BE       DELMOD#     YES-- FIND ENTRY
         AI,R4    ENTSIZ      NO--- TO NXT ENTRY
NXTMODNO EQU      %
         BDR,R1   NXTMOD#     NO--- DONE
         B        NEWUPDAT    --->  EXIT
*----------------
DELMOD#  EQU      %
         LCI      R4-R1+1
         PSM,R1   *R0               SAVE INFO
         LW,R5    *PGADDR1          # ENTRIES
         MI,R5    ENTSIZ            # WORDS IN TABLE
         SW,R5    R4                # ENTRIES
         AI,R5    -ENTSIZ             TO MOVE FOR DELETE
         LW,R3    R2                DESTINATION ADDR.FOR MOVE
         AW,R3    R4                SOURCE ADDR.FOR MOVE
         AW,R2    R4
         AI,R2    ENTSIZ
         SW,R3    R15
         SW,R2    R15
         MTW,-1   *PGADDR1          # ENTRIES -1
         CI,R5    0
         BEZ      ENDMOVE     NO--- ANY MOVE
MOVENT   EQU      %           YES--
         LCI      ENTSIZ            MOVE ENTRIES REMOVING
         LM,R8    *R2                 DELETE REQUESTED ENTRY
         STM,R8   *R3
         AI,R2    ENTSIZ
         AI,R3    ENTSIZ
         AI,R5    -1
         BGZ      MOVENT      NO--- DONE MOVE
ENDMOVE  EQU      %           YES--
         LCI      R4-R1+1
         PLM,R1   *R0               RESTORE INFO
         B        NXTMODNO
*----------------
         PAGE
INSERT   EQU      %           <---- ENTER
         BAL,R4   GETFELD     ****  GET DEVICE MODEL # FIELD
*
*  RETURN +0      DEVICE TYPE MODEL #
*         +1      CONTROLLER TYPE MODEL #
*        R12 = MODEL #
*  NO RETURN IF ERROR FOUND
*
         B        SETINSDV
         B        IDERR       EEEE  ILLEGAL OPTION
*----------------
SETINSDV EQU      %
         STW,R12  DEVMOD#           SAVE DEVICE MODEL #
         CI,R8    ','
         BNE      DELERR      EEEE  UNKNOWN DELIMETER
         BAL,R4   GETFELD     ****  GET CONTROLLER MODEL #
*
*  RETURN +0      DEVICE TYPE MODEL #
*         +1      CONTROLLER TYPE MODEL #
*        R12 = MODEL #
*  NO RETURN IF ERROR FOUND
*
         B        IDERR       EEEE  ILLEGAL OPTION
         B        SETINSCN
*----------------
SETINSCN EQU      %
         SCD,R12  -8                R12 = 'VVVV'
         STW,R12  CNTMOD#           SAVE CONTROLLER MODEL #
         LW,R1    *PGADDR1          # ENTRIES IN TABLE
         LW,R2    PGADDR1           WORK AREA ADDRESS
         AI,R2    ENTSIZ            TO 1ST ENTRY
         MI,R1    ENTSIZ            NEXT ENTRY
         AW,R1    R2
         MTW,1    *PGADDR1          INCREMENT # ENTRIES
         LW,R4    DEVMOD#
         STW,R4   *R1               PUT DEV.MODEL # INTO ENTRY
         AI,R1    1
         LW,R4    CNTMOD#
         STW,R4   *R1               PUT CONT.MODEL # INTO ENTRY
         B        NEWUPDAT    --->  EXIT
*----------------
         PAGE
DISPMOD# EQU      %
*  R1 = # ENTRIES IN TABLE
*  R2 = ADDRESS OF 1ST ENTRY
         BAL,R11  NEWLINE     ****  OUTPUT NEWLINE
         LI,R12   ASTER             '****'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R12   TITLMOD           TITLE
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R12   DASH              '----'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R4    LNG
         LW,R5    L('    ')         BLANKS TO BUFFER
         STW,R5   OCMSG-1,R4
         BDR,R4   %-1
         LI,R4    LNG*4-8           SET BUFFER LENGTH
         STB,R4   OCMSG
         CI,R1    0
         BEZ      DISPDONE    YES-- DONE
NEXTDISP EQU      %           NO---
         LCI      ENTSIZ
         LM,R12   *R2         GET ENTRY
         STW,R12  OCMSG+1           DEV.MODEL #
         STW,R13  OCMSG+5           CONT.MODEL #
         LI,R12   X'15'             NEW LINE
         LI,R4    LNG*4-8
         STB,R12  OCMSG,R4          NEW LINE IN MESSAGE
         LI,R12   OCMSG
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         AI,R2    ENTSIZ
         BDR,R1   NEXTDISP    NO--- DONE
DISPDONE EQU      %           YES--
         BAL,R11  NEWLINE     ****  OUTPUT NEWLINE
         LI,R12   ASTER             '****'
         BAL,R11  MSG         ****  OUTUT MESSAGE
         M:FP     1           ****  RETURN WORK AREA
         B        NXTCMND     --->  EXIT
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    GETFELD
*        DESCRIPTION:
*  GETFELD ROUTINE
*
*     OBTAIN A FIELD FROM MODNUM SUB-COMMANDS.
*
*        OUTPUT:
*        EXIT TO BAL +1 IF DEV.MOD.#
*        EXIT TO BAL +2 IF CONT.MOD.#
*             R6  = # CHAR. IN STRING
*            R12  = 'VVVV' OR 'VVV-'  (DEV./CONT.RESPECTIVELY)
*            R13  = '---D' OR '---V'  (DEV./CONT.RESPECTIVELY)
*
*        CALL:    R4 = LINK
*
*        INTERFACE:  HEXSCAN,I/O-SYNTAX-ERROR-ROUTINES.
*        REGISTERS:  R6,R8,R11-R13 USED, R4 SAVED
*FIN*
*****************
         SPACE    3
GETFELD  EQU      %           <---  ENTER
         LI,R8    0
         BAL,R11  HEXSCAN     ****  GET MODEL # FIELD
         BCS,8    IDERR       EEEE  BAD FIELD
         CI,R8    BADCONT
         BE       NXTSUBCM    --->  EXIT, BAD CONTINUATION
         LCI      2
         LM,R12   SCNPLST+CHSTRG    'DVVVV---' OR 'VVVV----'
         SCD,R12  8                 R12='VVVV'/'VV--', R13='---D'/'---V'
         AND,R13  L(X'FF')
         LW,R6    SCNPLST+CSL
         CI,R6    4
         BE       1,R4        --->  RETURN, +1
         CI,R6    5
         BNE      IDERR       EEEE  BAD FIELD
         CI,R13   'D'
         BNE      IDERR       EEEE  BAD FIELD
         B        0,R4        --->  RETURN, +0
*----------------
         PAGE
*****************
*D*
*D*      NAME:    I/O-SYNTAX-ERROR-ROUTINES
*D*      ENTRY:   ERRO
*D*      ENTRY:   ABNO
*D*      ENTRY:   ERRR
*D*      ENTRY:   ABNR
*D*      ENTRY:   ERROO
*D*      ENTRY:   ABNOO
*D*      ENTRY:   ERRW
*D*      ENTRY:   ABNW
*D*      ENTRY:   IDERR
*D*      ENTRY:   DELERR
*D*  ERROR/ABNORMAL ROUTINES FOR I/O ON M:MODNUM FILE & SYNTAX ERRORS.
*D*      ROUTINES INCLUDE:  ERRO,ABNO,ERRR,ABNR,ERROO,ABNOO,
*D*               ERRW,ABNW,IDERR,DELERR.
*D*      INTERFACE:  HEXHEXE,NEWLINE,MSG,MSG%,NXTSUBCM,NXTCMND.
*D*
*****************
         SPACE    3
ERRO     EQU      %           <---  ERROR ON OPEN
ABNO     EQU      %           <---  ABNORMAL ON OPEN
         LI,R15   0
         LCI      2
         LM,R2    OPNMSG
CMNERR   EQU      %                 FORM APPROPRIATE MESSAGE
         STM,R2   I:O:MSG+2
*  R1 = ADDRESS IN DCB OF ACCOUNT #
         LCI      2
         LM,R2    1,R1              GET ACCOUNT # FROM DCB
         LI,R7    10
         LI,R8    8
STRACNT  EQU      %
         STB,R3   I:O:MSG+5,R7      PUT ACCOUNT # INTO MESS.
         AI,R7    -1
         SLD,R2   -8
         BDR,R8   STRACNT     NO--- DONE
*                             YES--
         LI,R1    I:O:MSG
         LI,R3    8
CMNERR1  EQU      %
         LI,R13   0
         LH,R12   R10               GET ERR/ABN CODE AND SUB-CODE
         SLS,R12  -1
         SLD,R12  -7                SUB-CODE
         SLS,R13  -1
         SLD,R12  -8
         LI,R5    4
         BAL,R10  HEXHEXE     ****  CONVERT TO EBCDIC
*
*  R14 = CONVERTED VALUE IN EBCDIC
*
         STW,R14  *R1,R3            ERR/ABN CODE TO MESSAGE
         BAL,R11  NEWLINE     ****  OUTPUT NEWLINE
         LW,R12   R1
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         CI,R15   0
         BEZ      ERRABNXT    YES-- ERR/ABN ON OPEN
*                             NO--- ON READ/WRITE
         M:CLOSE  *R15,(SAVE)
ERRABNXT EQU      %
         LI,R12   COMABRT           ABORT MESSAGE
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         M:FP     1           ****  RETURN WORK AREA
         B        NXTCMND     --->  EXIT
*----------------
ERRR     EQU      %           <---  ERROR ON READ
ABNR     EQU      %           <---  ABNORMAL ON READ
         LCI      2
         LM,R2    READMSG
         LI,R15   M:EI
         B        CMNERR
*----------------
ERROO    EQU      %           <---  ERROR ON OPEN
ABNOO    EQU      %           <---  ABNORMAL ON OPEN
         LI,R15   0
         LCI      2
         LM,R2    OPNMSG1
CMNERR2  EQU      %
         STM,R2   I:O:MSG1+2        FORM APPROPRIATE MESSAGE
         LI,R1    I:O:MSG1
         LI,R3    6
         B        CMNERR1
*----------------
ERRW     EQU      %           <---  ERROR ON WRITE
ABNW     EQU      %           <---  ABNORMAL ON WRITE
         LI,R15   M:EO
         LCI      2
         LM,R2    WRITMSG1
         B        CMNERR2
*----------------
IDERR    EQU      %           <---  ENTER
         CI,R8    BADCONT
         BE       NXTSUBCM    --->  EXIT, BAD CONTINUATION
         BAL,R10  MSG%        ****  '%'
         LI,R12   NAMBAD            'UNKNOWN ID'
IDERRX   EQU      %
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTSUBCM    --->  EXIT
*----------------
DELERR   EQU      %           <---  ENTER
         CI,R8    BADCONT
         BE       NXTSUBCM    --->  EXIT, BAD CONTINUATION
         BAL,R10  MSG%        ****  '%'
         LI,R12   TERMBAD           'BAD TERMINATOR'
         B        IDERRX
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    HEXEHEX
*        DESCRIPTION:
* HEXEHEX ROUTINE
*
*        CONVERT A 'YYNDD' (SIGMA), 'YYNDD' (TAURUS) OR 'YYVALUE' (TAURU
*        VALUE FROM EBCDIC TO HEX.. IF TAURUS = 0, CONVERT AS SIGMA
*        'YYNDD'. IF TAURUS = 1, CONVERT AS TAURUS 'YYNDD' OR 'YYVALUE',
*        THAT IS, 'YYNDD' IF R5 = 3, & 'YYVALUE' IF R5 = 4.
*
*        INPUT:
*             R5  = # CHAR.TO CONVERT
*             R13 = 3 OR 4 EBCDIC CHAR.(LEFT JUSTIFIED,BLANK FILLED)
*
*        OUTPUT:
*             R14 = CONVERTED VALUE RIGHT JUSTIFIED & ZERO FILLED
*
*        CALL:    R10 = LINK
*
*        INTERFACE:  SYNTAX-ERROR-ROUTINES.
*        REGISTERS:  R1,R5,R13-R15 USED, R10 SAVED
*FIN*
*****************
         SPACE    3
HEXEHEX  EQU      %          <---   ENTER
         LI,R14   0
         MTW,0    TAURUS
         BNEZ     TAUCNVT     YES-- TAURUS TYPE CONVERSION
         CI,R5    3           NO--- SIGMA
         BNE      NAMERR      EEEE  SIGMA 'NDD' REQUIRES 3 DIGITS
         LB,R14   R13
         AI,R14   -'A'
         BLZ      NAMERR      EEEE  MUST BE CHANNEL LETTER  'A' - 'P'
         CI,R14   X'16'             CHECK FOR >'P' OR '0' - 'F' DIGIT
         BG       NAMERR      EEEE  NOT 'A' - 'P'
         CI,R14   8                 CONVERT
         BLE      %+2                 'A' = 0, 'B' = 1, THRU
         AI,R14   -7                  'P' = F
         AI,R5    -1                # CHAR.LEFT
         SLS,R13  8                 REMOVE EBCDIC 'N' FROM 'NDD'
NXTDGTE  EQU      %
         LB,R15   R13               CONVERT
         AI,R15   -'0'                A
         BGEZ     %+2                 CHAR.
         AI,R15   X'39'               TO HEX.
         CI,R15   X'F'
         BG       NAMERR      EEEE  NOT HEX.NUMBER
         CI,R15   0
         BLZ      NAMERR      EEEE  BAD DIGIT
         SCS,R15  -4
         SLD,R14  4                 FORM RESULT
         SCS,R13  8                 TO NEXT DIGIT
         BDR,R5   NXTDGTE     NO--- DONE CONVERSION
         B        *R10        YES-- RETURN
*----------------
TAUCNVT  EQU      %
         CI,R5    4
         BE       NXTDGTE     YES-- 'YYVALUE' TYPE
*                             NO--- 'YYNDD' TYPE
         CI,R5    3
         BNE      NAMERR      EEEE  'NDD' REQUIRES 3 DIGITS
         LB,R14   R13               GET 'N'
         LI,R15   #CLUNT            MATRIX SIZE
         LI,R1    0
NXTCLUNT EQU      %
         CB,R14   CLUSUNT,R1        SEARCH FOR 'N'
         BE       FNDCLUNT    YES-- FIND 'N'
         AI,R1    2           NO--- TO NEXT MATRIX ENTRY
         BDR,R15  NXTCLUNT    NO--- DONE SEARCH
*                             YES--
         B        NAMERR      EEEE
*----------------
FNDCLUNT EQU      %
         AI,R1    1                 TO CLUSTER/UNIT CODE
         LB,R14   CLUSUNT,R1        GET CLUSTER/UNIT PER 'N'
         SLS,R13  8                 POSITION TO 'DD'
         AI,R5    -1                # CHAR.TO CONVERT -1
         B        NXTDGTE           FORMS A 'VALUE' TYPE FROM 'NDD'
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    HEXHEXE
*        DESCRIPTION:
*  HEXHEXE ROUTINE
*
*        CONVERT A VALUE IN HEX. TO AN EBCDIC #
*
*        INPUT:
*             R5  = # CHAR.TO CONVERT
*             R13 = CHAR., LEFT JUSTIFIED
*
*        OUTPUT:
*             R14 = CONVERTED VALUE RIGHT JUSTIFIED & ZERO FILLED
*
*        CALL:    R10 = LINK
*
*        REGISTERS:  R5,R13-R14 USED, R10,R12 SAVED
*FIN*
*****************
         SPACE    3
HEXHEXE  EQU      %           <---  ENTER
         PSW,R12  *R0               SAVE INFO
         LW,R14   L(C'0000')
NXTDGTH  EQU      %
         SLS,R14  8                 MAKE ROOM FOR NEXT EBCDIC CHAR.
         LI,R12   0
         SLD,R12  4                 GET NEXT DIGIT
         AI,R12   '0'               CONVERT
         CI,R12   '9'                 A
         BLE      %+2                 CHAR.
         AI,R12   -X'39'              TO EBCDIC
         OR,R14   R12
         BDR,R5   NXTDGTH     NO--- DONE CONVERSION
         PLW,R12  *R0         YES-- RESTORE INFO
         B        *R10        --->  RETURN
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    MVTOMSG
*        DESCRIPTION:
*  MVTOMSG ROUTINE
*
*        FORM A MESSAGE BY MOVING ONE TO ANOTHER
*
*        INPUT:
*             R6  = MESSAGE ADDR.OF SOURCE(TEXTC FORM)
*
*        CALL:    R11 = LINK
*
*        REGISTERS:  R3-R5,R9-R10 USED, R11 SAVED
*FIN*
*****************
         SPACE    3
MVTOMSG  EQU      %           <---  ENTER
         LI,R9    CPSZ              DESTINATION LENGTH
         LI,R4    CP1               DESTINATION ADDR.(BYTE)
         LI,R10   ' '               BLANK
BLNK     EQU      %
         STB,R10  0,R4              BLANKS
         AI,R4    1                   TO DESTINATION
         BDR,R9   BLNK                AREA
         LI,R3    1
         LB,R5    *R6               SOURCE LENGTH
         LI,R4    CP1
MVEINFO  EQU      %
         LB,R10   *R6,R3            MOVE SOURCE
         STB,R10  0,R4                INFO
         AI,R3    1                   INTO
         AI,R4    1                   DESTINATION
         BDR,R5   MVEINFO             AREA
         B        *R11        --->  RETURN
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    SETYYNDD
*        ENTRY:   GETYYNDD
*        ENTRY:   PUTVAL
*        DESCRIPTION:
*  SETYYNDD ROUTINE
*  GETYYNDD ROUTINE
*  PUTVAL ROUTINE
*
*        PUT YYNDD OR YYVALUE INTO APPROPRIATE MESSAGE
*        BUILD YYNDD & THEN PUT INTO MESSAGE
*        PUT VALUE INTO MESSAGE (VALUE SUPPLIED)
*
*        INPUT:
*             R2  = DCT INDEX
*             R3  = BA(AREA IN MESSAGE WHERE INFO GOES)
*          R8,R9  = VALUE TO PUT INTO MESSAGE (RIGHT JUSTIFIED)
*                   R3 = # CHAR.
*            R13  = DEVICE ADDRESS
*
*        CALL:    R10 = LINK
*
*        INTERFACE:  HEXHEXE.
*        REGISTERS:  R3,R8-R10,R14 USED, R5,R10,R13 SAVED
*FIN*
*****************
         SPACE    3
SETYYNDD EQU      %           <---  ENTER
         PSW,R5   *R0               SAVE VALUE
         PSW,R10  *R0               SAVE RETURN
         LD,R8    *DCT16X,R2  NO--- GET 'YYNDD'
*
*   R8 =  ---Y
*   R9 =  YNDD
*
SETVAL   EQU      %                 COMMON ENTRY
         STB,R8   0,R3              PUT
         SLD,R8   8                   YY
         AI,R3    1                   INTO
         STB,R8   0,R3                MESSAGE
         DO1      WANT:VAL=0
         B        NDDSIGMA
         DO       WANT:VAL=1
         MTW,0    TAURUS
         BEZ      NDDSIGMA    YES-- SIGMA SYSTEM
         LW,R14   R9          NO--- TAURUS
         PLW,R10  *R0               RESTORE RETURN ADDR.
         PSW,R10  *R0               SAVE RETURN AGAIN
         LI,R11   M:ADDR
         AI,R10   -1
         LS,R10   *R10              GET BALED TO ADDR.
         CI,R10   PUTVAL
         BE       NO:CNVT     YES-- ROUTINE ENTERED AT PUTVAL
         LI,R5    4           NO---
         BAL,R10  HEXHEXE     ****  CONVERT HEX.TO HEX.EBCDIC(DEV.ADDR.)
*
*  RETURN     R14 = CONVERTED VALUE
*
NO:CNVT  EQU      %
         LI,R5    4
         FIN
NXTNNDD  EQU      %
         SCS,R14  8                 PUT VALUE
         AI,R3    1                   INTO NNDD
         STB,R14  0,R3                OF MESSAGE
         BDR,R5   NXTNNDD     NO--- DONE SETTING UP MESSAGE
         PLW,R10  *R0               RESTORE RETURN
         PLW,R5   *R0               RESTORE VALUE
         B        *R10        --->  RETURN
*----------------
NDDSIGMA EQU      %
         AI,R9    ' '               BLANK FILL 'NDD '
         LW,R14   R9
         LI,R5    4
         B        NXTNNDD
*----------------
GETYYNDD EQU      %           <---  ENTER
         MTW,0    TAURUS
         BNEZ     SETYYNDD    YES-- TAURUS
         PSW,R5   *R0               SAVE VALUE
         PSW,R10  *R0         NO--- SIGMA, SAVE LINK
         PSW,R13  *R0               SAVE DEV.ADDR.
         LI,R5    4                 # CHAR. TO CONVERT
         BAL,R10  HEXHEXE     ****  CONVERT HEX.TO HEX.EBCDIC(DEV.ADDR.)
*
*  R14 = CONVERTED VALUE UPON RETURN
*
         LD,R8    *DCT16X,R2        GET 'YYNDD'
         LI,R5    1
         STH,R14  R9,R5             REPLACE 'DD' IN 'YYNDD'
         PLW,R13  *R0               RESTORE DEV.ADDR.
         LB,R10   R13               GET IOP FIELD
         AND,R10  L(X'F')
         AI,R10   'A'               MAKE IT 'A' THRU 'P'
         CI,R10   'I'
         BLE      %+2
         AI,R10   7
         LI,R5    1
         STB,R10  R9,R5             REPLACE 'N' IN 'YYNDD'
         B        SETVAL
*----------------
PUTVAL   EQU      %           <---  ENTER
         PSW,R5   *R0               SAVE VALUE
         PSW,R10  *R0               SAVE RETURN
         B        SETVAL
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    PRIVPACK
*        DESCRIPTION:
*  PRIVPACK ROUTINE
*
*        DETERMINE IF DEVICE REFERENCE IS TO A DISK PACK, & IF SO,
*        DISK PACK MUST BE PRIVATE
*
*        INPUT:
*             R2  = DCT INDEX
*            R13  = DEV.ADDR., LEFT JUSTIFIED
*
*        OUTPUT:
*             R4  = AVR TABLE INDEX
*
*    RETURN IF :
*
*        1. DEVICE NOT DISK PACK
*        2. DEVICE IS PRIVATE DISK PACK
*
*    OTHERWISE, NO RETURN
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  MSG%,MSG,NXTCMND,SETYYNDD.
*        REGISTERS:  R4,R8-R12 USED, R11 SAVED
*FIN*
*****************
         SPACE    3
PRIVPACK EQU      %           <---  ENTER
         LW,R4    R2                DETERMINE
         AI,R4    -BATAPE             AVR TABLE INDEX
         BLZ      *R11        --->  RETURN - NOT DISK PACK (IS DEVICE)
         CI,R4    AVRTBLSIZ
         BL       *R11        --->  RETURN - NOT DISK PACK (IS TAPE)
         CI,R4    AVRTBLNE
         BGE      *R11        --->  RETURN - NOT DISK PACK (IS OTHER)
         LD,R8    *AVRTBLX,R4       DISK PACK,
         CI,R9    0                   DETERMINE IF PUBLIC OR PRIVATE
*                             YES-- PRIVATE PACK
         BGEZ     *R11        --->  RETURN - IS PRIVATE DISK PACK
*                             NO--- PUBLIC
         BAL,R10  MSG%        ****  OUTPUT '%' MESSAGE
         LI,R3    NPRV0
         BAL,R10  SETYYNDD    ****  FIX MESSAGE
         LI,R12   NOPRVPCK          'ITEM NOT PRIVATE PACK'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    SYMBMSG
*        DESCRIPTION:
*  SYMBMSG  ROUTINE
*
*        DISPLAY SYMBIONT MESSAGES
*
*        INPUT:
*             R2  = DCT INDEX
*
*        CALL:    R1 = LINK
*
*        INTERFACE:  MSG,OCPRTSD.
*        REGISTERS:  R6,R8-R9,R11-R12 USED, R1 SAVED
*FIN*
*****************
         SPACE    3
SYMBMSG  EQU      %           <---  ENTER
         LD,R8    *DCT16X,R2        GET 'YYNDD'
         SLD,R8   8                 R8 = '--YY', R9 = 'NDD-'
         LI,R6    SYM1
         STH,R8   0,R6              PUT 'YY' INTO MESSAGE
         AI,R9    ' '               BLANK FILL
         STW,R9   SYM2              PUT 'NDD' INTO MESSAGE
         LI,R12   SYMBTERM          'SYMBIONT YYNDD TERMINATED'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LW,R13   CONTADR           CURRENT DEV.ADDR.
         STH,R13  R13
         SLD,R8   -8
         LI,R3    IT0
         BAL,R10  PUTVAL      ****  FIX MESSAGE
         LI,R12   ITEMPART          'ITEM PARTITIONED'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         BAL,R11  OCPRTSD     ****  MESSAGE TO OC
         B        *R1         --->  RETURN
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    OCMESG
*        ENTRY:   OCPRTD
*        ENTRY:   OCPRTC
*        ENTRY:   OCPRTSD
*        ENTRY:   OCRETD
*        ENTRY:   OCRETC
*        DESCRIPTION:
*  OCPRTD, OCPRTC, OCPRTSD, OCRETD, & OCRETC ROUTINES
*
*        DISPLAY APPROPRIATE MESSAGE ON OC DEVICE
*        ONLY IF OC NOT SAME DEVICE AS UC
*
*        INPUT:
*             R2  = DCT INDEX
*             R8  = MESSAGE SIZE (SOURCE)
*            R12  = BA(MESSAGE SOURCE)
*
*        CALL:    R11 = LINK
*
*        INTERFACE:  MSG.
*        REGISTERS:  R3,R8,R12-R13 USED, R4 SAVED
*FIN*
*****************
         SPACE    3
OCMESG   EQU      %                 PUT MESSAGES TOGETHER INTO ONE
         MTW,0    ONLINE            CHECK FOR GHOST VS. ONLINE
         BEZ      *R11        --->  RETURN, OC = UC WHEN GHOST
*                                   OC .NE. UC
*    R2  = DCT INDEX
*    R8  = # BYTES IN SOURCE MESSAGE FOR MSG #1
*    R12 = BA(MSG.SOURCE) FOR MSG #1
*
         SPACE    2
         LI,R13   BA(OCMSG)+1       DESTINATION OF MESSAGE PART
         STB,R8   R13               SOURCE MESSAGE SIZE
         MBS,R12  0                 FORM MESSAGE
*
*    R13 = BA(NEXT AREA IN DESTINATION)
*
         LW,R12   DCT16X            DETERMINE
         AW,R12   R2                  BA('YYNDD')
         AW,R12   R2                  WITHIN A
         SLS,R12  2
         AI,R12   3                   DCT16 ENTRY (---YYNDD)
         LI,R8    5                 SIZE
         STB,R8   R13               SOURCE MESSAGE SIZE, DESTINATION AS
         MBS,R12  0                 ADD 'YYNDD' TO MESSAGE
         LI,R8    X'15'             NEW LINE
         LW,R3    R13                 INTO
         STB,R8   0,R3                MESSAGE
         AI,R3    -BA(OCMSG)        DETERMINE FINAL MESSAGE SIZE
         STB,R3   OCMSG               & PUT INTO MESSAGE (TEXTC TYPE)
         MTW,0    BATCH
         BEZ      MESSG2      NO--- IN BATCH TEST MODE
         PSW,R11  *R0         YES-- SAVE RETURN
         LI,R12   OCMSG
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         PLW,R11  *R0               RESTORE RETURN
         B        *R11        --->  RETURN
*----------------
MESSG2   EQU      %
         M:MESSAGE  (MESS,OCMSG) ** DISPLAY ON OC DEVICE
         B        *R11        --->  RETURN
*----------------
         PAGE
*****************
*  VARIOUS ENTRIES
*****************
         SPACE    3
OCPRTD   EQU      %           <---  ENTER
         LI,R12   BA(OCPRTDM)+1     SOURCE
         LB,R8    OCPRTDM           SIZE
         B        OCMESG
*----------------
         SPACE    2
OCPRTC   EQU      %           <---  ENTER
         LI,R12   BA(OCPRTCM)+1     SOURCE
         LB,R8    OCPRTCM           SIZE
         B        OCMESG
*----------------
         SPACE    2
OCPRTSD  EQU      %           <---  ENTER
         LI,R12   BA(OCPRTSDM)+1    SOURCE
         LB,R8    OCPRTSDM          SIZE
         B        OCMESG
*----------------
         SPACE    2
OCRETD   EQU      %           <---  ENTER
         LI,R12   BA(OCRETDM)+1     SOURCE
         LB,R8    OCRETDM           SIZE
         B        OCMESG
*----------------
         SPACE    2
OCRETC   EQU      %           <---  ENTER
         LI,R12   BA(OCRETCM)+1     SOURCE
         LB,R8    OCRETCM           SIZE
         B        OCMESG
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    MSG
*        ENTRY:   MSGCMN
*        DESCRIPTION:
*  MSG ROUTINE
*  MSGCMN ROUTINE
*
*        OUTPUTS A MESSAGE.
*
*        INPUT:
*             R12 = ADDR.OF MESSAGE (TEXTC TYPE)
*
*        CALL:    R11 = LINK
*
*        REGISTERS:  R13 USED, R11 SAVED
*FIN*
*****************
         SPACE    3
MSG      EQU      %           <---  ENTER
         LB,R13   *R12              GET MESSAGE LENGTH
MSGCMN   EQU      %           <---  SPECIAL ENTRY
         PSW,R11  *R0               SAVE RETURN
         LI,R11   M:UC
         MTW,0    LIST:LP
         BNEZ     MSG4        YES-- OUTPUT TO LO
*                             NO---
         MTW,0    BATCH
         BEZ      MSG1        NO--- IN BATCH TEST MODE
MSG2     EQU      %           YES--
         LI,R11   M:LO
         AI,R13   -1                ELIMINATE NL
MSG1     EQU      %
         M:WRITE  *R11,(BUF,*R12),(SIZE,*R13),(BTD,1),(WAIT)  ERR.MSG.
MSG3     EQU      %
         PLW,R11  *R0               RESTORE RETURN
         B        *R11        --->  RETURN
*----------------
MSG4     EQU      %
         CI,R13   2
         BLE      MSG3        YES-- OUTPUT NEW LINES
         B        MSG2        NO--- ACTUAL MESSAGE
*----------------
         PAGE
*****************
*DO*
*D*      NAME:    MSG%
*        DESCRIPTION:
*  MSG% ROUTINE
*
*        OUTPUTS A MESSAGE WITH '%' UNDER BAD PART OF COMMAND.
*
*        CALL:    R10 = LINK
*
*    CHAR.SCAN PLIST CONTAINS LAST RELATIVE CHAR.POSITION LOOKED
*    AT WHEN COMMANDS ERROR WAS FOUND. WORD  'CCP' CONTAINS VALUE.
*
*        INTERFACE:  MSG.
*        REGISTERS:  R1,R11-R12 USED, R2,R10 SAVED
*FIN*
*****************
         SPACE    3
MSG%     EQU      %           <---  ENTER
         MTW,0    ONLINE
         BEZ      *R10        --->  RETURN, GHOST JOB
         PSW,R2   *R0               SAVE VALUE
         LW,R1    SCNPLST+CCP       GET REL.CHAR.POS.
         AI,R1    1                 ALLOW FOR A TEXTC TYPE FORMAT
         LI,R2    '%'
         STB,R2   %MSG%,R1          PUT '%' INTO BLANK MESSAGE
         AI,R1    1
         LI,R2    X'15'             PUT CR INTO MESSAGE
         STB,R2   %MSG%,R1
         AI,R1    1
         STB,R1   %MSG%             PUT MESSAGE SIZE INTO MESSAGE
         AI,R1    -1
         LI,R12   %MSG%             ' % '
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         LI,R2    ' '
         STB,R2   %MSG%,R1          REPLACE CR WITH BLANK
         AI,R1    -1
         STB,R2   %MSG%,R1          REPLACE '%' WITH BLANK
         PLW,R2   *R0               RESTORE VALUE
         B        *R10        --->  RETURN
*----------------
         PAGE
*****************
*D*
*D*      NAME:    SYNTAX-ERROR-ROUTINES
*D*      ENTRY:   NAMERR
*D*      ENTRY:   TERMERR
*D*      ENTRY:   BADPARAM
*D*      ENTRY:   NOCONT
*D*      ENTRY:   MAPBAD
*D*      DESCRIPTION:
*D*  ERROR ROUTINES FOR NAMERR,TERMERR,BADPARAM,NOCONT,MAPBAD.
*D*      INTERFACE:  MSG%,MSG,NXTCMND,EXIT.
*D*      REGISTERS:  R10-R12,R14 USED
*D*
*****************
         SPACE    3
NAMERR   EQU      %           <---  ENTER
         CI,R8    BADCONT
         BE       NXTCMND     YES-- BAD CONTINUATION
*                             NO---
         BAL,R10  MSG%        ****  OUTPUT '%' MESSAGE
         LI,R12   NAMBAD            'UNKNOWN KEYWORD'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*----------------
TERMERR  EQU      %           <---  ENTER
         BAL,R10  MSG%        ****  OUTPUT '%' MESSAGE
         LI,R12   TERMBAD           'INVALID TERMINATOR'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*----------------
BADPARAM EQU      %           <---  ENTER
         BAL,R10  MSG%        ****  OUTPUT '%' MESSAGE
         LI,R12   PARAMBAD          'UNKNOWN PARAMETER'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        NXTCMND     --->  RETURN & GET NEXT COMMAND
*----------------
NOCONT   EQU      %           <---  ENTER (FROM NXACTCHR)
         LW,R14   R11               SAVE RETURN
         BAL,R10  MSG%        ****  OUTPUT '%' MESSAGE
         LI,R12   CONTINU           'CONTINUATION ILLEGAL'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        *R14        --->  RETURN
*----------------
MAPBAD   EQU      %           <---  ENTER
         LI,R12   MAPMSG            'CANNOT MAP INTO MONITOR'
         BAL,R11  MSG         ****  OUTPUT MESSAGE
         B        EXIT
*----------------
         DATA     PATCH
         CSECT    0
PATCH    RES      100
         END      SYSCON
