         PCC      0
         TITLE    'CONTROL MODULE MOS'
*
*        0. PREAMBLE
*
*
*        PROGRAM NAME: 'MOS' [CONTROL MODULE MOS]
*
*        PURPOSE:      SERVES AS AN ADJUNCT TO 'CONTROL' BY
*                 DISPLAYING AND CHANGING MOS MEMORY THRESHOLD,
*                 ERROR, AND SINGLE-BIT CORRECTABLE ERROR (RCE)
*                 FLIP-FLOPS VALUES. THE SPECIFIC COMMANDS
*                 RECOGNIZED BY 'MOS' AND THE FUNCTIONS
*                 ASSOCIATED WITH THEM APPEAR BELOW.
*
* COMMAND         FUNCTION
* =======       ========
* END    E        RETURN TO CONMAIN
* *      *        COMMENT
* T[RESHOLD] {ALL} =NNN [,NO]
*            {U  }
*            {B  }
*            {U,B} SET THE THRESHOLD VALUE ON THE SELECTED UNIT,
*                 BANK, OR UNIT/BANK, AND SET OR RESET THE CURRENT
*                 COUNT ON THE SELECTED BANKS.
*
* C[URRENT]  {ALL}
*            {B  }
*            {U  }
*            {U,B} DISPLAY THE CURRENT ERROR COUNT AND THRESHOLD
*                 VALUES FOR THE SELECTED BANK(S) AND UNIT(S).
*
*
* R[CE] {ON } [ALL]
*       {OFF} [,B  ]
*             [,U  ]
*             [,U,B]  SET OR RESET THE CURRENT STATE OF THE
*                 REPORT CORRECTABLE ERRORS ON THE SELECTED
*                 UNIT(S) OR BANK(S).
*
*        NOTE: THE UNIT AND BANK, THEN SPECIFIED TOGETHER, MUST
*                 BE GIVEN IN THE ORDER INDICATED.
*
*        NOTE: THE UNIT NUMBER WILL BE ASSUMED AS ZERO IF NO
*                 UNIT NUMBER IS SPECIFIED WITH BANK
*
*        NOTE: IF NO BANK NUMBER IS SPECIFIED WITH UNIT, BANK
*                 NUMBERS ARE ASSUMED TO BE A THROUGH D.
*
*        NOTE: IF THE USER ASKS FOR A NON-EXISTENT BANK OR UNIT
*                 IN ANY COMMAND, THE ENTIRE ACTION IS ABORTED.
*
* THE FORMAT OF THE RETURNED RESPONSE TO A CORRECT ACTION
* GENERATING COMMAND AS STATED ABOVE, YIELDS A LINE OF THE
* FOLLOWING FORMAT FOR THE AFFECTED (OR SELECTED) BANKS
*
* UNIT 0  BANK A  COUNT=NNN  THRESHOLD=NNN  RCE=ON
*      1       B                                OFF
*              C
*              D
*
*                                   AUTHOR: J.L.JOSEPH, HONEYWELL LADC
*                                   DATE:   07/22/78
*
*
         PAGE
*
*        1.  ASSEMBLY ENVIRONMENT
*
         SPACE
CS:MOS:PROC CSECT 1
CS:MOS:DATA CSECT 0
CS:MOS:TEXT CSECT 1
         SPACE    3
         SYSTEM   SIG7FDP
         SYSTEM   BPM
:ST%TEXT%SWITCH SET 1               * GENERATE TEXT SWITCH
         SYSTEM   DATADEF
         SPACE    3
*
*        2. REGISTER ASSIGNMENTS
*
         SPACE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*
*        2. ASSEMBLY TIME PROCS
*
         SPACE    3
*
*
*********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:MOS: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:MOS:TEXT  SET %               BUMP END OF TEXT POINTER FOR DUMP
         USECT    CS:MOS:PROC       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 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:MOS: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:MOS:PROC       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
*
*
*********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
*
*        4. EXTERNAL REFERENCES AND DEFINITIONS
*
         SPACE    3
         DEF      MOS
         SPACE    2
*
*        4.1 SYSTEM REFERENCES
*
         SPACE
         SREF     MOSTAB            * MOS MEMORY DATA (ERROR & THRESH)
         SREF     MOS:ADDR          * INITIAL'S MOS ADDRESSES
         SPACE    3
*
*        4.2 INTERNAL (CONTROL) REFERENCES
*
         SPACE
         REF      COMMAND
         REF      CBUFWSZ
         REF      CBUFBSZ           * COMMAND BUFFER BYTE SIZE
         REF      SPDADR            * STACK POINTER DW
         REF      SPD               * EXTERNAL (MAIN) STACK
         REF      OBUFSZ
         REF      SEND
         REF      READSI
         REF      TYPEDO            * M:TYPE ON M:DO ROUTINE
         REF      BOUTX             * M:TYPE ON M:LO
         SPACE    5
         REF      M:LO
         REF      M:DO
         REF      M:SI
         REF      J:JIT
         REF      JB:PRIV           * USERS PRIVILEGE
         PAGE
*
*        5.       INTERNAL DATA SECTIONS
*
         SPACE    2
         USECT    CS:MOS:DATA       * CHANGE TO DATA SECTION
         SPACE    2
MAXBNKS  EQU      8                 * MAX # OF MOS MEM BANKS PER DUAL UNIT SYSTE
MEXEC    DATA     0                 * RE-ENTRANCY FLAG
         SPACE
*
*        GENERATE COMMAND COMPARISON TABLE AND TRANSFER VECTOR
*
         SPACE
CMDTBL,FLDTBL,BRTBL ;
         SCANTBL%,#SCANCMD,#SCANFLD ;
                  ('*',0,COMMENT),;
                  ('T',2,THRESHOLD),;
                  ('C',2,CURRENT),;
                  ('R',2,RCE),;
                  ('E',1,END)
DELIMS   TEXTC    '=,'
         SPACE
#CFAREA  EQU      15                * MAKE EXTRA SPACE IN CFPTRS
         SPACE
         SPACE
CFPNTRS  EQU      %
         DATA     0
         DO1      #CFAREA+5         * MAKE MAX # OF ENTRIES WORTH
         DATA     0
         SPACE    2
