         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    '******  COBOL61  ******'
         PAGE
         REF      F:W7,F:W8,M:LO,M:LL
         REF       PH61E,PDBCC
         REF      ABNERR,TMDATE,PDB,PDBP,PDBZ
         REF      RDMPF,RDMPFS
         REF       SL                                                   COBOL61
         DEF      COB61
         RES       10
************************************************************************
MAXDIAG  EQU      2000
AREA     EQU      (MAXDIAG*3)/2
************************************************************************
         PAGE
*      DIAGNOSTIC MESSAGE INDEX PROC DEFINITION
DMI      CNAME
         PROC
LF       RES      0
I        DO       NUM(AF)
         DATA,2   4*(AF(I)-DMTEXTS)
         FIN
         BOUND    4
         PEND
         PAGE
DKOUNT   DATA     MAXDIAG
DCOUNT   DATA      0
EVEN     DATA      BA(LOC)
ODD      GEN,8,24  6,BA(DMFLOC)
ODDD     GEN,8,24 (MAXM-MAXMESS)*4,BA(DBUF)
DYNMBS   GEN,8,24 100,BA(DBUF)                                          COBOL61
DFLAG    DATA     0
FLAG     DATA     -1
MAXMESS  TEXT     ' ************* THE MAXIMUM NUMBER OF DIAGNOSTICS P',;
                  'ERMITTED HAS BEEN EXCEEDED - REMAINDER DISCARDED'
MAXM     EQU      %
DYNMESS  TEXT     ' *****  NOT ENOUGH DYNAMIC MEMORY TO PRODUCE THE ',;
                  'REQUESTED PMAP LISTING - INCREASE CORE LIMIT ***** '
REG1A    GEN,8,24 80,BA(DMBUF)
REG1B    GEN,8,24  120,BA(DMBUF)
REG1C    GEN,8,24 136,BA(SLBUF)
REG2A    GEN,8,24  133,BA(DBUF)
REG2C    GEN,8,24 50,BA(SLBUF2+6)+2                                     COBOL61
REGR     DATA     X'40000000'
REGRU    GEN,8,24 4,BA(DBUF+9)
DDONE    DATA      COMPARE
SDONE    DATA     COMPARE
MASKS    DATA     X'000000F0'
MASKCD   DATA     X'00F00000'
AST      TEXT      '****'
IND      DATA      WRITES1
NUMB     TEXT     '  *** NUMBER OF DIAGNOSTIC MESSAGES'
         DATA     X'20202023'
         TEXT     ' ***'
         TEXT     '     HIGHEST SEVERITY LEVEL'                         COBOL61
SLMESS   DATA      X'404040B7'                                          COBOL61
         TEXT      ' ***'                                               COBOL61
NUMB2    GEN,8,24 BA(NUMB2)-BA(NUMB),BA(DBUF)                           COBOL61
SAVE2    RES      1
RSPF     GEN,8,24 X'10',WA(F:W7)
         DATA     X'74000010'
         DATA     WA(ABSOURCE)
         DATA     WA(SLBUF2)
         DATA     82
         DATA     2
WLIST    GEN,8,24 X'11',M:LO
         DATA     X'30000010'
         DATA     WA(DBUF)
         DATA     133
WLISTL   GEN,8,24 X'11',M:LL
         DATA     X'30000010'
         DATA     WA(DLBUF)
         DATA     81
WLISTS   GEN,8,24 X'11',M:LO
         DATA     X'30000010'
         DATA     WA(SLBUF)
         DATA     133
         BOUND     8
EDIT     TEXT     '.       '
BLANKS   TEXT     '                '
BMPF     RES      3                 MPF BUFFER
REGSV    RES      15
THREE    DATA     X'00030000'
OVCNT    DATA     0
SDISP    DATA     0
SRTBA    RES      1
MASK1    DATA     2
LISTR    GEN,8,24 X'10',F:W8
         DATA     X'74000010'
         DATA      ABIO
         DATA     X'80000002'       *R2 BUFFER ADDRESS
         DATA     6
         DATA     X'80000003'       *R3 DISPLACEMENT
CONVAL   DATA     X'00C'
CVRTBL   GEN,32   8000000           CONVERSION TABLE
         GEN,32   4000000
         GEN,32   2000000
         GEN,32   1000000
         GEN,32   800000
         GEN,32   400000
         GEN,32   200000
         GEN,32   100000
         GEN,32   80000
         GEN,32   40000
         GEN,32   20000
         GEN,32   10000
         GEN,32   8000
         GEN,32   4000
         GEN,32   2000
         GEN,32   1000
         GEN,32   800
         GEN,32   400
         GEN,32   200
         GEN,32   100
         GEN,32   80
         GEN,32   40
         GEN,32   20
         GEN,32   10
         GEN,32   8
         GEN,32   4
         GEN,32   2
         GEN,32   1
         GEN,32   0
         GEN,32   0
         GEN,32   0
         GEN,32   0
DMFLOC   RES,2    3                 SET UP DIAG INPUT BUFFER
DTCMP    TEXT     'DATE-COMPILED.  '                                    COBOL61
HEADR    TEXTC    ' 8-1  F00   ',;
                  ' COBOL SOURCE, DIAGNOSTIC AND PROCEDURE',;           COBOL61
                  '-MAP LISTING                                PAGE'    COBOL61
         BOUND     8
SLBUF    RES      5
SLBUF2   RES      29
JUNF     DATA     1
RGMPF    GEN,8,24 10,BA(BMPF)
RGML0    GEN,8,24 12,BA(DLBUF)
RGML1    GEN,8,24 80,BA(DLBUF)
RGML2    GEN,8,24 64,BA(DLBUF+4)
RGMLT    GEN,8,24 18,BA(DLBUF+3)
RGMLF    GEN,8,24 80,BA(DLBUF+1)
RGMDC    GEN,8,24 12,2                                                  COBOL61
DLBUF    RES      21
DBUF     TEXT     '  ****     **** '
DMBUF    RES      31
         TITLE    'DIAGNOSTIC MESSAGE INDEX'
         PAGE
