         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'COBOL RESIDENT'
*****
*****             PROGRAM DESCRIPTION BLOCK
*****
PDB      RES      0
PDBCC    RES      0                 COMPILER CONTROL WORD
PDBCCA   DATA,1   X'00'               CURRENT PHASE
PDBCCB   DATA,1   X'00'               CURRENT PASS
PDBCCC   DATA,2   X'0000'             PROGRAM OPTIONS
PDBA     DATA     F:W0              DCB LOCATION
PDBB     DATA     F:W1              DCB LOCATION
PDBC     DATA     F:W2              DCB LOCATION
PDBD     DATA     F:W3              DCB LOCATION
PDBE     DATA     F:W4              DCB LOCATION
PDBF     DATA     F:W5              DCB LOCATION
PDBG     DATA     F:W6              DCB LOCATION
PDBH     DATA     F:W7              DCB LOCATION
PDBI     DATA     F:W8              DCB LOCATION
PDBIA    DATA     F:W9              DCB LOCATION
PDBJ     DATA     0                 FILE DUMP SPECS.
PDBK     RES      0
PDBKA    DATA,2   0
PDBKB    DATA,2   0
PDBM     RES      0
PDBMA    RES      0                 1 BYTE
PDBMB    EQU      PDBLQ
PDBL     RES      0
PDBLQ    RES      0
PDBLA    DATA,2   21                REFERENCE NUMBER
PDBLB    DATA,2   0                 NO. OF DESCR. BLOCKS
PDBN     RES      0                 NO. OF BYTES IN DDB AREA
PDBO     RES      0
PDBOA    DATA,1   0
PDBOB    DATA,3   0                 NO. OF LAST DDD SEGMENT
PDBQ     EQU      PDBQA
PDBT     EQU      PDBTA
PDBU     EQU      PDBUA
PDBV     EQU      PDBVA
PDBQA    DATA,2   0                   SIZE OF BASE 0
PDBQB    DATA,2   0                   SIZE OF BASE 1
PDBR     RES      0
PDBRA    DATA,2   0                   SIZE OF BASE 2
PDBRB    DATA,2   0                   SIZE OF BASE 3
PDBS     RES      0
PDBSA    DATA,2   0                   SIZE OF BASE 4
PDBSB    DATA,2   0                   SIZE OF BASE 5
PDBTA    DATA,2   0                   SIZE OF BASE 6
PDBTB    DATA,2   0                   SIZE OF BASE 7
PDBUA    DATA,2   0                   SIZE OF BASE 8
PDBUB    DATA,2   0                   SIZE OF BASE 9
PDBVA    DATA,2   0                   SIZE OF BASE 10
PDBVB    DATA,2   0                 UNASSIGNED
PDBW     RES      0
PDBWA    DATA,1   0                   UNASSIGNED
PDBWB    DATA,3   0                   RERUN CLOCK-UNITS
CARDNO   RES      0                 CURRENT SOURCE LINE
PDBX     RES      0
PDBXA    DATA,2   0                   NUMBER
PDBXB    DATA,2   0                   SUB-NUMBER
PDBPL    DATA,1   0                 LINKAGE FLAG
         DATA,1   0
PDBPN    DATA,8   '        '        PROGRAM-ID NAME
         BOUND    4                                                     COBOL0
PDBY     DATA,1   5                 COMMON-STORAGE NAME
         DATA,5   'TALLY'
         BOUND    4
PDBZ     RES      0                 MEMORY ALLOCATION CELLS
PDBZ1    DATA     0                 WA START ACQUIRED MEMOR|
PDBZ2    DATA     0                 WA DINDEX
PDBZ3    DATA     0                 BA DINDEX
PDBZ4    DATA     0                 BA DB AREA
PDBZ5    DATA     0                 NUM DBS, WA DBINDX
PDBZ6    DATA     0                 WA END ACQUIRED MEMORY
PDBP1    RES      0
PDBP     RES      0
PDBPA    DATA,2   0
PDBPH    DATA,1   0
PDBPB    DATA,1   50
PDBP2    RES      0
         DATA,1   C'%'
         DATA,3   0
PDBTDB   DATA     0                 NO OF TDB'S                         COBOL0
PDBDBG   DATA     0                                                     COBOL0
PDBDBGC  DATA     0                 COUNT OF NUMBER OF DEBUG SECTIONS   COBOL0
ON:LINE  DATA     0                 FLAG FOR ON-LINE DEBUGGING          COBOL0
DBSIZE   DATA     0
*
* PDB DEFINITIONS
*
         DEF      PDB,PDBCC,PDBCCA,PDBCCB,PDBCCC,PDBA,PDBB,PDBC
         DEF      PDBD,PDBE,PDBF,PDBG,PDBH,PDBI,PDBJ,PDBK
         DEF      PDBKA,PDBKB,PDBM,PDBMA,PDBMB
         DEF      PDBL,PDBLA,PDBLB,PDBN,PDBO,PDBOA,PDBOB
         DEF      PDBQ,PDBQA,PDBQB,PDBRA,PDBRB,PDBS,PDBSA,PDBSB
         DEF      PDBT,PDBTA,PDBTB,PDBU,PDBUA,PDBUB
         DEF      PDBV,PDBVA,PDBVB,PDBWA,PDBWB,CARDNO
         DEF      PDBX,PDBXA,PDBXB,PDBY
         DEF      PDBZ,PDBZ1,PDBZ2,PDBZ3,PDBZ4,PDBZ5,PDBZ6
         DEF      PDBDBGC                                               COBOL0
         DEF      PDBR,PDBW,PDBPN,PDBPL
         DEF      PDBP,PDBP1,PDBPA,PDBPB,PDBP2
         DEF      SO%SEQ                                                COBOL0
         DEF      PDBTDB                                                COBOL0
         DEF      SRTPG                                                 COBOL0
         DEF      DBSIZE
         DEF      PDBDBG,ON:LINE                                        COBOL0
*
* REFERENCES TO SYSTEM DCB'S USED BY COBOL COMPILER
*
         REF      M:LO,M:LL                                             COBOL0
* RERERENCES TO COBOL DCB'S
         REF      F:W0,F:W1,F:W2,F:W3,F:W4,F:W5,F:W6,F:W7,F:W8
         REF      F:W9
         PAGE
*
* PRIORITY SEGMENTATION TABLE
*
         DEF      PRI
PRI      RES      0
         DO       25
         DATA     0
         FIN
         DEF      PDBMSL             MAX SEGMENT LENGTH
PDBMSL   DATA     0                  SET BY COBOL21, USED BY COBOL34
         PAGE
*
* TYPE ROUTINE
*    CONDITIONALLY TYPES (PDBJ) A MESSAGE
*    EXPECTS ADDRESS OF MESSAGE IN R4
*    LINKAGE REGISTER=R11
*
* CHANGE MADE TO DO M:PRINT INSTEAD OF M:TYPE                           COBOL0
*                                                                       COBOL0
         DEF      TYPE
TYPE     MTW,0    PDBJ
         BGE      *R11              NO TYPE UNLESS REQUESTED
         CAL1,2   TYPEPL
         B        *R11
TYPEPL   GEN,8,24 1,M:LL            M:PRINT MESSAGE                     COBOL0
         DATA     X'80000000'
         GEN,1,31 1,4               *R4                                 COBOL0
         PAGE
*
*    DIAGNOSTIC MESSAGE HANDLER
*
         DEF      DIAG
DIAG     RES      0
         LCI      0                 SAVE
         STM,0    REGS              REGISTERS
         LI,6     0
         CI,1     0                 IS DIAGNOSTIC # NEGATIVE?
         BGE      %+3                NO
         LI,6     1                  YES - PREPARE TO RELATE MESSAGE TO
         LCW,1    1                         PREVIOUS (NOT CURRENT) LINE
         CI,R1    500
         BGE      ERROR             DIAG NO.IMPLIES COMPILER ERROR
         LB,3     DCL,1             GET DIAGNOSTIC CODE
         CI,3     X'80'             IS THIS A FATAL DIAGNOSTIC?
         BAZ      %+3                NO
         LI,5     X'4000'            YES -
         STS,5    PDBP                SET ABORT INDICATOR
         CI,3     X'10'             IS THIS A PRECAUTIONARY DIAGNOSTIC?
         BAZ      DIAG1              NO - GO TO ISSUE THE MESSAGE
         LW,2     PDBCC              YES -
         CI,2     X'1000'           ARE TRIVIAL DIAGNOSTICS TO BE LISTED
         BAZ      DIAG2              NO - FORGET IT
DIAG1    STH,1    DM+1              PREPARE
         LW,4     CARDNO             AND
         CI,6     0                 WAS DIAGNOSTIC # NEGATIVE?
         BE       %+5                NO
         LH,2     CARDNO,6           YES - IS THERE A SUB-NUMBER?
         BNEZ     %+2                       YES - DECREMENT IT
         LI,6     X'10000'                  NO - DECREMENT MAIN NUMBER
         SW,4     6
         STW,4    DM                  OUTPUT
         LI,4     BA(DM)               A
         LI,2     6                     DMF
         BAL,11   WRDMF                  ITEM
DIAG2    AND,3    L(X'F')           COMPARE THIS SEVERITY LEVEL TO
         CW,3     SL                 HIGHEST PREVIOUSLY ENCOUNTERED
         BLE      %+2               NOT HIGHER - NO CHANGE
         STW,3    SL                RECORD NEW SEVERITY CODE
         LCI      0                 RESTORE
         LM,0     REGS               REGISTERS
         B        *11               RETURN
