         PCC      0
*
********************
*  0.    PREAMBLE  *
********************
*
*
*  PROGRAM NAME:  UTS MULTI-BATCH PARTITION CONTROL MODULE 'PART'
*
*
*  PURPOSE:         TO SERVE AS AN ADJUNCT TO 'CONTROL' (UTS SYSTEM
*                 PERFORMANCE CONTROL MONITOR) BY DISPLAYING PARTITION
*                 ATTRIBUTES AND SETTING ATTRIBUTE VALUES. THE SPECIFIC
*                 COMMANDS RECOGNIZED BY 'PART' AND THE FUNCTIONS
*                 ASSOCIATED WITH THEM APPEAR BELOW:
*
*        COMMAND        FUNCTION
*        -------        --------
*        DISPLAY N      DISPLAYS ALL ATTRIBUTES (SEE NOTE1) WITH THEIR
*                       FLAGS TURNED ON (SEE NOTE2) FOR PARTITION N.
*
*        DISPLAY ALL    DISPLAYS ALL ATTRIBUTES WITH THEIR FLAGS TURNED
*                       ON FOR ALL PARTITIONS.
*
*        N 'ATTRIBUTE'  DISPLAYS THE ATTRIBUTE SPECIFIED FOR PARTITION N
*
*        ALL 'ATTRIBUTE' DISPLAYS THE ATTRIBUTE SPECIFIED FOR ALL PART-
*                       ITIONS.
*
         PAGE
*
*        N 'ATTRIBUTE'=NUMBER       SETS THE 'ATTRIBUTE' SPECIFIED IN
*                                   THE PARTITION SPECIFIED BY 'N' TO
*                                   THE VALUE GIVEN BY 'NUMBER'.
*
*
*        STORE          TRANSFERS THE VALUES FOR ALL THE ATTRIBUTES
*                       WHICH HAVE BEEN MODIFIED FROM THE PARTITION
*                       DEFINITION BUFFER TO THE PARTITION DEFINITION
*                       TABLES.
*
*        CLEAR          CLEARS THE PARTITION DEFINITION BUFFER.
*
*        END            RETURNS EXECUTION LEVEL OF CONTROL BACK TO THE
*                       CONTROL COMMAND LEVEL.
*
*        (*)            PRINTS THE COMMENTS FOLLOWING THE ASTERISK.
*
*        NOTE1:   CURRENTLY RECOGNIZED PARTITION ATTRIBUTES WHICH MAY
*                 BE DISPLAYED ARE: CORE (RANGE), TIME (RANGE), QUAN,
*                 SP (RANGE), 7T (RANGE), 9T (RANGE), HOLD, LOCK, TOL,
*                 CURR, USER#, AND ACCT. THOSE WHICH MAY NOT BE ALTERED
*                 ARE: CURR, USER#, AND ACCT.
*
*        NOTE2:   FOR THE FIRST RELEASE OF THIS MODULE, THERE WILL BE
*                 NO FACILITY FOR TURNING DISPLAY FLAGS ON OR OFF.
*                 THEREFORE, THE USER WILL NOT HAVE CONTROL OVER DISPLAY
*                 CONTENT OR ORDER. HOWEVER, THE TABLES ARE SET UP AND
*                 THE PROGRAM LOGIC IS IMPLEMENTED FOR DISPLAY ACCESS
*                 BY FLAG AND ORDERED LIST SO THAT THE CAPABILITY FOR
*                 ORDERED AND SELECTIVE DISPLAY OF ATTRIBUTES IS PRESENT
*                 ONCE THE FACILITY FOR 'ADDING' AND 'DROPPING' ITEMS
*                 IS INCLUDED. THE STANDARD PARTITION DISPLAY INCLUDES
*                 THE CORE, TIME, SP, 7T, 9T, HOLD, LOCK, CURR, AND TOL
*                 PARAMETERS AND OMITS THE ACCT AND USER# PARAMETERS.
*                 THOSE OMITTED MAY BE DISPLAYED BY USE OF THE
*                 'N ATTRIBUTE' COMMAND OR THE 'ALL ATTRIBUTE' COMMAND.
*
*        NOTE3:   ALL KEYWORDS (I.E. ALL, DISPLAY, CLEAR, END, STORE)
*                 MAY BE SPECIFIED BY FIRST LETTER ONLY.
*
*        NOTE4:   SUBROUTINES REFERENCED EXTERNALLY MAY BE FOUND IN THE
*        MODULE 'CONSUB', AND MOST TABLES AND OTHER VARIABLES NOT
*        RESIDENT IN THE SYSTEM MAY BE FOUND DEF'D IN THE MAIN ROUTINE
*        'CONTROL'.
*
*        NOTE5:   FOR SAFETY, 'PART' SHOULD BE 'LOAD'ED WITH (TSS=100)
*        DUE TO THE FACT THAT 'DISPX' PUSHES NUMERIC OVERFLOWS ON
*        ATTRIBUTE DISPLAYS INTO THE USER TEMP STACK.
*
*
*  FUNCTION:        A COMPLETE DESCRIPTION OF THE INTERACTION BETWEEN
*                 'PART', 'CONTROL' AND 'CONSUB' MAY BE FOUND IN THE
*                 UTS TECHNICAL MANUAL UNDER SECTION QA.
*
*
*  IN-CORE HEADER:        THE IN-CORE HEADER CREATED FOR THIS MODULE
*                       IS FOUND IN 'CONTROL' AND HAS THE FOLLOWING
*                       FORMAT:
*
*        TEXT     '########'
*        TEXT     'UTS CONTROL B00 '
*        TEXT     '################'
*        TEXT     '10-1-71 '
*ICTRACE TEXT     '  :TRACE'
*        TEXT     '########'
*
*                         WHEN EXECUTION IS TRANSFERRED TO 'PART',
*                       A ' 7' IS STORED IN HW 0   OF 'ICTRACE' TO
*                       INDICATE TO A DUMP THAT THE 'PART' MODULE HAD
*                       CONTROL.
*
*                         SOME 'PART' SUBROUTINES HAVE TRACE SUB-CODES
*                       WHICH ARE SHOWN BELOW. THESE ARE STORED IN
*                       BYTE 0 OF ICTRACE. PROVIDING THE MAJOR TRACE
*                       CODE IN BYTE 1 IS THE RESPONSIBILITY OF THE
*                       CALLING ROUTINE.
*
         PAGE
*
*                       SUB-CODES ARE USED TO INDICATE SUBROUTINE EXECU-
*                 TION AND ARE STORED IN BYTE 0 OF ICTRACE OVERLAYING A
*                 BLANK IF NO SUBROUTINE HAD PREVIOUSLY BEEN EXECUTED
*                 BY THAT MODULE OR ANOTHER SUB-CODE. ALL SUB-CODES
*                 ARE GENERATED ONLY FOR THE INITIAL TESTING LEVELS
*                 2 AND 1 EXCEPT THOSE NOTED BY AN ASTERISK (*) WHICH
*                 WILL CONTINUE TO FUNCTION IN THE PRODUCTION ENVIRON-
*                 MENT. ALL CURRENT SUB-CODES ARE SHOWN BELOW:
*
*                 TRACE SUB-CODE    SUBROUTINE     MODULE
*                 --------------    ----------     ------
*                     BLANK         NO SUBROUTINE ENTERED
*                       0                -            -
*                       1           MAP (34) *     CONTROL
*                       2           READSI (14) *  CONSUB
*                       3           ABNXX (20) *   CONSUB
*                       4           APEND,BOUT,BOUTX (10) CONSUB
*                       5           DECTOBIN (12)  CONSUB
*                       6           OUTITEM (15)   CONSUB
*                       7           ITEMFIND (16)  CONSUB
*                       8           SEND (23) *    CONSUB
*                       9           BINOUT (24)    CONSUB
*                       A           MAIN (11) *    PART
*                       B           GETDATA (13)   PART
*                       C           ADD (11)       PART
*                       E           BUILD (11)     PART
*                       F           CLEAR (11)     PART
*                       G           DISPLAY (11)   PART
*                       H           DROP (11)      PART
*                       I           ATRN (11)      PART
*                       J           SET (11)       PART
*                       K           STORE (11)     PART
*                       L           DISPA (14)     PART
*                       M           DISPX (14)     PART
*
         PAGE
*
***********************************
*  0.1   INDEX TO CODED SECTIONS  *
***********************************
*
*                   SECTION
* CONTROL SECTION   NUMBER   SECTION NAME
* ---------------   ------   ------------
*        -          0.       PREAMBLE
* CS:PART:TEXT      1.       ASSEMBLY ENVIRONMENT
*        -          2.       PROCEDURES
*        -          3.       CONDITIONAL ASSEMBLY PARAMETERS
*        -          4.       EXTERNAL REFERENCES & DEFINITIONS
*        -          5.       STATIC ASSEMBLY PARAMETERS
* CS:PART:TEXT      6.       DATA CONSTANTS AND FPT'S
* CS:PART:TEXT      7.       DATA POINTERS
* CS:PART:TEXT      8.       DATA TABLES
* CS:PART:TEXT      9.       TEXT AND MESSAGES
* CS:PART:PROCEDURE 10.      EXTRY AND INITIALIZATION
* CS:PART:PROCEDURE 11.      MAIN SKELETON & COMMAND HANDLERS
* CS:PART:PROCEDURE 12.      EXIT
* CS:PART:PROCEDURE 13.      INPUT ROUTINES
* CS:PART:PROCEDURE 14.      OUTPUT ROUTINES
* CS:PART:PROCEDURE 15.      OTHER SUBROUTINES
* CS:PART:DATA      16.      DYNAMICALLY MODIFIED DATA CELLS
* CS:PART:DATA      17.      DYNAMICALLY MODIFIED DATA POINTERS
* CS:PART:DATA      18.      DATA BUFFERS
* CS:PART:DATA      19.      DCB'S AND FPT'S
* CS:PART:DATA      20.      LITERALS
*
         PAGE
*
********************************
*  1.    ASSEMBLY ENVIRONMENT  *
********************************
*
*
CS:PART:PROCEDURE CSECT 1
CS:PART:DATA      CSECT 0
CS:PART:TEXT      CSECT 1
*
         SYSTEM   SIG7P
         SYSTEM   BPM
:ST%TEXT%SWITCH SET 1               DATADEF (ST) KEYWORD TEXT SWITCH
         SYSTEM   DATADEF