BIGTABL  EQU      %                 * START OF INTERNAL 'TABLES'
         SPACE
UBTABLE  EQU      %
         DO1      MAXBNKS           * MAKE ONE ENTRY PER BANK
         DATA     0
#THRESH  EQU      %
         DATA     0
#COUNT   EQU      %
         DATA     0
RCEON%   EQU      %
         DATA     0                 * DID COMMAND SPECIFY RCE ON/OFF?
ALL%     EQU      %
         DATA     0                 * DID COMMAND SPECIFY ALL?
BANK#    EQU      %
         DATA     0                 * SPECIFIED BANK
UNIT#    EQU      %
         DATA     0                 * SPECIFIED UNIT
NUM#     EQU      %
         DATA     0                 * NUMBER OF UNIT/BANK FIELDS
UNIT%    EQU      %
         DATA     0                 * WAS UNIT SPECIFIED?
BANK%    EQU      %
         DATA     0                 * WAS BANK SPECIFIED
NUMBANKS% EQU     %
         DATA     0                 * NUMBER OF BANKS TO PROCESS
THRSH%NEW EQU     %
         DATA     0
NO%      EQU      %
         DATA     0
THRSHTAB EQU      %
         DO1      MAXBNKS
         DATA     0
END%TABLES EQU    %
         SPACE
#ENTRIES EQU      END%TABLES-BIGTABL * # OF WDS IN THIS CONTIG ARRAY
         SPACE    3
MOS:LINE TEXTC 'UNIT X  BANK X  COUNT=XXX  THRESHOLD=XXX   RCE=XXXX'
         SPACE    2
TXT:UNIT# EQU     6                 * X FOR UNIT #
TXT:BANK# EQU     14                * X FOR BANK #
TXT:COUNT# EQU    23                * 1ST X FOR COUNT
TXT:THRS# EQU     38                * 1ST X FOR THRSHOLD
TXT:RCE# EQU      12                * WD DISP OF RCE
         PAGE
*
*        CONSTANT DATA
*
*
*
         SPACE
         USECT    CS:MOS:TEXT
#COMMA   DATA,1   ',',0,0,0
##UNITS  DATA,1   '0',0,0,0
         DATA,1   '1',0,0,0
##BANKS  DATA,1   'A',0,0,0
         DATA,1   'B',0,0,0
         DATA,1   'C',0,0,0
         DATA,1   'D',0,0,0
#ALL     DATA,1   'A','L','L',0     * ALL?
#OFF     DATA,1   'O','F','F',0     * OFF?
#ON      DATA,1   'O','N',0,0       * ON?
#UNITS   DATA,1   '0','1',0,0       * BYTE TABL FOR UNIT TEXT
#BANKS   DATA,1   'A','B','C','D'   *       SAME FOR BANK TEXT
#ONOFF   TEXT     'ON'
         TEXT     'OFF'
#NO      DATA,1   'N','O',0,0       * 'NO'?
XFFFF    DATA     X'FFFF'           * HALFORD MASK
Y8BIT    DATA     X'80000000'       * RCERESET FLAG BIT (0)
X3FFFF   DATA     X'3FFFF'          * HEX BYTE MASK
X7FFFFFFF DATA    X'7FFFFFFF'       * 31 BIT MASK
         BOUND    8