REGS     RES      16
DM       DATA     0
         DATA     0
SL       DATA     0
         DEF      SL                SEVERITY LEVEL
         PAGE
*  THIS TABLE IS CHANGED TO PROTECTION TYPE 01 IN ORDER TO DECREASE     COBOL0
*     THE NUMBER OF PAGES REQUIRED BY THE COMPILER...                   COBOL0
         CSECT    1                                                     COBOL0
*    DIAGNOSTIC MESSAGE INDEX
*
*    EACH ENTRY IS COMPOSED AS FOLLOWS:
*        BIT 0   - IF SET DENOTES A FATAL DIAGNOSTIC - COMPILATION IS
*                     ABORTED AT END OF CURRENT PHASE
*        BIT 1,2 - UNASSIGNED
*        BIT 3   - IF SET DENOTES A PRECAUTIONARY DIAGNOSTIS-LISTED
*                  ONLY IF 'DIAG' CONTROL COMMAND OPTION IS SPECIFIED
*        BIT 4-7 - SEVERITY LEVEL CODE
*
*                                   DIAG.#
DCL      DATA,1   X'00'                 0
         DATA,1   X'04'                 1
         DATA,1   X'10'                 2
         DATA,1   X'01'                 3
         DATA,1   X'04'                 4
         DATA,1   X'04'                 5
         DATA,1   X'04'                 6
         DATA,1   X'04'                 7
         DATA,1   X'02'                 8
         DATA,1   X'02'                 9
         DATA,1   X'02'                10
         DATA,1   X'04'                11
         DATA,1   X'02'                12
         DATA,1   X'02'                13
         DATA,1   X'02'                14
         DATA,1   X'02'                15
         DATA,1   X'02'                16
         DATA,1   X'8B'                17
         DATA,1   X'02'                18
         DATA,1   X'01'                19
         DATA,1   X'02'                20
         DATA,1   X'8B'                21
         DATA,1   X'07'                22
         DATA,1   X'07'                23
         DATA,1   X'07'                24
         DATA,1   X'04'                25
         DATA,1   X'07'                26
         DATA,1   X'04'                27
         DATA,1   X'04'                28
         DATA,1   X'04'                29
         DATA,1   X'07'                30
         DATA,1   X'07'                31
         DATA,1   X'07'                32
         DATA,1   X'07'                33
         DATA,1   X'04'                34
         DATA,1   X'07'                35
         DATA,1   X'07'                36
         DATA,1   X'04'                37
         DATA,1   X'07'                38
         DATA,1   X'07'                39
         DATA,1   X'8B'                40
         DATA,1   X'07'                41
         DATA,1   X'07'                42
         DATA,1   X'07'                43
         DATA,1   X'07'                44
         DATA,1   X'07'                45
         DATA,1   X'07'                46
         DATA,1   X'07'                47
         DATA,1   X'07'                48
         DATA,1   X'07'                49
         DATA,1   X'07'                50
         DATA,1   X'07'                51
         DATA,1   X'07'                52
         DATA,1   X'07'                53
         DATA,1   X'07'                54
         DATA,1   X'07'                55
         DATA,1   X'07'                56
         DATA,1   X'10'                57
         DATA,1   X'10'                58
         DATA,1   X'01'                59
         DATA,1   X'02'                60
         DATA,1   X'8B'             61                                  COBOL0
         DATA,1   X'06'                62
         DATA,1   X'07'                63
         DATA,1   X'07'                64
         DATA,1   X'02'                65
         DATA,1   X'04'                66
         DATA,1   X'04'                67
         DATA,1   X'07'                68
         DATA,1   X'07'                69
         DATA,1   X'07'                70
         DATA,1   X'07'                71
         DATA,1   X'07'                72
         DATA,1   X'07'                73
         DATA,1   X'07'                74
         DATA,1   X'07'                75
         DATA,1   X'07'                76
         DATA,1   X'07'                77
         DATA,1   X'07'                78
         DATA,1   X'06'                79
         DATA,1   X'10'             080  SEVERITY LEVEL REDUCED FROM 6
         DATA,1   X'06'                81
         DATA,1   X'06'                82
         DATA,1   X'06'                83
         DATA,1   X'06'                84
         DATA,1   X'07'                85
         DATA,1   X'07'                86
         DATA,1   X'06'                87
         DATA,1   X'07'                88
         DATA,1   X'07'                89
         DATA,1   X'07'                90
         DATA,1   X'04'                91
         DATA,1   X'07'                92
         DATA,1   X'07'                93
         DATA,1   X'07'                94
         DATA,1   X'07'                95
         DATA,1   X'07'                96
         DATA,1   X'07'                97
         DATA,1   X'07'                98
         DATA,1   X'02'                99
         DATA,1   X'02'               100
         DATA,1   X'07'               101
         DATA,1   X'07'               102
         DATA,1   X'07'               103
         DATA,1   X'07'               104
         DATA,1   X'07'               105
         DATA,1   X'04'               106
         DATA,1   X'04'               107
         DATA,1   X'02'               108
         DATA,1   X'87'                109
         DATA,1   X'06'               110
         DATA,1   X'07'               111
         DATA,1   X'07'               112
         DATA,1   X'04'               113
         DATA,1   X'07'               114
         DATA,1   X'07'               115
         DATA,1   X'07'               116
         DATA,1   X'87'                117
         DATA,1   X'0B'               118
         DATA,1   X'8B'               119
         DATA,1   X'04'               120
         DATA,1   X'07'               121
         DATA,1   X'8B'               122
         DATA,1   X'04'               123
         DATA,1   X'07'               124
         DATA,1   X'04'               125
         DATA,1   X'10'              126                                COBOL0
         DATA,1   X'04'               127
         DATA,1   X'10'               128
         DATA,1   X'10'               129
         DATA,1   X'01'             130                                 COBOL0
         DATA,1   X'10'               131
         DATA,1   X'04'               132
         DATA,1   X'10'               133
         DATA,1   X'10'               134
         DATA,1   X'10'               135
         DATA,1   X'07'               136
         DATA,1   X'07'               137
         DATA,1   X'07'               138
         DATA,1   X'06'               139
         DATA,1   X'04'               140
         DATA,1   X'07'               141
         DATA,1   X'07'               142
         DATA,1   X'07'               143
         DATA,1   X'07'               144
         DATA,1   X'07'               145
         DATA,1   X'07'               146
         DATA,1   X'10'               147
         DATA,1   X'0B'               148
         DATA,1   X'07'               149
         DATA,1   X'07'               150
         DATA,1   X'07'               151
         DATA,1   X'07'               152
         DATA,1   X'07'               153
         DATA,1   X'07'               154
         DATA,1   X'06'               155
         DATA,1   X'07'               156
         DATA,1   X'0B'               157
         DATA,1   X'0B'               158
         DATA,1   X'10'             159
         DATA,1   X'07'               160
         DATA,1   X'07'               161
         DATA,1    X'02'             162
         DATA,1   X'07'               163
         DATA,1   X'07'               164
         DATA,1   X'07'               165
         DATA,1   X'07'               166
         DATA,1   X'07'               167
         DATA,1   X'07'               168
         DATA,1   X'07'               169
         DATA,1   X'07'               170
         DATA,1   X'06'               171
         DATA,1   X'04'               172
         DATA,1   X'06'               173
         DATA,1   X'04'               174
         DATA,1   X'04'               175
         DATA,1   X'07'               176
         DATA,1   X'07'               177
         DATA,1   X'07'               178
         DATA,1   X'07'               179
         DATA,1   X'0B'               180
         DATA,1   X'07'               181
         DATA,1   X'07'               182
         DATA,1   X'06'               183
         DATA,1   X'07'               184
         DATA,1   X'07'               185
         DATA,1   X'07'               186
         DATA,1   X'0B'               187
         DATA,1   X'0B'               188
         DATA,1   X'0B'               189
         DATA,1   X'0B'               190
         DATA,1   X'0B'               191
         DATA,1   X'0B'               192
         DATA,1   X'0B'               193
         DATA,1   X'0B'               194
         DATA,1   X'0B'               195
         DATA,1   X'0B'               196
         DATA,1   X'0B'               197
         DATA,1   X'8B'             198
         DATA,1   X'0B'               199
         DATA,1   X'06'                200
         DATA,1   X'06'                201
         DATA,1   X'06'                202
         DATA,1   X'0B'                203
         DATA,1   X'8B'                204
         DATA,1   X'07'              205
         DATA,1   X'8B'              206
         DATA,1   X'07'             207
         DATA,1   X'07'             208
         DATA,1   X'0B'             209
         DATA,1   X'10'               210
         DATA,1   X'10'               211
         DATA,1   X'10'               212
         DATA,1   X'07'             213
         DATA,1   X'8B'                          214
         DATA,1   X'07'           215
         DATA,1   X'07'           216
         DATA,1   X'07'             217
         DATA,1   X'04'           218  REDUCED FROM 7                 A1COBOL0
         DATA,1   X'07'             219
         DATA,1   X'07'             220 COBOL21
         DATA,1   X'07'             221 COBOL41B
         DATA,1   X'8B'             222 RG LEVELS
         DATA,1    X'04'            223 PICTURE                         COBOL0
         DATA,1   X'03'                                                 COBOL0
         DATA,1   X'02'             COBOL12                             COBOL0
         DATA,1   X'10'             226 COBOL51                         COBOL0
         DATA,1    X'10'            COBOL41B   227                      COBOL0
         DATA,1   X'07'              228
         DATA,1   X'07'              229
         DATA,1   X'02'             230 COBOL14
         DATA,1   X'07'             231 SYNTAX14
         DATA,1   X'01'             232 SYNTAX13
         DATA,1   X'0B'             233 COBOL51
         DATA,1    X'04'               234 COBOL41B                     COBOL0
         DATA,1   X'07'             235 SCAN
         DATA,1   X'07'             236
         DATA,1   X'8B'             237
         DATA,1   X'8B'             238
         DATA,1   X'07'              239
         DATA,1   X'07'              240
         DATA,1   X'07'             241
         DATA,1   X'07'             242
         DATA,1   X'07'             243
         DATA,1   X'07'             244
         DATA,1   X'07'             245
         DATA,1   X'07'             246
         DATA,1   X'07'             247
         DATA,1   X'07'             248
         DATA,1   X'07'             249
         DATA,1   X'07'             250
         DATA,1   X'07'             251
         DATA,1   X'07'             252
         DATA,1   X'07'             253
         DATA,1   X'07'             254
         DATA,1   X'07'             255
         DATA,1   X'07'             256
         DATA,1   X'07'             257
         DATA,1   X'07'             258
         DATA,1   X'07'             259
         DATA,1   X'07'             260
         DATA,1   X'07'             261
         DATA,1   X'07'             262
         DATA,1   X'07'             263
         DATA,1   X'07'             264
         DATA,1   X'07'             265
         DATA,1   X'07'             266
         DATA,1   X'07'             267
         DATA,1   X'07'             268
         DATA,1   X'07'             269
         DATA,1   X'07'             270
         DATA,1   X'07'             271
         DATA,1   X'07'             272
         DATA,1   X'07'             273
         DATA,1   X'07'             274
         DATA,1   X'07'             275
         DATA,1   X'07'             276
         DATA,1   X'07'             277
         DATA,1   X'07'             278
         DATA,1   X'8B'             279  COBOL31/COBOL32                COBOL0
         DATA,1   X'07'             280 COBOL21                         COBOL21
         DATA,1    X'02'             281 COBOL41A
         DATA,1   X'8B'            282  COBOL00                         COBOL0
         DATA,1   X'10'             283 SCAN                            COBOL0
         DATA,1   X'8B'             284 SCAN
         DATA,1   X'8B'             285 COBOL13                         COBOL0
         DATA,1   X'07'             286 COBOL34 - EL                    COBOL0
         DATA,1   X'04'             287 COBOL41L C.W.
         DATA,1   X'07'             288 COBOL21                         COBOL0
         DATA,1   X'04'             289 COBOL12                        COBOL0
         DATA,1   X'07'             290 COBOL12  R.H.H.                 COBOL12
         DATA,1   X'00'             291  UNUSED                         COBOL0
         DATA,1   X'00'             292  UNUSED                         COBOL0
         DATA,1   X'00'             293  UNUSED                         COBOL0
         DATA,1   X'00'             294  UNUSED                         COBOL0
         DATA,1   X'00'             295  UNUSED                         COBOL0
