         SYSTEM   SIG7FDP
         PAGE
         OPEN     NAME
         TITLE    'PHASE 1.1'
         REF      PICCUR,DBCNTR,DDBAT,DDBATC,NOSCAN,SCAN
         REF      NONNLIT,NUMBER,SBW,SEMICOL,SADNO,INTGR,SNC
         REF      SADGO,SYNTABLE,JUMPTBL,BYTESNWD,PHASEF,NAME
         REF      TBLSN1,SNW,INTEGER,DIAG,WREDF
         REF      STRING,HASHNUM,PICDEC,SKIP,SADNOSN,COLAFLG
         REF      COMMA,ENDSOUR,CONTROL,DBCURT,WRDRF,A,NOYES
         REF      CARDNO,RDIVON,EXNAME,ACCT,CCT,DCCT,DECCOM
         REF      PDBP,PDBQ,PDBW
         REF      STRING2,TMDATE,DATCF
         REF      FNFF,LENTH
         REF      MNTBL,WRXRF
         REF      SADIAG
         REF      PHASE1
         REF      CHARLIST,QUOTECHAR
         REF      FPERD,LIBCPY,REPLC,RNPTR
         REF      SFRPC,SLIBN,WORDR,PDBPN
         REF      HLNK11,AHLNK
         REF      HA%DNTIX,HA%DNT,PDBZ,HA%DNTND                         COBOL11
         REF      PDBCC
         REF      SRTPG                                                 COBOL11
         REF      PDBDBG                                                COBOL11
         DEF      COB11
         DEF      COB11DB                                               COBOL11
B1       EQU      2
B2       EQU      3
B3       EQU      5
B4       EQU      6
B5       EQU      7
B6       EQU      8
B7       EQU      9
B8       EQU      10
B9       EQU      1
B11      EQU      11
R7       EQU      7
R8       EQU      8
R9       EQU      9
R11     EQU       11
R6       EQU      6
SAD      EQU      SADNO
COB11DB  EQU      %                                                     COBOL11
IDPA     DATA     0                 IDENTIFICATION DIVISION
IDPAD    DATA     X'01020408'       DUPLICATION
         DATA     X'10204000'
IDPAO    DATA     X'7E7C7870'       ORDER
         DATA     X'60400000'
CFSC     DATA     0                 ENVIRONMENT DIVISION
CFSCO    DATA     X'02000000'       ORDER
CLFC     DATA     0                 CLAUSE
BB0      DATA,4   X'00800000'
BB1      DATA,4   X'00400000'
BB2      DATA,4   X'00200000'
CLUSTR   RES      12                CLUSTER STORAGE
STB4     GEN,32   0                 SAVE B4
ALLFLG   GEN,32   0                 'ALL' FLAG
DFLAG    GEN,32   0                 LITERAL FLAG
RFFKEY   GEN,32   0                 NUMBER FOR G IN FINTAB FOR RFF
RENAMI   GEN,32   0                 RENAMING FILE ADDRESS
BDDB1F   GEN,32   0                 'OPTIONAL' FLAG
SFCTR    GEN,32   0                 SAME AREA COUNTER
PRFNAM   GEN,32   0                 PREVIOUS FILE DB NUMBER
SINAM    GEN,32   0                 LITERAL NAME
ONOFF    GEN,32   0                 ON,OFF FLAG
ADINT    GEN,32   0                 POINT FOR INT OR SNT
RERINT   GEN,32   0                 SAVE FOR OUTPUT IN DDB OR PDB
DRFFLG   GEN,32   0                 DRF FLAG
CHAINF   GEN,32   0                 FIRST DB ADDRES OF FILE IN CHAIN
FILDBA   GEN,32   0                 SAVE FILE NAME AND BYTE COUNT
DBDREF   GEN,32   0                 SAVE DB NUMBER FOR DRF
SSCFLG   GEN,32   0
KEYF     DATA     0                 KEY FLAG
KEWDF    DATA     0
EIGHTN   DATA     18
RANDOM   DATA     0                 RANDOM FLAG
MNORD    DATA     0                 MNEMONIC-NAME ORDER
INT      TEXT     'DISC-R','MAGNETIC-TAPE','CARD-PUNCH',;               COBOL11

                  'CARD-READER','PAPER-TAPE-PUNCH',;                    COBOL11

                  'PAPER-TAPE-READER','TYPEWRITER','PRINTER',;          COBOL11

                  'DRUM','DISC'                                         COBOL11

