Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 000100 IDENTIFICATION DIVISION. 00010000
- 000200 PROGRAM-ID. UT0650. 00020000
- 000300*AUTHOR. DAVE LENNARD. 00030000
- 000400*DATE-WRITTEN. OCTOBER 1974. 00040000
- 000500* 00050000
- 000600* VERSION UT06-A01 FOR COMP.LANG.COBOL TUE-21-OCT-2003. 00060000
- 000700 00070000
- 000800 ENVIRONMENT DIVISION. 00080000
- 000900 00090000
- 001000 CONFIGURATION SECTION. 00100000
- 001100 00110000
- 001200 SOURCE-COMPUTER. ICL-1904. 00120000
- 001300 OBJECT-COMPUTER. ICL-19O4. 00130000
- 001400* MEMORY 10000 WORDS. 00140000
- 001500 SPECIAL-NAMES. 00150000
- 001600* DATE IS EXEC-DATE. 00160000
- 001700 BIT-01 ON IS COMPILE-AGAIN. 00170000
- 001800 BIT-02 ON IS PRINT-PROGRAM. 00180000
- 001900 BIT-03 ON IS HALT-AFTER-COMPILE. 00190000
- 002000 00200000
- 002100 INPUT-OUTPUT SECTION. 00210000
- 002200 00220000
- 002300 FILE-CONTROL. 00230000
- 002400 SELECT IN-DA ASSIGN EDS 1 ACCESS SEQUENTIAL. 00240000
- 002500 SELECT OUT-DA ASSIGN EDS 2 ACCESS SEQUENTIAL. 00250000
- 002600 SELECT IN-MT ASSIGN TAPES 1 RESERVE 1. 00260000
- 002700 SELECT OUT-MT-2048 ASSIGN TAPES 2 RESERVE 1. 00270000
- 002800 SELECT OUT-MT-512 ASSIGN TAPES 2 RESERVE 1. 00280000
- 002900 SELECT OUT-MT-128 ASSIGN TAPES 2 RESERVE 1. 00290000
- 003000 SELECT OUT-MT-64 ASSIGN TAPES 2 RESERVE 1. 00300000
- 003100 SELECT CARD-FILE ASSIGN CARD-READER 1 RESERVE 1. 00310000
- 003200 00320000
- 003300 I-O-CONTROL. 00330000
- 003400 SAME RECORD AREA FOR IN-DA OUT-DA IN-MT 00340000
- 003500 OUT-MT-2048 OUT-MT-512 OUT-MT-128 OUT-MT-64. 00350000
- 003600 SAME AREA FOR IN-DA IN-MT. 00360000
- 003700 SAME AREA FOR OUT-DA 00370000
- 003800 OUT-MT-2048 OUT-MT-512 OUT-MT-128 OUT-MT-64. 00380000
- 003900 APPLY REPLY-WORD TO TRANSFER-REPLY ON IN-DA. 00390000
- 004000 APPLY REPLY-WORD TO TRANSFER-REPLY ON OUT-DA. 00400000
- 004100 00410000
- 004200 DATA DIVISION. 00420000
- 004300 00430000
- 004400 FILE SECTION. 00440000
- 004500 00450000
- 004600 FD IN-MT 00460000
- 004700 BLOCK CONTAINS 2400 CHARACTERS 00470000
- 004800 LABEL RECORDS STANDARD WITH GENERATION-NO 00480000
- 004900 VALUE OF ID IS IN-NAME 00490000
- 005000 GENERATION-NO IS IN-GEN. 00500000
- 005100 00510000
- 005200 01 IN-RECORD. 00520000
- 005300* NOTE THE SIZES OF THESE AREAS ARE ALSO DEFINED IN TABLE-SIZES 00530000
- 005400 03 RECORD-AREA. 00540000
- 005500 05 CHAR PIC X OCCURS 800. 00550000
- 005600 03 WORK-AREA. 00560000
- 005700 05 FILLER PIC X OCCURS 400. 00570000
- 005800 03 LITERAL-AREA. 00580000
- 005900 05 FILLER PIC X OCCURS 400. 00590000
- 006000 03 SCRATCH-PAD. 00600000
- 006100 05 SCR-WORD PIC S9(6) COMP SYNC RIGHT. 00610000
- 006200 05 FILLER PIC X(36). 00620000
- 006300 03 CARD-AREA PIC X(80). 00630000
- 006400 03 A510-AREA. 00640000
- 006500 05 A510-LINES-PAGE PIC S9(6) COMP SYNC RIGHT. 00650000
- 006600 05 A510-TOT-LINES PIC S9(6) COMP SYNC RIGHT. 00660000
- 006700 05 A510-LINES-THIS PIC S9(6) COMP SYNC RIGHT. 00670000
- 006800 05 A510-PAGE PIC S9(6) COMP SYNC RIGHT. 00680000
- 006900 05 A510-HEADS PIC S9(6) COMP SYNC RIGHT. 00690000
- 007000 05 A510-REPLY PIC S9(6) COMP SYNC RIGHT. 00700000
- 007100 05 A510-CONTROL PIC XXXX. 00710000
- 007200 03 PRINT-AREA. 00720000
- 007300 05 FILLER PIC X OCCURS 160. 00730000
- 007400 03 A510-HD1-CONTROL PIC X(4). 00740000
- 007500 03 HEAD-1. 00750000
- 007600 05 FILLER PIC X(50). 00760000
- 007700 05 HEAD-1-COM PIC X(60). 00770000
- 007800 05 FILLER PIC X(50). 00780000
- 007900 03 A510-HD2-CONTROL PIC X(4). 00790000
- 008000 03 HEAD-2. 00800000
- 008100 05 FILLER PIC X OCCURS 160. 00810000
- 008200 03 A510-HD3-CONTROL PIC X(4). 00820000
- 008300 03 HEAD-3. 00830000
- 008400 05 FILLER PIC X OCCURS 160. 00840000
- 008500 00850000
- 008600 01 FILLER. 00860000
- 008700 03 RECORD-WORD-COUNT PIC S9(6) COMP SYNC RIGHT. 00870000
- 008800 00880000
- 008900 01 FILLER. 00890000
- 009000 03 BINARY-WORD PIC S9(6) COMP SYNC RIGHT 00900000
- 009100 OCCURS 400. 00910000
- 009200 00920000
- 009300 01 M5DA-RECORD. 00930000
- 009400 03 FILLER PIC XXXX OCCURS 14. 00940000
- 009500 03 M5DA-INDEX-BITS PIC XXXX. 00950000
- 009600 00960000
- 009700 FD IN-DA 00970000
- 009800 BLOCK CONTAINS 2048 CHARACTERS 00980000
- 009900 LABEL RECORDS STANDARD WITH GENERATION-NO 00990000
- 010000 VALUE OF ID IS IN-NAME 01000000
- 010100 GENERATION-NO IS IN-GEN. 01010000
- 010200 01020000
- 010300 01 FILLER. 01030000
- 010400 03 FILLER PIC X OCCURS 800. 01040000
- 010500 01050000
- 010600 FD OUT-DA 01060000
- 010700 BLOCK CONTAINS 2048 CHARACTERS 01070000
- 010800 LABEL RECORDS STANDARD WITH GENERATION-NO 01080000
- 010900 VALUE OF ID IS OUT-NAME 01090000
- 011000 GENERATION-NO IS OUT-GEN. 01100000
- 011100 01110000
- 011200 01 OUT-DA-REC. 01120000
- 011300 03 FILLER PIC X OCCURS 800. 01130000
- 011400 01140000
- 011500 FD OUT-MT-2048 01150000
- 011600 BLOCK CONTAINS 2048 CHARACTERS 01160000
- 011700 LABEL RECORDS STANDARD WITH GENERATION-NO 01170000
- 011800 VALUE OF ID IS OUT-NAME 01180000
- 011900 ACTIVE-TIME IS 07 01190000
- 012000 GENERATION-NO IS OUT-GEN. 01200000
- 012100 01210000
- 012200 01 OUT-MT-2048-REC. 01220000
- 012300 03 FILLER PIC X OCCURS 800. 01230000
- 012400 01240000
- 012500 FD OUT-MT-512 01250000
- 012600 BLOCK CONTAINS 512 CHARACTERS 01260000
- 012700 LABEL RECORDS STANDARD WITH GENERATION-NO 01270000
- 012800 VALUE OF ID IS OUT-NAME 01280000
- 012900 ACTIVE-TIME IS 07 01290000
- 013000 GENERATION-NO IS OUT-GEN. 01300000
- 013100 01310000
- 013200 01 OUT-MT-512-REC. 01320000
- 013300 03 FILLER PIC X OCCURS 512. 01330000
- 013400 01340000
- 013500 FD OUT-MT-128 01350000
- 013600 BLOCK CONTAINS 128 CHARACTERS 01360000
- 013700 LABEL RECORDS STANDARD WITH GENERATION-NO 01370000
- 013800 VALUE OF ID IS OUT-NAME 01380000
- 013900 ACTIVE-TIME IS 07 01390000
- 014000 GENERATION-NO IS OUT-GEN. 01400000
- 014100 01410000
- 014200 01 OUT-MT-128-REC. 01420000
- 014300 03 FILLER PIC X OCCURS 128. 01430000
- 014400 01440000
- 014500 FD OUT-MT-64 01450000
- 014600 BLOCK CONTAINS 64 CHARACTERS 01460000
- 014700 LABEL RECORDS STANDARD WITH GENERATION-NO 01470000
- 014800 VALUE OF ID IS OUT-NAME 01480000
- 014900 ACTIVE-TIME IS 07 01490000
- 015000 GENERATION-NO IS OUT-GEN. 01500000
- 015100 01510000
- 015200 01 OUT-MT-64-REC. 01520000
- 015300 03 FILLER PIC X OCCURS 64. 01530000
- 015400 01540000
- 015500 FD CARD-FILE. 01550000
- 015600 01560000
- 015700 01 CARD-RECORD. 01570000
- 015800 03 CARD-CHAR PIC X OCCURS 80. 01580000
- 015900 01590000
- 016000 WORKING-STORAGE SECTION. 01600000
- 016100 01610000
- 016200 01 PRINT-LINE. 01620000
- 016300 03 FILLER PIC X(8). 01630000
- 016400 03 LIST-CARD. 01640000
- 016500 05 LIST-CHAR PIC X OCCURS 80. 01650000
- 016600 03 FILLER PIC X(4). 01660000
- 016700 03 LIST-COMMENT PIC X(20). 01670000
- 016800 03 LIST-NAME PIC X(16). 01680000
- 016900 03 LIST-DATE PIC X(80). 01690000
- 017000 03 FILLER PIC X(24). 01700000
- 017100 01710000
- 017200 01 FILLER REDEFINES PRINT-LINE. 01720000
- 017300 03 FILLER PIC X(8). 01730000
- 017400 03 LIST-CELL PIC Z(6). 01740000
- 017500 03 FILLER PIC XXXX. 01750000
- 017600 03 LIST-LABEL. 01760000
- 017700 05 FILLER PIC XXXX. 01770000
- 017800 05 LIST-TYPE PIC X(12). 01780000
- 017900 03 LIST-LOC1 PIC Z(6). 01790000
- 018000 03 LIST-LOC2 PIC Z(6). 01800000
- 018100 03 LIST-NUM PIC Z(6). 01810000
- 018200 03 LIST-EXIT PIC Z(6). 01820000
- 018300 01830000
- 018400 01 HOUSEKEEPING. 01840000
- 018500 03 REPLY-WORD PIC S9(6) COMP SYNC RIGHT. 01850000
- 018600 01860000
- 018700 01 WORK-FIELDS. 01870000
- 018800 03 WORK-2-BITS PIC 11 SYNC RIGHT. 01880000
- 018900 03 WORK-CHAR PIC X. 01890000
- 019000 03 NUM-FIELD-X. 01900000
- 019100 05 NUM-CHAR PIC X OCCURS 6. 01910000
- 019200 03 NUM-FIELD REDEFINES NUM-FIELD-X PIC 9(6). 01920000
- 019300 01930000
- 019400 01 WORD-AREA. 01940000
- 019500 03 WORD-CHAR PIC X OCCURS 80. 01950000
- 019600 01960000
- 019700 01 FILLER REDEFINES WORD-AREA. 01970000
- 019800 03 WORD-16-CHAR. 01980000
- 019900 05 WORD-2-CHAR PIC XX. 01990000
- 020000 05 FILLER PIC X(14). 02000000
- 020100 03 FILLER PIC X(64). 02010000
- 020200 02020000
- 020300 01 FLAGS COMP. 02030000
- 020400 03 END-WORDS-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02040000
- 020500 03 END-CARDS-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02050000
- 020600 03 END-FILE-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02060000
- 020700 03 OUT-MT-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02070000
- 020800 03 END-CHAR-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02080000
- 020900 03 ERROR-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02090000
- 021000 03 QUOTE-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02100000
- 021100 03 LABEL-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02110000
- 021200 03 COMPILE-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02120000
- 021300 03 FULL-STOP-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02130000
- 021400 03 LOC-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02140000
- 021500 03 AND-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02150000
- 021600 03 OR-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02160000
- 021700 03 NOT-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02170000
- 021800 03 LOC-QUOTE-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02180000
- 021900 03 CHAR-AREA-FLAG PIC S9(6) SYNC RIGHT VALUE ZERO. 02190000
- 022000 02200000
- 022100 01 POINTERS COMP. 02210000
- 022200 03 CELL-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02220000
- 022300 03 WORD-CHAR-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02230000
- 022400 03 DATA-CHAR-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02240000
- 022500 03 LITERAL-CHAR-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02250000
- 022600 03 FIRST-CHAR-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02260000
- 022700 03 CARD-CHAR-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02270000
- 022800 03 NEED-EXIT-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02280000
- 022900 03 NUM-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02290000
- 023000 03 LOC-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02300000
- 023100 03 AUG-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02310000
- 023200 03 POYNT PIC S9(6) SYNC RIGHT VALUE ZERO. 02320000
- 023300 03 FILE-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02330000
- 023400 03 IN-FILE-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02340000
- 023500 03 OUT-FILE-POINT PIC S9(6) SYNC RIGHT VALUE ZERO. 02350000
- 023600 02360000
- 023700 01 TOTALS COMP. 02370000
- 023800 03 RECS-IN PIC S9(6) SYNC RIGHT VALUE ZERO. 02380000
- 023900 03 RECS-OUT PIC S9(6) SYNC RIGHT VALUE ZERO. 02390000
- 024000 02400000
- 024100 01 COMPILE-TOTALS COMP. 02410000
- 024200 03 TOTAL-CELLS PIC S9(6) SYNC RIGHT VALUE ZERO. 02420000
- 024300 02430000
- 024400 01 NUMERIC-WORK-AREAS. 02440000
- 024500 03 LOC-LENGTH PIC S9(6) COMP SYNC RIGHT. 02450000
- 024600 03 NUMBER-X4. 02460000
- 024700 05 NUMBER PIC S9(6) COMP SYNC RIGHT. 02470000
- 024800 02480000
- 024900 01 TABLE-SIZES COMP. 02490000
- 025000 03 RECORD-CHARS PIC S9(6) SYNC RIGHT VALUE 800. 02500000
- 025100 03 WORK-CHARS PIC S9(6) SYNC RIGHT VALUE 400. 02510000
- 025200 03 LITERAL-CHARS PIC S9(6) SYNC RIGHT VALUE 400. 02520000
- 025300 03 NO-OF-CELLS PIC S9(6) SYNC RIGHT VALUE 200. 02530000
- 025400 02540000
- 025500 01 AREA-START-LOCATIONS COMP. 02550000
- 025600 03 WORK-AREA-START PIC S9(6) SYNC RIGHT VALUE 800. 02560000
- 025700 03 LITERAL-AREA-START PIC S9(6) SYNC RIGHT VALUE 1200. 02570000
- 025800 03 LITERAL-AREA-END PIC S9(6) SYNC RIGHT VALUE 1600. 02580000
- 025900 03 CARD-AREA-START PIC S9(6) SYNC RIGHT VALUE 1640. 02590000
- 026000 03 A510-AREA-START PIC S9(6) SYNC RIGHT VALUE 1720. 02600000
- 026100 03 PRINT-AREA-START PIC S9(6) SYNC RIGHT VALUE 1748. 02610000
- 026200 03 H-HEAD-AREA-START PIC S9(6) SYNC RIGHT VALUE 1912. 02620000
- 026300 03 I-HEAD-AREA-START PIC S9(6) SYNC RIGHT VALUE 2076. 02630000
- 026400 03 J-HEAD-AREA-START PIC S9(6) SYNC RIGHT VALUE 2240. 02640000
- 026500 02650000
- 026600 01 ONE-WORD-MOVE COMP. 02660000
- 026700 03 ONE-LOC PIC S9(6) SYNC RIGHT. 02670000
- 026800 03 ONE-SCR-LOC PIC S9(6) SYNC RIGHT VALUE 1601. 02680000
- 026900 03 ONE-LENGTH PIC S9(6) SYNC RIGHT VALUE 4. 02690000
- 027000 02700000
- 027100 01 INSTRUCTION-POINTERS. 02710000
- 027200 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 1. 02720000
- 027300 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 2. 02730000
- 027400 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 3. 02740000
- 027500 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 4. 02750000
- 027600 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 5. 02760000
- 027700 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 6. 02770000
- 027800 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 7. 02780000
- 027900 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 8. 02790000
- 028000 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 9. 02800000
- 028100 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 10. 02810000
- 028200 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 11. 02820000
- 028300 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 12. 02830000
- 028400 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 13. 02840000
- 028500 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 14. 02850000
- 028600 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 15. 02860000
- 028700 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 16. 02870000
- 028800 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 17. 02880000
- 028900 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 18. 02890000
- 029000 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 19. 02900000
- 029100 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 20. 02910000
- 029200 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 21. 02920000
- 029300 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 22. 02930000
- 029400 03 FILLER PIC S9(6) COMP SYNC RIGHT VALUE 23. 02940000
- 029500 02950000
- 029600 01 FILLER REDEFINES INSTRUCTION-POINTERS. 02960000
- 029700* NOTE: KEEP INSTRUCTIONS IN THE SAME ORDER EVERYWHERE 02970000
- 029800 03 TYPE-ADD PIC S9(6) COMP SYNC RIGHT. 02980000
- 029900 03 TYPE-AUGMENT PIC S9(6) COMP SYNC RIGHT. 02990000
- 030000 03 TYPE-CALL PIC S9(6) COMP SYNC RIGHT. 03000000
- 030100 03 TYPE-DIVIDE PIC S9(6) COMP SYNC RIGHT. 03010000
- 030200 03 TYPE-EXIT PIC S9(6) COMP SYNC RIGHT. 03020000
- 030300 03 TYPE-GO PIC S9(6) COMP SYNC RIGHT. 03030000
- 030400 03 TYPE-IF-EQUAL-CHARS PIC S9(6) COMP SYNC RIGHT. 03040000
- 030500 03 TYPE-IF-NOT-EQUAL-CHARS PIC S9(6) COMP SYNC RIGHT. 03050000
- 030600 03 TYPE-IF-GREAT-CHARS PIC S9(6) COMP SYNC RIGHT. 03060000
- 030700 03 TYPE-IF-NOT-GREAT-CHARS PIC S9(6) COMP SYNC RIGHT. 03070000
- 030800 03 TYPE-IF-LESS-CHARS PIC S9(6) COMP SYNC RIGHT. 03080000
- 030900 03 TYPE-IF-NOT-LESS-CHARS PIC S9(6) COMP SYNC RIGHT. 03090000
- 031000 03 TYPE-LABEL PIC S9(6) COMP SYNC RIGHT. 03100000
- 031100 03 TYPE-MOVE-1B-D PIC S9(6) COMP SYNC RIGHT. 03110000
- 031200 03 TYPE-MOVE-CHARS PIC S9(6) COMP SYNC RIGHT. 03120000
- 031300 03 TYPE-MOVE-D-1B PIC S9(6) COMP SYNC RIGHT. 03130000
- 031400 03 TYPE-MULTIPLY PIC S9(6) COMP SYNC RIGHT. 03140000
- 031500 03 TYPE-PERFORM PIC S9(6) COMP SYNC RIGHT. 03150000
- 031600 03 TYPE-PRINT PIC S9(6) COMP SYNC RIGHT. 03160000
- 031700 03 TYPE-READ PIC S9(6) COMP SYNC RIGHT. 03170000
- 031800 03 TYPE-STOP PIC S9(6) COMP SYNC RIGHT. 03180000
- 031900 03 TYPE-SUBTRACT PIC S9(6) COMP SYNC RIGHT. 03190000
- 032000 03 TYPE-WRITE PIC S9(6) COMP SYNC RIGHT. 03200000
- 032100 03210000
- 032200 01 INSTRUCTION-NAMES. 03220000
- 032300 03 FILLER PIC X(8) VALUE "ADD". 03230000
- 032400 03 FILLER PIC X(8) VALUE "AUGMENT". 03240000
- 032500 03 FILLER PIC X(8) VALUE "CALL". 03250000
- 032600 03 FILLER PIC X(8) VALUE "DIVIDE". 03260000
- 032700 03 FILLER PIC X(8) VALUE "EXIT". 03270000
- 032800 03 FILLER PIC X(8) VALUE "GO TO". 03280000
- 032900 03 FILLER PIC X(8) VALUE "IF =". 03290000
- 033000 03 FILLER PIC X(8) VALUE "IF NOT =". 03300000
- 033100 03 FILLER PIC X(8) VALUE "IF >". 03310000
- 033200 03 FILLER PIC X(8) VALUE "IF NOT >". 03320000
- 033300 03 FILLER PIC X(8) VALUE "IF <". 03330000
- 033400 03 FILLER PIC X(8) VALUE "IF NOT <". 03340000
- 033500 03 FILLER PIC X(8) VALUE "LABEL". 03350000
- 033600 03 FILLER PIC X(8) VALUE "MOVE B-D". 03360000
- 033700 03 FILLER PIC X(8) VALUE "MOVE TO". 03370000
- 033800 03 FILLER PIC X(8) VALUE "MOVE D-B". 03380000
- 033900 03 FILLER PIC X(8) VALUE "MULTIPLY". 03390000
- 034000 03 FILLER PIC X(8) VALUE "PERFORM". 03400000
- 034100 03 FILLER PIC X(8) VALUE "PRINT". 03410000
- 034200 03 FILLER PIC X(8) VALUE "READ". 03420000
- 034300 03 FILLER PIC X(8) VALUE "STOP". 03430000
- 034400 03 FILLER PIC X(8) VALUE "SUBTRACT". 03440000
- 034500 03 FILLER PIC X(8) VALUE "WRITE". 03450000
- 034600 03460000
- 034700 01 FILLER REDEFINES INSTRUCTION-NAMES. 03470000
- 034800 03 INSTRUCTION-NAME PIC X(8) OCCURS 23. 03480000
- 034900 03490000
- 035000 01 SUBROUTINE-TYPES COMP. 03500000
- 035100 03 SUBR-M5DAEXPAND PIC S9(6) SYNC RIGHT VALUE 1. 03510000
- 035200* NOTE: ANY DESIRED SOUBROUTINES CAN BE INCLUDED HERE 03520000
- 035300* ALSO INCLUDE CODE TO TEST FOR AND RUN THE SUBROUTINE 03530000
- 035400 03540000
- 035500 01 CARD-PRINTER-STATUS. 03550000
- 035600 03 CARD-PRINTER-FLAG PIC S9(6) SYNC RIGHT VALUE 0. 03560000
- 035700 03570000
- 035800 01 FILE-OPEN-MODES COMP. 03580000
- 035900 03 OPEN-INPUT PIC S9(6) SYNC RIGHT VALUE 1. 03590000
- 036000 03 OPEN-OUTPUT PIC S9(6) SYNC RIGHT VALUE 2. 03600000
- 036100 03610000
- 036200 01 FILE-TYPES COMP. 03620000
- 036300 03 INPUT-DA PIC S9(6) SYNC RIGHT VALUE 1. 03630000
- 036400 03 OUTPUT-DA PIC S9(6) SYNC RIGHT VALUE 2. 03640000
- 036500 03 FILE-TYPE-DA PIC S9(6) SYNC RIGHT VALUE 3. 03650000
- 036600 03 INPUT-MT PIC S9(6) SYNC RIGHT VALUE 4. 03660000
- 036700 03 OUTPUT-MT-2048 PIC S9(6) SYNC RIGHT VALUE 5. 03670000
- 036800 03 OUTPUT-MT-1024 PIC S9(6) SYNC RIGHT VALUE 6. 03680000
- 036900 03 OUTPUT-MT-512 PIC S9(6) SYNC RIGHT VALUE 7. 03690000
- 037000 03 OUTPUT-MT-128 PIC S9(6) SYNC RIGHT VALUE 8. 03700000
- 037100 03 OUTPUT-MT-64 PIC S9(6) SYNC RIGHT VALUE 9. 03710000
- 037200 03720000
- 037300 01 FILE-TABLE-SIZE PIC S9(6) COMP SYNC RIGHT VALUE 15. 03730000
- 037400 03740000
- 037500 01 FILE-DATA-TABLE. 03750000
- 037600 03 FILE-DATA OCCURS 15. 03760000
- 037700 05 FTAB-NAME PIC X(12). 03770000
- 037800 05 FTAB-GEN PIC S9(6) COMP SYNC RIGHT. 03780000
- 037900 05 FTAB-BLOCK PIC S9(6) COMP SYNC RIGHT. 03790000
- 038000 05 FTAB-FILE-NO PIC S9(6) COMP SYNC RIGHT. 03800000
- 038100 05 FTAB-TYPE PIC S9(6) COMP SYNC RIGHT. 03810000
- 038200 05 FTAB-MODE PIC S9(6) COMP SYNC RIGHT. 03820000
- 038300 03830000
- 038400 01 FILE-STATUS-TABLE. 03840000
- 038500 03 FILE-STATUS-FLAG PIC S9(6) COMP SYNC RIGHT OCCURS 15. 03850000
- 038600 03860000
- 038700 01 WORK-FILE-DATA. 03870000
- 038800 03 WORK-NAME PIC X(12). 03880000
- 038900 03 WORK-GEN PIC S9(6) COMP SYNC RIGHT. 03890000
- 039000 03 WORK-BLOCK PIC S9(6) COMP SYNC RIGHT. 03900000
- 039100 03 WORK-FILE-NO PIC S9(6) COMP SYNC RIGHT. 03910000
- 039200 03 WORK-TYPE PIC S9(6) COMP SYNC RIGHT. 03920000
- 039300 03 WORK-MODE PIC S9(6) COMP SYNC RIGHT. 03930000
- 039400 03940000
- 039500 01 FILE-WORKING. 03950000
- 039600 03 WORK-MEDIUM PIC XX. 03960000
- 039700 03 FILLER PIC XX. 03970000
- 039800 03 MODE-REQUIRED PIC S9(6) COMP SYNC RIGHT. 03980000
- 039900 01 IN-FILE-DATA. 03990000
- 040000 03 IN-NAME PIC X(12). 04000000
- 040100 03 IN-GEN PIC S9(6) COMP SYNC RIGHT. 04010000
- 040200 03 IN-BLOCK PIC S9(6) COMP SYNC RIGHT. 04020000
- 040300 03 IN-FILE-NO PIC S9(6) COMP SYNC RIGHT. 04030000
- 040400 03 IN-TYPE PIC S9(6) COMP SYNC RIGHT. 04040000
- 040500 03 IN-MODE PIC S9(6) COMP SYNC RIGHT. 04050000
- 040600 04060000
- 040700 01 OUT-FILE-DATA. 04070000
- 040800 03 OUT-NAME PIC X(12). 04080000
- 040900 03 OUT-GEN PIC S9(6) COMP SYNC RIGHT. 04090000
- 041000 03 OUT-BLOCK PIC S9(6) COMP SYNC RIGHT. 04100000
- 041100 03 OUT-FILE-NO PIC S9(6) COMP SYNC RIGHT. 04110000
- 041200 03 OUT-TYPE PIC S9(6) COMP SYNC RIGHT. 04120000
- 041300 03 OUT-MODE PIC S9(6) COMP SYNC RIGHT. 04130000
- 041400 04140000
- 041500 01 CELL. 04150000
- 041600* NOTE: AN INSTRUCTION AND PARAMETERS ARE STORED HERE WHILE BEING 04160000
- 041700* GENERATED OR EXECUTED 04170000
- 041800 03 CELL-TYPE PIC S9(6) COMP SYNC RIGHT. 04180000
- 041900 03 CELL-LABEL. 04190000
- 042000 05 CELL-LOC1 PIC S9(6) COMP SYNC RIGHT. 04200000
- 042100 05 CELL-LOC2 PIC S9(6) COMP SYNC RIGHT. 04210000
- 042200 05 CELL-NUM PIC S9(6) COMP SYNC RIGHT. 04220000
- 042300 05 CELL-EXIT PIC S9(6) COMP SYNC RIGHT. 04230000
- 042400 03 FILLER REDEFINES CELL-LABEL. 04240000
- 042500 05 CELL-WORD PIC S9(6) COMP SYNC RIGHT OCCURS 4. 04250000
- 042600 04260000
- 042700 01 AUG-STORE. 04270000
- 042800 03 AUG-WORD PIC S9(6) COMP SYNC RIGHT OCCURS 4. 04280000
- 042900 04290000
- 043000 01 CELL-TABLE. 04300000
- 043100 03 CELL-STORE OCCURS 200. 04310000
- 043200 05 CELL-STORE-TYPE PIC S9(6) COMP SYNC RIGHT. 04320000
- 043300 05 CELL-STORE-LABEL. 04330000
- 043400 07 CELL-STORE-LOC1 PIC S9(6) COMP SYNC RIGHT. 04340000
- 043500 07 CELL-STORE-LOC2 PIC S9(6) COMP SYNC RIGHT. 04350000
- 043600 07 CELL-STORE-NUM PIC S9(6) COMP SYNC RIGHT. 04360000
- 043700 07 CELL-STORE-EXIT PIC S9(6) COMP SYNC RIGHT. 04370000
- 043800 03 FILLER PIC XXXX VALUE ZERO. 04380000
- 043900 04390000
- 044000 PROCEDURE DIVISION. 04400000
- 044100 04410000
- 044200 COMPILE SECTION. 04420000
- 044300 04430000
- 044400 TEST-IF-COMPILED. 04440000
- 044500 PERFORM OPEN-CARD-PRINTER. 04450000
- 044600 IF PRINT-PROGRAM 04460000
- 044700 MOVE 100 TO A510-LINES-THIS 04470000
- 044800 GO TO PRINT-CELLS. 04480000
- 044900 IF COMPILE-AGAIN 04490000
- 045000 GO TO PRINT-HEADINGS. 04500000
- 045100 IF COMPILE-FLAG = 1 04510000
- 045200 GO TO RUN-GENERATED-PROGRAM. 04520000
- 045300 04530000
- 045400 PRINT-HEADINGS. 04540000
- 045500 MOVE "#UT06/4A PROGRAM GENERATOR" 04550000
- 045600 TO PRINT-LINE. 04560000
- 045700 ACCEPT LIST-DATE FROM EXEC-DATE. 04570000
- 045800 MOVE ZERO TO FLAGS POINTERS IN-RECORD 04580000
- 045900 FILE-DATA-TABLE FILE-STATUS-TABLE 04590000
- 046000 CELL-TABLE CELL. 04600000
- 046100 MOVE SPACES TO LITERAL-AREA. 04610000
- 046200 MOVE 100 TO CARD-CHAR-POINT. 04620000
- 046300 ADD 1 LITERAL-AREA-START GIVING LITERAL-CHAR-POINT. 04630000
- 046400 MOVE PRINT-LINE TO HEAD-1. 04640000
- 046500 MOVE SPACES TO HEAD-2 HEAD-3. 04650000
- 046600 MOVE SPACES TO PRINT-LINE. 04660000
- 046700 MOVE 56 TO A510-LINES-PAGE. 04670000
- 046800 MOVE 100 TO A510-LINES-THIS. 04680000
- 046900 MOVE 3 TO A510-HEADS. 04690000
- 047000 MOVE "HEAD" TO A510-HD1-CONTROL. 04700000
- 047100 MOVE "SP 2" TO A510-HD2-CONTROL. 04710000
- 047200 MOVE "SP 1" TO A510-HD3-CONTROL. 04720000
- 047300 MOVE "SP 1" TO A510-CONTROL. 04730000
- 047400 MOVE "LISTING OF SOURCE CARDS:" TO LIST-CARD. 04740000
- 047500 PERFORM PRINT 2 TIMES. 04750000
- 047600 MOVE 1 TO CELL-POINT. 04760000
- 047700 04770000
- 047800 NEXT-WORD. 04780000
- 047900 PERFORM READAWORD. 04790000
- 048000 04800000
- 048100 CHECK-WORD. 04810000
- 048200 MOVE ZERO TO CELL. 04820000
- 048300 IF END-WORDS-FLAG = 1 04830000
- 048400 PERFORM CREATE-RETURN-CELL 04840000
- 048500 SUBTRACT 1 FROM CELL-POINT GIVING TOTAL-CELLS 04850000
- 048600 GO TO CHECK-LABELS. 04860000
- 048700 IF QUOTE-FLAG = 1 04870000
- 048800 PERFORM PRINT-ERROR 04880000
- 048900 GO TO NEXT-WORD. 04890000
- 049000 IF WORD-2-CHAR = "AD" GO TO COMPILE-ADD. 04900000
- 049100 IF WORD-2-CHAR = "AU" GO TO COMPILE-AUGMENT. 04910000
- 049200 IF WORD-2-CHAR = "CA" GO TO COMPILE-CALL. 04920000
- 049300 IF WORD-2-CHAR = "DI" GO TO COMPILE-DIVIDE. 04930000
- 049400 IF WORD-2-CHAR = "EL" GO TO COMPILE-ELSE. 04940000
- 049500 IF WORD-2-CHAR = "GO" GO TO COMPILE-GO. 04950000
- 049600 IF WORD-2-CHAR = "IF" GO TO COMPILE-IF. 04960000
- 049700 IF WORD-2-CHAR = "IN" GO TO COMPILE-IN. 04970000
- 049800 IF WORD-2-CHAR = "MO" GO TO COMPILE-MOVE. 04980000
- 049900 IF WORD-2-CHAR = "MU" GO TO COMPILE-MULTIPLY. 04990000
- 050000 IF WORD-2-CHAR = "OU" GO TO COMPILE-OUT. 05000000
- 050100 IF WORD-2-CHAR = "PE" GO TO COMPILE-PERFORM. 05010000
- 050200 IF WORD-2-CHAR = "PR" GO TO COMPILE-PRINT. 05020000
- 050300 IF WORD-2-CHAR = "RE" GO TO COMPILE-READ. 05030000
- 050400 IF WORD-2-CHAR = "ST" GO TO COMPILE-STOP. 05040000
- 050500 IF WORD-2-CHAR = "SU" GO TO COMPILE-SUBTRACT. 05050000
- 050600 IF WORD-2-CHAR = "WR" GO TO COMPILE-WRITE. 05060000
- 050700 IF WORD-2-CHAR = "**" 05070000
- 050800 MOVE 1 TO END-WORDS-FLAG 05080000
- 050900 GO TO CHECK-WORD. 05090000
- 051000 05100000
- 051100 COMPILE-LABEL. 05110000
- 051200 IF WORD-CHAR (1) NOT NUMERIC 05120000
- 051300 GO TO PRINT-ERROR. 05130000
- 051400 PERFORM CREATE-RETURN-CELL. 05140000
- 051500 MOVE 1 TO LABEL-FLAG. 05150000
- 051600 MOVE TYPE-LABEL TO CELL-TYPE. 05160000
- 051700 MOVE WORD-16-CHAR TO CELL-LABEL. 05170000
- 051800 PERFORM STORE-CELL. 05180000
- 051900 GO TO NEXT-WORD. 05190000
- 052000 05200000
- 052100 COMPILE-ADD. 05210000
- 052200 MOVE TYPE-ADD TO CELL-TYPE. 05220000
- 052300 GO TO COMPILE-ARITHMETIC. 05230000
- 052400 05240000
- 052500 COMPILE-ARITHMETIC. 05250000
- 052600 PERFORM READAWORD. 05260000
- 052700 PERFORM CONVERT-LOCATION. 05270000
- 052800 PERFORM LOC-TO-BINARY THRU LTB-EXIT. 05280000
- 052900 MOVE LOC-POINT TO CELL-LOC1. 05290000
- 053000 MOVE LOC-LENGTH TO CELL-NUM. 05300000
- 053100 PERFORM READAWORD. 05310000
- 053200 IF WORD-2-CHAR = "TO" OR "FR" OR "BY" OR "IN" 05320000
- 053300 PERFORM READAWORD. 05330000
- 053400 PERFORM CONVERT-LOCATION. 05340000
- 053500 PERFORM LOC-TO-BINARY THRU LTB-EXIT. 05350000
- 053600 MOVE LOC-POINT TO CELL-LOC2. 05360000
- 053700 MOVE LOC-LENGTH TO CELL-EXIT. 05370000
- 053800 IF CELL-NUM = -4 AND CELL-EXIT = -4 05380000
- 053900 PERFORM STORE-CELL 05390000
- 054000 GO TO NEXT-WORD. 05400000
- 054100 05410000
- 054200* IT LOOKS AS IF ARITHMETIC ONLY ON 1 WORD FIELDS IS ALLOWABLE 05420000
- 054300* WITH UT06/4A. I HAVE LOTS OF PENCILLED AMENDMENTS THAT ALLOW 05430000
- 054400* OTHER SIZE FIELDS 05440000
- 054500 05450000
- 054600 PERFORM PRINT-ERROR. 05460000
- 054700 GO TO NEXT-WORD. 05470000
- 054800 05480000
- 054900 COMPILE-AUGMENT. 05490000
- 055000* THIS IS A TEMPORARY INSTRUCTION THAT ALLOWS MODIFICATION OF 05500000
- 055100* THE NEXT INSTRUCTION'S PARAMETERS 05510000
- 055200 05520000
- 055300 MOVE TYPE-AUGMENT TO CELL-TYPE. 05530000
- 055400 ADD 1 TO CELL-POINT. 05540000
- 055500 05550000
- 055600 CAU-1. 05560000
- 055700 PERFORM READAWORD. 05570000
- 055800 IF WORD-CHAR (1) NOT = "L" 05580000
- 055900 SUBTRACT 1 FROM CELL-POINT 05590000
- 056000 PERFORM STORE-CELL 05600000
- 056100 GO TO CHECK-WORD. 05610000
- 056200 PERFORM CONVERT-WORD-TO-BINARY. 05620000
- 056300 IF NUMBER < 1 OR > 4 05630000
- 056400 GO TO PRINT-ERROR. 05640000
- 056500 MOVE NUMBER TO AUG-POINT. 05650000
- 056600 PERFORM READAWORD. 05660000
- 056700 IF WORD-16-CHAR = "WITH" 05670000
- 056800 PERFORM READAWORD. 05680000
- 056900 PERFORM CONVERT-LOCATION. 05690000
- 057000 IF LOC-LENGTH NOT = 4 05700000
- 057100 GO TO PRINT-ERROR. 05710000
- 057200 MOVE LOC-POINT TO CELL-WORD (AUG-POINT). 05720000
- 057300 GO TO CAU-1. 05730000
- 057400 05740000
- 057500 COMPILE-CALL. 05750000
- 057600 MOVE TYPE-CALL TO CELL-TYPE. 05760000
- 057700 PERFORM READAWORD. 05770000
- 057800 IF WORD-16-CHAR = "M5DAEXPAND" 05780000
- 057900 MOVE SUBR-M5DAEXPAND TO CELL-LOC2 05790000
- 058000 PERFORM STORE-CELL 05800000
- 058100 GO TO NEXT-WORD. 05810000
- 058200 GO TO PRINT-ERROR. 05820000
- 058300 05830000
- 058400 COMPILE-DIVIDE. 05840000
- 058500 MOVE TYPE-DIVIDE TO CELL-TYPE. 05850000
- 058600 GO TO COMPILE-ARITHMETIC. 05860000
- 058700 05870000
- 058800 COMPILE-GO. 05880000
- 058900 MOVE TYPE-GO TO CELL-TYPE. 05890000
- 059000 PERFORM READAWORD. 05900000
- 059100 IF WORD-2-CHAR = "TO" PERFORM READAWORD. 05910000
- 059200 MOVE WORD-16-CHAR TO CELL-LABEL. 05920000
- 059300 PERFORM STORE-CELL. 05930000
- 059400 GO TO NEXT-WORD. 05940000
- 059500 05950000
- 059600 COMPILE-ELSE. 05960000
- 059700 MOVE TYPE-GO TO CELL-TYPE. 05970000
- 059800 ADD CELL-POINT 1 GIVING POYNT. 05980000
- 059900 PERFORM SET-EXIT. 05990000
- 060000 PERFORM REQUEST-EXIT. 06000000
- 060100 PERFORM STORE-CELL. 06010000
- 060200 GO TO NEXT-WORD. 06020000
- 060300 06030000
- 060400 COMPILE-IF. 06040000
- 060500 IF NEED-EXIT-POINT NOT ZERO 06050000
- 060600 GO TO PRINT-ERROR. 06060000
- 060700 MOVE ZERO TO AND-FLAG OR-FLAG. 06070000
- 060800 06080000
- 060900 CI-CONDITION. 06090000
- 061000 MOVE ZERO TO NOT-FLAG. 06100000
- 061100 PERFORM READAWORD. 06110000
- 061200 MOVE 1 TO LOC-FLAG. 06120000
- 061300 PERFORM CONVERT-LOCATION. 06130000
- 061400 IF LOC-FLAG = 2 AND CELL-LOC1 NOT ZERO 06140000
- 061500 MOVE CELL-LOC1 TO LOC-POINT 06150000
- 061600 MOVE CELL-NUM TO LOC-LENGTH 06160000
- 061700 GO TO CI-RELATION. 06170000
- 061800 IF LOC-FLAG = 2 06180000
- 061900 GO TO PRINT-ERROR. 06190000
- 062000 PERFORM READAWORD. 06200000
- 062100 06210000
- 062200 CI-RELATION. 06220000
- 062300 IF QUOTE-FLAG NOT ZERO 06230000
- 062400 GO TO CI-NOT-RELATION. 06240000
- 062500 IF WORD-2-CHAR = "IS" PERFORM READAWORD. 06250000
- 062600 IF WORD-2-CHAR = "NO" 06260000
- 062700 MOVE 1 TO NOT-FLAG 06270000
- 062800 PERFORM READAWORD. 06280000
- 062900 IF WORD-CHAR (1) = "=" OR "E" 06290000
- 063000 MOVE TYPE-IF-EQUAL-CHARS TO CELL-TYPE 06300000
- 063100 GO TO CI-1. 06310000
- 063200 IF WORD-2-CHAR = "GO" 06320000
- 063300 GO TO CI-NOT-RELATION. 06330000
- 063400 IF WORD-CHAR (1) = ">" OR "G" 06340000
- 063500 MOVE TYPE-IF-GREAT-CHARS TO CELL-TYPE 06350000
- 063600 GO TO CI-1. 06360000
- 063700 IF WORD-CHAR (1) = "<" OR "L" 06370000
- 063800 MOVE TYPE-IF-LESS-CHARS TO CELL-TYPE 06380000
- 063900 GO TO CI-1. 06390000
- 064000 06400000
- 064100 CI-NOT-RELATION. 06410000
- 064200 IF CELL-TYPE = ZERO 06420000
- 064300 GO TO PRINT-ERROR. 06430000
- 064400 MOVE OR-FLAG TO NOT-FLAG. 06440000
- 064500 GO TO CI-2. 06450000
- 064600 06460000
- 064700 CI-1. 06470000
- 064800 MOVE LOC-POINT TO CELL-LOC1. 06480000
- 064900 MOVE LOC-LENGTH TO CELL-NUM. 06490000
- 065000 PERFORM READAWORD. 06500000
- 065100 IF WORD-CHAR (1) = "T" AND QUOTE-FLAG ZERO 06510000
- 065200 PERFORM READAWORD. 06520000
- 065300 PERFORM CONVERT-LOCATION. 06530000
- 065400 PERFORM READAWORD. 06540000
- 065500 06550000
- 065600 CI-2. 06560000
- 065700 MOVE LOC-POINT TO CELL-LOC2 06570000
- 065800 IF LOC-QUOTE-FLAG NOT ZERO 06580000
- 065900 MOVE LOC-LENGTH TO CELL-NUM. 06590000
- 066000 IF WORD-2-CHAR = "OR" GO TO CI-OR. 06600000
- 066100 IF WORD-2-CHAR = "AN" GO TO CI-AND. 06610000
- 066200 GO TO CI-ACTION. 06620000
- 066300 06630000
- 066400 CI-OR. 06640000
- 066500 IF AND-FLAG NOT ZERO GO TO PRINT-ERROR. 06650000
- 066600 MOVE 1 TO OR-FLAG. 06660000
- 066700 IF NOT-FLAG = ZERO 06670000
- 066800 MOVE 1 TO NOT-FLAG 06680000
- 066900 ELSE 06690000
- 067000 MOVE ZERO TO NOT-FLAG. 06700000
- 067100 GO TO CI-STORE. 06710000
- 067200 06720000
- 067300 CI-AND. 06730000
- 067400 IF OR-FLAG NOT ZERO 06740000
- 067500 GO TO PRINT-ERROR. 06750000
- 067600 MOVE 1 TO AND-FLAG. 06760000
- 067700 06770000
- 067800 CI-STORE. 06780000
- 067900 ADD NOT-FLAG TO CELL-TYPE. 06790000
- 068000 PERFORM REQUEST-EXIT. 06800000
- 068100 PERFORM STORE-CELL. 06810000
- 068200 GO TO CI-CONDITION. 06820000
- 068300 06830000
- 068400 CI-ACTION. 06840000
- 068500 IF OR-FLAG ZERO 06850000
- 068600 GO TO CI-3. 06860000
- 068700 IF NOT-FLAG ZERO 06870000
- 068800 MOVE 1 TO NOT-FLAG 06880000
- 068900 ELSE 06890000
- 069000 MOVE ZERO TO NOT-FLAG. 06900000
- 069100 06910000
- 069200 CI-3. 06920000
- 069300 ADD NOT-FLAG TO CELL-TYPE. 06930000
- 069400 PERFORM REQUEST-EXIT. 06940000
- 069500 PERFORM STORE-CELL. 06950000
- 069600 IF OR-FLAG NOT ZERO 06960000
- 069700 ADD 1 CELL-POINT GIVING POYNT 06970000
- 069800 PERFORM SET-EXIT 06980000
- 069900 MOVE ZERO TO CELL 06990000
- 070000 MOVE TYPE-GO TO CELL-TYPE 07000000
- 070100 PERFORM REQUEST-EXIT 07010000
- 070200 PERFORM STORE-CELL. 07020000
- 070300 GO TO CHECK-WORD. 07030000
- 070400 07040000
- 070500 COMPILE-IN. 07050000
- 070600 MOVE OPEN-INPUT TO WORK-MODE. 07060000
- 070700 07070000
- 070800 COMPILE-FILE. 07080000
- 070900 MOVE "MT" TO WORK-MEDIUM. 07090000
- 071000 MOVE "UT06-OUTPUT " TO WORK-NAME. 07100000
- 071100 MOVE ZERO TO WORK-GEN. 07110000
- 071200 MOVE 2048 TO WORK-BLOCK. 07120000
- 071300 07130000
- 071400 CF-READ-WORD. 07140000
- 071500 PERFORM READAWORD. 07150000
- 071600 07160000
- 071700 CF-TEST-WORD. 07170000
- 071800 IF QUOTE-FLAG NOT ZERO 07180000
- 071900 MOVE WORD-AREA TO WORK-NAME 07190000
- 072000 GO TO CF-READ-WORD. 07200000
- 072100 IF WORD-2-CHAR = "MT" OR "DA" OR "ED" 07210000
- 072200 MOVE WORD-2-CHAR TO WORK-MEDIUM 07220000
- 072300 PERFORM CONVERT-WORD-TO-BINARY 07230000
- 072400 MOVE NUMBER TO WORK-FILE-NO 07240000
- 072500 GO TO CF-READ-WORD. 07250000
- 072600 IF WORD-2-CHAR = "GE" 07260000
- 072700 PERFORM READAWORD 07270000
- 072800 PERFORM CONVERT-WORD-TO-BINARY 07280000
- 072900 MOVE NUMBER TO WORK-GEN 07290000
- 073000 GO TO CF-READ-WORD. 07300000
- 073100 IF WORD-2-CHAR = "BL" 07310000
- 073200 PERFORM READAWORD 07320000
- 073300 PERFORM CONVERT-WORD-TO-BINARY 07330000
- 073400 MOVE NUMBER TO WORK-BLOCK 07340000
- 073500 GO TO CF-READ-WORD. 07350000
- 073600 IF WORD-2-CHAR = "MT" 07360000
- 073700 GO TO CF-MT. 07370000
- 073800 IF WORK-MODE = OPEN-INPUT 07380000
- 073900 MOVE INPUT-DA TO WORK-TYPE 07390000
- 074000 ELSE 07400000
- 074100 MOVE OUTPUT-DA TO WORK-TYPE. 07410000
- 074200 GO TO CF-END. 07420000
- 074300 07430000
- 074400 CF-MT. 07440000
- 074500 IF WORK-MODE = OPEN-INPUT 07450000
- 074600 MOVE INPUT-MT TO WORK-TYPE 07460000
- 074700 GO TO CF-END. 07470000
- 074800 IF WORK-BLOCK > 512 07480000
- 074900 MOVE 2048 TO WORK-BLOCK 07490000
- 075000 MOVE OUTPUT-MT-2048 TO WORK-TYPE 07500000
- 075100 GO TO CF-END. 07510000
- 075200 IF WORK-BLOCK > 124 07520000
- 075300 MOVE 512 TO WORK-BLOCK 07530000
- 075400 MOVE OUTPUT-MT-512 TO WORK-TYPE 07540000
- 075500 GO TO CF-END. 07550000
- 075600 IF WORK-BLOCK > 64 07560000
- 075700 MOVE 128 TO WORK-BLOCK 07570000
- 075800 MOVE OUTPUT-MT-128 TO WORK-TYPE 07580000
- 075900 GO TO CF-END. 07590000
- 076000 MOVE 64 TO WORK-BLOCK. 07600000
- 076100 MOVE OUTPUT-MT-64 TO WORK-TYPE. 07610000
- 076200 07620000
- 076300 CF-END. 07630000
- 076400 ADD 1 TO FILE-POINT. 07640000
- 076500 IF FILE-POINT > FILE-TABLE-SIZE 07650000
- 076600 STOP "ABANDON, TOO MANY FILES". 07660000
- 076700 MOVE WORK-FILE-DATA TO FILE-DATA (FILE-POINT). 07670000
- 076800 GO TO CHECK-WORD. 07680000
- 076900 07690000
- 077000 COMPILE-MOVE. 07700000
- 077100 PERFORM READAWORD. 07710000
- 077200 PERFORM CONVERT-LOCATION. 07720000
- 077300 MOVE LOC-POINT TO CELL-LOC1. 07730000
- 077400 MOVE LOC-LENGTH TO CELL-NUM. 07740000
- 077500 PERFORM READAWORD. 07750000
- 077600 IF WORD-2-CHAR = "TO" PERFORM READAWORD. 07760000
- 077700 PERFORM CONVERT-LOCATION. 07770000
- 077800 MOVE LOC-POINT TO CELL-LOC2. 07780000
- 077900 MOVE LOC-LENGTH TO CELL-EXIT. 07790000
- 078000 IF CELL-NUM > 0 AND LOC-LENGTH > 0 07800000
- 078100 MOVE TYPE-MOVE-CHARS TO CELL-TYPE 07810000
- 078200 GO TO COMPILE-MOVE-END. 07820000
- 078300 IF CELL-NUM = -4 AND LOC-LENGTH > 0 AND LOC-LENGTH < 7 07830000
- 078400 MOVE TYPE-MOVE-1B-D TO CELL-TYPE 07840000
- 078500 GO TO COMPILE-MOVE-END. 07850000
- 078600 IF CELL-NUM > 0 AND CELL-NUM < 7 AND LOC-LENGTH = -4 07860000
- 078700 MOVE TYPE-MOVE-D-1B TO CELL-TYPE 07870000
- 078800 GO TO COMPILE-MOVE-END. 07880000
- 078900 IF CELL-NUM = -4 AND LOC-LENGTH = -4 07890000
- 079000 MOVE TYPE-MOVE-CHARS TO CELL-TYPE 07900000
- 079100 MOVE 4 TO CELL-NUM. 07910000
- 079200 PERFORM PRINT-ERROR. 07920000
- 079300 GO TO NEXT-WORD. 07930000
- 079400 07940000
- 079500 COMPILE-MOVE-END. 07950000
- 079600 PERFORM STORE-CELL. 07960000
- 079700 GO TO NEXT-WORD. 07970000
- 079800 07980000
- 079900 COMPILE-MULTIPLY. 07990000
- 080000 MOVE TYPE-MULTIPLY TO CELL-TYPE. 08000000
- 080100 GO TO COMPILE-ARITHMETIC. 08010000
- 080200 08020000
- 080300 COMPILE-OUT. 08030000
- 080400 MOVE OPEN-OUTPUT TO WORK-MODE. 08040000
- 080500 MOVE 1 TO OUT-MT-FLAG. 08050000
- 080600 GO TO COMPILE-FILE. 08060000
- 080700 08070000
- 080800 COMPILE-PERFORM. 08080000
- 080900 MOVE TYPE-PERFORM TO CELL-TYPE. 08090000
- 081000 PERFORM READAWORD. 08100000
- 081100 MOVE WORD-16-CHAR TO CELL-LABEL. 08110000
- 081200 PERFORM STORE-CELL. 08120000
- 081300 GO TO NEXT-WORD. 08130000
- 081400 08140000
- 081500 COMPILE-PRINT. 08150000
- 081600 MOVE TYPE-PRINT TO CELL-TYPE. 08160000
- 081700 PERFORM STORE-CELL. 08170000
- 081800 GO TO NEXT-WORD. 08180000
- 081900 08190000
- 082000 COMPILE-READ. 08200000
- 082100 MOVE TYPE-READ TO CELL-TYPE. 08210000
- 082200 ADD 2 TO CELL-POINT. 08220000
- 082300 PERFORM READAWORD. 08230000
- 082400 IF WORD-16-CHAR = "CARD" 08240000
- 082500 MOVE 1 TO CELL-LOC2 08250000
- 082600 PERFORM READAWORD. 08260000
- 082700 IF WORD-CHAR (1) = "F" 08270000
- 082800 PERFORM CONVERT-WORD-TO-BINARY 08280000
- 082900 MOVE NUMBER TO CELL-LOC1 08290000
- 083000 PERFORM READAWORD. 08300000
- 083100 IF WORD-2-CHAR = "AT" PERFORM READAWORD. 08310000
- 083200 SUBTRACT 2 FROM CELL-POINT. 08320000
- 083300 IF WORD-2-CHAR = "EN" 08330000
- 083400 PERFORM REQUEST-EXIT 08340000
- 083500 PERFORM STORE-CELL 08350000
- 083600 GO TO NEXT-WORD. 08360000
- 083700 ADD 2 CELL-POINT GIVING CELL-EXIT. 08370000
- 083800 PERFORM STORE-CELL. 08380000
- 083900 MOVE ZERO TO CELL. 08390000
- 084000 MOVE TYPE-STOP TO CELL-TYPE. 08400000
- 084100 PERFORM STORE-CELL. 08410000
- 084200 GO TO CHECK-WORD. 08420000
- 084300 08430000
- 084400 COMPILE-STOP. 08440000
- 084500 MOVE TYPE-STOP TO CELL-TYPE. 08450000
- 084600 PERFORM STORE-CELL. 08460000
- 084700 GO TO NEXT-WORD. 08470000
- 084800 08480000
- 084900 COMPILE-SUBTRACT. 08490000
- 085000 MOVE TYPE-SUBTRACT TO CELL-TYPE. 08500000
- 085100 GO TO COMPILE-ARITHMETIC. 08510000
- 085200 08520000
- 085300 COMPILE-WRITE. 08530000
- 085400 MOVE 1 TO OUT-MT-FLAG. 08540000
- 085500 MOVE TYPE-WRITE TO CELL-TYPE. 08550000
- 085600 ADD 1 TO CELL-POINT. 08560000
- 085700 PERFORM READAWORD. 08570000
- 085800 IF WORD-CHAR (1) = "F" 08580000
- 085900 PERFORM CONVERT-WORD-TO-BINARY 08590000
- 086000 MOVE NUMBER TO CELL-LOC1 08600000
- 086100 PERFORM READAWORD. 08610000
- 086200 SUBTRACT 1 FROM CELL-POINT. 08620000
- 086300 PERFORM STORE-CELL. 08630000
- 086400 GO TO CHECK-WORD. 08640000
- 086500 08650000
- 086600 READAWORD SECTION. 08660000
- 086700 08670000
- 086800 READ-WORD. 08680000
- 086900 IF FULL-STOP-FLAG NOT ZERO 08690000
- 087000 AND NEED-EXIT-POINT NOT ZERO 08700000
- 087100 MOVE CELL-POINT TO POYNT 08710000
- 087200 PERFORM SET-EXIT. 08720000
- 087300 MOVE ZERO TO FULL-STOP-FLAG. 08730000
- 087400 MOVE ZERO TO WORD-CHAR-POINT QUOTE-FLAG. 08740000
- 087500 MOVE SPACES TO WORD-AREA. 08750000
- 087600 08760000
- 087700 RW-1. 08770000
- 087800 IF END-CARDS-FLAG ZERO 08780000
- 087900 PERFORM READ-CHAR. 08790000
- 088000 IF END-CARDS-FLAG NOT ZERO 08800000
- 088100 MOVE 1 TO END-WORDS-FLAG FIRST-CHAR-POINT 08810000
- 088200 GO TO RW-EXIT. 08820000
- 088300 IF QUOTE-FLAG = 1 08830000
- 088400 GO TO RW-2. 08840000
- 088500 IF END-CHAR-FLAG = 1 08850000
- 088600 GO TO RW-1. 08860000
- 088700 MOVE CARD-CHAR-POINT TO FIRST-CHAR-POINT. 08870000
- 088800 IF WORK-CHAR = QUOTE 08880000
- 088900 MOVE 1 TO QUOTE-FLAG 08890000
- 089000 GO TO RW-1. 08900000
- 089100 08910000
- 089200 RW-2. 08920000
- 089300 IF WORD-CHAR-POINT > 79 08930000
- 089400 PERFORM PRINT-ERROR 08940000
- 089500 GO TO RW-3. 08950000
- 089600 ADD 1 TO WORD-CHAR-POINT. 08960000
- 089700 MOVE WORK-CHAR TO WORD-CHAR (WORD-CHAR-POINT). 08970000
- 089800 IF CARD-CHAR-POINT = 80 08980000
- 089900 GO TO RW-EXIT. 08990000
- 090000 09000000
- 090100 RW-3. 09010000
- 090200 PERFORM READ-CHAR. 09020000
- 090300 IF END-CARDS-FLAG = 1 09030000
- 090400 GO TO RW-EXIT. 09040000
- 090500 IF QUOTE-FLAG = ZERO AND END-CHAR-FLAG = 1 09050000
- 090600 GO TO RW-EXIT. 09060000
- 090700 IF WORK-CHAR NOT = QUOTE 09070000
- 090800 GO TO RW-2. 09080000
- 090900 09090000
- 091000 RW-EXIT. 09100000
- 091100 IF WORD-CHAR (WORD-CHAR-POINT) = "." AND QUOTE-FLAG ZERO 09110000
- 091200 MOVE 1 TO FULL-STOP-FLAG 09120000
- 091300 MOVE SPACE TO WORD-CHAR (WORD-CHAR-POINT) 09130000
- 091400 SUBTRACT 1 FROM WORD-CHAR-POINT. 09140000
- 091500 IF WORD-CHAR-POINT < 1 AND END-WORDS-FLAG ZERO 09150000
- 091600 GO TO READ-WORD. 09160000
- 091700 09170000
- 091800 SUBROUTINES SECTION. 09180000
- 091900 09190000
- 092000 READ-CHAR. 09200000
- 092100 ADD 1 TO CARD-CHAR-POINT. 09210000
- 092200 IF CARD-CHAR-POINT > 80 09220000
- 092300 PERFORM READ-CARD 09230000
- 092400 MOVE 1 TO CARD-CHAR-POINT. 09240000
- 092500 MOVE CARD-CHAR (CARD-CHAR-POINT) TO WORK-CHAR. 09250000
- 092600 IF WORK-CHAR = SPACE OR "," 09260000
- 092700 MOVE 1 TO END-CHAR-FLAG 09270000
- 092800 ELSE 09280000
- 092900 MOVE ZERO TO END-CHAR-FLAG. 09290000
- 093000 09300000
- 093100 READ-CARD. 09310000
- 093200 IF LIST-CARD NOT = SPACES 09320000
- 093300 PERFORM PRINT. 09330000
- 093400 READ CARD-FILE 09340000
- 093500 AT END 09350000
- 093600 MOVE 1 TO END-CARDS-FLAG 09360000
- 093700 MOVE "****" TO CARD-RECORD. 09370000
- 093800 MOVE CARD-RECORD TO LIST-CARD. 09380000
- 093900 PERFORM PRINT. 09390000
- 094000 09400000
- 094100 REQUEST-EXIT. 09410000
- 094200 IF NEED-EXIT-POINT ZERO 09420000
- 094300 MOVE CELL-POINT TO NEED-EXIT-POINT. 09430000
- 094400 MOVE -200 TO CELL-EXIT. 09440000
- 094500 09450000
- 094600 SET-EXIT. 09460000
- 094700 IF CELL-STORE-EXIT (NEED-EXIT-POINT) = -200 09470000
- 094800 MOVE POYNT TO CELL-STORE-EXIT (NEED-EXIT-POINT). 09480000
- 094900 ADD 1 TO NEED-EXIT-POINT. 09490000
- 095000 IF NEED-EXIT-POINT < CELL-POINT 09500000
- 095100 GO TO SET-EXIT. 09510000
- 095200 MOVE ZERO TO NEED-EXIT-POINT. 09520000
- 095300 09530000
- 095400 CREATE-RETURN-CELL. 09540000
- 095500 IF LABEL-FLAG NOT ZERO 09550000
- 095600 MOVE TYPE-EXIT TO CELL-TYPE 09560000
- 095700 PERFORM STORE-CELL. 09570000
- 095800 09580000
- 095900 STORE-CELL. 09590000
- 096000 MOVE CELL TO CELL-STORE (CELL-POINT). 09600000
- 096100 ADD 1 TO CELL-POINT. 09610000
- 096200 IF CELL-POINT > NO-OF-CELLS 09620000
- 096300 STOP "ABANDON, TOO MANY INSTRUCTIONS". 09630000
- 096400 09640000
- 096500 PRINT-ERROR. 09650000
- 096600 MOVE 1 TO ERROR-FLAG. 09660000
- 096700 MOVE "+" TO LIST-CHAR (FIRST-CHAR-POINT). 09670000
- 096800 MOVE "ERROR; WORD IGNORED" TO LIST-COMMENT. 09680000
- 096900 09690000
- 097000 PRINT-ERROR-EXIT. 09700000
- 097100 GO TO NEXT-WORD. 09710000
- 097200 09720000
- 097300 PRINT. 09730000
- 097400 MOVE PRINT-LINE TO PRINT-AREA. 09740000
- 097500 CALL A510 USING A510-AREA. 09750000
- 097600 MOVE "SP 1" TO A510-CONTROL. 09760000
- 097700 MOVE SPACES TO PRINT-LINE. 09770000
- 097800 09780000
- 097900 CONVERT-LOCATION SECTION. 09790000
- 098000 09800000
- 098100 READ-LOCATION. 09810000
- 098200 MOVE ZERO TO CHAR-AREA-FLAG. 09820000
- 098300 IF LOC-FLAG = 2 09830000
- 098400 MOVE ZERO TO LOC-FLAG. 09840000
- 098500 MOVE 1 TO LOC-POINT POYNT. 09850000
- 098600 MOVE ZERO TO LOC-LENGTH. 09860000
- 098700 IF QUOTE-FLAG = 1 09870000
- 098800 GO TO STORE-LITERAL. 09880000
- 098900 IF WORD-CHAR (1) = "W" 09890000
- 099000 ADD WORK-AREA-START TO LOC-POINT 09900000
- 099100 GO TO IGNORE-ALPHA. 09910000
- 099200 IF WORD-CHAR (1) = "R" 09920000
- 099300 GO TO IGNORE-ALPHA. 09930000
- 099400 IF WORD-CHAR (1) NUMERIC 09940000
- 099500 GO TO CREATE-BINARY-LITERAL. 09950000
- 099600 IF WORD-CHAR (1) = "A" 09960000
- 099700 ADD A510-AREA-START TO LOC-POINT 09970000
- 099800 GO TO IGNORE-ALPHA. 09980000
- 099900 MOVE 1 TO CHAR-AREA-FLAG. 09990000
- 100000 MOVE ZERO TO LOC-POINT. 10000000
- 100100 IF WORD-CHAR (1) = "C" 10010000
- 100200 ADD CARD-AREA-START TO LOC-POINT 10020000
- 100300 GO TO IGNORE-ALPHA. 10030000
- 100400 IF WORD-CHAR (1) = "P" 10040000
- 100500 ADD PRINT-AREA-START TO LOC-POINT 10050000
- 100600 GO TO IGNORE-ALPHA. 10060000
- 100700 IF WORD-CHAR (1) = "H" 10070000
- 100800 ADD H-HEAD-AREA-START TO LOC-POINT 10080000
- 100900 GO TO IGNORE-ALPHA. 10090000
- 101000 IF WORD-CHAR (1) = "I" 10100000
- 101100 ADD I-HEAD-AREA-START TO LOC-POINT 10110000
- 101200 GO TO IGNORE-ALPHA. 10120000
- 101300 IF WORD-CHAR (1) = "J" 10130000
- 101400 ADD J-HEAD-AREA-START TO LOC-POINT 10140000
- 101500 GO TO IGNORE-ALPHA. 10150000
- 101600 10160000
- 101700 NOT-A-LOCATION. 10170000
- 101800 IF LOC-FLAG = 1 10180000
- 101900 MOVE 2 TO LOC-FLAG 10190000
- 102000 GO TO RL-EXIT. 10200000
- 102100 PERFORM PRINT-ERROR. 10210000
- 102200 GO TO NEXT-WORD. 10220000
- 102300 10230000
- 102400 IGNORE-ALPHA. 10240000
- 102500 IF POYNT > WORD-CHAR-POINT 10250000
- 102600 GO TO RL-EXIT. 10260000
- 102700 IF WORD-CHAR (POYNT) ALPHABETIC 10270000
- 102800 OR WORD-CHAR (POYNT) = "+" 10280000
- 102900 OR WORD-CHAR (POYNT) = "-" 10290000
- 103000 ADD 1 TO POYNT 10300000
- 103100 GO TO IGNORE-ALPHA. 10310000
- 103200 IF WORD-CHAR (POYNT) = SPACE 10320000
- 103300 GO TO RL-EXIT. 10330000
- 103400 IF CHAR-AREA-FLAG = 1 10340000
- 103500 PERFORM CONVERT-NUMBER 10350000
- 103600 ADD NUMBER TO LOC-POINT. 10360000
- 103700 IF WORD-CHAR (POYNT) NUMERIC 10370000
- 103800 PERFORM CONVERT-NUMBER 10380000
- 103900 MULTIPLY 4 BY NUMBER 10390000
- 104000 ADD NUMBER TO LOC-POINT. 10400000
- 104100 IF WORD-CHAR (POYNT) = "." 10410000
- 104200 AND WORD-CHAR(WORD-CHAR-POINT) NOT = "B" 10420000
- 104300 ADD 1 TO POYNT 10430000
- 104400 PERFORM CONVERT-NUMBER 10440000
- 104500 ADD NUMBER TO LOC-POINT. 10450000
- 104600 IF WORD-CHAR (POYNT) = "/" 10460000
- 104700 ADD 1 TO POYNT 10470000
- 104800 PERFORM CONVERT-NUMBER 10480000
- 104900 MOVE NUMBER TO LOC-LENGTH. 10490000
- 105000 IF WORD-CHAR (POYNT) = "B" 10500000
- 105100 DIVIDE 4 INTO LOC-POINT 10510000
- 105200 ADD 1 TO LOC-POINT 10520000
- 105300 GO TO RL-EXIT. 10530000
- 105400 IF WORD-CHAR (POYNT) NOT = SPACE 10540000
- 105500 MOVE 2 TO LOC-FLAG 10550000
- 105600 GO TO NOT-A-LOCATION. 10560000
- 105700 GO TO RL-EXIT. 10570000
- 105800 10580000
- 105900 CREATE-BINARY-LITERAL. 10590000
- 106000* THIS CODE APPEARS TO ALIGN A BINARY LITERAL ON A WORD BOUNDARY 10600000
- 106100 MOVE LITERAL-CHAR-POINT TO WORK-2-BITS. 10610000
- 106200 IF WORK-2-BITS NOT = 1 10620000
- 106300 ADD 1 TO LITERAL-CHAR-POINT 10630000
- 106400 GO TO CREATE-BINARY-LITERAL. 10640000
- 106500* AND IS PROBABLY NOT NEEDED 10650000
- 106600 10660000
- 106700 PERFORM CONVERT-WORD-TO-BINARY. 10670000
- 106800 MOVE NUMBER-X4 TO WORD-AREA. 10680000
- 106900 MOVE 4 TO WORD-CHAR-POINT. 10690000
- 107000 10700000
- 107100 STORE-LITERAL. 10710000
- 107200 MOVE ZERO TO LOC-LENGTH. 10720000
- 107300 MOVE LITERAL-CHAR-POINT TO LOC-POINT. 10730000
- 107400 MOVE 1 TO POYNT. 10740000
- 107500 10750000
- 107600 SL-1. 10760000
- 107700 IF LITERAL-CHAR-POINT > LITERAL-AREA-END 10770000
- 107800 STOP "ABANDON, LITERAL TABLE OVERFLOW". 10780000
- 107900 IF POYNT > WORD-CHAR-POINT 10790000
- 108000 GO TO RL-EXIT. 10800000
- 108100 MOVE WORD-CHAR (POYNT) TO CHAR (LITERAL-CHAR-POINT). 10810000
- 108200 ADD 1 TO LITERAL-CHAR-POINT. 10820000
- 108300 ADD 1 TO POYNT. 10830000
- 108400 ADD 1 TO LOC-LENGTH. 10840000
- 108500 GO TO SL-1. 10850000
- 108600 10860000
- 108700 RL-EXIT. 10870000
- 108800 IF LOC-FLAG = 1 10880000
- 108900 MOVE ZERO TO LOC-FLAG. 10890000
- 109000 IF LOC-FLAG NOT = 2 10900000
- 109100 MOVE QUOTE-FLAG TO LOC-QUOTE-FLAG. 10910000
- 109200 IF LOC-LENGTH = ZERO 10920000
- 109300 MOVE 4 TO LOC-LENGTH. 10930000
- 109400 IF WORD-CHAR (WORD-CHAR-POINT) = "B" AND QUOTE-FLAG = ZERO 10940000
- 109500 MULTIPLY -1 BY LOC-LENGTH. 10950000
- 109600 10960000
- 109700 NUMERIC-CONVERSION SECTION. 10970000
- 109800 10980000
- 109900 CONVERT-WORD-TO-BINARY. 10990000
- 110000 MOVE WORD-AREA TO NUM-FIELD-X. 11000000
- 110100 MOVE NUM-FIELD TO NUMBER. 11010000
- 110200 11020000
- 110300 LOC-TO-BINARY. 11030000
- 110400 IF LOC-LENGTH NOT = 4 11040000
- 110500 GO TO LTB-EXIT. 11050000
- 110600 MOVE LOC-POINT TO WORK-2-BITS. 11060000
- 110700 IF WORK-2-BITS = 1 11070000
- 110800 DIVIDE 4 INTO LOC-POINT 11080000
- 110900 ADD 1 TO LOC-POINT 11090000
- 111000 MOVE -4 TO LOC-LENGTH. 11100000
- 111100 11110000
- 111200 LTB-EXIT. 11120000
- 111300 EXIT. 11130000
- 111400 11140000
- 111500 CONVERT-NUMBER SECTION. 11150000
- 111600 11160000
- 111700 CONVERT-NUM. 11170000
- 111800 MOVE SPACES TO NUM-FIELD-X. 11180000
- 111900 MOVE 1 TO NUM-POINT. 11190000
- 112000 11200000
- 112100 CN-1. 11210000
- 112200 IF WORD-CHAR (POYNT) NOT NUMERIC 11220000
- 112300 GO TO CN-EXIT. 11230000
- 112400 MOVE WORD-CHAR (POYNT) TO NUM-CHAR (NUM-POINT). 11240000
- 112500 ADD 1 TO NUM-POINT. 11250000
- 112600 IF NUM-POINT > 6 11260000
- 112700 PERFORM PRINT-ERROR 11270000
- 112800 GO TO NEXT-WORD. 11280000
- 112900 ADD 1 TO POYNT. 11290000
- 113000 IF POYNT > 80 11300000
- 113100 PERFORM PRINT-ERROR 11310000
- 113200 GO TO NEXT-WORD. 11320000
- 113300 GO TO CN-1. 11330000
- 113400 11340000
- 113500 CN-EXIT. 11350000
- 113600 MOVE NUM-FIELD TO NUMBER. 11360000
- 113700 11370000
- 113800 CHECK-LABELS SECTION. 11380000
- 113900 11390000
- 114000 CL-0. 11400000
- 114100 MOVE ZERO TO CELL-POINT. 11410000
- 114200 11420000
- 114300 CL-1. 11430000
- 114400 ADD 1 TO CELL-POINT. 11440000
- 114500 IF CELL-POINT > TOTAL-CELLS 11450000
- 114600 MOVE ZERO TO CELL 11460000
- 114700 MOVE TYPE-GO TO CELL-TYPE 11470000
- 114800 MOVE 1 TO CELL-EXIT 11480000
- 114900 MOVE CELL TO CELL-STORE (CELL-POINT) 11490000
- 115000 ADD 1 TO TOTAL-CELLS 11500000
- 115100 GO TO PRINT-CELLS. 11510000
- 115200 MOVE CELL-STORE (CELL-POINT) TO CELL. 11520000
- 115300 IF CELL-TYPE NOT = TYPE-PERFORM AND CELL-TYPE NOT = TYPE-GO 11530000
- 115400 GO TO CL-1. 11540000
- 115500 IF CELL-LOC1 ZERO 11550000
- 115600 GO TO CL-1. 11560000
- 115700 MOVE ZERO TO POYNT. 11570000
- 115800 11580000
- 115900 CL-2. 11590000
- 116000 ADD 1 TO POYNT. 11600000
- 116100 IF POYNT > TOTAL-CELLS 11610000
- 116200 MOVE "UNDEFINED LABEL" TO LIST-COMMENT 11620000
- 116300 MOVE CELL-LABEL TO LIST-NAME 11630000
- 116400 PERFORM PRINT 11640000
- 116500 MOVE 1 TO ERROR-FLAG 11650000
- 116600 GO TO CL-1. 11660000
- 116700 IF CELL-STORE-TYPE (POYNT) NOT = TYPE-LABEL 11670000
- 116800 GO TO CL-2. 11680000
- 116900 IF CELL-STORE-LABEL (POYNT) NOT = CELL-LABEL 11690000
- 117000 GO TO CL-2. 11700000
- 117100 MOVE ZERO TO CELL-LABEL. 11710000
- 117200 IF CELL-TYPE = TYPE-GO 11720000
- 117300 ADD 1 POYNT GIVING CELL-EXIT 11730000
- 117400 GO TO CL-4. 11740000
- 117500 ADD 1 POYNT GIVING CELL-LOC1. 11750000
- 117600 11760000
- 117700 CL-3. 11770000
- 117800 ADD 1 TO POYNT. 11780000
- 117900 IF POYNT > TOTAL-CELLS 11790000
- 118000 GO TO POST-MORTEM. 11800000
- 118100 IF CELL-STORE-TYPE (POYNT) NOT = TYPE-EXIT 11810000
- 118200 GO TO CL-3. 11820000
- 118300 MOVE POYNT TO CELL-LOC2. 11830000
- 118400 11840000
- 118500 CL-4. 11850000
- 118600 MOVE CELL TO CELL-STORE (CELL-POINT). 11860000
- 118700 GO TO CL-1. 11870000
- 118800 11880000
- 118900 PRINT-CELLS SECTION. 11890000
- 119000 11900000
- 119100 PC-0. 11910000
- 119200 PERFORM PRINT 3 TIMES. 11920000
- 119300 MOVE "LISTING OF FILE DATA:" TO LIST-CARD. 11930000
- 119400 PERFORM PRINT 2 TIMES. 11940000
- 119500 MOVE "FILE NO. FILE NAME GEN BLOCK TYPE MODE" 11950000
- 119600 TO LIST-CARD. 11960000
- 119700 PERFORM PRINT 2 TIMES. 11970000
- 119800 MOVE ZERO TO POYNT. 11980000
- 119900 11990000
- 120000 PC-FILE. 12000000
- 120100 ADD 1 TO POYNT. 12010000
- 120200 IF POYNT > FILE-POINT 12020000
- 120300 GO TO PC-CELLS. 12030000
- 120400 MOVE FILE-DATA (POYNT) TO WORK-FILE-DATA. 12040000
- 120500 MOVE WORK-FILE-NO TO LIST-CELL. 12050000
- 120600 MOVE WORK-NAME TO LIST-LABEL. 12060000
- 120700 MOVE WORK-GEN TO LIST-LOC1. 12070000
- 120800 MOVE WORK-BLOCK TO LIST-LOC2. 12080000
- 120900 MOVE WORK-TYPE TO LIST-NUM. 12090000
- 121000 MOVE WORK-MODE TO LIST-EXIT. 12100000
- 121100 PERFORM PRINT. 12110000
- 121200 GO TO PC-FILE. 12120000
- 121300 12130000
- 121400 PC-CELLS. 12140000
- 121500 PERFORM PRINT 2 TIMES. 12150000
- 121600 MOVE "LISTING OF GENERATED INSTRUCTIONS:" TO LIST-CARD. 12160000
- 121700 PERFORM PRINT 2 TIMES. 12170000
- 121800 MOVE "ADDRESS INSTRUCTION LOC1 LOC2 SIZE EXIT" 12180000
- 121900 TO LIST-CARD. 12190000
- 122000 PERFORM PRINT 2 TIMES. 12200000
- 122100 MOVE 1 TO CELL-POINT. 12210000
- 122200 12220000
- 122300 PC-1. 12230000
- 122400 MOVE CELL-STORE (CELL-POINT) TO CELL. 12240000
- 122500 MOVE CELL-POINT TO LIST-CELL. 12250000
- 122600 IF CELL-TYPE = TYPE-LABEL 12260000
- 122700 MOVE CELL-LABEL TO LIST-LABEL 12270000
- 122800 GO TO PC-2. 12280000
- 122900 MOVE INSTRUCTION-NAME (CELL-TYPE) TO LIST-TYPE. 12290000
- 123000 MOVE CELL-LOC1 TO LIST-LOC1. 12300000
- 123100 MOVE CELL-LOC2 TO LIST-LOC2. 12310000
- 123200 MOVE CELL-NUM TO LIST-NUM. 12320000
- 123300 MOVE CELL-EXIT TO LIST-EXIT. 12330000
- 123400 12340000
- 123500 PC-2. 12350000
- 123600 PERFORM PRINT. 12360000
- 123700 IF CELL-POINT < TOTAL-CELLS 12370000
- 123800 ADD 1 TO CELL-POINT 12380000
- 123900 GO TO PC-1. 12390000
- 124000 PERFORM PRINT 2 TIMES. 12400000
- 124100 MOVE "LISTING OF LITERAL TABLE:" TO LIST-CARD. 12410000
- 124200 PERFORM PRINT 2 TIMES. 12420000
- 124300 MOVE LITERAL-AREA TO PRINT-LINE. 12430000
- 124400 PERFORM PRINT. 12440000
- 124500 12450000
- 124600 CHECK-ERROR. 12460000
- 124700 IF ERROR-FLAG NOT ZERO 12470000
- 124800 STOP "ABANDON, COMPILE ERROR" 12480000
- 124900 GO TO CHECK-ERROR. 12490000
- 125000 MOVE 1 TO COMPILE-FLAG. 12500000
- 125100 IF HALT-AFTER-COMPILE 12510000
- 125200 PERFORM CLOSE-CARD-PRINTER 12520000
- 125300 STOP "ACTION, COMPILED OK" 12530000
- 125400 ELSE 12540000
- 125500 DISPLAY "COMPILED OK". 12550000
- 125600 12560000
- 125700 RUN-GENERATED-PROGRAM SECTION. 12570000
- 125800 12580000
- 125900 RUN-INITIALISE. 12590000
- 126000 PERFORM OPEN-CARD-PRINTER. 12600000
- 126100 MOVE ZERO TO RECORD-AREA WORK-AREA A510-PAGE 12610000
- 126200 FILE-STATUS-TABLE 12620000
- 126300 IN-FILE-POINT OUT-FILE-POINT TOTALS. 12630000
- 126400 MOVE SPACES TO CARD-AREA PRINT-AREA. 12640000
- 126500 MOVE 100 TO A510-LINES-THIS. 12650000
- 126600 MOVE SPACES TO HEAD-1-COM. 12660000
- 126700 IF OUT-MT-FLAG = 1 AND TOTAL-CELLS = 1 12670000
- 126800 MOVE OPEN-OUTPUT TO MODE-REQUIRED 12680000
- 126900 PERFORM OPEN-FILE 12690000
- 127000 GO TO CLOSE-FILES. 12700000
- 127100 MOVE ZERO TO CELL-POINT. 12710000
- 127200 12720000
- 127300 NEXT-CELL. 12730000
- 127400 ADD 1 TO CELL-POINT. 12740000
- 127500 12750000
- 127600 ACTION-CELL. 12760000
- 127700 MOVE CELL-STORE (CELL-POINT) TO CELL. 12770000
- 127800 12780000
- 127900 BRANCH-ON-CELL-TYPE. 12790000
- 128000 GO TO 12800000
- 128100 RUN-ADD 12810000
- 128200 RUN-AUGMENT 12820000
- 128300 RUN-CALL 12830000
- 128400 RUN-DIVIDE 12840000
- 128500 RUN-EXIT 12850000
- 128600 RUN-GO 12860000
- 128700 RUN-IF-EQUAL-CHARS 12870000
- 128800 RUN-IF-NOT-EQUAL-CHARS 12880000
- 128900 RUN-IF-GREAT-CHARS 12890000
- 129000 RUN-IF-NOT-GREAT-CHARS 12900000
- 129100 RUN-IF-LESS-CHARS 12910000
- 129200 RUN-IF-NOT-LESS-CHARS 12920000
- 129300 NEXT-CELL 12930000
- 129400 RUN-MOVE-1B-D 12940000
- 129500 RUN-MOVE-CHARS 12950000
- 129600 RUN-MOVE-D-1B 12960000
- 129700 RUN-MULTIPLY 12970000
- 129800 RUN-PERFORM 12980000
- 129900 RUN-PRINT 12990000
- 130000 RUN-READ 13000000
- 130100 RUN-STOP 13010000
- 130200 RUN-SUBTRACT 13020000
- 130300 RUN-WRITE 13030000
- 130400 DEPENDING ON CELL-TYPE. 13040000
- 130500 13050000
- 130600 POST-MORTEM. 13060000
- 130700 DISPLAY "ADDRESS" CELL-POINT. 13070000
- 130800 STOP "ABANDON PM". 13080000
- 130900 GO TO POST-MORTEM. 13090000
- 131000 13100000
- 131100 RUN-ADD. 13110000
- 131200 ADD BINARY-WORD (CELL-LOC1) TO BINARY-WORD (CELL-LOC2). 13120000
- 131300 GO TO NEXT-CELL. 13130000
- 131400 13140000
- 131500 RUN-AUGMENT. 13150000
- 131600 MOVE CELL-LABEL TO AUG-STORE. 13160000
- 131700 ADD 1 TO CELL-POINT. 13170000
- 131800 MOVE CELL-STORE (CELL-POINT) TO CELL. 13180000
- 131900 MOVE ZERO TO AUG-POINT. 13190000
- 132000 13200000
- 132100 RAU-1. 13210000
- 132200 ADD 1 TO AUG-POINT. 13220000
- 132300 IF AUG-POINT > 4 13230000
- 132400 GO TO BRANCH-ON-CELL-TYPE. 13240000
- 132500 MOVE AUG-WORD (AUG-POINT) TO ONE-LOC. 13250000
- 132600 IF ONE-LOC = ZERO 13260000
- 132700 GO TO RAU-1. 13270000
- 132800 ENTER PLAN MOVECHAR USING ONE-WORD-MOVE IN-RECORD. 13280000
- 132900 13290000
- 133000* SORRY I HAVE NO IDEA WHAT THIS IS DOING! 13300000
- 133100* IT OUGHT TO BE INCREMENTING THE NEXT INSTRUCTIONS'S PARAMETERS 13310000
- 133200* WITH A SET OF VARIABLES 13320000
- 133300 13330000
- 133400 IF SCR-WORD > 800 13340000
- 133500 STOP "ABANDON, MOD OUT OF RANGE". 13350000
- 133600 ADD SCR-WORD TO CELL-WORD (AUG-POINT). 13360000
- 133700 GO TO RAU-1. 13370000
- 133800 13380000
- 133900 RUN-CALL. 13390000
- 134000 IF CELL-LOC1 = SUBR-M5DAEXPAND 13400000
- 134100 ENTER PLAN M5DAEXPAND USING M5DA-INDEX-BITS. 13410000
- 134200 GO TO NEXT-CELL. 13420000
- 134300 13430000
- 134400 RUN-DIVIDE. 13440000
- 134500 DIVIDE BINARY-WORD (CELL-LOC1) INTO BINARY-WORD (CELL-LOC2). 13450000
- 134600 GO TO NEXT-CELL. 13460000
- 134700 13470000
- 134800 RUN-EXIT. 13480000
- 134900 IF CELL-EXIT ZERO 13490000
- 135000 GO TO NEXT-CELL. 13500000
- 135100 MOVE ZERO TO CELL-STORE-EXIT (CELL-POINT). 13510000
- 135200 MOVE CELL-EXIT TO CELL-POINT. 13520000
- 135300 GO TO ACTION-CELL. 13530000
- 135400 13540000
- 135500 RUN-GO. 13550000
- 135600 MOVE CELL-EXIT TO CELL-POINT. 13560000
- 135700 GO TO ACTION-CELL. 13570000
- 135800 13580000
- 135900 RUN-IF-EQUAL-CHARS. 13590000
- 136000 IF CELL-NUM = ZERO 13600000
- 136100 GO TO NEXT-CELL. 13610000
- 136200 IF CHAR (CELL-LOC1) = CHAR (CELL-LOC2) 13620000
- 136300 ADD 1 TO CELL-LOC1 13630000
- 136400 ADD 1 TO CELL-LOC2 13640000
- 136500 SUBTRACT 1 FROM CELL-NUM 13650000
- 136600 GO TO RUN-IF-EQUAL-CHARS. 13660000
- 136700 GO TO RUN-IF-FAIL. 13670000
- 136800 13680000
- 136900 RUN-IF-GREAT-CHARS. 13690000
- 137000 IF CELL-NUM = ZERO 13700000
- 137100 GO TO RUN-IF-FAIL. 13710000
- 137200 IF CHAR (CELL-LOC1) > CHAR (CELL-LOC2) 13720000
- 137300 GO TO NEXT-CELL. 13730000
- 137400 IF CHAR (CELL-LOC1) = CHAR (CELL-LOC2) 13740000
- 137500 ADD 1 TO CELL-LOC1 13750000
- 137600 ADD 1 TO CELL-LOC2 13760000
- 137700 SUBTRACT 1 FROM CELL-NUM 13770000
- 137800 GO TO RUN-IF-GREAT-CHARS. 13780000
- 137900 GO TO RUN-IF-FAIL. 13790000
- 138000 13800000
- 138100 RUN-IF-LESS-CHARS. 13810000
- 138200 IF CELL-NUM = ZERO 13820000
- 138300 GO TO RUN-IF-FAIL. 13830000
- 138400 IF CHAR (CELL-LOC1) < CHAR (CELL-LOC2) 13840000
- 138500 GO TO NEXT-CELL. 13850000
- 138600 IF CHAR (CELL-LOC1) = CHAR (CELL-LOC2) 13860000
- 138700 ADD 1 TO CELL-LOC1 13870000
- 138800 ADD 1 TO CELL-LOC2 13880000
- 138900 SUBTRACT 1 FROM CELL-NUM 13890000
- 139000 GO TO RUN-IF-LESS-CHARS. 13900000
- 139100 GO TO RUN-IF-FAIL. 13910000
- 139200 13920000
- 139300 RUN-IF-FAIL. 13930000
- 139400 MOVE CELL-EXIT TO CELL-POINT. 13940000
- 139500 GO TO ACTION-CELL. 13950000
- 139600 13960000
- 139700 RUN-IF-NOT-EQUAL-CHARS. 13970000
- 139800 SUBTRACT 1 FROM CELL-EXIT GIVING POYNT. 13980000
- 139900 ADD 1 CELL-POINT GIVING CELL-EXIT. 13990000
- 140000 MOVE POYNT TO CELL-POINT. 14000000
- 140100 GO TO RUN-IF-EQUAL-CHARS. 14010000
- 140200 14020000
- 140300 RUN-IF-NOT-GREAT-CHARS. 14030000
- 140400 SUBTRACT 1 FROM CELL-EXIT GIVING POYNT. 14040000
- 140500 ADD 1 CELL-POINT GIVING CELL-EXIT. 14050000
- 140600 MOVE POYNT TO CELL-POINT. 14060000
- 140700 GO TO RUN-IF-GREAT-CHARS. 14070000
- 140800 14080000
- 140900 RUN-IF-NOT-LESS-CHARS. 14090000
- 141000 SUBTRACT 1 FROM CELL-EXIT GIVING POYNT. 14100000
- 141100 ADD 1 CELL-POINT GIVING CELL-EXIT. 14110000
- 141200 MOVE POYNT TO CELL-POINT. 14120000
- 141300 GO TO RUN-IF-LESS-CHARS. 14130000
- 141400 14140000
- 141500 RUN-MOVE-1B-D. 14150000
- 141600* CONVERTS A BINARY WORD TO DISPLAY 14160000
- 141700 MOVE BINARY-WORD (CELL-LOC1) TO NUM-FIELD. 14170000
- 141800 SUBTRACT CELL-EXIT FROM 7 GIVING POYNT. 14180000
- 141900 14190000
- 142000 RMBD-MOVE. 14200000
- 142100 IF CELL-EXIT < 1 14210000
- 142200 GO TO NEXT-CELL. 14220000
- 142300 MOVE NUM-CHAR (POYNT) TO CHAR (CELL-LOC2). 14230000
- 142400 ADD 1 TO POYNT. 14240000
- 142500 ADD 1 TO CELL-LOC2. 14250000
- 142600 SUBTRACT 1 FROM CELL-EXIT. 14260000
- 142700 GO TO RMBD-MOVE. 14270000
- 142800 14280000
- 142900 RUN-MOVE-CHARS. 14290000
- 143000* SUBROUTINE MOVECHAR USED FOR EFFICIENCY ONLY 14300000
- 143100* ENTER PLAN MOVECHAR USING CELL-LOC1 IN-RECORD. 14310000
- 143200* GO TO NEXT-CELL. 14320000
- 143300 IF CELL-NUM = ZERO 14330000
- 143400 GO TO NEXT-CELL. 14340000
- 143500 MOVE CHAR (CELL-LOC1) TO CHAR (CELL-LOC2). 14350000
- 143600 ADD 1 TO CELL-LOC1. 14360000
- 143700 ADD 1 TO CELL-LOC2. 14370000
- 143800 SUBTRACT 1 FROM CELL-NUM. 14380000
- 143900 GO TO RUN-MOVE-CHARS. 14390000
- 144000 14400000
- 144100 RUN-MOVE-D-1B. 14410000
- 144200* CONVERTS DISPLAY NUMERICS TO BINARY 14420000
- 144300 MOVE SPACES TO NUM-FIELD-X. 14430000
- 144400 SUBTRACT CELL-NUM FROM 7 GIVING POYNT. 14440000
- 144500 14450000
- 144600 RMDB-MOVE. 14460000
- 144700 MOVE CHAR (CELL-LOC1) TO NUM-CHAR (POYNT). 14470000
- 144800 ADD 1 TO CELL-LOC1. 14480000
- 144900 ADD 1 TO POYNT. 14490000
- 145000 SUBTRACT 1 FROM CELL-NUM. 14500000
- 145100 IF CELL-NUM > 0 14510000
- 145200 GO TO RMDB-MOVE. 14520000
- 145300 MOVE NUM-FIELD TO BINARY-WORD (CELL-LOC2). 14530000
- 145400 GO TO NEXT-CELL. 14540000
- 145500 14550000
- 145600 RUN-MULTIPLY. 14560000
- 145700 MULTIPLY BINARY-WORD (CELL-LOC1) BY BINARY-WORD (CELL-LOC2). 14570000
- 145800 GO TO NEXT-CELL. 14580000
- 145900 14590000
- 146000 RUN-PERFORM. 14600000
- 146100 ADD 1 CELL-POINT GIVING CELL-STORE-EXIT (CELL-LOC2). 14610000
- 146200 MOVE CELL-LOC1 TO CELL-POINT. 14620000
- 146300 GO TO ACTION-CELL. 14630000
- 146400 14640000
- 146500 RUN-PRINT. 14650000
- 146600 CALL A510 USING A510-AREA. 14660000
- 146700* A510 IS A GENERAL PRINTING ROUTINE THAT HANDLES HEADINGS ETC 14670000
- 146800 MOVE SPACES TO PRINT-AREA. 14680000
- 146900 GO TO NEXT-CELL. 14690000
- 147000 14700000
- 147100 RUN-READ. 14710000
- 147200 IF CELL-LOC2 NOT ZERO 14720000
- 147300 GO TO RR-CARD. 14730000
- 147400 IF IN-FILE-POINT ZERO 14740000
- 147500 MOVE OPEN-INPUT TO MODE-REQUIRED 14750000
- 147600 GO TO RR-OPEN. 14760000
- 147700 IF CELL-LOC1 = IN-FILE-NO 14770000
- 147800 GO TO RR-READ. 14780000
- 147900 MOVE OPEN-INPUT TO MODE-REQUIRED. 14790000
- 148000 PERFORM CLOSE-FILE. 14800000
- 148100 14810000
- 148200 RR-OPEN. 14820000
- 148300 PERFORM OPEN-FILE. 14830000
- 148400 IF END-FILE-FLAG NOT ZERO 14840000
- 148500 GO TO NEXT-CELL. 14850000
- 148600 14860000
- 148700 RR-READ. 14870000
- 148800 IF IN-TYPE = INPUT-DA 14880000
- 148900 READ IN-DA 14890000
- 149000 AT END GO TO RUN-READ-END. 14900000
- 149100 IF IN-TYPE = INPUT-MT 14910000
- 149200 READ IN-MT 14920000
- 149300 AT END GO TO RUN-READ-END. 14930000
- 149400 ADD 1 TO RECS-IN. 14940000
- 149500 IF RECORD-WORD-COUNT > 200 14950000
- 149600 STOP "ABANDON, RECORD TOO LONG". 14960000
- 149700 14970000
- 149800 RR-NEXT. 14980000
- 149900 MOVE CELL-EXIT TO CELL-POINT. 14990000
- 150000 GO TO ACTION-CELL. 15000000
- 150100 15010000
- 150200 RR-CARD. 15020000
- 150300 READ CARD-FILE 15030000
- 150400 AT END GO TO NEXT-CELL. 15040000
- 150500 MOVE CARD-RECORD TO CARD-AREA. 15050000
- 150600 GO TO RR-NEXT. 15060000
- 150700 15070000
- 150800 RUN-READ-END. 15080000
- 150900 MOVE OPEN-INPUT TO MODE-REQUIRED. 15090000
- 151000 PERFORM CLOSE-FILE. 15100000
- 151100 PERFORM OPEN-FILE. 15110000
- 151200 IF END-FILE-FLAG NOT ZERO 15120000
- 151300 GO TO NEXT-CELL. 15130000
- 151400 GO TO RUN-READ. 15140000
- 151500 15150000
- 151600 RUN-STOP. 15160000
- 151700 GO TO CLOSE-FILES. 15170000
- 151800 15180000
- 151900 RUN-SUBTRACT. 15190000
- 152000 SUBTRACT BINARY-WORD (CELL-LOC1) FROM BINARY-WORD (CELL-LOC2).15200000
- 152100 GO TO NEXT-CELL. 15210000
- 152200 15220000
- 152300 RUN-WRITE. 15230000
- 152400 MOVE RECORD-WORD-COUNT TO NUMBER. 15240000
- 152500 IF OUT-FILE-POINT ZERO 15250000
- 152600 MOVE OPEN-OUTPUT TO MODE-REQUIRED 15260000
- 152700 GO TO RW-OPEN. 15270000
- 152800 IF CELL-LOC1 = OUT-FILE-NO 15280000
- 152900 GO TO RW-WRITE. 15290000
- 153000 MOVE OPEN-OUTPUT TO MODE-REQUIRED. 15300000
- 153100 PERFORM CLOSE-FILE. 15310000
- 153200 15320000
- 153300 RW-OPEN. 15330000
- 153400 PERFORM OPEN-FILE. 15340000
- 153500 15350000
- 153600 RW-WRITE. 15360000
- 153700 MOVE NUMBER TO RECORD-WORD-COUNT. 15370000
- 153800 IF OUT-TYPE = OUTPUT-DA 15380000
- 153900 WRITE OUT-DA-REC 15390000
- 154000 PERFORM OUT-REPLY-CHECK 15400000
- 154100 GO TO RUN-WRITE-END. 15410000
- 154200 IF OUT-TYPE = OUTPUT-MT-2048 15420000
- 154300 WRITE OUT-MT-2048-REC 15430000
- 154400 GO TO RUN-WRITE-END. 15440000
- 154500 IF OUT-TYPE = OUTPUT-MT-512 15450000
- 154600 WRITE OUT-MT-512-REC 15460000
- 154700 GO TO RUN-WRITE-END. 15470000
- 154800 IF OUT-TYPE = OUTPUT-MT-128 15480000
- 154900 WRITE OUT-MT-128-REC 15490000
- 155000 GO TO RUN-WRITE-END. 15500000
- 155100 IF OUT-TYPE = OUTPUT-MT-64 15510000
- 155200 WRITE OUT-MT-64-REC. 15520000
- 155300 15530000
- 155400 RUN-WRITE-END. 15540000
- 155500 MOVE NUMBER TO RECORD-WORD-COUNT. 15550000
- 155600 ADD 1 TO RECS-OUT. 15560000
- 155700 GO TO NEXT-CELL. 15570000
- 155800 15580000
- 155900 CLOSE-FILES. 15590000
- 156000 PERFORM CLOSE-CARD-PRINTER. 15600000
- 156100 MOVE OPEN-INPUT TO MODE-REQUIRED. 15610000
- 156200 PERFORM CLOSE-FILE. 15620000
- 156300 MOVE OPEN-OUTPUT TO MODE-REQUIRED. 15630000
- 156400 PERFORM CLOSE-FILE. 15640000
- 156500 IF RECS-IN NOT ZERO 15650000
- 156600 DISPLAY "IN " RECS-IN. 15660000
- 156700 IF RECS-OUT NOT ZERO 15670000
- 156800 DISPLAY "OUT " RECS-OUT. 15680000
- 156900 STOP RUN. 15690000
- 157000 15700000
- 157100 OPEN-FILE SECTION. 15710000
- 157200 15720000
- 157300 OF-INITIALISE. 15730000
- 157400 MOVE ZERO TO FILE-POINT END-FILE-FLAG. 15740000
- 157500 15750000
- 157600 OF-NEXT-FILE. 15760000
- 157700 ADD 1 TO FILE-POINT. 15770000
- 157800 IF FILE-POINT > FILE-TABLE-SIZE 15780000
- 157900 MOVE 1 TO END-FILE-FLAG 15790000
- 158000 GO TO OF-EXIT. 15800000
- 158100 15810000
- 158200 MOVE FILE-DATA (FILE-POINT) TO WORK-FILE-DATA. 15820000
- 158300 IF WORK-MODE NOT = MODE-REQUIRED 15830000
- 158400 OR WORK-FILE-NO NOT = CELL-LOC1 15840000
- 158500 OR FILE-STATUS-FLAG (FILE-POINT) NOT ZERO 15850000
- 158600 GO TO OF-NEXT-FILE. 15860000
- 158700 MOVE 1 TO FILE-STATUS-FLAG (FILE-POINT). 15870000
- 158800 IF MODE-REQUIRED = OPEN-INPUT 15880000
- 158900 GO TO OF-INPUT. 15890000
- 159000 15900000
- 159100 OF-OUTPUT. 15910000
- 159200 MOVE WORK-FILE-DATA TO OUT-FILE-DATA. 15920000
- 159300 MOVE FILE-POINT TO OUT-FILE-POINT. 15930000
- 159400 15940000
- 159500 OF-OUTPUT-DA. 15950000
- 159600 IF OUT-TYPE > FILE-TYPE-DA 15960000
- 159700 GO TO OF-OUTPUT-MT. 15970000
- 159800 IF OUT-TYPE = OUTPUT-DA 15980000
- 159900 OPEN OUTPUT OUT-DA 15990000
- 160000 GO TO OF-TEST-OUT-REPLY. 16000000
- 160100 GO TO OF-ABANDON. 16010000
- 160200 16020000
- 160300 OF-TEST-OUT-REPLY. 16030000
- 160400 IF REPLY-WORD NOT ZERO 16040000
- 160500 DISPLAY "FILE " OUT-NAME " REPLY " REPLY-WORD 16050000
- 160600 GO TO OF-OUTPUT-DA. 16060000
- 160700 DISPLAY "ED " OUT-NAME " OPEN OUTPUT". 16070000
- 160800 GO TO OF-EXIT. 16080000
- 160900 16090000
- 161000 OF-OUTPUT-MT. 16100000
- 161100 IF OUT-TYPE = OUTPUT-MT-2048 16110000
- 161200 OPEN OUTPUT OUT-MT-2048 16120000
- 161300 GO TO OF-EXIT. 16130000
- 161400 IF OUT-TYPE = OUTPUT-MT-512 16140000
- 161500 OPEN OUTPUT OUT-MT-512 16150000
- 161600 GO TO OF-EXIT. 16160000
- 161700 IF OUT-TYPE = OUTPUT-MT-128 16170000
- 161800 OPEN OUTPUT OUT-MT-128 16180000
- 161900 GO TO OF-EXIT. 16190000
- 162000 IF OUT-TYPE = OUTPUT-MT-64 16200000
- 162100 OPEN OUTPUT OUT-MT-64 16210000
- 162200 GO TO OF-EXIT. 16220000
- 162300 GO TO OF-ABANDON. 16230000
- 162400 16240000
- 162500 OF-INPUT. 16250000
- 162600 MOVE WORK-FILE-DATA TO IN-FILE-DATA. 16260000
- 162700 MOVE FILE-POINT TO IN-FILE-POINT. 16270000
- 162800 16280000
- 162900 OF-INPUT-DA. 16290000
- 163000 IF IN-TYPE > FILE-TYPE-DA 16300000
- 163100 GO TO OF-INPUT-MT. 16310000
- 163200 IF IN-TYPE = INPUT-DA 16320000
- 163300 OPEN INPUT IN-DA 16330000
- 163400 GO TO OF-TEST-IN-REPLY. 16340000
- 163500 GO TO OF-ABANDON. 16350000
- 163600 16360000
- 163700 OF-TEST-IN-REPLY. 16370000
- 163800 IF REPLY-WORD NOT ZERO 16380000
- 163900 DISPLAY "FILE " IN-NAME " REPLY " REPLY-WORD 16390000
- 164000 GO TO OF-INPUT-DA. 16400000
- 164100 DISPLAY "ED " IN-NAME " OPEN INPUT". 16410000
- 164200 GO TO OF-EXIT. 16420000
- 164300 16430000
- 164400 OF-INPUT-MT. 16440000
- 164500 IF IN-TYPE = INPUT-MT 16450000
- 164600 OPEN INPUT IN-MT 16460000
- 164700 GO TO OF-EXIT. 16470000
- 164800 16480000
- 164900 OF-ABANDON. 16490000
- 165000 STOP "ABANDON, FILE NOT SPECIFIED". 16500000
- 165100 16510000
- 165200 OF-EXIT. 16520000
- 165300 IF END-FILE-FLAG NOT ZERO 16530000
- 165400 AND MODE-REQUIRED NOT = OPEN-INPUT 16540000
- 165500 GO TO OF-ABANDON. 16550000
- 165600 16560000
- 165700 CLOSE-FILE SECTION. 16570000
- 165800 16580000
- 165900 CLF-INITIALISE. 16590000
- 166000 MOVE ZERO TO REPLY-WORD. 16600000
- 166100 IF MODE-REQUIRED = OPEN-INPUT 16610000
- 166200 MOVE IN-FILE-POINT TO FILE-POINT 16620000
- 166300 ELSE 16630000
- 166400 MOVE OUT-FILE-POINT TO FILE-POINT. 16640000
- 166500 IF FILE-POINT ZERO 16650000
- 166600 GO TO CLF-EXIT. 16660000
- 166700 IF FILE-STATUS-FLAG (FILE-POINT) NOT = 1 16670000
- 166800 GO TO CLF-EXIT. 16680000
- 166900 MOVE 2 TO FILE-STATUS-FLAG (FILE-POINT). 16690000
- 167000 MOVE FILE-DATA (FILE-POINT) TO WORK-FILE-DATA. 16700000
- 167100 16710000
- 167200 CLF-CLOSE. 16720000
- 167300 IF WORK-TYPE = INPUT-DA 16730000
- 167400 CLOSE IN-DA 16740000
- 167500 GO TO CLF-EXIT. 16750000
- 167600 IF WORK-TYPE = OUTPUT-DA 16760000
- 167700 CLOSE OUT-DA 16770000
- 167800 GO TO CLF-EXIT. 16780000
- 167900 IF WORK-TYPE = INPUT-MT 16790000
- 168000 CLOSE IN-MT 16800000
- 168100 GO TO CLF-EXIT. 16810000
- 168200 IF WORK-TYPE = OUTPUT-MT-2048 16820000
- 168300 CLOSE OUT-MT-2048 16830000
- 168400 GO TO CLF-EXIT. 16840000
- 168500 IF WORK-TYPE = OUTPUT-MT-512 16850000
- 168600 CLOSE OUT-MT-512 16860000
- 168700 GO TO CLF-EXIT. 16870000
- 168800 IF WORK-TYPE = OUTPUT-MT-128 16880000
- 168900 CLOSE OUT-MT-128 16890000
- 169000 GO TO CLF-EXIT. 16900000
- 169100 IF WORK-TYPE = OUTPUT-MT-64 16910000
- 169200 CLOSE OUT-MT-64 16920000
- 169300 GO TO CLF-EXIT. 16930000
- 169400 STOP "ABANDON CLF". 16940000
- 169500 16950000
- 169600 CLF-EXIT. 16960000
- 169700 IF REPLY-WORD NOT ZERO 16970000
- 169800 DISPLAY "FILE " WORK-NAME " REPLY " REPLY-WORD 16980000
- 169900 STOP "ABANDON ON CLOSE". 16990000
- 170000 17000000
- 170100 RUN-TIME-SUBROUTNES SECTION. 17010000
- 170200 17020000
- 170300 OPEN-CARD-PRINTER. 17030000
- 170400 IF CARD-PRINTER-FLAG ZERO 17040000
- 170500 MOVE 1 TO CARD-PRINTER-FLAG 17050000
- 170600 OPEN INPUT CARD-FILE 17060000
- 170700 MOVE "OPEN" TO A510-CONTROL 17070000
- 170800 PERFORM PRINT. 17080000
- 170900 17090000
- 171000 CLOSE-CARD-PRINTER. 17100000
- 171100 IF CARD-PRINTER-FLAG NOT ZERO 17110000
- 171200 MOVE ZERO TO CARD-PRINTER-FLAG 17120000
- 171300 CLOSE CARD-FILE 17130000
- 171400 MOVE "CLSE" TO A510-CONTROL 17140000
- 171500 PERFORM PRINT. 17150000
- 171600 17160000
- 171700 OUT-REPLY-CHECK. 17170000
- 171800 IF REPLY-WORD NOT ZERO 17180000
- 171900 DISPLAY "FILE " OUT-NAME " REPLY " REPLY-WORD 17190000
- 172000 STOP "ABANDON, OVERFLOW". 17200000
- 172100**** 17210000
Add Comment
Please, Sign In to add comment