ADDRM    DMI      M000,;
                  M001,M002,M003,M004,M005,M006,M007,M008,M009,M010,;
                   M011,M012,M013,M014,M015,M016,M017,M018,M019,M020,;
                  M021,M022,M023,M024,M025,M026,M027,M028,M029,M030,;
                   M031,M032,M033,M034,M035,M036,M037,M038,M039,M040,;
                   M041,M042,M043,M044,M045,M046,M047,M048,M049,M050,;
                   M051,M052,M053,M054,M055,M056,M057,M058,M059,M060,;
                   M061,M062,M063,M064,M065,M066,M067,M068,M069,M070,;
                   M071,M072,M073,M074,M075,M076,M077,M078,M079,M080,;
                   M081,M082,M083,M084,M085,M086,M087,M088,M089,M090,;
                  M091,M092,M093,M094,M095,M096,M097,M098,M099,M100,;
                   M101,M102,M103,M104,M105,M106,M107,M108,M109,M110,;
                   M111,M112,M113,M114,M115,M116,M117,M118,M119,M120,;
                  M121,M122,M123,M124,M125,M126,M127,M128,M129,M130,;
                   M131,M132,M133,M134,M135,M136,M137,M138,M139,M140,;
                  M141,M142,M143,M144,M145,M146,M147,M148,M149,M150,;
                  M151,M152,M153,M154,M155,M156,M157,M158,M159,M160,;
                  M161,M162,M163,M164,M165,M166,M167,M168,M169,M170,;
                   M171,M172,M173,M174,M175,M176,M177,M178,M179,M180,;
                   M181,M182,M183,M184,M185,M186,M187,M188,M189,M190,;
                  M191,M192,M193,M194,M195,M196,M197,M198,M199,M200,;
                  M201,M202,M203,M204,M205,M206,M207,M208,M209,M210,;
                  M211,M212,M213,M214,M215,M216,M217,M218,M219,M220,;
                  M221,M222,M223,M224,M225,M226,M227,M228,M229,M230,;
                  M231,M232,M233,M234,M235,M236,M237,M238,M239,M240,;
                  M241,M242,M243,M244,M245,M246,M247,M248,M249,M250,;
                  M251,M252,M253
         DMI      M254,M255,M256,M257,M258,M259,M260,;
                  M261,M262,M263,M264,M265,M266,M267,M268,M269,M270,;
                  M271,M272,M273,M274,M275,M276,M277,M278,M279,;        COBOL61
                  M280,M281,M282,M283,M284,M285,M286,M287,M288,;        COBOL61
                  M289,M290,M291,M292,M293,M294,M295                    COBOL61
         TITLE    'DIAGNOSTIC MESSAGE TEXTS'
         PAGE
DMTEXTS  RES      0
M000     TEXTC    '***  NO DIAGNOSTIC MESSAGE  ***'
M001     TEXTC    'SOURCE PROGRAM OUT OF SEQUENCE'
M002     TEXTC    'INCORRECT PUNCTUATION'
M003     TEXTC    'AREA A VIOLATION'
M004     TEXTC    'NAME/NUMERIC LITERAL EXCEEDS 30 CHARACTERS-TRUNCATED'
M005     TEXTC    'INVALID CHARACTER(S)'
M006     TEXTC    'QUOTE MARK OMITTED'
M007     TEXTC    'NON-NUMERIC LITERAL EXCEEDS 255 CHARACTERS-TRUNCATED'
M008     TEXTC    'RESERVED WORD USED INCORRECTLY-TREATED AS A NAME'
M009     TEXTC    'DIVISION HEADER INCORRECT OR OMITTED'
M010     TEXTC    'PERIOD OMITTED'
M011     TEXTC    'REQUIRED SECTION OMITTED'
M012     TEXTC    'SECTION OUT OF ORDER'
M013     TEXTC    'SECTION DUPLICATED'
M014     TEXTC    'REQUIRED PARAGRAPH OMITTED'
M015     TEXTC    'PARAGRAPH OUT OF ORDER'
M016     TEXTC    'PARAGRAPH DUPLICATED'
M017     TEXTC    'REQUIRED CLAUSE OMITTED - COMPILATION ABORTED'
M018     TEXTC    'CLAUSE DUPLICATED'
M019     TEXTC    'PROCEDURE DIVISION STRUCTURED INCORRECTLY'
M020     TEXTC    'REQUIRED WORD MISSING'
M021     TEXTC    'MISSING COBOL DIVISION(S) - COMPILATION ABORTED'
M022     TEXTC    'NAME INVALID/OMITTED'
M023     TEXTC    'INVALID LITERAL'
M024     TEXTC    'INVALID SUBSCRIPT'
M025     TEXTC    'CLOSING PARENTHESIS OMITTED'
M026     TEXTC    'INVALID NUMBER'
M027     TEXTC    'ILLEGAL CURRENCY SIGN'
M028     TEXTC    'ILLEGAL PRIORITY-NUMBER'
M029     TEXTC    'INCORRECT SWITCH-NAME'
M030     TEXTC    'INVALID ''ALL'' LITERAL'
M031     TEXTC    'CONDITION-NAME OMITTED'
M032     TEXTC    'INCOMPLETE ''SAME'' CLAUSE'
M033     TEXTC    'INVALID/OMITTED QUALIFIER'
M034     TEXTC    'UNSELECTED FILE'
M035     TEXTC    'INVALID LEVEL NUMBER'
M036     TEXTC    'INVALID/OMITTED DATA-NAME'
M037     TEXTC    'SECTION HEADER INCORRECT'
M038     TEXTC    'SOURCE WORDS BYPASSED'
M039     TEXTC    'INVALID INDEXING'
M040     TEXTC    'FD REPORT CLAUSE REQUIRED = COMPILATION ABORTED'
M041     TEXTC    'INVALID PICTURE'
M042     TEXTC    '''TYPE'' AND/OR ''NEXT GROUP'' OMITTED OR',;
                  ' WRITTEN IMPROPERLY'
M043     TEXTC    'CLAUSE WRITTEN ILLEGALLY'
M044     TEXTC    'EXCESSIVE REPETITION COUNT IN PICTURE'
M045     TEXTC    'INVALID REPETITION COUNT'
M046     TEXTC    'ILLEGAL CHARACTER(S) IN PICTURE - ''B'' SUBSTITUTED'
M047     TEXTC    'ILLEGAL COMBINATION OF PICTURE SYMBOLS-DISCARDED'
M048     TEXTC    'EXCESSIVE SIZE SPECIFIED FOR EDITED FIELD-TRUNCATED'
M049     TEXTC    'SYNTACTICAL ERROR'
M050     TEXTC    'CONDITIONAL STATEMENT INVALID IN CONTEXT'
M051     TEXTC    'INCORRECT SUBSCRIPTING/INDEXING'
M052     TEXTC    'INCORRECT CLASS TEST'
M053     TEXTC    'INCORRECT SIGN TEST'
M054     TEXTC    'INCORRECT ARITHMETIC OR LOGICAL EXPRESSION'
M055     TEXTC    'CONDITION TOO LIBERAL FOR THIS FORMAT OF',;
                  '''SEARCH'' STATEMENT'
M056     TEXTC    'INCORRECT ARITHMETIC EXPRESSION'
M057     TEXTC    'SECTION NAME OMITTED'
M058     TEXTC    'PARAGRAPH NAME OMITTED'
M059     TEXTC     'NULL PROCEDURE'
M060     TEXTC    'PREMATURE END OF PROCEDURE DIVISION'
M061     TEXTC    'STATEMENT TOO COMPLEX FOR ANALYSIS--',;
                  'COMPILATION ABORTED'                                 COBOL61