*   END OF CSECT 01 FOR DCL TABLE                                       COBOL0
         USECT    DM                                                    COBOL0
         PAGE
         BOUND    4
*
* COMPILER ERROR PROCESSING
*
ERROR    RES      0
         LI,R3    10                 X
         AI,R1    -500              SET UP ID FOR PRINT
         STB,R1   ERPMESS1           X
         LI,R2    BA(ERPMESS1)       X
         STW,R2   CLUSTERA           X
         LI,R2    1                  X
         BAL,R6   COBIOPR           PRINT COMPILER MESSAGE AND ID
         LW,R3    =C'HEX '          MOVE HEX INTO PRINT LINE            COBOL0
         STW,R3   COBIOPBF                                              COBOL0
         LB,R3    PDB                                                   COBOL0
         CI,R3    X'19'             COBOL35                             COBOLO
         BE       %+3                                                   COBOLO
         CI,R3    X'11'             PHASE 42                            COBOLO
         BG       %+4              IF PASS PH 41 DO NOT STORE LINE NO   COBOL0
         LW,R3    PDBX                                                  COBOL0
         SLS,R3   -16                                                   COBOL0
         STH,R3   LINO             STORE LINE NUMBER                    COBOL0
         LI,R3    11               POINT TO TEXT (FOR COBIOPR)          COBOL0
         LI,R2    BA(LINO)                                              COBOL0
         STW,R2   CLUSTERA                                              COBOL0
         LI,R2    2                                                     COBOL0
         BAL,R6   COBIOPR1                                              COBOL0
         LB,R3    PDB                                                   COBOL0
         CI,R3    X'19'             COBOL35                             COBOLO
         BE       %+3                                                   COBOLO
         CI,R3    X'11'             PHASE 42                            COBOLO
         BG       %+3                                                   COBOL0
         LW,R3    PDBX                                                  COBOL0
         STH,R3   SUBNO            STORE SUB LINE NO                    COBOL0
         LI,R3    12               POINT TO TEXT                        COBOL0
         LI,R2    BA(SUBNO)                                             COBOL0
         STW,R2   CLUSTERA                                              COBOL0
         LI,R2    2                                                     COBOL0
         BAL,R6   COBIOPR1                                              COBOL0
         LI,R4    ERTMESS
         BAL,R11  TYPE+2             UNCONDITIONAL TYPE
         LI,R4    9                 LENGTH OF TYPED MESSAGE
         STB,R4   COBIOPBF
         LI,R4    COBIOPBF
         BAL,R11  TYPE+2             UNCONDITIONAL TYPE
         LI,R7    X'F8000'          ONLY LEAVE ON LS                    COBOL0
         AND,R7   PDB                                                   COBOL0
         STW,R7   PDB               AND CONTINUE                        COBOL0
         LI,R7    X'40'
         AND,R7   PDBJ              'CONT' OPTION SPECIFIED
         BEZ      ERROR1            NO -
         LI,R1    X'40'             YES-
         STB,R1   COBIOPBF
         LCI      0
         LM,0     REGS              RESTORE REGISTERS
         B        *R11              CONTINUE COMPILATION
ERROR1   RES      0
         LB,R2    PDB
         LI,R1    9
         LH,R2    PHASE,R2
         STH,R2   DUMPPL,R1         SET PHASE
         LCI      0
         LM,0     REGS
         CAL1,3   DUMPPL            DUMP CORE
DUMPPL   DATA     0
         DATA     PDB
         DATA     PDBMSL             MAX SEG LENGTH (FOR 34)
         TEXT     'COBOL   '
         LI,R7    X'80'
         AND,R7   PDBJ              'DUMP' OPTION SPECIFIED
         BEZ      EXIT
         M:TRAP    SNAP,(TRAP,ALL)          CHANGE TRAP CONDITIONS      COBOL0
         LI,R7     X'200'           ONE PAGE                            COBOL0
SNPLOOP  LW,R6     *PDBAD           THIS WILL EVENTUALL| TRAP           COBOL0
         LW,R5     PDBAD                                                COBOL0
         CW,R5      PDBZ6                                               COBOL0
         BG        SNAP                                                 COBOL0
         AWM,R7    PDBAD                                                COBOL0
         B         SNPLOOP          ADD ONE MORE PAGE                   COBOL0
PDBAD    DATA      COBIOFID                                             COBOL0
SNAP     RES       0                                                    COBOL0
         LW,R7    PDBAD                                                 COBOL0
         AI,R7    -512             SUBTRACT ONE PAGE                    COBOL0
         STW,R7   PDBAD                                                 COBOL0
         CAL1,3    DUMPPL1          DUMP OVERLAY IN CORE                COBOL0
DUMPPL1  DATA     0
         DATA     COBIOFID          START SECOND DUMP
         GEN,8,24 X'80',PDBAD                                           COBOL0
         TEXT      'SEG DUMP'                                           COBOL0
         CAL1,3    DUMPPL2          DUMP DYNAMIC AREA                   COBOL0
DUMPPL2  DATA      0                                                    COBOL0
         GEN,8,24 X'80',PDBZ1       LOW CORE                            COBOL0
         GEN,8,24  X'80',PDBZ6      HIGH CORE                           COBOL0
         TEXT      'DYNAMIC '                                           COBOL0
EXIT     B        PH5E              GO TO PHASE 6                       COBOL0
ERTMESS  DATA     X'13151540'
ERPMESS  TEXT     ' COMPILER ERROR '
ERPMESS1 DATA     0
LINO     DATA     C'****'                                               COBOL0
SUBNO    DATA     C'****'                                               COBOL0
PHASE    TEXT     '00101112131415202122'
         TEXT     '30313233344041425051'
         TEXT     '526061626335'                                        COBOLO
*
* TRAP HANDLER
*
         DEF      TRAP              REFERENCED BY COBOL00
TRAP     STW,R1   TRAPR1            ADDR OF PSD,REGS,TRAP LOC
         LD,R2    *R1
         STD,R2   TRAPPSD           TRAP PSD
         LW,R2    18,R1
         STW,R2   TRAPLOC           TRAP LOCATION (X'40'-X'43')
         LH,R2    PDBCC
         STH,R2   TRAPLOC            SET COBOL PHASE NUMBER
         LI,R3    0
         LI,R2    X'1FFFF'          MASK
         AND,R2   0,R1              PSD ADDRESS
         CW,R2    PDBZ6             UPPER LIMIT OF COBOL WORK AREA
         BG       %+2               INVALID
         LW,R3    *R2               PICK UP INSTRUCTION
         STW,R3   TRAPINS
         LCI      0
         LM,0     2,R1              REGISTERS AT TRAP TIME
         CAL1,3   %+1               DUMP TRAP INFORMATION
         DATA     0
         DATA     TRAPPSD,TRAPINS   LIMITS OF DATA
         TEXT     '**TRAP**'        TRAP IDENTIFICATION
         LI,R1    509               COMPILER ERROR 09
         BAL,R11  ERROR
         MTW,1    *TRAPR1           INCREMENT PSD
         CAL1,9   5                 M:TRTN  CONTINUE AFTER TRAP
