000020$$ SET LIST MAP 000100$$ SET LINEINFO BINDINFO 000120$$ FEDLEVEL=5 001000 100000 IDENTIFICATION DIVISION. 100100 PROGRAM-ID. AS4027-COBOL74-SAMPLE. 100200*AUTHOR. P.KIMPEL. 100300*INSTALLATION. PARADIGM CORPORATION, SAN DIEGO. 100400*DATE-WRITTEN. NOVEMBER 2002. 100500 100600****************************************************************** 100700* UNITE/AS4027/COBOL74/SAMPLE * 100800****************************************************************** 100900* THIS PROGRAM CONTAINS SOME COMMON MEMORY ALLOCATION 101000* TECHNIQUES USED BY COBOL-74, FOR THE PURPOSE OF SHOWING 101100* HOW THEY APPEAR IN AN MCP PROGRAMDUMP. 105000****************************************************************** 105002* MODIFICATION LOG. 105006* 2002-11-01 P.KIMPEL 105007* ORIGINAL VERSION, CLONED FROM ISAMCALC. 109990****************************************************************** 110003 110100 ENVIRONMENT DIVISION. 110200 CONFIGURATION SECTION. 110300 SOURCE-COMPUTER. UNISYS-MCP. 110400 OBJECT-COMPUTER. UNISYS-MCP. 110401 SPECIAL-NAMES. 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. 150150****************************************************************** 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 300050****************************************************************** 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. 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". 330000 330100 01 WLN-LOG-AREA. 330200 05 WLN-ARG PIC S9(7)V9(5) BINARY. 330300 05 WLN-RESULT PIC S9(2)V9(9) BINARY. 330600 05 WLN-LN-2 PIC S9(1)V9(10) BINARY 330700 VALUE 0.6931471806. 330705 05 WLN-TERM PIC S9(7)V9(16) BINARY. 330800 05 WLN-SUM REAL. 330900 05 WLN-POWER REAL. 331000 05 WLN-N PIC S9(5) COMP. 331200 05 WLN-FACTOR-VALUES. 331300 10 FILLER PIC S9(1)V9(10) VALUE +0.9999964239 COMP. 331400 10 FILLER PIC S9(1)V9(10) VALUE -0.4998741238 COMP. 331500 10 FILLER PIC S9(1)V9(10) VALUE +0.3317990258 COMP. 331600 10 FILLER PIC S9(1)V9(10) VALUE -0.2407338084 COMP. 331700 10 FILLER PIC S9(1)V9(10) VALUE +0.1676540711 COMP. 331800 10 FILLER PIC S9(1)V9(10) VALUE -0.0953293897 COMP. 331900 10 FILLER PIC S9(1)V9(10) VALUE +0.0360884937 COMP. 332000 10 FILLER PIC S9(1)V9(10) VALUE -0.0064535442 COMP. 332100 05 WLN-FACTOR-TABLE REDEFINES WLN-FACTOR-VALUES 332200 OCCURS 8 INDEXED WLN-FX. 332300 10 WLN-FACTOR PIC S9(1)V9(10) COMP. 500000 500100 PROCEDURE DIVISION. 500150****************************************************************** 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 510050****************************************************************** 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 600050****************************************************************** 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 PERFORM 200-COMPUTE-LN. 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 604250****************************************************************** 604300 110-COMPUTE-LEVELS SECTION. 604400 110-BEGIN. 604800 MOVE W-AVG-ENTRIES TO WLN-ARG. 604900 PERFORM 200-COMPUTE-LN. 605000 COMPUTE W-MAX-LEVELS ROUNDED = 605100 W-POPULATION-LN / WLN-RESULT. 605200 605300 MOVE W-BLOCK-ENTRIES TO WLN-ARG. 605400 PERFORM 200-COMPUTE-LN. 605500 COMPUTE W-MIN-LEVELS ROUNDED = 605600 W-POPULATION-LN / WLN-RESULT. 605700 605800 110-EXIT. 605900 EXIT. 620000 620050****************************************************************** 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. 650000 650050****************************************************************** 650100 200-COMPUTE-LN SECTION. 650200* THIS ROUTINE CALCULATES THE NATURAL LOGARITHM OF WLN-ARG 650300* LEAVING THE RESULT IN WLN-RESULT. IT IS ACCURATE TO ONE 650400* PART IN 10**7. FROM HBK OF MATH FUNCTIONS, ABRAMOWITZ & 650500* STEGUN, DOVER, NEW YORK, 1965 (LCCN 65-12253), PP 67 FF. 650600* (I CAN'T BELIEVE I'M ACTUALLY DOING THIS IN COBOL...) 650700 200-BEGIN. 650800 MOVE ZERO TO WLN-N, WLN-SUM. 650900 MOVE WLN-ARG TO WLN-TERM. 651000 651100 200-SCALE-LOOP. 651200 IF WLN-TERM > 2.0 651300 ADD 1 TO WLN-N 651400 COMPUTE WLN-TERM ROUNDED = WLN-TERM / 2 651500 GO TO 200-SCALE-LOOP 651600 ELSE IF WLN-TERM < 1.0 651700 SUBTRACT 1 FROM WLN-N 651800 COMPUTE WLN-TERM ROUNDED = WLN-TERM * 2 651900 GO TO 200-SCALE-LOOP. 652200 652300 SET WLN-FX TO 1. 652400 MOVE 1.0 TO WLN-POWER. 652500 SUBTRACT 1.0 FROM WLN-TERM ROUNDED. 652600 652700 200-SERIES-LOOP. 652800 MULTIPLY WLN-TERM BY WLN-POWER ROUNDED. 652900 COMPUTE WLN-SUM ROUNDED = WLN-SUM + 653000 WLN-FACTOR (WLN-FX) * WLN-POWER. 653020 653050* ---- THE BUG: THE LOOP LIMIT SHOULD BE 8, NOT 9 --- 653100 IF WLN-FX < 9 653200 SET WLN-FX UP BY 1 653300 GO TO 200-SERIES-LOOP. 653400 653500 COMPUTE WLN-RESULT ROUNDED = WLN-SUM + 653600 WLN-N * WLN-LN-2. 653700 653800 200-EXIT. 653900 EXIT.