SNT      DATA,4   C'PRIN'           IMPL-NAME TABLE
         DATA,4   C'TER '
         DATA,4   C'CONS'
         DATA,4   C'OLE '
         DATA,4   C'SWIT'
         DATA,4   C'CH-6'
         DATA,4   C'SWIT'
         DATA,4   C'CH-5'
         DATA,4   C'SWIT'
         DATA,4   C'CH-4'
         DATA,4   C'SWIT'
         DATA,4   C'CH-3'
         DATA,4   C'SWIT'
         DATA,4   C'CH-2'
         DATA,4   C'SWIT'
         DATA,4   C'CH-1'
CURTBL   GEN,32   X'F0F1F2F3'       ILLEGAL CURRENCY SIGN TABLE
         GEN,32   X'F4F5F6F7'
         GEN,32   X'F8F9C1C2'
         GEN,32   X'C3C44D5D'       C'CD()'       J & K REMOVED
         GEN,32   X'5ED7D9E2'       C';PRS'       L REMOVED, ; ADDED
         GEN,32   X'E5E7E95C'
         GEN,32   X'4E606B4B'
INTLNTH  DATA,1   0,4,4,7,10,17,16,11,10,13,6,0                         COBOL11

GENLNTH  LB,B4    INTLNTH,B2
DNTIX    DATA,2   0
         DATA,2   15                DEBUG-LINE
         DO       12
         DATA,2   0
         FIN
         DATA,2   1                 TALLY
         DO       38
         DATA,2   0
         FIN
         DATA,2   31                DEBUG-SUB-1
         DATA,2   0
         DATA,2   40                DEBUG-SUB-2
         DATA,2   0
         DATA,2   49                DEBUG-SUB-3
         DATA,2   0
         DATA,2   0
         DATA,2   7                 DEBUG-ITEM
         DO       42
         DATA,2   0
         FIN
         DATA,2   58                DEBUG-CONTENTS
         DO       17
         DATA,2   0
         FIN
         DATA,2   23                DEBUG-NAME
         DO       6
         DATA,2   0
         FIN
DNTHD    DATA,2   0                 DNT HEADR
         DATA,2   0
         DATA,2   0
         DATA,2   5
         DATA,6   C'TALLY '
         DATA,2   0
         DATA,2   3
         DATA,2   10
         DATA,6   C'DEBUG-'
         DATA,4   C'ITEM'
         DATA,2   0
         DATA,2   6
         DATA,2   10
         DATA,6   C'DEBUG-'
         DATA,4   C'LINE'
         DATA,2   0
         DATA,2   9
         DATA,2   10
         DATA,6   C'DEBUG-'
         DATA,4   C'NAME'
         DATA,2   0
         DATA,2   12
         DATA,2   11
         DATA,6   C'DEBUG-'
         DATA,6   C'SUB-1 '
         DATA,2   0
         DATA,2   15
         DATA,2   11
         DATA,6   C'DEBUG-'
         DATA,6   C'SUB-2 '
         DATA,2   0
         DATA,2   18
         DATA,2   11
         DATA,6   C'DEBUG-'
         DATA,6   C'SUB-3 '
         DATA,2   0
         DATA,2   21
         DATA,2   14
         DATA,6   C'DEBUG-'
         DATA,8   C'CONTENTS'
         BOUND    4
DNXRF    DATA     X'08000003'
         DATA     X'08000006'
         DATA     X'08000009'
         DATA     X'0900000C'
         DATA     X'0900000F'
         DATA     X'09000012'
         DATA     X'0A000015'
DHDBA    DATA     BA(DNTHD+4)+3
         DATA     BA(DNTHD+8)+3
         DATA     BA(DNTHD+12)+3
         DATA     BA(DNTHD+16)+3
         DATA     BA(DNTHD+21)+1
         DATA     BA(DNTHD+25)+3
         DATA     BA(DNTHD+30)+1
DBNL     DATA     X'0B0B0B0C'       BYTE LENGTH
         DATA     X'0C0C0F00'
DBXRFB   RES      10                DEBUG NAME XRF BUFFER
SETPF    LB,5     IDPAD,3           PARAGRAPH FLAG
         AND,5    IDPA
         BEZ      SETPF1
         LI,1     16                DUPLICATED
         BAL,11   DIAG
SETPF1   LB,5     IDPAD,3
         OR,5     IDPA
         STW,5    IDPA              SET FLAG
         LB,5     IDPAO,3
         AND,5    IDPA
         BEZ      SAD
         LI,3     15                OUT OF ORDER
         B        SADIAG
TESTIP   RES      0
TESTID   LI,5     0
         XW,5     IDPA
         CI,5     1
         BANZ     SAD
TESTID1  LI,3     14                PROGRAM-ID MISSING
         B        SADIAG