*
         BOUND    8
TRAPPSD  DATA,8   0                 TRAP PSD
TRAPLOC  DATA     0                 TRAP LOCATION
TRAPINS  DATA     0                 TRAPPED INSTRUCTION
TRAPR1   DATA     0                 ADDRESS OF TRAP SAVE AREA
         PAGE
*
* ABNORMAL I/O HANDLER
*
ABN      EQU      X'9F'             INTERENAL COBOL I/O ABN CONDITION
         DEF      ABNERR
ABNERR   LI,R1    ABN
         STW,R10  R9                SAVEABNORMAL CODE
         STB,R1   R10
         CAL1,2   ABNERRPL
ABNERRPL DATA     X'10000000'       M:MERC PLIST
         PAGE
*
* PHASE 0 ENTRY
*
COB0     RES      0                                                     COBOL0
         CAL1,8   PLIST0            M:SEGLD PHASE 0.0
         LI,R2    X'00'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         B        COB00             TO PHASE 0.0
         REF      COB00
PH00E    EQU      %
         CAL1,8   PLIST1            M:SEGLD PHASE 1
         LI,R2    X'01'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         B        COB10             TO PHASE 1
         REF      COB10
PH1E     CAL1,8   PLIST2            M:SEGLD PHASE 2
         LI,R2    X'07'
         STB,R2   PDBCC
         B        COB20             TO PHASE 2
         REF      COB20
PH2E     CAL1,8   PLIST3            M:SEGLD PHASE 3
         LI,R2    X'0A'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         B        COB30             TO PHASE 3
         REF      COB30
PH3E     CAL1,8   PLIST4            M:SEGLD PHASE 4
         LI,R2    X'0F'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         BLZ      %-1
         B        COB40             TO PHASE 4
         REF      COB40
PH4E     CAL1,8   PLIST5            M:SEGLD PHASE 5
         LI,R2    X'12'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         B        COB50             TO PHASE 5
         REF      COB50
PH5E     CAL1,8   PLIST6            M:SEGLD PHASE 6
         LI,R2    X'15'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         B        COB60             TO PHASE 6
         REF      COB60
PH6E     RES      0
         CAL1,1   COBIVFPL
         CAL1,1   CLOSELOFPT      M:CLOSE M:LO,(SAVE)
         CAL1,9   1                 M:EXIT
         DEF      COB0,PH1E,PH2E,PH3E,PH4E,PH5E,PH6E
         DEF      PH00E
         PAGE
*
* PHASE 0 PLISTS
*
PLIST0   GEN,8,24 X'01',ECB
         DATA     PH00
PLIST1   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH10
PLIST2   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH20
PLIST3   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH30
PLIST4   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH40
PLIST5   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH50
PLIST6   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH60
PH00     TEXTC    'COBOL00'
CLOSELOFPT DATA,1 X'15'             FPT
         DATA,3   M:LO               TO
         DATA,4   X'80000000'         CLOSE M:LO DCB
         DATA,4   X'00000002'       WITH SAVE OPTION
PH10     TEXTC    'COBOL10'
PH20     TEXTC    'COBOL20'
PH30     TEXTC    'COBOL30'
PH40     TEXTC    'COBOL40'
PH50     TEXTC    'COBOL50'
PH60     TEXTC    'COBOL60'
ECB      EQU      0                                                     COBOL0
*
* ENTRY POINTS
*    OPEN IN-FILE
*
         DEF      COBIOOIF
*
*    OPEN OUT-FILE
*
         DEF      COBIOOOF
*
*    CLOSE IN-FILE
*
         DEF      COBIOCIF
*
*    CLOSE OUT-FILE
*
         DEF      COBIOCOF
         PAGE
*
*    READ CLUSTER
*
         DEF      RDEPF,RDDRF,RDRRF,RDRGF,RDXRFM
         DEF      RDEDF,RDECF,RDOLF
         DEF      RDIVF,RDCRF,RDOLFS
         DEF      RDDDD,RDPDD,RDMCF,RDILF
         DEF      RDPOF,RDXRF4
         DEF      RDRFF,RDSPD,RDCSF,RDRPF,RDXRFS,RDXRF5
         DEF      RDXRF,RDXRF6
         DEF      RDSPF,RDXRF7
         DEF      RDDMF,RDMPF,RDMPFS
         DEF      RDMDF,RDMDFS
         DEF      RDMDF4,RDMDF5,RDMDF6,RDMDF7
         DEF      RDMDFM,WRMDFM
*
*    WRITE CLUSTER
*
         DEF      WREPF,WRDRF,WRRRF,WRRGF,WRXRFM
         DEF      WREDF,WRECF,WROLF,WRCRFS
         DEF      WRIVF,WRCRF,WROLFS
         DEF      WRDDD,WRPDD,WRMCF,WRILF,WREPFS
         DEF      WRPOF,WREDFS
         DEF      WRRFF,WRSPD,WRCSF,WRRPF,WRXRFS
         DEF      WRXRF
         DEF      WRSPF
         DEF      WRDMF,WRMPF,WRMPFS
         DEF      WRMDF,WRMDFS
         DEF      COBIODB
         DEF      CLUSNUM
         DEF      COBIOLFC
         PAGE
*
* COBIO EQUALANTENCES
* REGISTERS EQUATES
*
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
COBIODCB EQU      PDBA
OBUFSIZE EQU      74*4
         PAGE
*
* COBIO ENTRY FOR ALL FILES USING DCB 0 TO READ
*
RDEPF    RES      0
RDDRF    RES      0
RDRRF    RES      0
RDRGF    RES      0
RDXRFM   RES      0
RDMPFS   RES      0
RDMDFM   RES      0
         LCI      0                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 1 TO READ
RDEDF    RES      0
RDECF    RES      0
RDOLF    RES      0
         LCI      1                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 2 TO READ
RDIVF    RES      0
RDCRF    RES      0
RDOLFS   RES      0
         LCI      2                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 3 TO READ
RDDDD    RES      0
RDPDD    RES      0
RDMCF    RES      0
RDILF    RES      0
         LCI      3                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
         PAGE
*
* COBIO ENTRY FOR ALL FILES USING DCB 4 TO READ
*
RDPOF    RES      0
RDMDF4   RES      0
RDXRF4   RES      0
         LCI      4                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 5 TO READ
RDRFF    RES      0
RDSPD    RES      0
RDCSF    RES      0
RDRPF    RES      0
RDMPF    RES      0
RDMDF5   RES      0
RDMDFS   RES      0
RDXRFS   RES      0
RDXRF5   RES      0
         LCI      5                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 6 TO READ
RDXRF    RES      0
         LCI      6                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 7 TO READ
RDSPF    RES      0
RDMDF7   RES      0
RDXRF7   RES      0
         LCI      7                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 8 TO READ
RDXRF6   RES      0
RDMDF6   RES      0
RDDMF    RES      0
         LCI      8                 DCB NUMBER
         B        COBIOGET          GOTO GET CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 9 TO READ
RDMDF    RES      0
         LCI      9                 DCB NUMBER
         B        COBIOGET          GO TO GET CLUSTER ROUTINE
         PAGE
*
* COBIO ENTRY FOR ALL FILES USING DCB 0 TO WRITE
*
WREPF    RES      0
WRDRF    RES      0
WRRRF    RES      0
WRRGF    RES      0
WRXRFM   RES      0
WRMPFS   RES      0
WRMDFM   RES      0
         LCI      0                 DCB NUMBER
         B        COBIOPUT          GOTO PUT CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 1 TO WRITE
WREDF    RES      0
WRCRFS   RES      0
WRECF    RES      0
WROLF    RES      0
         LCI      1                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 2 TO WRITE
WRIVF    RES      0
WRCRF    RES      0
WROLFS   RES      0
         LCI      2
         B        COBIOPUT          GOTO PUT CLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 3 TO WRITE
WREPFS   RES      0
WRDDD    RES      0
WRPDD    RES      0
WRMCF    RES      0
WRILF    RES      0
         LCI      3                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
         PAGE
*
* COBIO ENTRY FOR ALL FILES USING DCB 4 TO WRITE
*
WREDFS   RES      0
WRPOF    RES      0
         LCI      4                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 5 TO WRITE
WRRFF    RES      0
WRSPD    RES      0
WRCSF    RES      0
WRRPF    RES      0
WRMPF    RES      0
WRMDFS   RES      0
WRXRFS   RES      0
         LCI      5                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 6 TO WRITE
WRXRF    RES      0
         LCI      6                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 7 TO WRITE
WRSPF    RES      0
         LCI      7                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 8 TO WRITE
WRDMF    RES      0
         LCI      8                 DCB NUMBER
         B        COBIOPUT          GOTO PUTCLUSTER ROUTINE
* COBIO ENTRY FOR ALL FILES USING DCB 9 TO WRITE
WRMDF    RES      0
         LCI      9                 DCB NUMBER
         B        COBIOPUT          GO TO PUT CLUSTER ROUTINE
         PAGE
