UNISYS COBOL85 IC COBOL85-048.1A.2 [48.189.002] 2002 November 2 7:36:17 am Page 1 Card = (PAUL)SRCE/UNITE/AS4027/COBOL85/SAMPLE ON OPS Code file = OBJECT/UNITE/AS4027/COBOL85/SAMPLE 000020 $$ SET LIST MAP MAPONELINE PAGESIZE=80 000100 $$ SET LINEINFO BINDINFO 000120 $$ FEDLEVEL=5 00000120 001000 003:0000:0 100000 IDENTIFICATION DIVISION. 003:0000:0 100100 PROGRAM-ID. AS4027-COBOL85-SAMPLE. 003:0000:0 100200 *AUTHOR. P.KIMPEL. 003:0000:0 100300 *INSTALLATION. PARADIGM CORPORATION, SAN DIEGO. 003:0000:0 100400 *DATE-WRITTEN. NOVEMBER 2002. 003:0000:0 100500 003:0000:0 100600 ****************************************************************** 003:0000:0 100700 * UNITE/AS4027/COBOL85/SAMPLE * 003:0000:0 100800 ****************************************************************** 003:0000:0 100900 * THIS PROGRAM CONTAINS SOME COMMON MEMORY ALLOCATION 003:0000:0 101000 * TECHNIQUES USED BY COBOL-85, FOR THE PURPOSE OF SHOWING 003:0000:0 101100 * HOW THEY APPEAR IN AN MCP PROGRAMDUMP. THIS SAMPLE ALSO 003:0000:0 101200 * ILLUSTRATES CALLING A PROGRAM LIBRARY. 003:0000:0 105000 ****************************************************************** 003:0000:0 105002 * MODIFICATION LOG. 003:0000:0 105006 * 2002-11-01 P.KIMPEL 003:0000:0 105007 * ORIGINAL VERSION, CLONED FROM ISAMCALC. 003:0000:0 109990 ****************************************************************** 003:0000:0 110000 003:0000:0 110100 ENVIRONMENT DIVISION. 003:0000:0 110200 CONFIGURATION SECTION. 003:0000:0 110300 SOURCE-COMPUTER. UNISYS-MCP. 003:0000:0 110400 OBJECT-COMPUTER. UNISYS-MCP. 003:0000:0 110500 003:0000:0 110600 INPUT-OUTPUT SECTION. 003:0000:0 110700 FILE-CONTROL. 003:0000:0 110800 SELECT DC-FILE 003:0000:0 110900 ASSIGN TO REMOTE. 003:0000:0 111000 SELECT PR-FILE 003:0000:0 111100 ASSIGN TO PRINTER. 003:0000:0 150000 003:0000:0 150100 DATA DIVISION. 003:0000:0 150120 ****************************************************************** 003:0000:0 150200 FILE SECTION. 003:0000:0 150300 FD DC-FILE 003:0000:0 150400 LABEL RECORDS STANDARD. 003:0000:0 DC-FILE = (2,004) offset = 0 Byte DC-FILE(FILEORGANIZATION) = NOTRESTRICTED DC-FILE(MINRECSIZE) = 0 DC-FILE(MAXRECSIZE) = 80 DC-FILE(INTMODE) = EBCDIC 150500 01 DC-REC. 003:0000:0 DC-REC = (2,003) offset = 0 Byte 150600 05 DC-DATA PIC X(80). 003:0000:0 DC-DATA = (2,003) offset = 0 Byte 150700 05 DC-INPUT REDEFINES DC-DATA. 003:0000:0 DC-INPUT = (2,003) offset = 0 Byte 150800 10 DC-POPULATION PIC 9(6). 003:0000:0 DC-POPULATION = (2,003) offset = 0 Byte 150900 10 DC-KEY-SIZE PIC 9(2). 003:0000:0 DC-KEY-SIZE = (2,003) offset = 6 Byte 151000 10 DC-LOAD-FACTOR PIC 9(2). 003:0000:0 DC-LOAD-FACTOR = (2,003) offset = 8 Byte 151100 10 DC-TITLE PIC X(64). 003:0000:0 DC-TITLE = (2,003) offset = 10 Byte 151200 10 FILLER PIC X(6). 003:0000:0 160000 003:0000:0 160100 FD PR-FILE 003:0000:0 160200 LABEL RECORDS STANDARD. 003:0000:0 PR-FILE = (2,006) offset = 0 Byte PR-FILE(FILEORGANIZATION) = NOTRESTRICTED PR-FILE(MINRECSIZE) = 0 PR-FILE(MAXRECSIZE) = 80 PR-FILE(INTMODE) = EBCDIC 160300 01 PR-REC. 003:0000:0 PR-REC = (2,005) offset = 0 Byte 160400 05 PR-DATA PIC X(80). 003:0000:0 PR-DATA = (2,005) offset = 0 Byte 300000 003:0000:0 300020 ****************************************************************** 003:0000:0 300100 WORKING-STORAGE SECTION. 003:0000:0 UNISYS COBOL85 IC COBOL85-048.1A.2 [48.189.002] 2002 November 2 7:36:17 am Page 2 300200 77 W-BLOCK-OVERHEAD PIC 9(4) VALUE 4 BINARY. 003:0000:0 W-BLOCK-OVERHEAD = (2,00D) offset = 0 Word 300400 77 W-SEGMENT-SIZE PIC 9(4) VALUE 30 BINARY. 003:0000:0 W-SEGMENT-SIZE = (2,00E) offset = 0 Word 300500 77 W-SEGMENT-LIMIT PIC 9(4) VALUE 50 BINARY. 003:0000:0 W-SEGMENT-LIMIT = (2,00F) offset = 0 Word 300600 77 W-ENTRY-SIZE PIC 9(4) BINARY. 003:0000:0 W-ENTRY-SIZE = (2,010) offset = 0 Word 300700 77 W-LOAD-FACTOR PIC 9(2) BINARY. 003:0000:0 W-LOAD-FACTOR = (2,011) offset = 0 Word 300800 77 W-KEY-SIZE PIC 9(2) BINARY. 003:0000:0 W-KEY-SIZE = (2,012) offset = 0 Word 300900 77 W-POPULATION PIC 9(6) BINARY. 003:0000:0 W-POPULATION = (2,013) offset = 0 Word 301000 77 W-POPULATION-LN REAL. 003:0000:0 W-POPULATION-LN = (2,014) offset = 0 Word 302000 003:0000:0 302100 77 W-AVG-ENTRIES PIC 9(4) COMP. 003:0000:0 W-AVG-ENTRIES = (2,015) offset = 0 Hex 302200 77 W-BLOCK-SEGS PIC 9(2) COMP. 003:0000:0 W-BLOCK-SEGS = (2,015) offset = 12 Hex 302300 77 W-BLOCK-SIZE PIC 9(4) COMP. 003:0000:0 W-BLOCK-SIZE = (2,015) offset = 24 Hex 302400 77 W-BLOCK-ENTRIES PIC 9(4) COMP. 003:0000:0 W-BLOCK-ENTRIES = (2,015) offset = 36 Hex 302500 77 W-MAX-LEVELS PIC 9(2)V9(2) COMP. 003:0000:0 W-MAX-LEVELS = (2,015) offset = 48 Hex 302600 77 W-MIN-LEVELS PIC 9(2)V9(2) COMP. 003:0000:0 W-MIN-LEVELS = (2,015) offset = 60 Hex 302700 77 W-SLOP PIC 9(4) COMP. 003:0000:0 W-SLOP = (2,015) offset = 72 Hex 303000 003:0000:0 303020 77 WLN-ARG PIC S9(7)V9(5) BINARY. 003:0000:0 WLN-ARG = (2,016) offset = 0 Word 303040 77 WLN-RESULT PIC S9(2)V9(9) COMP. 003:0000:0 WLN-RESULT = (2,018) offset = 0 Hex 310000 003:0000:0 310100 01 WPL-PRINT-LINES. 003:0000:0 WPL-PRINT-LINES = (2,019) mom is (2,015) offset = 42 Byte 310200 05 WPL-TITLE-LINE. 003:0000:0 WPL-TITLE-LINE = (2,019) mom is (2,015) offset = 42 Byte 310300 10 WPL-TITLE-TEXT PIC X(64). 003:0000:0 WPL-TITLE-TEXT = (2,019) mom is (2,015) offset = 42 Byte 310400 10 WPL-TITLE-DATE PIC 99/99/99. 003:0000:0 WPL-TITLE-DATE = (2,019) mom is (2,015) offset = 106 Byte 310500 05 WPL-DATA-LINE. 003:0000:0 WPL-DATA-LINE = (2,019) mom is (2,015) offset = 114 Byte 310600 10 WPL-DATA-SEGS PIC ZZZ9BB. 003:0000:0 WPL-DATA-SEGS = (2,019) mom is (2,015) offset = 114 Byte 310700 10 WPL-DATA-BLOCK-SIZE PIC Z,ZZZ,ZZ9BB. 003:0000:0 WPL-DATA-BLOCK-SIZE = (2,019) mom is (2,015) offset = 120 Byte 310800 10 WPL-DATA-WASTE PIC Z,ZZ9BB. 003:0000:0 WPL-DATA-WASTE = (2,019) mom is (2,015) offset = 131 Byte 310900 10 WPL-DATA-ENTRIES PIC ZZZ,ZZ9BB. 003:0000:0 WPL-DATA-ENTRIES = (2,019) mom is (2,015) offset = 138 Byte 311000 10 WPL-DATA-AVG-ENTRIES PIC ZZZ,ZZZ,ZZ9BB. 003:0000:0 WPL-DATA-AVG-ENTRIES = (2,019) mom is (2,015) offset = 147 Byte 311100 10 WPL-DATA-MIN-LEVELS PIC ZZZ,ZZ9.99BB. 003:0000:0 WPL-DATA-MIN-LEVELS = (2,019) mom is (2,015) offset = 160 Byte 311200 10 WPL-DATA-MAX-LEVELS PIC ZZZ,ZZ9.99BB. 003:0000:0 WPL-DATA-MAX-LEVELS = (2,019) mom is (2,015) offset = 172 Byte 315000 003:0000:0 315100 01 WPL-HEADER-1. 003:0000:0 WPL-HEADER-1 = (2,019) mom is (2,015) offset = 186 Byte 315200 05 WPL-POPULATION-LINE. 003:0000:0 WPL-POPULATION-LINE = (2,019) mom is (2,015) offset = 186 Byte 315300 10 FILLER PIC X(11) VALUE "RECORDS:". 003:0000:0 315400 10 WPL-POPULATION PIC ZZZ,ZZ9. 003:0000:0 WPL-POPULATION = (2,019) mom is (2,015) offset = 197 Byte 315500 003:0000:0 315600 01 WPL-HEADER-2. 003:0000:0 WPL-HEADER-2 = (2,019) mom is (2,015) offset = 204 Byte 315700 05 WPL-KEY-SIZE-LINE. 003:0000:0 WPL-KEY-SIZE-LINE = (2,019) mom is (2,015) offset = 204 Byte 315800 10 FILLER PIC X(14) VALUE "KEY SIZE:". 003:0000:0 315900 10 WPL-KEY-SIZE PIC ZZZ9. 003:0000:0 WPL-KEY-SIZE = (2,019) mom is (2,015) offset = 218 Byte 316000 10 FILLER PIC X(6) VALUE " WORDS". 003:0000:0 UNISYS COBOL85 IC COBOL85-048.1A.2 [48.189.002] 2002 November 2 7:36:17 am Page 3 316100 003:0000:0 316200 01 WPL-HEADER-3. 003:0000:0 WPL-HEADER-3 = (2,019) mom is (2,015) offset = 228 Byte 316300 05 WPL-LOAD-FACTOR-LINE. 003:0000:0 WPL-LOAD-FACTOR-LINE = (2,019) mom is (2,015) offset = 228 Byte 316400 10 FILLER PIC X(16) VALUE "LOAD-FACTOR:". 003:0000:0 316500 10 WPL-LOAD-FACTOR PIC Z9. 003:0000:0 WPL-LOAD-FACTOR = (2,019) mom is (2,015) offset = 244 Byte 316600 10 FILLER PIC X(2) VALUE " %". 003:0000:0 316700 003:0000:0 316800 01 WPL-HEADER-4. 003:0000:0 WPL-HEADER-4 = (2,019) mom is (2,015) offset = 252 Byte 316900 05 WPL-HEAD-LINE. 003:0000:0 WPL-HEAD-LINE = (2,019) mom is (2,015) offset = 252 Byte 317000 10 FILLER PIC X(6) VALUE "SEGS". 003:0000:0 317100 10 FILLER PIC X(11) VALUE "BLOCKSIZE". 003:0000:0 317200 10 FILLER PIC X(7) VALUE "WASTE". 003:0000:0 317300 10 FILLER PIC X(9) VALUE "ENTRIES". 003:0000:0 317400 10 FILLER PIC X(13) VALUE "AVG-ENTRIES". 003:0000:0 317500 10 FILLER PIC X(12) VALUE "MIN-LEVELS". 003:0000:0 317600 10 FILLER PIC X(12) VALUE "MAX-LEVELS". 003:0000:0 320000 003:0000:0 320100 01 WUM-UTILITY-MESSAGES. 003:0000:0 WUM-UTILITY-MESSAGES = (2,019) mom is (2,015) offset = 324 Byte 320400 05 WUM-PROMPT. 003:0000:0 WUM-PROMPT = (2,019) mom is (2,015) offset = 324 Byte 320600 10 FILLER PIC X(30) VALUE 003:0000:0 320700 "PPPPPPKKFF TITLE". 003:0000:0 470000 003:0000:0 470100 ****************************************************************** 003:0000:0 470200 LOCAL-STORAGE SECTION. 003:0000:0 470300 LD EXPLIB-TEMPLATE. 003:0000:0 470400 77 L-ARG PIC S9(7)V9(5) COMP. 003:0000:0 470500 77 L-RESULT PIC S9(2)V9(9) BINARY. 003:0000:0 480000 003:0000:0 480100 ****************************************************************** 003:0000:0 480200 PROGRAM-LIBRARY SECTION. 003:0000:0 480300 LB AS4027-EXPLIB IMPORT 003:0000:0 AS4027-EXPLIB = (2,007) offset = 0 Byte 480400 ATTRIBUTE TITLE IS 003:0000:0 480500 "(PAUL)OBJECT/UNITE/AS4027/COBOL85/EXPLIB ON OPS" 003:0000:0 480600 LIBACCESS IS BYTITLE. 003:0000:0 480700 ENTRY PROCEDURE COMPUTE-LN WITH EXPLIB-TEMPLATE 003:0000:0 COMPUTE-LN = (2,009) offset = 0 Byte 480800 USING L-ARG, L-RESULT. 003:0030:0 500000 003:0030:0 500100 PROCEDURE DIVISION. 003:0030:0 500120 ****************************************************************** 003:0030:0 500200 000-MAIN SECTION. 003:0030:0 500300 000-BEGIN. 003:0030:0 500400 OPEN OUTPUT PR-FILE. 003:0030:0 500500 ACCEPT WPL-TITLE-DATE FROM TODAYS-DATE. 003:004F:3 500600 OPEN I-O DC-FILE. 003:0056:5 500680 MOVE "UNISYS A SERIES DMSII ISAM CALCUALTIONS PROGRAM" TO 003:007A:2 500690 DC-REC. 003:007D:2 500700 WRITE DC-REC. 003:007D:2 500710 MOVE "ENTER POPULATION (PPPPPP) IN RECORDS" TO DC-REC. 003:008F:5 500720 WRITE DC-REC. 003:0092:5 500730 MOVE "ENTER KEY SIZE (KK) IN WORDS, INCLUDING OVERHEAD" TO 003:00A5:2 500740 DC-REC. 003:00A8:2 500750 WRITE DC-REC. 003:00A8:2 500760 MOVE "ENTER LOAD-FACTOR (FF) IN PERCENT" TO DC-REC. 003:00BA:5 500770 WRITE DC-REC. 003:00BD:5 500780 MOVE "ENTER TITLE OF THE INDEX FOLLOWING THE FACTOR" TO 003:00D0:2 500790 DC-REC. 003:00D3:2 500800 WRITE DC-REC. 003:00D3:2 500810 MOVE "LIKE THIS:" TO DC-REC. 003:00E5:5 500820 WRITE DC-REC BEFORE 2 LINES. 003:00E9:0 500900 003:00FC:2 501000 000-LOOP. 003:00FC:2 501040 MOVE WUM-PROMPT TO DC-REC. 003:00FC:2 501060 WRITE DC-REC. 003:00FF:3 501100 READ DC-FILE AT END 003:0112:0 501200 GO TO 000-EOF. 003:0116:2 501300 003:0123:0 501400 IF DC-REC = SPACE 003:0123:0 501500 GO TO 000-EOF. 003:0125:1 501600 003:0125:1 UNISYS COBOL85 IC COBOL85-048.1A.2 [48.189.002] 2002 November 2 7:36:17 am Page 4 501700 MOVE DC-POPULATION TO W-POPULATION. 003:0125:1 501800 MOVE DC-KEY-SIZE TO W-KEY-SIZE. 003:0126:2 501900 MOVE DC-LOAD-FACTOR TO W-LOAD-FACTOR. 003:0128:1 502000 MOVE DC-TITLE TO WPL-TITLE-TEXT. 003:012A:0 502100 PERFORM 100-CALCULATIONS. 003:012C:4 502200 GO TO 000-LOOP. 003:012E:2 502300 003:012E:2 502400 000-EOF. 003:012E:2 502500 CLOSE DC-FILE. 003:012E:2 502600 CLOSE PR-FILE. 003:0142:1 502700 003:0156:1 502800 000-EXIT. 003:0156:1 502900 STOP RUN. 003:0156:1 510000 003:0157:0 510020 ****************************************************************** 003:0157:0 510100 010-PRINT SECTION. 003:0157:0 510200 010-BEGIN. 003:0157:0 510300 MOVE PR-REC TO DC-REC. 003:0157:0 510400 WRITE DC-REC. 003:0158:5 510500 WRITE PR-REC AFTER 2 LINES. 003:016B:2 510600 MOVE SPACE TO DC-REC, PR-REC. 003:017E:4 510700 010-EXIT. 003:0183:1 510800 EXIT. 003:0183:1 600000 003:0183:1 600020 ****************************************************************** 003:0183:1 600100 100-CALCULATIONS SECTION. 003:0183:1 600200 100-BEGIN. 003:0183:1 600215 MOVE WPL-TITLE-LINE TO PR-REC. 003:0183:1 600220 WRITE PR-REC AFTER PAGE. 003:0186:1 600225 003:0199:2 600300 MOVE W-POPULATION TO WPL-POPULATION. 003:0199:2 600400 MOVE WPL-POPULATION-LINE TO PR-REC. 003:019D:5 600500 PERFORM 010-PRINT. 003:01A0:5 600600 003:01A2:4 600700 MOVE W-KEY-SIZE TO WPL-KEY-SIZE. 003:01A2:4 600800 MOVE WPL-KEY-SIZE-LINE TO PR-REC. 003:01A7:1 600900 PERFORM 010-PRINT. 003:01AA:1 601000 003:01AC:0 601100 MOVE W-LOAD-FACTOR TO WPL-LOAD-FACTOR. 003:01AC:0 601200 MOVE WPL-LOAD-FACTOR-LINE TO PR-REC. 003:01B0:3 601300 PERFORM 010-PRINT. 003:01B3:3 601400 003:01B5:2 601700 MOVE WPL-HEAD-LINE TO PR-REC. 003:01B5:2 601800 PERFORM 010-PRINT. 003:01B8:2 601880 003:01BA:1 601885 COMPUTE W-ENTRY-SIZE = W-KEY-SIZE. 003:01BA:1 601900 MOVE W-POPULATION TO WLN-ARG. 003:01BA:3 601920 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 003:01BC:5 601940 MOVE WLN-RESULT TO W-POPULATION-LN. 003:01CC:1 602000 MOVE ZERO TO W-BLOCK-SEGS. 003:01CF:1 602100 003:01D0:5 602200 100-SEG-LOOP. 003:01D0:5 602300 ADD 1 TO W-BLOCK-SEGS. 003:01D0:5 602400 COMPUTE W-BLOCK-ENTRIES = 003:01D3:5 602500 (W-BLOCK-SEGS * W-SEGMENT-SIZE - W-BLOCK-OVERHEAD) / 003:01D8:4 602600 W-ENTRY-SIZE. 003:01D8:4 602700 COMPUTE W-BLOCK-SIZE = W-BLOCK-ENTRIES * W-ENTRY-SIZE + 003:01D8:4 602800 W-BLOCK-OVERHEAD. 003:01DD:0 602900 COMPUTE W-SLOP = (W-BLOCK-SEGS * W-SEGMENT-SIZE) - 003:01DD:0 603000 W-BLOCK-SIZE. 003:01E2:2 603100 COMPUTE W-AVG-ENTRIES = W-LOAD-FACTOR * W-BLOCK-ENTRIES / 003:01E2:2 603200 100. 003:01E6:3 603300 003:01E6:3 603400 IF W-AVG-ENTRIES > 1 003:01E6:3 603500 PERFORM 110-COMPUTE-LEVELS 003:01E8:3 603600 PERFORM 120-FORMAT-RESULTS 003:01EA:2 603700 IF W-MAX-LEVELS < 2.00 003:01EC:1 603705 GO TO 100-EXIT. 003:01EE:3 603710 003:01EE:3 603800 IF W-BLOCK-SEGS < W-SEGMENT-LIMIT 003:01EE:3 603900 GO TO 100-SEG-LOOP. 003:01F0:5 603905 003:01F2:1 604000 100-EXIT. 003:01F2:1 604100 EXIT. 003:01F2:1 604200 003:01F2:1 604220 ****************************************************************** 003:01F2:1 604300 110-COMPUTE-LEVELS SECTION. 003:01F2:1 604400 110-BEGIN. 003:01F2:1 UNISYS COBOL85 IC COBOL85-048.1A.2 [48.189.002] 2002 November 2 7:36:17 am Page 5 604800 MOVE W-AVG-ENTRIES TO WLN-ARG. 003:01F2:1 604900 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 003:01F4:5 605000 COMPUTE W-MAX-LEVELS ROUNDED = 003:0204:1 605100 W-POPULATION-LN / WLN-RESULT. 003:020A:4 605200 003:020A:4 605300 MOVE W-BLOCK-ENTRIES TO WLN-ARG. 003:020A:4 605400 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 003:020D:3 605500 COMPUTE W-MIN-LEVELS ROUNDED = 003:021C:1 605600 W-POPULATION-LN / WLN-RESULT. 003:0224:1 605700 003:0224:1 605800 110-EXIT. 003:0224:1 605900 EXIT. 003:0224:1 620000 003:0224:1 620020 ****************************************************************** 003:0224:1 620100 120-FORMAT-RESULTS SECTION. 003:0224:1 620200 120-BEGIN. 003:0224:1 620300 MOVE W-BLOCK-SEGS TO WPL-DATA-SEGS. 003:0224:1 620400 MOVE W-BLOCK-SIZE TO WPL-DATA-BLOCK-SIZE. 003:0229:4 620500 MOVE W-SLOP TO WPL-DATA-WASTE. 003:022F:1 620600 MOVE W-BLOCK-ENTRIES TO WPL-DATA-ENTRIES. 003:0234:4 620700 MOVE W-AVG-ENTRIES TO WPL-DATA-AVG-ENTRIES. 003:023A:1 620800 MOVE W-MIN-LEVELS TO WPL-DATA-MIN-LEVELS. 003:023F:3 620900 MOVE W-MAX-LEVELS TO WPL-DATA-MAX-LEVELS. 003:0245:0 620905 MOVE WPL-DATA-LINE TO PR-REC. 003:024A:3 621000 PERFORM 010-PRINT. 003:024D:3 621100 120-EXIT. 003:0251:2 621200 EXIT. 003:0251:2 621220 003:0251:2 621240 END PROGRAM AS4027-COBOL85-SAMPLE. 00621000 003:0251:2 No errors detected. Program: 275 lines; date compiled: 2002 November 2 7:36:17 am Card = (PAUL)SRCE/UNITE/AS4027/COBOL85/SAMPLE ON OPS Code file = OBJECT/UNITE/AS4027/COBOL85/SAMPLE Disk segments = 61. D2 size = 39. D1 size = 15. Target = LEVEL5; Memory_model = Tiny; Longlimit = 10922. Compiler: 2.25 Seconds processor time