MBSTHRESH EQU     %
         DATA     BA(#THRESH)+1
         DATA     X'03000000'+BA(MOS:LINE)+TXT:THRS#
MBSCOUNT EQU      %
         DATA     BA(#COUNT)+1
         DATA     X'03000000'+BA(MOS:LINE)+TXT:COUNT#
         SPACE
DEC%DIGS TEXT     '0123456789'      * DECIMAL DIGITS
         SPACE
CVSTAB   EQU      %
         DATA     0,0,0,0
         DATA     8000,4000,2000,1000
         DATA     0,0,0,0
         DATA     800,400,200,100
         DATA     0,0,0,0
         DATA     80,40,20,10
         DATA     0,0,0,0
         DATA     8,4,2,1
*
*        6. INTERNAL EQUS AND ASSIGNMENTS
*
         SPACE    2
CK%CODE  SET      0
CFAREA   EQU      CFPNTRS+5         * BEGINNING OF SPECIAL HASH TABLE
         PAGE
*
*        10. ENTRY POINT MOS ... DRIVER ROUTINE FOR ALL
*
         SPACE    3
         USECT    CS:MOS:PROC
         SPACE
MOS      EQU      %
MOSENT   EQU      %
10ENT1   EQU      %
         SPACE
         MTW,0    MEXEC             * SEE IF WE WERE IN 'MOS' & HAVE
*                                   BEEN RE-ENTERED
         BEZ      10ENT2            * GUESS NOT...FORGE AHEAD
*
*        COME HERE IF WE'RE GOING TO COMPLAIN AND RETURN TO
*        CONMAIN
         SPACE
,MOSERR1 TYPE     ' MOS CONTROL ACTIVE '
*
,MOSERR2 TYPE     ' INPUT ''QUIT'', ''PROCEED'', OR ''CONTROL COMMAND'''
*
         B        12EXIT3           * GO BACK TO CONMAIN, WO RESETTING
         SPACE    3
10ENT2   EQU      %
         LCI      1                 * FOR 'CLEAN ENTRY'
         STCF     MEXEC             * SAVE RE-ENT FLAG
*
         LCI      0                 * SAVE ALL GENERAL REGISTERS
         PSM,R0   SPD               * IN GENERAL STACK
*
         LI,R1    MOSTAB            * WE MUST BE CAUTIOUS, AS SOMETIMES
         BNEZ     10ENT15           * WE MAY NOT HAVE MOS MEMORY
*
,MOSERR3 TYPE     ' *** THIS SYSTEM NOT GENN''ED FOR MOS MEMORY'
*
         B        12EXIT1           * EXIT BY PULLING REGS, AND RESETTING
*
*
         SPACE    3
10ENT15  EQU      %
         SPACE    2
         M:CVM    MOS:ADDR,MOS:ADDR+X'10000'   * GET DATA PAGE
         M:CVM    MOSTAB,MOSTAB+X'10000'       * THAT MOS NEEDS
         M:CVM    MOSTAB+MAXBNKS,MOSTAB+MAXBNKS+X'10000' * END OF TBL
         M:CVM    MOS:ADDR+MAXBNKS,MOS:ADDR+MAXBNKS+X'10000' *
         SPACE    2
*        B        11MAIN1           * GO TO MAIN LOGIC
         PAGE
*
*        11. MAIN ROUTINE FOR DRIVING MOS CONTROL LOGIC
*
*        INTERNAL REGISTER USAGE.....
*                 R0-R2             WORK/SCRATCH
*                 R7                BAL
*                 SR1               INDEX TO LAST INPUT CHAR
*                 SR2               INPUT BUFFER ADDRESS
*                 SR4               READSI LINK
*
*        EXIT REGISTER USAGE .....
*                 SR1               LAST CHARACTER INDEX
*                 SR2               CMD BUFR ADDRESS
*                 SR4               RETURN LINK
*                 R0-R2             SCRATCH,VOLATILE
*                 R3-R6,D1-D4       PRESERVED
*
*
         SPACE    2
MOSMAIN  EQU      %
11MAIN1  EQU      %
11MAIN2  EQU      %
11MAIN3  EQU      %
         LW,R0    =C'    '          * BLANK CMD BUFFER
         LI,R2    CBUFWSZ           ****
         STW,R0   COMMAND-1,R2      ****
         BDR,R2   %-1               ****
         SPACE
         LI,SR1   CBUFBSZ           * COMMAND BUFFER BYTE SIZE
         SPACE
         LI,SR2   COMMAND           * COMMAND BUFFER ADDRESS
         LI,SR3   DELIMS            * DELIMITERS  (,=)
         SPACE
         BAL,SR4  READSI            * GET A COMMAND FROM M:SI
         SPACE
         CI,SR1   0                 * IF ONLY ACTIVATION,
         BL       11MAIN3           * TRY AGAIN
         SPACE
         PSW,SR1  *SPDADR           * SAVE INDEX TO LAST CHARACTER
         SPACE
         M:DEVICE M:SI,(CORRES,M:LO) * (SI=LO)?
         CI,SR1   1                 * IF = 1 THEN TRUE
         BE       11MAIN4           * ***
         SPACE
         LW,SR4   R1                * PREPARE TO ECHO THE COMMAND ON
         AI,SR4   1                 * (BYTE CNT) THE APPROPRIATE DEV.
         SPACE
         LBAL%,R7 BOUTX,,1,BA(COMMAND) * OUTPUT ON LO
         SPACE    3
11MAIN4  EQU      %
         PLW,SR1  *SPDADR           * RESTORE INDEX TO LAST CHAR READ
         LI,SR2   COMMAND           * AND ADDRESS OF COMMAND BUFFER
         BAL,SR4  15SCAN1           * GO SCAN THE INPUT
*                                   * IF VALID, WE WILL ACT ON THE INPUT
*                                   * AND EXECUTE ACCORDINGLY, RETURNING
*                                   * TO 11MAIN1 (ABOVE) IF WE ERROR
*                                   * (I.E., DON'T FIGURE IT OUT) RETURN
*                                   * TO BAL+1
         SPACE
         TYPE     'ILLEGAL COMMAND' * ERROR MSG
         B        11MAIN2           * BACK UP TOP
         PAGE
*
*        12. EXIT (RETURN TO CONMAIN) LOGIC
*
         SPACE    2
12EXIT   EQU      %
EXIT     EQU      %
12EXIT1  EQU      %
         LCI      0
         STCF     MEXEC             * CLEAR RE-ENTRANCY FLAG
         PLM,R0   SPD               * GET REGS BACK
         SPACE
12EXIT2  EQU      %
12EXIT3  EQU      %
         B        *D4               * COMMAND LOOP IN CONMAIN
         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.       CFPNTRS - '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 CFPNTRS 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 CFPNTRS. 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 CFPNTRS
*        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.
*
*                 WORD 0 OF 'CFPNTRS' 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   CFPNTRS,R2    <-
         BDR,R2   %-1             ->
         STW,SR1  CFPNTRS           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   CFPNTRS+1         STORE BA OF 1ST CHAR OF 1ST FIELD
*                                   IN 1ST ENTRY IN CFPNTRS 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    CFPNTRS,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   CFPNTRS,R6        STORE IN CFPNTRS 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    CFPNTRS,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
         PAGE
*
*  15.2.2  COMMAND INTERPRETER
*
*                                   CFPNTRS 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   CFPNTRS       <-  STORE ACTUAL # FIELDS SCANNED
         LW,R5    CFPNTRS+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
         PAGE
*
********************************************************
*        16. COMMAND PROCESSORS
********************************************************
*
*        WHEN SECTION 15 DETERMINES THAT OUR INPUT COMMAND WAS
*        A VALID ONE, IT BRANCHES TO A ROUTINE IN THIS SECTION
*
*        EACH ROUTINE HAS SLIGHTLY DIFFERENT FUNCTIONING, BUT
*        THE BASIC RULES ARE:
*        1) CLEAR THE TABLES
*        2) CHECK FOR SUFFICIENT PRIVILEGE
*        3) DRIVE THRU SYNTAX SCAN  AND  CHECK FOR REQUIRED ITEMS
*        4) SET UP TABLES BASED OR SYNTAX SCAN RESULTS
*        5) PROCESS THE COMMAND
*        6) REPORT ON THE RESULTS
*        7) RETURN TO MAIN DRIVER
*
*********************************************************************
*
*        ROUTINES WHICH DO NOT FOLLOW THE ABOVE RULES ARE
*                 END               WHICH GOES TO 12EXIT
*                 COMMENT           WHICH JUST RETURNS
*
*********************************************************************
         PAGE
*
*******************************
*        16.1 PROCESS THE 'CURRENT' COMMAND
*******************************
*
         SPACE    3
CURRENT  EQU      %
16CURRENT EQU     %
         SPACE
         BAL,SR4  CLEARTABS         * CLEAR DATA TABLES
         SPACE
         BAL,SR4  UNPACK            * UNPACK THE 2ND PARSED FIELD
         B        ERRABN            **** BAL -> ERROR RETURN (0)
         SPACE
