************************************************************************
*M*      CHARROUT PERFORMS ANALYSIS ON CHARACTER STRINGS
***********************************************************************
*P*
*P*      NAME:    CHARROUT
*P*
*P*      PURPOSE:     TO PERFORM SYNTAX ANALYSIS ON CHARACTER STRINGS
*P*
*P*      DESCRIPTION: THIS MODULE CONTAINS A SET OF SUBROUTINES FOR
*P*                   DOING SYNTAX ANALYSIS ON CHARACTER STRINGS
*P*                   OBTAINED FROM CONTROL COMMANDS. SEE FUNCTION
*P*                   PREAMBLES FOR NXACTCHR, NAMSCAN,
*P*                   ANYSCAN, CHARSCAN, HEXSCAN, DECSCAN, QUOTSCAN,
*P*                   CHSTSCAN AND GETCHST.
*P*
*P*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*P*
       CSECT       1
         SYSTEM   SIG7FDP
       PAGE
*                 SYMBOLIC REGISTER DEF'S.
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
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 0,NAME(1),AF(1),0,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         PEND
         REF      TSTACK
         PAGE
         DEF      CHARSCAN          COMPARE THE NEXT ACTIVE CHARACTER
*,*                                 WITH SPECIFIED CHARACTER
         DEF      CHSTSCAN          GET NEXT FIELD FROM THE CONTROL
*,*                                 COMMAND
         DEF      DECSCAN           GET DECIMAL VALUE FROM THE SPECIFIED
*,*                                 CHARACTER STRING
         DEF      HEXSCAN           GET HEXADECIMAL VALUE FOR THE
*,*                                 SPECIFIED CHARACTER STRING
         DEF      NAMSCAN           GET NEXT FIELD FROM THE CONTROL
*,*                                 COMMAND
         DEF      NXACTCHR          GET NEXT ACTIVE CHARACTER FROM THE
*,*                                 CHARACTER STRING
         DEF      QUOTSCAN          GET THE NEXT FIELD FROM THE CHARACTER
*,*                                 STRING AND COMPARE
*,*                                 DELIMITERS
         DEF      CONTR             EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING ADDRESS OF ROUTINE TO READ
*,*                                 CONTINUATION RECORDS
         DEF      OUTR              EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING ADDRESS TO OUTPUT IMAGE
*,*                                 IN INPUT BUFFER
         DEF      CCP               EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING NEXT CHARACTER POSITION
*,*                                 IN INPUT RECORD
         DEF      FLAGS             EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING FLAGS INDICATING BLANK
*,*                                 ACTIVE ON SCAN, BLANK OUT INPUT RECORD
*,*                                 , AND BUFFER IS EMPTY
         DEF      CBUF              EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING INPUT RECORD BUFFER
*,*                                 ADDRESS
         DEF      PCCP              EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING CHARACTER POSITION
*,*                                 OF FIRST CHARACTER OF LAST FIELD
*,*                                 OBTAINED
         DEF      CSL               EQU; OFFSET ONTO PARAMETER TABLE
*,*                                 CONTAINING NUMBER OF CHARACTERS IN
*,*                                 CHARACTER STRING IN PARAMETER LIST
*,*                                 BUFFER
         DEF      PLB               EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING BUFFER WHICH CONTAINS
*,*                                 LAST CHARACTER STRING
         DEF      CHTBL             TABLE OF ALPHANUMERIC CHARACTERS
         DEF      CCRSZ             EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING INPUT RECORD SIZE
         DEF      BAPLB             EQU; BYTE OFFSET INTO PARAMETER TABLE
*,*                                 BUFFER WHICH CONTAINS LAST
*,*                                 CHARACTER STRING
         DEF      COMEXIT1          NORMAL EXIT FROM SCAN ROUTINES
         DEF      CLD               EQU; OFFSET INTO PARAMETER TABLE
*,*                                 CONTAINING NUMBER AND ADDRESS
*,*                                 OF DELIMITERS
         REF      GETVAL4           RETURN TO CALLING ROUTINE SETTING
*,*                                 CC1=1
         REF      GETVAL0           RETURN TO CALLING ROUTINE SETTING
