         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.1 - ACCEPT,DISPLAY'
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RCEF     CNAME    0                                                     APR00
RECF     CNAME    1                                                     APR01
RCRF     CNAME    2                                                     APR02
         PROC                                                           APR04
         DO       NAME>1                                                APR10
LF       BAL,L1   AAC00             READ CRF CLUSTER                    APR11
         ELSE                                                           APR12
         DO       NAME                                                  APR13
LF       BAL,L1   AAE00             READ ECF CLUSTER                    APR14
         ELSE                                                           APR15
LF       BAL,L1   *AF(3)            READ CRF/ECF CLUSTER                APR16
         FIN                                                            APR17
         FIN                                                            APR18
         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                                                     APR43
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
WMCF     CNAME    1                                                     APW01
         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       NAME                                                  APW80
         DO       NUM(AF(4))
         B        WRMCF             WRITE MCF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1    AF(3)             LOAD LINK REGISTER
         B        WRMCF             TO WRITE MCF CLUSTER
         ELSE                                                           APW812
         BAL,L1   WRMCF             WRITE MCF CLUSTER                   APW813
         FIN                                                            APW814
         FIN                                                            APW818
         ELSE                                                           APW82
         DO       NUM(AF(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1    AF(3)             LOAD LINK REGISTER
         B        WRPOF             TO WRITE POF CLUSTER
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         FIN                                                            APW85
         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              WRITE DMF CLUSTER
         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
*
         DEF      ABL00             ACCEPT
         DEF      ABM00             DISPLAY
         DEF      ABM10
         DEF      ABN00             STOP
         DEF      ACK00             EXHIBIT
         DEF      ABD00             EXAMINE
         DEF      ACL00             INSPECT
         DEF      ACM00             STRING
         DEF      ACN00             UNSTRING
*                                                                       AA0
         REF      WRPOF
         REF      WRMCF
         REF      DIAG
         REF      AAC00             READ
         REF      AA01,AA02,AA03    M.C. RETURNS
         REF      AA15,AA16,AA17    INTL DEF
         REF      AA18,AA19         INTL REF
         REF      AA46              BIN ADCON
         REF      AA49,AA50,AA51,AA52  ADCON
         REF      ADI00,ADI02       REF
         REF      PRA04
         REF      PRA24,PDB06,PDD04,PII02,PII22,PPI10,PPI30
         REF      STBAS
         REF      MCBUF
         REF      PDB
         REF      PDBS
         REF      GTMP              TEMP STG
         REF      GMSG              MAX. ACCEPT/STOP LITERAL MSG LNG
         REF      GADNO             ADCON NO.
         REF      JAKON             CONSTANTS
         REF      JADAT             DATA
         REF      JASAV             SAVE AREA
         REF      JAMOD             MODEL CLUSTERS,BUFFER
         REF      JMCEX             EXHIBIT SWITCH
         REF      AVI00,ADV00
* REGISTER EQUIVALENCES
R0       EQU      0
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
CIR4     EQU      8
* DIAG CODE BASE EQUIVALENCES
XFS      EQU      148               S DIAG CODE BASE - FILE,RECORD
* MCF CLUSTER CLNG,CNTL
DABM     EQU      X'04C3'           ACCEPT,DISPLAY                       1
DABC     EQU      X'04C4'           MOVE
DABD     EQU      X'04C6'           EXAMINE,INSPECT,STRING,UNSTRING
DACC     EQU      X'04CC'           CONDITION CNTL
* MCF OPTIONS                                                            2
DABLO    EQU      X'30000'          ACCEPT                               3
DABMO    EQU      X'10000'          DISPLAY                              4
DABNO    EQU      X'20000'          STOP                                 5
DACKO    EQU      0                 EXHIBIT                              6
* SPECIAL MOVE OPTIONS                                                  10
DABCA    EQU      2                 ACCEPT                              11
DABCD    EQU      1                 DISPLAY                             12
DABCS    EQU      3                 STOP
DABCE    EQU      5                 EXHIBIT
* POF CLUSTER CLNG,CNTL
DAIA     EQU      X'0401'           CONSTANT
DAIX     EQU      X'0108'           XREF
DADX     EQU      X'0328'           EXTERNAL NAME
* OP CODES
CBE      EQU      X'6830'
CDST     EQU      X'7F00'
DBCAL    EQU      X'0410'           OP CODE - CAL1,1
*
CJIA     EQU      X'F0981'          AN
CJIFC    EQU      X'D0390'          FIGCON
CJIAL    EQU      X'D0691'          AN LIT
CISAV    EQU      X'80000'          SAVE FLAG
CLOP     EQU      X'80'           A LAST OPERAND                        A
* REF DATA TYPE CONTROL SETTINGS
IBDA     EQU      X'9100'
IBMDA    EQU      X'9040'
* TEMP WORK AREA                                                        21
DTWA     EQU      28                WA TMP WORK AREA
DTBA     EQU      DTWA*4            BA TMP WORK AREA                    22
* *** ACTUAL DTWA EQU 36(FOR 2 DECA SAVES)***
* HEADING LNG                                                           23
DMSGD    EQU      1                 DISPLAY/ACCEPT
DMSGA    EQU      8                 ACCEPT                              25
DMSGS    EQU      1                 STOP
TEMP     DATA     0
*                                                                       27
* ACCEPT                            TYPE = X'50'                        ABL
ABL00    RES      0                                                     ABL00
         LI,V2    IBMDA             LOAD REF CNTL                       ABM006
ABL02    RES      0                                                      4
         BAL,L1   ADI00             CHECK DREF                           6
         B        ABL04             INVALID DREF                         7
* VALID ACCEPT DREF                                                      8
         LI,V0    EBL02-2           LOAD EXU TABLOC
         BAL,L1   ABM05             CHECK,SET ACCEPT BLNG
         LI,D2    DABLO             LOAD OPTION                          9
         LW,D0    V1                LOAD DSIZ                           10
         BAL,L1   ABM24+1           WRITE ACCEPT CLUSTER                11
*                                                                       27
         LI,D1    DABCA             LOAD ACCEPT OPTION
         BAL,L1   ABM01+1           WRITE ACCEPT MOVE CLUSTER
*                        R7 = STMT OPTION                               15
ABL04    RES      0                                                     16
         CI,R7    CLOP              CHECK LAST OP FLAG                  17
         BANZ     AA01              E-O-ACCEPT
         BAL,L1   AVI00             INIT VAR PARAM TABL
         B        ABL02             MORE ACCEPT FIELD
* ACCEPT BLNG - SFLD TYPE
EBL02    RES      0
         LI,V1    16                FLL
         LI,V1    8                 FLS
         LI,V1    10                BIN
*                                                                       92
* DISPLAY                           TYPE = X'55'                        ABM
ABM00    RES      0                                                     ABM00
         LI,L1    ABM14             SET LINK REGISTER                   31
         AI,R2    1
         LH,D1    0,R2
         AI,R2    -1
         AND,D1   L(X'0F')          PRINTER OPTION
         STH,D1   TEMP              UPON PRINTER
         LI,D1    DABCD             LOAD DISPLAY OPTION                 35
ABM01    RES      0                                                     34
         LI,V2    IBMDA             LOAD REF CNTL                       ABM006
         LI,D0    DTBA+DMSGD        LOAD BA(TMP MSG AREA)
*                        V2 = REF CNTL                                  36
*                        D0 = BA(TMP MSG AREA)                          37
*                        D1 = SPECIAL MOVE OPTION                       38
*                        L1 = LINK REGISTER                             39
ABM02    RES      0                                                     ABM020
         STW,L1   ABMSAV            SAVE LINK REGISTER                  ABM0014
         AW,D1    MABCG             FORM CLNG,CNTL OPTION               42
         CI,D1    1                 CHECK MOVE OPTION
         BAZ      ABM06             ACCEPT
* DISPLAY/STOP/EXHIBIT
ABM04    RES      0                                                     43
         BAL,L1   ADI00             CHECK DREF                          ABM022
         B        *ABMSAV           INVALID DREF
*    THE  ORIGINAL TYPE  IS CHECKED TO SEE IF WE HAVE A COMP-3 OR       COBOL41E
*    DISPLAY  SIGNED  FIELD  IF SO  1 IS ADD  TO THE  DECIMAL SIZE      COBOL41E
*    SO THE SIGN MAY BE PRINTED                                         COBOL41E
         LH,L1    0,R4                                                  COBOL41E
         AND,L1   L(X'F')                                               COBOL41E
         CI,L1    6                                                     COBOL41E
         BE       %+3                                                   COBOL41E
         CI,L1    8                                                     COBOL41E
         BNE      %+2                                                   COBOL41E
         AI,V1    1                                                     COBOL41E
* VALID DREF                                                            ABM04
         LI,L1    ABM06             SET LINK REGISTER
         LI,V0    EBM05-2           LOAD EXU TABLOC
* CHECK,SET DISPLAY BLNG
*                        V0 = EXU TABLOC
*                        V1 = DIGIT/CHAR. SIZE (DSIZ)                   ABM04 9
ABM05    RES      0
         CI,R6    8                 CHECK CLASS
         BAZ      *L1               NON-NUMERIC
* NUMERIC
         CI,R6    4                 CHECK INDEX/BIN/FLP FLAG
         BAZ      *L1               DOWN. NC/ND/NLIT
* INDEX/BIN/FLP
         LH,R1    R6                LOAD SFLD TYPE
         EXU      *V0,R1            EXU ON SFLD TYPE
         B        *L1               RETURN
*                        V1 = DISPLAY BLNG
* DISPLAY BLNG - SFLD TYPE
EBM05    RES      0
         LI,V1    22                FLL
         LI,V1    14                FLS
         LI,V1    11                BIN
ABM06    RES      0
         CI,D1    4                 CHECK EXHIBIT FLAG
         BAZ      ABM08             DOWN. NOT EXHIBIT
* EXHIBIT
         AI,V1    1                 DSIZ = DSIZ+1(SPACE)
ABM08    RES      0
         LW,D2    D0                LOAD DISPLAY FLD DISPL              46
         AW,D0    V1                DCNT = DCNT+DSIZ                    ABM042
         CI,D0    X'FF'+DTBA        CHECK FOR MAX SIZE
         BLE      *JMCEX            < MAX. SIZE
* S*****MAX. DISPLAY SIZE EXCEEDED**                                    ABM05
         DX       XFS+7             WRITE DMF CLUSTER
*                                                                       ABM06
         SW,D0    V1                DCNT = DCNT-DSIZ                    ABM062
         B        *ABMSAV           NO DISPLAY FLDS                     ABM064
*                                                                       ABM08
* VALID DISPLAY FLD                                                     ABM12
ABM10    RES      0                                                     ABM100
         STH,R6   D2                STORE DISPLAY FLD  TYPE,CLASS       52
         STH,V1   D3                STORE DSIZ                          ABM121
         WMCF     ,X'34'            WRITE SPECIAL GRP MOVE CLUSTER      ABM122
         LW,R4    R5                LOAD HA(CLOC)
         AI,R4    1
         AW,R4    R4                HA(CLOC) TO BA
         BAL,L1   ADV00             RESOLVE VAR PARAM
         BAL,L1   WRMCF             WRITE DREF
         B        *ABMSAV           RETURN                              54
*                                                                       55
ABM14    RES      0                                                     56
         CI,R7    CLOP              CHECK FOR LAST OP                   ABM082
         BANZ     ABM20             E-O-DISPLAY
         BAL,L1   AVI00             INIT VAR PARAM TABL
         B        ABM04             MORE DISPLAY FILD
* E-O-DISPLAY FIELDS                                                    ABM15
*                                                                       ABM20
ABM20    RES      0                                                     ABM200
         LI,D2    DABMO             SET DISPLAY OPTION                  61
         AW,D2    TEMP              UPON PRINTER
         CI,D0    DTBA+DMSGD        CHECK BA(TMP MSG AREA)              62
         BLE      AA01              </= INITIAL SETTING, NO VALID FLDS  63
ABM22    RES      0                                                     73
         LI,L1    AA01              SET LINK REGISTER                   64
* VALID DISPLAY FLDS                                                    75
*                        D0 = BA(E-O-MSG)
*                        D2 = STMT OPTION                               71
*                        L1 = LINK REGISTER                             72
ABM24    RES      0                                                     84
         AI,D0    -DTBA             OBTAIN MSG BLNG
*                        D0 = MSG BLNG                                  70
         AW,D2    D0                FORM STMT OPTION,MSG BLNG
         LI,D1    DABM              LOAD DISPLAY CLNG CNTL              85
         LI,R4    X'36'             LOAD BA(CLOC)
         AI,D0    -8*4+1            ADJUST MSG BLNG
         CW,D0    GTMP              CHECK TEMP STG SIZE                 ABM283
         BLE      WRMCF             </= MAX. MSG AREA
* > MAX USED                                                            82
         STW,D0   GTMP              UPDATE GTMP                         ABM293
*                                                                       ABM30
         B        WRMCF             WRITE MCF CLUSTER
         PAGE                                                           87
* STOP                              TYPE = X'69'                        ABN
ABN00    RES      0                                                     ABN00
         CI,R6    0                 CHECK REF TYPE,OPTION               ABN002
         BE       ABN10             = 0, STOP RUN                       ABN003
* STOP LITERAL/FIGCON                                                   ABN02
         LI,D1    DABCS             LOAD STOP OPTION
         BAL,L1   ABM01             WRITE SPECIAL MOVE TO MSG AREA      92
*                                                                       92
         LI,D2    DABNO             SET STOP OPTION                     95
         BDR,D0   ABM22             BA(MSG AREA) = BA(MSG AREA)-1
* STOP RUN                                                              ABN10
ABN10    RES      0                                                     ABN100
         WMCF     ,BA(KEXIT)+2,AA02 WRITE M:EXIT CLUSTER                ABN102
* EXHIBIT                           TYPE = X'70'                        ACK
ACK00    RES      0                                                     ACK00
         LW,L1    PDB               LOAD DEBUG FLAG
         CI,R6    1                 CHECK OPTION                        03
         BANZ     ACK80             NAMED OPTION
* CHANGED/CHANGED NAMED                                                 05
         LI,R3    HA(STBAS)+1       LOAD HA(STKTOP)+1
         LI,V2    IBMDA+CISAV       LOAD REF CNTL                       02
         CI,L1    X'800'            CHECK DEBUG FLAG
         BANZ     ACK01             UP
* DOWN, NO DEBUG
         LI,V2    IBMDA             NO SAVE
ACK01    RES      0
         LI,D2    0                 CLEAR STACK ANCHOR                  06
ACK02    RES      0
         BAL,L1   ADI00             CHECK EXHIBIT FLD                    5
         B        ACK22             INVALID EXHIBIT FLD
* VALID EXHIBIT FLD                                                      7
         CI,V2    CISAV             CHECK DEBUG FLAG
         BAZ      ACK22             DOWN. NO DEBUG
* DEBUG
         CI,R6    X'10'             CHECK SFLD TYPE
         BANZ     ACK40             = LIT/FIGCON/'NAME'
* DATA
         LW,R3    D2                SAVE STACK ANCHOR                    8
         LH,R1    3,R4              LOAD BSIZ
         LI,D2    DACC              FORM SIMPLE RELATION CLUSTER        12
         LH,D3    R6                *   (SFLD = RFLD TYPE)              13
         STH,D3   D3                                                    14
* INITIALIZE TEST DATA CLUSTER
         STH,V0   JADDC+4           STORE DECP
         LI,V0    X'FF'             REFORMAT CLNG,CNTL(NOT SUBSCRIPTED) 76
         AND,V0   R6
         AI,V0    X'900'                                                78
         LH,R1    3,R4              LOAD BSIZ
         CI,D3    X'10001'          CHECK SFLD TYPE                     15
         BNE      ACK03             SFLD NOT=  ND
* SFLD = ND                                                             17
         AI,D3    -1                RFLD = NC                           19
         AI,V0    2                 RFLD CLASS = NC
         SLS,R1   -1                BSIZ = BSIZ/2+1
         AI,R1    1
ACK03    RES      0                                                     19
         STW,V0   JADDC             STORE RFLD CLNG,CNTL
         STW,R1   JADDC+3           STORE BSIZ
         STH,V1   JADDC+3           STORE DSIZ
         AW,R4    R4                HA(CLOC) TO BA
         STD,R4   ACKSAV            SAVE BA(CLOC),HA(CLOC)-1
         BAL,L1   PRA24+1           WRITE SIMPLE RELATION CLUSTER       20
         LW,R4    ACKSAV            LOAD BA(CLOC)
         BAL,L1   ADV00             RESOLVE VAR REC PARAM
         BAL,L1   WRMCF             WRITE SFLD CLUSTER
* FORMAT MOVE RFLD TYPE
         CI,D3    7                 CHECK RFLD TYPE
         BAZ      ACK05             = NC
         BG       ACK04             RFLD = INDEX/BIN/FLP
* RFLD = AN/GRP
         AI,D3    X'E000D'
ACK04    RES      0                                                     37
         AI,D3    -1                ADJUST,CHECK RFLD TYPE
         CI,D3    X'C'
         BAZ      ACK05             RFLD = BIN/FLP
* RFLD = INDEX/AN/GRP
         AI,D3    X'FFFA'           ADJUST RFLD TYPE
ACK05    RES      0
         STW,D3   JADDC+2           SAVE MOVE SFLD, RFLD TYPE
* DEFINE TEST DATA
         CI,D3    X'20001'          CHECK SFLD TYPE
         BGE      ACK06             SFLD = BIN/FLP                      25
* SFLD = GRP/AN/NC/ND                                                   26
         STB,R1   MCBUF+2           STORE BSIZ
         LI,D2    X'400'            LOAD,FORM GLIT BASE DISPL           41
         LH,D1    PDBS                                                  42
         STH,D2   D1                                                    43
         LW,D0    R1                LOAD,POSITION HSIZ(=BSIZ/2)
         SLS,D0   7                                                     45
         AI,D0    X'4AD'            FORM AN DATA CLNG,CNTL
         AND,D0   K2FF7F                                                47
         STD,D0   MCBUF             STORE AN CNTL,BASE,DISPL            48
         AW,D1    R1                UPDATE GLIT DISPL
         STH,D1   PDBS                                                  51
         AND,R1   K2F00F            MASK,POSITION MOD(BSIZ,16)
         SLS,R1   4
         AI,R1    CDST+CIR4         FORM DST,BSIZ 0,R4
         SCS,R1   16
         DL,3     K20F              LOAD D'+0'                          57
         LI,R4    BA(MCBUF)+9       LOAD BA(DATA)                       58
         EXU      R1                EXU, DST,BSIZ 0,R4
         LW,D1    MCBUF+1           LOAD BASE,DISPL
         WPOF     ,BA(MCBUF)+2,ACK08      WRIT AN DATA
* SFLD = BIN/FLP                                                        61
ACK06    RES      0                                                     62
         BAL,L1   PDB06             WRITE                               63
         GEN,4,28 8,0               ****     X'80000000'
         CI,D3    X'20001'          CHECK SFLD TYPE
         BG       ACK08             SFLD = BIN/FLS                      66
         CI,D1    4                 CHECK WA BIT                        67
         BANZ     PDD04             UP. NOT DA ALIGNED
         MTW,4    GADNO             ADCON NO. = ADCON NO.+1             69
* WRITE TEST DATA CLUSTER
*                        D1 = BASE,DISPL
ACK08    RES      0                                                     73
         XW,D1    JADDC+2           STORE BASE,DISPL, LOAD SFLD,RFLD
*        WMCF     ,BA(JADDC)+2      WRITE TEST CLUSTER
         WMCF     ,BA(JADXC)+18     WRITE TEST CLUSTER
         LW,D3    JINTL             LOAD INTL NO.+1
         AI,D3    1
         LBAL     PII22,CBE         WRITE BE INTL
         LI,D0    DABC              LOAD MOVE CLNG,CNTL
         BAL,L1   PRA04+1           WRITE MOVE TO TEST AREA
         LW,R4    ACKSAV            LOAD BA(CLOC)
         BAL,L1   ADV00             RESOLVE VAR REC PARAM
         BAL,L1   WRMCF             WRITE SFLD CLUSTER
*        WMCF     ,BA(JADDC)+2      WRITE TEST CLUSTER
         WMCF     ,BA(JADXC)+18     WRITE TEST CLUSTER
ACK10    RES      0                                                      1
         LI,D0    DTBA+DMSGD        LOAD BA TMP MSG AREA
         LI,D1    DABCE             LOAD EXHIBIT(MOVE) OPTION
         AW,D1    MABCG
         LI,L1    ACK14             SET LINK                            10
         STW,L1   ABMSAV                                                11
         LW,R5    R3                LOAD,CHECK STACK ANCHOR
         BEZ      ACK16             = 0, NO AN CHAIN.
*   LIT/FIGCON/'NAME' CHAIN
         STW,R6   ACKSAV            SAVE SFLD CLNG CNTL
         LI,R6    CJIAL             LOAD AN LIT CNTL
ACK12    RES      0
         AI,R5    HA(STBAS)         FORM HA(CLOC)-1
         LH,V1    1,R5              LOAD DSIZ
         B        ABM06+2           WRITE DISPLAY MOVE
ACK14    RES      0
         LH,R5    0,R5              LOAD,CHECK LINK
         BNEZ     ACK12             NOT= 0, CONTINUE.
* = 0, E-O-CHAIN
         LW,R6    ACKSAV            LOAD SFLD CLNG CNTL
*                        R6 = TYPE,CLNG CNTL
ACK16    RES      0
         LW,R5    ACKSAV+1          RESTORE HA(CLOC)-1
         LH,V1    3,R5              LOAD DSIZ
         MTW,ACK18-ACK14 ABMSAV     SET NEW LINK
         B        ABM05-2           WRITE DISPLAY MOVE
*                        R7 = STMT OPTION
ACK18    RES      0
         LI,R3    HA(STBAS)+1       LOAD HA(STKTOP)+1
         CI,R7    CLOP              CHECK LAST OP FLAG
         BANZ     ACK20             UP. LAST OP.
*                        R2 = HA(NLOC)
         AI,R2    1                 HA(NLOC) = HA(NLOC)+1
         LH,R1    0,R2              LOAD, CHECK OPTION
         AI,R2    -1                RESET HA(NLOC)
         CI,R1    8
         BANZ     ACK20             'NAME' FLAG UP
         CI,R1    X'6000'           CHECK ANLIT/FIGCON FLAG
         BANZ     ABM04             UP. ANLIT LIT.
* DATA NAME
*                        R7 = LAST OP FLAG IF E-O-STATEMENT
ACK20    RES      0
         LI,D2    DACKO             LOAD EXHIBIT OPTION
         AI,D0    -DTBA-1           OBTAIN MSG BLNG
         BAL,L1   ABM24+1           WRITE EXHIBIT CLUSTER
         BAL,L1   PPI10             WRITE INTL DEF
ACK22    RES      0
         CI,R7    CLOP              CHECK LAST OP FLAG
         BANZ     AA01              E-O-EXHIBIT
         BAL,L1   AVI00             INIT VAR PARAM TABL
         B        ACK01             MORE EXHIBIT FIELD
* ANLIT/FIGCON/'NAME'
*                        R5 = HA(CLOC)-1                                 2
ACK40    RES      0
         STH,V1   1,R5              STORE DSIZ
         LI,V0    0                 RESET NEXT LINK
         STH,V0   0,R5                                                   5
         SW,R5    KHASTK            FORM LINK                            6
         XW,D1    R5                SAVE LAST LINK                       7
         CI,D2    0                 CHECK ANCHOR
         BNEZ     ACK44             NOT= 0. NOT FIRST ENTRY
* = 0. FIRST ENTRY                                                      10
         LW,D2    D1                LOAD ANCHOR                         11
         B        ACK02
* CHAIN CURRENT ENTRY                                                   20
ACK44    RES      0                                                     21
         STH,D1   STBAS,R5          LINK CURRENT ENTRY                  22
         B        ACK02
* NAMED
ACK80    RES      0
         CI,L1    X'800'            CHECK DEBUG FLAG
         BANZ     ACK82             UP. DEBUG
* DOWN, NO DEBUG
         MTW,-1   JMCEX             SET NO EXHIBIT SWITCH
ACK82    RES      0
         LI,D1    DABCE             LOAD EXHIBIT(MOVE) OPTION
         BAL,L1   ABM01             MOVE EXHIBIT FLD
*                        R7 = STMT OPTION
         CI,R7    CLOP              CHECK LAST OP FLAG
         BANZ     ACK83             E-O-EXHIBIT
         BAL,L1   AVI00             INIT VAR PARAM TABL
         B        ABM04             MORE DISP FIELD
ACK83    RES      0
         LW,L1    PDB               LOAD,CHECK DEBUG FLAG
         CI,L1    X'800'
         BANZ     ACK84             UP.
* DOWN. NO DEBUG
         MTW,1    JMCEX             RESET NO EXHIBIT SWITCH
         B        AA01
* DEBUG
ACK84    RES      0
         LI,D2    DACKO             LOAD EXHIBIT OPTION
         BDR,D0   ABM22             WRITE EXHIBIT CLUSTER
         B        AA01
*
         TITLE    'PHASE4.1 - DATA MANIPULATION'
*
* EXAMINE                           TYPE = X'59'
*                       R6 = STMT OPTION
ABD00    RES      0
         LI,D0    X'3000'
         LI,D1    1
         MTW,1    EXAMF             SET EXAMINE FLAG                    COBOL41E
         B        ACL01
*
* INSPECT                           TYPE = X'4D'
*                       R6 = STMT OPTION
ACL00    RES      0
         LI,D0    X'2000'
         LI,D1    0
ACL01    AND,R6   K3FF
         OR,D0    R6                TALLYING/REPLACING OPTIONS
         LI,V2    IBDA
         BAL,L1   EISU00
ACL02    BAL,L1   EISU07            READ NEXT CRF CLUSTER
         CI,V0    X'40'
         BAZ      ACL03             NOT TALLYING
         LI,V2    X'48'             NUMERIC
         B        ACL04
ACL03    LI,V2    IBDA
ACL04    BAL,L1   EISU02
         B        ACL02
*
* STRING                            TYPE = X'4E'
*                       R6 = STMT OPTION
ACM00    RES      0
         LI,D0    0
         B        ACN01
*
* UNSTRING                          TYPE = X'4F'
*                       R6 = STMT OPTION
ACN00    RES      0
         LI,D0    X'1000'
ACN01    STW,D0   SUSF              SET UNSTRING FLAG
         BAL,L1   EISU06
ACN02    LI,V2    IBDA
         BAL,L1   EISU00
ACN03    BAL,L1   EISU07            READ NEXT CRF CLUSTER
         CI,V0    X'58'             COUNT POINTER TALLYING
         BAZ      ACN04
         LI,V2    X'68'             NUMERIC INTEGER
         B        ACN10
ACN04    MTW,0    SUSF
         BEZ      ACN06             IN STRING
         CI,V0    X'04'             CHARACTERS
         BAZ      ACN09
ACN05    LI,V2    X'8D50'           EDITING ALLOWED
         B        ACN10
ACN06    CI,V0    X'04'
         BANZ     ACN09             INTO
         AND,V0   K20F
         CI,V0    X'900'
         BE       ACN05             NOT LITERAL
ACN09    LI,V2    IBDA
ACN10    BAL,L1   EISU02            OUTPUT MCF CLUSTER
         B        ACN03
EISU00   STW,L1   SAVL1
         STH,D0   D1
         LI,D0    DABD              LOAD CLNG,CNTL
         WMCF     ,X'32'            WRITE DATA MANIPULATION CLUSTER
         BAL,L1   ADI00
         B        EISU05            BAD DREF
         AW,R4    R4
         B        EISU03
EISU02   STW,L1   SAVL1
         BAL,L1   ADI00
         B        EISU05            BAD DREF
         LH,D0    0,R4
         AW,R4    R4
         AND,D0   K3FF
         CI,D0    X'90'
         BL       EISU03            NOT LITERAL
         CI,D0    X'94'
         BLE      EISU04
         MTW,0    EXAMF                                                 COBOL41E
         BNEZ     EISU01            EXAMINE                             COBOL41E
*
* CHANGE SINGLE DECIMAL DIGIT TO SINGLE CHAR
*      DIAGNOSE AS ILLEGAL FOR INSPRCT
*
         DX       X'17'
EISU01   RES      0                                                     COBOL41E
         LW,R1    R4                GET CLUSTER ADDR
         LB,L1    0,R4              GET CLUSTER LENGTH
         AI,L1    -1
         SLS,L1   1                 IN BYTES...OFFSET TO NUMMER
         AW,R1    L1
         LB,L1    0,R1              GET NUMMER
         SLS,L1   -4
         AI,L1    X'F0'             MAKE CHARACTER
         STB,L1   0,R1
         B        EISU04            GO WRITE IT....
EISU03   BAL,L1   ADV00             RESOLVE VAR REC
EISU04   BAL,L1   WRMCF             WRITE OPERAND CLUSTER
EISU05   RES      0                                                     COBOL41E
         CI,R2    0                                                     COBOL41E
         BE       EISU05A                                               COBOL41E
         LH,D0    0,R2                                                  COBOL41E
         AND,D0   =X'80'                                                COBOL41E
         BNEZ     EISU05B           NEXT STATEMENT CLUSTER READ         COBOL41E
EISU05A  RES      0                                                     COBOL41E
         LH,D0    1,R5                                                  COBOL41E
         CI,D0    CLOP
         BAZ      *SAVL1            NOT LAST OPERAND                    COBOL41E
EISU05B  RES      0                                                     COBOL41E
         LI,L1    0
         STW,L1   EXAMF             RESET EXAMINE FLAG
         B        AA01              EXIT                                COBOL41E
EISU06   LI,D1    0
         AND,R6   K2FF
         CW,R6    K2E6
         BNE      *L1
         LH,D1    1,R2
         AW,D0    JINTL             NEXT STATEMENT LABEL
         MTW,1    JINTL
         AI,D0    1
         LI,R2    0                 FORCE TO READ NEXT CLUSTER
EISU07   STW,L1   SAVL1
         AI,R2    0
         BNEZ     %+2               MCF READ ALREADY
         BAL,L1   AAC00             READ NEXT CRF CLUSTER
         LI,R5    1
         AW,R5    R2
         LH,V0    0,R5
         B        *SAVL1
K2FF     DATA     X'FF00'
K2E6     DATA     X'E600'
SUSF     DATA     0
EXAMF    DATA     0                                                     COBOL41E
SAVL1    RES      1
KEXIT    DATA     DAIA              M:EXIT CLUSTER CLNG,CNTL
         CAL1,9   1                 M:EXIT CAL                          ABN104
K0FF     EQU      JAKON+1           1ST BYTE
K20F     EQU      JAKON+2           CLASS
K2F00F   EQU      JAKON+3           TYPE,NDIM
K2FF7F   EQU      JAKON+4
K303     EQU      JAKON+5
K3FF     EQU      JAKON+6           BYTE MASK
KHASTK   EQU      JAKON+X'20'
ABMSAV   EQU      JASAV+25          L1
MABCG    EQU      JAMOD+8           SPECIAL MOVE,0
JINTL    EQU      JAMOD+13          INTL DEF,NO.
         REF      JADXC
JADDC    EQU      JADXC+4           -,CNTL
         BOUND    8
ACKSAV   RES      2                 EXHIBIT
         DATA     1
         END