*
         TITLE    '''PART'' - PARTITION CONTROL MODULE'
*
*
*****************************************
*  2.    COM DIRECTIVES AND PROCEDURES  *
*****************************************
*
*
********************
*  2.1   COMMANDS  *
********************
*
*
WDOP     EQU      X'6D'*(CK%CODE=0)|X'70'*(CK%CODE>0)  'WD' OR 'NOP'
*                                   GEN A NOP FOR LEVELS 1 & 2 (CHECK-
*                                   OUT) OR WRITE DIRECT FOR PRODUCT'N
ENABLE   COM,8,16,8  WDOP,0,X'27'*(CK%CODE=0)  SET INT INHIBITS
DISABLE  COM,8,16,8  WDOP,0,X'37'*(CK%CODE=0)  RESET INT INHIBITS
*
*
**********************
*  2.2   PROCEDURES  *
**********************
*
*
*********PROC NAMES:    GENERATE TRACE CODE (TRACE%, CK%TRACE)
*
*        TYPE:          COMMAND
*
*        CALL FORMAT:   TRACE%   'STRING'
*
*                       WHERE STRING=1 CHARACTER (SUB-CODE) OR 2 CHAR-
*                       ACTERS (MAIN CODE IN EBCDIC FORMAT WHICH IDEN-
*                       TIFY THE CALLING ROUTINE.
*
*        DATE:          NOVEMBER 18, 1971
*
*        PURPOSE:       TO PROVIDE A SIMPLE MEANS TO GENERATE A TRACE-
*                       CODE OR SUB-CODE AT THE START OF A ROUTINE.
*                       THE SPECIFIED TRACE-CODE IS STORED IN THE
*                       IN-CORE HEADER AT THE BEGINNING OF THE LOAD
*                       MODULE DATA SECTION.
*
*
TRACE%   CNAME    0                 UNCONDITIONAL ASS'Y OF TRACE-CODE
CK%TRACE CNAME    1                 CONDITIONAL ASS'Y OF TRACE-CODE
         PROC
         LOCAL    TR@NC,TR@AF,TR@OP
TR@AF    SET      AF                GET AF LIST; NOT JUST LIST NAME
TR@NC    SET      S:NUMC(TR@AF)     GET # CHARS IN TRACE-CODE
         ERROR,X'2',(TR@NC>2)|(TR@NC=0)|(TCOR(AF,S:C))=0 ;
         'PROC.TRACE%.# TRACE BYTES>2 OR =0, OR NOT CHAR STRING'
TR@OP    SET      X'75',X'55'       SET UP OP-CODE TBL WITH STB & STH
         DO       (NAME=0)|(CK%CODE>=1) UNCOND OR CK%CODE=1,2
           LI,R0    TR@AF           GET CHECK-CODE
           GEN,8,7,17  TR@OP(TR@NC),0,ICTRACE  STB OR STH
         FIN
         PEND
*
         PAGE
*
*
*********PROC NAME:     TYPE
*
*        TYPE:          COMMAND
*
*        CALL FORMAT:   TYPE  'CHARACTER STRING'
*
*        PURPOSE:       TO PROVIDE A PROCEDURE FOR TYPING MESSAGES
*                       ON THE 'DO' DEVICE.
*
*        REGISTER USE:  R1, R2
*
TYPE     CNAME
         PROC
         LOCAL    TY@TA
         DISP     %
         LIST     0
         USECT    CS:PART:TEXT
         DO       TCOR(AF(1),S:C)=1  DO ONLY IF CHAR STRING
TY@TA      SET      %               SET SYMBOL TO 1ST BYTE OF STRING
LF(2)      TEXTC    AF(1)           SET LABEL TO TEXTC STRING, IF ANY
         ELSE                       IF SYMBOL, SET LOCAL TO 1ST BYTE
TY@TA      SET      AF(1)           OF PREVIOUSLY CREATED STRING
           FIN
CSEND:PART:TEXT SET %               BUMP END OF TEXT POINTER FOR DUMP
         USECT    CS:PART:PROCEDURE ANALYSIS.
*********CK%CODE  SAVE REGISTERS
         DO       CK%CODE>=1        FOR LEVEL S 1 & 2 ONLY
           LCI      2               LOAD CONDITION CODES FOR STM
           PSM,R1   *SPDADR         SAVE REGS R1,R2
         FIN
*********CK%CODE  END
LF(1)    LI,R2    TY@TA
         BAL,R1   TYPEDO          >>M:WRITE THROUGH M:DO DCB
*********CK%CODE  RESTORE REGISTERS R1,R2 AFTER 'TYPE' EXECUTION
         DO       CK%CODE>=1
           LCI      2               PREPARE FOR PLM
           PLM,R1   *SPDADR         RESTORE R1,R2
         FIN
*********CK%CODE  END
         LIST     1
         PEND
*
         PAGE
*
*
*********PROC NAME:     SCANTBL%
*
*        TYPE:          COMMAND
*
*        CALL FORMAT:   LF(1),LF(2),LF(3) SCANTBL%,CF(2),CF(3) ;
*                                         (CHAR1,FIELDS1,ADR1),;
*                                         (CHAR2,FIELDS2,ADR2), ETC
*
*        WHERE:         LF(1)=WA(BASE OF COMMAND LIST).
*                       LF(2)=WA(BASE OF NUMBER OF FIELDS REQUIRED
*                                PER COMMAND TABLE ENTRY).
*                       LF(3)=WA(BASE OF COMMAND HANDLER BRANCH ADDRESS
*                                TABLE).
*                       SCANTBL%=PROC NAME.
*                       CF(2)=NUMBER OF COMMANDS IN LIST.
*                       CF(3)=MAXIMUM NUMBER OF SCAN FIELDS REQUIRED
*                             FOR ANY COMMAND.
*                       CHARN=A CHARACTER STRING CONSISTING OF 1,2 OR 4
*                             CHARACTERS WHICH ARE TO BE USED IN IDENT-
*                             IFYING A PARTICULAR INPUT COMMAND.
*                       FIELDSN=NUMBER OF COMMAND FIELDS REQUIRED FOR
*                               THIS COMMAND. THIS PARAMETER
*                               MAY EITHER BE A SINGLE NUMBER NOT
*                               GREATER THAN 15 OR A RANGE SPECIFIED AS
*                               (LEAST # FLDS COMMAND REQUIRES, MOST
*                               # FLDS COMMAND REQUIRES).
*                       ADRN=ENTRY POINT OF APPROPRIATE COMMAND HANDLER.
*
*                       LF(1), LF(2), LF(3), CF(2), AND  CF(3) ARE
*                       ALL OUTPUT PARAMETERS SET TO THE CORRESPONDING
*                       USER-SUPPLIED LABEL.
*
*        DATE:          NOVEMBER 1, 1971
*
*        PURPOSE:       TO PROVIDE A PROCEDURE WHICH WILL CONSTRUCT
*                       THREE PARALLEL TABLES TO BE SEARCHED IN IDENTI-
*                       FYING INPUT COMMANDS. THE COMMAND TABLE IS
*                       A SERIES OF BYTE, HALFWORD, OR WORD ENTRIES
*                       (DEPENDING ON THE BYTE COUNT OF THE FIRST
*                       ENTRY) WHICH ARE COMPARED TO THE FIRST
*                       BYTE, HALFWORD, OR WORD (DEPENDING ON THE
*                       WIDTH OF THE TABLE) OF THE FIRST INPUT COMMAND
*                       FIELD FOR A MATCH. THE ENTRY NUMBER OF THE
*                       MATCHING COMMAND SERVES AS AN INDEX INTO THE
*                       FIELDS TABLE AND BRANCH ADDRESS TABLE. THE
*                       FIELDS TABLE SPECIFIES THE NUMBER OF FIELDS
*                       REQUIRED BY EACH COMMAND AND CAN SERVE AS MATCH
*                       BREAK LOGIC FOR COMMANDS WITH THE SAME FIRST
*                       BYTE (E.G. 'ADD' AND 'ALL').
*
*
SCANTBL% CNAME
         PROC
         LOCAL    I,SC@NA,SC@AF,SC@MNF,SC@NF,SC@#E,SC@1
         DISP     %
SC@AF    SET      AF                SETTING AF CUTS ASS'Y TIME
CF(2),SC@NA EQU   NUM(SC@AF)        GET NUMBER ENTRIES IN AF
         ERROR,X'5',SC@NA>255 'PROC.SCANTBL%.# ENTRIES>255' BYTE CMDS
*                                   IN 'PART' LIMIT TABLE SIZE.
CMDBS    SET      S:NUMC(AF(1,1))   GET NUMBER OF BYTES FOR CMD LIST
*                                   AND 'PART' SCAN SUBROUTINE.
         ERROR,X'3',CMDBS>4  'PROC.SCANTBL%.ENTRY>4 BYTES' WORD=MAX
*
         BOUND    4
LF(1)    EQU      %                 BEGINNING OF CMD LIST TBL
         DATA,CMDBS 0               0TH ENTRY NULL;FIRST SUBSCRIPT=1
I        DO       SC@NA             DO FOR TOTAL # CMDS
*
           ERROR,X'5',NUM(SC@AF(I))~=3 ;
           'PROC.SCANTBL%.ENTRY NOT 3 ELEMENTS' ERROR, CONTINUE
*
         DATA,CMDBS SC@AF(I,1)      CREATE COMMAND ENTRY
         FIN
*
         BOUND    4                 START ON WORD BOUND
LF(2)    EQU      %                 START FIELDS TBL
         DATA,1   0                 0TH ENTRY NULL
SC@MNF   SET      0                 SET MAX # FIELDS, ANY CMD
I        DO       SC@NA             DO FOR # CMDS
SC@#E      SET      NUM(SC@AF(I,2)) SET # ELEMENTS IN AF(I,2)
           ERROR,X'5',SC@#E>2  ;
           'PROC.SCANTBL%.# ELEMENTS IN FLDTBL SPEC>2'
           DO       SC@#E=2         DO FOR A RANGE OF FIELD POSIBLES
             GOTO,SC@AF(I,2,1)=SC@AF(I,2,2)  SC@1  ->IF RANGE LIMITS
*                                            EQUAL, GEN SINGLE VALUE
             ERROR,X'3',SC@AF(I,2,1)>SC@AF(I,2,2) ;
             'PROC.SCANTBL%.# FLDS LOWER LIM>#FLDS UPPER LIM'
SC@NF        SET      SC@AF(I,2,2)  GET MAX # FLDS REQUIRED,THIS CMD
             GEN,4,4  SC@AF(I,2,1),SC@NF     SET UP 4-BIT RANGE LIMS
SC@1       ELSE                     DO FOR SINGLE # REQUIRED FLDS
SC@NF        SET      SC@AF(I,2,1)       <-  GET # FLDS REQUIRED,THIS CMD
             DATA,1   SC@NF         GEN # FLDS REQUIRED
           FIN
*
           ERROR,X'5',SC@NF>15 'PROC.SCANTBL%.# FLDS>15'
SC@MNF     SET      MAX%(SC@MNF,SC@NF)  RETAIN MAX # FLDS
         FIN
*
         BOUND    4
CF(3)    EQU      SC@MNF            SET MAX # FIELDS REQUIRED, ANY CMD
*
LF(3)    EQU      %                 START OF BRANCH TABLE
         DATA     0                 0TH ENTRY NULL; 1ST SUBSCRPT=1
I        DO       SC@NA             DO FOR # CMDS
           DATA     SC@AF(I,3)      GENERATE PARALLEL BRANCH TBL
         FIN
*
         PEND
*
         PAGE
*
*
*********PROC NAMES:    LOAD STD REGS AND BAL TO SUBR (LBAL%)
*                       LOAD STD REGS AND BRANCH TO ROUTINE (LBR%)
*
*        TYPE:          COMMAND PROCEDURES
*
*        CALL FORMAT:   LBAL%,R  SUBR,AF1,AF2,AF3,AF4
*                       LBR%     SUBR,AF1,AF2,AF3,AF4
*
*                       WHERE: LBAL%,LBR%=PROC NAMES
*                              R=BAL REGISTER (FOR LBAL%)
*                              AF1=DATA TO BE LOADED INTO REG SR1
*                              AF2=DATA TO BE LOADED INTO REG SR2
*                              AF3=DATA TO BE LOADED INTO REG SR3
*                              AF4=DATA TO BE LOADED INTO REG SR4
*                              SUBR=TARGET SUBROUTINE OR ROUTINE
*
*                       AND, ANY AF(N) MAY HAVE THE FOLLOWING SYNTAX:
*                              ADR
*                              (W,<*>ADR <,REG>)
*                              (H,<*>ADR <,REG>)
*                              (B,<*>ADR <,REG>)
*                              (WAM,<*>ADR <,REG>)
*                              (HAM,<*>ADR <,REG>)
*                              (BAM,<*>ADR <,REG>)
*
*                       WHERE: ADR=SYMBOLIC OR ABSOLUTE ADDRESS (IF
*                                  IT IS THE ONLY SPECIFICATION IN AF,
*                                  A LOAD IMMEDIATE IS GENERATED).
*                              <*>=OPTIONAL INDIRECT ADDRESS
*                              <REG>=OPTIONAL INDEX REGISTER
*                              W=WORD LOCATION (LOAD WORD GENERATED)
*                              H=HALFWORD LOCATION (LOAD HALFWORD
*                                GENERATED).
*                              B=BYTE LOCATION (LOAD BYTE GENERATED)
*                              WAM=LOAD WORD AND MASK WA
*                              HAM=LOAD WORD AND MASK HA
*                              BAM=LOAD WORD AND MASK BA
*
*
*  DESCRIPTION:   THE PURPOSE OF BOTH PROCS IS TO SET UP STANDARD
*                 REGISTERS SR1-SR4 FOR A CALL TO THE SPECIFIED SUB-
*        ROUTINE. LBAL% PRODUCES A BRANCH AND LINK INSTRUCTION ON
*        THE REGISTER SPECIFIED IN COMMAND FIELD 2 AND LBR% PRODUCES
*        A DIRECT BRANCH TO THE ROUTINE SPECIFIED. ANY OF THE REG-
*        ISTER SPECIFICATIONS MAY BE LEFT BLANK IF A COMMA IS PLACED
*        TO INDICATE PRESENCE OF THE PARAMETER. (THIS IS NECESSARY ONLY
*        IF ANOTHER REGISTER SPECIFICATION FOLLOWS).
*
*                 DATA TO BE LOADED INTO THE REGISTERS MAY BE A SINGLE
*        SYMBOL (INWHICH CASE A LOAD IMMEDIATE INSTRUCTION WILL BE
*        GENERATED) OR A KEYWORD (W,H, OR B) AND A SYMBOL (IN WHICH
*        CASE A LOAD WORD, HALFWORD, OR BYTE INSTRUCTION WILL BE GEN-
*        ERATED). AN INDIRECT ADDRESS MAY BE SPECIFIED BY PLACING AN
*        ASTERISK IN FRONT OF THE ADDRESS SYMBOL IN ALL CASES EXCEPT
*        FOR THE IMMEDIATE ADDRESS FORMAT. AN INDEX REGISTER MAY BE
*        SPECIFIED FOLLOWING THE SYMBOLIC ADDRESS IN ALL CASES EXCEPT
*        FOR THE IMMEDIATE ADDRESS FORMAT. IF THE DATA WHICH IS LOADED
*        IS TO BE MASKED TO PRODUCE A WORD, HALFWORD OR BYTE ADDRESS,
*        'WAM', 'HAM', OR 'BAM' MAY BE USED AS KEYWORDS IN WHICH CASE
*        A 'LW' INSTRUCTION WILL BE GENERATED FOLLOWED BY AN 'AND' WITH
*        A 17-BIT, 18-BIT, OR 19-BIT MASK.
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL            EXIT
*        -----             --------            ----
*        'R'=USER SUPPLIED SR1-SR4=LOAD REGS   ALL REGS PRESERVED
*        BAL REGISTER      'R'=BAL REG
*
*
LBR%     CNAME    0             <<  LOAD STD REG & BRANCH TO SUBR
LBAL%    CNAME    1             <<  LOAD STD REG & BAL TO SUBR
         PROC
         LOCAL    I,LB@BR,LB@SR,LB@E1,LB@E2,LB@3,LB@F,LB@OP,;
                  LB@M
*
LB@E1    SET      (NAME=1)&(NUM(CF(2))=0) SET ERR FLG IF LBAL% & NO REG
LB@E2    SET      NUM(AF(1))=0            SET ERR FLG IF NO SUBR ADR
         GOTO,LB@E1|LB@E2  LB@3     SKIP CODE GEN IF ERROR CONDITION
*
LB@BR    SET      CF(2)             GET SYMBOLIC REGISTER SPECIFICATION
LB@SR    SET      ,SR1,SR2,SR3,SR4  CREATE STD REG LIST // TO AF
LB@OP    SET      X'32',X'52',X'72' CREATE LW,LH,LB OP-CODE LIST
LB@M     SET      ,,,X'1FFFF',X'3FFFF',X'7FFFF'  CREATE WA,HA,BA MSK LST
*
LF       SET      %                 SET LABEL FIELD  %, IF ANY
I        SET      1                 INITIALIZE AF INDEX
*
         DO       NUM(AF)-1         DO FOR ALL STD REGS SPECIFIED
I         SET      I+1              INCREMENT AF INDEX TO NEXT REG
LB@F      SET      SCOR(AF(I,1),W,H,B,WAM,HAM,BAM)   GET KEYWORD INDEX
          DO       LB@F=0         ->IS SPEC AN IMMEDTE VAL/NULL?
           DO1      NUM(AF(I))>0      YES-IS IT IMMEDIATE VAL?
             LI,LB@SR(I) AF(I)        YES-LOAD IMMEDIATE ADDRESS
          ELSE                    ->GO TO 'DO' END;TRY NXT FIELD
*
*                                   E.P. TO GEN LW,LH, OR LB
           DO       LB@F<4      <-  DO ONLY IF NO MASK DESIRED
             GEN,1,7,4,3,17 AFA(I,2),LB@OP(LB@F),; GEN INDRCT BIT,OP,
                      LB@SR(I),AF(I,3),AF(I,2)    REG,INDEX REG,ADR
           ELSE                     DO IF MASK DESIRED
             GEN,1,7,4,3,17 AFA(I,2),X'32',LB@SR(I),; GEN INDIRECT
                      AF(I,3),AF(I,2)     BIT,OP-CODE,REG,
*                                   INDEX REG, REF ADDRESS
             AND,LB@SR(I) L(LB@M(LB@F)) MASK WA,HA, OR BA
           FIN
          FIN                   <-
         FIN
*
*
         DO       NAME=0            DO IF DIRECT BRANCH DESIRED
           B        AF(1)         >>BRANCH TO ROUTINE
         ELSE                       DO IF BAL DESIRED
           BAL,LB@BR AF(1)        >>BAL TO SUBROUTINE
         FIN
*
LB@3     ERROR,X'5',LB@E1  'PROC.LBAL%.NO BAL REG SPECIFIED'
         ERROR,X'5',LB@E2  'PROC.LBR%/LBAL%.NO BRANCH TARGET SPECIFIED'
*
         PEND
*
         PAGE
*
*
*********PROC NAME:     ENTER SLAVE MODE (SLAVE%)
*
*
*        TYPE:          COMMAND PROC
*
*
*        CALL FORMAT:   SLAVE%
*
*
*        DESCRIPTION:   THE PURPOSE OF THE SLAVE% PROC IS TO ENTER
*                       SLAVE MODE. ON THE NEXT MONITOR CALL THE SCHED-
*        ULER WILL BE NOTIFIED THAT THE CURRENT TASK CAN BE RESCHED-
*        ULED FOR OUTSWAP IF DESIREABLE. THIS IS ACCOMPLISHED BY
*        EXECUTING AN LPSD WITH THE SLAVE BIT SET AND MAKING A CALL
*        ON A MONITOR SERVICE WHICH ON EXIT INFORMS THE MONITOR THAT
*        THE CURRENT TASK IS A CANDIDATE FOR SCHEDULING.
*
*
SLAVE%   CNAME                      PROC NAME=SLAVE%
         PROC
         LOCAL    SL@PSD,SL@RTN,SL@1
         GOTO,CK%CODE>0  SL@1     ->DON'T GEN CODE FOR LEVEL 1&2
SL@RTN   SET      %+1               SET ADR OF LPSD+1 (RETURN ADR
*                                   FROM LPSD)
         USECT    CS:PART:TEXT      USE PT 1 DATA CONTROL SECTION
         BOUND    8
SL@PSD   SET      %                 SET ADR OF THIS PSD
         GEN,12,3,17  X'00D',0,SL@RTN  PSD  WD1: SLAVE,MM,AM & RETURNS
         DATA     0                 TO LPSD+1. PSD WD0: WK=0
         USECT    CS:PART:PROCEDURE RTN TO PROCEDURE PT 1 CSECT
         LPSD,0   SL@PSD            ENTER SLAVE MODE
SL@1     SET      %             <-  CHECKOUT LEVELS 1 & 2 EXIT
         PEND
*
         PAGE
*
*
*********PROC NAME:     ENTER MASTER MODE (MASTER%)
*
*
*        TYPE:          COMMAND PROCEDURE
*
*
*        CALL FORMAT:   MASTER%
*
*
*        DESCRIPTION:   THE PURPOSE OF THE MASTER% PROC IS TO ENTER
*                       MASTER MODE IF THE PRODUCTION LEVEL OF
*        ASSEMBLY IS INDICATED BUT OTHERWISE, FOR ALL TESTING LEVELS,
*        GENERATE NO CODE. MASTER MODE IS ENTERED BY A SYSTEM
*        BPM PROC M:SYS WHICH GENERATES A CAL1,6.
*
*
MASTER%  CNAME                      PROC NAME=MASTER%
         PROC
         LOCAL    MA@1
         GOTO,CK%CODE>0  MA@1     ->DON'T GO MASTER FOR LEV 1&2
         M:SYS                    **GET INTO MASTER MODE
MA@1     SET      %             <-  EXIT POINT FOR TESTING LEVELS
         PEND
*
         PAGE
*
*
*********PROC NAME:     MAX%  -  RETURN MAX VALUE OF A SET
*                       MIN%  -  RETURN MIN VALUE OF A SET
*
*        TYPE:          FUNCTION PROCEDURE
*
*
*        CALL FORMAT:   MAX%(X1,X2,X3,...XN)
*                       MIN%(X1,X2,X3,...XN)
*
*        DESCRIPTION:   EACH OF THESE FUNCTION PROCEDURES MAY RECEIVE
*                 ANY NUMBER OF ARGUMENTS (X1,X2,X3,...XN) OF ANY TYPE
*                 FORMAT (CHARACTER STRING, INTEGER, ETC.). ALL THE
*                 ARGUMENTS TAKEN TOGETHER COMPRISE A SET OF VALUES AND
*                 EACH ARGUMENT AN ELEMENT OF THAT SET. THE FUNCTIONS
*                 ANALYZE THE SET AND RETURN THE MAXIMUM/MINIMUM VALUES
*                 OF THE SET AS THE FUNCTION VALUE.
*
*
MAX%     FNAME    1                 1 ===> MAX% PROC CALLED
MIN%     FNAME    0                 0 ===> MIN% PROC CALLED
         PROC
         LOCAL    I,J,MM@AF,MM@NA,MM@X1,MM@X2
MM@AF    SET      AF                GET PROC REF LINE ARG FIELD:
*                                   ON PROC CALL, CANNOT TEST EACH ARG
*                                   IN SEQUENCE USING 'WHILE  AF(I)' -
*                                   AF(I) EVALUATED ONLY ONCE FOR INI-
*                                   TIAL I VALUE ON FIRST ASSEMBLY PASS.
*                                   SUBSEQUENT EVALUATIONS USE THIS I.
MM@NA    SET      NUM(MM@AF)        NUMBER OF ARGUMENTS - LOOP COUNT
J        SET      1
         WHILE    NUM(MM@AF(J))=0   SEARCH FOR 1ST NON-NULL ELEMENT
J          SET      J+1             INCREMENT ARG INDEX
MM@NA      SET      MM@NA-1         DECREMENT # ARGS REMAINING BY 1
           DO       MM@NA=0         IF NO ARGS LEFT, FLAG ERROR
MM@X1        EQU      0             SET FUNCTION VALUE TO 0
             ERROR,X'3',1 'ALL ARGUMENTS OF PROC MAX%/MIN% ARE NULL'
             GOTO,1   MM@END        JUMP TO END PROC
             FIN
           FIN                      FOUND A GOOD ONE?
MM@X1      SET      MM@AF(J)        USE ARG1 AS 1ST BASE FOR COMPARE
I        DO       MM@NA-1           COMPARE AGAINST ARG2--->ARGN
MM@X2    SET      MM@AF(I+J)        GET NEXT ARG VALUE
         DO1      (((NAME=0)&(MM@X1>MM@X2))|; REPLACE OLD VALUE WITH
                  ((NAME=1)&(MM@X1<MM@X2)))&; NEW IF:
                  (NUM(MM@AF(I+J))>0) 1. NEW NOT NULL AND
MM@X1    SET      MM@X2             2.  MAX% CALLED & NEW > OLD
*                                   3.  MIN% CALLED & NEW < OLD
         FIN
MM@END   PEND     MM@X1             RETURN VALUE
*
         PAGE
*
*******************************************
*  3.    CONDITIONAL ASSEMBLY PARAMETERS  *
*******************************************
*
*                       NOTE: ALL CONDITIONAL ASSEMBLY PROCS BEGIN WITH
*                       '%' AND MAY BE LOCATED THROUGH THE USE OF A
*                       CONCORDANCE LISTING.
*
CK%CODE  EQU      0     THREE LEVELS OF MODULE CHECK-OUT ARE PROVIDED
*                       BY THE INCLUSION OF CHECK-CODES WITH CERTAIN
*                       OF THE TEST TABLE ENTRIES AND CONDITIONAL
*                       ASSEMBLY OF THE 'CONTROL' AREAS WHICH CHECK
*                       THE TABLE CODES FOR CORRECT ACCESS. ON THE
*                       FIRST GO-AROUND, THESE CHECK-CODES WILL BE
*                       INCLUDED WITH EACH APPLICABLE TABLE ENTRY AND
*                       WILL BE COMPARED TO SIMILAR CODES IN THE FIRST
*                       CHECK-OUT LEVEL OF THE 'CONTROL' MODULE.
*                       WHEN THE 'CONTROL' UPDATES HAVE BEEN FIRMED UP
*                       THROUGH INITIAL TESTING (LEVEL 2), THE
*                       TABLES WILL BE REASSEMBLED WITHOUT THE CHECK-
*                       CODES AND RUN WITH THE CORRESPONDING VERSION
*                       OF 'CONTROL' WHICH WILL EMPLOY LIMITED CHECKS.
*                       ULTIMATELY, 'CONTROL' WILL BE TESTED WITH NO
*                       GUARD-CODE IN CONJUNCTION WITH PRODUCTION
*                       SYSGEN TABLES.
*
*
AD%DP    EQU      0     INITIALLY, THERE WILL BE NO FACILITY TO 'ADD'
*                       OR 'DROP' PARTITION ATTRIBUTES FOR DISPLAY
*                       PURPOSES. A STANDARD DISPLAY WILL BE GENERATED
*                       DEPENDENT ON THE SETTING OF THIS FLAG UNTIL
*                       SUCH TIME AS WE DECIDE TO TELL THE USER HE HAS
*                       THE MORE GENERAL FACILITY OF CREATING HIS OWN
*                       ORDERED PARTITION ATTRIBUTE DISPLAY.
*
         PAGE
*
***********************************************
*  4.    EXTERNAL REFERENCES & DEFINITIONS  *
***********************************************
*
*  4.1   EXTERNAL REFS
*
*
*        PARTITION ATTRIBUTE TABLES
*
         REF      LPART             # PARTITIONS
         REF      PLD:ACT           ACCT# OF CURRENTLY EXECUTING USER
         REF      PLB:MIN           LOWER LMTS FOR RSRCE
         REF      PLB:MAX           UPPER LMTS FOR RSRCE
         REF      PLH:FLG           HOLD/REL, LOCK/UNLOCK FLAGS
         REF      PLH:QN            PARTITION QUANTUM
         REF      PLH:TOL           TOTAL # JOBS EXECUTED THIS PART
         REF      PLH:CUR           TOTAL # JOBS SELECTED THIS PART
         REF      PLH:TL            LOWER TIME LIMIT
         REF      PLH:TU            UPPER TIME LIMIT
         REF      PLB:USR           CURRENT USER #
         REF      PLH:SID
*
*        PARTITION ACCESS CONTROL WORDS
*
         REF      PL:LK             PART TABLES LOCK-OUT WORD
         REF      PL:CHG            REDEFINED PARTS FLAGS; CONTROL USR#
*
*FOR GERM
         REF      SH:RNM            RSRCE NAME TBL
         REF      SV:RSIZ           RSRCE NAME TBL ENTRIES SIZE
         PAGE
*
*        REFERENCES TO 'CONTROL' PARAMETERS
*
         REF      ICTRACE           'CONTROL' TRACE FLAG FOR DUMPS
         REF      FMAP              'CONTROL' MAPPING OFFSET
         REF      TYPEDO            SUBR FOR TYPING MESSAGE ON M:DO
         REF      USRPRIV           USER PRIV LEV (1=80,2=B0,3=C0)
         REF      COMMAND           INPUT COMMAND BUFFER
         REF      CBUFBSZ           INPUT COMMAND BUFFER BYTE SIZE
         REF      CBUFWSZ           INPUT COMMAND BUFFER WORD SIZE
         REF      ERMS1             ' ILLEGAL COMMAND'
         REF      ERMS4             ''CURRENT' VALUES NOT BET ALTERED'
         REF      C28,C27,C29       TEXT FOR ERROR MSGES
         REF      SPDADR            USER'S TCB SPD ADR CELL
         REF      BREAK,BREAK3,BREAK5 E.P. FOR BREAK CONTROL HANDLERS
         REF      ADD1              E.P. TO PROCESS 'ADD' CMD
         REF      PARTMAIN          FOR ENTRY INTO 'ADD1' IN MAIN
*********CK%CODE  BREAK FLAG TEST IN 'ENTRY'
         DO1      CK%CODE>=1        BREAK FLAG (-1=BREAK SET;0=NO BREAK)
         REF      BFLG
*********CK%CODE  END
*
*        REFERENCES TO 'CONTROL' SUBROUTINES (MODULE 'CONSUB')
*
         REF      APEND,BOUTX,BOUT  APPEND CHAR STRING OUTPUT BUF SUBR
         REF      HEXINX            EBCDIC HEX INTEGER-->BIN CONVERS
         REF      OCTOLP,LPTOOC
         REF      OBUFSZ            OUTPUT BUFFER SIZE
         REF      DECIN,DECINX      DEC INTEGER-->BINARY CONVERSION
         REF      DECOUT            BINARY-->EBCDIC DECIMAL INTEGER
         REF      HEXOUT            BIN-->EBCDIC HEXADECIMAL INTEGER
         REF      READSI            M:READ OF M:SI DEVICE
         REF      SPACE             SPACE N OUTPUT BLANKS
         REF      SEND              M:WRITE OUTPUT BUFFER THROUGH M:LO
         REF      NEWLN             SKIP N OUTPUT LINES
         REF      ITEMFIND          FIND AN ITEM NAME IN TABLE
*
*        REFERENCES TO OTHER SYSTEM PARAMETERS
*
         REF      S:CUN             USER # OF TASK CURRENTLY EXECUTING
         REF      M:LO,M:DO,M:SI    CONTROL COMMUNICATION DCB'S
         REF      J:JIT             1ST WORD OF JIT FOR DUMPS
*
*  4.2   EXTERNAL DEFS
*
         DEF      CS:PART:TEXT,CS:PART:PROCEDURE,CS:PART:DATA
         DEF      CSEND:PART:PROCEDURE,CSEND:PART:TEXT
         DEF      CSEND:PART:DATA
         DEF      PART              'CONTROL' ENTRY INTO MODULE
         DEF      PEXEC             'PART' EXECUTION FLAG
         DEF      ZEROUT            RELEASE PART DEF STK PG SUBR
         DEF      9WAR3             NUMBERIC OVERFLOW MSGE
         DEF      SCAN              CMD SCANNER
         DEF      CFPTRS            SCANNED CMD FIELD POINTERS
         DEF      SPD               'PART' STACK POINTER DW
*********CK%CODE  'PART' STACK SIZE FOR 'QUIT' CHECKOUT
         DO1      CK%CODE>=1
         DEF      STSZ              DEF TO CONTROL FOR CHECKOUT
*********CK%CODE  END
*
*FOR GERM
         DEF      GATERM            FOR SEARCHING
         DEF      GAHEAD            FOR HEADING
         DEF      GAVMIN            FOR MIN CHECK
         DEF      GAVMAX            FOR MAX CHECK
         DEF      GAOSTD            FOR STANDARD OUTPUT
         PAGE
*
**************************************
*  5.    STATIC ASSEMBLY PARAMETERS  *
**************************************
*
*  5.1   REGISTER USAGE
*
R0       EQU      0                 SCRATCH REG
R1       EQU      1                 SCRATCH REG; PROC REG
R2       EQU      2                 DATADEF PRINC.; SCRATCH; PROC REG
R3       EQU      3                 DATADEF INDEX; SCRATCH  REG
R4       EQU      4                 DATADEF PRINCIPLE; SUBR REG
R5       EQU      5                 DATADEF SUBORDINATE; SUBR REG
R6       EQU      6                 DATADEF; INDEX REG
R7       EQU      7                 DATADEF; INDEX; BAL REG
SR1      EQU      8                 SUBR I/O PARAMS; CAL RETURN ADR
SR2      EQU      9                 SUBR I/O PARAMS
SR3      EQU      10                SUBR I/O PARAMS; CAL ERR/ABN CODE
SR4      EQU      11                SUBR I/O PARAMS; BAL REG
D1       EQU      12                SCRATCH;HANDLER PARAM
D2       EQU      13                SCRATCH;HANDLER PARAM
D3       EQU      14                SCRATCH;HANDLER PARAM
D4       EQU      15                BAL REG
*
         PAGE
*
*        UNDER THE CONCEPT OF GERM(GENERALIZED RESOURCE MANAGEMENT
*SCHEME),ATTRIBUTES FOR PARTITION DEFINITION ARE NOW SEPERATED INTO
*TWO PARTS :
*   1. NON-RESOURCE ATTRIBUTES,SUCH AS TIME,QUAN,LOCK,ETC
*   2. RESOURCE ATTRIBUTES,SUCH AS CORE,9T,7T,SP,ETC
*        TO REFLECT AND FACILITATE SUCH A CONCEPT,THE FOLLOWING IS
*IN LINE :
*  1. ALL TABLES ARE SET UP IN THE DATA AREA SO THAT SOME ENTRIES
*CONCERNING RSRCE CAN BE EASILY INITIALIZED(WHICH IS DONE IN THEMAIN
*ROUTINE) AND MODIFIED. ENTRIES FOR NON-RSRCE ATTRIBUTES
*,THOUGH PLACED IN DATA AREA, ARE ESSENTIALLY STATIC AND SHOULD
*NOT BE INITIALIZED
*  2. ALL TABLES IN THIS ROUTINE ARE LOGICALLY SPLIT INTO TWO PARTS
*WITH THE RSRCE ATTRIBUTES RIGHT ON HEELS OF THE NON-RSRCE ONES
*SO THAT DUE CONTROL CAN BE EXERTED.
*
         PAGE
*
*  5.2   PARTITION ATTRIBUTE TABLE ENTRY DEFINITIONS
*
PACT1    SET      :ITEM((AD,PLD:ACT+F),(BI,64)) 1ST WORD OF ACCOUNT DW
PACT2    SET      :ITEM(PACT1,(EO,1))  2ND WORD OF ACCOUNT DW
PHOLD    SET      :ITEM((LB,0),(AD,PLH:FLG+F),(BI,16),(ST,'NO','YES'))
*                                   HOLD/RELEASE FLAG
PLOCK    SET      :ITEM(PHOLD,(FB,15),(LB,15))  LK/ULK FLAG
PLCL     SET      :ITEM(PHOLD,(FB,12),(LB,12))
PTRM     SET      :ITEM(PHOLD,(FB,13),(LB,13))
PRB      SET      :ITEM(PHOLD,(FB,14),(LB,14))
*********CK%CODE  FOR CHECK-OUT OF 'GETVAL'
         DO1      CK%CODE=2         DO FOR LEVEL 2 ONLY; GET CHECK-CODE
PLOCK    SET      :ITEM(PLOCK,(FB,8)) USE WHOLE BYTE
         DO1      CK%CODE=2
PHOLD    SET      :ITEM(PHOLD,(FB,0),(LB,7))   SAME FOR HOLD
*********CK%CODE  END
PQUAN    SET      :ITEM((LB,15),(AD,PLH:QN+F),(BI,16)) QUANTUM
PTOL     SET      :ITEM(PQUAN,(AD,PLH:TOL+F)) TOT # JOBS EXECUTED
PCUR     SET      :ITEM(PQUAN,(AD,PLH:CUR+F)) TOT % JOBS SELECTED
PTL      SET      :ITEM(PQUAN,(AD,PLH:TL+F)) LOWER TIME LIMIT TABLE
PTU      SET      :ITEM(PQUAN,(AD,PLH:TU+F)) UPPER TIME LIMIT TABLE
PUSR     SET      :ITEM((LB,7),(AD,PLB:USR+F),(BI,8)) CURRENT USER #
PSID     SET      :ITEM(PQUAN,(AD,PLH:SID+F)) CURRENT SYSID
PTLK     SET      :ITEM((FB,31),(AD,PL:LK+F),;
                       (ST,'PT.OPEN','PT.CLOSE'))  TBL LK/ULK
PCUN     SET      :ITEM((LB,7),(AD,PL:CHG+F)) CURRENT USER OF CONTROL
PFLAGS   SET      :ITEM((FB,16),(LB,31),(AD,PL:CHG+F)) PART CHANGE FLAGS
*
         PAGE
*
*********CK%CODE  LEV 2 CHECK-OUT OF 'GETVAL'
         DO       CK%CODE=2         GEN CHECK-CODE DATADEF ITEMS;LEV 2
PLOCK%C    SET      :ITEM((FB,8),(LB,14),(BI,16),(ST,3,'CODE.OK'))
PLOCK%R    SET      :ITEM((FB,15),(LB,15),(BI,16))  EXTRACT LOCK FLG
           FIN
*********CK%CODE  END
*
         PAGE
*
*  5.4   OTHER ASSEMBLY PARAMETERS
*
F        EQU      FMAP              'CONTROL' VIRTUAL MAPPING CONSTANT
*                                   FOR REAL MON PAGES
#ATERM2  EQU      DA(ATEND)-DA(ATERM2)  # OF ENTRIES IN ATERM2
#AT2SET  EQU      DA(AT2DISP)-DA(ATERM2) #ALTERABLE ENTRIES IN ATERM2
MTNP     EQU      'TABLE NOT PARALLEL'  WARNING MESSAGE FOR ASS'Y
*
CMDBUF   EQU      COMMAND           ADR OF INPUT COMMAND BUFFER
GBSZ     EQU      12                GETDATA BUFFER BYTE SIZE
AOSZ     EQU      #ATERM2+1         AORDER SIZE= #ENTRIES IN ATERM2+1
STSZ     EQU      48                MAIN STACK SZ;2 SETS 16 REGS
PDSZ     EQU      16*3*(#AT2SET+RSRCE)    (#PARTS)*(MAX WDS PUSH)*
*                                   (# ALTERABLE ATTRIBUTES/PART)
DOVSZ    EQU      2*16+1            DISPLAY OVERFLOW STACK SIZE;
*                                   (MAX# OVRFLWS POSSIBLE/PART)*
*                                   (MAX # PARTS)+1 - STACK NEVER FULL
*
*FOR TBL SETUP,ASSUME MAX RSRCE ITEMS TO BE 15
RSRCE    EQU      15
         PAGE
*
**********************************
*  6.    DATA CONSTANTS & FPT'S  *
**********************************
*
*
         BOUND    8
PART#LIM DATA     1,LPART           GEN LIMITS FOR PART #
AT2IXL   DATA     1,#ATERM2+SV:RSIZ  GEN LIMITS FOR ITEM INDEX #
A#RNGE   DATA     X'C1',X'F9'       EBCDIC ALPHANUMERIC VALS RANGE
ARNGE    DATA     X'C1',X'E9'       EBCDIC ALPHABETIC VALS RANGE
PMPLIMS  DATA     CS:PART:PROCEDURE,CSEND:PART:PROCEDURE  GEN LIMITS
*                                   FOR 'PART' MODULE PROCEDURE.
AT2DATA  GEN,8,24 #ATERM2+SV:RSIZ,ATERM2  #ENTRIES;TBL FOR 'ITEMFIND'
*                                   BOTH NON-RSRCE AND RSRCE
PH#LIM   DATA,2   LPART,1           SET UP MAX/MIN P#'S FOR 'SET'
*
*
* ALL TABLES SET UP IN DATA AREA
*
         USECT    CS:PART:DATA
         PAGE
*
*************************
*  7.    DATA POINTERS  *
*************************
*
*
*  7.1   'AHEADPTR' - A WORD-TABLE OF ADDRESSES, EACH POINTING TO THE
*                     FIRST BYTE OF A TEXTC STRING IN TABLE 'AHEAD'.
*        EACH TEXT STRING IN 'AHEAD' IS A HEADING FOR A PARTITION
*        ATTRIBUTE SPECIFIED IN 'ATERM2'. SINCE 'AHEADPTR' IS PARALLEL
*        TO 'ATERM2', AN ITEM INDEX IN 'ATERM2' CAN BE USED TO ACCESS
*        THE PARALLEL POINTER IN 'AHEADPTR' WHICH INDIRECTLY ALLOWS
*        ACCESS TO THE HEADING FOR THAT ATTRIBUTE.
*
*
         BOUND    4          ENTRY #
AHEADPTR EQU      %          -------
         DATA     PH0           -   PARTITION #
         DATA     PH2           2   TIME
         DATA     PH3           3   QUAN
         DATA     PH7           7   LOCK
         DATA     PH8           8   HOLD
         DATA     PH14                14   JCL-LCL
         DATA     PH15                15   JCL-TRM
         DATA     PH16                16   JCL-RB
         DATA     PH9           9   CUR
         DATA     PH10         10   TOL
         DATA     PH11         11   ACCT
         DATA     PH12         12   USER#
         DATA     PH13         13   CURRENT SYSID
*
         ERROR,X'F',%-AHEADPTR~=ATERM2  MTNP
*
*FOR GERM
GAHDPTR  EQU      %
         DATA     GAHEAD
I        DO       RSRCE-1
         DATA     GAHEAD+I*2
         FIN
*
         PAGE
*
***********************
*  8.    DATA TABLES  *
***********************
*
*
*  8.1   'ATERM2' - TEXT DOUBLEWORD TABLE CONTAINING THE KEY-WORD FOR
*                   EACH OF THE PARTITION ATTRIBUTE OPTIONS. THE ENTRY
*                 NUMBER OF EACH KEY-WORD IN THE TABLE IS THE KEY-WORD
*                 INDEX. SINCE TABLES AVMINL, AVMINU, AVMAXL, ADRFLAG
*                 AVMAXU, AHEADPTR, AFWIDTH AND ACLASS ARE PARALLEL
*                 TO ATERM2, THIS INDEX SELECTS ASSOCIATED ENTRIES FROM
*                 ALL TABLES. WHEN A USER ENTERS A COMMAND WITH A
*                 PARTITION ATTRIBUTE OPTION, A SEARCH IS MADE ON THIS
*                 TABLE TO DETERMINE THE OPTION INDEX. ALL OPTIONS IN
*                 TABLE ATERM2 MAY BE DISPLAYED OR ALTERED. AT2DISP,
*                 WHICH IS A SUBSET OF ATERM2, CONTAINS THE NAMES OF
*                 THOSE OPTIONS WHICH ARE FOR DISPLAY ONLY.
*
*
         BOUND    8
ATERM2   EQU      %-2        ENTRY #   ENTRY # IS AN INDEX TO OPTION:
*                            -------   E.G. LW,R0  ATERM2,R1 WHERE R1
         TEXT     'TIME    '    2   EXECUTION TIME RANGE ALLOWED
         TEXT     'QUAN    '    3   BATCH QUANTUM IN MSEC
         TEXT     'LOCK    '    7   LOCK=1==>PART NOT AVAILABLE
*                                   FOR JOB SELECTION;LOCK=0==>OPERAT'NL
         TEXT     'HOLD    '    8   HOLD=1==>HOLD PART JOB IN CORE;
         TEXT     'LCL     '    14    JCL-LCL
         TEXT     'TRM     '    15    JCL-TRM
         TEXT     'RB      '    16    JCL-RB
*                                   HOLD=0==>SWAP JOB
AT2DISP  EQU      %-2               ITEMS FOR DISPLAY ONLY
         TEXT     'CUR     '    9   #JOBS CURRENTLY SELECTED FOR EXEC
         TEXT     'TOL     '   10   TOTAL # JOBS EXECUTED THIS PART
         TEXT     'ACCT    '   11   ACCOUNT # OF CURRENTLY EXECUTING JOB
         TEXT     'USER#   '   12   USER # OF CURRENTLY EXECUTING JOB
         TEXT     'SYSID   '   13   CURRENT SYSID
ATEND    EQU      %-2               TABLE END
*
         DISP     #ATERM2           DISPLAY TOTAL # PART ATRBTES
         DISP     DA(ATEND)-DA(AT2DISP)  DISPLAY # DISPLAY ONLY ATRBTES
*
*FOR GERM,TO BE INITIALIZED IN MAIN ROUTINE
GATERM   EQU      %
         DO       RSRCE
         TEXT     '        '
         FIN
*
         PAGE
*
*  8.2   'ADRFLG' - THE DISPLAY/RANGE TABLE IS AN INDEXED SET OF FLAGS
*                   USED TO DETERMINE THE TYPE OF PARTITION ATTRIBUTE
*        SPECIFIED: A SINGLE VALUE ITEM (ENTRY=1), A RANGE
*        (ENTRY=2), A SINGLE VALUE ITEM (DISPLAY ONLY; ENTRY=3), A
*        RANGE OR DOUBLEWORD VALUE (DISPLAY ONLY, ENTRY=4). THE DATA
*        ENTRY FOR DISPLAY ONLY ITEMS IS ALWAYS GREATER THAN TWO.
*        'ADRFLG' IS PARALLEL TO 'ATERM2' AND IS A BYTE TABLE.
*
*                   MINIMUM VALUES FOR SINGLE VALUED ITEMS ARE STORED
*        IN AVMIN AND MAXIMUMS IN AVMAX. MINIMUM VALUES FOR THE
*        LOWER ITEM IN A RANGE ARE STORED IN AVMIN, AND MAXIMUM VALUES
*        FOR THE UPPER ITEM ARE FOUND IN AVMAX. (SEE 8.3)
*
         BOUND    4          ENTRY #
ADRFLG   EQU      %          -------
         DATA,1   0                 0TH ENTRY IS NULL
         DATA,1   2              2  TIME - RANGE
         DATA,1   1              3  QUAN - SINGLE VALUE
         DATA,1   1              7  LOCK - SINGLE VALUE
         DATA,1   1              8  HOLD - SINGLE VALUE
         DATA,1   1                    14  LCL  - SINGLE VALUE
         DATA,1   1                    15  TRM  - SINGLE VALUE
         DATA,1   1                    16  RB   - SINGLE VALUE
         DATA,1   3              9  CUR  - DISPLAY ONLY
         DATA,1   3             10  TOL  - DISPLAY ONLY
         DATA,1   4             11  ACCT - DISPLAY ONLY
         DATA,1   3             12  USER#- DISPLAY ONLY
         DATA,1   3             13  SYSID- DISPLAY ONLY
*
         ERROR,X'F',(BA(%)-1-BA(ADRFLG))~=#ATERM2 MTNP
*
*FOR GERM,ALL ASSUMED TO HAVE A RANGE VALU
GADRFLG  EQU      %
         DO       RSRCE
         DATA,1   2
         FIN
*
         PAGE
*
*  8.3   'AVMIN'   - A HALF-WORD TABLE SPECIFYING THE MINIMUM ALLOWABLE
*                     VALUE FOR THE LOWER VALUE IN A PARITION ATTRIBUTE
*                 ITEM RANGE OR FOR A SINGLE VALUED ITEM. A -2 INDICATES
*                 DISPLAY ITEM ONLY.
*
         BOUND    4          ENTRY #
AVMIN    EQU      %          -------
         DATA,2   0                 0TH ENTRY IS NULL
         DATA,2   0              2  TIME
         DATA,2   0              3  QUAN
         DATA,2   0              7  LOCK
         DATA,2   0              8  HOLD
         DATA,2   0                    14  LCL
         DATA,2   0                    15  TRM
         DATA,2   0                    16  RB
         DATA,2   -2             9  CUR   - DISPLAY ONLY
         DATA,2   -2            10  TOL   - DISPLAY ONLY
         DATA,2   -2            11  ACCT  - DISPLAY ONLY
         DATA,2   -2            12  USER# - DISPLAY ONLY
         DATA,2   -2            13  SYSID- DISPLAY ONLY
*
         ERROR,X'F',(HA(%)-1-HA(AVMIN))~=#ATERM2 MTNP
*
*FOR GERM,TO BE INITIALIZED IN MIAN ROUTINE
GAVMIN   EQU      %
         RES,2    RSRCE
*
         PAGE
*
*  8.6   'AVMAX' - A HALF-WORD TABLE SPECIFYING THE MAXIMUM ALLOWABLE
*                  VALUE FOR THE UPPER VALUE IN A PARTITION ATTRIBUTE
*        ITEM RANGE OR THE MAXIMUM ALLOWABLE VALUE FOR A SINGLE VALUED
*        ITEM.
*
*                 A -2 INDICATES AN ITEM FOR DISPLAY ONLY.
*
         BOUND    4          ENTRY #
AVMAX    EQU      %          -------
         DATA,2   0                 0TH ENTRY IS NULL
         DATA,2   32767          2  TIME
         DATA,2   10000          3  QUAN
         DATA,2   1              7  LOCK
         DATA,2   1              8  HOLD
         DATA,2   1                    14  LCL
         DATA,2   1                    15  TRM
         DATA,2   1                    16  RB
         DATA,2   -2             9  CUR
         DATA,2   -2            10  TOL
         DATA,2   -2            11  ACCT
         DATA,2   -2            12  USER#
         DATA,2   -2            13  SYSID
*
         ERROR,X'F',(HA(%)-1-HA(AVMAX))~=#ATERM2 MTNP
*
*FOR GERM,TO BE INITIALIZED IN MAIN ROUTINE
GAVMAX   EQU      %
         RES,2    RSRCE
*
         PAGE
*
*  8.7.1 'AFWIDTH' - A BYTE-TABLE PARALLEL TO 'ATERM2' WHICH GIVES THE
*                    DISPLAY FIELD WIDTH FOR EACH ATTRIBUTE ITEM WHEN
*        DISPLAYED BY THE 'DISPLAY N' OR 'DISPLAY ALL' COMMAND.
*        DEPENDING ON THE FIELD CODE IN' 'AVJUST', THE RANGE OR SINGLE
*        VALUE MAY BE CENTERED, RIGHT-JUSTIFIED, OR LEFT-JUSTIFIED
*        IN THE FIELD FOR A PLEASING OUTPUT.
*
         BOUND    4          ENTRY #
AFWIDTH  EQU      %          ------- DISPLAY FIELD WIDTH
         DATA,1   4             -   PARTITION #
         DATA,1   7             2   TIME
         DATA,1   4             3   QUAN
         DATA,1   4             7   LOCK
         DATA,1   4             8   HOLD
         DATA,1   4                    14  LCL
         DATA,1   4                    15  TRM
         DATA,1   4                    16  RB
         DATA,1   3             9   CUR
         DATA,1   4            10   TOL
         DATA,1   8            11   ACCT
         DATA,1   5            12   USER#
         DATA,1   5             13  SYSID
*
         ERROR,X'F',BA(%)-1-BA(AFWIDTH)~=#ATERM2 MTNP
*
*FOR GERM,ALL RSRCE FILED WIDTH SET TO 5
GAFWIDTH EQU      %
         DO       RSRCE
         DATA,1   5
         FIN
*
         PAGE
*
*  8.7.2 'AVJUST' - A BYTE TABLE PARALLEL TO 'ATERM2' WHICH GIVES THE
*                   VALUE JUSTIFICATION WITHIN EACH ATTRIBUTE ITEM
*        DISPLAY FIELD FOR THE 'DISPLAY N' OR 'DISPLAY ALL' COMMAND.
*        CODE MEANINGS FOR EACH ENTRY ARE:
*
*        NEGATIVE CODE ===> LEFT-JUSTIFY VALUE WITHIN DISPLAY FIELD
*        ZERO CODE     ===> CENTER VALUE WITHIN DISPLAY FIELD
*        POSITIVE CODE ===> RIGHT-JUSTIFY VALUE WITHIN DISPLAY FIELD
*
         BOUND    4          ENTRY #
AVJUST   EQU      %          -------DISPLAY VALUE JUSTIFICATION
         DATA,1   0             -   PARTITION #
         DATA,1   0             2   TIME
         DATA,1   1             3   QUAN
         DATA,1   0             7   LOCK
         DATA,1   0             8   HOLD
         DATA,1   0                    14  LCL
         DATA,1   0                    15  TRM
         DATA,1   0                    16  RB
         DATA,1   1             9   CUR
         DATA,1   1            10   TOL
         DATA,1   -1           11   ACCT
         DATA,1   1            12   USER#
         DATA,1   1             13  SYSID
*
         ERROR,X'F',BA(%)-1-BA(AVJUST)~=#ATERM2  MTNP
*
*FOR GERM,ALL RSRCE HAVE ZERO CODE
GAVJUST  EQU      %
         DO       RSRCE
         DATA,1   0
         FIN
*
         PAGE
*
*  8.8   'ACLASS' - A BYTE-TABLE PARALLEL TO 'ATERM2' OF CODES INDI-
*                   CATING THE CLASS OF OUTPUT FOR EACH PARTITION
*        ATTRIBUTE DISPLAY ITEM. THE TRANSLATION OF EACH CODE FOLLOWS:
*
*                 CODE  MEANING
*                 ----  --------------------------
*                   1   DECIMAL NUMBER
*                   2   RANGE (2 DEC #'S SEPARATED BY A '-')
*                   3   ALPHANUMBERIC (EBCDIC)
*                   4   HEXADECIMAL NUMBER (EBCDIC REPRESENTATION)
*                   5   'YES'/'NO'/'1'/'0'
*
         BOUND    4          ENTRY #
ACLASS   EQU      %          -------
         DATA,1   1             0   PARTITION #
         DATA,1   2             2   TIME
         DATA,1   1             3   QUAN
         DATA,1   5             7   LOCK
         DATA,1   5             8   HOLD
         DATA,1   5                    14  LCL
         DATA,1   5                    15  TRM
         DATA,1   5                    16  RB
         DATA,1   1             9   CUR
         DATA,1   1            10   TOL
         DATA,1   3            11   ACCT
         DATA,1   4            12   USER#
         DATA,1   4             13  SYSID
*
         ERROR,X'F',BA(%)-1-BA(ACLASS)~=#ATERM2 MTNP
*
*FOR GERM,ALL HAVE CLASS 2
GACLASS  EQU      %
         DO       RSRCE
         DATA,1   2
         FIN
*
         PAGE
*
*  8.9   INPUT COMMAND SCAN TABLES - 'SCANTBL%', THE PROC USED TO GEN-
*                 ERATE THESE TABLES, CONSTRUCTS FROM THE INPUT LISTS
*        A TABLE CONTAINING THE KEYWORDS USED TO IDENTIFY INPUT COMMANDS
*        (CMDTBL), A BYTE TABLE CONTAINING THE NUMBER OF FIELDS
*        REQUIRED BY EACH COMMAND ENTRY (FLDTBL), AND A TABLE CONTAINING
*        THE ADDRESS OF AN APPROPRIATE HANDLER FOR EACH COMMAND ENTRY.
*        (BRTBL). THE NUMBER OF BYTES PER ENTRY IN CMDTBL DEPENDS ON THE
*        NUMBER OF BYTES IN THE FIRST LIST ENTRY IN THE SCANTBL% ARGU-
*        MENT FIELD.
*
*                 THE NUMBER OF FIELDS REQUIRED BY EACH COMMAND MAY
*        EITHER BE A SINGLE NUMBER OR A RANGE. NO COMMAND MAY REQUIRE
*        MORE THAN 15 FIELDS. A RANGE IS SPECIFIED BY (LEAST # FIELDS
*        COMMAND REQUIRES, MOST # FIELDS COMMAND REQUIRES).
*
*                 'SCANTBL%' ALSO OUTPUTS A PARAMETER EQUATED TO THE
*        NUMBER OF COMMAND ENTRIES (#SCANCMD) AND A PARAMETER EQUATED
*        TO THE MAXIMUM NUMBER OF FIELDS REQUIRED BY ANY COMMAND.
*
CMDTBL,FLDTBL,BRTBL SCANTBL%,#SCANCMD,#SCANFLD ; CREATE CMD/FLD/BR TBLS
*                                               FOR 'SCAN' (SECT 15)
         ('D',2,DISPLAY),;          DISPLAY N/DISPLAY ALL CMDS
         ('A',2,15SCN12),;          ALL 'ATRBTE'/ALL 'ATRBTE'=X CMDS
         ('L',1,LIST),;             LIST CURRENT DISPLAY ITEMS
         ('S',1,STORE),;            STORE CMD
         ('C',1,CLEAR),;            CLEAR CMD
         ('E',1,END),;              END CMD
         ('A',1,ADD),;              ADD CMD
         ('D',1,DROP),;             DROP CMD
         ('B',2,BUILD),;            BUILD CMD
         ('0',2,15SCN12),;          N 'ATRBTE'/N 'ATRBTE'=NN CMDS
         ('1',2,15SCN12),;          SAME
         ('2',2,15SCN12),;          SAME
         ('3',2,15SCN12),;          SAME
         ('4',2,15SCN12),;          SAME
         ('5',2,15SCN12),;          SAME
         ('6',2,15SCN12),;          SAME
         ('7',2,15SCN12),;          SAME
         ('8',2,15SCN12),;          SAME
         ('9',2,15SCN12),;          SAME
         ('*',0,COMMENT)            COMMENT CMD
*
         PAGE
*
*  8.10  'AOSTD' - STANDARD PARTITION ATTRIBUTE DISPLAY ENTRY TABLE.
*                  THIS BYTE TABLE CONTAINS THE ATERM2 ENTRY NUMBERS
*        FOR EACH PARTITION ATTRIBUTE. IT IS USED TO INITIALIZE THE
*        ATTRIBUTE ENTRY DISPLAY ORDER TABLE 'AORDER' WHEN !ADD!
*        AND THEN 'ALL' ARE SPECIFIED BY THE USER.
*
*
         BOUND    4
AOSTD    EQU      %
I        DO       #ATERM2           GENERATE ENTRY #'S
           DATA,1   I               INCREMENT ENTRY #'S TIL DONE
         FIN
*FOR GERM ,E-O-T WILL BE SET UP IN MAIN
GAOSTD   EQU      %
I        DO RSRCE
         DATA,1   #ATERM2+I
         FIN
         DATA,1   0                 END-OF-TABLE FLAG
*
         BOUND    4
*
         PAGE
*
***************************
*  9.    TEXT & MESSAGES  *
***************************
*
*
*  9.1   'AHEAD' - A TEXTC TABLE OF HEADINGS FOR PARTITION ATTRIBUTES
*                 WHICH ARE DISPLAYED IN COLUMNS BY THE 'DISPLAY N'
*        OR 'DISPLAY ALL' COMMANDS. THE USER CHOOSES THE ATTRIBUTES HE
*        WISHES DISPLAYED THROUGH USE OF THE 'ADD' AND 'DROP' COMMANDS.
*        WHEN HE CALLS FOR A DISPLAY OF THESE ATTRIBUTES FOR APRTICULAR
*        PARTITION, THE HEADINGS OF THOSE ATTRIBUTES ARE TAKEN FROM
*        THIS TEXT TABLE AND CONCATENATED TO FORM A DESCRIPTIVE HEADING
*        FOR THE DISPLAY. EACH MICRO-HEADING IS ACCESSED THROUGH
*        'AHEADPTR', A TABLE OF SYMBOL POINTER (PH0-PH12) PARALLEL TO
*        THE ATTRIBUTE NAMES IN ATERM2.
*
*
         BOUND    4
AHEAD    EQU      %                 PART DISPLAY HEADINGS
*
PH0      TEXTC    ' PART '
PH1      TEXTC    ' CORE '
PH2      TEXTC    '  TIME  '
PH3      TEXTC    'QUAN '
PH4      TEXTC    ' SP   '
PH5      TEXTC    ' 7T   '
PH6      TEXTC    ' 9T   '
PH7      TEXTC    'LOCK '
PH8      TEXTC    'HOLD '
PH9      TEXTC    'CUR '
PH10     TEXTC    ' TOL '
PH11     TEXTC    '  ACCT   '
PH12     TEXTC    'USER# '
PH13     TEXTC    'SYSID '
PH14     TEXTC    ' LCL '
PH15     TEXTC    ' TRM '
PH16     TEXTC    ' RB  '
*FOR GERM TEXTC NAMES TO BE INIT. IN MAIN
         BOUND    8                 FOR EASE FO DYNAMIC INIT.
GAHEAD   EQU      %
         RES,8    RSRCE
*
         USECT    CS:PART:TEXT
*
         PAGE
*
*  9.2   OTHER TEXT
*
         BOUND    8
IDLET    TEXT     '**IDLE**'
DASHES   TEXT     '------------'    THIS TABLE IS USED TO UNDERLINE THE
*                                   ATTRIBUTE HEADINGS. TO USE, GO
*                                   INDIRECT THROUGH 'AHEADPTR' AND
*                                   GET 1ST BYTE OF 'AHEAD' ENTRY WHICH
*                                   IS THE HEADING'S STRING LENGTH.
*                                   SUBTRACT 1 AND GET THAT NUMBER OF
*                                   DASHES; ADD THEM TO THE OUTPUT
*                                   BUFFER AND FOLLOW WITH A BLANK.
*
NOC      TEXTC    'NO'              'NO' FOR PART ATRBTE OUTPUT
YESC     TEXTC    'YES'             'YES' FOR PART ATRBTE OUTPUT
DELIMS   TEXTC    '=-'              DELIM LIST FOR PRESCAN PACK
ASTC     TEXTC    '*'               ASTERISK FOR ATRBTE OVERFLW DISPLAY
9WAR1    TEXTC    ' TABLES LOCKED. CUR USER #=    '
9WAR1#   EQU      %-1               SET ADR OF USER # BUFFER FOR ERR
*
         PAGE
*
**********************************
*  10.   ENTRY & INITIALIZATION  *
**********************************
*
*
*  DESCRIPTION:   THE PURPOSE OF 'ENTRY' IS:
*
*        1.       TO ASCERTAIN THAT PARTITION CONTROL EXECUTION STATUS
*                 IS NOT STILL ACTIVE, I.E., THE USER HAS NOT ISSUED
*                 A BREAK WHILE EXECUTING IN THE PARTITION CONTROL
*                 MODULE WHICH HAS NOT BEEN SATISFIED BY A 'QUIT' OR
*                 'PROCEED' COMMAND.
*        2.       TO SAVE ALL GENERAL REGISTERS BEFORE THEIR CONTENTS
*                 ARE ALTERED.
*        3.       TO RESET THE DISPLAY OVERFLOW STACK (USED WHEN AN
*                 EBCDIC DISPLAY CONTAINS MORE CHARACTERS THAN THE
*                 ALLOWABLE FIELD WIDTH) AND THE PARTITION DEFINITION
*                 STACK (USED TO STORE TENTATIVE PARTITION LIMIT
*                 CHANGES). EITHER ONE OF THESE STACKS MAY HAVE BEEN
*                 IN USE WHEN A BREAK PREVIOUSLY OCCURRED AND MAY HAVE
*                 BEEN LEFT PARTIALLY FILLED. THE 'PARTITION' COMMAND
*                 RESETS THE VARIABLES ASSOCIATED WITH ANY PREVIOUS
*                 ATTRIBUTE SET COMMAND BY CALLING 'ZEROUT', IF THE
*                 USER HAS PRIVILEGE X'C0' OR GREATER.
*        4.       TO PROVIDE CONDITIONAL ASSEMBLY CHECKS ON THE BREAK
*                 FLAG AND PARTITION CONTROL EXECUTION FLAGS, THE
*                 PARTITION CONTROL REGISTERS PUSH STACK, AND THE USER
*                 PRIVILEGE LEVEL.
*
*                 'PART' IS DESIGNED TO FUNCTION AS AN OPEN-ENDED IN-
*        DEPENDENT MODULE IN CONFUNCTION WITH THE NECESSARY SUBROUTINES
*        CONTAINED IN 'CONSUB'.
*
*
*  FUNCTION:      'PEXEC' IS THE PARTITION CONTROL EXECUTION FLAG. IT
*                 IS SET > 0 ON ENTRY TO 'PART' AND RESET TO 0 ON
*        EXIT. IF A BREAK OCCURS IN 'PART', 'PEXEC' WILL REMAIN ON
*        UNTIL RESET BY A 'QUIT' COMMAND OR BY A 'PROCEED', 'END'
*        SEQUENCE. 'PART' IS NOT RE-ENTRANT. THE COMMANDS 'PARTITION',
*        'CLEAR', AND 'STORE' ZERO OUT ALL SET COMMAND VARIABLES
*        INCLUDING THE ATTRIBUTE SET VALUE STACK.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL              EXIT
*        -----             --------              ----
*        ALL REGS PUSHED   R1=WORK               ALL REGS PRESERVED
*
*
         USECT    CS:PART:PROCEDURE
*
PART,10ENT1 EQU   %                 ENTRY IS FROM 'CONTROL'; UNIQUE EP
         PSW,R0   *SPDADR           SAVE R0 TEMPORARILY
         TRACE%   ' 7'              STORE PART TRACE-CODE IN ICTRACE
         PLW,R0   *SPDADR           GET R0
         MTW,0    PEXEC             IS PARTITION CONTROL FLAG ON?
         BEZ      10ENT2          ->  NO-GOOD;CLEAN ENTRY INTO PART
*                                     YES-PREVIOUS BREAK OUT OF PART-
*                                     ITION CONTROL INDICATED.
*********CK%CODE  FOR PEXEC=1, PREVIOUS BREAK OUT OF PART CONTROL
         DO       CK%CODE>=1        MUST HAVE OCCURRED.
           MTW,0    BFLG            IS BREAK FLAG TURNED ON?
           BLZ      10CK1             YES-USER MUST 'QUIT' OR
*                                     'PROCEED' TO RETURN TO PART.
           TYPE     'PART.10.ENTRY.PEXEC=1.BFLG>-1'
           B        12EXIT2       >>WAIT FOR DELTA
10CK1      EQU      %           <-
         FIN
*********CK%CODE  END BREAK FLAG CHECK
,9ERR1    TYPE    ' PARTITION CONTROL ACTIVE' USER ATTEMPT TO RE-OPEN
*                                             PART CONTROL WITHOUT TERM-
*                                             INATING PREVIOUS COMMAND
*                                             SESSION.
,9ERR2    TYPE    'INPUT ''QUIT'',''PROCEED'',OR ''CONTROL COMMAND'''
         B        12EXIT3         >>EXIT 'PART'