M062     TEXTC    'EXCESSIVE NEGATION'
M063     TEXTC    'NEGATIVE INTEGER-MUST BE UNSIGNED OR POSITIVE'
M064     TEXTC    'INTEGER VALUE TOO GREAT'
M065     TEXTC    'MNEMONIC-NAME SYNONYM'
M066     TEXTC    'SPECIFICATION CONFLICT'
M067     TEXTC    'MULTIPLE VALUE CLAUSES'
M068     TEXTC    'ILLEGAL USE OF ''REDEFINES'''
M069     TEXTC    'INCORRECT QUALIFICATION'
M070     TEXTC    'ILLEGAL DATA HIERARCHY'
M071     TEXTC    'INVALID ''RENAMES'' SCOPE'
M072     TEXTC    'MISPLACED ''RENAMES'' CLAUSE'
M073     TEXTC    'CONDITION-NAME ENTRY LACKS ''VALUE'' CLAUSE'
M074     TEXTC    'CONDITION-NAME ENTRY BEARS INVALID CLAUSE(S)'
M075     TEXTC    'MISPLACED ''REDEFINES'' CLAUSE'
M076     TEXTC    'ILLEGAL USE OF ''OCCURS ... DEPENDING ON'''
M077     TEXTC    'NESTING OF ''OCCURS'' EXCEEDS 3 LEVELS'
M078     TEXTC    'MISPLACED ''OCCURS'' CLAUSE'
M079     TEXTC    'USAGE CONFLICT BETWEEN GROUP AND SUBORDINATE ITEMS'
M080     TEXTC    'MISPLACED ''PICTURE CLAUSE'''
M081     TEXTC    'ILLEGAL ''BLANK WHEN ZERO'' CLAUSE'
M082     TEXTC    'ILLEGAL ''JUSTIFIED RIGHT'' CLAUSE'
M083     TEXTC    '''VALUE'' CLAUSE WITHIN SCOPE OF ''REDEFINES'''
M084     TEXTC    'NESTED ''VALUE'' CLAUSES'
M085     TEXTC    '''VALUE'' CLAUSE INCONSISTENT WITH CLASS OF ENTRY'
M086     TEXTC    '''OCCURS...DEPENDING ON'' ILLEGAL WITHIN SCOPE OF',;
                 '''REDEFINES'''
M087     TEXTC    '''PICTURE'' CLAUSE ILLEGAL ON GROUP ENTRY'
M088     TEXTC    'NON-UNIQUE DATA REFERENCE'
M089     TEXTC    'NON-UNIQUE PROCEDURE NAME'
M090     TEXTC    'INVALID ''DEPENDING ON'' FIELD'
M091     TEXTC    'NON-CONTIGUOUS DATA ITEM FOLLOWING DATA STRUCTURE',;
                  '- LEVEL 77 CHANGED TO LEVEL 01'
M092     TEXTC    'LEVEL 66 ILLEGAL FOLLOWING LEVEL 77, OR 01'
M093     TEXTC   'INVALID DATA USAGE'
M094     TEXTC    'MAXIMUM SIZE EXCEEDED FOR NUMERIC OPERAND'
M095     TEXTC   'UNDEFINED DATA REFERENCE'
M096     TEXTC   'INVALID DATA REFERENCE'
M097     TEXTC    'VALUE ILLEGAL WITHOUT COLUMN NO.'
M098     TEXTC    'NUMERIC VALUE ILLEGAL IN REPORT SECTION'
M099     TEXTC    'PRIORITY SEGMENTATION IS NOT HONORED IN THIS COMPI',;
                  'LATION'
M100     TEXTC    'ILLEGAL LEVEL-NUMBER SEQUENCE'
M101     TEXTC    'UNDEFINED KEY'
M102     TEXTC    'SIZE OF DATA ENTRY INDETERMINATE'
M103     TEXTC    'SIZES OF REDEFINING AND REDEFINED AREAS UNEQUAL'
M104     TEXTC    'RENAMES DATA-NAME MISSING'
M105     TEXTC    'VALUE LITERAL CONFLICTS WITH CLASS OF DATA ENTRY'
M106     TEXTC    'VALUE TRUNCATED ON RIGHT'
M107     TEXTC    'VALUE TRUNCATED ON LEFT'
M108     TEXTC    'DUPLICATE DATA-NAMES WHICH CANNOT BE UNIQUELY',;
                  ' REFERENCED'
M109     TEXTC    'EXCESSIVE NESTING OF LIBRARY RETRIEVAL STATEMENTS',;
                  ' - COMPILATION ABORTED'
M110     TEXTC    'PICTURE INCOMPATIBLE WITH USAGE'
M111     TEXTC    'INCORRECT ''GO TO'' STRUCTURE'
M112     TEXTC    '''USE'' STATEMENT OMITTED FROM DECLARATIVE SECTION'
M113     TEXTC    'POSSIBLE MISUSE OF RESERVED WORD'
M114     TEXTC    'NO CORRESPONDING DATA ITEMS IN A ''CORRESPONDING''',;
                  ' STATEMENT'
M115     TEXTC    'IDENTIFIER IN ''CORRESPONDING'' STATEMENT IS AN ',;
                  'ELEMENTARY ITEM'
M116     TEXTC    'COMPILER LIMITATION EXCEEDED - STATEMENT INCOMPLET',;
                  'ELY COMPILED'
M117     TEXTC    'INVALID LIBRARY RETRIEVAL STATEMENT',;
                  ' -COMPILATION ABORTED'
M118     TEXTC   'NUMBER OF RENAMED FILES EXCEEDS COMPILER CAPACITY'
M119     TEXTC    'ASSEMBLY PHASE TABLE OVERFLOW - COMPILATION ABORTED'
M120     TEXTC    'FILLER MEANINGLESS ON LEVEL 77 - ACCEPTED'
M121     TEXTC    'CONFLICT BETWEEN ''BLOCK CONTAINS'' CLAUSE AND RE',;
                      'CORD SIZE'
M122     TEXTC    'CANNOT PROCESS DATA STRUCTURE IN CORE AVAILABLE--',; COBOL61
                 'COMPILATION ABORTED'                                  COBOL61
M123     TEXTC    'REPORT FIELD OVERLAP - DATA ITEM TRUNCATED'
M124     TEXTC    'REPORT STATEMENTS BYPASSED'
M125     TEXTC    'CONFLICT BETWEEN ''RECORD CONTAINS'' CLAUSE AND RE',;
                  'CORD SIZE'
M126     TEXTC    'VACUOUS ''ROUNDED'' OPTION - IGNORED'
M127     TEXTC    '''SELECT'' SENTENCE(S) DUPLICATED'
M128     TEXTC   'ILLEGAL NUMERIC-EDITED USAGE'
M129     TEXTC   'ILLEGAL FLOATING-POINT USAGE FOR INTEGER'
M130     TEXTC   'ILLEGAL BINARY/FLOATING POINT USAGE'
M131     TEXTC   'ILLEGAL INDEX-DATA USAGE'
M132     TEXTC   'ILLEGAL NON-INTEGER USAGE'
M133     TEXTC   'ILLEGAL COMPUTATIONAL-3 USAGE'
M134     TEXTC   'ILLEGAL ALPHANUMERIC USAGE'
M135     TEXTC   'ILLEGAL ALPHANUMERIC-EDITED USAGE'
M136     TEXTC    'MAXIMUM OF 3 IDENTIFIERS ONLY MAY BE VARIED - ENTI',;
                                   'RE ''PERFORM'' STATEMENT DELETED'
M137    TEXTC    'ILLEGAL ELEMENTARY ITEM USAGE'
M138     TEXTC   'ILLEGAL INDEX NAME USAGE'
M139     TEXTC   'PARAGRAPH BOTH ALTERED AND PERFORMED'
M140     TEXTC   'ALTERED PARAGRAPH NOT ''GO TO'''
M141     TEXTC   'INVALID PROCEDURE REFERENCE'
M142     TEXTC   'INVALID SECTION NAME REFERENCE'
M143     TEXTC   'EXTERNAL NAME ALTERED TO PROCEED TO OVERLAY'
M144     TEXTC   'INVALID PARAGRAPH NAME REFERENCE'
M145     TEXTC    'INTEGER VALUE ILLEGAL IN CONTEXT'
M146     TEXTC    '''SET'' USED WITH NON-INDEXED FIELD'
M147     TEXTC    '''GO TO'' INITIALIZED AT C:ERR'
M148     TEXTC   'INVALID FILE NAME'
M149     TEXTC   'INVALID RECORD NAME'
M150     TEXTC   'LABEL/ERROR CHECK IN DECLARATIVE SECTION'
M151     TEXTC   'INVALID REVERSED/NO REWIND OPTION'
M152     TEXTC    'AT END/INVALID KEY OPTION INCOMPATIBLE WITH ',;      COBOL61
                  'ACCESS MODE'                                         COBOL61
