000020$$ SET LIST MAP MAPONELINE PAGESIZE=80 000100$$ SET LINEINFO BINDINFO 000120$$ FEDLEVEL=5 001000 100000 IDENTIFICATION DIVISION. 100100 PROGRAM-ID. AS4027-COBOL85-SAMPLE. 100200*AUTHOR. P.KIMPEL. 100300*INSTALLATION. PARADIGM CORPORATION, SAN DIEGO. 100400*DATE-WRITTEN. NOVEMBER 2002. 100500 100600****************************************************************** 100700* UNITE/AS4027/COBOL85/SAMPLE * 100800****************************************************************** 100900* THIS PROGRAM CONTAINS SOME COMMON MEMORY ALLOCATION 101000* TECHNIQUES USED BY COBOL-85, FOR THE PURPOSE OF SHOWING 101100* HOW THEY APPEAR IN AN MCP PROGRAMDUMP. THIS SAMPLE ALSO 101200* ILLUSTRATES CALLING A PROGRAM LIBRARY. 105000****************************************************************** 105002* MODIFICATION LOG. 105006* 2002-11-01 P.KIMPEL 105007* ORIGINAL VERSION, CLONED FROM ISAMCALC. 109990****************************************************************** 110000 110100 ENVIRONMENT DIVISION. 110200 CONFIGURATION SECTION. 110300 SOURCE-COMPUTER. UNISYS-MCP. 110400 OBJECT-COMPUTER. UNISYS-MCP. 110500 110600 INPUT-OUTPUT SECTION. 110700 FILE-CONTROL. 110800 SELECT DC-FILE 110900 ASSIGN TO REMOTE. 111000 SELECT PR-FILE 111100 ASSIGN TO PRINTER. 150000 150100 DATA DIVISION. 150120****************************************************************** 150200 FILE SECTION. 150300 FD DC-FILE 150400 LABEL RECORDS STANDARD. 150500 01 DC-REC. 150600 05 DC-DATA PIC X(80). 150700 05 DC-INPUT REDEFINES DC-DATA. 150800 10 DC-POPULATION PIC 9(6). 150900 10 DC-KEY-SIZE PIC 9(2). 151000 10 DC-LOAD-FACTOR PIC 9(2). 151100 10 DC-TITLE PIC X(64). 151200 10 FILLER PIC X(6). 160000 160100 FD PR-FILE 160200 LABEL RECORDS STANDARD. 160300 01 PR-REC. 160400 05 PR-DATA PIC X(80). 300000 300020****************************************************************** 300100 WORKING-STORAGE SECTION. 300200 77 W-BLOCK-OVERHEAD PIC 9(4) VALUE 4 BINARY. 300400 77 W-SEGMENT-SIZE PIC 9(4) VALUE 30 BINARY. 300500 77 W-SEGMENT-LIMIT PIC 9(4) VALUE 50 BINARY. 300600 77 W-ENTRY-SIZE PIC 9(4) BINARY. 300700 77 W-LOAD-FACTOR PIC 9(2) BINARY. 300800 77 W-KEY-SIZE PIC 9(2) BINARY. 300900 77 W-POPULATION PIC 9(6) BINARY. 301000 77 W-POPULATION-LN REAL. 302000 302100 77 W-AVG-ENTRIES PIC 9(4) COMP. 302200 77 W-BLOCK-SEGS PIC 9(2) COMP. 302300 77 W-BLOCK-SIZE PIC 9(4) COMP. 302400 77 W-BLOCK-ENTRIES PIC 9(4) COMP. 302500 77 W-MAX-LEVELS PIC 9(2)V9(2) COMP. 302600 77 W-MIN-LEVELS PIC 9(2)V9(2) COMP. 302700 77 W-SLOP PIC 9(4) COMP. 303000 303020 77 WLN-ARG PIC S9(7)V9(5) BINARY. 303040 77 WLN-RESULT PIC S9(2)V9(9) COMP. 310000 310100 01 WPL-PRINT-LINES. 310200 05 WPL-TITLE-LINE. 310300 10 WPL-TITLE-TEXT PIC X(64). 310400 10 WPL-TITLE-DATE PIC 99/99/99. 310500 05 WPL-DATA-LINE. 310600 10 WPL-DATA-SEGS PIC ZZZ9BB. 310700 10 WPL-DATA-BLOCK-SIZE PIC Z,ZZZ,ZZ9BB. 310800 10 WPL-DATA-WASTE PIC Z,ZZ9BB. 310900 10 WPL-DATA-ENTRIES PIC ZZZ,ZZ9BB. 311000 10 WPL-DATA-AVG-ENTRIES PIC ZZZ,ZZZ,ZZ9BB. 311100 10 WPL-DATA-MIN-LEVELS PIC ZZZ,ZZ9.99BB. 311200 10 WPL-DATA-MAX-LEVELS PIC ZZZ,ZZ9.99BB. 315000 315100 01 WPL-HEADER-1. 315200 05 WPL-POPULATION-LINE. 315300 10 FILLER PIC X(11) VALUE "RECORDS:". 315400 10 WPL-POPULATION PIC ZZZ,ZZ9. 315500 315600 01 WPL-HEADER-2. 315700 05 WPL-KEY-SIZE-LINE. 315800 10 FILLER PIC X(14) VALUE "KEY SIZE:". 315900 10 WPL-KEY-SIZE PIC ZZZ9. 316000 10 FILLER PIC X(6) VALUE " WORDS". 316100 316200 01 WPL-HEADER-3. 316300 05 WPL-LOAD-FACTOR-LINE. 316400 10 FILLER PIC X(16) VALUE "LOAD-FACTOR:". 316500 10 WPL-LOAD-FACTOR PIC Z9. 316600 10 FILLER PIC X(2) VALUE " %". 316700 316800 01 WPL-HEADER-4. 316900 05 WPL-HEAD-LINE. 317000 10 FILLER PIC X(6) VALUE "SEGS". 317100 10 FILLER PIC X(11) VALUE "BLOCKSIZE". 317200 10 FILLER PIC X(7) VALUE "WASTE". 317300 10 FILLER PIC X(9) VALUE "ENTRIES". 317400 10 FILLER PIC X(13) VALUE "AVG-ENTRIES". 317500 10 FILLER PIC X(12) VALUE "MIN-LEVELS". 317600 10 FILLER PIC X(12) VALUE "MAX-LEVELS". 320000 320100 01 WUM-UTILITY-MESSAGES. 320400 05 WUM-PROMPT. 320600 10 FILLER PIC X(30) VALUE 320700 "PPPPPPKKFF TITLE". 470000 470100****************************************************************** 470200 LOCAL-STORAGE SECTION. 470300 LD EXPLIB-TEMPLATE. 470400 77 L-ARG PIC S9(7)V9(5) COMP. 470500 77 L-RESULT PIC S9(2)V9(9) BINARY. 480000 480100****************************************************************** 480200 PROGRAM-LIBRARY SECTION. 480300 LB AS4027-EXPLIB IMPORT 480400 ATTRIBUTE TITLE IS 480500 "(PAUL)OBJECT/UNITE/AS4027/COBOL85/EXPLIB ON OPS" 480600 LIBACCESS IS BYTITLE. 480700 ENTRY PROCEDURE COMPUTE-LN WITH EXPLIB-TEMPLATE 480800 USING L-ARG, L-RESULT. 500000 500100 PROCEDURE DIVISION. 500120****************************************************************** 500200 000-MAIN SECTION. 500300 000-BEGIN. 500400 OPEN OUTPUT PR-FILE. 500500 ACCEPT WPL-TITLE-DATE FROM TODAYS-DATE. 500600 OPEN I-O DC-FILE. 500680 MOVE "UNISYS A SERIES DMSII ISAM CALCUALTIONS PROGRAM" TO 500690 DC-REC. 500700 WRITE DC-REC. 500710 MOVE "ENTER POPULATION (PPPPPP) IN RECORDS" TO DC-REC. 500720 WRITE DC-REC. 500730 MOVE "ENTER KEY SIZE (KK) IN WORDS, INCLUDING OVERHEAD" TO 500740 DC-REC. 500750 WRITE DC-REC. 500760 MOVE "ENTER LOAD-FACTOR (FF) IN PERCENT" TO DC-REC. 500770 WRITE DC-REC. 500780 MOVE "ENTER TITLE OF THE INDEX FOLLOWING THE FACTOR" TO 500790 DC-REC. 500800 WRITE DC-REC. 500810 MOVE "LIKE THIS:" TO DC-REC. 500820 WRITE DC-REC BEFORE 2 LINES. 500900 501000 000-LOOP. 501040 MOVE WUM-PROMPT TO DC-REC. 501060 WRITE DC-REC. 501100 READ DC-FILE AT END 501200 GO TO 000-EOF. 501300 501400 IF DC-REC = SPACE 501500 GO TO 000-EOF. 501600 501700 MOVE DC-POPULATION TO W-POPULATION. 501800 MOVE DC-KEY-SIZE TO W-KEY-SIZE. 501900 MOVE DC-LOAD-FACTOR TO W-LOAD-FACTOR. 502000 MOVE DC-TITLE TO WPL-TITLE-TEXT. 502100 PERFORM 100-CALCULATIONS. 502200 GO TO 000-LOOP. 502300 502400 000-EOF. 502500 CLOSE DC-FILE. 502600 CLOSE PR-FILE. 502700 502800 000-EXIT. 502900 STOP RUN. 510000 510020****************************************************************** 510100 010-PRINT SECTION. 510200 010-BEGIN. 510300 MOVE PR-REC TO DC-REC. 510400 WRITE DC-REC. 510500 WRITE PR-REC AFTER 2 LINES. 510600 MOVE SPACE TO DC-REC, PR-REC. 510700 010-EXIT. 510800 EXIT. 600000 600020****************************************************************** 600100 100-CALCULATIONS SECTION. 600200 100-BEGIN. 600215 MOVE WPL-TITLE-LINE TO PR-REC. 600220 WRITE PR-REC AFTER PAGE. 600225 600300 MOVE W-POPULATION TO WPL-POPULATION. 600400 MOVE WPL-POPULATION-LINE TO PR-REC. 600500 PERFORM 010-PRINT. 600600 600700 MOVE W-KEY-SIZE TO WPL-KEY-SIZE. 600800 MOVE WPL-KEY-SIZE-LINE TO PR-REC. 600900 PERFORM 010-PRINT. 601000 601100 MOVE W-LOAD-FACTOR TO WPL-LOAD-FACTOR. 601200 MOVE WPL-LOAD-FACTOR-LINE TO PR-REC. 601300 PERFORM 010-PRINT. 601400 601700 MOVE WPL-HEAD-LINE TO PR-REC. 601800 PERFORM 010-PRINT. 601880 601885 COMPUTE W-ENTRY-SIZE = W-KEY-SIZE. 601900 MOVE W-POPULATION TO WLN-ARG. 601920 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 601940 MOVE WLN-RESULT TO W-POPULATION-LN. 602000 MOVE ZERO TO W-BLOCK-SEGS. 602100 602200 100-SEG-LOOP. 602300 ADD 1 TO W-BLOCK-SEGS. 602400 COMPUTE W-BLOCK-ENTRIES = 602500 (W-BLOCK-SEGS * W-SEGMENT-SIZE - W-BLOCK-OVERHEAD) / 602600 W-ENTRY-SIZE. 602700 COMPUTE W-BLOCK-SIZE = W-BLOCK-ENTRIES * W-ENTRY-SIZE + 602800 W-BLOCK-OVERHEAD. 602900 COMPUTE W-SLOP = (W-BLOCK-SEGS * W-SEGMENT-SIZE) - 603000 W-BLOCK-SIZE. 603100 COMPUTE W-AVG-ENTRIES = W-LOAD-FACTOR * W-BLOCK-ENTRIES / 603200 100. 603300 603400 IF W-AVG-ENTRIES > 1 603500 PERFORM 110-COMPUTE-LEVELS 603600 PERFORM 120-FORMAT-RESULTS 603700 IF W-MAX-LEVELS < 2.00 603705 GO TO 100-EXIT. 603710 603800 IF W-BLOCK-SEGS < W-SEGMENT-LIMIT 603900 GO TO 100-SEG-LOOP. 603905 604000 100-EXIT. 604100 EXIT. 604200 604220****************************************************************** 604300 110-COMPUTE-LEVELS SECTION. 604400 110-BEGIN. 604800 MOVE W-AVG-ENTRIES TO WLN-ARG. 604900 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 605000 COMPUTE W-MAX-LEVELS ROUNDED = 605100 W-POPULATION-LN / WLN-RESULT. 605200 605300 MOVE W-BLOCK-ENTRIES TO WLN-ARG. 605400 CALL COMPUTE-LN USING WLN-ARG, WLN-RESULT. 605500 COMPUTE W-MIN-LEVELS ROUNDED = 605600 W-POPULATION-LN / WLN-RESULT. 605700 605800 110-EXIT. 605900 EXIT. 620000 620020****************************************************************** 620100 120-FORMAT-RESULTS SECTION. 620200 120-BEGIN. 620300 MOVE W-BLOCK-SEGS TO WPL-DATA-SEGS. 620400 MOVE W-BLOCK-SIZE TO WPL-DATA-BLOCK-SIZE. 620500 MOVE W-SLOP TO WPL-DATA-WASTE. 620600 MOVE W-BLOCK-ENTRIES TO WPL-DATA-ENTRIES. 620700 MOVE W-AVG-ENTRIES TO WPL-DATA-AVG-ENTRIES. 620800 MOVE W-MIN-LEVELS TO WPL-DATA-MIN-LEVELS. 620900 MOVE W-MAX-LEVELS TO WPL-DATA-MAX-LEVELS. 620905 MOVE WPL-DATA-LINE TO PR-REC. 621000 PERFORM 010-PRINT. 621100 120-EXIT. 621200 EXIT. 621220 621240 END PROGRAM AS4027-COBOL85-SAMPLE.