*
10ENT2   EQU      %                 PASSED PEXEC/BREAK TEST
         LCI      1             <-  GET PART CONTROL FLAG
         STCF     PEXEC             SET PART CONTROL ACTIVE (PEXEC>0)
*********CK%CODE  CHECK TO ASCERTAIN PART PUSH STACK IS EMPTY ON ENTRY
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           PSW,R1   *SPDADR         SAVE R1 TEMPORARILY
           LI,R1    0               GET 0 IN MSP REG
           MSP,R1   SPD             IS PART REG STACK EMPTY?
           BSE      10CK2         ->  YES-2ND ENTRY CHECK PASSED
           PLW,R1   *SPDADR           NO-ASSEMBLY ERROR;RESET USER SPD
           TYPE     'PART.10.ENTRY.PART STACK NOT EMPTY' OUTPUT ERR MSG
           B        12EXIT2       >>WAIT FOR DELTA
10CK2      PLW,R1   *SPDADR     <-  STACK OK;PULL R1
         FIN
*********CK%CODE  END PART STACK CHECK
         LCI      0                 PREPARE TO PUSH ALL REGS
         PSM,R0   SPD               PUSH ALL GENERAL REGS
         LI,R1    X'7FFF'           MASK FOR DOVSTK WD CNT
         LS,R1    DOVSPD+1          GET STACK WD CNT
         LCW,R1   R1                MAKE IT NEGATIVE
         MSP,R1   DOVSPD            RESET THE DISP OVFLW PUSH STACK
         LW,R2    USRPRIV           CONTROL USER PRIV MUST BE >=X'80'
*********CK%CODE  IF PRIVILEGE LEVEL HAS NOT BEEN SET BY CONTROL===>ERROR
         DO       CK%CODE>=1        USRPRIV=0===>PRIV LEVEL NOT SET
           CI,R2    1               HAS PRIV LEV BEEN SET?
           BGE      10CK4         ->USRPRIV=1===>PRIV LEVEL>=X'80'
           TYPE    'PART.10.ENTRY.USRPRIV=0' 1==>80,2==>B0,3==>C0
           B        12EXIT2       >>ERROR RETURN TO CONTROL
10CK4      EQU      %
         FIN
*********CK%CODE  END
*********CK%CODE  ASCERTAIN THAT NO COMMON DYNAMIC PAGES HAVE BEEN
         DO       CK%CODE>=1        REQUESTED.
           MTW,0    PDSVP           HAVE P.D. STK PGS BEEN REQUESTED?
           BEZ      10CK5         ->  NO-GOOD;STK SET UP ONLY ON
*                                     X'C0' PRIV TEST IN 'SET'.
           TYPE     'PART.10.ENTRY.PART DEF STACK PAGES REQUESTED'
           B        12EXIT2       ->  YES-ERR MSGE
10CK5      EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         B        11MAIN1       <<>>GO TO MAIN SKELETON
*
         PAGE
*
**********************************************
*  11.   MAIN SKELETON AND COMMAND HANDLERS  *
**********************************************
*
*
*  DESCRIPTION:   'MAIN' INITIATES A CALL TO 'READSI' WHICH READS
*                 THE USER INPUT COMMAND AFTER ISSUING A PROMPT. IF
*        ONLY A DELIMITER IS ENTERED, ANOTHER COMMAND IS READ. IF THE
*        COMMAND CONSISTS OF SIGNIFICANT CHARACTERS, A CALL IS MADE
*        TO THE COMMAND SCAN ROUTINE WHICH DETERMINES IF THE CHARACTERS
*        INPUT FORM A LEGAL COMMAND. IF SO, A DIRECT BRANCH IS MADE
*        FROM THE SCAN ROUTINE TO THE APPROPRIATE HANDLER. IF NOT,
*        THE MESSAGE 'ILLEGAL COMMAND' IS OUTPUT AND RETURN IS EFFECTED
*        TO 'MAIN'.
*
*
*  FUNCTION:      TRACE SUB-CODE C'B' IS STORED IN THE IN-CORE
*                 HEADER. THE COMMAND BUFFER IS BLANKED ON EVERY NEW
*        COMMAND READ FROM THE USER.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY               INTERNAL            EXIT
*        -----               --------            ----
*        NO CALL REGS         R0-R2=WORK          SR1=LST CHAR INDX
*                            R7=BAL REG          SR2=CMD BUF ADR
*                            SR1=INDEX LAST      SR4=RETURN LINK
*                                INPUT CHAR      R0-R2,R7,SR1-SR4 VOL
*                            SR2=INPT BUF ADR    R3-R6,D1-D4 PRESRVED
*                            SR4='READSI' LINK
*
*
MAIN,11MAIN1 EQU  %                 E.P. TO MAIN CMD SKELETON & HANDLRS
         TRACE%   'B'           <<  'B' IS TRACE SUB-CODE FOR MAIN
11MAIN2  EQU      %             <-  GET A COMMAND
         LBAL%,SR4 NEWLN,1        >>SKIP A LINE FOR NEW CMD
11MAIN3  LW,R0    =C'    '    <-<<  GET WORD OF BLANKS
         LI,R2    CBUFWSZ           GET # WORDS IN CMD BUF
         STW,R0   CMDBUF-1,R2   <-  BLANK CMD BUF
         BDR,R2   %-1             ->
         LI,SR1   CBUFBSZ           BYTE LENGTH LONGEST INPT CMD
*                                   LONGEST=COMMENT (*)
         LI,SR2   CMDBUF            GET BUFFER ADDRESS
         LI,SR3   DELIMS            GET DELIM LIST ADR FOR PRESCAN
         BAL,SR4  READSI          >>GET INPUT LINE AND STRIP DELIMITERS
         CI,SR1   0             <<  (SR1)=INDEX TO LAST CHAR
         BL       11MAIN3         ->IF DELIMITER ONLY, RE-PROMPT
         PSW,SR1  *SPDADR           SAVE INDEX TO LAST CHAR
         M:DEVICE M:SI,(CORRES,M:LO) **CHECK SI/LO DEVICE CORRESPNDNC
         CI,SR1   1                 IS SI DEV=LO DEV?
         BE       11MAIN4         ->  YES-SKIP SI ECHO ON LO
         LW,SR4   R1                  NO-GET BUF INDEX
         AI,SR4   1                 CONVERT TO INPUT MSGE BYTE CNT
         LBAL%,R7 BOUTX,,1,BA(CMDBUF)   >>OUTPUT INPUT CMD ON LO
11MAIN4  PLW,SR1  *SPDADR     <-<<  RESTORE INDEX TO LAST CMD CHAR
         LI,SR2   CMDBUF            GET ADR OF CMD BUF
         BAL,SR4  15SCAN1         >>SCAN CMD (BRANCH TO HANDLER)
         TYPE     ERMS1         <<  'ILLEGAL COMMAND' FUTILE SEARCH
         B        11MAIN2         ->GET ANOTHER COMMAND
*
         PAGE
*
************************************************************
*  11.1  'ADD' - ADD & ORDER PARTITION DISPLAY ATTRIBUTES  *
************************************************************
*
*
*  DESCRIPTION:   THE 'ADD' COMMAND ALLOWS THE USER TO SPECIFY WHICH
*                 PARTITION ATTRIBUTES WILL BE DISPLAYED BY THE
*        'DISPLAY |N,ALL~' COMMAND AND IN WHAT ORDER THEY WILL BE
*        DISPLAYED. WHEN THE 'ADD' COMMAND IS ISSUED, IF NO ENTRIES
*        EXIST IN 'AORDER', THEN NO PARTITION ATTRIBUTES ARE FLAGGED
*        FOR PRINTING AND THE 'AORDER' TABLE IS GOING TO BE SET UP
*        FROM SCRATCH. A ZERO SHOULD BE IN ENTRY 1 (FIRST BYTE
*        OF THE TABLE) INDICATING NO ENTRIES BEYOND THIS POINT. AS
*        ATTRIBUTES ARE ENTERED UNDER THE 'ADD' COMMAND,
*        THEIR PRINT FLAGS ARE TURNED ON BY ENTERING THEIR ATERM2
*        INDEX IN THE TABLE. A PUSH-DOWN STACK APPROACH IS USED TO
*        TO BUILD THE LIST EVEN THOUGH THERE IS THE DIFFICULTY OF
*        PATCHING HOLES LEFT BY 'DROP'ING CERTAIN ATTRIBUTES. WHEN A
*        (CR) IS FINALLY ENTERED, A ZERO IS STORED IN THE LAST ENTRY
*        POSITION TO INDICATE NO MORE ATTRIBUTES ARE TO HAVE THEIR
*        FLAGS SET FOR DISPLAY. AS ATTRIBUTES ARE ADDED TO THE LIST
*        BY 'ADD', THEY WILL BE ORDERED SUBSEQUENTLY IN THE TABLE.
*        'DROP'S WILL BE HANDLED BY FINDING THE INDEX OF THE DROP
*        ITEM IN THE TABLE AND MOVING ALL FOLLOWING INDICES, INCLUD-
*        ING THE ZERO, DOWN ONE PLACE. THE ONLY WAY THE ORDER MAY
*        BE CHANGED, IS TO DROP ALL ATTRIBUTES AND START OVER 'ADD'-
*        ING A NEW LIST, EXCEPT FOR THE CASE WHEN AN ITEM HAS PRE-
*        VIOUSLY BEEN SPECIFIED AND ONE WISHES TO DELETE IT AND
*        TACK IT ONTO THE END OF THE LIST.
*
*        NOTE1: ALTHOUGH 'ADD' AND 'DROP' WERE NOT WRITTEN UP IN
*        THE B00 FUNCTIONAL SPEC, THEY WERE INSERTED BECAUSE OF THE
*        EASE OF IMPLEMENTATION DUE TO THE SIMILAR FUNCTION OF 'ADD'
*        AND 'DROP' IN CONMAIN AT THE COMMAND LEVEL.
*
*        NOTE2:   REGISTER USER IS AS FOLLOWS:
*
*        ENTRY              INTERNAL               EXIT
*        -----              --------               ----
*        D4=RTN LINK        R0-R2=WORK             R0-R2,R7,SR1-SR4
*        ----------------   R7=SUBR LINK           VOLATILE
* IF CALLED AS PART SUBR:   SR1-SR4=SUBR REGS      R3-R6,D1-D4 PRE-
*        D1=DISPL LIST ADR  D1=DISPLAY LIST ADR    SERVED
*        D2=STD DISP LIST   D2=STD DISPLAY LIST ADR
*           ADR             D3=ITEM LIST BOUNDS
*        D3=ITEM LIST BOUNDS
*
*
ADD,11ADD1 EQU    %                 E.P. TO ADD & ORDER PARTITION
*                                   ATTRIBUTE DISPLAYS.
         CK%TRACE 'C'               TRACE SUBCODE FOR 'ADD' CMD
         LI,R2    1                 FLAG FOR 'ADD'
         STW,R2   PARTMAIN          FOR ENTRY INTO 'ADD1'/PART
         LI,D1    AORDER            GET ATARTING ADR OF ATRBTE DISP
*                                   TABLE.
         LI,D2    AOSTD             GET BASE ADR OF STANDARD DISPLAY
*                                   INDEX LIST
         LW,D3    AT2DATA           GET PART ATRBTE TBL INFO FOR
*                                   'ITEMFIND'.
         BAL,D4   ADD1            >>DO ADD WORK IN MAIN ROUTINE
         LC       J:JIT             IF ONLINE, OUTPUT MIGHT NOT FIT
         BCR,8    11MAIN1
         LI,R2    -1                INDEX FOR AORDER
         LW,D3    OBUFSZ            MAX LINE SIZE
         LB,D2    AFWIDTH           SIZE OF 'PART' PART
         SW,D3    D2
11ADD2   EQU      %
         AI,R2    1                 TO NEXT ITEM
         LB,R1    AORDER,R2         WHATSIT
         BEZ      11MAIN1           NO MORE, THEY ALL FIT
         LB,D2    AFWIDTH,R1        SIZE OF THIS ONE
         SW,D3    D2
         BDR,D3   11ADD2            IF BDR BRANCHES IT FITS
         LI,D3    0
         STB,D3   AORDER,R2         TERMINATE THE LIST
         TYPE     'OUTPUT LINE OVERFLOW - LIST TRUNCATED'
         B        11MAIN1       <<>>RETURN
*
         PAGE