M153     TEXTC   '''SEEK'' USED WITH UN-KEYED FILE'
M154     TEXTC   'INVALID KEY'
M155     TEXTC   'MAXIMUM DISPLAY SIZE EXCEEDED'
M156     TEXTC    'ILLEGAL SUBSCRIPTED ''DEPENDING ON'' FIELD'
M157     TEXTC    'NON TABLE ITEM SEARCH'
M158     TEXTC    '''SEARCH ALL'' UNORDERED TABLE ILLEGAL'
M159     TEXTC    'EXTERNAL REFERENCE GENERATED'
M160     TEXTC   'UNDEFINED PARAMETER NAME'
M161     TEXTC   'CONDITION NAME USED AS PARAMETER'
M162     TEXTC   'DIMENSIONED PARAMETER'
M163     TEXTC   'INDEX NAME USED AS PARAMETER'
M164     TEXTC   'SUBSCRIPTS/INDICES APPLIED TO UNDIMENSIONED DATA ITEM'
M165     TEXTC    'INVALID SUBSCRIPTS/INDICES'
M166     TEXTC   'EXCESSIVE SUBSCRIPTS/INDICES'
M167     TEXTC   'MAXIMUM SUBSCRIPT SIZE EXCEEDED'
M168     TEXTC   'FRACTION USED AS SUBSCRIPT'
M169     TEXTC   'SIGNIFICANCE LOST WHEN ALIGNED'
M170    TEXTC    'INCORRECT SUBSCRIPT/INDEX'
M171     TEXTC   'FLOATING POINT SUBSCRIPT/INDICES--INTEGER VALUE ONLY'
M172     TEXTC   'SUBSCRIPTED TABLE ITEM'
M173     TEXTC   'SUBSCRIPT INCREMENT/DECREMENT USED'
M174     TEXTC   'INEFFECTIVE DIGITS TRUNCATED'
M175     TEXTC   'NON-INTEGER SUBSCRIPT--INTEGER VALUE USED'
M176     TEXTC   'DIMENSIONED SUBSCRIPT'
M177     TEXTC   'INSUFFICIENT SUBSCRIPTS/INDICES'
M178     TEXTC   'DIMENSIONED DATA NOT SUBSCRIPTED/INDEXED'
M179     TEXTC    'MAXIMUM SORT KEY LENGTH EXCEEDED - 255 CHARACTERS ',;
                  'USED'
M180     TEXTC    'INVALID CS NAME - IGNORED'
M181     TEXTC    'INVALID CONTROL COMMAND OPTION - IGNORED'
M182     TEXTC    'ILLEGAL RELATION TEST. ONLY CONDITION-',;
                  'NAME TEST GENERATED'
M183     TEXTC    'ILLEGAL OPERAND IN COMPARISON, ',;
                  'COMPARISON DELETED'
M184     TEXTC    'ILLEGAL SUBJECT IN RELATION TEST. ',;
                  'STATEMENT DELETED'
M185     TEXTC    'ILLEGAL RELATION TEST'
M186     TEXTC    'RELEASE/RETURN NOT IN INPUT/OUTPUT PROCEDURE'
M187     TEXTC    'SORT STATEMENT WITHIN INPUT/OUTPUT PROCEDURE-DELETED'
M188     TEXTC    'SORT KEY NOT IN SORT FILE RECORD DESCRIPTION'
M189     TEXTC    'NO SORT KEYS'
M190     TEXTC    'EXCESSIVE SORT KEYS'
M191     TEXTC    'INVALID REPORT RECORD'
M192     TEXTC    'INVALID DATA REFERENCE - EXPRESSION DELETED'
M193     TEXTC    'INVALID EXPRESSION OPERAND - EXPRESSION DELETED'
M194     TEXTC    'INVALID EXPRESSION - DELETED'
M195     TEXTC    'UNBALANCED EXPRESSION - DELETED'
M196     TEXTC    'SUM ADDENDS NOT DEFINED IN A DETAIL OR OTHER SUM I',;
                  'TEM'
M197     TEXTC    'INCOMPATIBLE LINE NUMBERS GIVEN IN ''PAGE LIMITS''',;
                  ' CLAUSE'
M198     TEXTC    'NO FD/SD ENTRY ASSOCIATED WITH A ''SELECT'' CLAUSE',;
                  ' - COMPILATION ABORTED'
M199     TEXTC    'DUPLICATE FD/SD ENTRIES'
M200     TEXTC    'CONFLICT BETWEEN ''ACCESS MODE'' AND',;
                  '''ACTUAL KEY'' - RANDOM ACCESS ASSUMED.'
M201     TEXTC    'CONFLICT BETWEEN ''ACCESS MODE'' AND',;
                  '''ACTUAL KEY'' - SEQUENTIAL ACCESS ASSUMED.'
M202     TEXTC    'MAXIMUM ACTUAL KEY SIZE EXCEEDED - 255 CHARACTERS ',;
                  'USED'
