*****************
*M*      GETFIELD OBTAIN NEXT FIELD FROM INPUT COMMAND
*****************
*                 CATALOG NO. 704891 - M:SYSCHR0 (SYSGEN PASS0 CHAR.SR.)
*P*
*P*      NAME:    GETFIELD
*P*      PURPOSE: OBTAIN NEXT FIELD OR TERMINATOR FROM
*P*               INPUT COMMAND
*P*      DESCRIPTION:  OBTAINS NEXT FIELD A CHARACTER AT A
*P*               TIME & DETERMINES IF IT IS A SPECIFIED
*P*               TERMINATOR (I.E., SPECIFIED BY CALLERS FPT),
*P*               & IF IT IS, RETURN TO CALLER WITH TERMINATOR
*P*               & NEXT FIELDS CHARACTER STRING IF ONE EXISTS.
*P*               IF NOT A TERMINATOR, A CHARACTER STRING IS
*P*               FORMED USING THE NON-TERMINATOR CHARACTERS
*P*               & EACH CHARACTER IS VALIDATED ACCORDING TO
*P*               CALLERS REQUEST, (I.E., HEXADECIMAL, OR
*P*               ALPHANUMERIC).
*P*
         PAGE
         SYSTEM   SIG7FDP
*                 SYMBOLIC REGISTER DEF'S.
         DEF      GETFIELD:         PATCHING DEF
GETFIELD: RES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
         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)  *R0
         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 1,NAME(1),AF(1),0,R0
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17 1,NAME(1),AF(2),0,R0
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17 1,NAME(2),AF(2),0,R0
         FIN
         FIN
         PEND
         PAGE
         DEF      HEXSCAN           SCAN NEXT FIELD FOR HEX.VALUE
         DEF      NAMSCAN           SCAN NEXT FIELD FOR ALPHANUMERIC
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K6       EQU      X'6'
K8       EQU      X'8'
K24      EQU      X'24'
K40      EQU      X'40'
K50      EQU      X'50'
KFF      EQU      X'FF'
KN1      EQU      -X'1'
KBLANK   EQU      ' '
KCRET    EQU      X'15'
KEOB     EQU      X'26'
KSCOLON  EQU      ';'
         PAGE