*                                   **** BAL+1 -> PROCESS OKAY
         LI,R5    CFAREA            * SETUP R5 AS POINTER FOR SCAN
         BAL,SR4  UNITBANK          * UNIT/BANK INFO SHOULD BE HERE
         B        ERRABN            **** IF NOT UNIT/BANK SYNTAX 'ERROR'
         B        NONEXIST          **** IF NONEXISTENT, TELL HIM (1)
*                                   **** BAL+2 IF ALL IS WELL
         BAL,SR4  PRINTIT           * PROCESS AND PRINT REQUESTED BANKS
         SPACE
         B        11MAIN1           * RETURN TO MAIN FLO
         PAGE
*
*****************************************************
*        16.2 PROCESS THE 'THRESHOLD' COMMAND
*****************************************************
*
         SPACE    2
THRESHOLD EQU     %
16THRESHOLD EQU   %
         SPACE
         BAL,SR4  CLEARTABS         * ZERO IMPORTANT TABLES
         SPACE
         BAL,SR4  UNPACK            * HASH APART THE 2ND FIELD ON LINE
         B        ERRABN            ***** ERROR (BAL+0) IF UNPK FAILS
*                                   * RETURN TO BAL+1 IF ALL IS WELL
         LI,R5    CFAREA            * POINTER TO HASHED AREA
         BAL,SR4  UNITBANK          * CHECK UNIT/BANK VALUES
         B        ERRABN        (0) * HERE IF ILLEGAL VALUES
         B        NONEXIST      (1) * HERE IF REQUEST FOR NON-EXIST MEM
         SPACE
*                               (2) * HERE IF ALL IS WELL
         BAL,SR4  CKPRIV            * CHECK TO SEE IF M:SYS OKAY
         B        INSUFF        (0) * HERE IF TOO LOW (<X'C0')
*                               (1) * HERE IF X'C0' OR BETTER
         BAL,SR4  CHECKEQU          * MAKE SURE = SIGN AFTER U/B
         B        ERRABN        (0) * HERE IF NO = SIGN
*                               (1) * HERE IF IT IS THERE
         BAL,SR4  CONVDEC           * CHECK FOR, AND CONVERT DECIMAL #
         B        ERRABN        (0) * HERE IF NON-DEC OR ODDBAL VALUE
         B        OUTRNG        (1) * HERE IF OUT OF RANGE
*                               (2) * HERE IF ALL IS SWELL
         BAL,SR4  CHECK4NO          * SEE IF OPTIONAL 'NO' SPECIFIED
         B        ERRABN        (0) * BAD SYNTAX....GET OUT
*                               (1) * NO OR NULL SPECIFIED
         BAL,SR4  SETTHRSH          * TRY TO SET THRESHOLD VALUES
         B        BADLMS        (0) * SOMETHING WENT WRONG
*                               (1) * VALUES OKAY (HERE INHIBITED)
         BAL,SR4  RCESET            * TRY TO SET BANKS RCE 'ON'
         B        BADLMS        (0) * SOMETHING WENT WRONG
*                               (1) * OKAY HERE...DO THE REPORT
         BAL,SR4  PRINTIT           * ON THE BANKS REQUESTED
         SPACE    2
         B        11MAIN1           * BACK TO DRIVER
         PAGE
*
********************************************
*        16.3 PROCESS THE 'RCE' COMMAND
********************************************
*
         SPACE    2
RCE      EQU      %
16RCE    EQU      %
         SPACE    2
         BAL,SR4  CLEARTABS         * CLEAR DATA TABLES
         SPACE
         BAL,SR4  UNPACK            * HASH INPUT LINE
         B        ERRABN        (0) * HERE IF COULDNT UN-HASH
*                               (1) * HERE IF HASHED OKAY
         LI,R5    CFAREA            * MAKE POINTER TO HASH TABLE
         BAL,SR4  CKONOFF           * CHECK FOR ON/OFF SPECIFIED
         B        ERRABN        (0) * HERE IF NO ON/OFF GIVEN
*                               (1) * HERE IF ON/OFF AND ,
*                                   * SPECIFIED, NEXT ENTRY NON-ZERO
         BAL,SR4  UNITBANK           * PERFORM TABLE BUILDS FROM HASH
         B        ERRABN        (0) * HERE IF SOME SYNTAX PROBLEM
         B        NONEXIST      (1) * HERE IF BAD REQUEST
*                               (2) * HERE IF ALL SWELL
         BAL,SR4  CKPRIV            * CHECK USERS PRIVILEGE
         B        INSUFF        (0) * HERE IF NOT GOOD
*                               (1) * HERE IF X'C0' OR BETTER
         BAL,SR4  RCESET            * TRY TO DO THE COMMAND
         B        BADLMS        (0) * SOMETHING IS WRONG
*                               (1) * HERE IF ALL IS OKAY
         BAL,SR4  PRINTIT           * GO WRITE REPORT ON DESIRED BANKS
         SPACE
         B        11MAIN1           * BACK TO MAINLINE
         PAGE
*
*********************************************
*        16.4 PROCESS THE 'END' COMMAND
*********************************************
*
         SPACE    2
END      EQU      %
16END    EQU      %
         SPACE    3
         B        12EXIT
         PAGE
*
********************************************
*        16.5 PROCESS THE 'COMMENT' (*) INPUT
*********************************************
*
         SPACE    2
COMMENT  EQU      %
16COMMENT EQU     %
         SPACE    2
         B        11MAIN1           * GO TO MAIN FLO
         PAGE
*
***********************************************
*        17. SLAVE ROUTINES
***********************************************
*
         SPACE
*
******************************************************
*        17.1    UNPACK       ....PARSE THE PASSED FIELD
******************************************************
*
         SPACE    2
UNPACK   EQU      %
         SPACE