M203     TEXTC    '''END DECLARATIVES'' STATEMENT MISSING'
M204     TEXTC    'MAXIMUM NUMBER OF SELECT STATEMENTS EXCEEDED',;
                  '-COMPILATION ABORTED'
M205     TEXTC    'MORE THAN 3 FD''S ASSOCIATED WITH 1 RD - IGNORED'
M206     TEXTC    'VALUE CLAUSE NOT ALLOWED-COMPILATION ABORTED'
M207     TEXTC    'LEVEL 66 DATA ENTRY BEARS INVALID CLAUSE(S)'
M208     TEXTC    'EXCESSIVE CHARACTERS IN PICTURE STRING - TRUNCATED'
M209     TEXTC    'A ''RENAMING'' STATEMENT CANNOT BE HONORED'
M210     TEXTC    'RIGHTMOST AND/OR FRACTIONAL DIGITS TRUNCATED'
M211     TEXTC    'LEFTMOST DIGITS/CHARACTERS TRUNCATED'
M212     TEXTC    'INTEGER AND FRACTIONAL DIGITS TRUNCATED'
M213     TEXTC    'LEVEL 77 ILLEGAL IN FILE SECTION',;
                  ' - DATA ENTRY DISCARDED'
M214     TEXTC    'DUPLICATE OR INVALID RD NAME - COMPILATION',;
                  ' - ABORTED'
M215     TEXTC    'VALUE CLAUSE WITHIN SCOPE OF OCCURS'
M216     TEXTC    'OCCURS ILLEGAL ON LEVEL 01 OR 77 '
M217     TEXTC    'DECLARATIVE IS NOT APPROPRIATE ON FILE WITH LABEL ',;COBOL61
                  'RECORDS OMITTED'
M218     TEXTC    'ILLEGAL CONTINUATION CHARACTER - IGNORED'
M219     TEXTC    'DECLARED DATA STORAGE EXCEEDS AVAILABLE ',;
                  'CORE STORAGE'
M220     TEXTC    'DUPLICATE DECLARATIVES HAVE BEEN SPECIFIED'          COBOL61
M221     TEXTC    'INTEGER PERFORM COUNT LIMIT OF (2**19)-1 EXCEEDED',;
                  ' -- VALUE TRUNCATED'
M222     TEXTC    'COMPILER LIMIT OF 9 REPORT CONTROL FIELDS EXCEEDED',;
                  ' -- COMPILATION TERMINATED'
M223     TEXTC     'USAGE NOT SPECIFIED -- NUMERIC DISPLAY ASSUMED'     COBOL61
M224     TEXTC    'KEYED FILE BLOCKING PRE-EMPTED BY MONITOR',;         COBOL61
                  '--CLAUSE IGNORED'                                    COBOL61
M225     TEXTC    'SIZE IN NUMERIC PICTURE GREATER THAN 31---RESULTS',; COBOL61
                 ' ARE UNPREDICTABLE'                                   COBOL61
M226     TEXTC    'CAUTION NO RECORD DESCRIBED--VALID IF REPORT ',;     COBOL61
                  'CLAUSE PRESENT'                                      COBOL61
M227     TEXTC     'WARNING---PROCEDURE NAME PASSED IN ENTER ',;        COBOL61
                   'STATEMENT IN AN OVERLAY SEGMENT'                    COBOL61
M228     TEXTC    'OPTION OF DEBUGGING MISSING/INVALID'
M229     TEXTC    'COPY  REPLACING STATEMENT INCORRECTLY STRUCTURED'
M230     TEXTC    'DEVICE NOT SPECIFIED - CONSOLE ASSUMED'
M231     TEXTC    'IDENTIFIER NOT SPECIFIED FOR "ACCEPT" STATEMENT'
M232     TEXTC    'USAGE NOT SPECIFIED - DISPLAY ASSUMED'
M233     TEXTC    'MAXIMUM DCB SIZE EXCEEDED - 3 INSN/OUTSNS GENERATED'
M234     TEXTC    'UNDEFINED PROCEDURE NAME - EXTERNAL REFERENCE GENE',;
                  'RATED'
M235     TEXTC    'SOURCE INPUT EXCEEDS 72 CHARACTERS - TRUNCATED'
M236     TEXTC    'REMAINDER NOT ALLOWED ON DIVIDE WITH MULTIPLE',;
                  ' RECEIVING FIELDS'
M237     TEXTC    'SUBSCRIPTED ''DEPENDING ON'' DATA NAME - ',;
                  'COMPILATION ABORTED'
M238     TEXTC    '''OCCURS DEPENDING ON'' ENTRIES EXCEEDED LIMIT 15',;
                  '-COMPILATION ABORTED'
M239     TEXTC    'OPTION OF DELIMITED MISSING/INVALID'
M240     TEXTC    'IDENTIFIER MISSING/INVALID AFTER ''IN''/''OF'''
M241     TEXTC    'REQUIRED WORD ''RUN'' OR LITERAL MISSING AFTER ',;
                  '''STOP'''
M242     TEXTC    'REQUIRED WORD ''INTO'' OR ''BY'' MISSING'
M243     TEXTC    'FILE-NAME OR REQUIRED WORD(S) ''REVERSED''/',;
                  '''NO REWIND'' MISSING'
M244     TEXTC    'REQUIRED WORD(S) MISSING AFTER ''TALLYING'' OR ',;
                  '''REPLACING'''
M245     TEXTC    'REQUIRED WORD ''TALLYING'' OR ''REPLACING'' MISSING'
M246     TEXTC    'REQUIRED WORD ''TO'' MISSING'
M247     TEXTC    'REQUIRED WORD ''DEPENDING'' MISSING'
M248     TEXTC    'REQUIRED WORD ''TIMES''/''UNTIL''/''VARYING''',;
                  ' MISSING'
M249     TEXTC    'REQUIRED WORD ''INTO''/''END''/''INVALID'' MISSING'
M250     TEXTC    'REQUIRED WORD ''FROM'' MISSING'
M251     TEXTC    'REQUIRED WORD ''UNTIL'' MISSING'
M252     TEXTC    'REQUIRED WORD ''ELSE'' MISSING'
M253     TEXTC    'REQUIRED WORD ''WHEN'' MISSING'
M254     TEXTC    'REQUIRED WORD(S) ''LOCK'' OR ''NO REWIND'' MISSING'
M255     TEXTC    'REQUIRED WORD(S) ''TO''/''UP BY''/''DOWN BY''',;
                  ' MISSING'
M256     TEXTC    'REQUIRED WORD ''INPUT''/''OUTPUT''/''I-O'' MISSING'
M257     TEXTC    'FILE-NAME MISSING'
M258     TEXTC    'LITERAL MISSING AFTER ''ALL''/''LEADING''/',;
                  '''FIRST'''
M259     TEXTC    'LITERAL MISSING AFTER ''BY'''
M260     TEXTC    'IDENTIFIER/INTEGER/MNEMONIC-NAME MISSING AFTER',;
                  ' ''BEFORE/AFTER ADVANCING'''
M261     TEXTC    'RECORD-NAME MISSING AFTER ''WRITE'''
M262     TEXTC    'IDENTIFIER/LITERAL/INDEX-NAME MISSING AFTER',;
                  ' ''FROM''/''TO''/''BY'''
M263     TEXTC    'IDENTIFIER MISSING AFTER ''TO'''
M264     TEXTC    'IDENTIFIER MISSING AFTER ''TO''/''GIVING'''
M265     TEXTC    'IDENTIFIER MISSING AFTER ''COMPUTE'''
M266     TEXTC    'IDENTIFIER MISSING AFTER ''INSPECT'''
M267     TEXTC    'IDENTIFIER MISSING AFTER ''DEPENDING ON'''
M268     TEXTC    'IDENTIFIER MISSING AFTER ''INTO'''
M269     TEXTC    'IDENTIFIER MISSING AFTER ''FROM'''
M270     TEXTC    'IDENTIFIER MISSING AFTER ''SEARCH'''
M271     TEXTC    'IDENTIFIER MISSING AFTER ''ACCEPT'''
M272     TEXTC    'PROCEDURE-NAME MISSING'
M273     TEXTC    'MISSING/INCORRECT STATEMENT AFTER ''AT END''/',;
                  '''INVALID KEY''/''SIZE ERROR'''
