[an error occurred while processing this directive]
[an error occurred while processing this directive]
ADVANCED COBOL FOR STRUCTURED AND OBJECT-ORIENTED PROGRAMMING, THIRD EDITIONGary DeWard BrownSOLUTIONS TO PROBLEMS IN BOOKChapter 3
|
FORMULA |
Correct |
Z |
Correct |
2HOT |
Correct |
NOT-HER |
Correct |
FORMULA |
Correct |
PROGRAM-ID |
Reserved Word |
7UP |
Correct |
OH* |
* not permitted |
UP-OR-DOWN |
Correct |
W- |
- can't end word |
EITHER/OR |
/ not permitted |
UP |
Reserved word |
TO H24 |
Space not permitted |
NOW--OR-LATER |
Correct |
-TO-HERE |
- can't begin word |
TEXT |
Reserved word |
MEET-ME@4 |
@ not permitted |
F-117 |
Correct |
AVERAGE-AMOUNT-OF-DOLLARS-REMAINING |
More than 30 words (Will be legal in new ANSI COBOL) |
HUT_16 |
_ not permitted (Will be legal in new ANSI COBOL) |
HASN'T |
' not permitted |
A1. COMPUTE A = B*C. |
No spaces before and after * |
MOVE ZERO TO A. |
Correct |
IF (B=C) THEN GO TO A1. |
No spaces before and after = |
MOVE 1 TO X(1,2). |
No space after comma |
**** BEGIN COMPUTATIONS |
Correct |
START-IT. |
Correct |
MOVE X |
X above has two subscripts |
TO Y, MOVE V |
Correct |
TO W |
Correct |
ADD A, B C TO D. |
Correct |
ADD E,F,G TO H. |
No spaces after commas |
NEW-PART |
No period terminator |
ADD I,J TO K. |
No space after comma |
ADD X(1) TO Y. |
X above has two subscripts |
COMPUTE A = B+C. |
No spaces before or after + |
MOVE STRING TO X. |
STRING is reserved word. X above has two subscripts |
MOVE 1 TO A, B |
A = 1, B = 1 |
COMPUTE B = A + 1 |
A = 1, B = 2 |
ADD B TO A |
A = 3, B = 2 |
MULTIPLY B BY A |
A = 6, B = 2 |
DIVIDE A BY 5 GIVING C REMAINDER D |
A = 6, B = 2, C = 1, D = 1 |
1/2*A*T**2 |
((1 / 2) * A) *( T ** 2) |
A**B-2/Y-D |
((A ** B) - (2 / Y)) - D |
A+2*C**2/B+6*4 |
A + ((2 * (C ** 2)) / B) + (6 * 4) |
A+B=ZERO OR NOT A |
((A + B) = ZERO) OR ((NOT (A NOT = 1)) AND (B > ((A * 10) - 6))) |
MULTIPLY A BY 2 |
[The 2 must be an identifier.] |
ADD "125" TO B |
[An alphanumeric literal cannot participate in an arithmetic expression.] |
DIVIDE Budget-Remaining BY Periods-Remaining |
[From the context of the names, Periods-Remaining will contain zero in the last period, resulting in a division by zero.] |
MOVE ZERO TO A, B, C |
[Should be a comma rather than a period after B.] |
COMPUTE A = B * C ROUNDED |
[Should be COMPUTE A ROUNDED = B * C.] |
IF A = 2 = B THEN ADD 1 TO A END-IF |
[Should be coded as:]
IF A = 2 AND B � Or: |
EVALUATE Switch-A WHEN 1 PERFORM Start-It WHEN 2 PERFORM Finish-It WHEN 3 PERFORM Continue-It WHEN 4 PERFORM Proceed-To END-EVALUATE
IF X = 0 THEN MOVE 0 TO Ans ELSE IF X < 0 AND Y <= 0 THEN MOVE �1 TO Ans ELSE IF X > 22 AND X + Y > 22 THEN MOVE �2 TO Ans ELSE (IF X = 1 AND Y = 1) OR ((Y + Z) / 2 = 1) THEN MOVE 100 TO Ans ELSE MOVE 200 TO Ans END-IF EVALUATE TRUE WHEN X < 0 AND Y <= 0 MOVE �1 TO Ans WHEN X > 22 AND X + Y > 22 MOVE �2 TO Ans WHEN X = 1 AND Y = 1 WHEN (Y + Z) / 2 = 1 MOVE 100 TO Ans WHEN OTHER MOVE 200 TO Ans END-EVALUATE
EVALUATE X WHEN X = 1 WHEN X >= 10 AND X <= 30 WHEN X = 50 WHEN X = 60 WHEN X = 61 � END-EVALUATE
PERFORM Loop1 VARYING X FROM -10 BY 3 UNTIL X > -10, -7, -4, -1, 2, 5 PERFORM Loop2 VARYING X FROM 1 BY 1 UNTIL X > 1 1 MOVE 4 TO Y PERFORM WITH TEST BEFORE VARYING X FROM 1 BY 1 UNTIL (X > 10) OR (Y NOT > 0) PERFORM VARYING X FROM -3 BY -2 UNTIL X < -7 imperative-statements END-PERFORM END-PERFORM -3, -5, -7, -3, -5, -7, � in an endless loop.
PERFORM WITH TEST AFTER VARYING X FROM �6.0 BY 0.5 UNTIL X = 10.0 COMPUTE Y = (X � 1) / (X * 2 + 1) END-PERFORM
PERFORM WITH TEST BEFORE VARYING X FROM 1 BY 1 UNTIL X = 10 MOVE ZERO TO A(X) END-PERFORM EVALUATE TRUE WHEN B > 6 WHEN B < 0 WHEN C = 0 MOVE ZERO TO E IF X + Y <= 0 THEN ADD 1 TO G END-IF ADD 1 TO F WHEN B > 3 ADD 1 TO G WHEN OTHER MOVE ZERO TO D ADD 1 TO B ADD 1 TO F END-EVALUATE Or: PERFORM WITH TEST AFTER VARYING X FROM 1 BY 1 UNTIL X > 9 MOVE ZERO TO A(X) END-PERFORM IF (B > 6) OR (B < ZERO) OR (C = ZERO) THEN MOVE ZERO TO E IF (X + Y) <= ZERO THEN ADD 1 TO G END-IF ADD 1 TO F ELSE IF B > 3 THEN ADD 1 TO G ELSE ADD 1 TO D ADD 1 TO F END-IF END-IF Or: PERFORM VARYING X FROM 1 BY 1 UNTIL X > 9 MOVE ZERO TO A(X) END-PERFORM EVALUATE TRUE WHEN (B > 6) OR (B < ZERO) OR (C = ZERO) MOVE ZERO TO E IF (X + Y) <= ZERO THEN ADD 1 TO G END-IF ADD 1 TO F WHEN B > 3 ADD 1 TO G WHEN OTHER ADD 1 TO D ADD 1 TO F END-EVALUATE
X Y Z 1 0 2 1 0 5 1 -1 2 1 -1 5 3 0 2 3 0 5 3 -1 2 3 -1 5
MOVE LOW-VALUES TO Rec-In PERFORM WITH TEST AFTER UNTIL Rec-In = HIGH-VALUES READ In-File INTO Rec-In AT END MOVE HIGH-VALUES TO Rec-In NOT AT END PERFORM Process-Rec END-READ END-PERFORM GOBACK . Process-Rec. EVALUATE Rec-Type WHEN " " MOVE HIGH-VALUES TO Rec-In WHEN "A" WHEN "C" PERFORM WITH TEST BEFORE VARYING Ix FROM 1 BY 1 UNTIL IX = 21 IF Ix = 1 AND Rec-Name(Ix) = SPACES THEN CONTINUE ELSE MOVE Rec-Name(Ix) TO Save-Name(Ix) PERFORM WITH TEST BEFORE VARYING Iy FROM 1 BY 1 UNTIL Iy = 11 IF Rec-Pop(Ix, Iy) NOT = SPACES THEN MOVE Rec-Pop(Ix, Iy) TO Save-Pop(Ix, Iy) END-IF END-PERFORM END-IF END-PERFORM MOVE Rec-No TO Save-No END-EVALUATE . **** EXIT
COMPUTE E = A * D |
[A is converted to PACKED-DECIMAL and then to COMP-1. The A * D COMP-1 intermediate result is converted to COMP-2 and stored in E.] |
COMPUTE A = D * B * C |
[B and C are converted to COMP-1. The COMP-1 intermediate result is converted to DISPLAY and stored in A.] |
ADD 1 TO C |
[Conversion depends on compiler. Literal constants in IBM COBOL are PACKED-DECIMAL, and so the 1 would be converted to BINARY and be added to C.] |
MOVE B TO A |
[PACKED-DECIMAL is converted to DISPLAY.] |
COMPUTE A = 3.5 |
[A = 3 (4V0)] |
COMPUTE A ROUNDED = 3.5 |
[A = 4 (4V0)] |
COMPUTE B = 1254.6 * |
[1254.6 (4V1) * 3.3235 (1V4) = 4169.66310 (5V5) 4169.66310 (5V5) / 6.43229 (1V5) = 648.23928 (4V5) 645.23928 (4V5) + 12.1136 (2V4) = 660.35288 (5V5) 660.35288 (5V5) stored in B as 660.352 (6V3)] |
MOVE 12.211 TO B |
[B = 12.211 (6V3)] |
COMPUTE B = B / 4.395 * |
[12.211 (6V3) / 4.395 (1V3) = 2.77838 (3V5) 2.77838 (3V5) * 6.4 (1V1) = 17.781623 (4V6) 17.781623 (4V6) + 7.1135 (1V4) = 24.895123 (5V6) 24.895123 (5V6) stored in B as 24.895 (6V3)] |
COMPUTE A = (12 + .1) / 7 |
[12 (2V0) + .1 (0V1) = 12.1 (3V1) 12.1 (3V1) / 7 (1V0) = 1.7 (3V1) 1.7 (3V1) stored in A as 1 (4V0)] |
COMPUTE A = (12 / 7) + .1 |
[12 (2V0) / 7 (1V0) = 1 (2V0) 1 (1V0) + .1 (0V1) = 1.1 (2V1) 1.1 (2V1) stored in A as 1 (4V0)] |
01 A |
A = "000000" | PIC X(6) VALUE ZEROS.
|
01 B |
B = "MARYQU" with compilation warning |
PIC X(10) VALUE "MARYQUOTES".
|
01 C |
C = "ABC" | PIC X(3) VALUE "ABC".
|
01 D |
D = "121212" | PIC X(6) VALUE ALL "12".
|
01 E |
E = "123bbbbb" | PIC X(8) JUST RIGHT VALUE "123".
|
01 F |
F = "ABCbbb" | PIC X(6) VALUE "ABC".
|
01 G |
G = "000000" | PIC X(8) VALUE ALL ZEROS.
|
01 The-Num PIC S9(5). 01 Ix PIC S9(5) BINARY. IF The-Num = ZERO THEN PERFORM VARYING Ix FROM 1 BY 1 UNTIL Ix > LENGTH(The-Num) MOVE SPACE TO The-Num(Ix:1) END-PERFORM END-IF
MOVE Two TO One |
[All.] |
MOVE CORR Two TO One |
[None.] |
MOVE CORR J TO A IN One |
[C.] |
MOVE S TO G |
[S, G.] |
01 W PIC $$,$$$,$$9.99CR. MOVE 23655.97 TO W "bbb$23,658.97bb" MOVE -2 TO W "bbbbbbbb$2.OOCR" MOVE .01 TO W "bbbbbbbb$0.01bb" 01 PIC Z,ZZZ,ZZ9. MOVE 26531 TO X "bbb26,531" MOVE -4 TO X "bbbbbbbb4" 01 Y PIC -****9. MOVE -16 TO Y "-***16" MOVE 327 TO Y "b**327" MOVE -923945 TO Y "-23945" 01 Z PIC $--,---,--9.99 BLANK WHEN ZERO. MOVE 35275.6 TO Z "$bbbb35,275.60" MOVE -247.96 TO Z "$bbbbbb-247.96" MOVE ZERO TO Z "bbbbbbbbbbbbbb"
01 Count-It PIC S9(4) BINARY. 01 Something. 05 Tables OCCURS 200 TIMES ASCENDING KEY IS Tables-Val INDEXED BY Ix. 10 Tables-Val PIC S9(3)V9(4) PACKED-DECIMAL. Unordered, number of times 3.6257 occurs: MOVE ZEROS TO Count-It PERFORM VARYING Ix FROM 1 BY 1 UNTIL Ix > 200 IF Tables-Val(Ix) = 3.6257 THEN ADD 1 TO Count-It END-IF END-PERFORM DISPLAY "3.6257 OCCURS THIS MANY TIMES: ", Count-It Unordered, see if 0.7963 is in table: SET Ix TO 1 SEARCH Tables AT END DISPLAY "0.7963 NOT IN Tables-Val" WHEN Tables-Val(Ix) = 0.7963 DISPLAY "0.7963 IS FOUND IN Tables-Val" END-SEARCH Ordered, see if 2.1537 is in table: SEARCH ALL Tables AT END DISPLAY "2.1537 NOT IN Tables-Val" WHEN Tables-Val(Ix) = 2.1537 DISPLAY "2.1537 IS FOUND IN Tables-Val" END-SEARCH
IDENTIFICATION DIVISION. PROGRAM-ID. TABLE-PGM. ***************************************************************** * PROGRAM TO READ A FILE AND STORE THE RECORDS IN A TABLE. * * IN: In-File CONTAINS INPUT FILE WITH A MAXIMUM OF 100 * * RECORDS. * * OUT: RECORDS DISPLAYED AND STORED IN A TABLE. * ***************************************************************** ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT In-File ASSIGN TO "TABLEPGM.TXT" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD In-File BLOCK CONTAINS 0 RECORDS. 01 In-Record PIC X(80). WORKING-STORAGE SECTION. 01 In-Rec. 05 Field-1 PIC S9(7) SIGN IS LEADING. 05 Field-2 PIC S9(9) SIGN IS LEADING. 05 Field-3 PIC S9(5)V99 SIGN IS LEADING. 05 Field-4 PIC S9(7)V99 SIGN IS LEADING. 05 Field-5 PIC X(7). 05 Field-6 PIC X(9). 05 Rest-Of-Rec PIC X(32). 01 In-EOF PIC X. * Flag for end of file. "Y", EOF. "N", no EOF. 01 Table-Rec. 05 Table-Entries OCCURS 100 TIMES DEPENDING ON No-Entries INDEXED BY Ix. 10 F-1 PIC S9(7) PACKED-DECIMAL. 10 F-2 PIC S9(9) PACKED-DECIMAL. 10 F-3 PIC S9(5)V99 PACKED-DECIMAL. 10 F-4 PIC S9(7)V99 PACKED-DECIMAL. 10 F-5 PIC X(7). 10 F-6 PIC X(9). 10 Rest-Of-Rec PIC X(32). 05 No-Entries PIC S9(4) BINARY VALUE 100. PROCEDURE DIVISION. A00-Begin. DISPLAY "BEGINNING TABLE-PGM PROGRAM." OPEN INPUT In-File MOVE "N" TO IN-EOF PERFORM WITH TEST AFTER VARYING IX FROM 1 BY 1 UNTIL In-EOF = "Y" READ In-File INTO In-Rec AT END MOVE "Y" TO In-EOF NOT AT END DISPLAY In-Rec IF Ix > No-Entries THEN DISPLAY "Too many records, ", " Table-Entries table overflow. " "Killing job." CLOSE In-File GOBACK END-IF MOVE FUNCTION NUMVAL(Field-1) TO F-1(Ix) MOVE FUNCTION NUMVAL(Field-2) TO F-2(Ix) MOVE FUNCTION NUMVAL(Field-3) TO F-3(Ix) MOVE FUNCTION NUMVAL(Field-4) TO F-4(Ix) MOVE Field-5 TO F-5(Ix) MOVE Field-6 TO F-6(Ix) END-READ END-PERFORM CLOSE In-File GOBACK . END PROGRAM TABLE-PGM. TABLEPGM.TXT: 1 2 1 2AAAAAAABBBBBBBBBB -3 -4 -333 -444CCCCCCCDDDDDDDDDD - 5- 6- 555- 555EEEEEEEFFFFFFFFFF
IDENTIFICATION DIVISION. PROGRAM-ID. VALPGM. ***************************************************************** * PROGRAM READ A FILE, CHECK THE SORT SEQUENCE, AND DISPLAY * * DUPLICATE PROJECT NUMBERS. * * IN: File-In IS INPUT FILE. * * OUT: DUPLICATE PART NUMBERS ARE DISPLAYED. * ***************************************************************** ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT File-In ASSIGN TO "INFILE.TXT" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD File-In BLOCK CONTAINS 0 RECORDS. 01 Rec-In PIC X(36). * Record length increased from 33 to 36 for testing so that * the input file doesn't contain PACKED-DECIMAL and thus * can be created by a text editor. WORKING-STORAGE SECTION. 01 In-Rec. 05 In-Proj PIC X(4). 05 In-Name PIC X(25). 05 In-Ohd PIC S9(5)V99. * In-Ohd changed from PACKED-DECIMAL TO DISPLAY FOR TESTING. 01 In-Dup-Proj PIC X(4). 01 In-No-Dup PIC S9(4) BINARY. PROCEDURE DIVISION. A00-Begin. DISPLAY "BEGINNING VALIDATE PROGRAM" OPEN INPUT File-In MOVE LOW-VALUES TO In-Rec, In-Dup-Proj MOVE ZEROS TO In-No-Dup PERFORM UNTIL In-Rec = HIGH-VALUES READ File-In INTO In-Rec AT END MOVE HIGH-VALUES TO In-Rec NOT AT END PERFORM B10-Check-Records END-READ END-PERFORM CLOSE File-In DISPLAY "NUMBER OF DUPLICATES: ", In-No-Dup DISPLAY "END VALIDATE PROGRAM" GOBACK. B10-Check-Records. IF In-Proj < In-Dup-Proj THEN DISPLAY "RECORD OUT OF SORT: " DISPLAY In-Rec ELSE IF In-Proj = In-Dup-Proj THEN DISPLAY "DUPLICATE PROJECT NUMBER:" DISPLAY In-Rec ADD 1 TO In-No-Dup END-IF END-IF MOVE In-Proj TO In-Dup-Proj . **** Exit END PROGRAM VALPGM. INFILE.TXT: 0000-------------------------0000000 1111AAAAAAAAAAAAAAAAAAAAAAAAA0000100 2222BBBBBBBBBBBBBBBBBBBBBBBBB0001001 2222GGGGGGGGGGGGGGGGGGGGGGGGG0050055 3333CCCCCCCCCCCCCCCCCCCCCCCCC0010011 4444DDDDDDDDDDDDDDDDDDDDDDDDD0020022 5555EEEEEEEEEEEEEEEEEEEEEEEEE0030033 5555HHHHHHHHHHHHHHHHHHHHHHHHH0060066 5555IIIIIIIIIIIIIIIIIIIIIIIII0070077 6666FFFFFFFFFFFFFFFFFFFFFFFFF0040044 4444GGGGGGGGGGGGGGGGGGGGGGGGG0080088
IDENTIFICATION DIVISION. PROGRAM-ID. TESTSTAT. ***************************************************************** * PROGRAM TO TEST THE STATS SUBPROGRAM. * * IN: Nothing. * * OUT: Table-Min contains minimum value of Table-VAL, * * Table-Max contains the maximum, and Table-Avg the * * average. * ***************************************************************** DATA DIVISION. WORKING-STORAGE SECTION. 01 Table-Defn. 05 Table-Size PIC S9(4) BINARY. 05 Table-Val PIC S9(5)V99 PACKED-DECIMAL OCCURS 0 TO 500 TIMES DEPENDING ON Table-Size INDEXED BY Tbl-X. 05 Table-Min PIC S9(5)V99 PACKED-DECIMAL. 05 Table-Max PIC S9(5)V99 PACKED-DECIMAL. 05 Table-Avg PIC S9(5)V99 PACKED-DECIMAL. 01 Some-Value PIC S9(5)V99 PACKED-DECIMAL. PROCEDURE DIVISION. A00-Begin. DISPLAY "START OF TESTSTAT PROGRAM" MOVE 1000.00 TO Some-Value MOVE 100 TO Table-Size PERFORM WITH TEST AFTER VARYING Tbl-X FROM 1 BY 1 UNTIL Tbl-X = Table-Size MOVE Some-Value TO Table-Val(Tbl-X) SUBTRACT 10.00 FROM Some-Value END-PERFORM CALL "STATS" USING Table-Defn DISPLAY "Table-Min: ", Table-Min DISPLAY "Table-Max: ", Table-Max DISPLAY "Table-Avg: ", Table-Avg GOBACK . IDENTIFICATION DIVISION. PROGRAM-ID. STATS. ***************************************************************** * SUBPROGRAM TO FIND MINIMUM, MAXIMUM, AND AVERAGE VALUES OF * * A VARIABLE SIZED TABLE. * * CALL: CALL "STATS" USING Table-Defn * * IN: Table-Size contains the size of the table as * * PIC S9(4) BINARY. * * Table-Val contains the table values as PIC S9(5)V99 * * PACKED-DECIMAL. * * OUT: Table-Min contains minimum value of Table-VAL, * * Table-Max contains the maximum, and Table-Avg the * * average. All are PIC S9(5)V99 PACKED-DECIMAL. * ***************************************************************** DATA DIVISION. WORKING-STORAGE SECTION. 01 Table-Total PIC S9(9)V99 PACKED-DECIMAL. LINKAGE SECTION. 01 Table-Defn. 05 Table-Size PIC S9(4) BINARY. 05 Table-Val PIC S9(5)V99 PACKED-DECIMAL OCCURS 0 TO 500 TIMES DEPENDING ON Table-Size INDEXED BY Tbl-X. 05 Table-Min PIC S9(5)V99 PACKED-DECIMAL. 05 Table-Max PIC S9(5)V99 PACKED-DECIMAL. 05 Table-Avg PIC S9(5)V99 PACKED-DECIMAL. PROCEDURE DIVISION USING Table-Defn. START-PROGRAM. MOVE ZEROS TO Table-Total MOVE -99999.99 TO Table-Max MOVE 99999.99 TO Table-Min PERFORM VARYING Tbl-X FROM 1 BY 1 UNTIL Tbl-X > Table-Size ADD Table-Val(Tbl-X) TO Table-Total IF Table-Val(Tbl-X) > Table-Max THEN MOVE Table-Val(Tbl-X) TO Table-Max END-IF IF Table-Val(Tbl-X) < Table-Min THEN MOVE Table-Val(Tbl-X) TO Table-Min END-IF END-PERFORM COMPUTE Table-Avg = Table-Total / Table-Size GOBACK. END PROGRAM STATS. END PROGRAM TESTSTAT.
01 Titles PIC X(200). 01 Count-It PIC S9(5) BINARY. MOVE ZERO TO Count-It INSPECT Titles TALLYING Count-It FOR ALL "ABCD" ALL "EFG"
IDENTIFICATION DIVISION. PROGRAM-ID. SORTPGM. ************************************************************ * PROCEDURE TO SORT A FILE ON TWO SORT KEYS AND WRITE AN * * OUTPUT FILE. * * IN: Sort-In file. * * OUT: Sort-Out file sorted into necessary order. * ************************************************************ INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Sort-File ASSIGN TO SORTWK. SELECT Sort-In ASSIGN TO "SORTIN.TXT" ORGANIZATION IS LINE SEQUENTIAL. SELECT Sort-Out ASSIGN TO "SORTOUT.TXT" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. SD Sort-File. 01 Sort-Rec. 05 Sort-Key-1 PIC X(8). 05 Sort-Key-2 PIC X(12). 05 FILLER PIC X(60). FD Sort-In BLOCK CONTAINS 0 RECORDS. 01 In-Rec PIC X(80). FD Sort-Out BLOCK CONTAINS 0 RECORDS. 01 Out-Rec PIC X(80). PROCEDURE DIVISION. A00-Begin. DISPLAY "BEGINNING SORTPGM PROGRAM" SORT Sort-File ON ASCENDING KEY Sort-Key-1 ON DESCENDING KEY Sort-Key-2 USING Sort-In GIVING Sort-Out GOBACK. END PROGRAM SORTPGM. SORTIN.TXT: 43333333333333333333GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG 63333333666666666666KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK 11111112222222222222BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB 43333333222222222222HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH 22222222333333333333DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD 33333333444444444444EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE 11111111222222222222AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 43333333444444444444FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 11111112111111111111CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 43333333555555555555IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII 53333333555555555555JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ
IDENTIFICATION DIVISION. PROGRAM-ID. BUBBLE. ***************************************************************** * PROGRAM TO READ FILE, STORE IT IN A TABLE, AND USE A BUBBLE * * SORT TO SORT THE RECORDS AND WRITE THEM OUT. * * IN: In-File CONTAINS INPUT FILE. * * OUT: Out-File CONTAINS SORTED FILE. * ***************************************************************** ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT In-File ASSIGN TO "INFILE.TXT" ORGANIZATION IS LINE SEQUENTIAL. SELECT Out-File ASSIGN TO "OUTFILE.TXT" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD In-File BLOCK CONTAINS 0 RECORDS. 01 In-Record PIC X(20). FD Out-File BLOCK CONTAINS 0 RECORDS. 01 Out-Record PIC X(20). WORKING-STORAGE SECTION. 01 In-Rec. 05 In-Rec-Key PIC X(20). 01 In-EOF PIC X. * Flag for end of file. "Y", EOF. "N", no EOF. 01 Swap PIC X(20). 01 Max-Table PIC S9(7) VALUE 1000. 01 A-Table-Size PIC S9(7). 01 A-Table. 05 A-Table-Key OCCURS 1000 TIMES INDEXED BY X-Amt, Y-Amt PIC X(20). PROCEDURE DIVISION. A00-Begin. DISPLAY "BEGINNING BUBBLE PROGRAM." PERFORM A10-Read-File PERFORM B10-Bubble-Sort PERFORM C10-Write-File GOBACK . A10-Read-File. OPEN INPUT In-File MOVE "N" TO IN-EOF SET X-Amt TO 1 PERFORM WITH TEST AFTER UNTIL In-EOF = "Y" READ In-File INTO In-Rec AT END MOVE "Y" TO In-EOF NOT AT END IF X-Amt > Max-Table THEN DISPLAY "Too many records, ", " A-Table table overflow. " "Killing job." CLOSE In-File GOBACK END-IF MOVE In-Rec-Key TO A-Table-Key(X-Amt) SET A-Table-Size TO X-Amt SET X-Amt UP BY 1 END-READ END-PERFORM CLOSE In-File . B10-Bubble-Sort. PERFORM VARYING X-Amt FROM 1 BY 1 UNTIL X-Amt = A-Table-Size PERFORM VARYING Y-Amt FROM X-Amt BY 1 UNTIL Y-Amt > A-Table-Size IF A-Table-Key(X-Amt) > A-Table-Key(Y-Amt) THEN MOVE A-Table-Key(Y-Amt) TO Swap MOVE A-Table-Key(X-Amt) TO A-Table-Key(Y-Amt) MOVE Swap TO A-Table-Key(X-Amt) END-IF END-PERFORM END-PERFORM . ****Exit C10-Write-File. OPEN OUTPUT Out-File PERFORM WITH TEST AFTER VARYING X-Amt FROM 1 BY 1 UNTIL X-Amt = A-Table-Size WRITE Out-Record FROM A-Table-Key(X-Amt) END-PERFORM CLOSE Out-File . END PROGRAM BUBBLE. INFILE.TXT: 111115111111111AAAA 111111171111111AAAA 000000000000000ABAA 111115111111111AAAA 111111611111111AAAA 111111171111111AAAA 111111111922222AAAA 111111111111191AAAA 000000000000000BAAA 111111111191111AAAA 555555555555553DDDD 111111111119111AAAA 111111611111111AAAA 111111111111911AAAA 000000000000000AAAB 111141111111111AAAA 555555555555553CCCC 111111118111111AAAA 111111111111119AAAA 322222222222222AAAA 222222222222222AAAB 000000000000000AAAA 111111111911111AAAA 111111111111111AAAA 121111111111111AAAA 555555555555552CCCC 121111111111111AAAA 111111111111111AAAB 222222222222220AAAA 222222222222221AAAA 112111111111111AAAA 111211111111111AAAA 111311111111111AAAA 000000000000000AABA 222222222222222DDDD 444444444444441BBBB
IDENTIFICATION DIVISION. PROGRAM-ID. SORT-IT. ***************************************************************** * PROGRAM TO SORT INPUT FILE ON ASCENDING ORDER ON STATE AND * * TOWN. THE INPUT FILE HAS TWO RECORD TYPES WITH THE SORT KEYS * * IN DIFFERENT POSIITIONS FOR EACH TYPE OF RECORD. THE PROGRAM * * APPENDS A SORT KEY TO THE RECORD IN AN INPUT PROCEDURE AND * * STIPS OFF THE KEY IN AN OUTPUT * * PROCEDURE. * * IN: File-I CONTAINS THE INPUT FILE. * * OUT: File-O CONTAINS THE SORTED INPUT FILE. * ***************************************************************** INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT File-I ASSIGN TO "SORTIN.TXT" ORGANIZATION IS LINE SEQUENTIAL. SELECT File-O ASSIGN TO "SORTOUT.TXT" ORGANIZATION IS LINE SEQUENTIAL. SELECT Sort-File ASSIGN TO "SORTWK.TXT". DATA DIVISION. FILE SECTION. FD File-I. 01 File-I-Rec PIC X(41). FD File-O. 01 File-O-Rec PIC X(41). SD Sort-File. 01 Sort-Record. 05 Sort-Original PIC X(41). 05 Sort-Key. 10 Sort-State PIC X(20). 10 Sort-Town PIC X(10). WORKING-STORAGE SECTION. 01 Rec-A. 05 Rec-A-Type PIC X. * "A" for Rec-A. 05 Rec-A-State PIC X(20). 05 Rec-A-Town PIC X(10). 05 Rec-A-Remainder PIC X(10). * NOTE: RECORD LENGTH CHANGED FROM 131 TO 41 FOR THE TEST * TO MAKE IT EASIER TO CREATE DATA FOR THE PROGRAM WITH * A TEXT EDITOR. 01 Rec-B REDEFINES Rec-A. 05 Rec-B-Type PIC X. * "B" for Rec-B. 05 Rec-B-Town PIC X(10). 05 Rec-B-State PIC X(20). 05 Rec-B-Remainder PIC X(10). PROCEDURE DIVISION. A00-Begin. DISPLAY "BEGINNING SORT-IT PROGRAM" SORT Sort-File ON ASCENDING KEY Sort-State, Sort-Town INPUT PROCEDURE IS B10-Get-Records OUTPUT PROCEDURE IS C10-Write-Records GOBACK. B10-Get-Records. OPEN INPUT File-I MOVE LOW-VALUES TO Rec-A-Type PERFORM UNTIL Rec-A-Type = HIGH-VALUES READ File-I INTO Rec-A AT END MOVE HIGH-VALUES TO Rec-A-Type NOT AT END MOVE Rec-A TO Sort-Original EVALUATE Rec-A-Type WHEN "A" MOVE Rec-A-State TO Sort-State MOVE Rec-A-Town TO Sort-Town RELEASE Sort-Record WHEN "B" MOVE Rec-B-State TO Sort-State MOVE Rec-B-Town TO Sort-Town RELEASE Sort-Record WHEN OTHER DISPLAY "BAD RECORD IGNORED" DISPLAY Rec-A END-EVALUATE END-READ END-PERFORM CLOSE File-I . **** EXIT C10-Write-Records. OPEN OUTPUT File-O MOVE LOW-VALUES TO Sort-Key PERFORM UNTIL Sort-Key = HIGH-VALUES RETURN Sort-File AT END MOVE HIGH-VALUES TO Sort-Key NOT AT END WRITE File-O-Rec FROM Sort-Original END-RETURN END-PERFORM CLOSE File-O . **** EXIT END PROGRAM SORT-IT. SORTIN.TXT: AWYOMING CHEYENNE XXXXXXXXXX AARIZONA PHOENIX XXXXXXXXXX ANEW YORK ALBANY XXXXXXXXXX BLAS VEGAS NEVADA XXXXXXXXXX BPROVO UTAH XXXXXXXXXX BRETON VERMONT XXXXXXXXXX
IDENTIFICATION DIVISION. PROGRAM-ID. TESTSCR. ***************************************************************** * PROGRAM TO TEST MenuH SUBPROGRAM. * * IN: Nothing. * * OUT: Number of menu item selected is displayed. * * Terminates when the fifth menu item is selected. * ***************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. CURSOR IS Csr-Loc CRT STATUS IS PF-Key. DATA DIVISION. WORKING-STORAGE SECTION. 01 Csr-Loc GLOBAL PIC 9(6). 01 Csr-Loc-Parts REDEFINES Csr-Loc GLOBAL. 05 Csr-Row PIC 999. 05 Csr-Col PIC 999. 01 PF-Key PIC 99X. 01 No-Entries PIC S9(4) BINARY VALUE 5. 01 The-Menu-Names. 05 N-1 PIC X(8) VALUE "One ". 05 N-2 PIC X(8) VALUE "Two ". 05 N-3 PIC X(8) VALUE "Three ". 05 N-4 PIC X(8) VALUE "Four ". 05 N-5 PIC X(8) VALUE "Quit ". 05 N-6 PIC X(8) VALUE "Six ". 05 N-7 PIC X(8) VALUE "Seven ". 05 N-8 PIC X(8) VALUE "Eight ". 05 N-9 PIC X(8) VALUE "Nine ". 05 N-10 PIC X(8) VALUE "Ten ". 01 The-Menu REDEFINES The-Menu-Names. 05 The-Entries PIC X(8) OCCURS 10 TIMES. 01 The-Selection PIC S9(4) BINARY. 01 Now-Quit PIC X. PROCEDURE DIVISION. DISPLAY "BEGINNING TESTSCR PROGRAM" DISPLAY "Select Quit to quit" MOVE "N" TO Now-Quit PERFORM WITH TEST AFTER UNTIL Now-Quit = "Y" CALL "MenuH" USING No-Entries, The-Menu, The-Selection DISPLAY "Selection: ", The-Selection IF The-Selection = 5 OR 0 THEN MOVE "Y" TO Now-Quit END-IF END-PERFORM GOBACK . IDENTIFICATION DIVISION. PROGRAM-ID. MenuH. ***************************************************************** * SUBPROGRAM TO DISPLAY A LOTUS 1-2-3 TYPE MENU ON THE TOP * * ROW OF THE SCREEN AND LET THE PERSON AT THE TERMINAL SELECT * * AN ITEM. * * CALL: CALL MenuH USING No-Entries, BY REFERENCE The-Menu, I * * IN: Csr-Row, Csr-Col PIC 999 GLOBAL are used to set and * * retrieve the position of the cursor on the screen. * * No-Entries PIC S9(4) BINARY contains the number of * * menu items in The-Entries to display. * * The-Menu contains The-Entries PIC X(8) OCCURS 10 TIMES * * as a table containing the menu items. * * N is PIC S9(4) Binary identifier. * * OUT: N contains the number (1 to No-Entries) of the menu * * item selected. * ***************************************************************** ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 01 Menu-Loc. 05 Menu-Loc-Vals OCCURS 10 TIMES. 10 LL-Row PIC 99. 10 LL-Col PIC 99. 10 UR-Row PIC 99. 10 UR-Col PIC 99. LINKAGE SECTION. 01 No-Entries PIC S9(4) BINARY. 01 The-Menu. 05 The-Entries PIC X(8) OCCURS 10 TIMES. 01 I PIC S9(4) BINARY. SCREEN SECTION. 01 Screen-1 BLANK SCREEN BACKGROUND-COLOR 1 FOREGROUND-COLOR 7. 10 LINE LL-Row(1) COLUMN LL-Col(1) REVERSE-VIDEO PIC X(8) USING The-Entries(1). 01 Screen-2 BLANK SCREEN BACKGROUND-COLOR 1 FOREGROUND-COLOR 7. 10 LINE LL-Row(1) COLUMN LL-Col(1) REVERSE-VIDEO PIC X(8) USING The-Entries(1). 10 LINE LL-Row(2) COLUMN LL-Col(2) REVERSE-VIDEO PIC X(8) USING The-Entries(2). * ... Screen definitions omitted for brevity. * There may be a way to do this without defining a new screen for * each number of menu items, but I don't know what it is. 01 Screen-5 BLANK SCREEN BACKGROUND-COLOR 1 FOREGROUND-COLOR 7. 10 LINE LL-Row(1) COLUMN LL-Col(1) REVERSE-VIDEO PIC X(8) USING The-Entries(1). 10 LINE LL-Row(2) COLUMN LL-Col(2) REVERSE-VIDEO PIC X(8) USING The-Entries(2). 10 LINE LL-Row(3) COLUMN LL-Col(3) REVERSE-VIDEO PIC X(8) USING The-Entries(3). 10 LINE LL-Row(4) COLUMN LL-Col(4) REVERSE-VIDEO PIC X(8) USING The-Entries(4). 10 LINE LL-Row(5) COLUMN LL-Col(5) REVERSE-VIDEO PIC X(8) USING The-Entries(5). * ... Screen definitions omitted for brevity. 01 Screen-10 BLANK SCREEN BACKGROUND-COLOR 1 FOREGROUND-COLOR 7. 10 LINE LL-Row(1) COLUMN LL-Col(1) REVERSE-VIDEO PIC X(8) USING The-Entries(1). 10 LINE LL-Row(2) COLUMN LL-Col(2) REVERSE-VIDEO PIC X(8) USING The-Entries(2). 10 LINE LL-Row(3) COLUMN LL-Col(3) REVERSE-VIDEO PIC X(8) USING The-Entries(3). 10 LINE LL-Row(4) COLUMN LL-Col(4) REVERSE-VIDEO PIC X(8) USING The-Entries(4). 10 LINE LL-Row(5) COLUMN LL-Col(5) REVERSE-VIDEO PIC X(8) USING The-Entries(5). 10 LINE LL-Row(6) COLUMN LL-Col(6) REVERSE-VIDEO PIC X(8) USING The-Entries(6). 10 LINE LL-Row(7) COLUMN LL-Col(7) REVERSE-VIDEO PIC X(8) USING The-Entries(7). 10 LINE LL-Row(8) COLUMN LL-Col(8) REVERSE-VIDEO PIC X(8) USING The-Entries(8). 10 LINE LL-Row(9) COLUMN LL-Col(9) REVERSE-VIDEO PIC X(8) USING The-Entries(9). 10 LINE LL-Row(10) COLUMN LL-Col(10) REVERSE-VIDEO PIC X(8) USING The-Entries(10). PROCEDURE DIVISION USING No-Entries, The-Menu, I. * Calculate where to place menu items and coordinates * of box around it. MOVE 1 TO LL-Row(1) MOVE 1 TO LL-Col(1) COMPUTE UR-Row(1) = LL-Row(1) - 1 COMPUTE UR-COL(1) = LL-Col(1) + 7 PERFORM WITH TEST BEFORE VARYING I FROM 2 BY 1 UNTIL I > No-Entries MOVE LL-Row(I - 1) TO LL-Row(I) COMPUTE LL-COL(I) = UR-Col(I - 1) + 1 COMPUTE UR-Row(I) = LL-Row(I) - 1 COMPUTE UR-Col(I) = LL-Col(I) + 7 END-PERFORM MOVE LL-Row(1) TO Csr-Row MOVE LL-Col(1) TO Csr-Col EVALUATE No-Entries WHEN 1 DISPLAY Screen-1 ACCEPT Screen-1 WHEN 2 DISPLAY Screen-2 ACCEPT Screen-2 * ... Screen definitions omitted for brevity. WHEN 5 DISPLAY Screen-5 ACCEPT Screen-5 * ... Screen definitions omitted for brevity. WHEN 10 DISPLAY Screen-10 ACCEPT Screen-10 END-EVALUATE PERFORM WITH TEST BEFORE VARYING I FROM 1 BY 1 UNTIL I > No-Entries IF Csr-Row <= LL-Row(I) AND Csr-Col >= LL-Col(I) AND Csr-Row >= UR-Row(I) AND Csr-Col <= UR-Col(I) DISPLAY "I: ", I GOBACK END-IF END-PERFORM MOVE ZERO TO I GOBACK . END PROGRAM MenuH. END PROGRAM TESTSCR.
[ Home ] | [ References ] | [ Exercises ] | [ Programs ] |