Trailing-Edge
-
PDP-10 Archives
-
BB-AE97A-BM
-
uetp/lib/rmtcbs.cbl
There are 4 other files named rmtcbs.cbl in the archive. Click here to see a list.
ID DIVISION.
PROGRAM-ID. RMTCBS.
* RMS TEST FOR COBOL.
* THIS IS A SIMPLE TEST OF THE VARIOUS RMS FUNCTIONS NEEDED FOR COBOL.
* IT TRIES TO TEST A LITTLE OF EVERYTHING FOR RMS SEQUENTIAL FILES.
*
* COPYRIGHT (c) 1984 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
*
ENVIRONMENT DIVISION.
I-O SECTION.
FILE-CONTROL.
SELECT FILE-1 ASSIGN TO DSK
RECORDING MODE SIXBIT
ORGANIZATION IS RMS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-2 ASSIGN TO DSK
RECORDING MODE ASCII
ORGANIZATION IS RMS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT FILE-3 ASSIGN TO DSK
RECORDING MODE F
ORGANIZATION IS RMS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD FILE-1 VALUE OF ID IS "RMTF1 RMS".
01 REC-1.
02 FILLER PIC X(5).
02 RK1 PIC X(5).
02 AK1-1 PIC X(5).
02 AK1-2 PIC 9(5).
02 FILLER PIC X(5).
FD FILE-2 VALUE OF ID IS "RMTF2 RMS".
01 REC-2 DISPLAY-7.
02 FILLER PIC X(5).
02 RK2 PIC X(5).
02 AK2-1 PIC X(5).
02 AK2-2 PIC 9(5).
02 FILLER PIC X(5).
FD FILE-3 VALUE OF ID IS "RMTF3 RMS".
01 REC-3 DISPLAY-9.
02 FILLER PIC X(5).
02 RK3 PIC X(5).
02 AK3-1 PIC X(5).
02 AK3-2 PIC 9(5).
02 FILLER PIC X(5).
WORKING-STORAGE SECTION.
01 F2R1 PIC X(25) VALUE "XXXXXAAAAADDDDD55555XXXXX".
01 F2R2 PIC X(25) VALUE "YYYYYBBBBBEEEEE66666XYXYX".
01 F2R3 PIC X(25) VALUE "XXXXYCCCCCFFFFF77777XXYXX".
01 F2R4 PIC X(25) VALUE "XXYYXDDDDDGGGGG88888YXYXY".
01 F2R5 PIC X(25) VALUE "YYXXYEEEEEHHHHH99999YYYYX".
PROCEDURE DIVISION.
STARTER-S.
OPEN OUTPUT FILE-1.
WRITE REC-1 FROM F2R1.
WRITE REC-1 FROM F2R2.
WRITE REC-1 FROM F2R3.
CLOSE FILE-1.
EXTENDER-S.
OPEN EXTEND FILE-1.
WRITE REC-1 FROM F2R4.
WRITE REC-1 FROM F2R5.
CLOSE FILE-1.
READER-S.
OPEN I-O FILE-1.
S-1.
READ FILE-1 AT END DISPLAY "?S-1".
S-2.
IF REC-1 NOT = F2R1 DISPLAY "?S-2".
S-2A.
MOVE "MMMMM" TO AK1-1.
REWRITE REC-1 INVALID KEY DISPLAY "?S-2A".
S-3.
READ FILE-1 AT END DISPLAY "?S-3".
S-4.
IF REC-1 NOT = F2R2 DISPLAY "?S-4".
S-5.
READ FILE-1 AT END DISPLAY "?S-5".
S-6.
IF REC-1 NOT = F2R3 DISPLAY "?S-6".
S-7.
READ FILE-1 AT END DISPLAY "?S-7".
S-8.
IF REC-1 NOT = F2R4 DISPLAY "?S-8".
S-9.
READ FILE-1 AT END DISPLAY "?S-9".
S-10.
IF REC-1 NOT = F2R5 DISPLAY "?S-10".
S-11.
READ FILE-1 AT END GO TO S-12.
DISPLAY "?S-11".
S-12.
CLOSE FILE-1.
OPEN INPUT FILE-1.
S-13.
READ FILE-1 AT END DISPLAY "?S-13".
S-14.
IF AK1-1 NOT = "MMMMM" DISPLAY "?S-14".
CLOSE FILE-1.
STARTER-A.
OPEN OUTPUT FILE-2.
WRITE REC-2 FROM F2R1.
WRITE REC-2 FROM F2R2.
WRITE REC-2 FROM F2R3.
CLOSE FILE-2.
EXTENDER-A.
OPEN EXTEND FILE-2.
WRITE REC-2 FROM F2R4.
WRITE REC-2 FROM F2R5.
CLOSE FILE-2.
READER-A.
OPEN INPUT FILE-2.
MOVE SPACES TO REC-2.
S-20.
READ FILE-2 AT END DISPLAY "?S-20".
S-21.
READ FILE-2 AT END DISPLAY "?S-21".
S-22.
IF REC-2 NOT = F2R2 DISPLAY "?S-22".
S-23.
READ FILE-2 AT END DISPLAY "?S-23".
S-24.
IF REC-2 NOT = F2R3 DISPLAY "?S-24".
S-25.
READ FILE-2 AT END DISPLAY "?S-25".
S-26.
IF REC-2 NOT = F2R4 DISPLAY "?S-26".
S-27.
READ FILE-2 AT END DISPLAY "?S-27".
S-28.
IF REC-2 NOT = F2R5 DISPLAY "?S-28".
S-29.
READ FILE-2 AT END GO TO S-30.
DISPLAY "?S-29".
S-30.
IF REC-2 NOT = F2R5 DISPLAY "?S-30".
S-31.
CLOSE FILE-2.
STARTER-E.
OPEN OUTPUT FILE-3.
WRITE REC-3 FROM F2R1.
WRITE REC-3 FROM F2R2.
WRITE REC-3 FROM F2R3.
CLOSE FILE-3.
EXTENDER-E.
OPEN EXTEND FILE-3.
WRITE REC-3 FROM F2R4.
WRITE REC-3 FROM F2R5.
CLOSE FILE-3.
READER-E.
OPEN I-O FILE-3.
S-41.
READ FILE-3 AT END DISPLAY "?S-41".
S-42.
IF REC-3 NOT = F2R1 DISPLAY "?S-42".
S-42A.
MOVE "MMMMM" TO AK3-1.
REWRITE REC-3 INVALID KEY DISPLAY "?S-42A".
S-43.
READ FILE-3 AT END DISPLAY "?S-43".
S-44.
IF REC-3 NOT = F2R2 DISPLAY "?S-44".
S-45.
READ FILE-3 AT END DISPLAY "?S-45".
S-46.
IF REC-3 NOT = F2R3 DISPLAY "?S-46".
S-47.
READ FILE-3 AT END DISPLAY "?S-47".
S-48.
IF REC-3 NOT = F2R4 DISPLAY "?S-48".
S-49.
READ FILE-3 AT END DISPLAY "?S-49".
S-50.
IF REC-3 NOT = F2R5 DISPLAY "?S-50".
S-51.
READ FILE-3 AT END GO TO S-52.
DISPLAY "?S-51".
S-52.
CLOSE FILE-3.
OPEN INPUT FILE-3.
S-53.
READ FILE-3 AT END DISPLAY "?S-53".
S-54.
IF AK3-1 NOT = "MMMMM" DISPLAY "?S-54".
CLOSE FILE-3.
T-DONE.
DISPLAY "[RMS/COBOL - Completed test for Sequential Files]".
STOP RUN.