*,*                                 CC1=0
         REF      CCI120            ERROR RETURN TO CCIR AFTER FAILURE
*,*                                 TO READ CONTINUATION RECORD
         REF      Y08               CONSTANT
         REF      YDFFFFFFF         MASK
         REF      Y8                CONSTANT
         REF      Y4                CONSTANT
         REF      Y2                CONSTANT
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K4       EQU      X'4'
K8       EQU      X'8'
K6       EQU      X'6'
K24      EQU      X'24'
K40      EQU      X'40'
KFF      EQU      X'FF'
KN1      EQU      -X'1'
KCRET    EQU      X'15'
KEOB     EQU      X'26'
KSCOLON  EQU      ';'
         PAGE
*F*
*F*      NAME:        NXACTCHR
*F*
*F*      PURPOSE:     TO GET THE NEXT ACTIVE CHARACTER FROM THE
*F*                   CHARACTER STRING BEING PROCESSED.
*F*
*F*      DESCRIPTION: NXACTCHR GETS THE NEXT ACTIVE CHARACTER FROM
*F*                   THE INPUT RECORD. IF A SEMICOLON IS
*F*                   ENCOUNTERED, THE OUTPUT ROUTINE (CCLIST) IS
*F*                   CALLED TO LIST THE CONTROL COMMAND. THE
*F*                   NEXT RECORD IS OBTAINED AND SCANNING
*F*                   CONTINUED. CONDITION CODES ARE SET TO
*F*                   INDICATE WHETHER A CHARACTER WAS OBTAINED OR
*F*                   WHETHER A DELIMITER WAS ENCOUNTERED.
*F*
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*F*
*        NXACTCHR-NEXT ACTIVE CHARACTER ROUTINE GETS THE NEXT ACTIVE
*        CHARACTER FROM THE INPUT RECORD. IF A SEMICOLON IS ENCOUNTERED,
*        THE OUTR ROUTINE IS CALLED IF SPECIFIED. THEN THE NEXT
*        RECORD IS OBTAINED BY CALLING THE SPECIFIED CONTINUATION
*        ROUTINE IF A LEGAL CONTINUATION RECORD IS NOT OBTAINABLE.
*        ENTER WITH ADR OF CHAR PARAM LIST IN R7,
*        JIT POINTER IN R5 AND CUR CHAR OR ZERO IN SR1.
NXACTCHR EQU      %
         AI,SR1   K0                CHK IF CUR CHAR = 0
         BNE      NXACH3            BRANCH IF NOT
NXACH1   EQU      %
         LW,R2    CCP,R7
         CW,R2    CCRSZ,R7          CHECK IF TO END OF RECORD
         BE       NXACH5            BRACH IF YES
         LW,R3    CBUF,R7
         LB,SR1   *R3,R2            PICK UP NEXT CHAR
         CI,SR1   KSCOLON           CHECK IF CUR CHAR IS A ;
         BE       NXACH6            BRANCH IF YES
         CI,SR1   KCRET             CHECK IF CARRIAGE RETURN
         BE       NXACH51
         MTW,1    CCP,R7            SET CCP = CCP+1
NXACH3   EQU      %
         LW,R1    FLAGS,R7          (R1) = FLAGS
         CI,SR1   K40               CHECK IF CUR CHAR IS A BLANK
         BNE      NXACH4            BRANCH IF NOT
         CW,R1    Y8                CHECK IF BLANK IS ACTIVE
         BAZ      NXACH1            BRANCH IF NOT
NXACH4   EQU      %
         CI,SR1   KCRET             CHECK IF CARRIAGE RETURN
         BE       NXACH51
         LW,R1    CLD,R7            (R1) = # OF DELIM, BYTE ADR OF DLM
         LB,R2    R1                (R2) = # OF DELIM
NXACH8   EQU      %
         CB,SR1   0,R1              CHECK IF CUR CHAR IS A DELIM
         BE       NXACH9            BRANCH IF YES
         AI,R1    K1
         BDR,R2   NXACH8
         LW,R3    FLAGS,R7
         CW,R3    Y4                CHECK IF BLANKOUT FLAG SET
         BAZ      NXACH81
         LW,R2    CCP,R7
         AI,R2    -1                (R2) = CUR CHAR POS. -1
         LI,R4    X'40'
         STB,R4   *R3,R2            BLANKOUT CHAR