*
*        UNHASH THE MASHED 2ND FIELD FROM THE (HA HA) PARSER
*        AND DUMP IT INTO AN UNUSED AREA OF THE CFPTR TABLE
*
*        ONE 'KEYWORD' OR PUNCTUATION ITEM PER WORD, LEFT
*        JUSTIFIED
*
         SPACE
         LI,R1    #CFAREA           * PERFORM MAGIC ON CLEARING
         LI,R2    0                 * CFPTRS FIRST
         STW,R2   CFAREA-1,R1       * ********
         BDR,R1   %-1               ******************
         SPACE
         LW,R1    CFPNTRS+2         * GET SIZE IN BYTES+BA(START)
         LB,R2    R1                * GET COUNT IN R2
         AND,R1   X3FFFF            * CLOBBER COUNT IN R1
         SPACE
         CI,R2    1                 * SMALL FIELDS ARE A DRAG
         BL       *SR4
         SPACE
         LI,R7    CFAREA            * INDEX TO SPECIAL AREA
         SPACE
UNPK01   EQU      %
         LI,R3    0                 * BYTE INDEX TO NEXT BYTE IN FIELD
         SPACE
UNPK02   EQU      %
         LB,R5    0,R1              * GET THE NEXT BYTE FROM FIELD
         CI,R5    ','               * IS IT A 'DELIMITER'
         BE       UNPK03            * PROCESS DELIMITERS
         CI,R5    '='               * SAME FOR =
         BE       UNPK03            ******
         SPACE
         STB,R5   *R7,R3            * STORE THE BYTE
         AI,R3    1                 * UP BYTE INDEX INTO HASH WORD
         AI,R1    1                 * UP BYTE INDEX INTO INPUT BUFR
         SPACE
         CI,R3    4                 * SEE IF WD OVER FLOWED
         BGE      *SR4              * IF SO...ERROR BACK
         SPACE
         AI,R2    -1                * DROP FIELD SIZE
         BGZ      UNPK02            * IF > 0 TRY AGAIN
         SPACE
         AI,SR4   1                 * OOPS, ALL PROCESSED
         B        *SR4              * RETURN TO CALLER
         SPACE    5
UNPK03   EQU      %
         AI,R7    1                 * UP THE WORD POINTER
         STB,R5   *R7               * STORE THE 'DELIMITER'
         AI,R7    1                 * AND UP THE POINTER AGAIN
         AI,R1    1                 * UP THE POINTER TO NEXT BYTE
         AI,R2    -1                * DROP THE FIELD SIZE
         BGZ      UNPK01            * GO BACK TO TRY SOME MORE
         B        *SR4              * NO COMMANDS END IN A DELIMITER,
*                                   * SO TAKE THE ERROR RETURN
         PAGE
*
*******************************************
*        17.2  PRINTIT     (PRINT THE PER/BANK INFO LINE)
*******************************************
*
         SPACE
PRINTIT  EQU      %
         SPACE
         LI,R2    0                 * INDEX TO ALL TABLES
         LI,R3    MAXBNKS           * MX NO OF BANKS
         SPACE
PRINT01  EQU      %
         LW,R4    UBTABLE,R2        * GET AN ENTRY FROM PARSED TABLE
         BEZ      PRINT02           * IF NOT SELECTED, SKIP
         SPACE
         LI,R7    0                 * BEGIN SETUP.....UNIT/BANK
         LW,R6    R2                * FROM BINARY TO EBCDIC HERE
         SCD,R6   -2                * ***
         SCS,R7   -30               * ***
         LI,R1    TXT:UNIT#         * DISPLACEMENT INTO STRING
         LB,R6    #UNITS,R6         *
         STB,R6   MOS:LINE,R1       *
         SPACE
         LI,R1    TXT:BANK#         * ***
         LB,R7    #BANKS,R7         *
         STB,R7   MOS:LINE,R1       *
         SPACE
         LW,R6    MOSTAB+X'10000',R2 * GET CURRENT THRSH,COUNT
         LB,R1    R6                * GET 'NO RCE' FLAG IN R1
         SLS,R1   -7                * INTO BIT 31
         SPACE
         AND,R6   X7FFFFFFF         * CLOBBER 'NO RCE' FLAG
         LI,R7    0                 * CLEAR 7
         SLD,R6   -16               * COUNT INO R7
         SLS,R7   -16               * RIGHT JUSTIFY
         SPACE
         LW,R1    #ONOFF,R1         * GET THE ON/OFF TEXT
         STW,R1   MOS:LINE+TXT:RCE# * PUT IN LINE
         SPACE
         LW,R1    R7                * GET COUNT IN R1 FOR NOW
         SPACE
         CVS,R6   CVSTAB            *+*+* EBCDIC!
         SPACE
         STW,R7   #THRESH           * STORE AWAY FOR NOW
         SPACE
         LW,R6    R1                * GET COUNT BACK
         SPACE
         CVS,R6   CVSTAB            * GET EBCDIC FOR COUNT
         SPACE
         STW,R7   #COUNT            * AGAIN, STASH
         SPACE
         LD,R6    MBSCOUNT          ***** MOVE THE CONVERTED
         MBS,R6   0                 ***** VALUES INTO THE LINE
         LD,R6    MBSTHRESH         *****
         MBS,R6   0                 *****
         SPACE
         STW,R2   R6                * SAVE THE POINTER REGISTER
         TYPE     MOS:LINE          ******** PRINT THE SUCKER OUT
         LW,R2    R6                * AND RESTORE IT
         SPACE
PRINT02  EQU      %
         AI,R2    1                 * UP THE INDEX
         BDR,R3   PRINT01           * TRY GAIN
         SPACE
         B        *SR4              * BACK TO CALLER
         PAGE
*
*******************************************
*        17.3 CHECK FOR SYNTAX OF ON/OFF IN MSG
*******************************************
*
         SPACE
CKONOFF  EQU      %
         SPACE
         LW,SR3   *R5               * GET THE NEXT HASH
         CW,SR3   #ON               * CHECK AGAINST 'ON  '
         BNE      ONOFF01           *********
         MTW,1    RCEON%            * 'ON' SETS FLAG
         B        ONOFF02           *
         SPACE
ONOFF01  EQU      %
         CW,SR3   #OFF              * HOW ABOUT 'OFF '
         BNE      ONOFFOUT          * **** IF NOT, TAKE ABN
         SPACE
