COBOL 64/COBOL 128

This article or section is in the process of an expansion or major restructuring and is therefore classed as a work in progress. You are welcome to assist in its construction by editing it as well. If this article or section has not been edited in several days, please remove this template.

COBOL 64/COBOL 128
Developer	K. A. Alexander
Publisher	Abacus Software, Data Becker
Release	1984, V2.5
Platform	C64 C128
Genre	Coding Language for COBOL
Operation
Media
Language
Information	...

COBOL 64/128

This software package was developed by Abacus Software for use on the C64 (or 64 mode on the 128).

Code Example

Demo.

renumber.cbl

0001 IDENTIFICATION DIVISION.
0002 PROGRAM-ID.
0003     RENUMBER.
0004 AUTHOR.
0005     ELLIS COMPUTING.
0006 INSTALLATION.
0007     SAN FRANCISCO PROGRAMMING CENTER.
0008 DATE-WRITTEN.
0009     JANUARY 11, 1979.
0010 DATE-COMPILED.
0011     DECEMBER 21, 1981.
0012 SECURITY.
0013     NONE.
0014* This program renumbers a NEVADA COBOL source program file.
0015 ENVIRONMENT DIVISION.
0016 CONFIGURATION SECTION.
0017 SOURCE-COMPUTER.
0018     8080-CPU.
0019 OBJECT-COMPUTER.
0020     8080-CPU.
0021 INPUT-OUTPUT SECTION.
0022 FILE-CONTROL.
0023     SELECT FILE-TO-RENUMBER ASSIGN TO DISK
0024       RECORD DELIMITER IS STANDARD.
0025     SELECT COPY-FILE ASSIGN TO DISK
0026       RECORD DELIMITER IS STANDARD.
0027 DATA DIVISION.
0028 FILE SECTION.
0029 FD FILE-TO-RENUMBER
0030     LABEL RECORDS ARE STANDARD
0031     VALUE OF FILE-ID IS RE-NUMBER-FILE-NAME
0032     DATA RECORD IS A-RECORD.
0033 01 A-RECORD.
0034     02 SEQ-NUMBER PIC 9999.
0035     02 CKCOPY PIC X(6).
0036     02 CKFILE.
0037     03 BYTE OCCURS 70 TIMES PIC X.
0038 01 A1-RECORD.
0039     02 FILLER PIC XXX.
0040     02 CK-SHORT PIC X(77).
0041 01 A2-RECORD.
0042     02 CK-TAB OCCURS 4 TIMES PIC X.
0043     02 FILLER PIC X(76).
0044 FD COPY-FILE
0045     LABEL RECORDS ARE STANDARD
0046     VALUE OF FILE-ID IS COPY-FILE-NAME
0047     DATA RECORD IS C-RECORD.
0048 01 C-RECORD.
0049     02 COPY-SEQ-NUMBER PIC 9999.
0050     02 FILLER PIC IS X(76).
0051 01 C1-RECORD.
0052     02 FILLER PIC XXX.
0053     02 C-CK-SHORT PIC X(77).
0054 01 C2-RECORD.
0055     02 C-CK-TAB OCCURS 4 TIMES PIC X.
0056     02 FILLER PIC X(76).
0057 WORKING-STORAGE SECTION.
0058 01 NEW-SEQ-NUMBER PIC 9999
0059         VALUE IS 0001.
0060 01 RE-NUMBER-FILE-NAME PIC X(14)
0061         VALUE "A:FILENAME.TYP".
0062 01 COPY-FILE-NAME.
0063     02 H-LABEL.
0064     03 H-BYTE OCCURS 10 TIMES PIC X.
0065     02 FILLER PIC X(4)
0066         VALUE ".CBL".
0067 01 SUBSCRIPTS.
0068     02 X1 PIC 99
0069         VALUE 01 COMP.
0070     02 X2 PIC 99
0071         VALUE 01 COMP.
0072 PROCEDURE DIVISION.
0073 BEGIN.
0074     DISPLAY "ENTER FILE NAME ".
0075     DISPLAY RE-NUMBER-FILE-NAME WITH NO ADVANCING.
0076     ACCEPT RE-NUMBER-FILE-NAME.
0077     OPEN I-O FILE-TO-RENUMBER.
0078 GET-NEXT-RECORD.
0079     MOVE SPACE TO A-RECORD.
0080     READ FILE-TO-RENUMBER
0081       AT END
0082       GO TO END-OF-JOB.
0083     IF CK-SHORT = SPACE
0084       DISPLAY "CANNOT RENUMBER BLANK LINES"
0085       GO TO SKIP-1.
0086     IF CK-TAB (1) = ""09"" OR
0087       CK-TAB (2) = ""09"" OR
0088       CK-TAB (3) = ""09"" OR
0089       CK-TAB (4) = ""09""
0090       DISPLAY "CANNOT RENUMBER TABS"
0091       GO TO SKIP-1.
0092     MOVE NEW-SEQ-NUMBER TO SEQ-NUMBER.
0093 SKIP-1.
0094     ADD 1 TO NEW-SEQ-NUMBER.
0095D    DISPLAY A-RECORD.
0096     REWRITE A-RECORD.
0097     IF CKCOPY = "  COPY "
0098       PERFORM ALT-FILE THRU ALT-FILE-EXT.
0099     GO TO GET-NEXT-RECORD.
0100 ALT-FILE.
0101     MOVE 1 TO X1.
0102     MOVE 1 TO X2.
0103     MOVE SPACE TO H-LABEL.
0104 ALT1.
0105     IF BYTE (X1) = SPACE
0106       ADD 1 TO X1
0107       GO TO ALT1.
0108 NXT-BYTE.
0109     IF BYTE (X1) = "."
0110       GO TO OPN-2.
0111     MOVE BYTE (X1) TO H-BYTE (X2).
0112     ADD 1 TO X1.
0113     ADD 1 TO X2.
0114     IF X2 = 11
0115       GO TO OPN-2.
0116     GO TO NXT-BYTE.
0117 OPN-2.
0118     OPEN I-O COPY-FILE.
0119 NXT-C-RECORD.
0120     MOVE SPACE TO C-RECORD.
0121     READ COPY-FILE
0122       AT END
0123       GO TO END-COPY.
0124     IF C-CK-SHORT = SPACE
0125       DISPLAY "CANNOT RENUMBER BLANK LINE"
0126       GO TO SKIP-C-1.
0127     IF C-CK-TAB (1) = ""09"" OR
0128       C-CK-TAB (2) = ""09"" OR
0129       C-CK-TAB (3) = ""09"" OR
0130       C-CK-TAB (4) = ""09""
0131       DISPLAY "CANNOT RENUMBER TABS "
0132       GO TO SKIP-C-1.
0133     MOVE NEW-SEQ-NUMBER TO COPY-SEQ-NUMBER.
0134 SKIP-C-1.
0135     ADD 1 TO NEW-SEQ-NUMBER.
0136D    DISPLAY C-RECORD.
0137     REWRITE C-RECORD.
0138     GO TO NXT-C-RECORD.
0139 END-COPY.
0140     CLOSE COPY-FILE.
0141 ALT-FILE-EXT.
0142     EXIT.
0143 END-OF-JOB.
0144     CLOSE FILE-TO-RENUMBER.
0145     DISPLAY "RENUMBERING COMPLETE".
0146     STOP RUN.
0147 END PROGRAM RENUMBER.

Links

• COBOL-64/128 Manual