NXACH81  EQU      GETVAL0
                  B        GETVAL0           SET CC1=0&EXIT
*
NXACH5   EQU      %
         LI,SR1   KEOB              SET CUR CHAR  = EOB
NXACH51  EQU      %
         LW,R1    OUTR,R7
         BEZ      NXACH9
         PUSH     SR4
         BAL,SR4  0,R1              LIST LAST RECORD
NXACH52  EQU      GETVAL4-1
         B        GETVAL4-1                  SET CC=1
*
NXACH6   EQU      %
         PUSH     2,SR3
         LW,R1    OUTR,R7
         BEZ      NXACH7
         BAL,SR4  0,R1              LIST RECORD
NXACH7   EQU      %
         LW,R1    CONTR,R7
         LB,R2    R1
         OR,R2    Y08
         STW,R2   CCP,R7            SET CCP = CP (CONTINUATION POS)
         BAL,SR4  0,R1              GET CONTINUATION RECORD
         LI,R2    0                 RESET BIT TO NOT CONTINUE RESD
         LW,R3    Y08
         STS,R2   CCP,R7
         LB,R2    SR3               (R2) = I/O COMPLETE CODE
         PULL     2,SR3
         CI,R2    K6                CHECK IF CONT. RECORD OBTAINED
         BE       NXACH1            BRANCH IF YES
         LI,SR1   KFF               SET CUR CHAR = FF
         LCI      8
         B        CCI120
NXACH9   EQU      GETVAL4
         B        GETVAL4         SET CC = 1 & EXIT
         PAGE
*F*
*F*      NAME:        NAMSCAN
*F*
*F*      PURPOSE      TO GET THE NEXT FIELD FROM THE CONTROL
*F*                   COMMAND AND CHECK IF IT A LEGAL ALPHANUMERIC
*F*                   NAME.
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE CONTROL
*F*                   COMMAND, MOVED TO THE CHARACTER STRING
*F*                   BUFFER (CBUF) AND CHECKED FOR BEING A
*F*                   LEGAL ALPHANUMERIC CHARACTER. CONDITION
*F*                   CODES ARE SET TO INDICATE WHETHER OR
*F*                   NOT AN ILLEGAL CHARACTER STRING WAS
*F*                   SCANNED.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        NAMSCAN-SCANS FOR LEGAL ALPHA NUMERIC NAME.
*        IF LEGAL CC1 = 0, IF NOT
*        CC1 = 1  OR CC2 = 1.
*        IF CC1 = 1, ILLEGAL STRING
*        IF CC2 = 1, STRING DOESN'T CONTAIN AT LEAST ONE ALPHABETIC CHAR.
*        ENTER WITH ADR OF CCPL IN R7, CUR CHAR OR ZERO IN SR1
*
*
*
NAMSCAN  EQU      %
         PUSH     1,SR4
         BAL,SR4  GETCHST           GET CHARACTER STRING
         BCS,8    COMEXIT2          BRANCH IF ILLEGAL STRING
         LI,R4    K0
NAMS1    EQU      %
         LB,R3    *R7,R2            SET (R3) = ITH CHAR
         CI,R3    X'4E'
         BL       COMEXIT2
         LB,R3    CHTBL,R3          CHECK IF CHAR LEGAL ALPHANUMERIC
         BEZ      COMEXIT2          BRANCH IF NOT
         OR,R4    R3                MERGE TYPE
         AI,R2    K1
         BDR,R1   NAMS1             SET N# N-1
         CI,R4    K2                CHECK IF AT LEAST ONE ALPHABETIC
         BL       COMEXIT3          ALL NUMERIC, SET CC2=1 AND EXIT
         B        COMEXIT1          SET CC=0 AND EXIT
         PAGE