M274     TEXTC    'REQUIRED WORD(S) ''NEXT SENTENCE'' MISSING'
M275     TEXTC    'SUBROUTINE-NAME MISSING AFTER ''ENTER'''
M276     TEXTC    'IDENTIFIER/LITERAL INVALID OR MISSING'
M277     TEXTC    'IDENTIFIER/INDEX-NAME MISSING AFTER ''VARYING''/',;
                  '''SET''/''AFTER'''
M278     TEXTC    'IDENTIFIER/LITERAL MISSING AFTER ''INTO''/''FROM''',;
                  '/''BY'''
M279     TEXTC    'NUMBER OF USE STATEMENTS EXCEEDS 64--',;             COBOL61
                  'COMPILATION ABORTED'                                 COBOL61
M280     TEXTC    'SIZE FOR THIS SECTION HAS EXCEEDED 65K'              COBOL61
M281     TEXTC    'UNDEFINED/INVALID REPORT NAME'
M282     TEXTC    'NOT ENOUGH DYNAMIC MEMORY--COMPILATION ABORTED'      COBOL61
M283     TEXTC    'SOURCE IMAGE EXCEEDED 80 CHARACTERS - ',;            COBOL61
                  'TRUNCATED'                                           COBOL61
M284     TEXTC    'SOURCE IMAGE EXCEEDED 140 CHARACTERS - ',;           COBOL61
                  'COMPILATION ABORTED'                                 COBOL61
M285     TEXTC    'invalid/missing report record--compilation aborted'  cobol61
M286     TEXTC    'UNDEFINED CONTROL FIELD, IGNORED'
M287     TEXTC    'INVALID DATA USAGE IN CLASS TEST'
M288     TEXTC    'SIZE FOR THIS DATA ITEM HAS EXCEEDED 65K'            COBOL61
M289     TEXTC    'MAX. NUMBER OF REPORT PER FILE EXCEEDED,',;          COBOL61
                  'IGNORE EXCEEDED REPORT NAMES'                        COBOL61
M290     TEXTC    'COMPILER LIMIT OF 50 VALUES EXCEEDED',;              COBOL61
                  ' - EXCESS IGNORED'                                   COBOL61
M291     EQU      M000              AVAILABLE                           COBOL61
M292     EQU      M000              AVAILABLE                           COBOL61
M293     EQU      M000              AVAILABLE                           COBOL61
M294     EQU      M000              AVAILABLE                           COBOL61
M295     EQU      M000              AVAILABLE                           COBOL61
MSGCNT   EQU      295                                                   COBOL61
* IF NEW DIAGNOSTICS ARE ADDED, THIS NUMBER MUST BE CHANGED
* BECAUSE LOCATION WRITED+7 TESTS AGAINST THIS VALUE
         TITLE    'COBOL61 PROGRAM'
         PAGE
LOC      RES       AREA
COB61    LI,5     BA(HEADR+18)
         LI,4     18
         STB,4    5
         LI,4     BA(TMDATE+1)      MOVE TIME-DATE
         MBS,4    0
         M:DEVICE M:LO,(HEADER,2,HEADR)
         M:DEVICE M:LO,(COUNT,105)
         M:DEVICE M:LO,(PAGE)
         M:DEVICE M:LO,(CORRES,M:LL)
         LW,8     8
         BNEZ     COB610            NOT TO M:LL
         STW,8    JUNF              SET M:LL FLAG
         LW,1     RGMLF
         MBS,0    BA(BLANKS)
         LW,3     RGMLT
         LI,2     BA(TMDATE+1)      TIME-DATE
         MBS,2    0
         LI,2     1                 GET JOB NUMBER
         LH,4     *X'4F',2          ***X'4F' MAY BE CHANGED TO J:UN***  COBOL61
         LI,7     BA(DLBUF+1)+3                                         COBOL61
         LI,6     4                                                     COBOL61
         BAL,11   EBCD              CONVERT TO EBCDIC                   COBOL61
         LW,5     L(C'*ID=')
         STW,5    DLBUF
         CAL1,1   WLISTL
COB610   LW,2     PDBP
         CI,2     X'4000'
         BANZ     COB611            ABORT FLAG SET
         LI,2     10
         AND,2    PDB
         BEZ      COB611            NO MAP REQUESTED
         BAL,10   MPFRD             READ MPF
         LW,5     PDBZ+5
         SW,5     PDBZ
         DH,5     THREE
         AW,5     PDBZ
         STW,5    SRTBA             MPFS BUFFER BYTE ADDR
SRT01    BAL,11   RDMPFS            READ MPFS
         CI,2     0
         BL       SRT02
         LW,4     OVCNT
         LW,3     SRTBA
         STW,3    *PDBZ,4           SET INDEX
         SLS,3    2
         LI,4     8
         STB,4    3
         MBS,2    0                 MOVE CLUSTER
         MTW,1    OVCNT
         MTW,2    SRTBA
         LW,4     PDBZ+5            PDBZ6 = MAX DYNAMIC                 COBOL61
         CW,4     SRTBA             SEE IF WE HAVE EXCEEDED             COBOL61
         BGE      SRT01             NO                                  COBOL61
         B        SRT07             YES                                 COBOL61
SRT02    LW,1     OVCNT
SRT03    SLS,1    -1
         CI,1     0
         BE       COB612
         LW,2     OVCNT
         SW,2     1
         LI,3     0
SRT04    LW,5     3                 START SORTING
         LW,4     1
         AW,4     5
         LW,7     *PDBZ,5
         LW,6     1,7
         LW,7     *PDBZ,4
         CW,6     1,7               COMPARE LINE NUMBER
         BG       SRT06
SRT05    AI,3     1
         CW,3     2
         BCS,1    SRT04
         B        SRT03
SRT06    LW,6     *PDBZ,5           EXCHANGE INDEX
         XW,6     *PDBZ,4
         XW,6     *PDBZ,5
         SW,5     1
         BCS,1    SRT05
         B        SRT04+1
SRT07    EQU      %                                                     COBOL61
         LW,1     REG1B                                                 COBOL61
         MBS,0    BA(BLANKS)        BLANK OUT BUFFER                    COBOL61
         LI,6     BA(DYNMESS)       NOT ENOUGH DYNAMIC MESS             COBOL61
         LW,7     DYNMBS                                                COBOL61
         MBS,6    0                 MOVE MESSAGE                        COBOL61
         CAL1,1   WLIST             WRITE MESSAGE                       COBOL61
         BAL,11   PRNTL             SEE IF IT GOES TO M:LL              COBOL61
COB611   LI,2     0                 SET NO MAP FLAG
         STW,2    BMPF+1
COB612   LW,1     REG1C             BLANK OUTPUT LINE
         MBS,0    BA(BLANKS)
         CAL1,1   WLISTS            PRINT BLANK LINE
         LI,5     MAXDIAG           MAX NO OF DIAG MESSAGES
         LI,2     LOC               INITIALIZE *BUFF ADDR IN LISTR
         LI,3     0                 INITIALIZE *BYTE DISPL IN LISTR
         LI,1     1