*
**********************************************
*  11.2  'LIST' - LIST CURRENT DISPLAY LIST  *
**********************************************
*
*
*  DESCRIPTION:  'LIST' EXAMINES THE DISPLAY LIST 'AORDER' FOR ITEM
*                INDICES. IT OUTPUTS THE NAME OF EACH ITEM IN THE LIST
*
*
*
*
*        NOTE: ALL REGISTERS ARE PROBABLY DESTROYED
*
*
LIST,11LST1 EQU   %
         LI,R3    -1                INITIALIZE AORDER INDEX
11LST2   EQU      %
         AI,R3    1                 INCREMENT INDEX
         LB,R4    AORDER,R3         HAS TBL END BEEN REACHED
         BEZ      11MAIN1           YES, RETURN TO MAIN ROUTINE
         LBAL%,SR4 SPACE,1          PUT A BLANK IN OUTPUT BUFFER
         ANLZ,SR3 11LST3            GET DA(ITEMNAME)
         SLS,SR3  3                 CONVERT TO BYTE ADDRESS
         LBAL%,R7 BOUTX,,1,,8       AND PRINT IT
         B        11LST2            GET NEXT ITEM
*
11LST3   LD,0     ATERM2,R4         DATA FOR ANLZ INSTRUCTION
*
         PAGE
*
****************************************************************
*  11.3  'BUILD' - SELECT AN ORDERED PARTITION DISPLAY FORMAT  *
****************************************************************
*
*        NOT IMPLEMENTED THIS VERSION
*
BUILD,11BLD1 EQU  %                 E.P. TO SELECT OR BUILD A STANDARD
*                                   PARTITION DISPLAY.
         B        11MAIN1         >>RETURN
*
         PAGE
*
*************************************************************
*  11.4  'CLEAR' - CLEAR PARTITION DEFINITION BUFFER STACK  *
*************************************************************
*
*
*  DESCRIPTION:   'CLEAR' NULLIFIES THE INFORMATION WHICH HAS BEEN
*                 STORED IN THE PARTITION DEFINITION STACK THROUGH
*        A SERIES OF 'SET' COMMANDS BY RELEASING THE COMMON
*        PAGES ALLOCATED FOR THE STACK AND RESETTING THE STACK POINTER
*        DOUBLEWORD AND BOTTOM WORD OF STACK ADDRESS (PDSVP). IF THE
*        USER HAS NOT SUFFICIENT PRIVILEGE TO BUILD A STACK (X'C0')
*        OR HAS NOT USED THE SET COMMAND, THE 'M:FCP' CAL DOES
*        NO HARM. 'CLEAR' USES SUBROUTINE 'ZEROUT' TO DO ALL ITS WORK.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY            INTERNAL           EXIT
*        -----            --------           ----
*        NO SIGNIFICANT   R0=WORK            R0,SR4 VOLATILE
*        DATA IN REGS     SR4=SUBR LINK      R1-R7,SR1-SR3,D1-D4
*                                            PRESERVED
*
*
CLEAR,11CLR1 EQU  %                 E.P. TO CLEAR INFORMATION ENTERED
*                                   INTO PART BUFFER STACK BY SET CMDS.
         BAL,SR4  ZEROUT        <<>>RELEASE PART DEF STK PGS
         B        11MAIN1       <<>>RETURN
*
         PAGE
*
*******************************************
*  11.5  'COMMENT' - IGNORE COMMENT LINE  *
*******************************************
*
*
COMMENT,11COM1 EQU %                E.P. TO IGNORE COMMENT LINE
*                                   COMMENT ALREADY ECHOED ON M:DO BY
*                                   'READSI'.
         B        11MAIN1       <<>>SIMPLE, HUH?
*
         PAGE
*
************************************************************
*  11.6  'DISPLAY' - DISPLAY PARTITION N (ALL) ATTRIBUTES  *
************************************************************
*
*
*  DESCRIPTION:   'DISPLAY' ACCEPTS AS INPUT THE BUFFERED FIELDS OF THE
*                 USER INPUT COMMAND, DETERMINES WHICH PARTITION(S)
*        WILL BE DISPLAYED, OUTPUTS A HEADING CORRESPONDING TO THE
*        CURRENT DISPLAY LIST AND OUTPUTS THE APPROPRIATE PARTITION
*        ATTRIBUTES FOR THE SPECIFIED PARTITION(S). 'DISPLAY' IS BUILT
*        UPON SEVERAL SUBROUTINES WHICH PERFORM EBCDIC TO BINARY
*        CONVERSION, ACCESS THE PARTITION TABLES AND FORM THE DISPLAY
*        FOR EACH ATTRIBUTE; THEREFORE, THE ACTUAL CODING CONSISTS
*        MOSTLY OF SETTING UP CALLS TO THESE ROUTINES.
*
*
*  FUNCTION:      COMMAND FIELD 2 IS EXAMINED TO DETERMINE IF A PART-
*                 ITION NUMBER, A RANGE, OR 'ALL' WAS SPECIFIED.
*        SUBROUTINE 'P#CK' I IN THE 'SET' COMMAND HANDLER PER-
*        FORMS THIS FUNCTION RETURNING THE BEGINNING AND ENDING
*        PARTITION NUMBER IN THE RANGE. IF THE PARTITION NUMBER
*        SPECIFICATION IS ILLEGAL, 'P#CK' CALLS A SUBROUTINE TO
*        PRINT AN APPROPRIATE ERROR MESSAGE AND RETURNS TO 11MAIN1.
*
*                 IF A LEGAL PARTITION NUMBER IS DETECTED, AN
*        APPROPRIATE HEADING IS OUTPUT THROUGH M:LO AND 'DISPX' IS
*        CALLED TO DISPLAY ALL THE ATTRIBUTES IN THE CURRENT DISPLAY
*        LIST (TABLE 'AORDER').
*
*                 IF 'ALL' HAS BEEN SPECIFIED, A PARTITION NUMBER
*        COUNTER IS INITIALIZED TO 1 AND SUCCESSIVE CALLS ARE MADE TO
*        'DISPX' AS THE COUNTER IS INCREMENTED.
*
*                 WHEN THE PARTITION(S) HAS BEEN DISPLAYED, A CHECK
*        IS MADE TO DETERMINE IF THE NUMERIC DISPLAY WAS TOO WIDE FOR
*        ANY ATTRIBUTE DISPLAY FIELD. IF SO, THE PARTITION NUMBER/
*        ATTRIBUTE INDEX PAIRS ARE PULLED OUT OF THE USER STACK (WHERE
*        THEY WERE PUSHED BY 'DISPX') ONE BY ONE AND DISPLAYED AS INDI-
*        VIDUAL ATTRIBUTES.
*
*
*        NOTE1:   SUBROUTINES CALLED ARE: DECIN, HEAD, DISPX, DISPA
*
*        NOTE2:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY              INTERNAL            EXIT
*        -----              --------            ----
*        NO INPUTS          R0-R3=WORK          D1 PRESERVED
*                           R4-R6=WORK          R0-R7,SR1-SR4,D2-D4
*                           R7=BAL REG          VOLATILE
*                           SR1-SR3=SUBR REGS
*                           SR4=BAL REG
*                           D2=PART #
*                          D3=OVERFLOW CNT
*                          D4=RTN LINK (MAIN SUBS)
*
*
DISPLAY,11DISP1 EQU %               E.P. 'DISPLAY N'/'DISPLAY ALL' CMDS
         BAL,R7   OCTOLP            PUT BIG STUFF ON LP IF GHOST
         CK%TRACE 'G'               TRACE-CODE ENTRY FOR DISPLAY
         LBAL%,R7 P#CK,CFPTRS+2   >>GET PART #'S FOR DISPLAY
         STW,SR2  D2            <<  STORE P#RANGE;HW0 D2=UPPER P#;
*                                   HW1 D2=LOWER P#.
         B        11DISP5         ->OUTPUT PART ATRBTES
*
11DISP3  EQU      %                 PARTITION(S) ATTRIBUTES DISPLAYED;
*                                   TEST FOR OVERFLOW.
         CI,D3    0           <-<<  IS NUMERIC DISP OVFLW FLG SET?
         BLEZ     11DISP4         ->  NO-RETURN
         BAL,SR4  11DSP10         >>  YES-DISPLAY OVFLW ATRBTES
11DISP4  EQU      %                 ALL OVFLW ATRBTES DISPLAYED
         BAL,R7   LPTOOC            NOW BACK TO OC
         B        11MAIN1     <-<<>>RETURN FOR NEW COMMAND
*
*                 DISPLAY 'N', 'N-N', OR 'ALL' PARTITIONS
*
11DISP5  EQU      %             <-  DISPLAY ALL ATRBTES, ALL PARTS
         BAL,D4   14HE1           >>OUTPUT PART DISPLAY HEADING
         LI,D3    0             <<  INITIALIZE NUMERIC OVFLW CNTR
11DISP6  LW,SR1   D2            <-  GET CURRENT PART #
         AND,SR1  =X'FFFF'          MASK PART LOWER LIMIT
         CH,SR1   D2                IS CURR P#<=MAX P#?
         BG       11DISP3         ->  YES-TEST OVFLW FLAG
         BAL,D4   14DX1           >>  NO-DISPLAY PART N
         AW,D3    SR3           <<  ACCUMULATE OVFLW COUNT
         AI,D2    1                 INCREMENT PART #
         B        11DISP6         ->DISPLAY NEXT PART
*
*                 DISPLAY ALL NUMERIC OVERFLOWS AS SINGLE ATTRIBUTES
*
11DSP10  EQU      %                 E.P. DISPLAY PRINT OVERFLOW
*                                   ATTRIBUTES SINGLY.
         PSW,SR4  SPD           <<  SAVE RETURN LINK
         LI,SR1   1                 GET # OF LINES TO BE SPACED
         BAL,SR4  NEWLN           >>OUTPUT 1 SPACE
,9WAR3   TYPE     ' *** ==> NUMBERIC DISPLAY OVERFLOW' <<OUTPUT MSGE
11DSP11  PLW,SR2  DOVSPD        <-  GET OVFLW PART # & ATRBTE INDEX
         LH,SR1   SR2               GET PART #
         AND,SR2  =X'FFFF'          MASK ATTRIBUTE INDEX
         BAL,D4   14DA1           >>DISPLAY SINGLE PART ATRBTE
         BDR,D3   11DSP11       <<->DISPLAY SINGLY NXT ATRBTE OVFLW
*********CK%CODE  MAKE SURE STACK IS EMPTY
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           LW,R1    DOVSPD+1        GET WORD COUNT
           AND,R1   ='7FFF'         IS IT 0?
           BEZ      11CK60        ->  YES-CONTINUE
           TYPE     'PART.11.6.DISP.STACK NOT EMPTY'  ERR MESGE
           B        12EXIT2       >>WAIT FOR DELTA
11CK60     EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         PLW,SR4  SPD               PULL RETURN ADDRESS
         B        *SR4            >>RETURN
*
         PAGE
*
******************************************************************
*  11.7  'DROP' - DELETE ATTRIBUTES FROM PARTITION DISPLAY LIST  *
******************************************************************
*
*
*  DESCRIPTION:   THE 'DROP' COMMAND ALLOWS THE USER TO DELETE
*                 PARTITION ATTRIBUTES FROM THE DISPLAY LIST. FOR
*        DETAILS CONCERNING THE FUNCTION OF 'DROP', SEE 11.1 'ADD'
*        (MODULE PART), 18.1 'AORDER' (MODULE PART), AND 21.
*        'ADD' (MODULE CONMAIN).
*
*
*        ENTRY              INTERNAL               EXIT
*        -----              --------               ----
*        D4=RTN LINK        R0-R2=WORK             R0-R2,R7,SR1-SR4
*        ----------------   R7=SUBR LINK           VOLATILE
* IF CALLED AS PART SUBR:   SR1-SR4=SUBR REGS      R3-R6,D1-D4 PRE-
*        D1=DISPL LIST ADR  D1=DISPLAY LIST ADR    SERVED
*        D2=STD DISP LIST   D2=STD DISPLAY LIST ADR
*           ADR             D3=ITEM LIST BOUNDS
*        D3=ITEM LIST BOUNDS
*
*
DROP,11DROP EQU   %                 E.P. TO DROP PART ATTRIBUTES FROM
*                                   THE DISPLAY LIST.
         CK%TRACE 'H'               TRACE SUB-CODE FOR 'DROP' CMD
         LI,R2    1
         STW,R2   PARTMAIN          FOR ENTRY INTO 'ADD1'/PART
         LI,R2    0                 FLAG FOR 'DROP'
         LI,D1    AORDER            GET STARTING ADR OF ATRBTE DISP-
*                                   LAY TABLE 'AORDER'.
         LI,D2    AOSTD             GET BASE ADR OF STD DSPL ENTRY
*                                   LIST
         LW,D3    AT2DATA           GET PART ATRBTE TBL INFO FOR
*                                   'ITEMFIND' - TABLE BOUNDS.
         BAL,D4   ADD1            >>DO DROP WORK IN MAIN ROUTINE
         B        11MAIN1       <<>>RETURN
*
         PAGE
*
*********************************************************
*  11.8  'ATRN' - DISPLAY AN ATTRIBUTE FOR PARTITION N  *
*********************************************************
*
*
*  DESCRIPTION:   'ATRN' ACCEPTS AS INPUT THE BUFFERED FIELDS OF THE
*                 USER INPUT COMMAND, DETERMINES WHICH PARTITIONS
*        WERE SPECIFIED AND WHICH ATTRIBUTE IS TO BE DISPLAYED, AND
*        OUTPUTS THE APPROPRIATE PARTITION ATTRIBUTE FOR THE
*        INDICATED PARTITION(S). 'ATRN' IS BUILT UPON STANDARD
*        'CONTROL' SUBROUTINES WHICH PERFORM EBCDIC TO BINARY CONVER-
*        SION, ACCESS THE PARTITION TABLES AND FORM THE DISPLAY FOR
*        EACH ATTRIBUTE, ETC.; THEREFORE, THE ACTUAL CODING CONSISTS
*        MOSTLY OF SETTING UP CALLS TO THESE ROUTINES.
*
*
*        NOTE1:   SUBROUTINES USED (MODULE): 'P#CK' ('PART'),
*                 'ITEMFIND' ('CONSUB'), '14DA1' ('PART'),
*                 '15ERR3' ('PART')
*
*
*        NOTE2:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY              INTERNAL               EXIT
*        -----              --------               ----
*        D4=RTN LINK        SR1=PART #             R0,SR1-SR4,D2,D4
*                           SR2=ATR INDX           VOLATILE
*                           SR4=BAL REG            R1-R7,D1,D3
*                           D2=P# RANGE;HW0=UPPER  PRESERVED
*                              P#;HW1=LOWER P#
*                           D4=RTN LINK
*
*
ATRN,11ATRN1 EQU  %                 E.P. TO DISPLAY AN ATTRIBUTE FOR
*                                   PARTITION N.
         TRACE%   'I'           <<  SET TRACE-CODE FOR 'ATRN'
         LBAL%,R7  P#CK,CFPTRS+1  >>GET PART #'S
         STW,SR2  D2            <<  SAVE PART# RANGE;HW0 D2=UPPER
*                                   P#;HW1 D2=LOWER P#.
         LBAL%,SR4 ITEMFIND,(W,AT2DATA),(W,CFPTRS+2) >>IS ATRBTE IN 'ATERM2'?
         B        15ERR3        <<>>  NO-OUTPUT 'NO SUCH ATTRIBUTE'
         STW,SR3  SR2           <<    YES-SAVE ATRBTE INDEX
11ATRN3  EQU      %                 DISPLAY ATRBTE VALS FOR PART RANGE
         LI,SR1   X'FFFF'       <-  GET CURRENT PART #
         AND,SR1  D2
         CH,SR1   D2                IS CURR P#<=MAX P#?
         BG       11ATRN99        ->  YES-ALL DONE
         BAL,D4   14DA1           >>  NO-DISPLAY ATRBTE VAL, THIS P#
         AI,D2    1             <<  INCREMENT CURR PART #
         B        11ATRN3         ->DISPLAY NEXT PART ATRBTE
11ATRN99 EQU      %             <-  EXIT POINT
         B        11MAIN1         >>RETURN
*
         PAGE
*
*****************************************************************
*  11.9  'SET' - ASSIGN TENTATIVE VALUE TO PARTITION ATTRIBUTE  *
*****************************************************************
*
*
*  DESCRIPTION:   'SET' IS THE COUNTERPART CMD HANDLER TO 'STORE' AND
*                 SETS UP THE PARTITION DEFINITION STACK WITH THE USER-
*        SPECIFIED ATTRIBUTE VALUES IN IT SO THAT AT A LATER TIME THE
*        STACK MAY BE EMPTIED INTO THE MONITOR PARTITION TABLES BY
*        EXECUTION OF THE 'STORE' COMMAND. THE USER HAS ESSENTIALLY
*        3 ALTERNATIVES IN THE PARTITION DEFINITION SPECIFICATION:
*
*        1.       A SINGLE PARTITION NUMBER MAY BE GIVEN WITH AN
*                 ATTRIBUTE AND ASSOCIATED VALUE(S)==>N ATTRIBUTE=VAL
*        2.       SAME AS 1 EXCEPT THAT A RANGE OF PARTITIONS MAY BE
*                 SPECIFIED==>N-N ATTRIBUTE=VAL
*        3.       SAME AS 1 EXCEPT THAT 'ALL' MAY BE SPECIFIED==>
*
*                 ALL ATTRIBUTE=VAL
*        FOR THE MULTIPLE PARTITION SPECIFICATIONS, THE APPROPRIATE
*        ATTRIBUTE VALUE WILL BE PUSHED INTO THE STACK FOR ALL PART-
*        ITIONS SPECIFIED.
*
*                 IT IS NECESSARY TO BUILD A STACK WITH THESE VALUES
*        BECAUSE THEY CANNOT BE STORED IMMEDIATELY WHEN INPUT. THIS
*        WOULD CAUSE THE PARTITION TABLES TO BE LOCKED A GREAT DEAL
*        OF THE TIME AND CONSTANT RESCHEDULING OF JOBS FOR EXECUTION
*        UNDER NEW DEFINITIONS.
*
*
*  FUNCTION:      IN ORDER FOR THE 'SET' COMMAND TO FUNCTION, A SERIES
*                 OF CHECKS MUST BE PASSED:
*
*        1.   USER MUST HAVE PRIVILEGE X'C0' OR GREATER.
*        2.   ATTRIBUTE SPECIFIED MUST BE CONTAINED IN TBL 'ATERM2'.
*        3.   ATTRIBUTE CANNOT BE A DISPLAY ONLY TYPE.
*        4.   PARTITION NUMBER(S) MUST BE VALID SPECIFICATIONS.
*        5.   IF A PARTITION RANGE, THE LOWER PARTITION NUMBER MUST BE
*             LESS THAN OR EQUAL TO THE UPPER PARTITION NUMBER.
*        6.   THE ATTRIBUTE VALUE MUST MATCH THE ATTRIBUTE TYPE.
*        7.   IF A RANGE, THE MAXIMUM MUST BE GREATER THAN OR EQUAL
*             TO THE MINIMU.
*        8.   THE ATTRIBUTE VALUE(S) MUST LIE WITHIN LEGAL RANGE.
*
*                 IF VIRTUAL PAGES NECESSARY TO BUILD THE PART DEF
*        STACK HAVE NOT BEEN OBTAINED, OR PREVIOUSLY RELEASED, A
*        MONITOR CALL IS ISSUED TO GET THEM. FOR EACH SINGLE-VALUED
*        ATTRIBUTE (EXCEPT FOR DW ATTRIBUTES), TWO WORDS ARE PUSHED
*        INTO THE STACK; FIRST THE VALUE, AND THEN A PARAMETER PRESENCE
*        WORD (SEE 'SAP' - SECTION 15.4). FOR DOUBLEWORD ATTRIBUTES,
*        OR THOSE WITH RANGES, 3 WORDS ARE PUSHED SEQUENTIALLY INTO
*        THE STACK; VIZ., LOWER VALUE, UPPER VALUE, AND PARAMETER
*        PRESENCE WORD.
*
*
*  SUBROUTINES CALLED: APEND, COUT, DECOUT, 15ERR1, 15ERR2, 15ERR3,
*                      15ERR4, SAP, TAT#, IDENT#
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY            INTERNAL           EXIT
*        -----            --------           ----
*        D1=BA('=')       R0-R2=WORK         R0-R7,SR1-SR4,D1-D3
*                         R3-R7=TAT# CALL    VOLATILE
*                               REGS         D4 PRESERVED
*                         SR1-SR4=SUBR PARAMS
*                         D1=BA('=')
*                         D2=ATRBTE INDEX
*                         D3=PART# LIMS (MAX/MIN)
*
*
SET,11SET1 EQU    %                 E.P. TO SET VALUE OF AN ATTRIBUTE
*                                   FOR PARTITION N.
*                                   BA('=') IN CMD FLD IN D1
         CK%TRACE 'J'           <<  TRACE CODE FOR 'SET'
         LW,R0    USRPRIV           GET USER PRIVILEGE LEVEL
         CI,R0    3                 IS PRIV LEV>=X'C0'?
         BL       15ERR2          >>  NO-OUTPUT ERR MSGE & PROMPT
         LI,SR2   X'7FFFF'            YES-GET 19-BIT BA MASK
         LS,SR2   CFPTRS+2          GET BA(ATTRIBUTE ITEM NAME)
         LW,R1    D1                GET BA('=')
         SW,R1    SR2               CALCULATE ITEM NAME BYT CNT
         STB,R1   SR2               STORE BYT CNT WITH BA(ITEM NAME)
         LBAL%,SR4 ITEMFIND,(W,AT2DATA)  >>IS ATRBTE IN TBL ATERM2?
         B        15ERR3        <<>>  NO-OUTPUT 'NO SUCH ATTRIBUTE'
         STW,SR3  D2            <<    YES-SAVE ATRBTE INDX IN D2
         LW,R1    D2                GET ATRBTE INDX INTO ATERM2
         LH,R2    AVMIN,R1          GET MIN VAL FOR THIS ATRBTE
         CI,R2    -2                IS ATRBTE 'DISPLAY ONLY'?
         BE       11SET90         ->  YES-OUTPUT WARNING MESSAGE
*                                     NO-CHECKS PASSED:PRIV,VALID
*                                     ATRBTE, DISPLAY.
         LI,SR1   CFPTRS+1          GET P# FLD ADR
         BAL,R7   11P#CK1         >>TEST P# FLD FOR 'ALL','N','N-N'
*                                   AND TRANSLATE FROM EBCDIC.
*                                   IF RETURN,PART #S PASSED LIMIT
         STW,SR2  D3            <<  CHECKS;HW0 D3=LOWER#;HW1 D3=UPPER#.
         LB,R6    ACLASS,R1         GET CLASS OF ARGUMENT THROUGH
*                                   ATRBTE INDEX.
         LB,R3    CFPTRS+2          GET BYT CNT OF INPUT CMD
         LI,R5    X'7FFFF'          GET 19-BIT BA MASK
         LS,R5    CFPTRS+2          GET BA(1ST CMD BYT)
         AI,D1    1                 INCREMENT TO BA(ARGUMENT)
         LW,R2    D1                GET BA(1ST ARG BYTE)
         SW,D1    R5                CALC BYTS FROM ATRBTE THROUGH '='
         SW,R3    D1                CALC # BYTS IN AF
         BAL,R7   TAT#            >>TEST AND TRANSLATE AF
         B        11SET91       <<>>AF ERROR. OUTPUT MSGE.
         CI,R6    2             <<  AF OK. IS AF A RANGE?
         BNE      11SET2          ->  NO-CONTINUE
         CW,R5    R4                  YES-IS MAX>=MIN?
         BGE      11SET2              YES-CONTINUE
         TYPE     9ERR4               NO-OUTPUT 'INVALID ATRBTE VAL(S)'
         B        15ERR4          >>OUTPUT 'MIN VAL>MAX VAL'
11SET2   EQU      %                 ARGUMENT TYPE O.K.;CHECK LEGAL
*                                   RANGE.
         LH,R2    AVMIN,R1          GET MIN LIMIT IN REG
         LH,R3    AVMAX,R1          GET MAX LIMIT IN REG
         CLR,R2   R4                DOES LOWER VAL (OR SINGLE VAL)
*                                   LIE WITHIN LIMITS?
         BCS,6    11SET92         ->  NO-OUTPUT 'NUMBER(S) NOT
*                                     WITHIN LEGAL RANGE'
         CI,R6    2                   YES-IS AF A RANGE?
         BNE      11SET3          ->  NO-SKIP TEST
         CW,R5    R3                  YES-IS MAX VAL>MAX LIM
         BG       11SET92         ->  YES-OUTPUT ERR MSGE
11SET3   EQU      %                   NO-AF LIMIT CHECK PASSED;
*                                     TEST FOR STK PAGE PRESENCE.
         MTW,0    PDSVP         <-  ARE P.D. STK VIR PGS PRESENT?
         BLEZ     11SET80         ->  NO-REQUEST X COMMON
*                                     DYNAMIC PAGES.
11SET4   STW,D2   SR1           <-    YES-STORE ATRBTE INDX IN
*                                     CALL REGISTER.
         LW,SR2   R4                GET MIN ATRBTE VALUE
         LW,SR3   R5                GET MAX ATRBTE VALUE
11SET5   EQU      %                 PART ATRBTE VAL STORE LOOP
         STH,D3   SR1           <-  STORE LOWER PART# IN CALL REG
         BAL,SR4  SAP             >>STORE VALUES IN P.D. STK
         AI,D3    1             <<  INCREMENT LOWER PART#
         INT,R3   D3                GET LOWER P# IN WORK REG
         CH,R3    D3                IS MIN P#<=MAX P#?
         BLE      11SET5          ->  YES-STORE ATRBTE VALS FOR
*                                     NEW PART DEFINITION.
         B        11SET99         ->  NO-QUIT & RETURN
         PAGE
*
***
* *11.9.1 END OF MAIN ROUTINE - SUBROUTINES FOLLOW
***
*
11SET80  EQU      %                 GET COMMON DYNAMIC PAGES FOR
*                                   PARTITION DEFINITION STACK.
         M:GCP    (PDSZ+511)/512 <- CALC # PGS NECESSARY FOR STK;
*                                   WAS THERE A CAL ERROR?
         BCR,8    11SET81         ->  NO-CONTINUE
         TYPE     ' CONTROL SPACE OVERFLOW'  YES-OUTPUT ERR MSGE
         TYPE     ' PARTITION REDEFINITION IMPOSSIBLE'
*********CK%CODE  GO WAIT FOR DELTA
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           B        12EXIT2       ->EXAMINE PROBLEM
         FIN
*********CK%CODE END
         B        11SET99         ->GO TO COMMON EXIT PT
11SET81  EQU      %                 COMMON PGS GOTTEN;SET UP SPD
         STW,SR1  PDSVP             SAVE # VIR PGS GOTTEN
         STW,SR2  PDSADR            SAVE WD ADR OF LOWEST PG
         AI,SR2   -1                CALC ADR OF WD BELOW 1ST WD OF STK
         STW,SR2  PDSPD             STORE PTR TO STK
         B        11SET4          ->CONTINUE
         PAGE
*
***
* *11.9.2 TEST AND TRANSLATE PARTITION # FIELD
***
*
*
*        NOTE2:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY              INTERNAL           EXIT
*        -----              --------           ----
*        R7=RTN LINK        SR1=P#FLD ADR      HW0 SR2=LOWER P#;
*        SR1=P# FLD ADR     SR2=LOWER P#       HW1 SR2=UPPER P#
*                           SR3=UPPER P#       SR1,SR3-SR4 VOLATILE
*                           SR4=BAL REG        R0-R7,D1-D4 PRESERVED
*
*
P#CK,11P#CK1 EQU  %                 TEST PART# FLD FOR 'ALL','N',
*                                   OR 'N-N' AND TRANS FROM EBCDIC.
         LBAL%,SR4 IDENT#,,(W,=X'03010203'),15ERR1 <<>>
         CI,SR1   3             <<  WAS PART# SPEC ALPHABETIC?
         BNE      11P#CK2         ->  NO-CHECK OTHER POSSIBILITIES
         CW,SR2   =C'ALL '            YES-WAS IT 'ALL'?
         BNE      15ERR1          >>  NO-OUTPUT 'NO SUCH PARTITION'
         LW,SR2   PH#LIM              YES-GET 1ST AND LAST PART #S
         B        11P#CK4         ->COMMON EXIT
11P#CK2  EQU      %                 PART SPEC WAS RANGE OR DEC #
         CLM,SR2  PART#LIM      <-  IS FIRST PART# VALID?
         BCS,9    15ERR1          ->  NO-OUTPUT 'NO SUCH PART'
         CI,SR1   2                   YES-WAS PART RANGE SPECIFIED?
         BE       11P#CK3         ->  YES-TEST UPPER PART #
*********CK%CODE THE CLASS BETTER HAVE BEEN 1
         DO       CK%CODE>=1
           CI,SR1   1               WAS ARG CLASS 1?
           BE       11CK90        ->  YES-CHECK PASSED
           TYPE     'PART.11.9.P#CK.ERRONEOUS CLASS RETURNED'
           B        12EXIT2       ->  NO-OUTPUT ERR MSGE & DELTA
11CK90     EQU      %           <-
         FIN
*********CK%CODE  END
*                                     NO-LOWER PART # IN HW1 SR2
         STH,SR2  SR2               STORE UPPER PART# (IDENTICAL)
         B        11P#CK4         ->COMMON EXIT
11P#CK3  EQU      %                 PARTITION RANGE SPECIFIED
         CLM,SR3  PART#LIM      <-  IS 2ND PART#VALID?
         BCS,9    15ERR1          ->  NO-OUTPUT 'NO SUCH PART'
         CW,SR3   SR2                 YES-IS MAX#>=MIN#?
         BL       11P#CK5         ->  NO-OUTPUT 'INVALID PART SPEC'
*                                     YES-MIN PART# IN HW1 SR2
         STH,SR3  SR2               STORE MAX PART#
11P#CK4  B        *R7             >>RETURN TO CALLING ROUTINE
*
11P#CK5  EQU      %                 OUTPUT ERROR MSGE
         TYPE     ' INVALID PARTITION SPECIFICATION'  <-
         B        15ERR4          ->OUTPUT 'MIN VAL>MAX VAL'
