*                 CATALOG NO. 704735 - SIGMA 5/7 BPM M:CHARROUT
       CSECT       1
         SYSTEM   SIG7FDP
*
*                 CHARACTER ROUTINES
*
*
       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
         REF      Y2
         REF      Y4
         REF      Y8
         REF      YDFFFFFFF
         REF      CCI120
         DEF      CHARSCAN
         DEF      CHSTSCAN
         DEF      DECSCAN
         DEF      HEXSCAN
         DEF      NAMSCAN
         DEF      COMEXIT1
         DEF      NXACTCHR
         DEF      QUOTSCAN
         DEF      BAPLB
         DEF      CONTR
         DEF      OUTR
         DEF      CCP
         DEF      FLAGS
         DEF      CBUF
         DEF      PCCP
         DEF      CSL
         DEF      CCRSZ
         DEF      PLB
         DEF      CHTBL                                                 735
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
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
*        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
         REF      GETVAL0,Y08,GETVAL4,GETACCN0
*
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
*        NAMSCAN-SCANS FOR LEGAL ALPHA NUMERIC NAME.
*        IF LEGAL CC1 =0, IF NOT CC1 = 1
*        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'5B'
         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       COMEXIT2
         B        COMEXIT1
         PAGE
         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
*        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
*        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
COMEXIT1 EQU      %
         LW,R3    YDFFFFFFF         RESET BUFFER
         AND,R3   FLAGS,R7                   EMPTY
         STW,R3   FLAGS,R7                        FLAG
COMEXIT0 RES      0
         B        GETACCN0
         PAGE
*        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
*        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
*
COMEXIT2 EQU      NXACH52
         PAGE
*        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
*        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
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      %-22
         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