*D*
*D*      NAME:    NXACTCHR
*D*      DESCRIPTION:
*D*               NXACTCHR OBTAINS THE NEXT ACTIVE CHARACTER
*D*               FROM THE INPUT BUFFER. THE CHARACTER IS
*D*               CHECKED AGAINST A LIST OF DELIMITERS SPECIFIED
*D*               BY THE FPT. A DELIMITER IS A CHARACTER WHICH
*D*               TERMINATES A FIELD. IF A SEMICOLON IS FOUND,
*D*               THE USERS ROUTINE FOR PRINTING THE INPUT BUFFER
*D*               IS ENTERED IF ONE IS SPECIFIED IN FPT. THEN THE
*D*               NEXT RECORD IS OBTAINED BY ENTERING THE USER
*D*               ROUTINE TO READ RECORD AS SPECIFIED IN THE FPT.
*D*
*D*      INPUT:
*D*               R7 = ADDRESS OF FPT
*D*               R8 = CURRENT CHARACTER OR 0 (NO CHARACTER)
*D*
*D*      OUTPUT:
*D*               R8 = CURRENT CHARACTER
*D*               CC1 = 0 CURRENT CHARACTER NOT DELIMITER
*D*               CC1 = 1 CURRENT CHARACTER IS A DELIMITER
*D*
*D*  FPT FORMAT *********
*D*      WORD-0   BYTE 0      # DELIMITERS IN DELIMITER LIST
*D*               BYTES 1-3   BYTE ADDRESS OF DELIMITER LIST
*D*                           (LIST CONTAINS DELIMITERS AS
*D*                           EBCDIC CHARACTERS)
*D:      WORD-1   BYTE 0      CHARACTER POSITION WHERE TO START
*D*                           SCAN ON CONTINUATION RECORD
*D*               BYTES 1-3   ADDRESS OF ROUTINE TO READ CONTINUATION
*D*                           RECORD
*D*      WORD-2               ADDRESS OF ROUTINE TO
*D*                           DISPLAY RECORD TO BE CONTINUED
*D*      WORD-3               CURRENT CHARACTER POSITION
*D*                           (RELATIVE INDEX) WHERE SCAN GETS
*D*                           NEXT CHARACTER
*D*      WORD-4   BYTE 0      FLAGS
*D*                           = X'40' SET, BLANK INPUT BUFFER ONCE
*D*                                        CHARACTER OBTAINED
*D*                           = X'80' SET, BLANK IS AN ACTIVE
*D*                                        CHARACTER, I.E., DON'T
*D*                                        IGNORE IT
*D*                           = X'20' SET, CHARACTER STRING BUFFER
*D*                                        CONTAINS MEANINGFUL INFO
*D*               BYTES 1-3   INPUT BUFFER ADDRESS
*D*      WORD-5               # CHARACTERS IN CHARACTER STRING BUFFER
*D*      WORD-6               RELATIVE CHARACTER POSITION OF 1ST
*D*                           CHARACTER IN INPUT BUFFER FOR CURRENT
*D*                           CHARACTER STRING
*D*      WORDS-7-15           CHARACTER STRING BUFFER (IN EBCDIC)
*D*  END OF FPT **********
*D*
*D*      INTERFACE:  USERS DISPLAY ROUTINE (IF DESIRED IN FPT)
*D*               CALLED VIA R11
*D*               USER MUST SAVE ALL REGISTERS
*D*                  USERS READ CONTINUATION ROUTINE (IF DESIRED
*D*                  IN FPT)
*D*               CALLED VIA R11
*D*               USER MUST SAVE ALL REGISTERS
*D*      REGISTERS:  R1-R4,R8 USED, R7,R10-R11 SAVED
*D*
NXACTCHR EQU      %
         CI,SR1   K0                CHECK IF CUR CHAR = 0
         BNE      NXACH3            BRANCH IF NOT
NXACH1   EQU      %
         LW,R2    CCP,R7
         CI,R2    K50               CHECK IF CUR CHAR POSITION = 80
         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
         CI,SR1   X'0D'             CHECK FOR RETURN
         BE       NXACH51
         CI,SR1   KEOB              CHECK IF EOB
         BE       NXACH51
         LW,R1    FLAGS,R7
         CW,R1    Y4                CHECK IF IN BLANK-OUT MODE
         BAZ      NXACH2            BRACH IF NOT
         LI,R4    K40
         STB,R4   *R3,R2            BLANK OUT CUR CHAR IN RECORD
NXACH2   EQU      %
         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
         CI,SR1   KEOB              CHECK IF EOB
         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
         LCI      K0                SET  CC1 = 0
         B        *SR4              EXIT
NXACH9   EQU      %
         LCI      K8                SET CC1 TO INDICATE CUR CHAR IS DLM
         B        *SR4
*
NXACH5   EQU      %
         LI,SR1   KEOB              SET CUR CHAR  = EOB
NXACH51  EQU      %
         PUSH     SR4
         LW,R1    OUTR,R7
         BEZ      NXACH52
         BAL,SR4  *R1               LIST LAST RECORD
NXACH52  EQU      %
         PULL     SR4
         B        NXACH9
*
NXACH6   EQU      %
         PUSH     2,SR3
         LW,R1    OUTR,R7
         BEZ      NXACH7
         BAL,SR4  *R1               GO TO OUTR ROUTINE
NXACH7   EQU      %
         LW,R1    CONTR,R7
         BNEZ     NXACH7X           YES THERE IS A S.R.2 READ
         LI,SR3   0                 NO S.R. 2 READ CONTINUATION
         B        NXACH7Y
NXACH7X  EQU      %
         LB,R2    R1
         STW,R2   CCP,R7            SET CCP = CP (CONTINUATION POS)
         BAL,SR4  *R1               GET CONTINUATION RECORD
NXACH7Y  EQU      %
         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      K8                SET CC1 =1, ERR IN GETTING CONT
         B        *SR4                                            RECORD
         PAGE