*
         PAGE
*
***
* *11.9.3 EXITS FROM 'SET'
***
*
11SET90  EQU      %                 OUTPUT ERROR MSGE
         TYPE     ERMS4         <-  ''CURRENT' VALS MAY NOT
*                                   BE ALTERED'.
         B        11SET99         ->COMMON EXIT PT
*
11SET91  EQU      %                 OUTPUT ERROR MSGE
,9ERR4   TYPE     ' INVALID ATTRIBUTE VALUE(S)'  <-
         B        11SET99         ->COMMON EXIT PT
*
11SET92  EQU      %                 E.P. TO OUTPUT AF RANGE ERROR
         TYPE     ' ATTRIBUTE VALUE(S) NOT WITHIN LEGAL RANGE' <-
         LW,R3    D2                GET ATRBTE INDX IN NON-VOL REG
         LBAL%,R7 APEND,,,C27     >>APPEND 'PERMISSIBLE RANGE='
         LBAL%,SR4 DECOUT,(H,AVMIN,R3) <<>>CONVERT MIN LIM TO DEC
         LBAL%,R7 APEND         <<>>APPEND LOWER LIM TO OUT BUF
         LBAL%,R7 APEND,,,C28       APPEND '-'
         LBAL%,SR4 DECOUT,(H,AVMAX,R3) <<>>CONVERT MAX LIM TO EBCDIC
         LBAL%,R7 BOUT          <<>>APPEND MAX# AND OUTPUT SMGE
         B        11SET99       <<->COMMON EXIT PT
*
11SET99  EQU      %                 COMMON EXIT POINT FOR 'SET'
         B        11MAIN1         >>RETURN
*
         PAGE
*
******************************************************************
*  11.10 'STORE' - STORE PARTITION ATTRIBUTES IN MONITOR TABLES  *
******************************************************************
*
*
*  DESCRIPTION:   'STORE' ACCEPTS A GROUP OF VALID PARTITION ATTRIBUTE
*                 DEFINITIONS WHICH HAVE BEEN INPUT BY THE 'CONTROL'
*        USER AND STORES THEM INTO THE APPROPRIATE SYSTEM PARTITION
*        DEFINING TABLES. THE USER-SUPPLIED DEFINITIONS HAVE BEEN INPUT
*        THROUGH A SERIES OF ATTRIBUTE 'SET' COMMANDS (SEE SECTION
*        11.9) AND, AFTER VALIDITY CHECKS, HAVE BEEN PUSHED INTO THE
*        PARTITION DEFINITION STACK. 'STORE' PULLS THESE DEFINITIONS
*        FROM THE STACK ONE-AT-A-TIME AND STORES THE DATA IN THE
*        SYSTEM TABLES. THE PARTITION TABLES ARE NOT UPDATED EACH TIME
*        AN ATTRIBUTE 'SET' COMMAND IS EXECUTED BECAUSE: 1) IF A USER
*        HAD SEVERAL VALUES TO CHANGE FOR A GIVEN PARTITION, SUBSEQUENT
*        TO EACH ATTRIBUTE REDEFINITION, THE PARTITION TABLES WOULD BE
*        LEFT IN A PARTIALLY UPDATED STATE FOR AT LEAST SEVERAL SECONDS
*        UNTIL ALL UPDATES COULD BE ENTERED BY THE USER, THUS ALLOWING
*        THE MULTI-BATCH SCHEDULER (MBS) TO RESCHEDULE JOBS FOR THAT
*        PARTITION ON THE BASIS OF INCOMPLETE DATA; 2) AFTER EACH
*        CHANGE, THE MBS IS FORCED TO RESCHEDULE ALL JOBS WHICH WERE
*        SLATED TO RUN UNDER THAT PARTITION AS WELL AS WELL AS THE
*        JOBS IN THE 'CAN'T RUN' QUEUE.
*
*                 THE PARTITION DEFINITION STACK PAGES ARE DYNAMICALLY
*        ALLOCATED TO 'CONTROL' ON THE FIRST ENTRY TO THE ATTRIBUTE
*        'SET' COMMAND HANDLER IF THE USER HAS SUFFICIENT PRIVILEGE).
*        FOLLOWING SUCCESSFUL EXECUTION OF A 'STORE', 'CLEAR', 'QUIT',
*        OR'END' COMMAND, THE COMMON DYNAMIC STACK PAGES ARE RELEASED.
*
*                 THE 3 CONDITIONS NECESSARY FOR THE 'STORE' COMMAND TO
*        BE EXECUTED ARE:
*        1.   THE USER MUST HAVE PRIVILEGE X'C0' OR GREATER.
*        2.   THE PARTITION DEFINITION STACK MUST HAVE AT LEAST 1 ENTRY.
*        3.   THE PARTITION TABLES MUST NOT BE LOCKED. THE ATBLES
*             ARE LOCKED WHEN BEING UPDATED BY ANY PROGRAM, E.G.
*             ANOTHER COPY OF 'CONTROL'. IF THE TABLES ARE LOCKED, A
*             MESSAGE IS OUTPUT INFORMING THE USER OF THIS CONDITION
*             AND SUPPLYING HIM WITH THE USER NUMBER OF THE JOB
*             ACCESSING THEM.
*
*
*  FUNCTION:      IT IS NECESSARY FOR THE CORE OF STORE TO RUN IN
*                 MASTER-MODE IN ORDER TO PREVENT ANY INTERRUPTIONS
*        WHILE THE PARTITION ATTRIBUTE DATA IS BEING STORED IN THE
*        SYSTEM TABLES. AN INTERRUPTION DURING THIS PROCESS AND A LONG
*        WAIT IN A COMPUTE-BOUND QUEUE COULD CAUSE SOME SYSTEM DEGRA-
*        DATION AS THE TABLES WOULD BE LOCKED TO THE MBS DURING THIS
*        PERIOD OF TIME. ALSO, IT IS NECESSARY TO HAVE SUFFICIENT
*        PRIVILEGE TO SET AND RESET THE MASTER INTERRUPT ROUP INHIBITS
*        WHILE THE TABLES ARE BEING LOCKED AND THE CURRENT USER NUMBER
*        IS BEING CHANGED, OR WHILE A PARTITION'S TABLES ARE BEING
*        UPDATED AND THE APPROPRIATE CHANGE BIT IS BEING SET IN
*        PL:CHG.
*
*                 A PARTITION DEFINITION STACK ENTRY CONSISTS OF AN
*        ATTRIBUTE PRESENCE WORD AND EITHER ONE OR TWO DATA WORDS
*        DEPENDING ON THE TYPE OF ATTRIBUTE. THE PRESENCE WORD INDICATES
*        THE NUMBER OF DATA WORDS TO FOLLOW IN THE MOST SIGNIFICANT
*        4 BITS OF THE WORD. THIS ENABLES THE LOGIC TO EXECUTE A LOAD
*        CONDITIONS FROM THE PRESENCE WORD AND A PULL-MULTIPLE. BYTE
*        1 OF THE PRESENCE WORD CONTAINS THE PARTITION NUMBER AND
*        HALFWORD 1 CONTAINS THE ATTRIBUTE INDEX INTO ATERM2.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL             EXIT
*        -----             --------             ----
*        NO SIGNIFICANT    R0-R1=WORK           R0-R7,SR1-SR4 VOLATILE
*        DATA IN REGS      R2=WORK;STORVAL REG  D1-D4 PRESERVED
*                          R3=DATADEF;STORVAL
*                          R4=DATADEF;STORVAL
*                          R5=DATADEF INDEX;STORVAL
*                          R6=PART #
*                          R7=ATRBTE INDEX
*                          SR1=MBS REG
*                          SR2=MBS REG (SR1-SR3 BOMBED BY M:SYS)
*                          SR3=PARAM REG
*                          SR4=BAL REG
*
*
STORE,11ST1 EQU   %                 E.P. TO STORE PARTITION ATTRIBUTE
*                                   VALUES IN MONITOR TABLES.
         TRACE%   'K'           <<  'K' IS TRACE CODE FOR 'STORE'
         LW,R2    USRPRIV           GET USER PRIVILEGE FLAG
         CI,R2    3                 IS PRIVILEGE X'C0' OR GREATER?
         BGE      11ST2           ->  YES-CONTINUE
         B        15ERR2          ->  NO-OUTPUT WARNING MSGE
11ST2    EQU      %             <-  PRIVILEGE OK; CONTINUE
         LI,R1    X'7FFF'           GET SPD WD CNT MASK
         LS,R1    PDSPD+1           IS P.D. STACK WD CNT>0
         BGZ      11ST3           ->  YES-CONTINUE
         TYPE     ' NOTHING TO STORE'  NO-OUTPUT WARNING MSGE
         B        11ST6           ->RETURN
*
11ST3    EQU      %                 ALL CHECKS PASSED; STORE VALUE(S)
*********CK%CODE  ASCERTAIN VIRTUAL PAGES HAVE BEEN ALLOCATED FOR PART
         DO       CK%CODE>=1        DEF STACK. DO FOR LEVELS 1 & 2
           M:GL                     COMPARE LOWER C-PAGE TO UPPER
*                                   ALLOCATED COMMON PAGE.
           CW,SR1   SR2             HAVE VIRTUAL PAGES BEEN ALLOCATED?
           BL       11CK100       ->  YES-CONTINUE
           TYPE     ;                 NO-OUTPUT ERROR MESSAGE
           'PART.11.10.STORE.P.D. STACK VIRTUAL PAGES NOT ALLOCATED'
           B        12EXIT2       ->WAIT FOR DELTA
11CK100    EQU      %           <-  STACK PAGES ALLOCATED; CONTINUE
         FIN
*********CK%CODE  END
         M:INT    BREAK3        <-**DELAY ANY BREAKS
         MASTER%                ****REQUEST MASTER MODE
*********CK%CODE  DID WE GET MASTER MODE?
         DO       CK%CODE=1
           BCR,8    11CK101     **->  YES-CONTINUE
           TYPE     'PART.11.10.STORE.M:SYS CAL FAILURE'  NO-ERR MSGE
           B        12EXIT2       ->WAIT FOR DELTA
11CK101    EQU      %           <-  IN MASTER MODE;CONTINUE
         FIN
*********CK%CODE  END
         LI,R4    :STV(PTLK,'PT.CLOSE')  GET FLAG TO LOCK PART TBLS
         LW,R2    S:CUN             GET CURRENT 'CONTROL' USER'S NUMBER
         :JE,R3,R5 PTLK,:STV(PTLK,'PT.OPEN'),11ST4  GET CUR PART TBLS
*                                   LOCK FLAG. TBLS OPEN? YES-JUMP.
         :FETCH,SR1,R1 PCUN           NO-GET CUR PART TBLS USER#
         SLAVE%                     RETURN TO SLAVE MODE
         LW,R3    SR1               SAVE CURR USER
         LBAL%,R7 APEND,,,9WAR1     APPEND WARNING MSG
         LW,SR1   R3
         BAL,SR4  HEXOUT            CONVERT TO HEX BCD
         LBAL%,R7  BOUT             OUT MSG
         BAL,SR4  BREAK5          >>CHECK FOR DELAYED BREAK
         B        11ST6         <<->RETURN
11ST4    EQU      %                 PART TBLS OPEN
         DISABLE                <-  SET ALL INTERRUPT INHIBITS
*                                   DISABLE/ENABLE EXECUTED TO PREVENT
*                                   POSSIBLE SINGLE USER ABORT BEFORE
*                                   USER # CAN BE STORED WITH TABLES
*                                   LOCKED. OTHERWISE MBS COULD GET
*                                   CONFUSED.
         :STORE,R2,R0 PCUN          STORE CUR CONTROL USER#
         :STORE,R4,R0 PTLK          LOCK UP PART TBLS
         ENABLE                     RESET ALL INTERRUPT INHIBITS
11ST5    EQU      %                 PART ATRBTE DEFINITION RETRIEVAL
*                                   & STORAGE.
         PLW,R1   PDSPD         <-  PULL ATRBTE PRESENCE WD
*********CK%CODE  CHECK FOR STACK UNDERFLOW
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           BNSU     11CK102       ->IF NO STACK UNDERFLOW, CONTINUE
           LCI      4               PREPARE TO PUSH 4 WORK REGS
           PSM,R0   SPD             PUSH
           LI,R1    :STV(PTLK,'PT.OPEN')  GET FLAG TO OPEN PART TBLS
           LI,R2    0               GET ZEROES FOR P:CUN
           DISABLE                  SET ALL INTERRUPT INHIBITS
           :STORE,R2,R1 PCUN        ZERO OUT P:CUN IN PL:CHG
           :STORE,R0,R2 PTLK        UNLOCK PART TBLS
           ENABLE                   RESET ALL INTERRUPT INHIBITS
           SLAVE%                   RETURN TO SLAVE MODE
           TYPE     'PART.11.10.STORE.STACK UNDERFLOW'  OUTPUT ERR MSGE
           LCI      4               PREPARE TO PULL 4 WORK REGS
           PLM,R0   SPD             PULL
         BAL,SR4  BREAK5          >>CHECK FOR DELAYED BREAKS
           B        12EXIT2     <<->WAIT FOR DELTA
11CK102    EQU      %           <-  CONTINUE-NO STACK UNDERFLOW
         FIN
*********CK%CODE  END
         LC       R1                GET # OF DATA WDS TO PULL FROM STK
         PLM,R4   PDSPD             PULL LIMITS; IS STACK EMPTY?
         LI,R3    1                 GET BYTE INDEX TO PART#
         LB,R6    R1,R3             GET PART #
         LI,R3    3                 GET BYTE INDEX TO ATRBTE INDEX
         LB,R7    R1,R3             GET ATRBTE INDEX
         BAL,SR4  14STV1          >>STORE VALUE(S)
         LI,R1    X'7FFF'       <<  GET SPD WD CNT MASK
         LS,R1    PDSPD+1           IS P.D. STACK WD CNT>0?
         BGZ      11ST5           ->  YES-PULL ANOTHER ATRBTE PRESNCE WD
*                                     NO-ALL DONE UPDATING PART TBLS
         LI,R4    :STV(PTLK,'PT.OPEN')  GET FLAG TO OPEN PART TBLS
         LI,R2    0                 GET ZEROES FOR P:CUN
         DISABLE                    SET ALL INTERRUPT INHIBITS
         :STORE,R2,R0 PCUN          ZERO OUT P:CUN IN PL:CHG
         :STORE,R4,R0 PTLK          UNLOCK PART TBLS
         ENABLE                     RESET ALL INTERRUPT INHIBITS
         SLAVE%                     RETURN TO SLAVE MODE
         BAL,SR4  ZEROUT          >>RELEASE P.D. STK PGS & ZERO PTRS
         TYPE     ' VALUES STORED' <<OUTPUT SUCCESSFUL OPERATION MSGE
         BAL,SR4  BREAK5          >>CHECK FOR DELAYED BREAKS
11ST6    B        11MAIN1     <-<<>>RETURN
*
         PAGE
*
*************************
*  12.   EXIT ROUTINES  *
*************************
*
************************************************
*  12.1  'END' - RELINQUISH PARTITION CONTROL  *
************************************************
*
*
*
*  DESCRIPTION:   'EXIT' CONTROL RESETS THE PARTITION CONTROL MODULE
*                 EXECUTION FLAG TO ZERO, PULLS ALL REGISTERS AND EXITS
*        ON *D4. IF, DURING INITIAL TESTING (LEVELS 2 & 1), ERROR
*        CHECKS FAIL, EXIT FROM 'PART' (AFTER AN APPROPRIATE ERROR
*        MESSAGE HAS BEEN PRINTED) WILL OCCUR THROUGH 12EXIT2. HERE
*        THE PROGRAM WILL LOOP SO THAT THE ON-LINE USER/TESTER CAN
*        CALL DELTA AND EXAMINE CORE LOCATIONS AND REGISTERS. IF THE
*        USER WISHES EXECUTION TO FALL THROUGH THIS POINT, HE MUST
*        SET DELTA%WAIT%FLAG TO 0.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY               INTERNAL            EXIT
*        -----               --------            ----
*        ALL REGS VOLATILE   R0=WORK             REG CONTENTS ON
*                                                ENTRY TO 'PART' PRESRVD
*
END,12EXIT1 EQU   %                 EXIT THE PARTITION CONTROL MODULE
         BAL,SR4  ZEROUT          >>RELEASE PART DEF STK PGS,
*                                   IF ALLOCATED.
         LCI      0             <<  SET UP FOR 16
         PLM,R0   SPD               PULL ALL REGISTERS
*********CK%CODE  CHECK FOR STACK EMPTY
         DO       CK%CODE>=1        FORE LEVELS 1 & 2
           BSE      12CK1         ->STACK EMPTY. EXIT O.K.
           LI,R0    16              STACK NOT EMPTY
           MSP,R0   SPD             RESTORE STACK POINTER & COUNT
           TYPE     'PART.12.EXIT.STACK NOT EMPTY'  ERROR
           B        12EXIT2       ->WAIT ON DELTA
12CK1      EQU      %           <-  SAFE EXIT
         FIN
*********CK%CODE  END
12EXIT3  LI,R0    0             <<  GET NOT-EXECUTING CODE
         STW,R0   PEXEC             RESET PART EXECUTION FLAG
         B        *D4             >>GO HOME
*
*********CK%CODE  DEBUG EXIT FROM 'PART'
         DO       CK%CODE>=1        DEBUG LEVELS 2 & 1
           DEF      %DELTA%         DEF FOR DELTA USER
           USECT    CS:PART:DATA    USE DATA SECTION
%DELTA%    DATA     1               FLAG SET FOR LOOP
           USECT    CS:PART:TEXT    USE CSECT TYPE 1
BELL       GEN,8,8,16 1,X'07',X'4040' MAKE BELL CHAR TEXT STR
           USECT    CS:PART:PROCEDURE BACK TO PROCEDURE SECTION
12EXIT2    EQU      %           <<  E.P. FOR VALIDITY CHK FAILURES
           TYPE     BELL            SIGNAL DELTA HERE;R1,R2 SAVED
           MTW,0    %DELTA%         IS FLAG RESET?
           BGZ      %-1               NO-CONTINUE TO LOOP
           B        12EXIT1       ->  YES-EXIT PART
         FIN
*********CK%CODE  END
*
         PAGE
