         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.2 DATA MANIPULATION'
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RMCF     CNAME    1                                                     APR01
         PROC                                                           APR04
LF       BAL,L1   RDMCF             READ MCF CLUSTER
         SLS,R2   -1                BA(CLOC) TO HA
         DO       NUM(AF(1))                                            APR30
         LW,AF(1) R2                LOAD HA(CLOC)+/- HW OFFSET          APR31
         DO       NUM(AF(2))                                            APR40
         AI,AF(1) AF(2)                                                 APR41
         ELSE                                                           APR42
         AI,AF(1) -1                SET HA(CLOC)-1
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
         PROC                                                           APW03
         DO       NUM(AF(2))                                            APW11
LF       LI,R4    AF(2)             LOAD BA(CLOC)                       APW12
         ELSE                                                           APW13
         DO       NUM(AF(1))                                            APW132
LF       LW,R4    AF(1)             LOAD,SET HA(CLOC) TO BA             APW14
         AW,R4    R4                                                    APW15
         FIN                                                            APW16
         FIN                                                            APW17
         DO       NUM(AF(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1     AF(3)
         B        WRPOF             WRITE POF CLUSTER                   APW841
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         PEND                                                           APW90
* DIAG PROC                                                             APD
DX       CNAME                                                          APD00
         PROC                                                           APD01
* AF     DX       DIAG CODE,LINK                                        APD02
LF       LI,R1    AF(1)             LOAD DIAG CODE                      APD10
         DO       NUM(AF(3))
         B        DIAG
         ELSE
         DO       NUM(AF(2))
         LI,L1    AF(2)             LOAD LINK REGISTER
         B        DIAG              WRITE DMF CLUSTER                   APD242
         ELSE                                                           APD243
         BAL,L1   DIAG              WRITE DMF CLUSTER                   APD244
         FIN                                                            APD248
         FIN                                                            APD29
         PEND                                                           APD40
* LINK(OR LOAD) AND BRANCH PROC                                         APL
* LF     LAB,L/R  BRANCH ADDRESS,LINK ADDRESS(OR LOAD VALUE)            APL  1
LAB      CNAME                                                          APL01
         PROC                                                           APL04
LF       LI,CF(2) AF(2)             SET LINK REGISTER                   APL12
         B        AF(1)             BRANCH                              APL14
         PEND                                                           APL90
* LOAD,BRANCH AND LINK                                                  PRL
LBAL     CNAME    0                                                     PRL01
         PROC                                                           PRL02
* LF     LBAL,L-  BRANCH,LOAD VALUE,V-                                  PRL09
         DO       NUM(AF(3))                                            PRL20
         LI,AF(3) AF(2)             LOAD VALUE                          PRL22
         ELSE                                                           PRL23
         LI,V0    AF(2)             LOAD VALUE                          PRL24
         FIN                                                            PRL28
         DO       NUM(CF(2))                                            PRL40
         BAL,CF(2) AF(1)            BRANCH                              PRL42
         ELSE                                                           PRL43
         BAL,L1   AF(1)             BRANCH                              PRL44
         FIN                                                            PRL48
         PEND                                                           PRL99
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      MCBUF
         REF      PIA00,PIA02,PIA06,PIA08,PIA20,PIA22,PIA26,PIA28
         REF      PII00,PII02,PII20,PII22
         REF      PIL00,PIL02,PIL06,PIL20,PIL22,PIL26
         REF      PID10,PID11,PID12,PID14,PID16,PID18
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PPI10,PPI12
         REF      LIT00,PIX06
         REF      SSL00,SSL02
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF     VRPMD,VRPPD,VRPF,VPL00,VARF
         REF      BAA46
         REF      PDBP
         REF      DIAG
         DEF      DMVF
         DEF      STG:UST                                               COBOL42E
* REGISTER EQUIVALENCES
R0       EQU      1
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
* OP CODES
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CAW      EQU      X'3000'
CSTW     EQU      X'3500'           STW                                 C35
CLW      EQU      X'3200'                                               C32
COR      EQU      X'4900'           OR
CBR      EQU      X'6800'           B                                   C68
CBE      EQU      X'6830'           BE
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CBL      EQU      X'6910'           BL                                  C691
CBNE     EQU      X'6930'           BNE,BNEZ
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
* DATA DEF
DADB     EQU      X'0621'           BINARY
         PAGE
*
*  DATA MANIPULATION PROCESSOR ENTRY POINT
         DEF      BBD00
*
BBD00    RES      0
         STW,D1   NSTAG             SAVE NEXT SENTENCE TAG
         LI,D1    X'FFF'
         AND,D1   R6                SAVE D OF MCF
         STW,D1   OVTAG
         SLS,R6   -12
         B        %+1,R6            GO TO DIFFERENT PROCESSOR
         B        BBDS00            STRING
         B        BBDU00            UNSTRING
         B        BBDI00            INSPECT
*
*  EXAMINE PROCESSOR
*
BBDE00   RES      0                 EXAMINE
         BAL,L1   EIIN0
BBDE01   BAL,L0   NXMCF             READ NEXT MCF
         CI,R7    X'20'
         BANZ     BBDE10            REPLACING
         CI,R7    X'40'
         BAZ      BBDE02            NOT TALLYING DATA NAME
         LI,V0    X'0100'
         BAL,L1   STPC0
         B        BBDE01
BBDE02   MTW,1    OCHAF             SET ONE CHARACTER FLAG
         LW,V0    OVTAG
         CI,V0    X'20'
         BAZ      %+2               NO REPLACING FOLLOWS
         MTW,1    PARSF             SET PARAM SAVED FLAG
         LH,R7    1,R5
         CI,R7    X'0C'
         BAZ      BBDE04            NOT UNTIL FIRST
         LW,D2    PTCHA
         BAL,L0   PW010             PW0 FOR CHARACTERS
         MTW,1    CHARF             CHARACTERS FLAG
         LI,V0    X'0410'
BBDE03   BAL,L1   SEIEF
         BAL,L1   SNUM0             PARAM FOR LITERAL
         LW,L0    EBIT
         BNEZ     BBDI20            END OF STATEMENT
         STW,L0   PARSF
         B        BBDE01
BBDE04   CI,R7    1
         BANZ     BBDE05            LEADING
         LI,V0    X'0214'           ALL
         B        BBDE03
BBDE05   LI,V0    X'0218'           LEADING
         B        BBDE03
BBDE10   LW,V0    OVTAG             REPLACING
         CI,V0    X'40'
         BAZ      BBDE13            NO TALLYING PRECEEDING
         MTW,0    CHARF
         BNEZ     BBDE12
         LW,D2    PARSV
         OR,D2    L(X'10000000')    SET FOR REPLACING
         BAL,L0   PW010             OUTPUT PW0
         LW,D3    PARSV+1
         LI,V0    0
         BAL,L1   PDD00             OUTPUT PW1
         B        BBDE20
BBDE12   LW,D2    PRCHA
         BAL,L0   PW010             OUTPUT PW0 FOR REPLACING CHARACTER
         LI,R7    X'1410'
         STH,R7   PARSV             RESET FOR REPLACING
         B        BBDE20
BBDE13   CI,R7    X'04'
         BAZ      BBDE16            NOT CHARACTERS
         MTW,1    CHARF             CHARACTERS FLAG
         LW,D2    PRCHA
         BAL,L0   PW010             PW0 - CHARACTERS
         BAL,L0   SNUMC
         STW,D3   PARSV+1
         LW,V0    L(X'14100001')
         STW,V0   PARSV
         B        BBDE19+1
BBDE16   CI,R7    1                 REPLACING ONLY
         BANZ     BBDE17            LEADING
         CI,R7    2
         BANZ     BBDE18            FIRST
         LI,V0    X'1214'           ALL
         B        BBDE19
BBDE17   LI,V0    X'1218'           LEADING
         B        BBDE19
BBDE18   LI,V0    X'121C'           FIRST
BBDE19   BAL,L1   SNUM0
         BAL,L0   NXMCF             READ NEXT MCF - 'BY'
BBDE20   LI,V0    X'1310'           REPLACING BY
         MTW,0    CHARF
         BNEZ     %+2               PARAM SAVED
         BAL,L1   SEIEF
         BAL,L1   SNUM0
         MTW,0    CHARF
         BEZ      BBDI20            END OF STATEMENT
         LW,D2    PARSV
         OR,D2    L(X'20000000')    SET END OF STATEMENT FLAG
         BAL,L0   PW010             OUTPUT SAVED PW0
         LW,D3    PARSV+1
         LI,V0    0
         BAL,L1   PDD00
         B        BBDI20            END OF STATEMENT
*
*  INSPECT PROCESSOR
*
BBDI00   RES      0                 INSPECT
         BAL,L1   EIIN0
BBDI01   BAL,L0   NXMCF             READ NEXT MCF CLUSTER
         CI,R7    X'20'
         BANZ     BBDI10            REPLACING
         CI,R7    X'18'
         BANZ     BBDI07            BEFORE/AFTER
         CI,R7    X'40'
         BAZ      BBDI05            NOT TALLYING
         LI,V0    X'0100'
         BAL,L1   STPC0
         LW,R7    SVSTOP
         CI,R7    X'04'
         BAZ      BBDI04            NOT CHARACTERS
         LH,V0    PTCHA
         LI,D2    0
         BAL,L1   SEIEF
         BAL,L0   PW007             PW0 FOR CHARACTERS
BBDI02   MTW,0    EBIT
         BNEZ     BBDI20            END OF STATEMENT
         B        BBDI01
BBDI04   BAL,L0   NXMCF             READ NEXT MCF CLUSTER
BBDI05   CI,R7    X'01'
         BANZ     BBDI06            LEADING
         LI,V0    X'0214'           ALL
         B        BBDI08
BBDI06   LI,V0    X'0218'           LEADING
         B        BBDI08
BBDI07   LI,V0    X'0410'           BEFORE/AFTER
         CI,R7    X'08'
         BANZ     BBDI08            BEFORE
         AI,V0    4                 AFTER
BBDI08   BAL,L1   SEIEF
         BAL,L1   OPTW01            OUTPUT PW0 PW1
         B        BBDI02
BBDI10   CI,R7    X'04'             REPLACING
         BAZ      BBDI11
         MTW,1    OCHAF             CHARACTERS
         LW,D2    PRCHA
         BAL,L0   PW010             PW0 FOR CHARACTERS
         B        BBDI15
BBDI11   CI,R7    X'01'
         BANZ     BBDI12            LEADING
         CI,R7    X'02'
         BANZ     BBDI13            FIRST
         LI,V0    X'1214'           ALL
         B        BBDI14
BBDI12   LI,V0    X'1218'           LEADING
         B        BBDI14
BBDI13   LI,V0    X'121C'           FIRST
BBDI14   BAL,L1   OPTW01            OUTPUT PW0 PW1
         BAL,L0   NXMCF             READ NEXT MCF CLUSTER
BBDI15   LI,V0    X'1310'           BY
BBDI16   BAL,L1   SEIEF
         BAL,L1   OPTW01            OUTPUT PW0 PW1
         MTW,0    EBIT
         BNEZ     BBDI20            END OF STATEMENT
         BAL,L0   NXMCF             READ NEXT MCF CLUSTER
         CI,R7    X'18'
         BAZ      BBDI11            NOT BEFORE/AFTER
         LI,V0    X'1410'
         CI,R7    X'08'
         BANZ     BBDI16            BEFORE
         AI,V0    4                 AFTER
         B        BBDI16
BBDI20   LI,R7    0                 END OF EXAMINE, INSPECT
         STW,R7   OCHAF
         STW,R7   CHARF
         STW,R7   EBIT
         LW,D1    LINKP             PARAM ADDR
         LBAL     PRA01,CLI+CRR7    **** WRITE LI,R7 PARAM ADDR
         BAL,L1   PIX06
         TEXT     ':INS'            *** WRITE BAL,11 C:INS
         B        BAA02             RETURN
*
*  STRING PROCESSOR
*
BBDS00   RES      0                 STRING
         MTW,1    STG:UST           TURN ON STRNG/UNSTRNG FLG           COBOL42E
         LI,V0    X'4000'
         BAL,L1   EIIN2             INTO FIELD
         BAL,L0   NXMCF             READ NEXT MCF
         CI,R7    X'08'
         BAZ      BBDS02+1          NOT POINTER
         LI,V0    X'8000'
         BAL,L1   STPC0             PW/ PW1 FOR POINTER
BBDS02   BAL,L0   NXMCF             READ NEXT MCF
         CI,R7    X'01'
         BAZ      BBDS03            NOT DELIMITED DATA-NAME
         LI,L0    0
         STW,L0   SIZF              RESET SIZE FLAG
         LI,V0    X'2000'
         BAL,L1   OPTW00            PW0 PW1 FOR DELIMITED
         B        BBDS02
BBDS03   CI,R7    X'02'
         BAZ      BBDS04            NOT SIZE OPTION
         MTW,0    SIZF
         BNEZ     BBDS04            SIZE PARAM OUT ALREADY
         LW,D2    PSSIZ
         BAL,L0   PW010             PW0 FOR SIZE
         LI,D2    0
         BAL,L0   PW010             PW1 FOR SIZE
         MTW,1    SIZF
BBDS04   LI,V0    X'1000'
         CI,R7    X'80'
         BAZ      BBDS05            NOT LAST ENTRY
         LI,L1    X'10'
         STW,L1   EBIT              END OF STATEMENT BIT
BBDS05   BAL,L1   OPTW00            PW0 PW1 FOR SENDING
         LI,V0    0
         XW,V0    EBIT
         BEZ      BBDS02            NOT FINISHED
         LW,D1    LINKP             PARAM ADDRESS
         LBAL     PRA01,CLI+CRR7    *** WRITE LI,R7 PARAM ADDR
         BAL,L1   PIX06
         TEXT     ':STM'            *** WRITE BAL,11 C:STM
         LI,V0    0                                                     COBOL42E
         STW,V0   SIZF              CLEAR DELIMITED SIZE FLAG           COBOL42E
BBDS10   RES      0                                                     COBOL42E
         MTW,-1   STG:UST           RESET STRNG/UNSTRG FLG              COBOL42E
         LW,V0    NSTAG                                                 COBOL42E
         AW,V0    OVTAG
         BEZ      BAA02             NO OVERFLOW OPTION
         LI,V0    CBNE
         LW,D1    OVTAG             OVERFLOW TAG
         BAL,L1   PII02
         LW,D1    NSTAG
         LI,V0    CBR
         BAL,L1   PII02             OVERFLOW NST
         LW,D1    OVTAG
         BAL,L1   PPI12             OVERFLOW DEF
         B        BAA02             RETURN
*
*  UNSTRING PROCESSOR
*
BBDU00   RES      0                 UNSTRING
         MTW,1    STG:UST           SET STRING UNSTRING FLAG            COBOL42E
         LI,V0    X'0000'
         BAL,L1   EIIN2             UNSTRING DATA-NAME
BBDU01   BAL,L0   NXMCF             READ NEXT MCF
*        IF LINE CLUSTER IS HERE THEN THERE MUST HAVE AN ERROR          COBOL42E
*        IF THIS IS THE CASE THEN WE MUST GO BACK TO 42A                COBOL42E
         LH,V0    0,R2              LOAD CTRL BYTE                      COBOL42E
         AND,V0   K3FF              MASK OFF CTRL BYTE                  COBOL42E
         CI,V0    X'47'             SEE IF LINE NUMBER                  COBOL42E
         BNE      %+3               NO                                  COBOL42E
         LI,V0    X'1000'                                               COBOL42E
         STW,V0   EBIT              SET END OF STATEMENT BIT            COBOL42E
         CI,R7    X'34'
         BANZ     BBDU05            INTO GROUP
         CI,R7    X'08'
         BAZ      BBDU03            NOT POINTER
         LI,V0    X'4000'           POINTER
BBDU02   BAL,L1   STPC0             POINTER/TALLYING
         B        BBDU01
BBDU03   CI,R7    X'40'
         BAZ      BBDU04            NOT TALLYING
         LI,V0    X'2000'
         B        BBDU02
BBDU04   LI,V0    X'1000'           DELIMITED
         CI,R7    X'02'
         BAZ      %+2               NOT ALL OPTION
         AI,V0    X'10'             ALL BIT
         BAL,L1   OPTW00            PW0 PW1 FOR DELIMITED
         B        BBDU01
BBDU05   CI,R7    X'80'
         BAZ      BBDU06            NOT LAST OPERAND
         LI,V0    X'1000'
         STW,V0   EBIT              SET END OF STATEMENT BIT
BBDU06   CI,R7    X'04'
         BANZ     BBDU08            INTO OPTION
         CI,R7    X'10'
         BANZ     BBDU07            COUNT OPTION
         LI,V0    X'C000'
         BAL,L0   PW006             PW0 FOR DELIMITER
         BAL,L0   PW100             PW1 FOR DELIMITER
         B        BBDU15
BBDU07   LI,V0    X'A000'
         BAL,L1   STPC0             PW0 PW1 FOR COUNT
         B        BBDU15
BBDU08   LI,V0    X'8000'           INTO
         LH,D2    0,R2
         AND,D2   K30F
         STW,D2   TRFLG             SAVE CLASS
         CI,D2    5
         BNE      BBDU09            NOT NUMERIC EDITED
         LW,L0    PDBP
         CI,L0    X'200'            DECP COMMA FLAG
         BAZ      %+2
         MTW,1    DECPT             SET DECP COMMA FLAG
         LW,L0    PDBP+1
         SLS,L0   -16                TO THIRD BYTE
         STW,L0   EINFO+2
BBDU09   SLS,D2   4
         OR,V0    D2                SET CLASS
         BAL,L0   PW006             PW0 FOR INTO
         BAL,L0   PW100             PW1 FOR INTO
         LW,R7    TRFLG             CLASS
         CI,R7    5
         BG       BBDU15            NO EDITING
         BNE      BBDU10
         LH,L0    3,R5              DIGIT SIZE
         LI,R6    3
         STB,L0   EINFO+2,R6
         LI,R6    8
         B        BBDU11
BBDU10   CI,R7    3
         BL       BBDU15            NO EDITING
         AW,R5    R5
         LB,R6    5,R5              MASK DESCRIPTOR LENGTH
         AI,R6    3
BBDU11   STB,R6   EFILD             SAVE LENGTH
         LI,R3    BA(EINFO)+2
         STB,R6   R3
         AI,R2    8                 EDITING INFORMATION HA
         AW,R2    R2
         MBS,R2   0                 MOVE EDITING INFORMATION
         LW,R7    TRFLG
         CI,R7    5
         BNE      %+2               NOT NE
         MTB,2    EFILD
         LW,D3    EINFO             DISP OF EDITING MASK
         AW,D3    K4BAS               PLUS BASE
         LW,V0    EFILD
         MTB,2    V0
         LH,V0    V0
         BAL,L1   PDD00             WRITE EDITING MASK ADDR
         LI,R2    1
         LB,R3    EFILD
         AI,R3    1                 BYTE COUNT
         SLS,R3   -2                  TO WORD COUNT
BBDU12   LW,D2    EINFO,R2
         BAL,L0   PW010             WRITE EDITING INFORMATION
         AI,R2    1
         BDR,R3   BBDU12
BBDU15   LI,V0    0
         XW,V0    EBIT
         BEZ      BBDU01            NOT FINISHED
         LW,D1    LINKP             PARAM ADDRESS
         LBAL     PRA01,CLI+CRR7    *** WRITE LI,R7 PARAM ADDR
         BAL,L1   PIX06
         TEXT     ':MTS'            *** WRITE BAL,11 C:MTS
         B        BBDS10
*
*  DATA MANIPULATION COMMON ROUTINES
*
EIIN0    STW,L1   SAVL1
         LI,L0    X'8000'
         STW,L0   VBIT              SET VAR REC BIT
         LI,V0    X'0010'
         BAL,L0   PW001             OUTPUT PW0
EIIN1    STW,D1   LINKP             SAVE PARAM ADDR
         BAL,L0   PW100             OUTPUT PW1
         B        *SAVL1
EIIN2    STW,L1   SAVL1
         LI,L0    X'0008'
         STW,L0   VBIT              SET VAR REC BIT
         BAL,L0   PW006             WRITE PW0
         B        EIIN1
PW001    LH,R7    0,R2              LOAD MASK CLASS
         AND,R7   K30F
         CI,R7    6                 CLASS
         BNE      %+2               NOT NDS
         AI,V0    -X'10'
         MTW,0    OCHAF
         BEZ      PW006             SIZE LEGAL
         LH,D2    3,R2              BYTE SIZE
         CI,D2    1
         BE       PW006
         DX       X'114'            BYTE SIZE ILLEGAL
PW006    MTW,0    VRPF
         BEZ      %+2               NO VAR REC
         OR,V0    VBIT              SET VAR REC BIT
         LH,D2    3,R2              SIZE
PW007    OR,V0    EBIT              SET EOF BIT
         STH,V0   D2
PW010    RES      0
         LBAL     PDD04,DADB,D0     WRITE PW0
         B        *L0
PW100    LH,D1    1,R2              LOAD SUBSCRIPT INFO
         BNEZ     PW110             SUBSCRIPTED
         LH,D3    2,R2              BASE,DISP
         LH,V0    2,R5
         STH,V0   D3
         LB,V0    D3                BASE
         CI,V0    X'FF'
         BE       PW110             IN LINKAGE SECTION
         LI,V0    0
         XW,V0    DECPT             DECP OR DECP COMMA FLAG
         SLS,V0   24                TO FIRST BYTE
         BAL,L1   PDD00             WRITE PW1
PW105   MTW,0    VRPF
        BEZ      PW106             NO VAR REC
         LI,D2    0
         LBAL     PDD04,DADB,D0
         STW,D1   DMVF
        LI,R6    0
        STW,R6   VARF
        LW,R6    VRPPD
        BAL,L1   VPL00             RESOLVE VAR REC
         LI,D1    0
         XW,D1    DMVF
         LBAL     PRA01,CSTW+CRR7   *** WRITE STW,R7 PARAM ADDR CELL
PW106   LI,D1    0
        STW,D1   VRPMD
        STW,D1   VRPPD
         B        *L0
PW110    LW,L1    GADNO
         STW,L1   SGDNO             SAVE GADNO
         BAL,L1   SSL00             CHECK SUBSCRIPT
         LI,D1    0
         XW,D1    DECPT
         BEZ      PW111             DECP = 0
         LBAL     PIA02,CLI+CRR7    WRITE LI,R7 DECP
         LI,D1    R2
         LBAL     PIA02,CSTB+CRR7   WRITE STB,R7 R2
PW111    LW,V0    GADNO
         SW,V0    SGDNO
         BEZ      PW112             NO ADCON USED
         SLS,V0   -2
         AI,V0    CLI+CRR7          FORM LI,R7 --
         BAL,L1   PIA02
         LW,D1    SGDNO
         LBAL     PRA01,COR+CRR7    WRITE OR,R7 PW0
         LBAL     PRA02,CSTW+CRR7   WRITE STW,R7 PW0
PW112    LI,D2    0
         LBAL     PDD04,DADB,D0
         LBAL     PRA01,CSTW+CRR2   *** WRITE STW,R2 ADCON
         B        PW105
STPC0    STW,L1   SAVL1             PW0 PW1 FOR TALLYING POINTER COUNT
         LH,D0    4,R5              DECP
         STW,D0   DECPT
         LH,R7    0,R2
         AND,R7   K30F              MASK CLASS
         AI,R7    -6
         SLS,R7   4
         OR,V0    R7                SET CLASS
         BAL,L0   PW006             OUTPUT PW0
         BAL,L0   PW100             OUTPUT PW1
         B        *SAVL1
SNUM0    STW,L1   SAVL1             SAVE L1
SNUM1    LI,D2    1                 ONE CHARACTER LIT
SNUM2    BAL,L0   PW007             OUTPUT PW0
         MTW,0    PARSF
         BEZ      %+2
         STW,D2   PARSV             SAVE PW0
         BAL,L0   SNUMC
         MTW,0    PARSF
         BEZ      %+2
         STW,D3   PARSV+1           SAVE BASE,DISP - LIT
         LI,V0    0
         BAL,L1   PDD00             WRITE PW1
         B        *SAVL1
SNUMC    LH,D0    0,R2
         AND,D0   K30F              MASK CLASS
         BEZ      SNUMC1            FIGCON
         CI,D0    5
         BE       SNUMC1            FIGCON
         CI,D0    4
         BNE      SNUMC2            ANLIT
SNUMC1   AW,R2    R2                FIGCON
         LB,D3    1,R2              FIGCON INDEX
         AW,D3    K4BAS             FIGCON BASE,DISP
         B        *L0
SNUMC2   BAL,L1   LIT00             ANLIT BASE,DISP
         B        *L0
NXMCF    BAL,L1   BAA46             READ NEXT MCF
         LH,R7    1,R5
         STW,R7   SVSTOP            SAVE STMT OPTION
         B        *L0
OPTW00   STW,L1   SAVL1
         LH,R7    0,R2
         AND,R7   K3FF              CONTROL BYTE
         CI,R7    X'90'
         BGE      OPTW02            LITERAL
         BAL,L0   PW006
         B        OPTW11
OPTW01   STW,L1   SAVL1             OUTPUT PW0 PW1
         LH,R7    0,R2
         AND,R7   K3FF              CONTROL BYTE
         CI,R7    X'90'
         BGE      OPTW02            LITERAL
         BAL,L0   PW001             PW0 PW1 FOR DATA-NAME
OPTW11   BAL,L0   PW100
         B        *SAVL1
OPTW02   CI,R7    X'90'
         BE       SNUM1             FIGCON
         CI,R7    X'94'
         BE       SNUM1             FIGCON-ZERO
         LH,D2    3,R2              ANLIT - SIZE
         MTW,0    OCHAF
         BEZ      SNUM2             USE ACTUAL SIZE
         CI,D2    1
         BE       SNUM2             OK - ONE CHAR
         DX       X'114',SNUM1      BYTE SIZE ILLEGAL
SEIEF    LW,L0    SVSTOP
         CI,L0    X'80'
         BAZ      *L1               NOT LAST OPERAND
         LI,L0    X'2000'
         STW,L0   EBIT              SET EOF BIT
         B        *L1
*
*  WORKING BUFFERS AND CONSTANTS
*
PTCHA    DATA     X'02000000'       CHARACTERS-TALLYING
PRCHA    DATA     X'12000000'       CHARACTERS-REPLACING
PSSIZ    DATA     X'20100000'       DELIMITED SIZE PARAM
SIZF     DATA     0                 DELIMITED SIZE FLAG
STG:UST  DATA     0                 STRING UNSTRING FLAG FOR 42S        COBOL42E
VBIT     DATA     0                 VAR REC BIT
EBIT     DATA     0                 END OV STATEMENT BIT
DMVF     DATA     0
OVTAG    DATA     0                 D OF MCF
OCHAF    DATA     0                 ONE CHAR LIT FLAG
NSTAG    DATA     0                 E OF MCF
DECPT    DATA     0                 DECP
TRFLG    DATA     0                 TALLYING,REPLACING FLAG
SVSTOP   DATA     0                 STMT OPTION
CHARF    DATA     0                 CHARACTERS FLAG
PARSF    DATA     0
EFILD    DATA     0                 COUNT OF EINFO
EINFO    DATA     0                 EDITING INFORMATION
         RES      8
PARSV    RES      2                 SAVE PARAMETERS
LINKP    RES      1                 PARAM START ADDR
SGDNO    RES      1                 SAVE GADNO
SAVL1    RES      1                 SAVE L1
*
         REF      KBKON,K4BAS
K30F     EQU      KBKON+2
K3FF     EQU      KBKON+4
         END