*
* COBIO OPEN IN-FILE ROUTINE
*    EXPECTS DCB NUMBER             IN R5
*    EXPECTS DCB NUMBER                   IN R5(POS=NORMAL)
*                                              (NEG=DDD)
*    EXPECTS BUFFER BYTE ADDRESS          IN R2(POS=CLUSTERED)
*                                              (0=NON CLUSTERED)
*                                              (NEG=NON SEGQUENTIAL)
*    EXPECTS TRAILER STORAGE AREA ADDRESS IN R3(NONSEQUENTIAL ONLY)
*    EXPECTS FWD/REV KEY                  IN R4(POS=FORWARD)
*                                              (NEG=REVERSE)
*
COBIOOIF STW,R4   COBIOXR+7         SAVE REGISTERS R4
         STW,R5   COBIOXR+8                        R5
         STW,R6   COBIOXR+9                        R6
         STW,R11  COBIOXR+10                       R11
         LI,R6    0                 SET TO FWD
         STW,R5   READDD,R5         SET/RESET DDD READ FLAG
         SLS,R5   1
         SLS,R5   -1
         CI,R4    0
         BGE      COBIOOI1          DIRECTION-FWD
         LI,R6    X'20'                      -REV
         LW,R4    COBIODCB,R5
         OR,R4    COBIOPFC
         STW,R4   COBIOPFL          SET DCB ADDRESS
         LI,R4    0
         STW,R4   COBIOPFL+1
         CAL1,1   COBIOPFL          POSITION TO EOF
COBIOOI1 STB,R6   COBIOFRL,R5       SET FWD/REV BIT
         LI,R6    0
         STW,R6   COBICLBL,R5       SET BUFF EMPTY FLAG
         CI,R2    0                 PRIMARY RUFF ADDRESS
         BG       COBIOOI0          POSITIVE-CLUSTERED
         BLZ      COBIOOI3          NEGITIVE-NON SEQUENTIAL
         STB,R6   COBIONBL,R5       ZERO    -NON CLUSTERED
         LI,R6    1
         STB,R6   COBIONCL,R5       SET NON CLUSTERED BYTE
         B        COBIOOI2          GO EXIT
COBIOOI3 LI,R7    X'0020'
         AND,R7   PDBCC
         BNEZ     %+3
         LW,R2    R3
         B        COBIOOI0
         STB,R6   COBIONCL,R5
         STW,R6   SECTSW1           RESET SWITCH 1
         STW,R6   SECTSW2                        2
         LI,R6    1
         STB,R6   COBIONBL,R5       SET NON SEQUENTIAL BYTE
         STW,R3   COBIOSBL,R5       SET READ ADDRESS TO TRAILER STORAGE
         SLS,R3   -2
         AI,R3    102
         STW,R3   TRAILAD           SET ADDRESS OF TRAILER
         LCW,R6   R2
         BAL,R11  RDEPF             READ TRAILER
         STW,R6   COBIOSBL,R5       SET READ ADDRESS TO BUFFER
         LW,R7    *TRAILAD
         AI,R7    -1
         STW,R7   CLUSNUM           INIT CURRENT CLUSTER NUMBER
         LW,R3    R5
         BAL,R7   NEXLINK           GET NEXT LINK
         LW,R7    R6
         SW,R6    CLUSNUM
         STW,R7   CLUSNUM
         LW,R3    R5
         BAL,R7   COBIOPNR          POISITION N RECORDS
         B        COBIOOI2          GO EXIT
COBIOOI0 RES      0
         STB,R6   COBIONCL,R5       RESET NON CLUSTERED BYTE
         STB,R6   COBIONBL,R5             NON BUFFERED BYTE
         STW,R2   COBIOSBL,R5
COBIOOI2 LW,R4    COBIOXR+7         LOAD REGISTERS R4
         LW,R5    COBIOXR+8                        R5
         LW,R6    COBIOXR+9                        R6
         LW,R11   COBIOXR+10                       R11
         B        *R11              RETURN
         PAGE
*
* COBIO OPEN OUT-FILE ROUTINE
*    EXPECTS DCB NUMBER             IN R5
*    EXPECTS BUFFER BYTE ADDRESS    IN R2 (POS=CLUSTERED)
*                                         (0 0=NONCLUSTERED)
*                                         (-1 =SCATTERED)
*                                         (NEG=NONSEQUENTIAL)
*                                   IN R3 (SCATTERED ONLY)
COBIOOOF STW,R6   COBIOXR+5         SAVE REGISTER R6
         LI,R6    0
         STB,R6   COBIONBL,R5       RESET NON-SEQ BYTE
         STB,R6   COBIOSCT,R5       RESET SCAT BYTE
         CI,R2    0                 OUTPUT TYPE
         BNEZ     COBIOOO0
         LI,R6    1                            -NONCLUSTERED
         STB,R6   COBIONCL,R5       SET NON CLUSTERED BIT
         B        COBIOOO1          GOTO EXIT
COBIOOO0 STB,R6   COBIONCL,R5
         CI,R2    -1
         BE       COBIOOO2                     -SCATTERED
         STW,R2   COBIOSBL,R5
         BG       COBIOOO1                     -CLUSTERED
         LCW,R6   R2
         STW,R6   COBIOSBL,R5
         LI,R6    X'0020'
         AND,R6   PDBCC
         BEZ      COBIOOO1                     -CLUSTERED
         LI,R6    1                            -NONSEQUENTIAL
         STW,R6   CLUSNUM
         STB,R6   COBIONBL,R5
COBIOOO1 LI,R6    OBUFSIZE
         STW,R6   COBICLBL,R5       INIT CURRENT LENGTH OF BLOCK
         LW,R6    COBIOSBL,R5
         AI,R6    2
         STW,R6   COBIOCBL,R5
         LW,R6    COBIOXR+5
         B        *R11              RETURN
COBIOOO2 STW,R6   COBIOCFN          INIT CURRENT FILE NUMBER
         STW,R6   COBIOLFC          INIT LOGICAL FILE COUNT
         LI,R6    1
         STB,R6   COBIOSCT,R5       SET SCAT BYTE
         STW,R3   COBIOSBL,R5
         B        COBIOOO1          EXIT
         PAGE
*
* COBIO GETCLUSTER ROUTINE
*    EXPECTS DCB NUMBER IN CONDITION CODE
*    EXPECTS BLOCK BYTE ADDRESS IN R2 (NONCLUSTERED ONLY)
*    RETURNS BYTE ADDRESS OF CLUSTER IN R2
*    RETURNS NEGITIVE VALUE IN R2 FOR EOF
*    LEVER REGISTER = R3
*            (IF READ DDD  R3 = BUFF SIZE)
COBIOGET STW,R1   COBIOXR           SAVE REGISTERS R1-R7
         STW,R2   COBIOXR+1
         STW,R3   COBIOXR+2
         STW,R4   COBIOXR+3
         STW,R5   COBIOXR+4
         STW,R6   COBIOXR+5
         STW,R7   COBIOXR+6
         STCF     R3
         SCS,R3   4                 SET LEVEL = DCB NUMBER
         AND,R3   COBIHBMK
         LB,R4    COBIONCL,R3       NON CLUSTERED
         BEZ      COBIOGE4          NO -GOTO CHECK SEQUENTIAL
         STW,R2   COBIOSBL,R3       YES-PLACE BLOCK ADDRESS IN SECONDARY
COBIOGE3 BAL,R4   COBIBRPL          BUILD READ AND CHECK PLISTS
         CAL1,1   0,R5              READBLOCK
         LCI      3
         LM,R8    COBIOXR+11
         LB,R6    COBIONCL,R3       NON CLUSTERED
         BNEZ     COBIOGEX          YES-GO EXIT
         LW,R5    COBIOSBL,R3
         AI,R5    2                 BLOCK LNG OFFSET
         STW,R5   COBIOCBL,R3       INIT CBL
         STW,R5   COBIOXR+1         SET CLUSTER RETURN ADDRESS
         LB,R6    COBIONBL,R3       NON SEQUENTIAL
         BEZ      COBIOGE8          NO-GO DEBLOCK CLUSTERS
         LI,R6    0
         STW,R6   COBICLBL,R3
         LI,R6    -1
         AWM,R6   CLUSNUM           DECREMENT CLUSTER NUMBER
         SLS,R5   -2
         LW,R6    *R5
         LW,R7    SECTSW2           SWITCH 2
         BEZ      COBIOGE5          RESET- GO CHECK FOR TRAILER
         LI,R7    0                 SET
         STW,R7   SECTSW2           RESET SWITCH 2
         LI,R7    1
         STW,R7   SECTSW1           SET   SWITCH 1
         AND,R6   L(X'00FF0000')
         BNEZ     COBIOGE7
         B        COBIOGEX          GO EXIT
COBIOGE5 AND,R6   L(X'00FFFF00')
         CW,R6    L(X'00F38A00')    SECTION TRAILER
         BE       COBIOGE6          YES-GO SAVE LINK
         CW,R6    L(X'00F38800')    SECTION HEADER
         BNE      COBIOGEX          NO-GO EXIT
         LI,R6    1                 YES-
         STW,R6   SECTSW2           SET SECTSW2
         B        COBIOGEX          GO EXIT
COBIOGE6 AI,R5    1
         LW,R6    *R5
         SLS,R6   16
         AI,R5    1
         LW,R7    *R5
         SLS,R7   -16
         OR,R6    R7
         STW,R6   LINKSAV           SAVE LINK IN TRAILER
         B        COBIOGEX          GO EXIT