*F*
*F*      NAME:        ANYSCAN
*F*
*F*
*F*      PURPOSE:     TO GET THE NEXT FIELD FROM THE CONTROL
*F*                   COMMAND WHICH MAY CONTAIN SPECIAL
*F*                   CHARACTERS NOT INCLUDED IN THE LEGAL
*F*                   ALPHANUMERIC CHARACTER SET.
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE
*F*                   CONTROL COMMAND AND MOVED TO THE CHARACTER
*F*                   STRING BUFFER (CBUF). THE PRESENCE OF
*F*                   QUOTATION MARKS SIGNALS THAT THE FIELD
*F*                   WHICH FOLLOWS MAY CONTAIN SPECIAL
*F*                   CHARACTERS. CHARACTERS ARE NOT
*F*                   CHECKED FOR LEGALITY.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
         DEF      ANYSCAN
         REF      LOUTSN3
ANYSCAN  EQU      %
         PUSH     SR4
         LI,SR2   ''''
         BAL,SR4  CHARSCAN
         BCS,8    NAMSCAN+1
         ANLZ,SR2 LOUTSN3
         LI,R1    0
ANYSCAN1 EQU      %
         BAL,SR4  GETNXTGUY
         BCS,8    COMEXIT2          SET CC1, PULL AND B *SR4
         CI,SR1   ''''
         BE       QUOTE
ANYSCAN2 EQU      %
         STB,SR1  *SR2,R1
         AI,R1    1
         CI,R1    17                MAXIMUM FILE NAME SIZE FOR ANS
         BG       COMEXIT2          SET CC1, PULL AND B *SR4
         B        ANYSCAN1