SETSF    LB,5     IDPAD,3
         AND,5    CFSC
         BEZ      SETSF1
         LI,1     13                DUPLICATED
         BAL,11   DIAG
SETSF1   LB,5     IDPAD,3
         OR,5     CFSC              SET FLAG
         STW,5    CFSC
         LB,5     CFSCO,3
         AND,5    CFSC
         BEZ      SAD
         LI,3     12                OUT OF ORDER
         B        SADIAG
TESTOC   MTW,0    SSCFLG
         BNEZ     SAD
         LI,5     1
         STW,5    SSCFLG
         CW,5     CFSC
         BANZ     SAD
         LI,3     11                CONFIGURATION MISSING
         B        SADIAG
TESTCP   LI,5     0                 CONFIGURATION SECTION
         XW,5     IDPA
         AND,5    L(X'3')
         CI,5     3
         BE       SAD
         B        TESTID1
SETCF    LB,5     IDPAD,3           SET CLAUSE FLAG
         AND,5    CLFC
         BEZ      SETCF1
         LI,1     18                CLAUSE DUPLICATED
         BAL,11   DIAG
SETCF1   LB,5     IDPAD,3
         OR,5     CLFC
         STW,5    CLFC              SET FLAG
         B        SAD
TESTOB   LI,5     0                 RESET CLAUSE FLAG
         STW,5    KEYF
         STW,5    RANDOM
         STW,5    KEWDF
         STW,5    CLFC
         B        SAD
STPHF1   MTW,1    PHASEF            SET PHASE FLAG
         B        SAD
STPHF2   LI,B3    3
         B        STPHF3+1
STPHF3   LI,B3    -1
         STW,B3   PHASEF
         LI,B3    0
         STW,B3   PDBQ
         LI,1     21                MISSING DIVISION DIAG
         BAL,11   DIAG
         B        SAD
PIDNAM   LB,2     BYTESNWD          PROGRAM NAME LENGTH
         CI,2     8
         BLE      %+2
         LI,2     8                 TRUNCATE TO 8 CHARACTERS
         LI,3     BA(PDBPN)-1
         STB,2    0,3               LENGTH
         LI,3     BA(PDBPN)
         STB,2    3
         LI,2     BA(STRING)
         MBS,2    0                 SAVE PROGRAM NAME IN PDBPN
         B        SADNO
ALFLG    LI,B2    0                 SET ALLFLG TO ZERO
         STW,B2   ALLFLG
         B        SADNO
STALL    LI,B2    1                 ALL FLAG
         STW,B2   ALLFLG
         B        SADNO
SRKWD    RES      0
         LW,B4    KEWDF
         BCR,3    SRKWD2
         MTW,-1   KEWDF
         B        SRKWD0
SRKWD2   LW,B4    COLAFLG
         BCR,3    SRKWD0
         MTW,1    KEWDF
         B        SADNO
SRKWD0   LI,B3    1
         CW,B3    CONTROL
         BNE      SRKWD05
         LI,B3    -1                SET END OF PHASE ABORT FLAG
         STW,B3   PHASEF
         B        PHASE1
SRKWD05  LI,B3    0
         STB,B3   NOSCAN
         BAL,B11  SCAN
         LI,B3    C'.'
         CB,B3    STRING
         BCR,3    SRKWD1
         LW,B3    COLAFLG
         BCR,3    SRKWD0
SRKWD1   RES      0
         LI,1     38
         BAL,11   DIAG
         B        SADNO
SLITF    AI,3     -1                LITERAL
         STW,3    DFLAG
         B        SADNO
WIDNT    MTB,1    EXNAME            SET NO DNT FLAG
         B        SAD
CLMA     MTB,1    EXNAME            SET NO DNT FLAG
         LW,B2    COLAFLG
         BCS,3    NOYES
         BAL,B11  SCAN
         LW,B2    COLAFLG           CHECK COLUMN A FLAG
         BCR,3    SADNOSN
         B        NOYES
IOCLMA   LW,B2    COLAFLG           CHECK COLUMN A FLAG
         BCS,3    SADNO
         LI,B9    49
         B        PRION+5
STOFF    LI,B2    2                 SET OFF FLAG
         B        STON+1
STON     LI,B2    1                 SET ON FLAG
         STW,B2   ONOFF
         B        SAD
STCHA    LI,B2    3                 SET ONE-CHA. LITERAL FLAG
         B        STON+1
PRION    LW,B2    INTGR             CHECK PRIORITY NUMBER
         BCR,2    %+3
         AI,B2    -49
         BCR,2    %+4
         LI,B9    28
         BAL,B11  DIAG
         B        SAD
         LW,B2    INTGR
         STW,B2   PDBP
         B        SAD