ONOFF02  EQU      %
         AI,R5    1                 * UP THE INDEX
         LB,SR3   *R5               * CHECK NEXT WORD FOR A ','
         CI,SR3   ','               * IF IT IS, SYNTAX IS OKAY
         BNE      ONOFFOUT          ****** NOTOKAY HERE------>
         SPACE
         AI,R5    1                 ** STILL OKAY, CHECK NEXT WD
         LW,SR3   *R5               ** IF NEXT PARM IS 0...ERROR
         BEZ      ONOFFOUT          ****** BYE
         SPACE
         AI,SR4   1                 * UP THE BAL ADDR FOR GOOD RETURN
ONOFFOUT EQU      %
         B        *SR4              * BACK TO CALLER WITH R5 -> U/B
         PAGE
*
**********************************************
*        17.4 UNIT/BANK DECODER
***********************************************
*
         SPACE
UNITBANK EQU      %
         LW,SR3   *R5               * GET NEXT HASH VALUE
         CW,SR3   #ALL              * SEE IF 'ALL' SPECIFIED
         BNE      UB01              ***** IF NOT, TRY BANK/UNIT DECODE
         SPACE
         AI,R5    1                 * IF IT WAS, RESET POINTER
         MTW,+1   ALL%              * SET THE FLAG WORD
         B        UB05              * PLAY 'FILLINTHEBANKS'
         SPACE    3
UB01     EQU      %
         LI,R3    2                 * CHK FOR UNIT 1ST
         CW,SR3   ##UNITS-1,R3      * '0   ' OR '1   '
         BE       UB04              * FOUND UNITS....TRY BANKS
         BDR,R3   %-2               * TRY AGAIN
         SPACE
UB02     EQU      %
         LI,R3    4                 * POSSIBLE # OF BANKS
         CW,SR3   ##BANKS-1,R3      * 'A   ','B   '...ETC
         BE       UB03              * FOUND!
         BDR,R3   %-2               ****TRY AGAIN
         B        *SR4              * NO MATCH...RETURN IN SHAME
         SPACE
UB03     EQU      %
         AI,R3    -1                * ADJUST R3 TO = 0-3 (NOT 1-4)
         STW,R3   BANK#             * STORE IN 'BANK' SLOT
         MTW,+1   BANK%             * AND SET 'BANK' FLAG
         MTW,+1   NUM#              * NUMBER OF FIELDS
         AI,R5    1                 * RE-POINT THE POINTER
         B        UB05              * PROCESS THE DATA
         SPACE    2
UB04     EQU      %                 * HERE ON UNIT FIND, TRY BANK?
         MTW,+1   NUM#              * NUMBER OF FIELDS
         AI,R3    -1                * ADJUST TO =0 OR 1
         STW,R3   UNIT#             * STORE AWAY
         MTW,+1   UNIT%             * AND FLAG THE FACT
         AI,R5    1                 * UP THE WORD POINTER IN HASH TABL
         LW,SR3   *R5               * CHECK NEXT FIELD
         CW,SR3   #COMMA            * ',   '
         BNE      UB05              * IF NOT A COMMA, MUST BE 0 0R =
         SPACE
         AI,R5    1                 * IF A COMMA, MUST HAVE BANK #
         LW,SR3   *R5               * GET NEXT FIELD
         B        UB02              *
         SPACE    5
UB05     EQU      %
         MTW,0    ALL%              * DID WE SEE 'ALL'
         BNEZ     UB09              * PROCESS IT
         SPACE
         LW,R2    NUM#              * CHECK IF WE SAW U,B
         CI,R2    2                 *
         BE       UB06              * YEP, TRY ONLY ONE BANK
         SPACE
         MTW,0    UNIT%             * SEE IF WHOLE UNIT REQ
         BNEZ     UB07              * PROCESS IT
         SPACE
         MTW,0    BANK%             * SEE IF WE SAW A BANK
         BNEZ     UB06              * YEP
         SPACE
         B        *SR4              * BACK TO CALLER ERRABN ROUTINE
*                                   * IF NO CASE SELECTED
         SPACE    2
UB06     EQU      %
         LW,R2    UNIT#             * GET UNIT
         SLS,R2   2                 ***
         AW,R2    BANK#             * AND FORM INDEX
         SPACE
         LW,R3    MOS:ADDR+X'10000',R2 * GET ADDRESS OF BANK
         BLZ      UB10              * OOPS, NOT HERE
         SPACE
         STW,R3   UBTABLE,R2        * STORE IN INTERNAL TABLE
         MTW,R1   NUMBANKS%         * SET # OF BANKS TO PROCESS
         B        UB10              * EXIT ROUTINE
         SPACE    3
UB07     EQU      %
         LW,R2    UNIT#             * GET UNIT #
         SLS,R2   2                 * MAKE INTO PSEUDO INDEX (BANK)
         LI,R3    4                 * MAK # OF BANKS/UNIT
         SPACE
UB08     EQU      %
         LW,R4    MOS:ADDR+X'10000',R2 * GET ADDRESS
         BLZ      UB085             * IF NOT HERE, SKIP INSERTION
         SPACE
         STW,R4   UBTABLE,R2        * STORE AWAY
         MTW,+1   NUMBANKS%         * UP COUNT
         SPACE
UB085    EQU      %
         AI,R2    1                 * TRY NEXT BANK
         BDR,R3   UB08              * BACK FOR MORE
         B        UB10              * EXIT THIS ROUTINE
         SPACE    2
UB09     EQU      %
         LI,R2    0                 * STARTING INDEX
         LI,R3    8                 * MAX # OF BANKS/DUAL UNIT
         B        UB08              * USE SINGLE UNIT ROUTINE
         SPACE    3
UB10     EQU      %
         MTW,0    NUMBANKS%         * SEE IF ANY WERE REALLY SETUP FOR
         BEZ      UB11              * NOPE, EXIT IN ERROR
         SPACE
         AI,SR4   1                 * UP RETN ADDRESS
UB11     EQU      %                 *
         AI,SR4   1                 * UP RETURN ADDRESS
         B        *SR4              * BACK TO CALLER
         PAGE
*
********************************************
*        17.5 CLEARTABS (CLEARS THE TABLE)
********************************************
*
         SPACE
CLEARTABS EQU     %
         LI,R1    0                 * CLEAR VALUE
         LI,R2    #ENTRIES
         STW,R1   BIGTABL-1,R2      * STORE IT AWAY
         BDR,R2   %-1               * AND KEEP TRYING
         B        *SR4              * WHEN DONE
         PAGE