RDIAG    CAL1,1   LISTR             READ DMF EOF GO TO ABIO
         AWM,1    DCOUNT            COUNT DIAG MESSAGES
         EOR,3    MASK1             CHANGE BYTE DISPLACEMENT FOR LISTR
         BEZ      CHANGE
         AI,2     1                 ADD 1 TO BUFF ADDR FOR LISTR
         B        CHANGE+1
CHANGE   AI,2     2                 ADD 2 TO BUFF ADDR FOR LISTR
         CW,5     DCOUNT
         BNE      RDIAG             READ NEXT RECORD DMF
         AWM,1    DFLAG             SET FLAG TO OUTPUT OVERFLOW MESSAGE
SORT     LW,7     DCOUNT            DIAGNOSTIC COUNT TO R7
         STW,7    6
SHIFT    SLS,6    -1                DIAG-COUNT/2 IN R6
         CI,6     0
         BE       MERGE             SORT FINISHED IF R6 = 0
         LW,15    7                 FIRST ELEMENT OF LAST SUBSET =
         SW,15    6                    3(R7-R6)
         MI,15    3
         LI,3     0                 SET SUBSET COUNTER TO 0
         LW,13    6                 COMPUTE INCREMENT = 3(R6)
         MI,13    3
FIRST    STW,3    2                 FIRST ELEMENT OF CURRENT SUBSET (R2)
UP       STW,13   5
         AW,5     2                 SECOND ELEMENT OF CURRENT SUBSET(R5)
         LI,10    2                 SET LOOP COUNTER
         STW,2    1                 HW INDEX FOR FIRST ELEMENT
         STW,5    4                 HW INDEX FOR SECOND ELEMENT
GETHW    LH,9     LOC,1             COMPARE HALFWORDS
         CH,9     LOC,4             COMPARE FIRST & SECOND
         BL       ADD3
         BG       SETMOVE
         AI,1     1
         AI,4     1
         BDR,10   GETHW
         B        ADD3
SETMOVE  LI,10    3                 INITIALIZE
         STW,2    1
         STW,5    4
MOVE     LH,12    LOC,1             EXCHANGE ELEMENTS
         LH,14    LOC,4
         STH,14   LOC,1
         STH,12   LOC,4
         AI,1     1
         AI,4     1
         BDR,10   MOVE
         SW,2     13                ELEMENT COMPARED PREVIOUSLY?
         BGEZ     UP                YES START TOP OF LIST(CURRENT INC)
ADD3     AI,3     3                 ADD 3 TO SUBSET COUNTER
         CW,3     15                LAST SUBSET COMPARED ?
         BGE      SHIFT             YES-START AGAIN (NEW INC)
         B        FIRST             NO-CONTINUE DOWN LIST
MERGE    LI,4     1                 INITIALIZE FOR MERGE
         LI,2     -1
         BAL,11     RDMF          MOVE FIRST RECORD OF DMF TO DMFLOC
         LW,9     PDBCC
         SLS,9    16
         CI,9     0
         BGE       SUPLIST
         B        READS
COMPARE  CW,2     DMFLOC
         BGE      WRITED
READS    CAL1,1   RSPF              READ SPF
         LI,3      X'0000FFFF'
         LS,2      SLBUF2
         LI,4     1                                                     COBOL61
         MTH,0    2,4
         BNEZ     CONVCOP           CONVERT COPIED LINE NUMBER
         MTH,1    2
INITIAL  LI,3      3
         LH,6     2
         BAL,11   CONVERT           CONVERT SOURCE LINE NUMBER
         UNPK,3   BA(SLBUF),3
         LW,9     MASKS
         STS,9    SLBUF+1           INSERT F IN SOURCE LINE NUMBER
         LD,12    BLANKS
         STD,12   SLBUF+2           BLANK COPIED LINE NO
         B        *IND              GO TO WRITES1 OR RETURN
WRITES   UNPK,3   BA(SLBUF),3
         LW,9     MASKCD
         STS,9    SLBUF+3
WRITES1  LCI      15
         STM,1    REGSV
         LD,12    BLANKS
         STD,12   SLBUF+4
         CW,2     TMDATE
         BNE      WRITES2           NOT DATE-COMPILED CARD
         LI,1     BA(SLBUF2+2)+2                                        COBOL61
         LI,6     ' '               GET A BLANK                         COBOL61
         AI,1     1                 FIND OUT WHERE DATE-COMPILED STARTS COBOL61
         CB,6     0,1                                                   COBOL61
         BE       %-2               LOOP UNTIL WE FIND CHARACTER        COBOL61
         LW,5     1                 SAVE STARTING LOCATION              COBOL61
         LW,1     REG2C
         MBS,0    BA(BLANKS)
         LI,4     16                                                    COBOL61
         STB,4    5
         LI,4     BA(DTCMP)
         MBS,4    0                 MOVE IN 'DATE-COMPILED'
         AW,5     RGMDC             SPACE OVER 2                        COBOL61
         LI,4     BA(HEADR+19)+2
         MBS,4    0                 MOVE IN DATE
         LI,4     C'.'              '.' IN STLIST
         STB,4    0,5
         B        WRITES9
WRITES2  LW,6     BMPF+1
         BNEZ     WRITES4           MPF NOT FINISHED
WRITES3  LW,5     SDISP
         CW,5     OVCNT
         BGE      WRITES9
         LW,7     *PDBZ,5           INDEX TO CLUSTER
         LW,6     1,7
         CW,6     2                 SAME SOURCE LINE?
         BG       WRITES9                                               COBOL61
         BE       WMATCH                                                COBOL61
         MTW,1    SDISP                                                 COBOL61
         B        WRITES3                                               COBOL61
WMATCH   LW,4     0,7                                                   COBOL61
         MTW,1    SDISP
         B        WRITES5
WRITES4  CW,6     2
         BNE      WRITES3           NOT THE LINE
         LW,4     BMPF              B OF MPF
         BAL,10    MPFRD            READ NEXT MPF
WRITES5  LI,7     BA(SLBUF+5)                                           COBOL61
         LI,6     5
         BAL,11   EBCD              CONVERT TO EBCDIC                   COBOL61
WRITES9  LCI      15
         LM,1     REGSV
WRITES10 LI,6     10
         LB,7     SLBUF2,6
         CI,7     '/'
         BNE      WRITES11
         M:DEVICE M:LO,(PAGE)
WRITES11 RES      0                                                     COBOL61

         CI,7       '<'                                                 COBOL61

         BE       LISTOFF                                               COBOL61

         CI,7     '>'                                                   COBOL61

         BE       LISTON                                                COBOL61

LISTIT   RES      0                                                     COBOL61

         MTW,0    LISTCNTRL                                             COBOL61

         BNEZ     LISTDONE                                              COBOL61

         CAL1,1   WLISTS                                                COBOL61

LISTDONE RES      0                                                     COBOL61

         B        *DDONE            GO TO COMPARE,WRITED OR READS