CKFN     LW,B3    FNFF
         BCR,3    SADNO
         B        SRKWD0
DDBFRM   LW,B5    LENTH
         LI,B4    0
         AI,B5    -50
         DW,B4    EIGHTN
         SW,B5    DBCNTR
         BCS,2    DDBFRM1
         MTW,1    FNFF
         LI,1     204
         BAL,11   DIAG
         B        SADNO
DDBFRM1  LB,B5    BYTESNWD
         AI,B5    -2
         BCR,2    %+4
         MTW,-1   DBCURT
         AI,B5    -4
         BCS,2    %-2
         LW,B2    DBCURT
         MTW,1    DDBATC
         LW,B3    DDBATC
         STW,B2   DDBAT-1,B3        SAVE  DDB ADDRESS
         MTW,1    DBCNTR
         LW,B4    DBCNTR
         LW,B5    BYTESNWD
         SLD,B4   24
         STW,B4   *B2
         LW,B5    B2
         SLS,B5   10
         LB,B4    BYTESNWD
         SLD,B4   -8
         AI,B5    2
         LI,B4    BA(STRING)
         MBS,B4   0                 MOVE FILE-NAME IN DB
         LI,B4    0
         LI,B5    -9
         STW,B4   -1,B2
         AI,B2    -1
         BIR,B5   %-2
         AI,B2    -1
         STW,B2   DBCURT