*
***********************************************************
*        17.6 CKPRIV                CHECK USERS PRIVILEGE
***********************************************************
*
         SPACE
CKPRIV   EQU      %
         LB,R1    JB:PRIV           * GET PRIVILEGE
         CI,R1    X'C0'             * MUST HAVE C0 FOR M:SYS
         BL       %+2               *
         AI,SR4   1                 *
         B        *SR4              * RETURN TO BAL+1 IF GOOD
         PAGE
*
***********************************************************
*        17.7 CHECK4NO    SEE IF NO WAS SPECIFIED
************************************************************
*
         SPACE
CHECK4NO EQU      %
         LB,R1    *R5               * POINTER INTO TABLE -> AFTER DEC
         BEZ      NONO1             * IF ZERO...OKAY..GOOD SYNTAX
         CI,R1    ','               * IF COMMA, CONTINUE SCAN
         BNE      NONO              * OKAY TO LEAVE
         AI,R5    1                 *
         LW,R1    *R5               * GET CONTENTS
         CW,R1    #NO               * CHECK IF NO WAS SAID
         BE       SETNO             * GOOD! HE SAID NO
         SPACE
NONO     EQU      %
         B        *SR4              * RETURN IN SHAME
         SPACE
SETNO    EQU      %
         MTW,+1   NO%               * TELL THRESH NOT TO CHANGE CURRENT
         SPACE
NONO1    EQU      %
         AI,SR4   1                 * AND RETURN OKAY
         B        *SR4              ******************
         PAGE
*
****************************************************
*        17.8 CHECKEQU    CHECKS FOR EUQAL SIGN IN BUFR
*****************************************************
*
         SPACE
CHECKEQU EQU      %
         LB,R1    *R5               * GET THE BYTE
         CI,R1    '='               ********!
         BNE      %+3               **** IF BAD, DONT INCR SR4 FOR RET
         AI,SR4   1                 **
         AI,R5    1                 * INCR POINTER, TOO
         B        *SR4              * BACK TO CALLER
         PAGE
*
************************************************
*        17.9  CONVDEC     DECIMAL/BINARY CONVERTER
************************************************
*
         SPACE
CONVDEC  EQU      %
         LW,R1    *R5               * GET THE VALUE
         BEZ      CDBAD             * IF ZERO, TOO BAD...ERRABN
         SPACE
         LI,R7    0                 * SET UP SOME REGISTERS
         LW,R6    R1                * FOR SOME SHIFTS
         LI,R2    4                 *  MOST # OF HEX/WORD
         SCD,R6   -8                * SHIFT A BYTE OUT
         CI,R7    0                 * CHECK 7
         BNEZ     CDOUT1            * GET OUT OF LOOP
         BDR,R2   %-3               * KEEP TRYING
         SPACE
         B        CDBAD1            * IF THIS FAR, VALUE OUT OF RANGE
         SPACE
CDOUT1   EQU      %
         SCD,R6   8                 * BACK IN R6, RIGHT JUSTIFIED
         SPACE
         LI,R4    4                 * LOOP CTR
         LI,R3    3                 * INDEX
CDDEC    EQU      %
         LI,R7    9                 *
         LI,SR3   10                * CTR AND INDEX REGS
         SPACE
         LB,R1    R6,R3             * GETABYTE
         BEZ      CDOUT2            * IF ZERO, IGNORE IT
         CB,R1    DEC%DIGS,R7       * IS IT DECIMAL?
         BE       CDOUT2            *........TRY ANOTHER
         AI,R7    -1                * DOWN INDEX
         BDR,SR3  %-3               * AND LOOP COUNTER
         B        CDBAD             * RETURN ON BAD VALUE
         SPACE
CDOUT2   EQU      %
         AI,R3    -1                * DOWN INDEX
         BDR,R4   CDDEC             * AND TRY NEXT DIG
         SPACE
*                                   * IF HERE, ALL BYTES WERE
*                                   * EITHER DECIMAL OR 0
         LW,R7    R6                * SETUP FOR CVA
         CVA,R6   CVSTAB            * TABLES
         SPACE
         CI,R6    255               * SEE IF OUT OF RANGE
         BG       CDBAD1            * YEP.......ERROR EXIT
         SPACE
         AI,R5    1                 * UP POINTER
         AI,SR4   1                 * AND RETURN ADDRESS
         STW,R6   THRSH%NEW         * NEW THRESHOLD ADDRESS
CDBAD1   EQU      %
         AI,SR4   1                 * UP IT AGAIN
CDBAD    EQU      %
         B        *SR4              * BACK TO CALLER
         PAGE
*
********************************************************
*        17.10  SETTHRSH      ROUTINE TO SET/RESET THRESHOLDING
*********************************************************
*
         SPACE    2
SETTHRSH EQU      %
         SPACE
         M:SYS    0                 * GO MASTER MODE
         BCS,X'8' *SR4              * WHOOPS, SOMETHING FAILED
         SPACE
         MTW,0    NO%               * DID USER SAY NO?
         BEZ      STT03             * NO..HE DIDNT...ASSUME CURR=0
         SPACE
         LI,R1    MAXBNKS           * LOOP CONTROL = R1
STT01    EQU      %
         LW,R2    UBTABLE-1,R1      * GET A PARSE ENTRY
         BEZ      STT02             * IF NO ENTRY, SKIP BANK
         SPACE
         LW,R2    MOSTAB-1+X'10000',R1 * GET A THRSH/CURR CELL
         AND,R2   XFFFF             * CLEAR TOP JUNK
         STW,R2   THRSHTAB-1,R1     * AND STASH IT
         SPACE
STT02    EQU      %
         BDR,R1   STT01             * TRY NEXT BANK
         SPACE    2
STT03    EQU      %                 ***** SET THE THRESHOLDS!
         LW,R5    THRSH%NEW         * GET THRSH VALUE
         LI,R1    MAXBNKS           * AND NUMBANKS
         SPACE
***************************************************************
         WD,0     X'37'             * DISABLE *****************
***************************************************************
         SPACE