*F*
*F*      NAME:    NAMSCAN
*F*      PURPOSE: SCAN FOR LEGAL ALPHANUMERIC FIELD
*F*
*D*
*D*      NAME:    NAMSCAN
*D*      DESCRIPTION:  NAMSCAN OBTAINS CHARACTER STRING UP TO
*D*               NEXT DELIMITER & CHECKS FOR A LEGAL ALPHANUMERIC
*D*               NAME (I.E., AT LEAST 1 ALPHABETIC CHARACTER
*D*               IS REQUIRED).
*D*
*D*      INPUT:   R7 = ADDRESS OF FPT
*D*               R8 = CURRENT CHARACTER OR 0
*D*
*D*      OUTPUT:  R8 = CURRENT CHARACTER (DELIMITER)
*D*               CC1 = 0 LEGAL NAME
*D*               CC1 = 1 ILLEGAL NAME
*D*
*D*      INTERFACE:  GETCHST,COMEXIT1,COMEXIT2.
*D*      REGISTERS:  R0-R7,R11-R15 SAVED
*D*
NAMSCAN  EQU      %
         PUSH     13,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
         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       COMEXIT2
         B        COMEXIT1
         PAGE
*F*
*F*      NAME:    HEXSCAN
*F*      PURPOSE: SCAN FOR HEXADECIMAL VALUE
*F*
*D*
*D*      NAME:    HEXSCAN
*D*      ENTRY:   COMEXIT1
*D*      ENTRY:   COMEXIT2
*D*      DESCRIPTION:  HEXSCAN OBTAINS CHARACTERS UP TO THE
*D*               NEXT DELIMITER & CHECKS FOR A LEGAL
*D*               HEXADECIMAL VALUE.
*D*
*D*               COMEXIT1 - NORMAL EXIT.
*D*               COMEXIT2 - ERROR EXIT.
*D*
*D*      INPUT:   R7 = ADDRESS OF FPT
*D*               R8 = CURRENT CHARACTER OR 0
*D*
*D:      OUTPUT:  R8 = CURRENT CHARACTER (DELIMITER)
*D*               CC1 = 0 LEGAL VALUE
*D*               CC1 = 1 ILLEGAL VALUE
*D*
*D*      INTERFACE:  GETCHST.
*D*      REGISTERS:  R0-R7,R11-R15 SAVED
*D*
HEXSCAN  EQU      %
         PUSH     13,SR4
         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
         LB,R3    CHTBL,R3
         BEZ      COMEXIT2          BRANCH IF NOT LEGAL ALPHANUMERIC
         CI,R3    K2                CHECKIF LEGAL HEX CHAR
         BG       COMEXIT2          BRANCH IF NOT
         AI,R2    K1
         BDR,R1   HEXS1             SET N =N-1
COMEXIT1 EQU      %
         LW,R3    YDFFFFFFF         RESET BUFFER
         AND,R3   FLAGS,R7                   EMPTY
         STW,R3   FLAGS,R7                        FLAG
         PULL     13,SR4
         LCI      K0                SET CC1 = 0
         B        *SR4              EXIT
COMEXIT2 EQU      %
         PULL     13,SR4
         LCI      K8                SET CC1 = 1
         B        *SR4              EXIT
         PAGE
*D*
*D*      NAME:    CHSTSCAN
*D*      DESCRIPTION:  OBTAINS THE NEXT CHARACTER STRING UP TO
*D*               THE NEXT DELIMITER AND MOVES THE STRING TO THE
*D*               FPT'S CHARACTER BUFFER.
*D*
*D*      INPUT:   R7 = ADDRESS OF FPT
*D*               R8 = CURRENT CHARACTER OR 0
*D*
*D*      OUTPUT:  R8 = CURRENT CHARACTER (DELIMITER)
*D:               CC1 = 0 STRING IS OK
*D*               CC1 = 1 STRING IS BAD
*D*      IF 'N' = 0 OR 'N' > 36, THEN THE STRING IS EITHER
*D*      NULL OR IS TOO LONG (I.E., 36 CHARACTERS MAX.).
*D*      'N' = # CHARACTERS IN CHARACTER STRING PRIOR TO DELIMITER
*D*
*D*      INTERFACE:  NXACTCHR
*D*      REGISTERS:  R0-R7,R11-R15 SAVED
*D*
CHSTSCAN EQU      %
         PUSH     13,SR4
         LI,R1    KBLANK
         LI,R2    BAPLB             (R2) = BYTE ADR OF PARAM LIST BUF
         LI,R3    K24