*
* SET FIELDS A AND D OF DDB
* FIELD D (NUMBER OF INSN/OUTSN'S) IS SET TO 3
* THIS SETTING IS ALSO MADE IN ROUTINE DDBFRM IN COBOL12
* FOR FILES WITHOUT SELECT STATEMENTS
*
         LW,B2    L(X'01000083')    COMPILER DEFAULT                    COBOL11
         STW,B2   *DBCURT
         MTW,-1   DBCURT
         B        *B1
SVFLN    LW,B2    DDBATC            CHECK DDB FORMED
         BCS,3    SVFLN1
         LI,B2    0
         STW,B2   FILDBA
         B        *B1
SVFLN1   LI,B5    BA(STRING)
         LB,B4    BYTESNWD
         STB,B4   B5
         LW,B4    DDBAT-1,B2
         LW,8     L(X'00FF0000')
         AND,8    0,6
         SLS,8    -16
         CB,8     BYTESNWD
         BCS,3    %+4
         SLS,B4   2
         CBS,B4   2
         BCR,3    %+3
         BDR,B2   SVFLN1
         B        SVFLN+2
         LW,B5    DDBAT-1,B2
         AI,B5    -10
         STW,B5   FILDBA
         B        *B1
STNAM    LW,B4    STRING            SAVE ONE CHARACTER NONNLIT
         STW,B4   SINAM
         LI,B4    1
         CB,B4    BYTESNWD
         BE       SADNO
         LI,1     22
         BAL,11   DIAG
         B        SADNO
SNAME    LI,B2    0                 CHECK SWITCH AND IMPLEMENTOR-NAMES
         STW,B2   ONOFF             SET MNEMONIC-NAME FLAG
         LI,B2    8
         LI,B5    BA(SNT)
SNAME0   STW,B5   ADINT
         LI,B4    8
         STB,B4   B5
         LI,B4    BA(STRING)
         CBS,B4   0
         BCS,3    SNAME2
         STW,B2   MNORD
         STB,B2   SINAM
         B        SAD
SNAME2   BDR,B2   SNAME1            FOR NEXT NAME
         LI,B3    0
         STW,B3   SINAM
         LI,B9    22                 SIDR 3291 ERROR 22 IF NOT SWITCH   COBOL11
         BAL,B11  DIAG               NAME                               COBOL11
         B        WIDNT                                                 COBOL11
SNAME1   LW,B5    ADINT
         AI,B5    8
         B        SNAME0
*
* NUMSN STORES THE SPECIFIED NUMBER OF INSN/OUTSN'S INTO FIELD D
* OF THE DDB. IF THE NUMBER IS GREATER THAN 255, THE VALUE 255 IS USED.
*
NUMSN    LW,B2    INTGR             PICK UP VALUE FROM INTEGER ROUTINE
         CI,B2    127               IF VALUE IS LARGER THAN 127         COBOL11
         BLE      %+2               USE 127                             COBOL11
         LI,B2    127                                                   COBOL11
         LI,B3    7
         STB,B2   *DBCURT,B3        STORE VALUE IN FIELD D OF DDB
         B        WIDNT             RETURN TO SAD
*
INAME    RES      0                                                     COBOL11

         LI,B2    10                CHECK IMPLEMENTOR NAME              COBOL11

         LI,B5    BA(INT)
         STW,B5   ADINT
         EXU      GENLNTH
         AWM,B4   ADINT
         STB,B4   B5
         LI,B4    BA(STRING)
         CBS,B4   0
         BCS,3    %+5
         SLS,B2   2
         LI,B3    8
         STB,B2   *DBCURT,B3        SAVE NUMBER IN V OF DDB
         B        WIDNT
         BDR,B2   INAME1
         LI,B9    22
         BAL,B11  DIAG
         B        WIDNT
INAME1   LW,B5    ADINT
         B        INAME+3
PICPON   BAL,B9   PICDEC            CALL PICDEC TO CHANGE . AND ,
         LI,B4    X'6B'
         STW,B4   DECCOM
         B        WIDNT
PICDOL   LI,B2    1
         CB,B2    BYTESNWD
         BNE      PICDOL2
         LB,B3    STRING
         LI,B4    BA(CURTBL)
         LI,B2    28     NOW ONLY 28 BYTES IN ILL CURTBL
PICDOL1  CB,B3    0,B4
         BNE      PICDOL3
PICDOL2  LI,1     27                ILLEGAL CURRENCY SIGN
         BAL,B11  DIAG
         B        WIDNT
PICDOL3  AI,B4    1
         BDR,B2   PICDOL1
         STB,B3   STRING2
         BAL,B9   PICCUR
         B        WIDNT
STFNO    BAL,B1   SVFLN             SET COUNTER,SAVE DB NUMBER
         LW,B2    FILDBA
         BCR,3    CHAIN+3
         STW,B2   CHAINF
         LW,B3    10,B2
         SLS,B3   -24
         STW,B3   PRFNAM
         LI,B1    1
         STW,B1   SFCTR
         B        SAD
CDDB     LW,B2    SFCTR             CHECK FILE NUMBER COUNTED
         BDR,B2   %+6
         LI,B9    32
         BAL,B11  DIAG
         LI,B2    0
         STW,B2   SFCTR
         B        SAD
         LW,B2    CHAINF
         SLS,B2   2
         AI,B2    2
         LW,B4    PRFNAM
         STB,B4   0,B2
         B        SAD
CHAIN    BAL,B1   SVFLN             UPDATE C OF DDB
         LW,B2    FILDBA
         BCS,3    %+4
         LI,B9    34
         BAL,B11  DIAG
         B        SAD
         LW,B3    10,B2
         SLS,B3   -24
         LW,B4    PRFNAM
         STW,B3   PRFNAM
         MTW,1    SFCTR
         SLS,B2   2
         AI,B2    2
         STB,B4   0,B2
         B        SAD
STDBAD   LI,B2    50
         STW,B2   PDBQ
         B        SAD
BDDB1    MTW,1    BDDB1F            STORE 'OPTIONAL'FLAG
         B        SAD
PRTDDB   BAL,B1   SVFLN             GO TO CHECK DB BLOCK
         LW,B3    FILDBA
         BCR,3    %+6
         LW,B4    3,B3
         BCS,3    PRTDDB1
         LI,1     127
         BAL,11   DIAG
         B        PRTDDB1
         BAL,B1   DDBFRM
         LW,B3    DBCURT
         AI,B3    1
         LW,B2    BDDB1F            UPDATE BIT 1 OF B OF DDB
         BCR,3    PRTDDB1
         LW,B4    0,B3
         EOR,B4   BB1
         STW,B4   0,B3
         MTW,-1   BDDB1F
PRTDDB1  STW,B3   RENAMI
         LW,B4    10,B3
         STW,B4   DBDREF
         LW,B4    HASHNUM
         STW,B4   5,B3
         LI,B4    X'2000'                                       EL27975 COBOL11
         AND,B4   PDBCC             IS OPTION 'XREF' ON ?       EL27975 COBOL11
         BEZ      TESTOB            NO, OUT                     EL27975 COBOL11
         LI,B4    X'FD80'           BUILD EPF FOR THE FILE      EL27975 COBOL11
         LW,B5    DBDREF                                        EL27975 COBOL11
         SLD,B4   8                                             EL27975 COBOL11
         STW,B4   CLUSTR                                        EL27975 COBOL11
         BAL,11   MVIJK                                         EL27975 COBOL11
         BAL,11   MVCD                                          EL27975 COBOL11
         STW,4    STB4              OUTPUT EPF                  EL27975 COBOL11
         LI,4     BA(CLUSTR)                                    EL27975 COBOL11
         BAL,11   WRDRF                                         EL27975 COBOL11
         LW,4     STB4                                          EL27975 COBOL11
         B        TESTOB
BDDB2    LW,B3    BB2               UPDATE BIT 2 OF B OF DDB
         EOR,B3   *RENAMI
         STW,B3   *RENAMI
         B        SAD
MDDB     LW,B3    BB0               UPDATE BIT 0 OF B OF DDB
         MTW,1    RANDOM
         B BDDB2+1
DDDB1    EQU      %                 RESERVE INTEGER
         LW,B2    INTGR             IF NON-ZERO......
         BNEZ     SAD                  GET OUT.
DDDB2    EQU      %                 RESERVE NO (OR 0)
         LW,B2    =X'80000000'      GET NO AREAS FLAG
         LW,B3    RENAMI            GET DDB WORD 0 ADDRESS              COBOL11
         STS,B2   1,B3              SET FLAG
         B        SAD               GET OUT
QDDB     LW,B2    INTGR             UPDATE R OF DDB
         LW,B5    FILDBA
         SLS,B5   1
         AI,B5    19
         STH,B2   0,B5
         B        SAD
PNAME    BAL,B1   SVFLN             SAVE FILE NAME ADDRESS
         B        SAD
FRNTB    BAL,B1   SVFLN             CHECK DB FOR FILE NAME
         LW,B2    FILDBA
         BCR,3    %+6
         LW,B4    4,B2
         BCR,3    FRNTB1
         LI,B9    22
         BAL,B11  DIAG
         B        SAD
         BAL,B1   DDBFRM            FORM DB IF NOT FIND
         LW,B2    DBCURT
         AI,B2    1
FRNTB1   MTW,1    RFFKEY
         LW,B4    RFFKEY
         LW,B3    RENAMI
         STW,B4   3,B2              RENAMED FLAG
         STW,B4   4,B3              RENAMING FLAG
         B        SAD
CONDN    LI,B4    -1                EVERY CONDITION-NAME OPTION
         B        VPDB+6
ODDB     BAL,B1   SVFLN             UPDATE O OF DDB
         LW,B2    FILDBA
         LW,B4    RERINT
         STW,B4   8,B2
         SLD,B4   -24
         LW,B4    10,B2
         B        VPDB+3
VPDB     LW,B4    RERINT            UPDATE V OF PDB
         SLD,B4   -24
         LI,B4    -1                CLOCK-UNIT OPTION
         SLD,B4   24
         LI,B3    0
         STW,B3   RERINT
         STW,B4   PDBW
         B        SAD
FEDFC    LW,B5    MNORD
         AI,B5    -7
         BLZ      FEDFC1
         STW,B5   MNORD             RESET MNORD                         COBOL11
         CI,B5    1
         BG       WIDNT             SUPPRESS CLUSTER
         LW,B4    MNTBL
         STW,B5   MNTBL+1,B4        SAVE 0/1  FOR DEVICE
         SLS,B4   1
         LW,B5    HASHNUM
         STH,B5   MNTBL+1,B4        SAVE REF NO
         MTW,1    MNTBL
         B        WIDNT
FEDFC1   LW,B5    SINAM             OUTPUT MNEMONIC NAME CLUSTER
         BCS,3    %+4
         LI,B9    29
         BAL,11   DIAG
         B        WIDNT
         LW,B4    ONOFF
         SLD,B4   -4
         LW,B4    HASHNUM
         BCR,1    %+3
         LI,B4    X'209'
         B        %+2
         LI,B4    X'208'
         SLD,B4   12
         STW,B4   CLUSTR
         BAL,11   MVIJK
         BAL,11   MVCD
         STW,4    STB4
         LI,4     BA(CLUSTR)
         BAL,11   WREDF
         LW,4     STB4
         B        WIDNT
DRFC     LI,B2    1                 DRF FLAG
         MTW,1    KEYF
DRFC1    STW,B2   DRFFLG
         B        SADNO
CKEY     LW,B2    RANDOM
         BCR,3    CKEY1
         LW,B2    KEYF
         BCS,3    TESTOB
         LI,1     201               RANDOM WITHOUT KEY
         BAL,11   DIAG
         LW,B2    BB0
         EOR,B2   *RENAMI
         STW,B2   *RENAMI
         B        TESTOB
CKEY1    LW,B2    KEYF
         BCR,3    TESTOB
         LI,1     200               KEY WITHOUT RANDOM
         BAL,11   DIAG
         LW,B3    BB0
         EOR,B3   *RENAMI
         STW,B3   *RENAMI
         B        TESTOB
RSDRF    LI,B2    0                 RESET DRFFLG
         B        DRFC1
GETRN1   LW,B2    DRFFLG            FORM DRF-KEY
         BCR,3    SAD
         LW,B4    HASHNUM
         BCR,1    %+3
         LI,B4    X'FB90'
         B        %+2
         LI,B4    X'FB80'
         LW,B5    DBDREF
         SLD,B4   8
         STW,B4   CLUSTR
         BAL,11   MVIJK
         BAL,11   MVCD
OUTDRF   STW,4    STB4              OUTPUT DRF
         LI,4     BA(CLUSTR)
         BAL,11   WRDRF
         LW,4     STB4
         B        SAD
GETRN2   LW,B2    DRFFLG            QUALIFIER
         BCR,3    SAD
         LW,B4    HASHNUM
         BCR,1    %+3
         LI,B4    X'FB91'
         B        %+2
         LI,B4    X'FB81'
         LW,B5    DBDREF
         SLD,B4   8
         STW,B4   CLUSTR
         BAL,11   MVIJK
GETRN3   AI,B8    2
         SLS,B8   -1
         STB,B8   CLUSTR
         B        OUTDRF
GETSTRM  LI,B1    2                 SUBSCRIPT
         LI,B4    X'D1'
         STB,B4   CLUSTR,B1
         LW,B2    INTGR
         STH,B2   CLUSTR+1
         LI,B8    4
         B        GETRN3+2
MVIJK    LI,B8    6                 IJK OF CLUSTER
         LW,B4    HASHNUM
         STH,B4   CLUSTR+1
         BCS,1    MVIJK1
         B        *11
MVIJK1   LB,B4    BYTESNWD          NEGATIVE
         LW,B2    B8
         STB,B4   CLUSTR,B2
         AI,B8    1
         LI,B5    BA(CLUSTR)
         AW,B5    B8
         STB,B4   B5
         AW,B8    B4
         LI,B4    BA(STRING)
         MBS,B4   0
         B        *11
MVCD     LI,B5    BA(CLUSTR)        CD OF CLUSTER
         AW,B5    B8
         LI,B4    4
         STB,B4   B5
         LI,B4    BA(CARDNO)
         MBS,B4   0
         AI,B8    6
         SLS,B8   -1
         STB,B8   CLUSTR
         B        *11
OVINT    LW,B4    INTGR             SAVE FOR OUTPUT IN DDB OR PDB
         STW,B4   RERINT
         B        SAD
YDATE    LW,B4    CARDNO
         STW,B4   TMDATE            SET DATE-COMPILED FLAG
         BAL,11   DATCF
         B        SADNO
COB11    LI,B2    WA(TBLSN1)        PHASE 1.1 INITIALIZATION
         STW,B2   SYNTABLE
         LI,B2    TBLJMP
         STW,B2   JUMPTBL
         LI,B2    HLNK11
         STW,B2   AHLNK
         LW,R7    *PDBZ
         AI,R7    1
         SLS,R7   1                  TO HALFWORD ADDRESS                COBOL11
         STW,R7   HA%DNTIX          TO DATA NAME INDEX ADDRESS          COBOL11
         AW,R7    R7
         LI,6     254
         STB,6    R7
         LI,6     BA(DNTIX)
         MBS,6    0                 MOVE DNTIX IN BUFFER
         LI,R8    0
         SLS,R7   -1
         STH,R8   0,R7
         AI,R7    1
         STW,R7   HA%DNT            DNT HW ADDRESS
         AW,R7    R7
         LI,6     136
         STB,6    R7
         LI,6     BA(DNTHD)
         MBS,6    0                 MOVE SKELETON DNT IN
         SLS,R7   -2
         AI,R7    8265              END OF DNT ENTRY
         CW,R7    PDBZ+5
         BLE      %+2
         LW,R7    PDBZ+5            LESS CORE AVAILABLE
         AI,R7    -11                                                   COBOL11
         SLS,R7   1                 IN HALFWORDS                        COBOL11
         STW,R7   HA%DNTND                                              COBOL11
SETQUOTE EQU      %                                                     SCAN
         LW,R7    CHARLIST+X'7D'
         LW,R11   CHARLIST+X'7F'
         LI,R6    X'7D'             SET SINGLE QUOTE (DEFAULT)          SCAN
         LI,R8    1                 WAS DOUBLE QUOTE                    SCAN
         AND,R8   PDBCC              OPTION SPECIFIED                   SCAN
         BEZ      %+3               NO.                                 SCAN
         XW,R7    R11
         LI,R6    X'7F'             YES. SET DOUBLE QUOTE               SCAN
         STW,R7   CHARLIST+X'7D'
         STW,R11  CHARLIST+X'7F'
         STB,R6   QUOTECHAR         STORE QUOTE CHARACTER               SCAN
         LI,4     0
         B        SADGO
YSRTINT  RES      0                                                     COBOL11
         LW,R6    INTGR             LOAD SPECIFIED MEMORY SIZE          COBOL11
         STW,R6   SRTPG             STORE IN SAVE AREA                  COBOL11
         B        SADNO                                                 COBOL11
YSRTWRD  RES      0                                                     COBOL11
         LW,R6    SRTPG                                                 COBOL11
         SLS,R6   -9                CHANGE NUMBER OF WORDS TO PAGES     COBOL11
         STW,R6   SRTPG             STORE                               COBOL11
         B        SADNO                                                 COBOL11
YSRTCHR  RES      0                                                     COBOL11
         LW,R6     SRTPG                                                COBOL11
         SLS,R6   -11               CHG CHARACTERS TO PAGES             COBOL11
         STW,R6   SRTPG                                                 COBOL11
         B        SADNO                                                 COBOL11
SETDBG   LW,3     L(X'09000000')
         STW,3    PDBDBG
         LI,1     X'2006'
         AND,1    PDBCC
         BCR,3    SADNO             NO XRF NECESSARY
         STW,4    STB4              SAVE REGISTER 4
         LI,4     BA(DBXRFB)
         LI,1     0
SETDBG1  LW,2     DNXRF,1           XRF FOR DEBUG-ITEM
         STW,2    DBXRFB
         LI,3     BA(DBXRFB+1)
         LB,2     DBNL,1
         STB,2    3
         LW,2     DHDBA,1
         MBS,2    0
         BAL,11   WRXRF             WRITE XRF CLUSTER
         AI,1     1
         MTB,0    DBNL,1
         BNEZ     SETDBG1
         LW,4     STB4
         B        SADNO                                                 COBOL11
TBLJMP   EQU      %
         B          SETCF
         B          SETPF
         B          SETSF
         B          SLITF                                               00000000
         B          A                                                   00000001
         B          ACCT                                                00000002
         B          ALFLG                                               00000003
         B          BDDB1                                               00000004
         B          BDDB2                                               00000005
         B          CCT                                                 00000006
         B          CDDB                                                00000007
         B          CHAIN                                               00000008
         B          CKEY                                                00000009
         B          CKFN                                                00000010
         B          CLMA                                                00000011
         B          COMMA                                               00000012
         B          CONDN                                               00000013
         B          DCCT                                                00000014
         B          DDDB1                                               00000015
         B          DDDB2                                               00000016
         B          DRFC                                                00000017
         B          ENDSOUR                                             00000018
         B          FEDFC                                               00000019
         B          FPERD                                               00000020
         B          FRNTB                                               00000021
         B          GETRN1                                              00000022
         B          GETRN2                                              00000023
         B          GETSTRM                                             00000024
         B          INAME                                               00000025
         B          INTEGER                                             00000026
         B          IOCLMA                                              00000027
         B          LIBCPY                                              00000028
         B          MDDB                                                00000029
         B          NAME                                                00000030
         B          NONNLIT                                             00000031
         B          NUMBER                                              00000032
         B          NUMSN                                               00000033
         B          ODDB                                                00000034
         B          OVINT                                               00000035
         B          PICDOL                                              00000036
         B          PICPON                                              00000037
         B          PIDNAM                                              00000038
         B          PNAME                                               00000039
         B          PRION                                               00000040
         B          PRTDDB                                              00000041
         B          QDDB                                                00000042
         B          RDIVON                                              00000043
         B          REPLC                                               00000044
         B          RNPTR                                               00000045
         B          RSDRF                                               00000046
         B          SBW                                                 00000047
         B          SEMICOL                                             00000048
         B          SETDBG                                              00000050
         B          SFRPC                                               00000053
         B          SLIBN                                               00000054
         B          SNAME                                               00000055
         B          SNC                                                 00000056
         B          SNW                                                 00000057
         B          SRKWD                                               00000058
         B          STALL                                               00000059
         B          STCHA                                               00000060
         B          STDBAD                                              00000061
         B          STFNO                                               00000062
         B          STNAM                                               00000063
         B          STOFF                                               00000064
         B          STON                                                00000065
         B          STPHF1                                              00000066
         B          STPHF2                                              00000067
         B          STPHF3                                              00000068
         B          TESTCP                                              00000069
         B          TESTID                                              00000070
         B          TESTIP                                              00000071
         B          TESTOB                                              00000072
         B          TESTOC                                              00000073
         B          VPDB                                                00000074
         B          WIDNT                                               00000075
         B          WORDR                                               00000076
         B          YDATE                                               00000077
         B          YSRTCHR                                             00000078
         B          YSRTINT                                             00000079
         B          YSRTWRD                                             00000080
         END