COBIOGE4 LB,R4    COBIONBL,R3       NON SEQUENTIAL
         BNEZ     COBIOGE7          YES -GO READ NON-SEQ
COBIOGEC LW,R4    COBICLBL,R3       NO -CLUSTERED
         BGZ      COBIOGE9          BUFFER EMPTY-NO GO MOVE POINTER
         B        COBIOGE3                      -YES GO READ A BLOCK
COBIOGE7 LW,R4    SECTSW1           SWITCH 1
         BEZ      COBIOGEC          RESET GO CHECK BLOCK
         LI,R4    0                 SET  -
         STW,R4   SECTSW1           RESET SWITCH1
         LW,R6    LINKSAV
         BNEZ     %+2
         BAL,R7   NEXLINK
         LW,R7    R6
         SW,R6    CLUSNUM
         STW,R7   CLUSNUM           UPDATE CLUSTER NUMBER
         BAL,R7   COBIOPNR          POSITION N RECORDS
         B        COBIOGEC          GO CHECK BLOCK
COBIOGE8 RES      0
         AI,R5    -2
         SLS,R5   -1                BA TO HA
         LH,R5    0,R5              PICK-UP BLOCK LENGTH
         AI,R5    -2
         STW,R5   COBICLBL,R3       INIT BLOCK LENGTH
         LB,R6    COBIOFRL,R3
         BEZ      COBIOGEB          DIRECTION-FWD
         AW,R5    COBIOCBL,R3       MOVE POINTER TO END OF BLOCK
         AI,R5    -1
         LB,R6    0,R5
         SLS,R6   1                 HW TO BA LENGTH
         AI,R6    -1
         SW,R5    R6
         B        COBIOGEA
COBIOGE9 LW,R5    COBIOCBL,R3
         LB,R6    COBIOCLL,R3       PREVIOUS CLUSTER LNG
         LB,R4    COBIOFRL,R3
         BEZ      COBIOGED          DIRECTION-FWD
         AI,R5    -1                         -REV
         LB,R6    0,R5
         AI,R5    1
         LCW,R6   R6
COBIOGED SLS,R6   1                 HA TO BA LENGTH
         AW,R5    R6
COBIOGEA STW,R5   COBIOCBL,R3       MOVE POINTER TO NEXT CLUSTER
         STW,R5   COBIOXR+1         SET RETURN CLUSTER ADDRESS
COBIOGEB LW,R6    COBIOCBL,R3
         LB,R5    0,R6
         STB,R5   COBIOCLL,R3       SAVE CURRENT CLUSTER HW LNG
         SLS,R5   1                 HW LENGTH TO BA LENGTH
         LW,R6    COBICLBL,R3
         SW,R6    R5                DECREMENT CURRENT LENGTH OF BLOCK
         STW,R6   COBICLBL,R3
COBIOGEX LCI      7                 LOAD REGISTERS R1-R7
         LM,R1    COBIOXR
         LW,R2    R2
         B        *R11              RETURN
         PAGE
*
* BUILD READ AND CHECK PLISTS
*
COBIBRPL LW,R7    COBIODCB,R3       PICK UP CURRENT DCB ADDRESS
         OR,R7    COBIORDC
         LW,R6    COBIOSBL,R3       PICKUP EMTPY BUFF BYTE ADDRESS
COBIBRP1 LB,R5    COBIOFRL,R3
         OR,R5    L(X'74000010')
         STW,R5   COBIORP2+1        SET FWD/REV BIT
         STW,R7   COBIORP2          SET DCB ADDRESS
         STW,R6   COBIORP2+5        SET BTD
         SLS,R6   -2
         STW,R6   COBIORP2+3        SET BUFF ADDRESS
         LI,R6    2*OBUFSIZE        DEFAULT READ SIZE                   COBOL0
         LW,R5    READDD,R3         IF DDD READ                         COBOL0
         BGEZ     %+2               NO.                                 COBOL0
         LW,R6    COBIOXR+2
         STW,R6   COBIORP2+4        SET BUFF SIZE
         LI,R5    COBIORP2
COBIBRPX RES      0
         LCI      3
         STM,R8   COBIOXR+11
         B        *R4               RETURN
*
* COBIO ABNORMAL READ RETURN
*    EXPECTS DCB ADDRESS AND ABN CODE IN REGISTER 8
*
COBIOGAB LB,R5    R10               PICKUP ABN CODE
         CI,R5    X'06'             EOF SENSED
         BE       COBIOGA1          YES-
         CI,R5    X'04'
         BE       COBIOGA1          YES-
         B        ABNERR
COBIOGA1 LCI      3
         LM,R8    COBIOXR+11
         LI,R2    -1
         STW,R2   COBIOXR+1
         B        COBIOGEX          GOTO EXIT
         PAGE
*
* COBIO PUTCLUSTER ROUTINE
*    EXPECTS SOURCE BYTE ADDRESS IN R4
*                                      (NEG=END OF LOGICAL FILE)
*    EXPECTS BLOCK BYTE LENGTH R2 (NONCLUSTERED ONLY)
*    EXPECTS DCB NUMBER CONDITION CODE
*    LEVEL REGISTER = R3
*
COBIOPUT STW,R1   COBIOXR           SAVE REGISTERS R1-R7
         STW,R2   COBIOXR+1
         STW,R3   COBIOXR+2
         STW,R4   COBIOXR+3
         STW,R5   COBIOXR+4
         STW,R6   COBIOXR+5
         STW,R7   COBIOXR+6
         STCF     R3
         SCS,R3   4                 SET LEVEL = DCB NUMBER
         AND,R3   COBIHBMK
         LCI      4
         STM,R12  COBIOXR+20
         CI,R4    15*4
         BG       %+4
         CI,R4    0
         BL       %+2
         AI,R4    BA(COBIOXR+8)
         LB,R6    COBIONCL,R3       NONCLUSTERED
         BEZ      COBIOPU1          NO -GO CHECK CURRENT BLOCK
COBIOPU0 STW,R4   COBIOSBL,R3       YES-SET BLOCK ADDRESS IN SECONDARY
COBIOPU5 STW,R2   COBICLBL,R3       SET BLOCK LENGTH IN LIST
         BAL,R5   COBIBWPL          GO BUILD WRITE AND CHECK PLISTS
         CAL1,1   COBIOWPL          WRITE BLOCK
         LB,R6    COBIONCL,R3
         BEZ      COBIOPU7          CLUSTERED-YES
         LW,R6    COBIOSBL,R3
         STW,R6   CLUSTERA
         BAL,R6   COBIOPR
         B        COBIOPEX          GOTO EXIT
COBIOPU7 LW,R2    COBIOSBL,R3
         AI,R2    2                 BLOCK LENGTH OFFSET
         STW,R2   COBIOCBL,R3       INIT CURRENT POSITION IN BUFFER
         LI,R2    OBUFSIZE
         STW,R2   COBICLBL,R3       INIT BLOCK SIZE
COBIOPU6 LB,R2    0,R4
         LW,R5    COBIOCBL,R3
         STW,R5   CLUSTERA
         STB,R2   R5
         MBS,R4   0                 MOVE CLUSTER INTO BLOCK
         STB,R2   R5
         MBS,R4   0
         STW,R5   COBIOCBL,R3       INC CBL
         AI,R5    -1
         STB,R2   0,R5              INSERT TRAIL CLUSTER LENGTH
         SLS,R2   1
         LW,R6    COBICLBL,R3
         SW,R6    R2
         STW,R6   COBICLBL,R3       DECREMENT BLOCK LENGTH
         BAL,R6   COBIOPR           PRINT
         B        COBIOPEX          GO TO EXIT
COBIOPU1 LB,R5    COBIOSCT,R3
         BNEZ     COBIOPU2          SCATTERED-YES
COBIOPU3 LB,R2    COBIONBL,R3                -NO
         BEZ      COBIOPU4          NONSEQUENTIAL-NO
         LI,R6    1                          -YES
         AWM,R6   CLUSNUM           INCREMENT CLUSTER NUMBER
         STW,R6   COBICLBL,R3       ***FORCE 1 CLUSTER/BLOCK***
COBIOPU4 LB,R2    0,R4
         SLS,R2   1
         CW,R2    COBICLBL,R3       WILL CURRENT CLUS FIT IN BLOCK
         BL       COBIOPU6                                        -YES
         LW,R2    COBIOCBL,R3                                     -NO
         SW,R2    COBIOSBL,R3
         LW,R5    COBIOSBL,R3
         SLS,R5   -1                BA TO HW
         STH,R2   0,R5              INSERT BLOCK LENGTH
         CI,R2    2                 EMPTY BLOCK
         BG       COBIOPU5                     -NO GO WRITE BLOCK
         B        COBIOPU7                     -YES SKIP WRITE
COBIOPEX LCI      7                 EXIT
         LM,R1    COBIOXR           LOAD REGISTERS R1,R2,R3,R4,R5,R6,R7
         B        *R11              RETURN
COBIOPU2 LW,R3    COBIOCFN          LOAD CURRENT FILE NUMBER
         CI,R4    0
         BGE      COBIOPU4
         LW,R4    COBIOLFC
         AI,R4    1                 INC FILE NUMBER
         STW,R4   COBIOLFC
         AND,R4   L(X'00000003')
         STW,R4   COBIOCFN
         LI,R4    BA(COBIOEOF)      SET UP LOGICAL EOF CLUSTER
         B        COBIOPU4          GO CHECK FIT
         PAGE