*
*****************************
*  13.   INPUT SUBROUTINES  *
*****************************
*
*
***************************************************************
*  13.1  GETDATA - GET ATTRIBUTE VALUE AND CONVERT TO EBCDIC  *
***************************************************************
*
*
*  DESCRIPTION:   'GETDATA' ACCEPTS AS ARGUMENTS THE PARTITION NUMBER
*                 AND ATTRIBUTE, FETCHES THE ATTRIBUTE VALUE FROM THE
*        PARTITION TABLES, AND RETURNS THE ADDRESS OF A TEXTC STRING
*        WHICH CONTAINS THE EBCDIC ATTRIBUTE VALUE(S) READY FOR
*        PRINTING. FOR INSTANCE, IF THE PARTITION NUMBER 2 AND ATTRI-
*        BUTE 'SP' WERE PASSED TO 'GETDATA', AN ADDRESS WOULD BE RE-
*        TURNED POINTING TO A TEXTC FIELD WITH BYTE 1 SPECIFYING THE
*        THE BYTE COUNT (IN THIS CASE, FOR EXAMPLE, X'05') AND THE
*        EBCDIC STRING FOLLOWING (C'NN-NN').
*
*
*  FUNCTION:      'GETDATA' USES THE PARTITION NUMBER (SR1) AND ATTRI-
*                 BUTE ITEM INDEX INTO TABLE 'ATERM2' (SR2) AS ARGUMENTS
*        TO CALL 'GETVAL' WHICH RETURNS THE RIGHT-JUSTIFIED PARTITION
*        ATTRIBUTE VALUE(S) FROM THE MONITOR TABLES IN REGISTERS R4 AND
*        R5. THE TYPE OF DISPLAY FOR THE PARTICULAR ITEM IS THEN DETER-
*        MINED BY ACCESSING THE DISPLAY CLASS CODE FROM TABLE 'ACLASS'.
*        'ACLASS' IS PARALLEL TO 'ATERM2' AND OFFERS SEVERAL DIFFERENT
*        DISPLAY CODES; THEY ARE:
*
*                 CODE  MEANING
*                 ----  --------------------------
*                   1   DECIMAL NUMBER
*                   2   RANGE (2 DEC #'S SEPARATED BY A '-')
*                   3   ALPHANUMBERIC (EBCDIC)
*                   4   HEXADECIMAL NUMBER (EBCDIC REPRESENTATION)
*                   5   'YES'/'NO'
*
*        ONE OF A GROUP OF CONVERSION ROUTINES IS CALLED DEPENDING
*        ON THE DISPLAY TYPE CODE. THESE ROUTINES EITHER SET UP THE
*        TEXTC DISPLAY BUFFER, 'GETDBUF', THEMSELVES, OR CALL SUB-
*        ROUTINES 'DECOUT', OR 'HEXOUT' TO PERFORM THE BINARY TO
*        EBCDIC CONVERSION. CONTROL IS RETURNED TO THE CALLING PROGRAM
*        AFTER SR3 IS LOADED WITH THE TEXTC BUFFER ADDRESS.
*
*                 GUARD-CODE GENERATED FOR TESTING LEVELS 2 & 1 CHECKS
*        THE PARTITION NUMBER AND ATTRIBUTE INDEX FOR VALIDITY AND
*        ASSURES THAT THE MOVE BYTE STRING INSTRUCTIONS IMPLEMENTED IN
*        BUFFER TO BUFFER OPERATIONS WILL NOT OVERFLOW THE DESTINATION
*        BUFFER.
*
*
*  SUBROUTINES CALLED:  'DECOUT' (MODULE CONSUB), 'HEXOUT' (MODULE
*                       CONSUB), AND 'GETVAL' (MODULE 'PART')
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY               INTERNAL            EXIT
*        -----               --------            ----
*        SR1=PART #          R0-R3=WORK          R0-R7,SR3 VOLATILE
*        SR2=ATRBTE INDEX    R4-R5=ATRBTE VALS   SR1-SR2,SR4,
*        SR4=RETURN LINK     R6-R7=SUBR ARGS,    D1-D4 PRESERVED
*                                  MBS REGS
*                            SR1=PART #          SR3=TEXTC ADR
*                            SR2=ATRBTE INDEX
*                            SR4=SUBR LINK
*                            SR3=BUFFER ADRS
*
*
GETDATA,13GETD1 EQU %               ENTRY POINT FOR PART ATRBTES FETCH
         CK%TRACE 'A'           <<  'A'=TRACE-CODE FOR 'GETDATA'
*********CK%CODE  VALIDITY CHECK PART # (SR1) & ATRBTE ITEM INDEX (SR2)
         DO       CK%CODE>=1        FOR LEVELS 2 & 1 OF TESTING
           CLM,SR1  PART#LIM        DOES PART # LIE BETWEEN LIMITS?
           BCS,9    13CK1         ->  NO-STOP EXECUTION; PRINT MESSAGE
           CLM,SR2  AT2IXL          DOES ITEM INDEX LIE WITHIN LIMITS?
           BCR,9    13CK2         ->  YES-PARAMETERS VALID; CONTINUE
13CK1      TYPE     'PART.13.GETDATA.INDEX/PART#.OUT OF LIMITS'  <- ERR
           M:SNAP   'SR1,SR2',(SR1,SR2)  **SNAP PART # AND INDEX
           B        12EXIT2     **>>WAIT AND EXIT IF FLAG SET
13CK2      EQU      %           <-  SUCCESSFUL EXIT POINT
         FIN
*********CK%CODE  END
         LCI      4                 PREPARE TO PUSH SR1-SR4
         PSM,SR1  SPD               PUSH
         LW,R6    SR1               PART #-->R6; PRESERVED
         LW,R7    SR2               ITEM INDEX-->R7; PRESERVED
         BAL,SR4  13GV1           >>GET ATRBTE VAL IN R4 (& R5,
*                                   IF DECIMAL RANGE OR 'ACCT')
         LB,R7    ACLASS,R7     <<  GET TYPE DISPLAY IN R1
         B        %,R7            ->HANDLE DISPLAY TYPE
         B        13GETD10      <-->SINGLE DECIMAL NUMBER
         B        13GETD20      <-->DECIMAL RANGE
         B        13GETD30      <-->ALPHANUMBERIC DOUBLEWORD
         B        13GETD40      <-->SINGLE HEXADECIMAL INTEGER
         B        13GETD50      <-->'YES'/'NO'
*                                   END OF BRANCH VECTOR TABLE
13GETD10 EQU      %                 BIN-->EBCDIC; SINGLE DEC #
         LW,SR1   R4            <-  GET BIN #;R5 NOT USED
         BAL,SR4  DECOUT          >>CONVERT TO DEC INTEGER;SR3=TEXTC
*                                   ADDRESS ON RETURN
         B        13GETD60      <<->FINISH UP
*
13GETD20 EQU      %                 BIN-->EBCDIC; DECIMAL RANGE
         LW,SR1   R4                GET LOWER LIMIT; R5 PRESERVED
         BAL,SR4  DECOUT          >>CONVERT;SR3=EBCDIC# TEXTC ADR
         LI,R7    BA(GETDBUF)+1 <<  GET BA(OUTPUT BUF)+1 (PTS TO TEXT)
         LB,R6    *SR3              GET MBS BYTE COUNT
*********CK%CODE  VALIDITY CHECK MBS BYTE COUNT FOR DESTINATION OVRFLW
         DO       CK%CODE>=1        DO FOR LEVELS 2 & 1
           CI,R6    GBSZ-1          IS BYTE CNT > DEST BUF SIZE-1?
*                                   (COUNT+TEXT)=BUF SIZE
           BLE      13CK4         ->  NO-CONTINUE
13CK3      TYPE     'PART.13.GETDATA.MBS CNT>GBSZ'  ERROR
           B        12EXIT2       >>  YES-TYPE MSGE; ERR EXIT
13CK4      EQU      %           <-
         FIN
*********CK%CODE  END
         STB,R6   R7                STORE CNT IN BYTE 0 OF R7
         SLS,SR3  2                 SOURCE WA TO BA
         LW,R6    SR3               GET SOURCE ADR
         MBS,R6   1                 MOVE ONLY TEXT DATA TO OUTPUT BUF
*
         LI,R0    C'-'              GET RANGE SEPARATOR (XX-XX)
         STB,R0   0,R7              STORE IN NEXT AVAILABLE BYTE OF DEST
         AI,R7    1                 INCREMENT NEXT BYTE POINTER
*                                   PTR TO NXT AVAIL DEST BYTE IN R7
*
         LW,SR1   R5                GET UPPER LIMIT OF RANGE
         BAL,SR4  DECOUT          >>CONVERT TO EBCDIC DEC INTEGER
         LB,R6    *SR3          <<  GET SOURCE STR BYTE CNT
         STB,R6   R7                STORE CNT IN BYTE 0 OF R7
         SLS,SR3  2                 SOURCE WA TO BA
         LW,R6    SR3               GET SOURCE ADR
         MBS,R6   1                 MOVE ONLY TEXT TO DESTINATION
         LI,R6    BA(GETDBUF)+1     GET PTR TO 1ST BYTE OF TEXT
         SW,R7    R6                SUBTRACT FROM NEXT AVAIL BYTE PTR
*********CK%CODE  TOTAL BUFFER BYTE COUNT VALIDITY CHECK
         DO       CK%CODE>=1        DO FOR LEVELS 2 & 1
           CI,R7    GBSZ-1          IS PROPOSED BYTE CNT>BUF SZ-BYT CNT?
           BLE      13CK5         ->  NO-CONTINUE
           B        13CK3         ->  YES-ERROR MESSAGE & OUT
13CK5      EQU      %           <-
         FIN
*********CK%CODE  END
         STB,R7   GETDBUF           STORE TEXT BYTE CNT (EG, '5XX-XX')
         LI,SR3   GETDBUF           GET ADR OF OUTPUT STRING
         B        13GETD60        ->FINISH UP
*
13GETD30 EQU      %                 ALPHANUMBERIC DOUBLEWORD - LUCK!
         STB,R5   GETDBUF+2     <-  STORE LAST BYTE OF DW IN
*                                   BYTE 0 OF 3RD WD OF BUF
         SLD,R4   -8                SHIFT OFF LAST BYTE
         STD,R4   GETDBUF           STORE ALPHA DW
         LI,R4    8                 GET # BYTES IN TEXT
         STB,R4   GETDBUF           STORE COUNT
         LI,SR3   GETDBUF           GET ADDR OF OUTPUT TEXT
         B        13GETD60        ->FINISH UP
*
13GETD40 EQU      %                 BIN-->EBCDIC HEX INTEGER CONVERSION
         LW,SR1   R4            <-  GET BIN # TO BE CONVERTED
         BAL,SR4  HEXOUT          >>CONVERT;SR3=TEXTC ADR ON RETURN
         B        13GETD60      <<->FINISH UP
*
13GETD50 EQU      %             <-  OUTPUT IS 'YES' OR 'NO'
         CI,R4    :STV(PLOCK,'YES') 'YES' VALUE FOR PHOLD IS SAME
*                                   IS ITEM VALUE='YES'?
         BE       %+3             ->  YES-SET UP IN BUFFER
         LI,SR3   NOC                 NO-GET TEXTC 'NO' ADR
         B        13GETD60        ->FINISH UP
         LI,SR3   YESC          <-  GET TEXTC 'YES' ADR
         B        13GETD60        ->FINISH UP
*
13GETD60 EQU      %                 EXIT POINT FROM SUBROUTINE
         PLW,SR4  SPD           <-  RESTORE RETURN LINK
         LI,R0    -1
         MSP,R0   SPD               BUMP STACK PTR DOWN 1 (FORGET SR3)
         LCI      2
         PLM,SR1  SPD               PULL SR1 & SR2
         B        *SR4            >>RETURN WITH TEXTC ADR IN SR3
*
         PAGE
*
**********************************************************************
*  13.2  'GETVAL' - GET ATTRIBUTE VALUE/RANGE FROM PARTITION TABLES  *
**********************************************************************
*
*
*  DESCRIPTION:   'GETVAL' ACCEPTS AS ARGUMENTS A PARTITION NUMBER AND
*                 ATTRIBUTE ITEM INDEX IN TABLE 'ATERM2', FETCHES THE
*        SPECIFIED VALUE(S) FROM THE PARTITION TABLES, RIGHT-JUSTIFIES
*        IT, AND RETURNS TO THE CALLING ROUTINE. THIS ROUTINE IS
*        DESIGNED AS THE SOLE CODE WHICH ACCESSES THE MONITOR PARTITION
*        TABLES FOR CURRENT ATTRIBUTE VALUES. THUS, ANY ACCESS PROBLEMS
*        ARE LOCALIZED TO THIS ROUTINE. THE ACTUAL DATA RETRIEVAL IS
*        IMPLEMENTED THROUGH THE USE OF DATADEF PROCS SO THAT IN THE
*        EVENT OF A RE-DESIGN OF PARTITION TABLES ARCHITECTURE, THE
*        BODY OF CODE DEALING WITH THE TABLES WILL NOT REQUIRE CHANGE.
*        THIS IS POSSIBLE BECAUSE ALL DATA IS REFERENCED SYMBOLICALLY
*        AND NOT SPECIFICALLY BY BIT-PATTERN IN THE CODE; ONLY THE
*        DATA ITEM DEFINITIONS NEED TO BE CHANGED (SEE SECTION 5.2).
*
*
*  FUNCTION:      THE INPUT PARAMETER REGISTERS ARE NAMED BELOW. A
*                 BLOCK OF REGISTERS (R2-R5) IS USED FOR CODING THE
*        DATADEF PROCS; A PAIR OF REGISTERS (R & RU1) AND AN INDEX
*        ARE NEEDED FOR EACH FETCH. THE WAY IN WHICH THE PARTITION
*        TABLES ARE CURRENTLY SET UP DOES NOT REQUIRE THE INDEX,
*        BUT IT IS SPECIFIED FOR POSSIBLE FUTURE CHANGES AS A PRE-
*        CAUTION. THE ATTRIBUTE ITEM INDEX IS USED TO INDEX INTO A
*        BRANCH VECTOR TABLE WHICH DIRECTS EXECUTION TO THE APPRO-
*        PRIATE SET OF FETCHES FOR THE ATTRIBUTE VALUE(S). IF THE ATTRI-
*        BUTE REQUIRES A RANGE TO BE RETRIEVED OR A DOUBLEWORD VALUE,
*        TWO FETCHES ARE EXECUTED FROM THE LOWER AND UPPER LIMIT TABLES
*        AND THE RESULTANT VALUES ARE RETURNED TO THE CALLING ROU-
*        TINE IN A CONSECUTIVE PAIR OF REGISTERS.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY               INTERNAL             EXIT
*        -----               --------             ----
*        R6=PART #           R2=DATADEF PRINC     R4=SINGLE ITEM/LOWER
*        R7=ATRBTE ITEM      R3=DATADEF INDEX        LIMIT
*           INDEX            R4=DATADEF PRINC     R5=VOLATILE/UPPER
*        SR4=RETURN LINK     R5=DATADEF SUBORD       LIMIT
*                            R6=PART #            R2-R3 VOLATILE
*                            R7=ATRBTE ITEM X
*                            SR4=RTN LINK
*
*
GETVAL,13GV1 EQU %                  ENTRY POINT; DATADEF FETCH ATRBTES
*ACTIONS FOR RSRCE ITEMS TREATED DIFFERENTLY
         CI,R7    #ATERM2
         BG       13RSRCE
13GVGV   EQU      %
         B        %,R7          <<->ITEM INDEX=PTR TO :FETCH
         B        13GVTIME   2    ->TIME RANGE
         B        13GVQUAN   3    ->PART QUANTUM
         B        13GVLOCK   7    ->LOCK, UNLOCK
         B        13GVHOLD   8    ->HOLD, RELEASE
         B        13GVLCL    14     ->LCL
         B        13GVTRM    15     ->TRM
         B        13GVRB     16     ->RB
         B        13GVCUR    9    ->CURRENT # JOBS SELECTED, THIS PART
         B        13GVTOL   10    ->TOTAL # JOBS EXECUTED, THIS PART
         B        13GVACCT  11    ->ACCOUNT # RUNNING, THIS PART
         B        13GVUSR#  12    ->USER # JOB EXECUTING, THIS PART
         B        13GVSID   13    ->SYSID CURRENT JOB
*
         ERROR,X'F',((%-1-13GVGV)=#ATERM2)=0  MTNP
*
*USE ALGORITHM TO ACCESS CORRECT ITEM
13RSRCE  EQU      %
         AI,R7    -#ATERM2          (R7)=RSRCE INDEX
         LW,R3    R6                GET PART# IN ODD REG. 3
         MI,R3    SV:RSIZ+1
         AW,R3    R7                (R3)=OFFSET FROM PLB:--- TBL
         LB,R4    PLB:MIN+F,R3      GET MIN
         LB,R5    PLB:MAX+F,R3      GET MAX
         AI,R7    #ATERM2           RESTORE R7
         B        13GV3             RETURN
*
13GVTIME EQU      %                 GET UPPER, LOWER TIME LIMITS
         :FETCH,R2,R4 PTU,R6    <-  GET UPPER TIME LIMIT;RT-JUSTIFY
         :FETCH,R4,R3 PTL,R6        GET LOWER TIME LIMIT; RT-JUSTIFY
         B        13GV2           ->RETURN
*
13GVQUAN EQU      %                 GET PART QUANTUM
         :FETCH,R4,R3 PQUAN,R6  <-  GET BATCH QUANTUM
         SLS,R4   1                 CONVER T TICS TO MSEC
         B        13GV3           ->RETURN
*
13GVLOCK EQU      %                 GET LOCK/UNLOCK FLAG
         :FETCH,R4,R3 PLOCK,R6  <-  GET FLAG
*********CK%CODE  IS CHECK-CODE FOR PL:FLG PRESENT?
         DO       CK%CODE=2         DO ONLY FOR LEVEL 2
           STH,R4   R2              STORE FLAG AND CHECK-CODE
           :JE,R4,R3 :ITEM(PLOCK%C,(AD,R2)),:STV(PLOCK%C,'CODE.OK'),;
                     13CK10         IF CK-CODE CORRECT, SKIP ERR CODE
           TYPE     'PART.13.GETVAL.PLOCK%><CHECK-CODE'  IF NOT, ERROR
*****SHOULD BE B 12EXIT2
         B        13CK10            LET CONTINUE(ANYTHING WRONG)
13CK10     :FETCH,R4,R3 :ITEM(PLOCK%R,(AD,R2))  <-GET REAL LK/ULK FLAG
         FIN                        PROCEED
*********CK%CODE  END
         B        13GV3           ->RETURN
*
13GVHOLD EQU      %                 GET HOLD/REL FLAG
         :FETCH,R4,R3 PHOLD,R6  <-  GET FLAG
         B        13GV3           ->RETURN
*
13GVLCL  EQU      %                 JOB ORIGIN AS ATTRIBUTE-LCL
         :FETCH,R4,R3 PLCL,R6       GET LCL
         B        13GV3             RETURN
*
13GVTRM  EQU      %                 JOB ORIGIN AS ATTRIBUTE-TRM
         :FETCH,R4,R3 PTRM,R6       GET TRM
         B        13GV3             RETURN
*
13GVRB   EQU      %                 JOB ORIGIN AS ATTRIBUTE-RB
         :FETCH,R4,R3 PRB,R6        GET RB
         B        13GV3             RETURN
*
13GVCUR  EQU      %                 GET CURRENT # JOBS SELECTED
         :FETCH,R4,R3 PCUR,R6   <-  GET # JOBS; RT-JUSTIFY
         B        13GV3           ->RETURN
*
13GVTOL  EQU      %                 GET TOTAL # JOBS EXECUTED, THIS PART
         :FETCH,R4,R3 PTOL,R6   <-  GET # JOBS;RT-JUSTIFY
         B        13GV3           ->RETURN
*
13GVACCT EQU      %                 GET ACCT # OF EXECUTING JOB
         :FETCH,R2,R4 PACT2,R6  <-  GET HIGH-ORDER ACCT WD
         :FETCH,R4,R3 PACT1,R6      GET LOW-ORDER ACCT WD
         BNEZ     13GV2           <-RETURN, EXISTS
         LD,4     IDLET             GET IDLE MESSAGE
         B        13GV3           <-RETURN
*
13GVUSR# EQU      %                 GET CURRENT PART USER #
         :FETCH,R4,R3 PUSR,R6   <-  GET USER #; RT-JUSTIFY
         B        13GV2           ->RETURN
*
13GVSID  EQU      %                 GET CURRENT SYSID
         :FETCH,R4,R3 PSID,R6   <-  GET SYSID
         B        13GV3             RETURN
*
13GV2    EQU      %                 EXIT FROM 'GETVAL'
         LW,R5    R2            <-  GET UPPER LIM/HIGH-ORDER VAL
13GV3    B        *SR4            >>RETURN
*
         PAGE
*
******************************
*  14.   OUTPUT SUBROUTINES  *
******************************
*
*
****************************************************************
*  14.1  'HEAD' - BUILD AND OUTPUT PARTITION DISPLAY HEADING  *
****************************************************************
*
*
*  DESCRIPTION:   'HEAD' BUILDS AN OUTPUT HEADING FOR THE PARTITION
*                 ATTRIBUTES DISPLAY CONSISTING OF A LINE OF ORDERED
*        DISPLAY ATTRIBUTE NAMES AND LINE OF DASHES WHICH UNDERLINE
*        EACH INDIVIDUAL ATTRIBUTE NAME. TO DETERMINE THE ORDER IN
*        WHICH THE ATTRIBUTES WILL BE BUILT IN THE OUTPUT BUFFER, TABLE
*        'AORDER' IS ACCESSED THROUGH AN INCREMENTING INDEX. 'AORDER'
*        CONTAINS AN ORDERED LIST OF THE INDICES (INTO ATTRIBUTE LIST
*        TABLE 'ATERM2') WHICH HAVE BEEN PLACED THERE BY THE USER
*        THROUGH 'ADD' AND 'DROP' COMMANDS. THE SELECTED INDEX IS
*        USED TO ACCESS THE ADDRESS OF THE APPROPRIATE TEXT STRING
*        HEADING FOR THE ATTRIBUTE, THE STRING IS APPENDED TO THE
*        OUTPUT BUFFER. THIS PROCESS CONTINUES UNTIL ALL ATTRIBUTES
*        WHICH HAVE BEEN SELECTED FOR DISPLAY HAVE BEEN PLACED IN THE
*        BUFFER AFTER WHICH THE LINE IS OUTPUT THROUGH M:LO.
*
*                 THE OUTPUT LINE FOLLOWING THE ATTRIBUTE NAMES CON-
*        TAINS GROUPS OF DASHES WHICH UNDERLINE EACH LETTER OF THE
*        ATTRIBUTE. THE BUFFER FOR THIS LINE IS BUILT IN MUCH THE SAME
*        WAY AS FOR THE ATTRIBUTE NAME LINE EXCEPT THAT A SINGLE TEXT
*        STRING OF DASHES ('-') IS USED TO APPEND TO THE OUTPUT BUFFER.
*        THE TEXT COUNT FOR EACH ATTRIBUTE UNDERLINE GROUP IS GAINED
*        FROM THE ARGUMENT FIELD WIDTH TABLE AFWIDTTH WHICH IS PARA-
*        LLEL TO ATERM2.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL               EXIT
*        -----             --------               ----
*        D4=RETURN LINK    R0=SUBR REG            R0-R4,SR1-SR4 VOLATLE
*                          R1=WORK;AHEADPTR INDX  R5-R7,D1-D4 PRESRVD
*                          R2=TYPE REG;SUBR REG
*                          R3=AORDER INDEX
*                          R4=AF WIDTH
*                          SR1=SPACE COUNT
*                          SR2=OUTPUT FLAG
*                          SR3=ATRBTE STR ADR
*                          SR4=BAL REG
*
*
HEAD,14HE1 EQU    %                 E.P. TO OUTPUT A PART DISPLAY HEAD
*                                   TEST FOR ATRBTE DISPLAY ENTRIES
*                                   IN AORDER.
         LB,R1    AORDER        <<  GET AORDER TBL ENTRY 1;
*                                   ANY ATTRIBUTES TO DISPLAY?
         BGZ      14HE2           ->  YES-FORM HEADING
,9ERR3   TYPE     ' NO ATTRIBUTE DISPLAY FLAGS SET'  NO-OUTPUT ERR MSGE
         B        11MAIN1         >>RETURN
14HE2    EQU      %                 BUILD HEADER IN OUTPUT BUFFER
         LBAL%,SR4  NEWLN,1       >>SKIP AN OUTPUT LINE
         LBAL%,R7 APEND,,,(W,AHEADPTR) <<>>' PART ' INITIALIZE OUT BUF
         LI,R3    0                 INITIALIZE AORDER TBL INDEX TO 1ST
*                                   ENTRY. LOOP & BUILD ATRBTE HEAD BUF
14HE3    EQU      %                 GET ATRBTE HEAD TEXT STRING ADRS
*                                   ONE BY ONE UNTIL EXHAUSTED.
         LB,R1    AORDER,R3     <-  GET NXT ATRBTE INDEX FOR PART DISP
         BLEZ     14HE4           ->  0==>NO MORE DISPLAY ATRBTES
         LBAL%,R7 APEND,,,(W,AHEADPTR,R1)  >>GET ATRBTE HEAD TEXTC
*                                   ADR & APPEND TO OUT BUF.
         AI,R3    1             <<  INCREMENT AORDER INDEX
         B        14HE3           ->GET NXT ATRBTE INDEX
*
14HE4    EQU      %                 OUTPUT THE PART DISPLAY HEADING
         BAL,R7   SEND            >>M:WRITE BUF THROUGH M:LO DCB
*                                   OUTPUT DASHES UNDER EACH ATRBTE FLD
         LI,R4    0                 INITIALIZE AFWIDTH INDEX
         LI,SR2   0                 GET 'NO OUTPUT' FLAG FOR BOUTX
         LI,R3    -1                INITIALIZE AORDER INDEX
14HE5    LBAL%,SR4  SPACE,1       >>SEPARATE UNDERLINE GROUPS WITH SPACE
         LBAL%,R7  BOUTX,,,BA(DASHES),(B,AFWIDTH,R4)  <<>>UNDERLINE
*                                   PARALLEL ATTRIBUTE WITH N DASHES
         AI,R3    1             <<  INCREMENT AORDER TABLE INDEX
         LB,R4    AORDER,R3         GET NXT ATRBTE INDX FOR PART DISP;
*                                   ALL DONE?
         BGZ      14HE5           ->  NO-SEPARATE DASH GROUPS
*                                     YES-OUTPUT LINE
14HE6    EQU      %                 OUTPUT BUF OF ATRBTE UNDERLINES
         BAL,R7   SEND              <->>M:WRITE BUF THROUGH M:LO DCB
         B        *D4           <<>>RETURN
*
         PAGE
*
********************************************************************
*  14.2  'DISPA' - DISPLAY SINGLE ATTRIBUTE VALUE FOR PARTITION X  *
********************************************************************
*
*
*  DESCRIPTION:   'DISPA' ACCEPTS AS ARGUMENTS A PARTITION NUMBER AND I
*                 INDEX POINTING TO THE ATTRIBUTE NAME IN TABLE
*        'ATERM2'. IT ACCESSES THE VALUE OF THE ATTRIBUTE THROUGH
*        SUBROUTINE 'GETDATA' AND DISPLAYS THE LINE ' NN ATRBTE=XXXX',
*        WHERE 'NN'=THE PARTITION NUMBER, 'ATRBTE'=THE ATTRIBUTE NAME,
*        AND 'XXXX'=THE ATTRIBUTE VALUE. STANDARD 'CONTROL' SUBROUTINES
*        ARE USED TO DO MOST OF THE CONVERSION, ACCESSING AND OUTPUT
*        WORK.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY              INTERNAL              EXIT
*        -----              --------              ----
*        SR1=PART #         R0-R1=WORK            R0 VOLATILE
*        SR2=ATRBTE INDEX   R2=CHAR BUF           R1-R7,SR1-SR4,D1-D4
*        D4=RTN LINK        R4-R5=ATRBTE NME BUF  PRESERVED
*                           SR1-SR4=SUBR REGS
*
*
DISPA,14DA1 EQU    %                E.P. TO DISPLAY A SINGLE PART ATRBTE
         TRACE%   'L'           <<  STORE TRACE-CODE FOR 'DISPA'
         LCI      15
         PSM,R1   SPD               PUSH R1-R7,SR1-SR4,D1-D4
         STW,SR1  D1                SAVE P#
         STW,SR2  D2                SAVE ATRBTE INDX
         LBAL%,SR4 SPACE,1        >>ALIGN OUTPUT WITH CMD LINE
         LBAL%,SR4 DECOUT,(W,D1) <<>>CONVERT P# TO EBCDIC
         LBAL%,R7  APEND        <<>>APPEND P# TO BUFFER
         LBAL%,SR4 SPACE,1      <<>>SPACE OVER TO ATRBTE
         LW,R1    D2            <<  GET ATRBTE INDEX
         LD,R4    ATERM2,R1         EBCDIC ATRBTE NAME TO BUF
*                                   CALCULATE # CHARS IN NAME
         LI,R1    0                 INITIALIZE BYTE INDEX
14DA3    LB,R2    R4,R1         <-  GET ATRBTE NAME BYTE
         CI,R2    X'40'             IS IT A BLANK?
         BE       14DA5           ->  YES-R1=NAME BYTE CNT
         AI,R1    1                   NO-INC BYTE PTR
         CI,R1    8                 ARE WE DONE WITH DW
         BL       14DA3           ->  NO-GET NEXT BYTE
14DA5    EQU      %                 ATRBTE NAME BYTE CNT ESTABLISHED
         LBAL%,R7  BOUTX,,0,4*R4,(W,R1) <->>APPEND ATRBTE NAME
         LBAL%,R7 APEND,,,C29   <<>>APPEND =
         LBAL%,SR4 GETDATA,(W,D1),(W,D2) <<>>GET ATRBTE VALUE
         LBAL%,R7  BOUT         <<>>APPEND ATRBTE VAL AND OUTPUT
         LCI      15
         PLM,R1   SPD               PULL R1-R7,SR1-SR4,D1-D4
         B        *D4             >>RETURN
*
         PAGE
*
************************************************************
*  14.3  'DISPX' - DISPLAY ALL ATTRIBUTES FOR PARTITION X  *
************************************************************
*
*
*  DESCRIPTION:   'DISPX' ACCEPTS AS AN ARGUMENT A PARTITION NUMBER
*                 AND DISPLAYS ALL THAT PARTITION'S ATTRIBUTES WHICH
*        HAVE THEIR INDICES ENTERED IN THE ATTRIBUTE DISPLAY AND
*        ORDER TABLE 'AORDER'. 'DISPX' ASSUMES THAT 'HEAD' (PARTITION
*        ATTRIBUTE HEADING ROUTINE) HAS BEEN CALLED AND ALIGNS THE
*        DISPLAY OF EACH ATTRIBUTE ITEM DIRECTLY UNDER ITS CORRESPOND-
*        ING HEADING. THIS ROUTINE IS BASICALLY A SKELETON WHICH CALLS
*        OTHER SUBROUTINES TO PERFORM THE BULK OF ITS TASKS. THREE
*        OPTIONS ARE PROVIDED FOR EBCDIC VALUE DISPLAY JUSTIFICATION
*        WITHIN THE ATTRIBUTE DISPLAY FIELD. DEPENDING ON THE VALUE
*        FOR THE ATTRIBUTE IN THE 'AVJUST' TABLE, A DISPLAY VALUE MAY
*        BE LEFT-JUSTIFIED, CENTERED, OR RIGHT-JUSTIFIED. IF A DISPLAY
*        VALUE WOULD OCCUPY MORE SPACES THAN THE FIELD WIDTH ALLOWS,
*        THE DISPLAY FIELD IS FILLED WITH ASTERISKS AND THE PARTITION
*        NUMBER AND ATTRIBUTE INDEX ARE PUSHED INTO A SPECIAL STACK.
*        THE CALLING ROUTINE MAY SUBSEQUENTLY PULL THIS INFORMATION
*        FROM THE STACK AND DISPLAY THE ATTRIBUTE VALUE INDIVIDUALLY.
*
*
*  FUNCTION:      THE PARTITION NUMBER IS INITIALLY CONVERTED TO A DEC-
*                 IMAL VALUE AND THE NUMBER OF PRECEDING AND TRAILING
*        BLANKS (WITHIN THE FIELD) IS CALCULATED ALONG WITH THE FIELD
*        WIDTH. THE PRECEDING BLANKS ARE THEN OUTPUT TO THE BUFFER,
*        THE EBCDIC PARTITION NUMBER FOLLOWS, WITH THE TRAILING
*        BLANKS LAST PLUS ONE BLANK TO SEPARATE THE NUMBER FROM THE
*        FIRST ATTRIBUTE DISPLAY.
*
*                 ATTRIBUTE INDICES ARE RETRIEVED FROM TABLE 'AORDER'
*        ONE AT A TIME UNTIL A '0' IS DETECTED. THIS SIGNIFIES
*        THAT NO MORE PARTITION ATTRIBUTES ARE TO BE DISPLAYED. THE
*        PARTITION ATTRIBUTE INDICES WERE ENTERED PREVIOUSLY INTO
*        'AORDER' IN THE ORDER IN WHICH THEY ARE TO BE DISPLAYED.
*        THUS, ONLY ATTRIBUTES WHICH HAVE BEEN SELECTED FOR DISPLAY
*        HAVE AN INDEX ENTRY IN 'AORDER'. SUBROUTINE 'GETDATA' IS CALLED
*        TO FETCH THE ATTRIBUTE VALUE(S) AND TO CONVERT THE VALUE(S)
*        TO AN EBCDIC TEXTC STRING. THE ADDRESS OF THIS STRING
*        IS PASSED BACK AND STORED. THE NUMBER OF BLANKS TO PRECEDE
*        THE DISPLAY IS CALCULATED ALONG WITH THE FIELD WIDTH
*        (WHICH IS RETRIEVED FROM TABLE 'AFWIDTH') AND NUMBER OF BLANKS
*        TO FOLLOW THE DISPLAY VALUE (PLUS ONE FOR SPACING BETWEEN
*        ATTRIBUTES). IF AN OVERFLOW WOULD OCCUR AS A RESULT OF THE
*        VALUE CHARACTER COUNT EXCEEDING THE DISPLAY FIELD WIDTH, THE
*        PARTITION NUMBER AND ATTRIBUTE INDEX ARE PUSHED INTO STACK
*        'DOVSTK' FOR USE BY THE CALLING ROUTINE. THE DISPLAY FIELD
*        IS PACKED WITH ASTERISKS. THE VALUE IS APPENDED TO THE OUTPUT
*        BUFFER WITH PADDING BLANKS BEFORE AND AFT AND THE THE ATTRI-
*        BUTE INDEX IS RETRIEVED.
*
*                 IF ANY ATTRIBUTE DISPLAY FIELDS WOULD HAVE BEEN
*        OVERFLOWED, A COUNT OF THE NUMBER OF OVERFLOWS IS CONTAINED
*        IN SR3. IF NO OVERFLOWS WOULD HAVE OCCURRED, SR3 = 0.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL             EXIT
*        -----             --------             ----
*        SR1=PART # (BIN)  R0-R3=WORK           SR3=OVERFLOW COUNT
*        D4=RETURN LINK    R4=FIELD WIDTH       R0-R7,SR1-SR4 VOLATILE
*                          R5=BLANKS PRECDNG    D1-D4 PRESERVED
*                          R6=BLANKS FOLLOWING
*                          R7=SUBR LINK
*                          SR1=PART #
*                          SR2=ATRBTE INDEX
*                          SR3=VALUE EBCDIC WIDTH
*                          SR4=SUBR LINK
*
*
DISPX,14DX1 EQU   %                 E.P. DISPLAY A PARTITION'S ATRBTES
         CK%TRACE 'M'               TRACE CODE FOR 'DISPX';LEVELS 1 & 2
         STW,SR1  PART#             SAVE PART #
         BAL,SR4  DECOUT          >>CONVERT PART # TO DEC TEXTC STR
         STW,SR3  TEXTCADR      <<  SAVE ADR OF OUTPUT VAL TEXC STR
         LBAL%,SR4  14DX20,,0,(B,*SR3)  >>CALCULATE PART# DISPLAY FIELD
*                                   WIDTH,BLANKS PRECEDING & BLANKS
*                                   FOLLOWING OUTPUT VALUE WITHIN FIELD.
*                                   R4=FIELD WIDTH;R5=BLANKS PRECEDING;
*                                   R6=BLANKS FOLLOWING.
         AI,R5    1             <<  PRECEDE DISPLAY WITH A BLANK
         LBAL%,SR4  SPACE,(W,R5)  >>BEGIN DISPLAY WITH (R5) BLANKS
         LBAL%,R7  APEND,,,(W,TEXTCADR)  <<  APPEND EBCDIC PART# DECIMAL
         LBAL%,SR4 SPACE,(W,R6) <<>>SPACE OUT TO NXT ATRBTE
*                                   INITIALIZE FOR ATRBTE DISPLAYS
         LI,R0    0             <<
         STW,R0   OVFCNT            ZERO DISPLAY OVERFLOW COUNT
         LI,R0    -1                GET BASE BYTE OF ATRBTE DISP ITEM
*                                   INDEX TABLE-1.
         STW,R0   AORDERX           STORE IT
*
14DX2    EQU      %                 APPEND SUCCESSIVE ATRBTE VALS TO
*                                   OUTPUT BUFFER
         MTW,1    AORDERX       <-  INCREMENT AORDER INDEX
         LW,R1    AORDERX           GET BYTE INDEX TO NXT ATRBTE INDX
         LB,SR2   AORDER,R1         GET NXT DISPLAY ATRBTE INDX
*                                   ALL DONE?
         BEZ      14DX3           ->  YES-LAST TABLE ENTRY IS ZERO
         LBAL%,SR4  GETDATA,(W,PART#)  >>NO-GET ATRBTE VAL IN TEXTC FMT
         STW,SR3  TEXTCADR      <<  SAVE ADR OF OUTPUT TEXTC STR
         LBAL%,SR4  14DX20,,,(B,*SR3)  ->CALCULATE DSPLY JUSTIFICATION;
*                                   WAS THERE OVERFLOW?
         BLZ      14DX4         <-->  YES-PUSH PART# & ATRBTE INDEX
         LBAL%,SR4  SPACE,(W,R5) >>  NO-APPEND (R5) BLANKS PRECEDING
         LBAL%,R7  APEND,,,(W,TEXTCADR)  <<  APPEND EBCDIC VAL TO BUF
         LBAL%,SR4  SPACE,(W,R6)  >>APPEND (R6) BLANKS FOLLOWING
         B        14DX2         <<->OUTPUT NEXT ATTRIBUTE
*
14DX3    EQU      %                 ALL ATRBTES REQUESTED OUTPUT
         BAL,R7   SEND            >>OUTPUT FINISHED BUFFER
         LW,SR3   OVFCNT        <<  GET OVERFLOW COUNT
         B        *D4             >>RETURN
*
*  14.3.2 DISPLAY OVERFLOW HANDLER
*
14DX4    EQU      %                 ATRBTE VAL OVERFLOWS FIELD WIDTH
         MTW,1    OVFCNT        <-  INCREMENT OVERFLOW CNT
         SLS,SR2  16                SHIFT ATRBTE INDEX TO HW 0 OF SR2
         SLD,SR1  16                SHIFT ATRBTE INDEX WITH PART#;SR1
         PSW,SR1  DOVSPD            PUSH PART # & ATRBTE INDEX INTO
*                                   OVERFLOW STACK.
*********CK%CODE  CHECK FOR PUSH/PULL ERROR
         DO       CK%CODE>=1        STACK SHOULD NEVER BE FULL; IS FULL?
           BSNF     14CK30        ->  NO - CONTINUE
           TYPE     'PART.14.3.DISPX.STACK FULL'  YES-ERR MSGE
           B        12EXIT2       >>WAIT FOR DELTA
14CK30     EQU      %
         FIN
*********CK%CODE  END
*                                   FILL DISPLAY FIELD WITH ASTERISKS
14DX5    LBAL%,R7  APEND,,,ASTC <->>APPEND AN ASTERISK TO OUTPUT BUF
         BDR,R4   14DX5         <<->IS FIELD FULL OF ASTERISKS?
         LBAL%,SR4  SPACE,1           YES-SPACE BETWEEN ATRBTES
         B        14DX2           ->OUTPUT ANOTHER ATRBTE
*
*  14.3.3 SUBROUTINE TO CALCULATE VALUE JUSTIFICATION IN FIELD
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL            EXIT
*        -----             --------            ----
*        SR2=ATRBTE INDEX  R2-R3=WORK          R4=FIELD WIDTH
*        SR3=CHAR CNT      R4-R6=PARAMS        R5=# BLANKS TO PRECEDE
*        SR4=RETURN LINK                       R6=# BLANKS TO FOLLOW
*
*
14DX20   EQU      %                 E.P. TO CALCULATE # BLANKS PRECED-
*                                   ING DISPLAY, FIELD WIDTH & # BLANKS
*                                   FOLLOWING DISPLAY.
         LW,R3    SR2           <-  GET ATRBTE INDEX
         LB,R4    AFWIDTH,R3        GET ATRBTE DISPLAY FIELD WIDTH
         LB,R2    AVJUST,R3         GET JUSTIFICATION CODE FOR DISPLAY
         BGZ      14DX21          ->RIGHT-JUSTIFY VAL WITHIN FIELD
         BLZ      14DX22          ->LEFT-JUSTIFY VAL WITHIN FIELD
*                                   CENTER VALUE IN DISPLAY FIELD
         LW,R3    R4                GET FIELD WIDTH FOR DIVIDE
         SW,R3    SR3               GET CNT OF SURPLUS SPACES;
*                                   IS THERE OVERFLOW?
         BLZ      *SR4            ->  YES-RETURN WITH CC<0?
*                                     NO-R2 ALREADY ZEROED OUT
         DW,R2    =2                DIVIDE EXCESS SPACES BY 2
         LW,R6    R3                GET # BLANKS TO FOLLOW VALUE
         AI,R6    1                 ADD SPACE BETWEEN ATRBTES
         LW,R5    R3                GET # BLANKS TO PRECEDE VALUE
         AW,R5    R2                TACK ON THE ODD BLANK, IF ANY
         B        *SR4            ->RETURN WITH CC>=0
*
14DX21   EQU      %                 RIGHT-JUSTIFY VALUE
         LW,R5    R4            <-  GET FIELD WIDTH
         SW,R5    SR3               GET SURPLUS SPACE CNT;
*                                   IS THERE OVERFLOW?
         BLZ      *SR4              ->  YES-RETURN WITH CC<0
         LI,R6    1                   NO-GET SEPARATOR BLANK TO FOLLOW
         B        *SR4            ->RETURN WITH CC>=0
*
14DX22   EQU      %                 LEFT-JUSTIFY VALUE
         LW,R6    R4            <-  GET FIELD WIDTH
         SW,R6    SR3               GET SURPLUS SPACE CNT;
*                                   IS THERE OVERFLOW?
         BLZ      *SR4            ->  YES-RETURN WITH CC<0
         AI,R6    1                   NO-ADD SPACE BETWEEN ATRBTES
         LI,R5    0                 NO BLANKS PRECEDING
         B        *SR4            ->RETURN WITH CC>=0
*
         PAGE
*
*
********************************************************************
*  14.4  'STORVAL' - STORE ATTRIBUTE VALUE/RANGE INTO PART TABLES  *
********************************************************************
*
*
*  DESCRIPTION:   'STORVAL' ACCEPTS AS ARGUMENTS A PARTITION NUMBER AND
*                 ATTRIBUTE ITEM INDEX IN TABLE 'ATERM2' AND ONE
*        OR TWO DATA WORDS DEPENDING ON WHETHER THE ATTRIBUTE IS A
*        SINGLE-VALUED ITEM (E.G. 'QUAN') OR A DOUBLEWORD (E.G. 'ACCT')
*        OR RANGE (E.G. 'TIME'). IT THEN STORES THIS RIGHT-JUSTIFIED
*        VALUE(S) IN THE APPROPRIATE PARTITION TABLE ENTRY AND SETS
*        THE PARTITION CHANGE FLAG OF THE SPECIFIED PARTITION TO SIGNAL
*        RESCHEDULING OF ALL JOBS SLATED FOR EXECUTION UNDER THE OLD
*        PARTITION DEFINITION. THIS ROUTINE IS DESIGNED AS THE SOLE
*        CODE WHICH STORES INTO THE MONITOR PARTITION TABLES. THUS,
*        ANY TABLE UPDATING PROBLEMS ARE LOCALIZED TO THIS ROUTINE.
*        THE ACTUAL DATA STORING IS IMPLEMENTED THROUGH DATADEF PROCS
*        SO THAT IN THE EVENT OF A RE-DESIGN OF PARTITION TABLES
*        ARCHITECTURE, THE BODY OF CODE DEALING WITH THE TABLES WILL
*        NOT REQUIRE CHANGE. THIS IS POSSIBLE BECAUSE ALL DATA IS
*        REFERENCED SYMBOLICALLY AND NOT SPECIFICALLY BY BIT-PATTERN
*        IN THE CODE; ONLY THE DATA ITEM DEFINITIONS NEED TO BE
*        CHANGED (SEE SECTION 5.2).
*
*
*  FUNCTION:      THE INPUT PARAMETER REGISTERS ARE NAMED BELOW. A
*                 BLOCK OF REGISTERS (R2-R5) IS USED FOR CODING THE
*        DATADEF PROCS; A PAIR OF REGISTERS (R & RU1) AND AN INDEX
*        ARE NEEDED FOR EACH STORE. THE WAY IN WHICH THE PARTITION
*        TABLES ARE CURRENTLY SET UP DOES NOT REQUIRE THE INDEX,
*        BUT IT IS SPECIFIED FOR POSSIBLE FUTURE CHANGES AS A PRE-
*        CAUTION. THE ATTRIBUTE ITEM INDEX IS USED TO INDEX INTO A
*        BRANCH VECTOR TABLE WHICH DIRECTS EXECUTION TO THE APPRO-
*        PRIATE SET OF STORES FOR THE ATTRIBUTE VALUE(S). IF THE
*        ATTRIBUTE REQUIRES A RANGE TO BE STORED OR A DOUBLEWORD
*        VALUE, TWO STORES ARE EXECUTED INTO THE LOWER AND UPPER LIMIT
*        TABLES FROM THE DATA WORDS IN THE CALLING REGISTERS.
*        ALL INTERRUPT INHIBITS ARE SET WHILE THE DATA STORES ARE TAKING
*        PLACE AND UNTIL THE APPROPRIATE PARTITION CHANGE BITS CAN BE
*        SET SO THAT A SINGLE USER ABORT CANNOT OCCUR WITHOUT THE
*        MBS BEING NOTIFIED OF THE NEW PARTITION CONFIGURATION.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL            EXIT
*        -----             --------            ----
*        R4=LOWER LIM/     R0-R1=WORK REGS     R0-R5 VOLATILE
*           SINGLE ITEM    R2=DATADEF PRINC    R6-R7,SR1-SR4,D1-D4
*        R5=UPPER LIM      R3=DATADEF INDX     PRESERVED
*        R6=PART #         R4=DATADEF PRINC
*        R7=ATRBTE ITEM    R5=DATADEF SUBORD
*           INDEX          R6=PART #
*        SR4=RETURN LINK   R7=ATRBTE ITEM INDEX
*                          SR4=RTN LINK
*
*
STORVAL,14STV1 EQU %                E.P. TO STORE PART ATRBTE VALUES IN
*                                   SYS PART TABLES.
         CLM,R7   AT2IXL        <<  DOES ATRBTE INDX LIE IN LIMS?
         BCS,9    14STV2          ->  NO-INDX INVALID; HALT. THIS
*                                   TEST SHOULD BE LEFT IN PERMANENTLY.
*                                   A WILD BRANCH ON R7 COULD CAUSE A
*                                   SOFTWARE CHECK OR CRASH BECAUSE OF
*                                   MASTER MODE AT THIS POINT; OR
*                                   WORSE YET, A WILD BRANCH WITH
*                                   INTERRUPTS DISABLED.
         CLM,R6   PART#LIM            YES-DOES PART# LIE IN LIMITS?
         BCR,9    14STV3          ->  YES-PART# & ATRBTE INDX VALID
14STV2   LCI      4             <-    NO-SAVE 4 REGS AND WORK THEM
         PSM,R0   SPD
         DISABLE                    INHIBIT ALL INTERRUPTS; INHIBIT
*                                   SINGLE-USER ABORT UNTIL VALUE(S)
*                                   STORED & PART CHANGE BIT SET.
         LI,R2    0                 GET ZERO
         :STORE,R2,R1  PCUN         ZERO OUT PL-CHG FIELD WHICH TELLS
*                                   MBS CURR USER# OF CONTROL USER
*                                   WHICH HAS LOCKED PART TBLS.
         LI,R2    :STV(PTLK,'PT.OPEN') GET PART TBLS NO-LOCK FLAG
         :STORE,R2,R1  PTLK         UNLOCK TABLES TO MBS
         ENABLE                     RESET ALL INTERRUPT INHIBITS
         SLAVE%                     RETURN TO SLAVE MODE
         TYPE     ;                 OUTPUT ERROR MESSAGE
         ' CATASTROPHIC ABORT: PART # OR ATTRIBUTE INDEX OUT OF RANGE'
         LCI      4                 RESTORE WORK REGISTERS
         PLM,R0   SPD               PULL 4 FROM PART STACK
         M:SNAP   'CONTROL',(J:JIT,CSEND:PART:TEXT+200)  DUMP PROGRAM
*******CK%CODE    REGAIN BREAK CONTROL AND WAIT FOR DELTA
         DO       CK%CODE>=1        FOR LEVELS 1 & 2 ONLY
         BAL,SR4  BREAK5          >>CHECK FOR DELAYED BREAK
           B        12EXIT2     <<->WAIT FOR DELTA
         FIN
*********CK%CODE  END
         M:XXX                    **ERROR EXIT; DUMP REGISTERS
*
14STV3   EQU      %                 INDEX CHECK PASSED; CONTINUE
         DISABLE                <-  SET INTERRUPT INHIBITS IN PSD
*ACTIONS FOR RSRCE ITEMS TREATED DIFFERENTLY
         CI,R7    #ATERM2
         BG       14RSRCE
14STVSTV EQU      %
         B        %,R7            ->ITEM INDEX=PTR TO :STORE
         B        14STVTI    2    ->TIME RANGE
         B        14STVQU    3    ->PART QUANTUM
         B        14STVLO    7    ->LOCK/UNLOCK
         B        14STVHO    8    ->HOLD/RELEASE
         B        14STVLCL   14    ->LCL
         B        14STVTRM   15    ->TRM
         B        14STVRB    16    ->RB
*
         ERROR,X'F',((%-1-14STVSTV)=#AT2SET)=0  MTNP
*
*USE ALGORITHM TO GET TO CORRECT ITEM
14RSRCE  EQU      %
         AI,R7    -#ATERM2          (R7)=RSRCE INDEX
         LW,R3    R6                GET PART# IN AN ODD REG. 3
         MI,R3    SV:RSIZ+1
         AW,R3    R7                OFFSET IN R3
         STB,R4   PLB:MIN+F,R3      STOR MIN
         STB,R5   PLB:MAX+F,R3      STORE MAX
         AI,R7    #ATERM2           RESTORE R7
         B        14STV4            GO SET PART CHG BIT IN PL:CHG
*
14STVTI  EQU      %                 STORE LOWER, UPPER TIME LIMITS
         LW,R2    R5            <-  SAVE UPPER TIME LIMIT
         :STORE,R4,R3 PTL,R6        STORE RT-JUST LOWER TIME LIMIT
         :STORE,R2,R4 PTU,R6        STORE RT-JUST UPPER TIME LIMIT
         B        14STV4          ->SET PL:CHG BIT
*
14STVQU  EQU      %                 STORE PART QUANTUM
         STW,R4   R5            <-  SET UP REGS FOR DIVIDE
         LI,R4    2                 CONVERT MSECS TO TICS (500 HZ)
         DW,R5    R4
         LW,R4    R5                GET QUANTUM IN TICS
         :STORE,R4,R3 PQUAN,R6      STORE RT-JUST QUANTUM
         ENABLE                     RESET INTERRUPT INHIBITS
         B        *SR4              >>RETURN
*
*
14STVLO  EQU      %             <-  STORE LOCK/UNLOCK FLAG
*********CK%CODE  SET-UP CHECK-CODE FOR PL:FLG IN OUTPUT REGISTER
         DO       CK%CODE=2         FOR LEVEL 2 ONLY
           LI,R2    :STV(PLOCK%C,'CODE.OK')  GET CHECK-CODE
           :STORE,R2,R5 :ITEM(PLOCK%C,(AD,R4)),:K(1)  STORE CHECK-CODE
*                                                     IN HW1.
         FIN
*********CK%CODE  END
         :STORE,R4,R3 PLOCK,R6      STORE LOCK/UNLOCK FLAG
         ENABLE                     RESET INTERRUPT INHIBITS
         B        *SR4              >>RETURN
*
14STVHO  EQU      %                 STORE HOLD/REL FLAG
         :STORE,R4,R3 PHOLD,R6  <-  STORE FLAG
         ENABLE                     RESET INTERRUPT INHIBITS
         B        *SR4              >>RETURN
*
14STVLCL EQU      %                 JOB ORIGIN AS ATTRIBUTE-LCL
         :STORE,R4,R3 PLCL,R6       STORE LCL
         ENABLE
         B        *SR4              RETURN
*
14STVTRM EQU      %                 JOB ORIGIN AS ATTRIBUTE-TRM
         :STORE,R4,R3 PTRM,R6       STORE TRM
         ENABLE
         B        *SR4              RETURN
*
14STVRB  EQU      %                 JOB ORIGIN AS ATTRIBUTE-RB
         :STORE,R4,R3 PRB,R6        STORE RB
         ENABLE
         B        *SR4              RETURN
*
14STV4   EQU      %                 ATRBTE VAL(S) STORED; CONTINUE
         LI,R3    1             <-  GET 'PART DEF ALTERED' FLAG
         SLS,R3   -1,R6             SHIFT FLAG TO PART BIT POSITION
         :POSL,R3 :RIJ(PFLAGS)      JUSTIFY FROM RT TO ITEM POSITION
         STS,R3   :AD(PFLAGS)       'OR' BIT INTO PART CHANGE HW
         ENABLE                     RESET INTERRUPT INHIBITS
         B        *SR4              >>RETURN
*
         PAGE
*
*****************************
*  15.   OTHER SUBROUTINES  *
*****************************
*
*
***************************************************************
*  15.1  'ZEROUT' - RELEASE PARTITION DEFINITION STACK PAGES  *
***************************************************************
*
*
ZEROUT,15ZE1 EQU  %                 ENTRY POINT TO ZERO PART DEF STK
         MTW,0    PDSVP         <<  HAVE PART DEF STK VIRTUAL PAGES
*                                   BEEN GOTTEN?
         BLEZ     15ZE2           ->  NO-NOTHING TO RELEASE
         M:FCP    PDSVP               YES-FREE COMMON PAGES
*********CK%CODE  CHECK OPERATION OF M:FCP LOGIC
         DO       CK%CODE>=1        WAS LAST COMMON PAGE FREED?
           BCS,8    15CK1         ->  YES-RETURN
           TYPE     'PART.15.1.ZEROUT.ALL COMMON PAGES NOT RELEASED'
*                                     NO-OUTPUT ERR MSGE
           B        12EXIT2       ->WAIT FOR DELTA
15CK1      EQU      %           <-
         FIN
*********CK%CODE  END
         LI,R0    0                 ZERO COMMON DYNAMIC PAGE CNT
         STW,R0   PDSVP
         STW,R0   PDSPD             ZERO OUT BOTTOM OF STACK PTR
         STW,R0   PDSADR            ZERO ADR OF 1ST WD OF LOWEST CDP
         LI,R0    PDSZ              GET PART DEF STK SPACE CNT
         SLS,R0   16                SHIFT IN 0 WD CNT
         STW,R0   PDSPD+1           RESET P.D. STK PTR DW
15ZE2    EQU      %                 RETURN TO CALLING ROUTINE
         B        *SR4          <->>
*
         PAGE
*
*********************************************************
*  15.2  'SCAN' - INPUT COMMAND IDENTIFICATION ROUTINE  *
*********************************************************
*
*
*  DESCRIPTION:   'SCAN' ACCEPTS THE ADDRESS OF A BUFFER WITH A MULTI-
*                 FIELD COMMAND IN IT AND PERFORMS TWO SEQUENCIAL
*        FUNCTIONS: 1) IT DETERMINES THE NUMBER OF FIELDS (UP TO AN
*        ASSEMBLY MAXIMUM) IN THE COMMAND, THEIR BYTE LENGTHS AND
*        STARTING BYTE ADDRESSED; AND 2) IT IDENTIFIES THE COMMAND AND,
*        IF IT IS LEGAL, BRANCHES TO THE APPROPRIATE COMMAND
*        HANDLER. IF THE COMMAND IS NOT LEGAL, THE ERROR MESSAGE
*        ' ILLEGAL COMMAND' IS OUTPUT TO THE USER.
*
*
*  FUNCTION:      FOUR TABLES PLAY SIGNIFICANT ROLES IN THE FUNCTION
*                 OF THE SCAN ROUTINE. THESE ARE:
*
*        1.       CFPTRS - 'COMMAND FIELD POINTERS', CONTAINS THE
*                 BEGINNING BYTE ADDRESS OF EACH COMMAND FIELD AND
*                 A BYTE LENGTH FOR EACH FIELD.
*        2.       CMDTBL - 'COMMAND TABLE', CONTAINS A LIST OF BYTE,
*                 HALFWORD, OR WORD ENTRIES (DEPENDING ON AN ASSEMBLY
*                 PARAMETER) USED TO IDENTIFY EACH COMMAND RECOGNIZED
*                 BY 'PART'. EACH ENTRY IS THE FIRST BYTE, HALFWORD,
*                 OR WORD OF THE ACTUAL COMMAND.
*        3.       FLDTBL - 'FIELDS TABLE', IS PARALLEL TO CMDTBL AND
*                 CONTAINS A NUMBER REPRESENTING THE NUMBER OF FIELDS
*                 REQUIRED BY THE COMMAND FOR THAT ENTRY.
*        4.       BRTBL - 'BRANCH TABLE', IS PARALLEL TO CMDTBL AND
*                 CONTAINS THE ENTRY POINT ADDRESS OF THE HANDLER
*                 CORRESPONDING TO THAT COMMAND ENTRY.
*
         PAGE
*
*        CMDTBL, FLDTBL, AND BRTBL ARE ASSEMBLED AND CFPTRS IS BUILT
*        BY 'SCAN'.
*
*                 THE FIRST SIGNIFICANT CHARACTER IN THE COMMAND FIELD
*        IS FOUND BY 'SCAN' AND ITS BYTE ADDRESS BECOMES THE BEGINNING
*        ADDRESS OF THE FIRST COMMAND FIELD. THIS ADDRESS IS STORED IN
*        ENTRY 1 OF CFPTRS. A SEARCH IS MADE TO DETERMINE THE NEXT
*        BLANK OR DELIMITER IN THE STRING; THIS DELIMITS THE FIRST
*        COMMAND FIELD. WHEN IT IS FOUND, THE LENGTH OF THE FIRST
*        COMMAND FIELD IS CALCULATED AND STORED IN ENTRY 1 OF CFPTRS
*        ALSO. THIS PROCESS IS REPEATED FOR EACH COMMAND FIELD UNTIL
*        EITHER THE STRING IS ENTIRELY SEARCHED OR THE MAXIMUM NUMBER
*        OF FIELDS REQUIRED BY ANY COMMAND IS EQUALED.
*
*                 COMMAND IDENTIFICATION IS EFFECTED BY FIRST COMPARING
*        THE NUMBER OF FIELDS IN THE ACTUAL COMMAND WITH THE NUMBER
*        REQUIRED BY EACH SUCCESSIVE ENTRY IN THE FIELDS TABLE. WHEN
*        THE NUMBER OF FIELDS INPUT IS WITHIN THE REQUIRED FIELDS RANGE,
*        A COMPARISON IS MADE BETWEEN THE FIRST X (WHERE X=1,2,OR 4)
*        BYTES OF THE 1ST COMMAND FIELD AND THE ENTRIES IN THE
*        COMMAND KEY-WORD TABLE, CMDTBL. IF THIS COMPARISON IS GOOD
*        A BRANCH IS MADE THROUGH THE PARALLEL HANDLER ADDRESS IN
*        BRTBL. IF EITHER COMPARISON IS NEGATIVE, A NEW FIELD ENTRY
*        IS TRIED UNTIL THE ENTRIES ARE EXHAUSTED.
*
*                 IF THE COMMAND IDENTIFIED WAS 'N ATTRIBUTE' OR
*        'N ATTRIBUTE=NNN', A RETURN IS MADE TO SCAN TO DETERMINE
*        WHICH COMMAND WAS ISSUED, AND THEN A BRANCH IS MADE TO THE
*        APPROPRIATE ROUTINE.
*
*                 WORD 0 OF 'CFPTRS' CONTAINS THE NUMBER OF FIELDS
*        SCANNED (BYTE 0) AND THE INDEX TO THE LAST CHARACTER OF THE
*        COMMAND INPUT LINE (BYTE 3).
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY             INTERNAL           EXIT
*        -----             --------           ----
*        SR1=LST CHAR INDX R0-R2=WORK         R0-R7=VOLATILE
*        SR2=CMD BUF BA    R4-R5=MBS,CBS REGS SR3-SR4,D1-D4 PRESERVED
*        SR4=RETURN LINK   R6=ACTUAL FLD CNT  (R3=BYTE INDEX TO '='
*                          R7=SCAN TBL ENTRY  FOR 'SET' CMD)
*                          SR1=LST CMD CHAR
*                          SR2=CMD BUF BYTE ADR
*                          SR4='MAIN' LINK
*
*
*  15.2.1  FIELD SCANNER - DETERMINE A BYTE ADDRESS AND BYTE COUNT FOR
*                          EACH SUB-FIELD IN THE COMMAND UP TO END OF
*                          COMMAND OR MAXIMUM REQUIRED # FIELDS FOR ANY
*                          COMMAND.
*
SCAN,15SCAN1 EQU  %                 ENTRY POINT FOR CMD FLDS SCAN
         LI,R1    0             <<  ZERO OUT CMD FLD PTR TBL
         LI,R2    #SCANFLD          GET MAX # SCAN FIELDS
         STW,R1   CFPTRS,R2     <-
         BDR,R2   %-1             ->
         STW,SR1  CFPTRS            SAVE INDEX TO LAST CHAR
*                                   R1=0, INITIAL BYTE INDEX
         LI,R2    C' '              GET BLANK BYTE;FIND 1ST NON-BLANK
15SCAN2  CB,R2    *SR2,R1       <-  IS BYTE A BLANK OR DELIM?
         BL       15SCAN3         ->  NO-FOUND 1ST NON-BLNK CHAR
         BG       15SCN11         ->  YES-RETURN;DELIMITER
         AI,R1    1                 INCREMENT CHAR PTR
         B        15SCAN2         ->TRY NXT BYTE,'READSI' SAW GOODUN
15SCAN3  EQU      %                 (R1)=INDEX TO 1ST GOOD CMD CHAR
         ANLZ,R3  15SCAN2           GET BA OF THIS CHAR
*********CK%CODE  CHECK ANLZ INSTRUCTION FOR CORRECT ADR-TYPE
         DO       CK%CODE=2         DO ONLY FOR LEV 2
           BCR,13   15CK5         ->1101==>BA, OK
           TYPE     'PART.15.SCAN.ANLZ NOT FUNCTIONING'  ERROR RTN
           B        12EXIT2         WAIT FOR DELTA
15CK5      EQU      %           <-
         FIN
*********CK%CODE  END
         STW,R3   CFPTRS+1          STORE BA OF 1ST CHAR OF 1ST FIELD
*                                   IN 1ST ENTRY IN CFPTRS TBL
         SLS,SR2  2                 WA(CMD BUF)-->BA(CMD BUF)
         AW,SR1   SR2               GET BYTE ADR OF LAST CHAR IN CMD
*                                   FIND 1ST & LST BYTE IN EACH CMD FLD;
*                                   FIND ACTUAL # FLDS IN INPT LINE
         LI,R6    1                 START ACTUAL FLD CNT WITH 1
         LI,R2    X'40'             GET UPPER DELIMITER CODE
15SCAN4  EQU      %                 FIELD SCAN LOOP
         CW,R3    SR1               PTR>BA(LAST BYTE OF CMD)?
         BG       15SCAN7         ->  YES-ALL DONE WITH CMD FLD SCAN
         AI,R3    1                 INCREMENT FIELD BYTE PTR
         CB,R2    0,R3                NO-IS CURRENT BYTE BLANK OR DLIM?
         BL       15SCAN4       <-    YES-TRY NXT BYTE
         LW,R1    R3                  NO-GET  END OF FLD BYTE ADR
15SCANLZ SW,R3    CFPTRS,R6         GET BYTE LENGTH OF FLD
*********CK%CODE  CONFIRM FIELD LENGTH CANNOT EXCEED 255 BYTES
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           CI,R3    255             IS BYTE CNT >255
           BLE      15CK6         ->  NO-CONTINUE
           TYPE     'PART.15.SCAN.FIELD BYTE COUNT>255' YES-ERROR
           B        12EXIT2       >>EXIT AND WAIT FOR DELTA
15CK6      EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         ANLZ,R0  15SCANLZ          GET WA OF CURRENT FLD PTR TBL ENTRY
         STB,R3   *R0               STORE FIELD BYTE SIZE
         CI,R6    #SCANFLD          IS THIS LAST FLD REQUIRED?
*                                   # SCANFLD=MAX # FIELDS REQUIRED BY
*                                   ANY COMMAND.
         BE       15SCAN8         ->  YES-DETERMINE COMMAND
*********CK%CODE  CHECK PROGRAM LOGIC
         DO       CK%CODE>=2        FOR LEVELS 1 & 2
           BL       15CK7         ->ACTUAL FLDS<MAX FLDS - O.K.
           TYPE     'PART.15.SCAN.# ACTUAL COMMAND FIELDS SCANNED>MAX'
           B        12EXIT2       >>ERROR EXIT
15CK7      EQU      %           <-
         FIN
*********CK%CODE  END
         AI,R6    1                   NO-DELINEATE NXT FLD
15SCAN5  AI,R1    1             <-  INCREMENT TO NXT CMD BUF BYT
         CW,R1    SR1               CURRENT BA>BA(LST CMD BYT)?
         BG       15SCAN6         ->  YES-TERMINATE CMD FLD SCAN
         CB,R2    0,R1                NO-IS BYT BLANK OR DELIMITER?
         BGE      15SCAN5         ->  YES-FIND NXT NON-BLANK BYT
*                                   ACCEPT A NON-BLANK DELIMITER HERE;
*                                   1ST FIELD MAY HAVE BEEN VALID AND
*                                   ONLY ONE REQUIRED.
         LW,R3    R1                  NO-GET BA OF CURRENT CHAR
         STW,R3   CFPTRS,R6         STORE IN CFPTRS TBL FOR THIS FLD
         B        15SCAN4         ->FIND LST BYT ADR THIS FLD
15SCAN6  EQU      %             <-  EXIT FROM MAIN SCAN LOOP
         AI,R6    -1                DECREMENT ACTUAL FIELD CNT -
*                                   SCAN TERMINATED BEFORE FLD FOUND
         B        15SCAN8         ->ENTER CMD SEARCH
15SCAN7  EQU      %             <-  EXIT FROM MAIN SCAN LOOP
         SW,R3    CFPTRS,R6         GET BYT LENGTH OF FLD
*********CK%CODE  CONFIRM FIELD LENGTH CANNOT EXCEED 255 BYTES
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           CI,R3    255             IS BYTE CNT >255
           BLE      15CK8         ->  NO-CONTINUE
           TYPE     'PART.15.SCAN.FIELD BYTE COUNT>255' YES-ERROR
           B        12EXIT2       >>EXIT AND WAIT FOR DELTA
15CK8      EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         ANLZ,R0  15SCANLZ          GET WA OF CURRENT FLD PTR TBL ENTRY
         STB,R3   *R0               STORE FIELD BYTE SIZE
*
*  15.2.2  COMMAND INTERPRETER
*
*                                   CFPTRS NOW CONTAINS A BEGINNING BYT
*                                   ADR AND BYT SZ FOR ALL CMD FLDS
*                                   SCANNED.(R6)=# CMD FLDS INTERPRETED.
15SCAN8  EQU      %                 E.P. FOR INTERPRETER
         STB,R6   CFPTRS        <-  STORE ACTUAL # FIELDS SCANNED
         CLM,SR4  PMPLIMS           WAS SCAN CALLED BY ROUTINE WITHIN
*                                   'PART' MODULE PROCEDURE LIMITS?
         BCS,9    *SR4            >>  NO-RETURN TO CALLING ROUTINE
*                                     YES-IDENTIFY SUB-CMD BY LOCAL TBL
         LW,R5    CFPTRS+1          GET DEST ADR FOR CMD COMPARE
         LI,R1    CMDBS             GET # BYTES/CMD TBL ENTRY
         LI,R4    BA(CMDTBL)+(#SCANCMD*CMDBS)  CALCULATE BA(1ST BYTE
*                                              OF LAST CMD IN TABLE).
         LI,R7    #SCANCMD          GET # ENTRIES IN CMD TBL
15SCAN9  EQU      %                 ENTRY POINT FOR CMD INTERPRETER
         LB,R3    FLDTBL,R7     <-  GET # FLDS REQUIRED THIS CMD
         CI,R3    0                 ANY # FLDS PERMITTED?
         BE       15SCN9B         ->  YES-DON'T COMPARE ACTUAL # FLDS
         CI,R3    15                  NO-IS RANGE OF FLDS IMPLIED?
         BG       %+3             ->  YES-BITS 28-31=UPPER FLD LIMIT
*                                     BITS 24-27=LOWER FLD LIMIT
         LW,R2    R3                  NO-MAKE UPPER,LOWER LIMS EQUAL
         B        15SCN9A         ->DO COMPARE
         LI,R2    0             <-  CLEAR R2
         SLD,R2   28                R3 BITS 24-27-->R2 BITS 28-31
         SCS,R3   4                 RETURN UPPER LIM TO BITS 28-31 R3
15SCN9A  CLR,R2   R6            <-  DOES FLD CNT LIE WITHIN FLD LIMS?
         BCS,6    15SCN10         ->  NO-GET NXT TBL ENTRY
15SCN9B  STB,R1   R5            <-    YES-STORE CBS BYT CNT IN RU1
*                                   SRC ADR=FLDTBL+1;INCRMNTD BY CBS
         CBS,R4   0                 CMD KEYWD=ACTUAL CMD BYTES?
         BNE      15SCN10         ->  NO-DECRMT DEST ADR BY CMD BYT SZ
         LW,R7    BRTBL,R7            YES-GET ADDRESS OF COMMAND HANDLER
         B        *R7             >>BRANCH TO APPROPRIATE HANDLER
15SCN10  EQU      %     GET NXT SET OF TBL ENTRIES
         AI,R4    -CMDBS            DECREMENT DEST ADR BY CMD BYTE SIZE
         BDR,R7   15SCAN9         ->DECREMENT COMMAND FIELD BRANCH
*                                   VECTOR TABLE ENTRY POINTER
15SCN11  B        *SR4          <->>RETURN-COMMAND NOT IDENTIFIED
*
*  15.2.3  'SET' COMMAND IDENTIFIER
*
15SCN12  EQU      %                 DISCERN BETWEEN 'N ATTRIBUTE' AND
*                                   'N ATTRIBUTE=XX' COMMANDS.
         LW,R3    CFPTRS+2      <-  GET BASE BYT ADR OF CF(2)
         AND,R3   =X'7FFFF'         MASK OFF 19-BIT BYT ADR
         LB,R1    CFPTRS+2          GET CMD FLD LENGTH
         LI,R2    C'='              GET 'SET' CMD IDENTIFIER
15SCN13  EQU      %                 SEARCH FOR '='
         CB,R2    0,R3              IS CURRENT BYTE '='?
         BE       15SCN14         ->  YES-BA('=')FOUND
         AI,R3    1                   NO-TRY NEXT BYTE
         BDR,R1   15SCN13         ->ARE ANY CMD FLD BYTES LEFT?
         B        11ATRN1         >>  NO-CMD WAS 'N ATTRIBUTE'
15SCN14  EQU      %                 CMD WAS 'N ATRBTE=XX' (SET CMD)
         LW,D1    R3            <-  GET BA('=')
         B        11SET1          >>BRANCH TO SET WITH BA('=') IN D1
*
         PAGE
*
*********************************************
*  15.3  WARNING/ERROR MESSAGE SUBROUTINES  *
*********************************************
*
*        THESE SUBROUTINES OUTPUT AN ERROR MESSAGE AND RETURN TO THE
*        MAIN COMMAND LOOP.
*
15ERR1   EQU      %                 OUTPUT ERROR MESSAGE
         TYPE     ' NO SUCH PARTITION'  <<ERROR
         B        11MAIN1         >>RETURN TO INPUT CMD READ
*
15ERR2   EQU      %             <<  OUTPUT ERROR MSGE
         TYPE     ;
         ' PARTITION DEFINITION REQUIRES AT LEAST PRIVILEGE LEVEL C0'
         B        11MAIN1         >>RETURN TO INPUT CMD READ
*
15ERR3   EQU      %             <<  OUTPUT ERROR MSGE
         TYPE     ' NO SUCH ATTRIBUTE'
         B        11MAIN1         >>RETURN TO INPUT CMD READ
*
15ERR4   EQU      %             <<  OUTPUT ERROR MSGE
         TYPE     ' MIN VALUE>MAX VALUE'
         B        11MAIN1         >>RETURN TO INPUT CMD READ
*
         PAGE
*
******************************************************************
*  15.4  'SAP' - SEARCH FOR PREVIOUS ENTRY IN P.D. STACK & PUSH  *
******************************************************************
*
*
*  DESCRIPTION:   'SAP' ACCEPTS AS ARGUMENTS A PARTITION NUMBER,
*                 ATTRIBUTE INDEX, AND ONE OR TWO WORD VALUES DEPEN-
*        DING ON THE CLASS OF ATTRIBUTE (SINGLE-VALUED OR RANGE) AND
*        SEARCHES THE PARTITION DEFINITION STACK FOR A PREVIOUS ENTRY
*        FOR THAT PARTITION AND ATTRIBUTE. IF A PREVIOUS ENTRY IS NOT
*        FOUND, THE VALUE(S) PASSED TO THE ROUTINE ARE PUSHED INTO
*        THE PARTITION DEFINITION STACK FOLLOWED BY A WORD CONTAINING
*        THE PARTITION NUMBER, ATTRIBUTE INDEX AND NUMBER OF VALUES
*        CORRESPONDING TO THAT ATTRIBUTE. IF A PREVIOUS ENTRY HAS BEEN
*        MADE, 'SAP' STORES THE NEW VALUES OVER THE OLD ONES AND
*        RETURNS.
*
*
*  FUNCTION:      FORMAT FOR THE PARAMETER PRESENCE WORD IS AS FOLLOWS:
*                 BITS 0-3 = COUNT OF THE NUMBER OF WORDS FOLLOWING
*                            IN THE ENTRY.
*                 BYTE 1 = PARTITION NUMBER
*                 BYTE 3 = ATTRIBUTE INDEX INTO TABLE ATERM2
*
*                 FROM TOP TO BOTTOM, THE ORDER OF ENTRY OF A MULTIPLE-
*        VALUED ATTRIBUTE IS: PARAMETER PRESENCE WORD, MAXIMUM VALUE
*        (OR WORD 2 IN THE CASE OF A DOUBLEWORD), AND MINIMUM VALUE
*        (OR WORD 1 IN THE CASE OF A DOUBLEWORD).
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY            INTERNAL           EXIT
*        -----            --------           ----
*        SR1=PART#/ATRBTE R1=WORK            R0-R7,SR1-SR4,D1-D4
*            INDEX        R2=P.P. WORD       PRESERVED
*        SR2=SNGL VAL,    R3=P#/AX MASK
*            MAX VAL      R4=TOP OF STK INDX,
*        SR3=NULL,MIN VAL    PREV ENTRY P.P. WD
*        SR4=RTN LINK     R5=BOTTOM WD PREV ENTRY
*                         R7=BAL REG
*
*
SAP,15SAP1 EQU    %                 E.P. TO SEARCH FOR IDENTICAL PART#/
*                                   ATRBTE INDEX IN STACK AND OVERWRITE
*                                   OR PUSH.
         LCI      8             <<  SAVE REGS R0-R7
         PSM,R0   SPD
         LI,R5    X'7FFF'           GET SPD WD CNT MASK
         LS,R4    PDSPD+1           GET SPD WD CNT
         AI,R4    -1                CALCULATE INDX TO TOP WD OF STK
         LW,R2    SR1               GET PART#/ATRBTE INDX
         BAL,R7   15SAP20         ->WAS AN IDENTICAL PART#/ATRBTE
*                                   ENTRY FOUND?
         B        15SAP2          ->  NO-SKIP SUBSTITUTION CODE
         LW,R4    *PDSADR,R4      ->  YES-GET # VALUES PUSHED
         LC       R4                  FROM PARAMETER PRESENCE WORD.
         STM,SR2  *PDSADR,R5        STORE NEW VALUE(S) IN STK
         B        15SAP99         ->RETURN
15SAP2   EQU      %                 NO IDENTICAL ITEM IN P.D. STK
         LI,R1    3             <-  GET BYTE INDX TO ATRBTE-X
         LB,R1    SR1,R1            GET ATRBTE-X
         LB,R1    ADRFLG,R1         GET DISPLAY/RANGE CODE
         CI,R1    2                 IS IT DISPLAY ONLY?
*                                   DISPLAY ONLY?
*********CK%CODE  EXECUTION SHOULD NEVER HAVE GOTTEN THIS FAR ON DISP
         DO       CK%CODE>=1        FOR LEVELS 1 & 2 ONLY
           BLE      15CK40        ->  NO-CONTINUE
           TYPE     'PART.15.4.SAP.ATTEMPT TO PUSH DISPLAY ITEM'
           B        12EXIT2       ->WAIT FOR DELTA
15CK40     EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         BG       15SAP99         ->  YES-RETURN WITH NO PUSH
         SLS,R1   4                 RT-JUSTIFY COUNT IN NIBBLE
         STB,R1   R2                STORE IN BYTE 0 OF STK P.P.WORD
         LC       R2                GET # WORDS TO PUSH
         PSM,SR2  PDSPD             PUSH INTO PART DEF STK
         PSW,R2   PDSPD             PUSH PARAMETER PRESENCE WD ON TOP
         B        15SAP99         ->RETURN
*
15SAP20  EQU      %                 SEARCH FOR IDENTICAL ITEM
         LW,R3    =X'FF00FF'    <-  GET PART #/ATRBTE INDX MASK
15SAP21  CI,R4    0                 ARE THERE MORE ENTRIES TO BE EXAMND?
         BL       0,R7            ->  NO-RETURN
         CS,R2    *PDSADR,R4          YES-HAS A 'SET' CMD PREVIOUSLY
*                                     BEEN INPUT FOR THIS PART/ATRBTE?
         BE       15SAP22         ->  YES-CALCULATE ADRS FOR STM
         LW,R1    *PDSADR,R4          NO-GET # WDS PUSHED
         SLS,R1   -28               RT-JUST CNT
         AI,R1    1                 ADD P.P. WORD
         SW,R4    R1                CALCULATE INDX OF NXT P.P.WD
         B        15SAP21         ->TRY NXT ENTRY
15SAP22  EQU      %                 PREVIOUS ENTRY FOUND
         LW,R5    R4            <-  GET INDX OF P.P. WD
         LW,R1    *PDSADR,R4        GET # WDS PUSHED
         SLS,R1   -28               RT-JUST CNT
         SW,R5    R1                CALC INDX TO LOW WD STK ENTRY
         B        1,R7            ->RETURN
*
15SAP99  EQU      %                 COMMON EXIT POINT
         LCI      8             <-
         PLM,R0   SPD               RESTORE R0-R7
         B        *SR4            >>RETURN
*
         PAGE
*
************************************************************
*  15.5  'IDENT#' - IDENTIFY INPUT ARGUMENT AND TRANSLATE  *
************************************************************
*
*
*  DESCRIPTION:   'IDENT#' ACCEPTS AS ARGUMENTS A CFPTRS-TYPE ENTRY
*                 (I.E. BYTE 0 = FIELD BYTE COUNT, BITS 13-31 = BYTE
*        ADDRESS OF THE FIRST BYTE OF THE FILED), A MAXIMUM OF 3 ARGU-
*        MENT CLASS CODES (CONTAINED IN BYTES 1-3 OF SR2) AND A NORMAL
*        RETURN AND ERROR RETURN ADDRESS. EACH CLASS CODE REPRESNETS A
*        TYPE OF ARGUMENT WHICH THE CALLING ROUTINE WILL ACCEPT FOR
*        THAT FIELD. 'IDENT#' CYCLES THROUGH THE CLASS CODES TESTING
*        THE FIELD FOR CORRESPONDENCE. WHEN A FIELD SATISFIES THE
*        REQUIREMENT OF A CLASS CODE, IT IS TRANSLATED INTO BINARY IF
*        NECESSARY AND A NORMAL RETURN IS MADE TWITH THE CORRECT
*        CLASS CODE INDICATED. IF THE ARGUMENT FIELD CANNOT MEET THE
*        REQUIREMENTS OF ANY OF THE POSSIBLE CLASS CODES, THE ERROR
*        RETURN IS TAKEN.
*
*
*  FUNCTION:      THE FORMAT OF REGISTER SR2 IS AS FOLLOWS:
*                 BYTE 0 = NUMBER OF CODES PASSED IN REGISTER,
*                          WHERE THE RANGE IS 1-3.
*                 BYTES 1-3 = CODES
*
*                 IF THE NUMBER OF CODES PASSED IS LESS THAN 3, THE
*        COUNT AND CODES MUST BE LEFT-JUSTIFIED IN THE REGISTER.
*        ACCEPTABLE ARGUMENT CLASS CODES ARE:
*
*                 1 = SINGLE DECIMAL NUMBER
*                 2 = RANGE (2 DECIMAL NUMBERS SEPARATED BY A '-')
*                 3 = ALPHANUMERIC (AN EBCDIC STRING WITH AT
*                     LEAST 1 ALPHABETIC CHARACTER).
*                 4 = HEXADECIMAL NUMBER (EBCDIC STRING BEGINNING
*                     WITH A '.').
*                 5 = 'YES'/'NO'/'1'/'0'
*
*                 THE SUBROUTINE 'TAT#' (TEST AND TRANSLATE ARGUMENT)
*        TESTS THE FIELD FOR CORRESPONDENCE TO THE ARGUMENT CLASS
*        CODE AND, IF THEY MATCH, TRANSLATES THE FIELD , IF NECESSARY,
*        TO BINARY.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY            INTERNAL           EXIT
*        -----            --------           ----
*        SR1=CFPTRS ENTRY R1=SR2 CODE INDX   SR1=CLASS CODE OF ARG
*        SR2=CLASS CODES  R2=BA(1ST BYTE OF  SR2=VALUE 1 (MIN OR
*            & CNT           ARG FIELD)          SINGLE VALUE)
*        SR3=ERROR RTN    R3=FLD BYT CNT     SR3=VALUE 2 (MAX OR NULL)
*        SR4=LINK RTN     R4=TRANSLATED VAL  SR4=RETURN LINK
*                         R5=TRANSLATED VAL  R0-R7,SR4,D1-D4 PRESRVED
*                         R6=CURR CLASS CODE
*                         R7=BAL TO TAT#
*
*
IDENT#,15ID1 EQU  %                 E.P. TO IDENTIFY AN INPUT ARGUMENT
*                                   FIELD AND TRANSLATE IT.
         LCI      8             <<  SAVE REGS R0-R7
         PSM,R0   SPD
         LB,R1    SR2               GET # CLASS CODES;BYT0 SR2=CNT;
*                                   BYTS1-3=POSS CLASS CDS FROM ACLASS.
         LW,R2    *SR1              GET BA OF ARG
         AND,R2   =X'7FFFF'         MASK SIG BITS
         LB,R3    *SR1              GET FIELD SIZE
15ID2    EQU      %                 COMPARE THE ACTUAL FIELD WITH EACH
*                                   TENTATIVE CLASS CODE - IDENTIFY BY
*                                   ELIMINATION OF POSSIBILITIES.
         LB,R6    SR2,R1        <-  GET AN ARGUMENT CLASS CODE
         BAL,R7   TAT#            >>DOES ARGUMENT FLD SATISFY
*                                   CLASS CODE CONDITIONS?
         B        15ID3         <<->  NO-TRY ANOTHER CODE
         LW,SR2   R4            <<    YES-GET MIN VAL OR SINGLE
*                                   VALUE.
         LW,SR3   R5                GET MAX VALUE OR NULL
         LW,SR1   R6                GET VALID CLASS CODE
         LCI      8                 RESTORE REGS R0-R7
         PLM,R0   SPD
         B        *SR4            >>RETURN TO CALLING ROUTINE
*
15ID3    EQU      %                 INCONSISTENCY BETWEEN TENTATIVE
*                                   CLASS CODE AND ARG FLD.
         BDR,R1   15ID2         <-->DO CODES REMAIN TO BE TESTED?
*                                     YES-GET NEXT CODE
         LCI      8                   NO-NO CODE TENDERED MATCHED ARG
*                                     FLD CLASS.
         PLM,R0   SPD               RESTORE R0-R7
         B        *SR3            >>TAKE ERROR RETURN
*
         PAGE
*
************************************************
*  15.6  'TAT#' - TEST AND TRANSLATE ARGUMENT  *
************************************************
*
*
*  DESCRIPTION:   'TAT#' ACCEPTS AS ARGUMENTS THE BYTE ADDRESS OF
*                 THE FIELD TO BE EXAMINED, THE FIELD BYTE COUNT, AND
*        AN ARGUMENT CLASS CODE FROM TABLE 'ACLASS'. ACCORDING
*        TO THE CODE SUPPLIED, THE FIELD IS CHECKED FOR CHARACTERISTICS
*        WHICH CORRESPOND TO THAT ARGUMENT TYPE. IF THE FIELD AND
*        THE CODE CORRESPOND, THE FIELD IS TRANSLATED FROM EBCDIC
*        TO BINARY (UNLESS THE ARGUMENT TYPE IS ALPHANUMERIC) AND
*        A NORMAL RETURN IS TAKEN. OTHERWISE, NO TRANSLATION OCCURS AND
*        THE ERROR RETURN IS TAKEN.
*
*
*  FUNCTION:      THE LIST OF POSSIBLE CLASS CODES IS FOUND UNDER THE
*                 DESCRIPTION OF 'IDENT#'. THIS ROUTINE ASSUMES THAT
*        THE FIELD IS NOT PADDED WITH ANY BLANKS ALTHOUGH IN SOME
*        CASES, THEY WOULD BE HANDLED CORRECTLY.
*
*
*        NOTE1:   REGISTER USE IS AS FOLLOWS:
*
*        ENTRY            INTERNAL           EXIT
*        -----            --------           ----
*        R2=FIELD BA      R2=BA(1ST FLD BYT) R0-R3,R7,SR1-SR4,D1-D4
*        R3=BYT CNT       R3=FLD BYTE CNT    PRESERVED
*        R6=CLASS CODE    R4-R5=WORK         R4=VALUE 1
*        R7=ERROR RTN     R6=CLASS CODE      R5=VALUE 2
*        (R7)+1=ERR RTN   R7=LINK            R6=CLASS CODE
*
*
TAT#,15TA1 EQU    %                 E.P. TO TEST AN EBCDIC INPUT
*                                   ARG FLD FOR CORRESPONDENCE TO A
*                                   CLASS CODE & TRANSLATE TO BINARY.
         LCI      4             <<  SAVE R0-R3,SR1-SR4
         PSM,R0   SPD
         LCI      4
         PSM,SR1  SPD
*********CK%CODE  DETERMINE THAT ARG FLD CLASS CODE IS VALID
         DO       CK%CODE>=1        FOR LEVELS 1 & 2
           USECT    CS:PART:TEXT    USE P.T. 1 DATA CONT SECT
15CKCL     DATA     1,5             GEN CLASS CODE INCLUSIVE LIMS
           USECT    CS:PART:PROCEDURE  USE PROCEDURE CONT SECT
           CLM,R6   15CKCL          DOES CLASS CODE LIE IN RANGE?
           BCR,9    15CK60        ->  YES-PASSED CHECK
           TYPE     'PART.15.6.TAT#.CLASS CODE OUT OF RANGE' NO-
           B        12EXIT2       ->WAIT FOR DELTA
15CK60     EQU      %           <-  CONTINUE
         FIN
*********CK%CODE  END
         B        15TA2,R6        ->FUMP TO APPROPRIATE CLASS TEST
15TA2    B        15TA99      0   ->ERROR EXIT PT
         B        15TA10      1   ->DECIMAL #
         B        15TA20      2   ->RANGE
         B        15TA30      3   ->ALPHANUMERIC
         B        15TA40      4   ->HEXADECIMAL
         B        15TA50      5   ->'YES'/'NO'/'1'/'0'
*
15TA10   EQU      %                 CHECK AF FOR *DECIMAL #* CORRES-
*                                   PONDENCE.
         LW,SR1   R2            <-  GET BA(1ST BYTE OF AF)
         STB,R3   SR1               GET BYTE CNT OF AF
         LBAL%,SR4 DECINX,,R4,15TA99  >>IS AF A VALID DECIMAL?
         B        15TA98        <<->  YES-TAKE NORMAL EXIT
*
15TA20   EQU      %                 CHECK AF FOR *RANGE* CORRESPONDENCE
         LW,R5    R2            <-  GET BA(1ST BYT IN RANGE STR)
         AW,R5    R3                GET BA(BYT FOLLOWING STR)
         LI,R4    C'-'              GET RANGE IDENTIFIER
15TA21   AI,R5    -1            <-  DECREMENT COMPARE BYTE ADR
         CW,R5    R2                IS BYT COMPARE DONE?
         BL       15TA99          ->  YES-AF NOT A RANGE
         CB,R4    0,R5                NO-IS BYTE='-'?
         BNE      15TA21              NO-TRY NEXT BYTE
         SW,R5    R2                  YES-AF IS A RANGE;R5=BYT CNT
*                                     OF LOWER VAL IN RANGE.
         LW,SR1   R2                GET BA(1ST BYT OF 1ST DEC#)
         STB,R5   SR1               STORE BYT CNT OF 1ST DEC#
         LBAL%,SR4 DECINX,,R4,15TA99  >>IS 1ST DECIMAL VALID?
         AI,R5    1             <<    YES-GET BYT CNT TO '-'
         SW,R3    R5                CALCULATE BYTE CNT OF 2ND DEC#
         AW,SR1   R5                CALCULATE BA(2ND DEC#)
         STB,R3   SR1               STORE BYTE CNT
         LBAL%,SR4 DECINX,,R5,15TA99  >>IS 2ND DECIMAL VALID?
         B        15TA98        <<->  YES-TAKE NORMAL EXIT
*
15TA30   EQU      %                 CHECK AF FOR *ALPHNUMERIC* CORRES-
*                                   PONDENCE.
         CI,R3    8             <-  IS ALPHA BYTE CNT<=8?
         BG       15TA99          ->  NO-ILLEGAL ARG
         LI,R1    0                   YES-RESET ALPHBETIC CHAR HIT FLG
         LW,R5    R3                GET AF BYTE CNT
         AW,R5    R2                CALCULATE BA(BYTE AFTER AF)
15TA31   AI,R5    -1           <-  DECREMENT BA(COMPARE CHAR)
         CW,R5    R2                HAS LAST BYTE BEEN COMPARED?
         BL       15TA32          ->  YES-TEST FOR ALPHA FLAG
         LB,R4    0,R5                NO-GET BYTE FROM AF
         CLM,R4   A#RNGE            IS CHAR ALPHANUMBERIC?
         BCS,9    15TA99          ->  NO-ILLEGAL ALPHANUMERIC
         CI,R1    1                   YES-HAS ALPHABETIC CHAR BEEN
*                                     FOUND?
         BGE      15TA31          ->  YES-TRY NEXT CHAR
         CLM,R4   ARNGE               NO-IS CHAR ALPHABETIC?
         BCS,9    15TA31              NO-TRY NEXT CHAR
         LI,R1    1                   YES-SET ALPHABETIC HIT FLAG
         B        15TA31          ->TEST NEXT CHAR
15TA32   EQU      %                 CHAR STRING WAS AT LEAST NUMERIC
         CI,R1    1             <-  WAS IT ALPHNUMERIC?
         BL       15TA99          ->  NO-ILLEGAL ALPHANUMERIC
         LW,R4    =C'    '            YES-BLANK DATA RETURN REGS
         LW,R5    =C'    '
         SLS,R3   24                SHIFT BYTE CNT TO BYTE 0
         AI,R3    4*R4              GEN BA(DESTIANTION DW REGS)
         MBS,R2   0                 TRANSFER BYTE STRING TO OUT BUF
         B        15TA98          ->TAKE CLEAN EXIT
*
15TA40   EQU      %                 CHECK AF FOR *HEXADECIAML* CORRES-
*                                   PONDENCE.
         LB,R4    0,R2          <-  GET FIRST BYTE OF AF
         CI,R4    C'.'              IS IT A '.'?
         BNE      15TA99          ->  NO-ILLEGAL HEX FMT
         AI,R2    1                   YES-GET BA(1ST HEX CHAR)
         AI,R3    -1                CALCULATE # HEX DIGITS
         LW,SR1   R2                GET BA & CNT IN CORRECT FMT
         STB,R3   SR1               FOR TRANSLATION TO BIN.
         LBAL%,SR4 HEXINX,,R4,15TA99 >>IS AF VALID HEX #?
         B        15TA98        <<->  YES-TAKE NORMAL EXIT
*
15TA50   EQU      %                 CHECK AF FOR *'YES'/'NO'* CORRES-
*                                   PONDENCE OR '1'/'0' CORRESPONDENCE
         LI,R5    BA(YESC)+1    <-  GET BA('YES') IN DEST REG
         STB,R3   R5                STORE AF COUNT
         LW,R4    R2                GET AF SOURCE ADR
         CBS,R4   0                 IS AF='YES'?
         BNE      15TA51          ->  NO-TRY 'NO'
         LI,R4    :STV(PHOLD,'YES')   YES-GET 'YES' VALUE
         B        15TA98          ->TAKE NORMAL EXIT
15TA51   LI,R5    BA(NOC)+1     <-  GET BA('NO') IN DEST REG
         STB,R3   R5                STORE AF BYTE CNT
         LW,R4    R2                GET AF SOURCE ADR
         CBS,R4   0                 IS AF='NO'?
         BNE      15TA52          ->  NO-AF NOT 'YES'/'NO'
         LI,R4    :STV(PHOLD,'NO')    YES-GET 'NO' VALUE
         B        15TA98          ->TAKE NORMAL EXIT
15TA52   EQU      %                 CHECK FOR '1'/'0' SPECIFICATION
         CI,R3    1                 IS AF ONLY 1 BYTE?
         BNE      15TA99          ->  NO-AF NOT 'YES'/'NO'/'1'/'0'
         LB,R4    0,R2                YES-GET BYTE
         CI,R4    X'F1'             IS BYTE='1'?
         BNE      15TA53          ->  NO-TRY '0'
         LI,R4    1                   YES-GET A 1 VALUE
         B        15TA98          ->TAKE NORMAL EXIT
15TA53   CI,R4    X'F0'         <-  IS BYTE='0'?
         BNE      15TA99          ->  NO-AF DOESN'T CORRES TO CLASS
         LI,R4    0                   YES-GET A 0 VALUE
         B        15TA98          ->TAKE NORMAL EXIT
*
15TA98   EQU      %                 NORMAL EXIT POINT; AF IDENTIFIED
         AI,R7    1             <-  INCREMENT RETURN LINK
15TA99   EQU      %                 ERROR EXIT; NO CORRESPONDENCE
*                                   BETWEEN CLASS CODE AND AF
         LCI      4             <-
         PLM,SR1  SPD               RESTORE SR1-SR4
         LCI      4
         PLM,R0   SPD               RESTORE R0-R3
         B        *R7             >>RETURN
*
CSEND:PART:PROCEDURE EQU %          END OF PROCEDURE CONTROL SECTION
*
         PAGE
*
*******************************************
*  16.   DYNAMICALLY MODIFIED DATA CELLS  *
*******************************************
*
*
         USECT    CS:PART:DATA      BEGIN DATA SECTION
*
PEXEC    DATA     0                 PARTITION CONTROL MODULE EXECUTION
*                                   FLAG (0=NOT EXECUTING IN PART;
*                                   1=EXECUTING IN 'PART')
*
SR4LINK  DATA     0                 SR4 RETURN LINK CELL
*
PART#    DATA     0                 'DISPX' PARTITION # STORE
TEXTCADR DATA     0                 'DISPX' OUTPUT VAL DISP TEXTC ADR
OVFCNT   DATA     0                 'DISPX' OVERFLOW COUNT
AORDERX  DATA     0                 'DISPX' AORDER TABLE INDEX
PDSVP    DATA     0                 PART DEF STK VIRT PGS REQUEST CNT
*
         PAGE
*
**********************************************
*  17.   DYNAMICALLY MODIFIED DATA POINTERS  *
**********************************************
*
*
         BOUND    8                 'PART' REG BLOCK PUSH STACK
SPD      DATA     STACK-1           STACK POINTER DOUBLEWORD
         DATA,2   STSZ,0            WORD CNT; SPACE CNT
STACK    RES      STSZ              BOTTOM OF STACK
*                                   INPUT COMMAND FIELDS START
*                                   ADDRESS & BYTE COUNT
CFPTRS   DATA     0                 # CMD FLDS EXAMINED (BYTE 0)
*                                   & INDX TO LAST CHAR OF LAST CMD
*                                   (BYTE 3).
         DO1      #SCANFLD          ENTRIES FOR MAX # CMD FIELDS
           DATA     0
*
         PAGE
*
************************
*  18.   DATA BUFFERS  *
************************
*
*
*  18.1  'AORDER' - ACCESS ORDER BYTE TABLE. EACH ENTRY IN THIS TABLE
*                   IS AN INDEX INTO ATERM2, THE ATTRIBUTE ITEM NAME
*        TABLE. THUS, BY ACCESSING THE LOCATIONS OF THIS TABLE FROM 1
*        TO N, AN ORDERED LIST OF ATTRIBUTE ITEMS MAY BE OBTAINED FOR
*        BUILDING THE PARTITION ATTRIBUTES DISPLAY WITH THE 'DISPLAY N'
*        COMMAND. THIS ALLOWS THE USER TO CHOOSE WHICH ITEMS HE WISHES
*        DISPLAYED BY THIS COMMAND AS WELL AS THE ORDER IN WHICH THEY
*        WILL BE DISPLAYED.
*
*        NOTE:    AT THE OUTSET, NO FACILITY WILL BE PROVIDED TO 'ADD'
*                 OR 'DROP' PARTITION ATTRIBUTES FROM THE DISPLAY LIST.
*                 A STANDARD, ORDERED LIST IS GENERATED IN LIEU OF THIS
*                 CAPABILITY TO DRIVE THE PRINT MECHANISM IN THE SAME
*                 MANNER AS FOR THE FULL-BLOWN CAPABILITY.
*                 EVEN THOUGH THE 'ADD'/'DROP' CAPABILITY IS PRO-
*                 VIDED, IT ISN'T DOCUMENTED SO THE STANDARD LIST
*                 IS STILL SUPPLIED WITH THE CODE.
*
*
         BOUND    4
AORDER   EQU      %                 LIE A LITTLE TO SETUP DFT ORDER
         DATA,1   1,2,3,4           TIME,QUAN,LOCK,HOLD
         DATA,1   5,6               CURR,TOL
         DATA,1   10,11,12,13       RSRCE1,RSRCE2,RSRCE3,RSRCE4
         DATA,1   0                 SIGNAL END
         DATA,1   0,0,0             ACCT,USER#,SYSID
         DO       RSRCE-4-1         ALLOCATE SPACE FOR RSRCE
         DATA,1   0
         FIN
         PAGE
*
*  18.2  OTHER STACKS, BUFFERS & TABLES
*
         BOUND    8                 EBCDIC OUTPUT BUFFER
GETDBUF  RES,1    GBSZ              GENERATE GETDATA BUFFER
*
         DISP     PDSZ              PARTITION DEFINITION STACK SZ
         BOUND    8
*                                   SPD FOR NEW ATRBTE VAL SET STACK
PDSPD    DATA     0                 TOP OF STACK PTR STORED DYNAMICALLY
*                                   AFTER LOW PAGE ADR RETURNED ON
*                                   'GET LIMITS'.
         DATA,2   PDSZ,0            SPACE CNT=STACK SZ;WD CNT=0
PDSADR   DATA     0                 ADR OF 1ST WD OF STACK;DYNAM STORED
*                                   PARTITION DEFINITION STACK USED
*                                   IN 'SET' & 'STORE'.
*
         BOUND    8
DOVSPD   DATA     DOVSTK-1          SPD FOR DISPLAY OVERFLOW STACK
         DATA,2   DOVSZ,0           SPACE CNT=STACK SZ;WD CNT=0
DOVSTK   RES      DOVSZ             DISPLAY OVERFLOW STACK SET IN DISPX
*
CSEND:PART:DATA END                 END OF DATA SECTION