QUOTE    EQU      %
         BAL,SR4  GETNXTGUY
         BCS,8    COMEXIT2          SET CC1, PULL AND B *SR4
         CI,SR1   ''''
         BE       ANYSCAN2
         STW,R1   CSL,R7
         LW,R3    FLAGS,R7
         AND,R3   Y7FFFFFFF         RESET BLANK FLAG
         STW,R3   FLAGS,R7
         B        COMEXIT1          RESET CC1,PULL AND B *SR4
*
GETNXTGUY EQU     %
         LW,R2    CCP,R7
         CW,R2    CCRSZ,R7
         BE       GETVAL4           SET CC1 & B *SR4
         LW,R3    CBUF,R7
         LB,SR1   *R3,R2
         MTW,1    CCP,R7
         B        GETVAL0           RESET CC1 & B *SR4
         PAGE
*F*
*F*      NAME:    CHARSCAN
*F*
*F*      PURPOSE: TO COMPARE CURRENT CHARACTER WITH THE CHARACTER
*F*               SPECIFIED IN SR2.
*F*
*F*      DESCRIPTION: THE NEXT ACTIVE CHARACTER FROM THE INPUT
*F*               CHARACTER STRING IS COMPARED WITH THE SPECIFIED
*F*               CHARACTER AND CONDITION CODES ARE SET TO REFLECT
*F*               THE RESULTS OF THE COMPARISIN.
*F*
*F*      REFERENCE: DATA BASE TECHNICAL MANUAL
*F*
*        CHARSCAN-COMPARES CUR CHAR WITH CHAR IN SR2. IF =, CC1 =0.
*        IF NOT CC1 = 1.
*        ENTER WITH PARAMETER LIST ADR IN R7, CUR CHAR OR ZERO IN SR1,
*        AND COMPARISON CHAR IN SR2.
*
CHARSCAN EQU      %
         PUSH     1,SR4             SAVE RTRN ADR
         BAL,SR4  NXACTCHR          GET NEXT ACTIVE CHAR
         CW,SR1   SR2
         BNE      CHRS3             BRANCH IF NOT
         LI,SR1   K0                SET CUR CHAR = 0
         B        COMEXIT0
CHRS3    EQU      NXACH52
         PAGE
*F*
*F*      NAME:        HEXSCAN
*F*
*F*      PURPOSE:     TO SCAN FOR A HEXADECIMAL NUMBER.
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE
*F*                   SPECIFIED CHARACTER STRING, MOVED
*F*                   TO THE CHARACTER STRING BUFFER
*F*                   (CBUF) AND CHECKED FOR BEING A LEGAL
*F*                   HEXADECIMAL CHARACTER . CONDITION CODES
*F*                   ARE SET TO INDICATE WHETHER OR NOT A LEGAL
*F*                   HEXDECIMAL FIELD WAS SCANNED.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        HEXSCAN-SCANS FOR HEXIDECIMAL NUMBER.
*        IF LEGAL HEX # CC1 = 0 ,IF NOT CC1 = 1
*        ENTER WITH ADR OF PARAMETER LIST IN R7, CUR CHAR OR 0 IN SR1
*
*
*
HEXSCAN  EQU      %
         LI,R4    2                 FOR HEX SCAN
         PUSH     1,SR4             SAVE RETURN ADR
         BAL,SR4  GETCHST           GET CHAR STRING
         BCS,8    COMEXIT2          BRANCH IF ILLEGAL CHAR STRING
HEXS1    EQU      %
         LB,R3    *R7,R2            SET (R3) =  ITH CHAR IN STRING
         CI,R3    X'5B'
         BL       COMEXIT2
         LB,R3    CHTBL,R3
         BEZ      COMEXIT2          BRANCH IF NOT LEGAL ALPHANUMERIC
         CW,R4    R3                CHK IF LEGAL CHAR
         BL       COMEXIT2          BRANCH IF NOT OK
         AI,R2    K1
         BDR,R1   HEXS1             SET N =N-1
         B        COMEXIT1
         PAGE
*F*
*F*      NAME:        QUOTSCAN
*F*
*F*      PURPOSE:     TO GET THE NEXT FIELD FROM THE SPECIFIED
*F*                   CHARACTER STRING AND COMPARE IT WITH
*F*                   ANOTHER STRING OF CHARACTERS.
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE
*F*                   SPECIFIED CHARACTER STRING AND MOVED TO
*F*                   THE CHARACTER STRING BUFFER (CBUF). THE
*F*                   CHARACTER STRING OBTAINED IS COMPARED
*F*                   WITH A SPECIFIED CHARACTER STRING AND
*F*                   CONDITION CODES SET TO REFLECT WHETHER OR
*F*                   NOT THE CHARACTER STRING COMPARED.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        QUOTSCAN-COMPARE QUOTE CONSTANT WITH CHAR STRING AND IF = SETS
*        CC1= 0 ,OTHERWISE SETS CC1 = 1.
*        QUOTE CONSTANT AND CHAR STRING CAN BE = ONLY IF THEY ARE
*        OF THE SAME LENGTH
*        ENTER WITH ADR OF PARAM LIST IN R7, CUR CHAR OR 0 IN SR1,
*        AND WORD ADR OF QUOTE CONSTANT IN SR2.
QUOTSCAN EQU      %
         PUSH     1,SR4
         BAL,SR4  GETCHST           GET CHAR STRING
         BCS,8    COMEXIT2          BRANCH IF ILLEGAL STRING
         LW,R4    SR2               (R4) = QUOTE CONSTANT ADR
         SLS,R4   2                 CONVERT TO BYTE ADR
         CB,R1    QC0,R4            COMPARE LENGTHS
         BNE      COMEXIT2
QUTS1    EQU      %
         AI,R4    K1
         LB,R3    *R7,R2
         CB,R3    QC0,R4            COMPARE CHARS
         BNE      COMEXIT2
         AI,R2    K1
         BDR,R1   QUTS1
         B        COMEXIT1
*
         PAGE
*F*
*F*      NAME:        DECSCAN
*F*
*F*      PURPOSE:     TO SCAN FOR A DECIMAL NUMBER.
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE
*F*                   SPECIFIED CHARACTER STRING, MOVED TO THE
*F*                   CHARACTER STRING BUFFER (CBUF) AND CHECKED
*F*                   FOR BEING A LEGAL DECIMAL CHARACTER.
*F*                   CONDITION CODES ARE SET TO INDICATE
*F*                   WHETHER OR NOT A LEGAL DECIMAL FIELD WAS
*F*                   SCANNED.
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        DECSCAN- SCANS FOR DECIMAL #.
*        IF LEGAL DEC # CC1 = 0, IF NOT CC1= 1
*        ENTER WITH ADR OF PARAM LIST IN R7 AND CUR CHAR OR 0 IN SR1.
*
*
DECSCAN  EQU      %
         LI,R4    1                 FOR DECIMAL SCAN
         B        HEXSCAN+1         GO SCAN
*
         PAGE
*F*
*F*      NAME:    CHSTSCAN
*F*
*F*      PURPOSE: TO GET THE NEXT FIELD FROM THE CONTROL COMMAND
*F*
*F*      DESCRIPTION: THE NEXT FIELD IS OBTAINED FROM THE SPECIFIED
*F*               CHARACTER STRING, MOVED TO THE CHARACTER STRING BUFFER
*F*               (CBUF). LEGALITY CHECKS ARE NOT PERFORMED ON THE
*F*               CHARACTERS. CONDITION CODES ARE SET TO INDICATE
*F*               WHETHER THE FIELD EXCEEDED THE MAXIMUM LENGTH OF 31
*F*               CHARACTERS.
*F*
*F*      REFERENCE: DATA BASE TECHNICAL MANUAL
*F*
*        CHSTSCAN-CHARACTER STRING SCAN- GETS THE NEXT CHARACTER
*                 STRING UP TO THE NEXT DELIMITER AND MOVES THE
*                 STRING TO THE PARAMETER LIST BUFFER.
*        ENTER WITH JOB POINTER IN R5, PARAM LIST POINTER IN R7,
*        CUR CHAR OR ZERO IN SR1
*        IF  N= 0  OR N > 31 CC1 IS SET  TO 1 . IF CHAR STRING IS NOT
*        OBTAINABLE BECAUSE OF ERROR IN TRYING TO OBTAIN A CONT. RECORD,
*        CC1 AND CC2 ARE BOTH SET TO ONE
*
CHSTSCAN EQU      %
         PUSH     1,SR4
         LW,D1    CCP,R7
         STW,D1   PCCP,R7
         LW,R3    BLANK
         ANLZ,R2  CHSTS5            ADDR OF CHAR STRING BFR
         LI,R1    9
         REF      BLANK
CHSTS1   EQU      %
         AI,R2    -1
         STW,R3   0,R2              FILL PARAM LIST BFR
         BDR,R1   CHSTS1              WITH BLANKS
*
         LW,R3    Y8                   BLANK
         STS,R2   FLAGS,R7                   NOT ACTIVE
*
         LI,R3    K24
CHSTS2   EQU      %
         PUSH     4,R1
         BAL,SR4  NXACTCHR          GET NEXT ACTIVE CHAR
         BCS,8    CHSTS4            CHECK IF CHAR IS A DELIMITER
         PULL     4,R1
         AI,R1    K0                CHK IF 1ST CHAR IN FIELD
         BNE      CHSTS22
         LW,D1    Y8                SET
         AWM,D1   FLAGS,R7            BLANK ACTIVE
         LW,D1    CCP,R7            SET PCCP = CHAR POSITION OF 1ST
         AI,D1    KN1
         STW,D1   PCCP,R7                         CHAR OF FIELD
CHSTS22  EQU      %
         STB,SR1  *R2,R1            STORE CHAR IN BUFFER
         LI,SR1   K0                SET CUR CHAR =0
         AI,R1    K1                SET  N= N+1
         BDR,R3   CHSTS2
CHSTS21  EQU      %
         LW,R4    Y8
CHSTS3   EQU      %
         STW,R1   CSL,R7            STORE N IN PARAM LIST
         PULL     1,SR4                        ACTIVE
CHSTS30  RES      0
         LC       R4                SET COND.  CODE
         B        *SR4              EXIT
CHSTS4   EQU      %
         PULL     4,R1
         AND,R4   XF                RESET CC
         AI,R1    K0                CHK IF N=0
         BE       CHSTS21
         LW,R2    Y7FFFFFFF
         AND,R2   FLAGS,R7          SET BLANK
         STW,R2   FLAGS,R7            NOT ACTIVE
         B        CHSTS3
         REF      Y7FFFFFFF
CHSTS5   LW,R2    PLB+9,R7          FOR ANLZ ABOVE
*
         PAGE
*F*
*F*      NAME:        GETCHST
*F*
*F*      PURPOSE:     GETS NEXT FIELD IF BUFFER IS EMPTY.
*F*
*F*      DESCRIPTION: GETCHST IS CALLED BY THE OTHER ROUTINES IN
*F*                   CHARROUT. IF THE CHARACTER STRING BUFFER IS
*F*                   EMPTY, THE NEXT CHARACTER STRING IS OBTAINED
*F*                   AND THE BUFFER IS MARKED FULL.
*F*
*F*
*F*      REFERENCE:   DATA BASE TECHNICAL MANUAL.
*F*
*        GETCHST-GETS THE NEXT CHAR STRING IF THE PARAM LIST BUFFER
*        IS EMPTY AND MARKS THE PARAM LIST BUFFER AS FULL. SETS
*        (R0) = (R1) = N, (R2) = BYTE ADR OF PARAM LIST BUFFER.
*        ENTER WITH ADR OF PARAM LIST IN R7, CUR CHAR OR 0 IN SR1.
*
*
GETCHST  EQU      %
         AND,R4   XF                RESET CC
         REF      XF
         LW,R3    Y2                CHECK
         AND,R3   FLAGS,R7               IF PARAM LIST BUF IS FULL
         BNEZ     GCHST1            BRANCH IF FULL
         PUSH     1,SR4
         BAL,SR4  CHSTSCAN          SCAN FOR CHAR STRING
         PULL     1,SR4
GCHST1   EQU      %
         LW,R1    CSL,R7
         LI,R2    BAPLB             (R2) = BYTE ADR OF PARAM LIST BUF
         LW,R3    Y2                SET
         STS,R3   FLAGS,R7               PARAM LIST BUF NOT EMPTY FLAG
         B        CHSTS30
         PAGE
*        SCAN ROUTINE EXITS.
*
COMEXIT1 EQU      %
         LW,R3    YDFFFFFFF         RESET BUFFER EMPTY FLAG
         AND,R3   FLAGS,R7
         STW,R3   FLAGS,R7
COMEXIT0 EQU      %
         PULL     SR4               SET CC1-4=0 AND EXIT
         LCI      K0
         B        *SR4
*
COMEXIT2 EQU      %
         PULL     SR4               SET CC1=1 AND EXIT
         LCI      K8
         B        *SR4
*
COMEXIT3 EQU      %
         LW,R3    YDFFFFFFF         RESET BUFFER EMPTY FLAG
         AND,R3   FLAGS,R7
         STW,R3   FLAGS,R7
         PULL     SR4               SET CC2=1 AND EXIT
         LCI      K4
         B        *SR4
         PAGE
*        00=  ILLEGAL CHARS.
*        01=  NUMERIC CHARS.
*        02=  ALPHABETIC CHARS. (A-F)
*        03=  ALPHABETIC CHARS. (G-Z) AND SPECIAL CHARS. %*-%:#@+UNDERLINE
C30      EQU      X'00000300'
C300     EQU      X'00030000'
C3000    EQU      X'03000000'
C33      EQU      X'00000303'
C3300    EQU      X'03030000'
C333     EQU      X'00030303'
C3333    EQU      X'03030303'
C222     EQU      X'00020202'
C2223    EQU      X'02020203'
C1100    EQU      X'01010000'
C1111    EQU      X'01010101'
         CSECT      0
CHTBL    EQU      %-19
         DATA     C30,0,0
         DATA     3,C3000           00033000
         DATA     C3000,0,0,C3300   3000000000003300
         DATA     0,0,C33,C3000         0 0 0 0 0 0 0 0 0 0 3 3 3 0 0 0
         DATA     C222,C2223,C3300,0    0 2 2 2 2 2 2 3 3 3 0 0 0 0 0 0
         DATA     C333,C3333,C3300,0    0 3 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C33,C3333,C3300,0     0 0 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     C222,C2223,C3300,0    0 2 2 2 2 2 2 3 3 3 0 0 0 0 0 0
         DATA     C333,C3333,C3300,0    0 3 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C33,C3333,C3300,0     0 0 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C1111,C1111,C1100,0   1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0
QC0      EQU      0
CLD      EQU      0
CONTR    EQU      1
OUTR     EQU      2
CCP      EQU      3
FLAGS    EQU      4
CBUF     EQU      4
CSL      EQU      5
PCCP     EQU      6
CCRSZ    EQU      7
PLB      EQU      8
BAPLB    EQU      4*PLB
         END