*
* BUILD WRITE AND CHECK PLISTS
*
COBIBWPL LW,R6    COBIODCB,R3       PICK UP CURRENT DCB ADDRESS
         OR,R6    COBIOWRC
         STW,R6   COBIOWPL          SET DCB ADDRESS IN WRITE PLIST
         LW,R6    COBIOSBL,R3       PICKUP FULL BUFF BYTE ADDRESS
         STW,R6   COBIOWPL+5        SET BTD IN WRITE PLIST
         SLS,R6   -2                CONVERT TO WORD ADDRESS
         STW,R6   COBIOWPL+3        SET BUFF ADDRESS
         LW,R6    COBICLBL,R3       PICKUP CURRENT LENGTH OF BLOCK
         STW,R6   COBIOWPL+4        SET BUFF SIZE
         B        *R5               RETURN
         PAGE
*
* COBIO CLOSE OUT-FILE ROUTINE
*    EXPECTS DCB NUMBER             IN R5
*    EXPECTS SAVE/RELEASE INDICATOR IN R2 (+/-)
*
COBIOCOF STW,R2   COBIOXR+7         SAVE
         STW,R3   COBIOXR+8
         STW,R11  COBIOXR+9
         CI,R2    0                 CLOSE TYPE
         BL       COBIOCO2                    -RELEASE
         LB,R3    COBIONCL,R5
         BNEZ     COBIOCO1                    -SAVE NONCLUSTERED
         LI,R3    0
         STB,R3   COBIOPCL,R5       RESET PRINT CONTROL
         STB,R3   COBIOSCT,R5       RESET SCAT BYTE
         LI,R4    BA(FCLUSTER)                -SAVE CLUSTER OR NONSEQ
         STB,R5   R3
         SLS,R3   4
         LC       R3
         BAL,R11  COBIOPUT          FLUSH BUFFER
COBIOCO1 LW,R3    COBIODCB,R5
         OR,R3    COBIOPFC
         STW,R3   COBIOPFL
         LI,R3    X'10'
         STW,R3   COBIOPFL+1
         CAL1,1   COBIOPFL          POSITION TO BOF
         B        COBIOCOX          GO RETURN
COBIOCO2 LW,R3    COBIODCB,R5
         OR,R3    COBIORWC
         STW,R3   COBIOPFL
         CAL1,1   COBIOPFL          REWIND
         LW,R3    COBIODCB,R5
         OR,R3    COBIOCFC
         STW,R3   COBIOCPL
         CAL1,1   COBIOCPL          CLOSE
COBIOCOX LW,R2    COBIOXR+7
         LW,R3    COBIOXR+8
         LW,R11   COBIOXR+9
         B        *R11              RETURN
         PAGE
*
* COBIO CLOSE IN-FILE ROUTINE
*    EXPECTS DCB NUMBER             IN R5
*    EXPECTS SAVE/RELEASE INDICATOR IN R2 (+/-)
*
COBIOCIF RES      0
         STW,R4   COBIOXR+7         SAVE REG R4
         LW,R4    COBIODCB,R5
         CI,R2    0
         BLZ      COBIOCI1          CLOSE-RELEASE
         OR,R4    COBIOPFC               -SAVE
         STW,R4   COBIOPFL
         LI,R4    X'10'
         STW,R4   COBIOPFL+1
         CAL1,1   COBIOPFL          POSITION TO BOF
COBIOCIX LW,R6    COBIOXR+7
         B        *R11              RETURN
COBIOCI1 OR,R4    COBIORWC
         STW,R4   COBIOPFL
         CAL1,1   COBIOPFL          REWIND
         LW,R4    COBIODCB,R5
         OR,R4    COBIOCFC
         STW,R4   COBIOCPL
         CAL1,1   COBIOCPL          CLOSE
         B        COBIOCIX
         PAGE
*
* COBIO POSITION N RECORDS ROUTINE
*    EXPECTS DCB NUMBER        IN R3
*    EXPECTS NUMBER OF RECORDS IN R6
*                                    (NEG=REVERSE)
*
COBIOPNR STW,R5   COBIOPNT
         LW,R5    COBIODCB,R3
         OR,R5    COBIOPRC
         STW,R5   COBIPRPL          SET CURRENT DCB
         LI,R5    X'00'
         CI,R6    0
         BGE      %+3               FORWARD-YES
         LCW,R6   R6                       -N0 REVERSE
         LI,R5    X'10'
         OR,R5    L(X'C0000000')
         STW,R5   COBIPRPL+1        SET FWD/REV
         STW,R6   COBIPRPL+2        SET NUMBER OF RECORDS
         LCI      3
         STM,R8   COBIOXR+11
         CAL1,1   COBIPRPL          POSITION N RECORDS
         LW,R5    COBIOPNT
         B        *R7               RETURN
         PAGE
*
* COBIO NEXLINK ROUTINE
*    RETURNS NEXT CLUSTER NUMBER IN R6
*    RETURNS R6 AND CC NEG ON EOF
*
NEXLINK  LI,R6    -1
         AWM,R6   TRAILAD
         LW,R6    *TRAILAD          NEXT TRAILER LINK EMPTY
         BEZ      NEXLINK           YES
         AND,R6   L(X'00FF0000')
         CW,R6    L(X'00730000')    END OF TRAILER TABLE
         BE       %+3               YES-GO POSITION FOR DRF CLUSTERS
         LW,R6    *TRAILAD          NO -RETURN NORMNAL
         B        *R7
         LW,R6    TRAILAD
         LW,R6    102,R6
         SLS,R6   -16
         B        *R7
         PAGE
*
* COBIO PRINT
*    EXPECTS LEVEL NUMBER IN R3
*    EXPECTS CONTROL BYTE AT COBIOPCL
*    EXPECTS BYTE ADDRESS IN CLUSTERA
*    EXPECTS CLUSTER LNG IN R2
*
COBIOPR  STW,R4   COBIOXR+12
         LB,R4    COBIOPCL,R3       FILE PRINT TURNED ON
         BEZ      COBIOPRE          NO GOTO EXIT
COBIOPR1 RES      0                                                     COBOL0
         STW,R2   COBIOXR+11
         STW,R5   COBIOXR+13
         STW,R6   COBIOXR+14
         STW,R7   COBIOXR+15
         STW,R1   COBIOXR+16
         LW,R4    COBIOFID,R3
         STW,R4   COBIOCBF           PUT ID INTO PRINT LINE
         LW,R1    CLUSTERA
         AI,R2    3                  WAS AI,R2  1
         CI,R2    3                  NEW TEST FOR ZERO LEN CLUSTER
         BG       COBIOPR2
         LW,R3    R1                 HOLD CLUSTERA
         LI,R1    508                COMPILER ERROR 08 ZERO CLUSTER
         LW,R2    COBIOXR+11
         LW,R4    COBIOXR+12
         LCI      0
         STM,0    REGS               FOR USE BY ERROR ROUTINE
         BAL,R11  ERROR
*                                    RETURN HERE ONLY IF CONT OPTION
         STW,R2   COBIOXR+11
         STW,R4   COBIOXR+12
         LW,R1    R3                 RESTORE CLUSTERA ADDRESS
         LI,R2    48                 FORCE CLUSTER LENGTH
COBIOPR2 STW,R2   CLUSTERL          SET CLUSTER LENGTH
COBICON2 LI,R7    2                  START INSIDE IDENT
COBICONV LB,R4    0,R1
         CI,R3    10                                                    COBOL0
         BLE      COBIOHEX                                              COBOL0
         LB,R5    PDB                                                   COBOL0
         CI,R5    X'10'                                                 COBOL0
         BG       NOCHG                                                 COBOL0
COBIOHEX RES      0                                                     COBOL0
         BAL,R6   COBIHEX
COBIOST  RES      0                                                     COBOL0
         STH,R2   COBIOCBF,R7
         AI,R7    1
         AI,R1    1
         CW,R7    CLUSTERL
         BG       COBICON1
         CI,R7    46                 PRINT 11 WORDS OF DATA PER LINE MAXCOBOL0
         BL       COBICONV          NO - GO FINISH
         SLS,R7   1
         AI,R7    4                 ALLOW FOR IDENT
         STW,R7   COBIOPPL+3
         CAL1,1   COBIOPPL
         SLS,R7   -1
         AI,R7    -4                 9/23 FIX FOR LOSS OF DATA          COBOL0
         SW,R7    CLUSTERL
         LCW,R7   R7
         BEZ      COBICON1+4         DONE ALREADY                       COBOL0
         STW,R7   CLUSTERL
         LW,R4    COBIOBL           BLANKS
         STW,R4   COBIOCBF          IDENTIFICATION
         B        COBICON2
NOCHG    RES      0                                                     COBOL0
         LW,R2    LINO                                                  COBOL0
         B        COBIOST                                               COBOL0
COBICON1 SLS,R7   1                 YES-TERMINATE
         STW,R7   COBIOPPL+3        SET SIZE
         CAL1,1   COBIOPPL          PRINT LINE
         LW,R2    COBIOXR+11
         LW,R5    COBIOXR+13
         LW,R6    COBIOXR+14
         LW,R7    COBIOXR+15
         LW,R1    COBIOXR+16
COBIOPRE LW,R4    COBIOXR+12
         B        *R6               RETURN
         PAGE
*
* CONVERT HEX BYTE TO HALFWORD DISPLAY
*
COBIHEX  LI,R2    0
         SLD,R4   -4
         CI,R4    9
         BG       COBIHEX1
         OR,R4    L(X'F0')
