Compiled 02 November 2002 at 07:47 with the Unisys ClearPath HMP LX Series COBOL74 Compiler Version 48.150.0049 (10/01/2 (PAUL)OBJECT/UNITE/AS4027/COBOL74/SAMPLE ON OPS 000020$$ SET LIST MAP 0000:0000:0 000100$$ SET LINEINFO BINDINFO 0000:0000:0 000120$$ FEDLEVEL=5 0000:0000:0 001000 0000:0000:0 100000 IDENTIFICATION DIVISION. 0000:0000:0 START OF SEGMENT AT (01,002) 100100 PROGRAM-ID. AS4027-COBOL74-SAMPLE. 0002:0000:0 100200*AUTHOR. P.KIMPEL. 0002:0000:0 100300*INSTALLATION. PARADIGM CORPORATION, SAN DIEGO. 0002:0000:0 100400*DATE-WRITTEN. NOVEMBER 2002. 0002:0000:0 100500 0002:0000:0 100600****************************************************************** 0002:0000:0 100700* UNITE/AS4027/COBOL74/SAMPLE * 0002:0000:0 100800****************************************************************** 0002:0000:0 100900* THIS PROGRAM CONTAINS SOME COMMON MEMORY ALLOCATION 0002:0000:0 101000* TECHNIQUES USED BY COBOL-74, FOR THE PURPOSE OF SHOWING 0002:0000:0 101100* HOW THEY APPEAR IN AN MCP PROGRAMDUMP. 0002:0000:0 105000****************************************************************** 0002:0000:0 105002* MODIFICATION LOG. 0002:0000:0 105006* 2002-11-01 P.KIMPEL 0002:0000:0 105007* ORIGINAL VERSION, CLONED FROM ISAMCALC. 0002:0000:0 109990****************************************************************** 0002:0000:0 110003 0002:0000:0 110100 ENVIRONMENT DIVISION. 0002:0000:0 110200 CONFIGURATION SECTION. 0002:0000:0 110300 SOURCE-COMPUTER. UNISYS-MCP. 0002:0000:0 110400 OBJECT-COMPUTER. UNISYS-MCP. 0002:0000:0 110401 SPECIAL-NAMES. 0002:0000:0 110500 0002:0000:0 110600 INPUT-OUTPUT SECTION. 0002:0000:0 110700 FILE-CONTROL. 0002:0000:0 110800 SELECT DC-FILE 0002:0000:0 110900 ASSIGN TO REMOTE. 0002:0000:0 111000 SELECT PR-FILE 0002:0000:0 111100 ASSIGN TO PRINTER. 0002:0000:0 150000 0002:0000:0 150100 DATA DIVISION. 0002:0000:0 150150****************************************************************** 0002:0000:0 150200 FILE SECTION. 0002:0000:0 150300 FD DC-FILE 0002:0000:0 150400 LABEL RECORDS STANDARD. 0002:0000:0 MYUSE VALUE = (02,003) SIRW TO D[01] = (02,004) DC-FILE = (02,005) 150500 01 DC-REC. 0002:0000:0 150600 05 DC-DATA PIC X(80). 0002:0000:0 0000(0000:0) DC-REC = (02,006) 150700 05 DC-INPUT REDEFINES DC-DATA. 0002:0000:0 0000(0000:0) 150800 10 DC-POPULATION PIC 9(6). 0002:0000:0 0000(0000:0) 150900 10 DC-KEY-SIZE PIC 9(2). 0002:0000:0 0006(0001:0) 151000 10 DC-LOAD-FACTOR PIC 9(2). 0002:0000:0 0008(0001:2) 151100 10 DC-TITLE PIC X(64). 0002:0000:0 000A(0001:4) 151200 10 FILLER PIC X(6). 0002:0000:0 160000 0002:0000:0 160100 FD PR-FILE 0002:0000:0 DC-FILE(MAXRECSIZE) = 80 DC-FILE(INTMODE) = EBCDIC 160200 LABEL RECORDS STANDARD. 0002:0000:0 MYUSE VALUE = (02,007) PR-FILE = (02,008) 160300 01 PR-REC. 0002:0000:0 160400 05 PR-DATA PIC X(80). 0002:0000:0 0000(0000:0) PR-REC = (02,009) 300000 0002:0000:0 300050****************************************************************** 0002:0000:0 300100 WORKING-STORAGE SECTION. 0002:0000:0 PR-FILE(MAXRECSIZE) = 80 PR-FILE(INTMODE) = EBCDIC 300200 77 W-BLOCK-OVERHEAD PIC 9(4) VALUE 4 BINARY. 0002:0000:0 W-BLOCK-OVERHEAD = (02,00A) 300400 77 W-SEGMENT-SIZE PIC 9(4) VALUE 30 BINARY. 0002:0000:0 W-SEGMENT-SIZE = (02,00B) 300500 77 W-SEGMENT-LIMIT PIC 9(4) VALUE 50 BINARY. 0002:0000:0 W-SEGMENT-LIMIT = (02,00C) 300600 77 W-ENTRY-SIZE PIC 9(4) BINARY. 0002:0000:0 W-ENTRY-SIZE = (02,00D) 300700 77 W-LOAD-FACTOR PIC 9(2) BINARY. 0002:0000:0 W-LOAD-FACTOR = (02,00E) 300800 77 W-KEY-SIZE PIC 9(2) BINARY. 0002:0000:0 W-KEY-SIZE = (02,00F) 300900 77 W-POPULATION PIC 9(6) BINARY. 0002:0000:0 W-POPULATION = (02,010) 301000 77 W-POPULATION-LN REAL. 0002:0000:0 W-POPULATION-LN = (02,011) 302000 0002:0000:0 0008(0000:8) 302100 77 W-AVG-ENTRIES PIC 9(4) COMP. 0002:0000:0 0008(0000:8) W-AVG-ENTRIES = (02,01C) 302200 77 W-BLOCK-SEGS PIC 9(2) COMP. 0002:0000:0 0016(0001:A) W-BLOCK-SEGS = (02,015) 302300 77 W-BLOCK-SIZE PIC 9(4) COMP. 0002:0000:0 0020(0002:8) W-BLOCK-SIZE = (02,016) 302400 77 W-BLOCK-ENTRIES PIC 9(4) COMP. 0002:0000:0 002C(0003:8) W-BLOCK-ENTRIES = (02,017) 302500 77 W-MAX-LEVELS PIC 9(2)V9(2) COMP. 0002:0000:0 0038(0004:8) W-MAX-LEVELS = (02,018) 302600 77 W-MIN-LEVELS PIC 9(2)V9(2) COMP. 0002:0000:0 0044(0005:8) W-MIN-LEVELS = (02,019) 302700 77 W-SLOP PIC 9(4) COMP. 0002:0000:0 0050(0006:8) W-SLOP = (02,01A) 310000 0002:0000:0 310100 01 WPL-PRINT-LINES. 0002:0000:0 310200 05 WPL-TITLE-LINE. 0002:0000:0 0000(0000:0) WPL-PRINT-LINES = (02,01D) 310300 10 WPL-TITLE-TEXT PIC X(64). 0002:0000:0 0000(0000:0) 310400 10 WPL-TITLE-DATE PIC 99/99/99. 0002:0000:0 0040(000A:4) 310500 05 WPL-DATA-LINE. 0002:0000:0 0048(000C:0) 310600 10 WPL-DATA-SEGS PIC ZZZ9BB. 0002:0000:0 0048(000C:0) 310700 10 WPL-DATA-BLOCK-SIZE PIC Z,ZZZ,ZZ9BB. 0002:0000:0 004E(000D:0) 310800 10 WPL-DATA-WASTE PIC Z,ZZ9BB. 0002:0000:0 0059(000E:5) 310900 10 WPL-DATA-ENTRIES PIC ZZZ,ZZ9BB. 0002:0000:0 0060(0010:0) 311000 10 WPL-DATA-AVG-ENTRIES PIC ZZZ,ZZZ,ZZ9BB. 0002:0000:0 0069(0011:3) 311100 10 WPL-DATA-MIN-LEVELS PIC ZZZ,ZZ9.99BB. 0002:0000:0 0076(0013:4) 311200 10 WPL-DATA-MAX-LEVELS PIC ZZZ,ZZ9.99BB. 0002:0000:0 0082(0015:4) 315000 0002:0000:0 315100 01 WPL-HEADER-1. 0002:0000:0 315200 05 WPL-POPULATION-LINE. 0002:0000:0 0000(0000:0) WPL-HEADER-1 = (02,01E) 315300 10 FILLER PIC X(11) VALUE "RECORDS:". 0002:0000:0 0000(0000:0) 315400 10 WPL-POPULATION PIC ZZZ,ZZ9. 0002:0004:5 000B(0001:5) 315500 0002:0004:5 315600 01 WPL-HEADER-2. 0002:0004:5 315700 05 WPL-KEY-SIZE-LINE. 0002:0004:5 0000(0000:0) WPL-HEADER-2 = (02,01F) 315800 10 FILLER PIC X(14) VALUE "KEY SIZE:". 0002:0004:5 0000(0000:0) LITERAL 4"404040404040" = (01,003) 315900 10 WPL-KEY-SIZE PIC ZZZ9. 0002:000B:0 000E(0002:2) 316000 10 FILLER PIC X(6) VALUE " WORDS". 0002:000B:0 0012(0003:0) 316100 0002:000B:0 316200 01 WPL-HEADER-3. 0002:000E:3 316300 05 WPL-LOAD-FACTOR-LINE. 0002:000E:3 0000(0000:0) WPL-HEADER-3 = (02,020) 316400 10 FILLER PIC X(16) VALUE "LOAD-FACTOR:". 0002:000E:3 0000(0000:0) 316500 10 WPL-LOAD-FACTOR PIC Z9. 0002:0015:0 0010(0002:4) 316600 10 FILLER PIC X(2) VALUE " %". 0002:0015:0 0012(0003:0) 316700 0002:0015:0 316800 01 WPL-HEADER-4. 0002:0018:3 316900 05 WPL-HEAD-LINE. 0002:0018:3 0000(0000:0) WPL-HEADER-4 = (02,021) 317000 10 FILLER PIC X(6) VALUE "SEGS". 0002:0018:3 0000(0000:0) 317100 10 FILLER PIC X(11) VALUE "BLOCKSIZE". 0002:001B:3 0006(0001:0) 317200 10 FILLER PIC X(7) VALUE "WASTE". 0002:0020:5 0011(0002:5) 317300 10 FILLER PIC X(9) VALUE "ENTRIES". 0002:0024:1 0018(0004:0) 317400 10 FILLER PIC X(13) VALUE "AVG-ENTRIES". 0002:0029:5 0021(0005:3) 317500 10 FILLER PIC X(12) VALUE "MIN-LEVELS". 0002:0030:0 002E(0007:4) 317600 10 FILLER PIC X(12) VALUE "MAX-LEVELS". 0002:0035:5 003A(0009:4) 320000 0002:0035:5 320100 01 WUM-UTILITY-MESSAGES. 0002:003A:5 320400 05 WUM-PROMPT. 0002:003A:5 0000(0000:0) WUM-UTILITY-MESSAGES = (02,022) 320600 10 FILLER PIC X(30) VALUE 0002:003A:5 0000(0000:0) 320700 "PPPPPPKKFF TITLE". 0002:003A:5 0000(0000:0) 330000 0002:003A:5 CONSTANT POOL = (01,004) 330100 01 WLN-LOG-AREA. 0002:003E:1 330200 05 WLN-ARG PIC S9(7)V9(5) BINARY. 0002:003E:1 0000(0000:0) WLN-LOG-AREA = (02,023) 330300 05 WLN-RESULT PIC S9(2)V9(9) BINARY. 0002:003E:1 0002(0002:0) WLN-ARG = (02,024) 330600 05 WLN-LN-2 PIC S9(1)V9(10) BINARY 0002:003E:1 0003(0003:0) 330700 VALUE 0.6931471806. 0002:003E:1 0004(0004:0) 330705 05 WLN-TERM PIC S9(7)V9(16) BINARY. 0002:0041:1 0004(0004:0) 330800 05 WLN-SUM REAL. 0002:0041:1 0006(0006:0) 330900 05 WLN-POWER REAL. 0002:0041:1 0007(0007:0) 331000 05 WLN-N PIC S9(5) COMP. 0002:0041:1 0060(0008:0) 331200 05 WLN-FACTOR-VALUES. 0002:0041:1 0033(0008:3) WLN-N = (02,025) 331300 10 FILLER PIC S9(1)V9(10) VALUE +0.9999964239 COMP. 0002:0041:1 0066(0008:6) 331400 10 FILLER PIC S9(1)V9(10) VALUE -0.4998741238 COMP. 0002:0044:5 0072(0009:6) 331500 10 FILLER PIC S9(1)V9(10) VALUE +0.3317990258 COMP. 0002:0048:1 007E(000A:6) 331600 10 FILLER PIC S9(1)V9(10) VALUE -0.2407338084 COMP. 0002:004B:5 008A(000B:6) 331700 10 FILLER PIC S9(1)V9(10) VALUE +0.1676540711 COMP. 0002:004F:1 0096(000C:6) 331800 10 FILLER PIC S9(1)V9(10) VALUE -0.0953293897 COMP. 0002:0052:5 00A2(000D:6) 331900 10 FILLER PIC S9(1)V9(10) VALUE +0.0360884937 COMP. 0002:0056:1 00AE(000E:6) 332000 10 FILLER PIC S9(1)V9(10) VALUE -0.0064535442 COMP. 0002:005A:0 00BA(000F:6) 332100 05 WLN-FACTOR-TABLE REDEFINES WLN-FACTOR-VALUES 0002:005E:1 0033(0008:3) 332200 OCCURS 8 INDEXED WLN-FX. 0002:005E:1 WLN-FX = (02,026) 332300 10 WLN-FACTOR PIC S9(1)V9(10) COMP. 0002:005E:1 +0000 500000 0002:005E:1 500100 PROCEDURE DIVISION. 0002:005E:1 SEGMENT 0002 IS 005F LONG 500150****************************************************************** 0002:005E:2 500200 000-MAIN SECTION. 0002:005E:2 START OF SEGMENT AT (01,005) LIBRARY DIRECTORY = (02,027) LIBRARY TEMPLATE MARKER = (02,028) PCW = (02,029) PCW = (02,02A) DATA SEGMENT 0027 IS 0002B LON PCW(005:000:1) = (02,02B) PCW(005:000:1) = (02,02C) 500300 000-BEGIN. 0005:0000:1 500400 OPEN OUTPUT PR-FILE. 0005:0000:1 MCP PROCEDURE: FILEATTRIBUTEGRABBER= (01,006) MCP PROCEDURE: FILEATTRIBUTEHANDLER= (01,007) MCP PROCEDURE: NEWOPEN = (01,008) MCP PROCEDURE: HANDLEERROR = (01,009) 500500 ACCEPT WPL-TITLE-DATE FROM TODAYS-DATE. 0005:0028:5 MCP PROCEDURE: TIME = (01,00A) TEMPORARY = (02,02D) SEGDICT ADDRESS = (01,00B) 500600 OPEN I-O DC-FILE. 0005:002F:3 500680 MOVE "UNISYS A SERIES DMSII ISAM CALCUALTIONS PROGRAM" TO 0005:0057:5 500690 DC-REC. 0005:0057:5 TEMPORARY = (02,02E) 500700 WRITE DC-REC. 0005:005D:5 500710 MOVE "ENTER POPULATION (PPPPPP) IN RECORDS" TO DC-REC. 0005:0065:0 500720 WRITE DC-REC. 0005:006B:0 500730 MOVE "ENTER KEY SIZE (KK) IN WORDS, INCLUDING OVERHEAD" TO 0005:0072:0 500740 DC-REC. 0005:0072:0 500750 WRITE DC-REC. 0005:0078:0 500760 MOVE "ENTER LOAD-FACTOR (FF) IN PERCENT" TO DC-REC. 0005:007F:0 500770 WRITE DC-REC. 0005:0088:1 500780 MOVE "ENTER TITLE OF THE INDEX FOLLOWING THE FACTOR" TO 0005:008F:0 500790 DC-REC. 0005:008F:0 500800 WRITE DC-REC. 0005:0095:0 500810 MOVE "LIKE THIS:" TO DC-REC. 0005:009C:0 500820 WRITE DC-REC BEFORE 2 LINES. 0005:00A9:4 500900 0005:00AB:4 501000 000-LOOP. 0005:00B1:0 501040 MOVE WUM-PROMPT TO DC-REC. 0005:00B1:0 501060 WRITE DC-REC. 0005:00B4:2 501100 READ DC-FILE AT END 0005:00BB:0 501200 GO TO 000-EOF. 0005:00BB:0 501300 0005:00C3:3 501400 IF DC-REC = SPACE 0005:00C4:0 501500 GO TO 000-EOF. 0005:00C6:5 501600 0005:00C6:5 501700 MOVE DC-POPULATION TO W-POPULATION. 0005:00C6:5 501800 MOVE DC-KEY-SIZE TO W-KEY-SIZE. 0005:00C9:1 501900 MOVE DC-LOAD-FACTOR TO W-LOAD-FACTOR. 0005:00CB:4 502000 MOVE DC-TITLE TO WPL-TITLE-TEXT. 0005:00CE:1 502100 PERFORM 100-CALCULATIONS. 0005:00D0:3 502200 GO TO 000-LOOP. 0005:00D2:5 502300 0005:00D2:5 502400 000-EOF. 0005:00D3:2 502500 CLOSE DC-FILE. 0005:00D3:2 MCP PROCEDURE: NEWCLOSE = (01,00C) 502600 CLOSE PR-FILE. 0005:00DE:4 502700 0005:00DE:4 502800 000-EXIT. 0005:00EA:4 502900 STOP RUN. 0005:00EA:4 510000 0005:00EA:4 510050****************************************************************** 0005:00EA:4 MCP PROCEDURE: GOTOSOLVER = (01,00D) 510100 010-PRINT SECTION. 0005:00EB:4 PCW = (02,02F) PCW = (02,030) SEGMENT 0005 IS 00ED LONG START OF SEGMENT AT (01,00E) PCW(00E:000:1) = (02,030) 510200 010-BEGIN. 000E:0000:1 510300 MOVE PR-REC TO DC-REC. 000E:0000:1 510400 WRITE DC-REC. 000E:0002:2 510500 WRITE PR-REC AFTER 2 LINES. 000E:0009:0 510600 MOVE SPACE TO DC-REC, PR-REC. 000E:0015:2 TEMPORARY = (02,031) 510700 010-EXIT. 000E:0019:4 510800 EXIT. 000E:0019:4 600000 000E:0019:4 600050****************************************************************** 000E:0019:4 600100 100-CALCULATIONS SECTION. 000E:0019:4 SEGMENT 000E IS 001C LONG START OF SEGMENT AT (01,00F) PCW(00F:000:1) = (02,02F) 600200 100-BEGIN. 000F:0000:1 600215 MOVE WPL-TITLE-LINE TO PR-REC. 000F:0000:1 600220 WRITE PR-REC AFTER PAGE. 000F:0003:3 600225 000F:0005:1 600300 MOVE W-POPULATION TO WPL-POPULATION. 000F:000B:0 600400 MOVE WPL-POPULATION-LINE TO PR-REC. 000F:0010:4 600500 PERFORM 010-PRINT. 000F:0014:0 600600 000F:0014:0 600700 MOVE W-KEY-SIZE TO WPL-KEY-SIZE. 000F:0016:5 600800 MOVE WPL-KEY-SIZE-LINE TO PR-REC. 000F:001C:3 600900 PERFORM 010-PRINT. 000F:001F:5 601000 000F:001F:5 601100 MOVE W-LOAD-FACTOR TO WPL-LOAD-FACTOR. 000F:0021:5 601200 MOVE WPL-LOAD-FACTOR-LINE TO PR-REC. 000F:0027:3 601300 PERFORM 010-PRINT. 000F:002A:5 601400 000F:002A:5 601700 MOVE WPL-HEAD-LINE TO PR-REC. 000F:002C:5 601800 PERFORM 010-PRINT. 000F:0030:1 601880 000F:0030:1 601885 COMPUTE W-ENTRY-SIZE = W-KEY-SIZE. 000F:0032:5 601900 MOVE W-POPULATION TO WLN-ARG. 000F:0034:2 601920 PERFORM 200-COMPUTE-LN. 000F:0037:2 601940 MOVE WLN-RESULT TO W-POPULATION-LN. 000F:0039:5 602000 MOVE ZERO TO W-BLOCK-SEGS. 000F:003D:2 602100 000F:003D:2 602200 100-SEG-LOOP. 000F:003E:1 602300 ADD 1 TO W-BLOCK-SEGS. 000F:003E:1 602400 COMPUTE W-BLOCK-ENTRIES = 000F:0040:4 602500 (W-BLOCK-SEGS * W-SEGMENT-SIZE - W-BLOCK-OVERHEAD) / 000F:0041:1 602600 W-ENTRY-SIZE. 000F:0041:1 602700 COMPUTE W-BLOCK-SIZE = W-BLOCK-ENTRIES * W-ENTRY-SIZE + 000F:0045:0 602800 W-BLOCK-OVERHEAD. 000F:0045:3 602900 COMPUTE W-SLOP = (W-BLOCK-SEGS * W-SEGMENT-SIZE) - 000F:0048:4 603000 W-BLOCK-SIZE. 000F:0049:1 603100 COMPUTE W-AVG-ENTRIES = W-LOAD-FACTOR * W-BLOCK-ENTRIES / 000F:004C:2 603200 100. 000F:004D:2 603300 000F:004D:2 603400 IF W-AVG-ENTRIES > 1 000F:0050:1 603500 PERFORM 110-COMPUTE-LEVELS 000F:0052:3 603600 PERFORM 120-FORMAT-RESULTS 000F:0052:3 603700 IF W-MAX-LEVELS < 2.00 000F:0056:5 603705 GO TO 100-EXIT. 000F:0058:2 603710 000F:0058:2 603800 IF W-BLOCK-SEGS < W-SEGMENT-LIMIT 000F:0058:2 603900 GO TO 100-SEG-LOOP. 000F:005A:0 603905 000F:005A:0 604000 100-EXIT. 000F:005A:0 604100 EXIT. 000F:005A:0 604200 000F:005A:0 604250****************************************************************** 000F:005A:0 604300 110-COMPUTE-LEVELS SECTION. 000F:005A:0 PCW = (02,032) PCW = (02,033) PCW = (02,034) SEGMENT 000F IS 005D LONG START OF SEGMENT AT (01,010) PCW(010:000:1) = (02,033) 604400 110-BEGIN. 0010:0000:1 604800 MOVE W-AVG-ENTRIES TO WLN-ARG. 0010:0000:1 604900 PERFORM 200-COMPUTE-LN. 0010:0004:3 605000 COMPUTE W-MAX-LEVELS ROUNDED = 0010:0006:5 605100 W-POPULATION-LN / WLN-RESULT. 0010:0007:2 605200 0010:0007:2 LITERAL 4"00174876E800" = (01,011) 605300 MOVE W-BLOCK-ENTRIES TO WLN-ARG. 0010:000D:0 605400 PERFORM 200-COMPUTE-LN. 0010:0010:3 605500 COMPUTE W-MIN-LEVELS ROUNDED = 0010:0012:5 605600 W-POPULATION-LN / WLN-RESULT. 0010:0013:2 605700 0010:0013:2 605800 110-EXIT. 0010:0019:0 605900 EXIT. 0010:0019:0 620000 0010:0019:0 620050****************************************************************** 0010:0019:0 620100 120-FORMAT-RESULTS SECTION. 0010:0019:0 SEGMENT 0010 IS 001C LONG START OF SEGMENT AT (01,012) PCW(012:000:1) = (02,032) 620200 120-BEGIN. 0012:0000:1 620300 MOVE W-BLOCK-SEGS TO WPL-DATA-SEGS. 0012:0000:1 620400 MOVE W-BLOCK-SIZE TO WPL-DATA-BLOCK-SIZE. 0012:0005:5 620500 MOVE W-SLOP TO WPL-DATA-WASTE. 0012:000B:3 620600 MOVE W-BLOCK-ENTRIES TO WPL-DATA-ENTRIES. 0012:0011:1 620700 MOVE W-AVG-ENTRIES TO WPL-DATA-AVG-ENTRIES. 0012:0016:5 620800 MOVE W-MIN-LEVELS TO WPL-DATA-MIN-LEVELS. 0012:001D:3 620900 MOVE W-MAX-LEVELS TO WPL-DATA-MAX-LEVELS. 0012:0023:1 620905 MOVE WPL-DATA-LINE TO PR-REC. 0012:0028:5 621000 PERFORM 010-PRINT. 0012:002C:2 621100 120-EXIT. 0012:002E:5 621200 EXIT. 0012:002E:5 650000 0012:002E:5 650050****************************************************************** 0012:002E:5 650100 200-COMPUTE-LN SECTION. 0012:002E:5 650200* THIS ROUTINE CALCULATES THE NATURAL LOGARITHM OF WLN-ARG 0012:002E:5 650300* LEAVING THE RESULT IN WLN-RESULT. IT IS ACCURATE TO ONE 0012:002E:5 650400* PART IN 10**7. FROM HBK OF MATH FUNCTIONS, ABRAMOWITZ & 0012:002E:5 650500* STEGUN, DOVER, NEW YORK, 1965 (LCCN 65-12253), PP 67 FF. 0012:002E:5 650600* (I CAN'T BELIEVE I'M ACTUALLY DOING THIS IN COBOL...) 0012:002E:5 SEGMENT 0012 IS 0031 LONG START OF SEGMENT AT (01,013) PCW(013:000:1) = (02,034) 650700 200-BEGIN. 0013:0000:1 650800 MOVE ZERO TO WLN-N, WLN-SUM. 0013:0003:4 650900 MOVE WLN-ARG TO WLN-TERM. 0013:0005:0 651000 0013:0005:0 651100 200-SCALE-LOOP. 0013:0009:5 651200 IF WLN-TERM > 2.0 0013:0009:5 651300 ADD 1 TO WLN-N 0013:0010:0 651400 COMPUTE WLN-TERM ROUNDED = WLN-TERM / 2 0013:0013:2 651500 GO TO 200-SCALE-LOOP 0013:0016:5 651600 ELSE IF WLN-TERM < 1.0 0013:0017:5 651700 SUBTRACT 1 FROM WLN-N 0013:001B:4 651800 COMPUTE WLN-TERM ROUNDED = WLN-TERM * 2 0013:001F:0 651900 GO TO 200-SCALE-LOOP. 0013:0022:0 652200 0013:0022:0 652300 SET WLN-FX TO 1. 0013:0022:3 652400 MOVE 1.0 TO WLN-POWER. 0013:0023:3 652500 SUBTRACT 1.0 FROM WLN-TERM ROUNDED. 0013:0026:1 652600 0013:0026:1 652700 200-SERIES-LOOP. 0013:0029:4 652800 MULTIPLY WLN-TERM BY WLN-POWER ROUNDED. 0013:0029:4 652900 COMPUTE WLN-SUM ROUNDED = WLN-SUM + 0013:002E:3 653000 WLN-FACTOR (WLN-FX) * WLN-POWER. 0013:002F:3 653020 0013:002F:3 653050* ---- THE BUG: THE LOOP LIMIT SHOULD BE 8, NOT 9 --- 0013:002F:3 LITERAL 4"0002540BE400" = (01,014) 653100 IF WLN-FX < 9 0013:0035:4 653200 SET WLN-FX UP BY 1 0013:0038:3 653300 GO TO 200-SERIES-LOOP. 0013:003A:1 653400 0013:003A:1 653500 COMPUTE WLN-RESULT ROUNDED = WLN-SUM + 0013:003A:4 653600 WLN-N * WLN-LN-2. 0013:003B:4 653700 0013:003B:4 653800 200-EXIT. 0013:0041:3 653900 EXIT. 0013:0041:3 SEGMENT 0013 IS 0044 LONG DATA SEGMENT 0004 IS 00027 LON DATA SEGMENT 000B IS 0001A LON START OF SEGMENT AT (01,015) PCW(015:000:0) = (02,029) LIBRARY USER = (02,035) MCP PROCEDURE: MUTATE = (01,016) MCP PROCEDURE: BLOCKEXIT = (01,017) PCW(015:005:0) = (02,02A) LIBRARY LOCK = (02,036) LIBRARY EVENT = (02,037) MCP PROCEDURE: WAIT = (01,018) LIBRARY EXIT PCW = (02,039) MCP PROCEDURE: CAUSEP = (01,019) SEGMENT 0015 IS 001D LONG START OF SEGMENT AT (01,01A) LIBRARY VARIABLE = (02,002) MCP PROCEDURE: FREEZELIB = (01,01B) DATA SEGMENT 0001 IS 0001C LON LIBRARY FIRST EXECUTABLE PCW(01A:00C:1) = (01,01C) MCP PROCEDURE: MYSELF = (01,01D) NORMAL FIRST EXECUTABLE PCW(01A:00D:3) = (01,01E) MCP PROCEDURE: INSTACKARRAYDEC = (01,01F) SEGMENT 001A IS 0051 LONG COMPILE O.K. TOTAL CARD COUNT: 318 D[01] STACK SIZE: 0032(020) WORDS D[02] STACK SIZE: 0058(03A) WORDS CORE ESTIMATE: 2677 WORDS STACK ESTIMATE: 1782 WORDS CODE FILE SIZE: 59 RECORDS PROGRAM SIZE: 9 CODE SEGMENTS, 708 TOTAL WORDS SUBROUTINE NAME: SAMPLE, LEVEL 02 COMPILED ON THE LX100 FOR THE LEVEL5 SERIES COMPILER COMPILED WITH THE FOLLOWING OPTIONS: NONE. COMPILE TIMES: ELAPSED CPU I-O RPM 0002.308 0000.890 0000.412 21429