WRITED   LH,5     DMFLOC+1          GET DIAG NUMBER
         LI,3     7
         LW,6     5
         BAL,11   CONVERT           CONVERT DIAG NO
         UNPK,2   BA(DBUF),3
         LW,9     MASKCD
         STS,9    DBUF+2            INSERT F IN DIAG NUMBER
         CI,5     MSGCNT            TEST FOR LARGEST MESSAGE NUMBER
         BG        LARGE
         LI,7     BA(DMBUF)         BA(DESTINATION)      INITIALIZE
         LI,6     BA(DMTEXTS)      LOCATE THE
         AH,6     ADDRM,5           DIAGNOSTIC MESSAGE TEXT
         LB,9     0,6                AND PICK UP CHARACTER COUNT
         STB,9    7                 COUNT                      S
         MBS,6    1                 MOVE DIAG MESSAGE TO BUFFER
         LW,1     7                 BLANK DIAG LINE
         LI,6     120
         SW,6     9
         STB,6    1
         MBS,0    BA(BLANKS)
BIG      CAL1,1   WLIST             WRITE DIAGNOSTIC MESSAGE
         LW,6     JUNF
         BNEZ     READD             NOT TO M:LL
         LI,4     BA(SLBUF)+2
         LW,5     RGML0
         MBS,4    0                 LINE NUMBER
         LW,4     DBUF+1
         LW,5     DBUF+2
         SLD,4    -8
         STW,5    DLBUF+3           DIAGNOSTIC NUMBER
         LI,4     BA(DMBUF)
         LW,5     RGML2
         MBS,4    0                 DIAGNOSTIC TEXT
         CAL1,1   WLISTL
READD    BAL,11    RDMF             MOVE NEXT RECORD OF DMF TO DMFLOC
         B        *SDONE            GO TO COMPARE,WRITED OR SET2
MPFRD    BAL,11   RDMPF             READ MPF
         CI,2     0
         BGE      MPFRD1
         LI,2     0
         STW,2    BMPF+1            SET END OF MPF
         B        *10
MPFRD1   LW,3     RGMPF
         MBS,2    0                 MOVE MPF TO BMPF
         B        *10
CONVCOP  LI,11    WA(WRITES)        SET RETURN ADDRESS
         LD,12    EDIT
         STD,12   SLBUF+2           INSERT PERIOD
         LH,6     2,4
         LI,3     9
CONVERT  CVS,6    CVRTBL
         DL,4     CONVAL
         OR,15    7
         B        *11
LARGE    LW,1     REG1A             FOR DEBUGGING ONLY--TEST FOR DIAG
         MBS,0    BA(AST)             NUMBER EXCEEDING 200
         B       BIG
SET2     LW,2     DMFLOC            ROUTINE TO PRINT LINE NUMBER IF
         B        INITIAL             SOURCE LISTING IS SUPPRESSED
RETURN   RES      0                                                     COBOL61
         LI,4     1                                                     COBOL61
         MTH,0    2,4               ROUTINE TO PRINT COPIED LINE NUMBER COBOL61
         BNEZ     CONVCOP             IF SOURCE LISTING IS SUPPRESSED
         B        WRITES10
TESTIO   LB,6     10                ROUTINE TO TEST EOF AFTER ABN ERROR
         CI,6     6
         BE       *11
         B        ABNERR
ABIO     BAL,11   TESTIO            ABNORMAL ERROR ROUTINE(EOF READ DMF)
         LW,12    DCOUNT
         STW,12    DKOUNT
         CI,12    1
         BE       MERGE             SKIP SORT IF ONLY 1 DIAGNOSTIC
         CI,12     0
         BNE       SORT
         LI,4      1
         LI,2      -1               INITIALIZE LINE COUNTER
         LI,14     READS
         STW,14   DDONE
         B         TESTEND
RDMF     MTW,-1   DKOUNT            ROUTINE TO MOVE DMF RECORDS TO
         BLZ      FINISH              COMPARE AREA AND CHECK FOR LAST
         LW,6     EVEN                RECORD
         LW,7      ODD
         MBS,6     0
         STW,6     EVEN
         B        *11
FINISH   MTW,0    DFLAG             ROUTINE TO OUTPUT DIAGNOSTIC IF
         BEZ      ENDIAG               NUMB DIAG MESSAGES EXCEEDS MAX
         LW,1     REG1B
         MBS,0    BA(BLANKS)
         LI,6     BA(MAXMESS)
         LW,7     ODDD
         MBS,6    0
         CAL1,1   WLIST
         BAL,11   PRNTL
         MTW,1    DCOUNT
ENDIAG   LI,14    READS             ROUTINE TO OUTPUT REMAINING SOURCE
         STW,14   DDONE                LINES
         B         TESTEND
PRNTL    LW,6     JUNF              OUTPUT TO M:LL
         BNEZ     *11
         LW,5     RGML1
         LI,4     BA(DBUF)
         MBS,4    0                 MOVE TO DLBUF
         CAL1,1   WLISTL
         B        *11
EBCD     LI,5     0                 CONVERT TO EBCDIC                   COBOL61
         SLD,4    -4                                                    COBOL61
         SCS,5    4                                                     COBOL61
         CI,5     9                                                     COBOL61
         BG       EBCD1                                                 COBOL61
         OR,5     L(X'F0')                                              COBOL61
         B        EBCD2                                                 COBOL61
EBCD1    AI,5     -9                                                    COBOL61
         OR,5     L(X'C0')                                              COBOL61
EBCD2    STB,5    0,7                                                   COBOL61
         AI,7     -1                                                    COBOL61
         BDR,6    EBCD                                                  COBOL61
         B        *11                                                   COBOL61
SUPLIST  LI,14    RETURN            ROUTINE TO SUPPRESS SOURCE LISTING
         STW,14    IND
         LI,14     WRITED
         STW,14    DDONE
         LI,14     SET2
        STW,14     SDONE
         B         TESTEND
ABSOURCE  BAL,11   TESTIO
         LI,14    WRITED
         STW,14    SDONE
TESTEND  MTW,1    FLAG              ENDING ROUTINE--IF 1 FILE DONE,
         BEZ      *14                 OUTPUT OTHER, IF BOTH DONE
         LW,1     REG2A             OUTPUT NUMB DIAGNOSTICS
         MBS,0     BA(BLANKS)
         CAL1,1   WLIST
         LW,6     DCOUNT
         BAL,11   CONVERT
         LW,7      SL               SEVERITY LEVEL                      COBOL61
         CI,7      9                                                    COBOL61
         BG        %+2                                                  COBOL61
         AI,7      X'39'                                                COBOL61
         AWM,7     SLMESS                                               COBOL61
         LI,6      BA(NUMB)
         LW,7      NUMB2
         MBS,6    0
         LW,4     REGR
         LW,5     REGRU
         LCI      4
         EBS,4    X'3D'
         CAL1,1   WLIST
         BAL,11   PRNTL
         B        PH61E
LISTOFF  RES      0                                                     COBOL61

         STW,7    LISTCNTRL                                             COBOL61

         B        LISTDONE                                              COBOL61

LISTON   RES      0                                                     COBOL61

         LI,7     0                                                     COBOL61

         STW,7    LISTCNTRL                                             COBOL61

         B        LISTIT                                                COBOL61

LISTCNTRL DATA     0                                                    COBOL61

         END       COB61
