| products/sources/formale sprachen/Cobol/Test-Suite/COBOL/EX/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: st144a.cob Sprache: Cobol |
|
||||||
|
000100 IDENTIFICATION DIVISION.
000200 000400 PROGRAM-ID. 000500 EXEC85. 000600 INSTALLATION. 000700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ". 000800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ". 000900 ENVIRONMENT DIVISION. 001000 001100**************************************************************** 001200* * 001300* VALIDATION FOR:- * 001400* * 001500* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ". 001600* * 001700* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ". 001800* * 001900**************************************************************** 002000 CONFIGURATION SECTION. 002100 002200 SPECIAL-NAMES. 002300 INPUT-OUTPUT SECTION. 002400 FILE-CONTROL. 002500 SELECT OPTIONAL POPULATION-FILE 002600 ASSIGN TO 002700 "C0001" . 002800 SELECT SOURCE-COBOL-PROGRAMS 002900 ASSIGN TO 003000 "C0002" 003100 ORGANIZATION SEQUENTIAL. 003200 SELECT UPDATED-POPULATION-FILE 003300 ASSIGN TO 003400 "C0003" . 003500 SELECT PRINT-FILE 003600 ASSIGN TO 003700 "C0085" . 003800 SELECT CONTROL-CARD-FILE 003900 ASSIGN TO 004000 "C0088" . 004100 DATA DIVISION. 004200 FILE SECTION. 004300 FD POPULATION-FILE. 004400* RECORD CONTAINS 2400 CHARACTERS. 004500 01 SOURCE-IN-2400. 004600 02 SOURCE-IN PIC X(80). 004700* OCCURS 30. 004800 FD CONTROL-CARD-FILE. 004900 01 CONTROL-RECORD PIC X(80). 005000 FD PRINT-FILE. 005100 01 PRINT-REC. 005200 05 FILLER PIC X. 005300 05 PRINT-DATA PIC X(131). 005400 FD SOURCE-COBOL-PROGRAMS 005500 BLOCK CONTAINS 1 RECORDS. 005600 01 CT-OUT. 005700 02 FILLER PIC X(72). 005800 02 FILLER PIC X(8). 005900 FD UPDATED-POPULATION-FILE 006000 RECORD CONTAINS 2400 CHARACTERS. 006100 01 UPDATED-SOURCE-OUT-2400. 006200 02 UD-SOURCE-OUT PIC X(80) OCCURS 30. 006300 006400 WORKING-STORAGE SECTION. 006500 006600 01 FILLER PIC X(40) VALUE 006700 "NEWEXEC WORKING-STORAGE STARTS HERE ==->". 006800 01 BLOCK-TYPE PIC X(5). 006900 01 SUB1 PIC S9(3) COMP. 007000 01 SUB2 PIC S9(3) COMP. 007100 01 SUB3 PIC S9(3) COMP. 007200 01 SUB4 PIC S9(3) COMP. 007300 01 SUB5 PIC S9(3) COMP. 007400 01 SUB6 PIC S9(3) COMP. 007500 01 SUB7 PIC S9(3) COMP. 007600 01 WA-ERR-IND PIC 9 VALUE ZEROES. 007700 01 WA-FIRST-IND PIC 9 VALUE ZEROES. 007800 01 WA-ZCARD-TABLE. 007900 05 WA-ZCARD OCCURS 10 008000 PIC X(60). 008100 01 WA-TOP-OF-PAGE-LINE. 008200 05 FILLER PIC X(4) VALUE SPACES. 008300 05 WA-VERSION. 008400 07 WA-VERSION-TEXT PIC X(22) VALUE 008500 "CCVS85 VERSION NUMBER ". 008600 07 WA-VERSION-NUM PIC X(3) VALUE SPACES. 008700 05 WA-RELEASE. 008800 07 WA-RELEASE-TEXT PIC X(14) VALUE 008900 ", RELEASED ON ". 009000 07 WA-VERSION-DATE PIC X(11) VALUE SPACES. 009100 05 FILLER PIC X(4) VALUE SPACES. 009200 05 WA-COMPANY-AND-COMPILER PIC X(30) VALUE SPACES. 009300 05 FILLER PIC X(5) VALUE SPACES. 009400 05 WA-DATE PIC XXBXXBXX. 009500 05 FILLER PIC X(4) VALUE SPACES. 009600 05 FILLER PIC X(5) VALUE "PAGE ". 009700 05 WA-PAGE-CT PIC Z(5)9. 009800 009900 01 WA-ACCT-LINE-1. 010000 05 FILLER PIC X(19) VALUE 010100 " ** END OF PROGRAM ". 010200 05 WA-CURRENT-PROG PIC X(6). 010300 05 FILLER PIC X(32) VALUE 010400 " FOUND, COBOL LINES PROCESSED: ". 010500 05 WA-LINES-COBOL PIC Z(5)9. 010600 01 WA-ACCT-LINE-2. 010700 05 FILLER PIC X(19) VALUE 010800 " ** LINES INSERTED ". 010900 05 WA-LINES-INSERTED PIC Z(5)9. 011000 05 FILLER PIC X(19) VALUE 011100 " ** LINES REPLACED ". 011200 05 WA-LINES-REPLACED PIC Z(5)9. 011300 05 FILLER PIC X(19) VALUE 011400 " ** LINES DELETED ". 011500 05 WA-LINES-DELETED PIC Z(5)9. 011600 01 WA-ACCT-LINE-3. 011700 05 FILLER PIC X(18) VALUE 011800 " ** OPTIONAL CODE ". 011900 05 WA-OPTIONAL-CODE PIC X(8). 012000 05 WA-CODE-REMOVED PIC Z(5)9. 012100 05 WA-CODE-KILLED PIC X(21) VALUE 012200 " ** COMMENTS DELETED ". 012300 05 WA-COMMENTS-DEL PIC Z(5)9. 012400 01 WA-FINAL-LINE-1. 012500 05 FILLER PIC X(34) VALUE 012600 " ** END OF POPULATION FILE REACHED". 012700 05 FILLER PIC X(27) VALUE 012800 " NUMBER OF PROGRAMS FOUND: ". 012900 05 WA-PROGS-FOUND PIC Z(5)9. 013000 01 WA-FINAL-LINE-2. 013100 05 FILLER PIC X(47) VALUE 013200 " ** NUMBER OF PROGRAMS WRITTEN TO SOURCE FILE: ". 013300 05 WA-SOURCE-PROGS PIC Z(5)9. 013400 01 WA-FINAL-LINE-3. 013500 05 FILLER PIC X(48) VALUE 013600 " ** NUMBER OF PROGRAMS WRITTEN TO NEW POPULATION". 013700 05 FILLER PIC X(7) VALUE " FILE: ". 013800 05 WA-NEWPOP-PROGS PIC Z(5)9. 013900 01 WB-CONTROL-DATA. 014000 05 WB-FILL PIC X(80). 014100 05 FILLER REDEFINES WB-FILL. 014200 10 WB-3 PIC X(3). 014300 10 FILLER PIC X(77). 014400 05 FILLER REDEFINES WB-FILL. 014500 10 WB-4 PIC X(4). 014600 10 WB-NN PIC 99. 014700 10 FILLER PIC X. 014800 10 WB-X PIC X. 014900 10 FILLER PIC X(72). 015000 05 FILLER REDEFINES WB-FILL. 015100 10 WB-6 PIC X(6). 015200 10 FILLER PIC X(74). 015300 05 FILLER REDEFINES WB-FILL. 015400 10 WB-7 PIC X(7). 015500 10 FILLER PIC X(73). 015600 05 FILLER REDEFINES WB-FILL. 015700 10 WB-8 PIC X(8). 015800 10 FILLER PIC X(72). 015900 05 FILLER REDEFINES WB-FILL. 016000 10 WB-9 PIC X(9). 016100 10 FILLER PIC X(71). 016200 05 FILLER REDEFINES WB-FILL. 016300 10 WB-10 PIC X(10). 016400 10 FILLER PIC X(70). 016500 05 FILLER REDEFINES WB-FILL. 016600 10 WB-11 PIC X(11). 016700 10 FILLER PIC X(69). 016800 05 FILLER REDEFINES WB-FILL. 016900 10 WB-12 PIC X(12). 017000 10 FILLER PIC X. 017100 10 WB-PROG PIC X(5). 017200 10 FILLER PIC X(62). 017300 05 FILLER REDEFINES WB-FILL. 017400 10 WB-13 PIC X(13). 017500 10 FILLER PIC X(67). 017600 05 FILLER REDEFINES WB-FILL. 017700 10 WB-14 PIC X(14). 017800 10 FILLER PIC X. 017900 10 WB-MODULE PIC XX. 018000 10 FILLER PIC X. 018100 10 WB-LEVEL PIC X. 018200 10 FILLER PIC X(61). 018300 05 FILLER REDEFINES WB-FILL. 018400 10 WB-15 PIC X(15). 018500 10 FILLER PIC X(65). 018600 05 FILLER REDEFINES WB-FILL. 018700 10 WB-16 PIC X(16). 018800 10 FILLER PIC X(64). 018900 05 WB-X-CARD REDEFINES WB-FILL. 019000 10 WB-X-HYPHEN PIC XX. 019100 10 WB-X-CARD-NUM PIC 9(3). 019200 10 WB-PROG-POS. 019300 15 WB-PROG-POS-NUM PIC 99. 019400 10 FILLER PIC X. 019500 10 WB-SUBS-TEXT PIC X(60). 019600 10 FILLER PIC X(12). 019700 05 WB-START-CARD REDEFINES WB-FILL. 019800 10 WB-STAR-START PIC X(6). 019900 10 FILLER PIC X. 020000 10 WB-UPDATE-PROG PIC X(6). 020100 10 FILLER PIC X. 020200 10 WB-RENUMBER PIC X. 020300 10 FILLER PIC X(65). 020400 05 WB-LINE-UPDATE REDEFINES WB-FILL. 020500 10 WB-SEQ-1 PIC X(6). 020600 10 WB-COBOL-LINE PIC X(74). 020700 10 FILLER REDEFINES WB-COBOL-LINE. 020800 15 WB-COL-7 PIC X. 020900 15 FILLER PIC X(73). 021000 10 FILLER REDEFINES WB-COBOL-LINE. 021100 15 WB-CHAR PIC X. 021200 15 WB-SEQ-2 PIC X(6). 021300/ 021400 01 WC-CURRENT-POP-RECORD. 021500 05 WC-1. 021600 10 WC-END-OF-POPFILE PIC X(16). 021700 10 FILLER PIC X(64). 021800 05 WC-HEADER REDEFINES WC-1. 021900 10 WC-STAR-HEADER PIC X(7). 022000 10 FILLER PIC X. 022100 10 WC-COBOL PIC X(5). 022200 10 FILLER PIC X. 022300 10 WC-PROG-ID. 022400 12 WC-PROG-ID-1-5. 022500 15 WC-PROG-ID-1-4. 022600 18 WC-MODULE PIC XX. 022700 18 WC-LEVEL PIC X. 022800 18 FILLER PIC X. 022900 15 FILLER PIC X. 023000 12 WC-PROG-ID-6 PIC X. 023100 10 FILLER PIC X. 023200 10 WC-SUBPRG PIC X(6). 023300 10 FILLER PIC X. 023400 10 WC-PROG2ID. 023500 12 WC-PROG2ID-1-5 PIC X(5). 023600 12 FILLER PIC X. 023700 10 FILLER PIC X(46). 023800 05 FILLER REDEFINES WC-1. 023900 10 WC-1-72. 024000 15 WC-6. 024100 20 WC-STAR PIC X. 024200 20 FILLER PIC X(5). 024300 15 FILLER REDEFINES WC-6. 024400 20 WC-1-5 PIC X(5). 024500 20 FILLER PIC X. 024600 15 WC-COL-7 PIC X. 024700 15 WC-COL-8 PIC X. 024800 15 FILLER PIC X(3). 024900 15 WC-SUB-DATA. 025000 20 WC-12-15 PIC X(4). 025100 20 FILLER PIC X. 025200 20 WC-17-19 PIC 9(3). 025300 20 WC-20 PIC X. 025400 20 FILLER PIC X(52). 025500 10 WC-73-80 PIC X(8). 025600 025700 01 WD-SOURCE-REC. 025800 05 WD-1. 025900 10 FILLER PIC X(6). 026000 10 WD-HEADER PIC X(74). 026100 026200 01 WE-PRINT-DATA. 026300 05 WE-COBOL-LINE PIC X(80). 026400 05 FILLER PIC X VALUE SPACE. 026500 05 WE-X-CARD PIC X(9). 026600 05 FILLER PIC XX VALUE SPACES. 026700 05 WE-CHANGE-TYPE PIC X(12). 026800 026900 01 WF-PROGRAM-SELECTED-TABLE. 027000 05 WF-PROGRAM-SELECTED PIC X(5) OCCURS 50. 027100 027200 01 WG-MODULE-SELECTED-TABLE. 027300 05 FILLER OCCURS 10. 027400 10 WG-MODULE-SELECTED PIC XX. 027500 10 WG-MODULE-LEVEL PIC X. 027600 027700 01 WV-PRINT-MISCELLANEOUS. 027800 05 WV-OPTION-HEADING PIC X(25) VALUE 027900 " OPTION SWITCH SETTINGS -". 028000 05 WV-OPT-1 PIC X(40) VALUE 028100 " 0 1 2". 028200 05 WV-OPT-2 PIC X(52) VALUE 028300 " 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6". 028400 05 WV-OPT-SWITCHES. 028500 10 FILLER PIC X VALUE SPACE. 028600 10 FILLER OCCURS 26. 028700 15 WV-OPT PIC X. 028800 15 FILLER PIC X. 028900 01 WX-X-CARD-TABLE. 029000 05 WX-X-CARD OCCURS 200. 029100 10 WX-X-CHAR PIC X 029200 OCCURS 60. 029300 01 WX-PROG-POS-TABLE. 029400 05 WX-PROG-POS OCCURS 200 029500 PIC 99. 029600 01 WY-SWITCHES. 029700 05 WY-OPTION-SWITCHES. 029800 10 WY-OPT-SW-1 PIC X. 029900 10 WY-OPT-SW-2 PIC X. 030000 10 WY-OPT-SW-3 PIC X. 030100 10 WY-OPT-SW-4 PIC X. 030200 10 WY-OPT-SW-5 PIC X. 030300 10 WY-OPT-SW-6 PIC X. 030400 10 WY-OPT-SW-7 PIC X. 030500 10 WY-OPT-SW-8 PIC X. 030600 10 WY-OPT-SW-9 PIC X. 030700 10 WY-OPT-SW-10 PIC X. 030800 10 WY-OPT-SW-11 PIC X. 030900 10 WY-OPT-SW-12 PIC X. 031000 10 WY-OPT-SW-13 PIC X. 031100 10 WY-OPT-SW-14 PIC X. 031200 10 WY-OPT-SW-15 PIC X. 031300 10 WY-OPT-SW-16 PIC X. 031400 10 WY-OPT-SW-17 PIC X. 031500 10 WY-OPT-SW-18 PIC X. 031600 10 WY-OPT-SW-19 PIC X. 031700 10 WY-OPT-SW-20 PIC X. 031800 10 WY-OPT-SW-21 PIC X. 031900 10 WY-OPT-SW-22 PIC X. 032000 10 WY-OPT-SW-23 PIC X. 032100 10 WY-OPT-SW-24 PIC X. 032200 10 WY-OPT-SW-25 PIC X. 032300 10 WY-OPT-SW-26 PIC X. 032400 05 FILLER REDEFINES WY-OPTION-SWITCHES. 032500 10 WY-OPT-SW PIC X 032600 OCCURS 26. 032700 05 WY-PRINT-SWITCHES. 032800 10 WY-EXTRACT-ALL PIC X. 032900 10 WY-EXTRACT-AUTO PIC X. 033000 10 WY-EXTRACT-MAN PIC X. 033100 10 WY-KILL-DELETIONS PIC X. 033200 10 WY-LIST-NO-UPDATES PIC X. 033300 10 WY-LIST-X-CARDS PIC X. 033400 10 WY-LIST-PROGRAMS PIC X. 033500 10 WY-LIST-COMPACT PIC X. 033600 10 WY-NO-DATA PIC X. 033700 10 WY-NO-LIBRARY PIC X. 033800 10 WY-NO-SOURCE PIC X. 033900 10 WY-REMOVE-COMMENTS PIC X. 034000 10 WY-NEW-POP PIC X. 034100 10 WY-SELECT-PROG PIC X. 034200 10 WY-SELECT-MODULE PIC X. 034300 10 WY-SELECT-LEVEL PIC X. 034400 034500 01 WZ-MISCELLANEOUS. 034600 05 WZ-PROGRAM-SELECTED PIC X. 034700 05 WZ-END-OF-POPFILE PIC X. 034800 05 WZ-FULL-STOP PIC X. 034900 05 WZ-DONT-READ-POPFILE PIC X. 035000 05 WZ-UPDATE-THIS-PROG PIC X. 035100 05 WZ-REPLACE-FLAG PIC X. 035200 05 WZ-LINE-UPDATE PIC X. 035300 05 WZ-RESEQUENCE-THIS PIC X. 035400 05 WZ-RESEQUENCE-NEXT PIC X. 035500 05 WZ-END-OF-UPDATES PIC X. 035600 05 WZ-OPTIONAL-SELECTED PIC X. 035700 05 WZ-DELETE-FLAG PIC X. 035800 05 WZ-NOT-THIS-COMMENT PIC X. 035900 05 WZ-CURRENT-HEADER PIC X(5). 036000 05 WZ-INVALID-DATA. 036100 10 FILLER PIC X(20). 036200 10 WZ-ERROR-MESSAGE PIC X(60). 036300 05 WZ-CURRENT-UPD-PROG. 036400 10 WZ-UPD-PROG-CHAR PIC X. 036500 10 FILLER PIC X(5). 036600 05 WZ-CURRENT-MAIN-PROG. 036700 10 WZ-MAIN-PROG-CHAR PIC X OCCURS 6. 036800 05 WZ-PROG-BREAK. 036900 10 WZ-1CHAR PIC X OCCURS 6. 037000 05 WZ-CURRENT-POP-PROG. 037100 10 FILLER PIC X(5). 037200 10 WZ-PROG-ID-6 PIC X. 037300 05 WZ-MAIN-PROG-FLAG PIC X. 037400 05 WZ-LINES-COBOL PIC 9(6). 037500 05 WZ-LINES-INSERTED PIC 9(6). 037600 05 WZ-LINES-REPLACED PIC 9(6). 037700 05 WZ-LINES-DELETED PIC 9(6). 037800 05 WZ-COMMENTS-DELETED PIC 9(6). 037900 05 WZ-CODE-REMOVED PIC 9(6). 038000 05 WZ-SOURCE-PROGS PIC 9(6). 038100 05 WZ-NEWPOP-PROGS PIC 9(6). 038200 05 WZ-PROGS-FOUND PIC 9(6). 038300 05 WZ-COMMENTS-DEL PIC 9(6). 038400 05 WZ-SEQ-NO PIC 9(6). 038500 05 WZ-SAVE-POP-RECORD. 038600 10 WZ-SAVE-SEQ PIC X(6). 038700 10 FILLER PIC X(5). 038800 10 WZ-SAVE-12-20. 038900 15 WZ-SAVE-12-15 PIC X(4). 039000 15 FILLER PIC X(5). 039100 10 FILLER PIC X(60). 039200 05 WZ-PAGE-CT PIC 9(6). 039300 05 WZ-LINE-CT PIC 9(6). 039400 05 WZ-MODULE PIC XX. 039500 05 WZ-LEVEL PIC X. 039600 05 WZ-PRINT-HOLD PIC X(132). 039700 05 WZ-X-CARD. 039800 10 WZ-X-CHAR PIC X 039900 OCCURS 60. 040000 05 WZ-WITHIN-DELETE-SERIES-FLAG PIC X. 040100 01 WZ-VERSION-CARD. 040200 10 FILLER PIC X(55) VALUE 040300 "CCVS85 VERSION 4.2 01 OCT 1992 0032 ". 040400 01 WZ-VERSION-CONTROL REDEFINES WZ-VERSION-CARD. 040500 10 FILLER PIC X(16). 040600 10 WZ-VERSION-NUM PIC X(3). 040700 10 FILLER PIC X(3). 040800 10 WZ-VERSION-DATE PIC X(11). 040900 041000/ 041100 PROCEDURE DIVISION. 041200*================== 041300* 041400 A10-MAIN SECTION. 041500*================ 041600* 041700**************************************************************** 041800* THIS IS THE HIGHEST LEVEL CONTROL MODULE * 041900* * 042000**************************************************************** 042100 A10-1-MAIN. 042200 PERFORM B10-INITIALISE. 042300 042400 PERFORM C10-PROCESS-MONITOR. 042500 042600 PERFORM D10-MERGE-UPDATE-CARDS. 042700 042800 PERFORM E10-TERMINATE. 042900 043000 A10-EXIT. 043100 EXIT. 043200 043300/ 043400 B10-INITIALISE SECTION. 043500*====================== 043600* 043700**************************************************************** 043800* THIS SECTION INITIALIZES THE OPTION SWITCH AND X-CARD FIELDS * 043900* PRIOR TO READING IN CONTROL CARD FILE. * 044000* * 044100* * 044200* * 044300* * 044400**************************************************************** 044500 B10-1-INIT-OPTION-SWITCHES. 044600 MOVE SPACES TO WZ-MISCELLANEOUS. 044700 MOVE SPACES TO WF-PROGRAM-SELECTED-TABLE. 044800 MOVE SPACES TO WG-MODULE-SELECTED-TABLE. 044900 MOVE SPACES TO WY-SWITCHES. 045000 MOVE "A" TO WY-OPT-SW-1. 045100 MOVE "E" TO WY-OPT-SW-2. 045200 MOVE "H" TO WY-OPT-SW-3. 045300 MOVE "L" TO WY-OPT-SW-4. 045400 MOVE "Y" TO WY-OPT-SW-7. 045500 MOVE "T" TO WY-OPT-SW-11. 045600 045700 B10-2-INIT-X-CARDS. 045800 MOVE ZERO TO SUB1. 045900 MOVE ZERO TO SUB6. 046000 MOVE ZERO TO SUB7. 046100 MOVE 1 TO SUB5. 046200 PERFORM B20-INIT-X-CARDS 200 TIMES. 046300 MOVE " OMITTED" TO WX-X-CARD (84). 046400 MOVE ZERO TO WZ-LINES-COBOL. 046500 MOVE ZERO TO WZ-LINES-INSERTED. 046600 MOVE ZERO TO WZ-LINES-REPLACED. 046700 MOVE ZERO TO WZ-LINES-DELETED. 046800 MOVE ZERO TO WZ-COMMENTS-DELETED. 046900 MOVE ZERO TO WZ-CODE-REMOVED. 047000 MOVE ZERO TO WZ-SOURCE-PROGS. 047100 MOVE ZERO TO WZ-NEWPOP-PROGS. 047200 MOVE ZERO TO WZ-PROGS-FOUND. 047300 MOVE ZERO TO WZ-COMMENTS-DEL. 047400 MOVE ZERO TO WZ-SEQ-NO. 047500 MOVE ZERO TO WZ-PAGE-CT. 047600 MOVE ZERO TO WZ-LINE-CT. 047700 ACCEPT WA-DATE FROM DATE. 047800 B10-EXIT. 047900 EXIT. 048000 048100 048200 048300 048400 B20-INIT-X-CARDS SECTION. 048500*======================== 048600 B20-1-INIT. 048700 ADD 1 TO SUB1. 048800 MOVE "**** X-CARD UNDEFINED ****" TO WX-X-CARD (SUB1). 048900 MOVE ZERO TO WX-PROG-POS (SUB1). 049000 049100 B20-EXIT. 049200 EXIT. 049300/ 049400 C10-PROCESS-MONITOR SECTION. 049500*=========================== 049600 049700**************************************************************** 049800* THIS SECTION PROCESSES THE RECORDS COMMENCING WITH "*" * 049900* AND "X-" (THE MONITOR PART OF THE INPUT FILE ) AND READS * 050000* THE FIRST "*START" UPDATE RECORD. * 050100* * 050200* PERFORMED BY A10-MAIN * 050300* PERFORMS C20-PROCESS-STAR-CARDS * 050400* C30-CHECK-COMBINATIONS * 050500* C40-PROCESS-X-CARDS * 050600**************************************************************** 050700 C10-1-OPEN-FILES. 050800 OPEN OUTPUT PRINT-FILE. 050900 MOVE SPACES TO PRINT-REC. 051000 OPEN INPUT CONTROL-CARD-FILE. 051100 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA 051200 AT END MOVE "CONTROL-CARD-FILE IS EMPTY" 051300 TO PRINT-DATA 051400 PERFORM X20-PRINT-DETAIL 051500 STOP RUN. 051600 PERFORM C20-PROCESS-STAR-CARDS 051700 UNTIL WB-X-HYPHEN = "X-". 051800 PERFORM C30-CHECK-COMBINATIONS. 051900 PERFORM C40-PROCESS-X-CARDS 052000 UNTIL WB-12 = "*END-MONITOR". 052100 052200 PERFORM C50-PRINT-OPTIONS. 052300 052400 C10-10-GET-FIRST-START-CARD. 052500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA 052600 AT END MOVE "NO BEGIN-UPDATE CARD FOUND" 052700 TO PRINT-DATA 052800 PERFORM X20-PRINT-DETAIL 052900 STOP RUN. 053000 IF WB-13 NOT = "*BEGIN-UPDATE" 053100 MOVE "*BEGIN-UPDATE CARD MISSING" 053200 TO PRINT-DATA 053300 PERFORM X20-PRINT-DETAIL 053400 STOP RUN. 053500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA 053600 AT END MOVE "NO END-UPDATE CARD FOUND" 053700 TO PRINT-DATA 053800 PERFORM X20-PRINT-DETAIL 053900 STOP RUN. 054000 IF WB-11 = "*END-UPDATE" 054100 MOVE "Y" TO WZ-END-OF-UPDATES 054200 GO TO C10-EXIT. 054300 IF WB-STAR-START = "*START" 054400 PERFORM C60-START-CARD. 054500 054600 C10-EXIT. 054700 EXIT. 054800/ 054900 C20-PROCESS-STAR-CARDS SECTION. 055000*============================== 055100* 055200**************************************************************** 055300* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * 055400* WHICH START WITH AN ASTERISK IN COLUMN 1 AND SETS VARIOUS * 055500* FLAGS WHICH CONTROL THE WAY THIS EXECUTIVE ROUTINE WORKS. * 055600* * 055700* PERFORMED BY C10-PROCESS-MONITOR * 055800* PERFORMS C25-SET-FLAGS * 055900**************************************************************** 056000 C20-1-UPDATE-CHECK. 056100 IF WB-13 = "*BEGIN-UPDATE" 056200 MOVE WB-13 TO WZ-INVALID-DATA 056300 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" 056400 TO WZ-ERROR-MESSAGE 056500 MOVE WZ-INVALID-DATA TO PRINT-DATA 056600 PERFORM X20-PRINT-DETAIL 056700 STOP RUN. 056800 056900 IF WB-6 = "*START" 057000 MOVE WB-6 TO WZ-INVALID-DATA 057100 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" 057200 TO WZ-ERROR-MESSAGE 057300 MOVE WZ-INVALID-DATA TO PRINT-DATA 057400 PERFORM X20-PRINT-DETAIL 057500 STOP RUN. 057600 057700 IF WB-11 = "*END-UPDATE" 057800 MOVE WB-11 TO WZ-INVALID-DATA 057900 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" 058000 TO WZ-ERROR-MESSAGE 058100 MOVE WZ-INVALID-DATA TO PRINT-DATA 058200 PERFORM X20-PRINT-DETAIL 058300 STOP RUN. 058400 058500 PERFORM C25-SET-FLAGS. 058600 058700 C20-EXIT. 058800 EXIT. 058900 059000/ 059100 C25-SET-FLAGS SECTION. 059200*===================== 059300 C25-1. 059400 MOVE WB-CONTROL-DATA TO PRINT-DATA. 059500 PERFORM X20-PRINT-DETAIL. 059600 IF WB-12 = "*EXTRACT-ALL" 059700 MOVE "Y" TO WY-EXTRACT-ALL. 059800 IF WB-13 = "*EXTRACT-AUTO" 059900 MOVE "Y" TO WY-EXTRACT-AUTO. 060000 IF WB-12 = "*EXTRACT-MAN" 060100 MOVE "Y" TO WY-EXTRACT-MAN. 060200 IF WB-15 = "*KILL-DELETIONS" 060300 MOVE "Y" TO WY-KILL-DELETIONS. 060400 IF WB-16 = "*LIST NO-UPDATES" 060500 MOVE "Y" TO WY-LIST-NO-UPDATES. 060600 IF WB-13 = "*LIST X-CARDS" 060700 MOVE "Y" TO WY-LIST-X-CARDS. 060800 IF WB-14 = "*LIST PROGRAMS" 060900 MOVE "Y" TO WY-LIST-PROGRAMS. 061000 IF WB-13 = "*LIST COMPACT" 061100 MOVE "Y" TO WY-LIST-COMPACT. 061200 IF WB-8 = "*NO-DATA" 061300 MOVE "Y" TO WY-NO-DATA. 061400 IF WB-11 = "*NO-LIBRARY" 061500 MOVE "Y" TO WY-NO-LIBRARY. 061600 IF WB-10 = "*NO-SOURCE" 061700 MOVE "Y" TO WY-NO-SOURCE. 061800 IF WB-16 = "*REMOVE-COMMENTS" 061900 MOVE "Y" TO WY-REMOVE-COMMENTS. 062000 IF WB-8 = "*NEW-POP" 062100 MOVE "Y" TO WY-NEW-POP. 062200 IF WB-4 = "*OPT" 062300 MOVE WB-X TO WY-OPT-SW (WB-NN). 062400 IF WB-14 = "*SELECT-MODULE" 062500 IF WB-MODULE = SPACE 062600 MOVE "SELECTED MODULE NOT SPECIFIED" 062700 TO PRINT-DATA 062800 PERFORM X20-PRINT-DETAIL 062900 STOP RUN. 063000 063100 IF WB-14 = "*SELECT-MODULE" 063200 ADD 1 TO SUB6 063300 IF SUB6 > 10 063400 MOVE "MORE THAN 10 MODULES SELECTED" 063500 TO PRINT-DATA 063600 PERFORM X20-PRINT-DETAIL 063700 STOP RUN 063800 ELSE 063900 MOVE "Y" TO WY-SELECT-MODULE 064000 MOVE WB-MODULE 064100 TO WG-MODULE-SELECTED (SUB6) 064200 MOVE WB-LEVEL TO WG-MODULE-LEVEL (SUB6). 064300 IF WB-12 = "*SELECT-PROG" 064400 ADD 1 TO SUB7 064500 IF SUB7 > 50 064600 MOVE "MORE THAN 50 RECORDS SELECTED" 064700 TO PRINT-DATA 064800 PERFORM X20-PRINT-DETAIL 064900 STOP RUN 065000 ELSE 065100 MOVE "Y" TO WY-SELECT-PROG 065200 MOVE WB-PROG 065300 TO WF-PROGRAM-SELECTED (SUB7). 065400 065500 C25-10-READ-FILE. 065600 MOVE SPACES TO WB-CONTROL-DATA. 065700 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA 065800 AT END MOVE "*END-MONITOR NOT ENCOUNTERED" 065900 TO PRINT-DATA 066000 PERFORM X20-PRINT-DETAIL 066100 STOP RUN. 066200 C25-EXIT. 066300 EXIT. 066400/ 066500 C30-CHECK-COMBINATIONS SECTION. 066600*============================== 066700* 066800**************************************************************** 066900* THIS SECTION CHECKS FOR ANY INVALID COMBINATIONS OF * 067000* CARDS INPUT WITH AN ASTERISK IN COLUMN 1. * 067100* * 067200* PERFORMED BY C10-PROCESS-MONITOR * 067300* PERFORMS NONE * 067400**************************************************************** 067500 C30-1-SELECTION-CHECK. 067600 IF WY-EXTRACT-ALL = SPACE 067700 GO TO C30-10. 067800 IF WY-EXTRACT-AUTO = "Y" 067900 MOVE "ALL AND AUTO PROGRAMS SELECTED" 068000 TO PRINT-DATA 068100 PERFORM X20-PRINT-DETAIL 068200 STOP RUN. 068300 068400 C30-10. 068500 IF WY-EXTRACT-ALL = SPACE 068600 GO TO C30-20. 068700 IF WY-EXTRACT-MAN = "Y" 068800 MOVE "ALL AND MANUAL PROGRAMS SELECTED" 068900 TO PRINT-DATA 069000 PERFORM X20-PRINT-DETAIL 069100 STOP RUN. 069200 069300 C30-20. 069400 IF WY-LIST-PROGRAMS = SPACE 069500 GO TO C30-30. 069600 IF WY-LIST-NO-UPDATES = SPACE 069700 MOVE "BOTH UPDATES AND PROGRAMS SELECTED" 069800 TO PRINT-DATA 069900 PERFORM X20-PRINT-DETAIL 070000 STOP RUN. 070100 070200 C30-30. 070300 IF WY-EXTRACT-AUTO = SPACE 070400 GO TO C30-40-CHECK-FOR-NEW-FILE. 070500 IF WY-EXTRACT-MAN = "Y" 070600 MOVE "AUTO AND MANUAL PROGRAMS SELECTED" 070700 TO PRINT-DATA 070800 PERFORM X20-PRINT-DETAIL 070900 STOP RUN. 071000 071100 C30-40-CHECK-FOR-NEW-FILE. 071200 IF WY-NO-SOURCE = SPACE 071300 GO TO C30-50. 071400 IF WY-NEW-POP = "Y" 071500 GO TO C30-50. 071600 MOVE "NO SOURCE OR UPDATED POPFILE SELECTED" TO PRINT-DATA. 071700 PERFORM X20-PRINT-DETAIL 071800 STOP RUN. 071900 072000 C30-50. 072100 IF WY-EXTRACT-ALL = "Y" 072200 GO TO C30-55. 072300 IF WY-EXTRACT-MAN = "Y" 072400 GO TO C30-55. 072500 IF WY-EXTRACT-AUTO = SPACE 072600 GO TO C30-60. 072700 C30-55. 072800 IF WY-SELECT-PROG = "Y" 072900 MOVE "SINGLE PROGRAM SELECTED WITH ALL/AUTO/MANUAL" 073000 TO PRINT-DATA 073100 PERFORM X20-PRINT-DETAIL 073200 STOP RUN. 073300 IF WY-SELECT-MODULE = "Y" 073400 MOVE "SINGLE MODULE SELECTED WITH ALL/AUTO/MANUAL" 073500 TO PRINT-DATA 073600 PERFORM X20-PRINT-DETAIL 073700 STOP RUN. 073800 073900 C30-60. 074000 IF WY-SELECT-PROG = SPACE 074100 GO TO C30-70. 074200 IF WY-SELECT-MODULE = "Y" 074300 MOVE "SINGLE MODULE AND SINGLE PROGRAM SELECTED" 074400 TO PRINT-DATA 074500 PERFORM X20-PRINT-DETAIL 074600 STOP RUN. 074700 074800 074900 C30-70. 075000 IF WY-EXTRACT-ALL = SPACE 075100 IF WY-EXTRACT-AUTO = SPACE 075200 IF WY-EXTRACT-MAN = SPACE 075300 IF WY-SELECT-PROG = SPACE 075400 IF WY-SELECT-MODULE = SPACE 075500 MOVE "NO PROGRAMS SELECTED" 075600 TO PRINT-DATA 075700 PERFORM X20-PRINT-DETAIL 075800 STOP RUN. 075900 076000 C30-EXIT. 076100 EXIT. 076200/ 076300 C40-PROCESS-X-CARDS SECTION. 076400*=========================== 076500* 076600**************************************************************** 076700* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * 076800* WHICH START WITH AN "X" IN COLUMN 1 AND SETS A TABLE WHICH* 076900* CONTAINS TEXT TO BE SUBSTITUTED BY THIS EXECUTIVE ROUTINE.* 077000* * 077100* PERFORMED BY C10-PROCESS-MONITOR * 077200* PERFORMS NONE * 077300**************************************************************** 077400 C40-1-PROCESS-CARD. 077500 IF WB-X-HYPHEN NOT = "X-" 077600 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA 077700 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE 077800 MOVE WZ-INVALID-DATA TO PRINT-DATA 077900 PERFORM X20-PRINT-DETAIL 078000 GO TO C40-90-READ-FILE. 078100 078200 IF WB-X-CARD-NUM > 200 078300 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA 078400 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE 078500 MOVE WZ-INVALID-DATA TO PRINT-DATA 078600 PERFORM X20-PRINT-DETAIL 078700 GO TO C40-90-READ-FILE. 078800 078900 C40-20-MOVE-DATA. 079000 MOVE WB-SUBS-TEXT TO WX-X-CARD (WB-X-CARD-NUM). 079100 IF WB-PROG-POS = SPACES 079200 GO TO C40-30-MOVE-DATA. 079300 IF WB-PROG-POS-NUM < 55 079400 MOVE WB-PROG-POS-NUM 079500 TO WX-PROG-POS (WB-X-CARD-NUM). 079600 079700 C40-30-MOVE-DATA. 079800 MOVE WB-CONTROL-DATA TO PRINT-DATA. 079900 PERFORM X20-PRINT-DETAIL. 080000 080100 C40-90-READ-FILE. 080200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA 080300 AT END MOVE 080400 "*BEGIN-UPDATE AND *END-UPDATE CARDS NOT ENCOUNTERED" 080500 TO PRINT-DATA 080600 PERFORM X20-PRINT-DETAIL 080700 STOP RUN. 080800 080900 C40-EXIT. 081000 EXIT. 081100 081200/ 081300 C50-PRINT-OPTIONS SECTION. 081400*========================= 081500* 081600**************************************************************** 081700* THIS SECTION PRINTS DETAILS OF THE PROCESSING OPTIONS * 081800* SELECTED BY THE VARIOUS CONTROL CARDS INPUT * 081900* * 082000* PERFORMED BY C10-PROCESS-MONITOR * 082100* PERFORMS NONE * 082200**************************************************************** 082300 C50-1-PRINT-OPTION-SWITCHES. 082400 WRITE PRINT-REC FROM WV-OPTION-HEADING AFTER PAGE. 082500 WRITE PRINT-REC FROM WV-OPT-1 AFTER 1. 082600 WRITE PRINT-REC FROM WV-OPT-2 AFTER 1. 082700 MOVE SPACES TO WV-OPT-SWITCHES. 082800 MOVE ZERO TO SUB1. 082900 PERFORM C50-4 26 TIMES. 083000 GO TO C50-5. 083100 C50-4. 083200* PERFORM 26 TIMES 083300 ADD 1 TO SUB1 083400 MOVE WY-OPT-SW (SUB1) TO WV-OPT (SUB1). 083500* END-PERFORM. 083600 C50-5. 083700 WRITE PRINT-REC FROM WV-OPT-SWITCHES AFTER 1. 083800 083900 C50-20-LISTING-OPTIONS. 084000 IF WY-LIST-NO-UPDATES = "Y" 084100 MOVE "UPDATES WILL NOT BE REPORTED" TO PRINT-DATA 084200 ELSE 084300 MOVE "UPDATES WILL BE REPORTED" TO PRINT-DATA. 084400 WRITE PRINT-REC AFTER 3. 084500 084600 IF WY-LIST-X-CARDS = "Y" 084700 MOVE "X-CARD SUBSTITUTIONS WILL BE SHOWN" 084800 TO PRINT-DATA 084900 ELSE 085000 MOVE "X-CARD SUBSTITUTIONS WILL NOT BE SHOWN" 085100 TO PRINT-DATA. 085200 WRITE PRINT-REC AFTER 1. 085300 085400 IF WY-LIST-PROGRAMS = "Y" 085500 MOVE "PROGRAM LISTINGS WILL BE PRINTED" 085600 TO PRINT-DATA 085700 ELSE 085800 MOVE "PROGRAM LISTINGS WILL NOT BE PRINTED" 085900 TO PRINT-DATA. 086000 WRITE PRINT-REC AFTER 1. 086100 086200 IF WY-LIST-COMPACT = "Y" 086300 MOVE "REPORT WILL BE COMPRESSED" TO PRINT-DATA 086400 ELSE 086500 MOVE "REPORT WILL BE EXPANDED" TO PRINT-DATA. 086600 WRITE PRINT-REC AFTER 1. 086700 086800 IF WY-NO-SOURCE = "Y" 086900 MOVE "SOURCE FILE WILL BE SUPPRESSED" TO PRINT-DATA 087000 ELSE 087100 MOVE "SOURCE FILE WILL BE CREATED" TO PRINT-DATA. 087200 WRITE PRINT-REC AFTER 1. 087300 087400 IF WY-NEW-POP = "Y" 087500 MOVE "NEW POPULATION FILE WILL BE CREATED" 087600 TO PRINT-DATA 087700 ELSE 087800 MOVE "NEW POPULATION FILE WILL BE SUPPRESSED" 087900 TO PRINT-DATA. 088000 WRITE PRINT-REC AFTER 1. 088100 088200 088300 C50-30. 088400 IF WY-NO-LIBRARY = "Y" 088500 MOVE "LIBRARY NOT SELECTED" 088600 TO PRINT-DATA 088700 ELSE 088800 MOVE "LIBRARY FILES WILL BE SELECTED" 088900 TO PRINT-DATA. 089000 WRITE PRINT-REC AFTER 1. 089100 089200 C50-35. 089300 IF WY-NO-DATA = "Y" 089400 MOVE "DATA BLOCKS WILL BE IGNORED" 089500 TO PRINT-DATA 089600 ELSE 089700 MOVE "DATA BLOCKS WILL BE SENT TO SOURCE FILE" 089800 TO PRINT-DATA. --> -------------------- --> maximum size reached --> -------------------- ¤ Dauer der Verarbeitung: 0.67 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