COBIHEX2 LW,2     R4
         SLS,R2   8
         LI,R4    0
         SLD,R4   4
         CI,R4    9
         BG       COBIHEX3
         OR,R4    L(X'F0')
COBIHEX4 OR,R2    R4
         B        *R6               RETURN
COBIHEX1 AI,R4    -9
         OR,R4    L(X'C0')
         B        COBIHEX2
COBIHEX3 AI,R4    -9
         OR,R4    L(X'C0')
         B        COBIHEX4
         PAGE
*
* COBIO DEBUGGING PRIMER
*     EXPECTS FILE ID IN R4
*     EXPECTS LEFT SHIFT AMOUNT IN R2
*     EXPECTS LEVEL NUMBER IN R3
*     RETURNS  *R11
*
COBIODB  STW,R4   COBIOFID,R3
         LW,R4    PDBJ              DEBUGGING TURNED OFF
         SLS,R4   0,R2              NO -IS PRESENT FILE TURNED ON
         AND,R4   =X'80000000'                                          COBOL0
         BGEZ     %+2               RESET PRINT CONTROL
         LI,R4    1                 SET PRINT CONTROL
         STB,R4   COBIOPCL,R3
         B        *R11              RETURN
         PAGE
*
* COBIO PRINT BUFFER
*
COBIOPBF TEXT     ' ***'
COBIOCBF RES      40
*
* COBIO ID MESSAGE
*
CLUSTERA DATA     0
CLUSTERL DATA     0
*
* COBIO CURRENT FILE ID
*
COBIOFID DATA     0                 F:W0
         DATA     0                    1
         DATA     0                    2
         DATA     0                    3
         DATA     0                    4
         DATA     0                    5
         DATA     0                    6
         DATA     0                    7
         DATA     0                    8
         DATA     0                 F:W9
         TEXT     'ERR#'            COMPILER ERROR
         TEXT     'LINE'                                                COBOL0
         TEXT     'SUB '                                                COBOL0
COBIOBL  TEXT     '    '            USE TO BLANK ID
         PAGE
*
* COBIO STORAGE/WORKING BUFFER LIST
*
COBIOSBL DATA     0                 WORKING BUFF ADDRESS OF FILE   F:W0
         DATA     0                                                F:W1
         DATA     0                                                F:W2
         DATA     0                                                F:W3
         DATA     0                                                F:W4
         DATA     0                                                F:W5
         DATA     0                                                F:W6
         DATA     0                                                F:W7
         DATA     0                                                F:W8
         DATA     0                 F:W9
* COBIO CURRENT LENGTH OF BLOCK LIST
COBICLBL DATA     0                 CURRENT LENGTH OF BLOCK FILE F:W0
         DATA     0                                              F:W1
         DATA     0                                              F:W2
         DATA     0                                              F:W3
         DATA     0                                              F:W4
         DATA     0                                              F:W5
         DATA     0                                              F:W6
         DATA     0                                              F:W7
         DATA     0                                              F:W8
         DATA     0                 F:W9
* COBIO  CURRENT LOC IN BLOCK LIST
COBIOCBL DATA     0                 CURRENT LOCATION IN BLOCK FILE F:W0
         DATA     0                                                F:W1
         DATA     0                                                F:W2
         DATA     0                                                F:W3
         DATA     0                                                F:W4
         DATA     0                                                F:W5
         DATA     0                                                F:W6
         DATA     0                                                F:W7
         DATA     0                                                F:W8
         DATA     0                 F:W9
         PAGE
*
* COBIO FWD/REV LIST
*
COBIOFRL DATA     0                 F:W0/F:W1/F:W2/F:W3
         DATA     0                 F:W8
         DATA     0                 F:W4/F:W5/F:W6/F:W7
* COBIO NON BUFFERED LIST
COBIONBL DATA     0                 F:W0-3
         DATA     0                 F:W4-7
         DATA     0                 F:W8
* COBIO NONCLUSTERED LIST
COBIONCL DATA     0                 F:W0/F:W1/F:W2/F:W3
         DATA     0                 F:W4/F:W5/F:W6/F:W7
         DATA     0                 F:W8
* COBIO PRINT CONTROL LIST
COBIOPCL DATA     0                 F:W0-3
         DATA     0                 F:W4-7
         DATA     X'0000FF00'       F:W8-9, FORCE COMPILER ERROR PRINT
* COBIO SCAT CONTROL LIST
COBIOSCT DATA     0                 F0-F3
         DATA     0                 F4-F7
         DATA     0                 F8
*COBIO CURRENT/PREVIOUS CLUSTER HW LENGTH LIST
COBIOCLL  DATA    0                 F:W0-3
         DATA     0                 F:W4-7
         DATA     0                 F:W8
         PAGE
*
* COBIO WRITE PLIST
*
COBIOWPL DATA     X'11000000'       DCB ADDRESS
         DATA     X'74000000'
         DATA     ABNERR
         DATA     0                 BUFF ADDRESS
         DATA     0                 SIZE VALUE
         DATA     0                 BTD
* COBIO READ PLIST
COBIORP2 DATA     X'10000000'       DCB ADDRESS
         DATA     X'74000000'
         DATA     COBIOGAB          ABNORMAL RETURN
         DATA     0                 BUFF ADDRESS
         DATA     0                 BUFF SIZE
         DATA     0                 BTD
*COBIO VERTICAL FORMAT CONTROL
COBIVFPL GEN,8,24 X'05',M:LO
         DATA     X'00000010'       VFC
         PAGE
* COBIO PRINT PLIST
COBIOPPL GEN,8,24 X'11',M:LO
         DATA     X'30000010'
         DATA     COBIOPBF          BUFF ADDRESS
         DATA     110               SIZE
* COBIO CLOSE PLIST
COBIOCPL DATA     X'15000000'       DCB ADDRESS
         DATA     X'80000000'       PRESENCE BITS
         DATA     X'00000001'       REL/SAV&
* COBIO PFIL PLIST
COBIOPFL DATA     X'1C000000'       DCB ADDRESS
         DATA     X'00000000'       BOF/EOF
* COBIO POSITION N RECORDS PLIST
COBIPRPL DATA     0
         DATA     X'C0000000'       FWD/REV (00/10)
         DATA     0                 NUMBER OF RECORDS
         DATA     COBIOGAB
         PAGE
*
* COBIO VARIBLES
*
READDD   DATA     0                 READ DDD FLAG
         DATA     0,0,0,0
         DATA     0,0,0,0
CLUSNUM  DATA     0                 CLUSTER NUMBER
TRAILAD  DATA     0
COBIOPNT DATA     0                 R5 TEMP
SECTSW1  DATA     0                 SWITCH 1
SECTSW2  DATA     0                 SWITCH 2
LINKSAV  DATA     0
COBIOCFN DATA     0                 CURRENT FILE NUMBER(SCAT)
COBIOLFC DATA     0                 LOGICAL FILE COUNT
FCLUSTER DATA,1   OBUFSIZE/2        FLUSH CLUSTER
         DATA,3   0
         DEF      TMDATE
         DEF      WSLOC
TMDATE   DATA     -1                DATE-COMPILED FLAG
         RES      5                 TIMEDATE
WSLOC    DATA     0
         DEF      CPBUF                                                 COBOL0
CPBUF    DATA     0,0                                                   COBOL0
*
*        LO OPTION RANGES
*
         DEF      RANGE
         DATA     0
RANGE    GEN,32   -1
         GEN,32   -1
         GEN,32   -1
         GEN,32   -1
         GEN,32   -1
         GEN,32   -1
*
* REGISTER STORAGE AREA
*
COBIOXR  DATA     0,0,0,0           REGISTER STORAGE- R1,R2,R3,R4
         DATA     0,0,0,0                             R5,R6,R7,R8
         DATA     0,0,0,0                             R9,R10,R11,R12
         DATA     0,0,0,0                             R13,R14,R15,R16
         DATA     0,0,0,0
         DATA     0,0,0,0
         PAGE
* COBIO CONSTANTS
*
COBIORDC DATA     X'10000000'       PLIST CODE FOR READ
COBIOWRC DATA     X'11000000'                      WRITE
COBIOCKC DATA     X'29000000'                      CHECK
COBIORWC DATA     X'01000000'                      REWIND
COBIOWEC DATA     X'02000000'                      WRITE EOF
COBIOOFC DATA     X'14000000'                      OPEN
COBIOCFC DATA     X'15000000'                      CLOSE
COBIOPFC DATA     X'1C000000'                      POSITION FILE
COBIOPRC DATA     X'1D000000'                      POSITION N RECORDS
COBIOBMK DATA     X'000000FF'       BYTE MASK
COBIHBMK DATA     X'0000000F'       HALF BYTE MASK
COBIOEOF DATA     X'02FFFFFF'       LOGICAL EOF MARK
*
* RESIDENT I/O BUFFERS
*
         DEF      POFBUF,XRFBUF
POFBUF   RES      75
XRFBUF   RES      75
         DEF      PATCH             03/12/71  FOR MODIFY CARDS
PATCH    RES      16                03/12/71  PATCH AREA
SRTPG    DATA     0                 NUMBER OF PAGES FOR SORT            COBOL0
SO%SEQ   DATA     0                 LOCATION TO  HOLD SOURCE SEQ. NO.   COBOL0
*     XEROX RESTRICTED PROPRIETY PROGRAM.  USE AUTHORIZED ONLY          COBOL0
*     PURSUANT TO LICENSE AGREEMENT.                                    COBOL0
         END      COB0