CHSTS1   EQU      %
         STB,R1   *R7,R2            FILL PARAM LIST BUFFER
         AI,R2    K1                            WITH BLANKS
         BDR,R3   CHSTS1
*
         LI,R2    K0                SET
         LW,R3    Y8                   BLANK
         STS,R2   FLAGS,R7                   NOT ACTIVE
*
         LI,R1    K0
         LI,R2    PLB
         AW,R2    R7
         LI,R3    K24
CHSTS2   EQU      %
         PUSH     3,R1
         BAL,SR4  NXACTCHR          GET NEXT ACTIVE CHAR
         BCS,8    CHSTS4            CHECK IF CHAR IS A DELIMITER
         LW,R3    Y8                SET
         STS,R3   FLAGS,R7              BLANK ACTIVE
         PULL     3,R1
         CI,R1    K0                CHECK IF FIRST CHAR OF FIELD
         BNE      CHSTS22
         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      %
         STW,R1   CSL,R7
         LI,R2    K0                SET BLANK NOT ACTIVE
         LW,R3    Y8
         STS,R2   FLAGS,R7
         PULL     13,SR4
         LC       Y8
         B        *SR4
CHSTS3   EQU      %
         STW,R1   CSL,R7            STORE N IN PARAM LIST
         LI,R2    K0                SET
         LW,R3    Y8                   BLANK
         STS,R2   FLAGS,R7                   NOT
         PULL     13,SR4                          ACTIVE
         LCI      K0                SET CC=0
         B        *SR4              EXIT
CHSTS4   EQU      %
         PULL     3,R1
         CI,R1    K0                CHECK IF  N= 0
         BNE      CHSTS3
         B        CHSTS21
         PAGE
*D*
*D*      NAME:    GETCHST
*D*      DESCRIPTION:  OBTAIN THE NEXT CHARACTER STRING IF THE
*D*               FPT'S CHARACTER STRING BUFFER IS EMPTY & MARKS
*D*               THE FPT'S CHARACTER STRING BUFFER AS FULL IN THE
*D*               FPT.
*D*
*D*      INPUT:   R7 = ADDRESS OF FPT
*D*               R8 = CURRENT CHARACTER OR 0
*D*
*D*      OUTPUT:  R1 = # CHARACTERS IN STRING
*D*               R2 = BYTE POSITION OF CHARACTER STRING BUFFER IN FPT
*D*               CC1 = VALUE RETURNED FROM CHSTSCAN
*D*
*D*      INTERFACE:  CHSTSCAN
*D*      REGISTERS:  R1-R4 USED, R11 SAVED
*D*
GETCHST  EQU      %
         LI,R4    K0
         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
         STCF     R4
         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
         LC       R4
         B        *SR4              EXIT
         PAGE
*  VALUE MEANINGS IN FOLLOWING TABLE INDEXED BY EBCDIC CHARACTER
*        00 =     NOT LEGITIMATE CHARACTER
*        01 =     DECIMAL DIGIT (0-9)
*        02 =     HEXADECIMAL DIGIT (A-F), OR ALPHABETIC
*                 CHARACTER (A-F)
*        03 =     ALPHABETIC CHARACTER (G-Z,|,%,-,:,#,@)
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'
CHTBL    DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 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     0,0,0,0               0 0 0 0 0 0 0 0 0 0 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     0,0,0,3               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3
         DATA     0,0,3,0               0 0 0 0 0 0 0 0 0 0 0 3 0 0 0 0
         DATA     0,0,0,C300            0 0 0 0 0 0 0 0 0 0 0 0 0 3 0 0
         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
PLB      EQU      7
BAPLB    EQU      4*PLB
Y2       DATA     X'20000000'
Y4       DATA     X'40000000'
Y8       DATA     X'80000000'
YDFFFFFFF DATA    X'DFFFFFFF'
         END