STT04    EQU      %
         LW,R2    UBTABLE-1,R1      * GET BANK INDICATOR
         BEZ      STT05             * IF ZERO, SKIP ME
         SPACE
         LI,R3    0                 * CLEAR R3 (FLAG/NOFLAG CELL)
         SPACE
         LW,R2    THRSHTAB-1,R1     * GET 'OLD' VALUE (0 IF CURR RESET)
         CW,R2    R5                * CURRENT <  THRESHOLD?
         BL       STT045            * YES....SET RCE ON
         SPACE
         AI,R3    X'8000'           * MAKE R3 CONTAIN "NO RCE" FLG
STT045   EQU      %
         AW,R3    R5                * MERGE THRSH WITH FLAG
         STH,R3   R2                * MAKE NEW TABLE WORD
         STW,R2   MOSTAB-1+X'10000',R1  * AND STORE IT
         SPACE
STT05    EQU      %
         BDR,R1   STT04             * TRY NEXT BANK
         SPACE
******************************************************************
         WD,0     X'27'             * ENABLE AGAIN ***************
******************************************************************
         SPACE
         MTW,1    RCEON%            * TELL RCESET TO TRY ALL
         AI,SR4   1                 * AND RETURN IN TRIUMPH
         B        *SR4              * *********************
         PAGE
*
************************************************************
*        17.11  RCESET       ROUTINE THAT ATTEMPTS TO SET RCE FLIP-FLOPS
************************************************************
*
         SPACE    2
RCESET   EQU      %
         SPACE
         M:SYS    0                 * GO MASTER MODE
         BCS,X'8' *SR4              * IF NO GOOD, ERROR EXIT
         SPACE
         LW,R2    RCEON%            * GEN ON/OFF FLAG (1=ON)
         LI,R1    MAXBNKS           * AND MAKE A LOOP COUNTER
         SPACE
****************************************************************
         WD,0     X'37'             * DISABLE THIS ROUTINE
*****************************************************************
         SPACE
RCET01   EQU      %
         LW,R3    UBTABLE-1,R1      * IS THIS BNK OKAY?
         BEZ      RCET02            * NOPE...TRY NEXT
         SPACE
         LW,R3    MOSTAB-1+X'10000',R1 * GET THRSH/CURR VALUES
         EXU      RCEBRNCH,R2       * IF NO ACTION SKIP OUT
         SPACE
*
*        AT THIS POINT, RCE HAS TO BE CHANGED ON THIS BANK
*        IF ITS ABOUT TO BE TURNED OFF, STUFF THE FLAG, AND
*                 DO IT
*        IF ITS ABOUT TO BE TURNED ON, CHECK THE CURR/THRSH VALUES
*                 AND IF THEY'RE OKAY, RESET THE FLAG AND DO IT
*                 IF THEY'RE NOT OKAY, TRY NEXT BANK
*
         SPACE
         CI,R2    0                 * CHECK FOR ON/OFF
         BEZ      RCET11            * ITS OFF..SKIP CHECK LOGIC
         SPACE
         AND,R3   X7FFFFFFF         * STRIP THE 'RCE OFF' BIT
         LH,R4    R3                * GET THRSH IN R4
         AND,R3   XFFFF             * AND STRIP IT OFF R3
         SPACE
         CW,R4    R3                * CHECK CURR < THRSH
         BLE      RCET02            * WHOOPS! DONT MUCK WITH ME!
         SPACE
         STH,R4   R3                * PUT IT BACK TOGETHER
         B        RCET12            * WITHOUT RCE OFF FLAG
         SPACE    2
RCET11   EQU      %
         OR,R3    Y8BIT             * PUT 'OFF' FLAG IN
         SPACE
RCET12   EQU      %
         STW,R3   MOSTAB-1+X'10000',R1 * AND DUMP INTO MONITOR DATA
         LW,R4    UBTABLE-1,R1      * GET MOS BANK ADDRESS INTO R4
         EXU      RCELCI,R2         * BUILD CC'S FOR SET/RESET
         LMS,R3   0,R4              * AND TOGGLE THE FLIP/FLOP
         SPACE
RCET02   EQU      %
         BDR,R1   RCET01            * TRY ANOTHER BANK
         SPACE
******************************************************************
         WD,0     X'27'             * RE-ENABLE ******************
******************************************************************
         SPACE
         AI,SR4   1                 * INCREMENT RETURN ADDRESS
         M:SLAVE                    * RETURN TO NORMALCY
         B        *SR4              * BACK TO CALLER
         SPACE
RCEBRNCH EQU     %
         BLZ      RCET02            **** ALREADY RESET
         BGZ      RCET02            **** ALREADY SET
         SPACE
RCELCI   EQU      %
         LCI      X'5'              ** RESET FLIP-FLOP
         LCI      X'4'              ** SET FLIP-FLOP
         PAGE
*
****************************************************
*        18.0 AUXILIARY ERROR ROUTINES
*****************************************************
*
         SPACE
ERRABN   EQU      %
         TYPE     'ILLEGAL COMMAND'
         B        11MAIN1
         SPACE
NONEXIST EQU      %
         TYPE     '** ILLEGAL OR NON-EXISTENT MEMORY REQUEST'
         B        11MAIN1
         SPACE
INSUFF   EQU      %
         TYPE     '** INSUFFICIENT PRIVILEGE (<X''C0'')'
         B        11MAIN1
         SPACE
BADLMS   EQU      %
         TYPE     '** M:SYS FAILED ON ATTEMPTING TO GET MASTER MODE'
         B        11MAIN1
         SPACE
OUTRNG   EQU      %
         TYPE     '**  VALUE TOO BIG OR ILLEGAL - TRY 0-255'
         B        11MAIN1
         PAGE
*
********************************************************
*        19.0 PATCH AREA
********************************************************
*
*
*        CREATE PATCH AREAS FOR PROCEDURE (MOS:PP)
*        AND DATA                         (MOS:DA)
*
         SPACE
         DEF      MOS:PP            *****
         DEF      MOS:DA
         USECT    CS:MOS:PROC       **  PT 01
MOS:PP   EQU      %
         DO1      40
         DATA     X'BAD'
         USECT    CS:MOS:DATA       **  PT 00
MOS:DA   EQU      %
         DO1      64
         DATA     X'BAD'
         PAGE
         END

