PDP-10 Archive: ii.ctl from bb-k345a-sb

Trailing-Edge - PDP-10 Archives - bb-k345a-sb - ii.ctl

There are 5 other files named ii.ctl in the archive. Click here to see a list.

;II.CTL  %007.2   CREATE, COMPILE, AND EXECUTE II.CBL TO TEST COBOL
;DISK I/O SEQUENTIAL AND RANDOM, SIXBIT AND ASCII
!;;FOR 601/507 MONITOR
;TO RUN II.CTL TYPE
;	.QUE INP:=II/OUT:2/TIME:1000,/DIS:DEL
;II IS USUALLY RUN BY MONTST.CTL IN WEEKLY MONITOR TEST
;6 MARCH 73   P WHITE	MODIFIED  3 JUL 74  SM LIBMAN
;
.GOTO SKIP
IICBL::
IDENTIFICATION DIVISION.
PROGRAM-ID. IITEST.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
OBJECT-COMPUTER. PDP-10.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT 1SEG-BLOCK-SEQ-SIX-FILE ASSIGN TO DSK.
	SELECT 2SEG-BLOCK-SEQ-SIX-FILE ASSIGN TO DSK.
	SELECT UNBLOCKED-SEQ-SIX-FILE  ASSIGN TO DEV1.
	SELECT 1SEG-BLOCK-SEQ-ASC-FILE ASSIGN TO DSK.
	SELECT 2SEG-BLOCK-SEQ-ASC-FILE ASSIGN TO DSK.
	SELECT UNBLOCKED-SEQ-ASC-FILE  ASSIGN TO DEV2.
	SELECT 1SEG-BLOCK1-SEQ-ASC-FILE ASSIGN TO DSK.
	SELECT 2SEG-BLOCK1-SEQ-ASC-FILE ASSIGN TO DSK.

	SELECT 1SEG-BLOCK-RAN-SIX-FILE ASSIGN TO DSK;
		ACCESS MODE IS RANDOM;
		ACTUAL KEY IS I; FILE-LIMIT IS 99.
	SELECT 2SEG-BLOCK-RAN-SIX-FILE ASSIGN TO DSK;
		ACCESS MODE IS RANDOM;
		ACTUAL KEY IS I; FILE-LIMIT IS 99.
	SELECT 1SEG-RAN-ASC-FILE       ASSIGN TO DSK;
		ACCESS MODE IS RANDOM;
		ACTUAL KEY IS I; FILE-LIMIT IS 99.
	SELECT 2SEG-RAN-ASC-FILE       ASSIGN TO DSK;
		ACCESS MODE IS RANDOM;
		ACTUAL KEY IS I; FILE-LIMIT IS 99.

DATA DIVISION.
FILE SECTION.

FD	1SEG-BLOCK-SEQ-ASC-FILE
	BLOCK CONTAINS 8 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "1BA   TMP"
	DATA RECORD IS 1BSA-REC.

01	1BSA-REC	DISPLAY-7.
	02 1BSA-COUNT	PICTURE S9(6).
	02 1BSA-FILLER	PICTURE X(72).

FD	2SEG-BLOCK-SEQ-ASC-FILE
	BLOCK CONTAINS 16 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "2BA   TMP"
	DATA RECORD IS 2BSA-REC.

01	2BSA-REC	DISPLAY-7.
	02 2BSA-COUNT	PICTURE S9(6).
	02 2BSA-FILLER	PICTURE X(72).

FD	UNBLOCKED-SEQ-ASC-FILE
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "UBA   TMP"
	DATA RECORD IS UBSA-REC.

01	UBSA-REC	DISPLAY-7.
	02 UBSA-COUNT	PICTURE S9(6).
	02 UBSA-FILLER	PICTURE X(72).

FD	1SEG-BLOCK-SEQ-SIX-FILE
	BLOCK CONTAINS 8 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "1BS   TMP"
	DATA RECORD IS 1BSS-REC.

01	1BSS-REC	DISPLAY-6.
	02 1BSS-COUNT	PICTURE S9(6).
	02 1BSS-FILLER	PICTURE X(72).

FD	2SEG-BLOCK-SEQ-SIX-FILE
	BLOCK CONTAINS 16 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "2BS   TMP"
	DATA RECORD IS 2BSS-REC.

01	2BSS-REC	DISPLAY-6.
	02 2BSS-COUNT	PICTURE S9(6).
	02 2BSS-FILLER	PICTURE X(72).

FD	UNBLOCKED-SEQ-SIX-FILE
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "UBS   TMP"
	DATA RECORD IS UBSS-REC.

01	UBSS-REC	DISPLAY-6.
	02 UBSS-COUNT	PICTURE S9(6).
	02 UBSS-FILLER	PICTURE X(72).

FD	1SEG-BLOCK-RAN-SIX-FILE
	BLOCK CONTAINS 8 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "1BS   TMP"
	DATA RECORD IS 1BRS-REC.

01	1BRS-REC.
	02 1BRS-COUNT	PICTURE S9(6).
	02 1BRS-COUNT-1	PICTURE S9(6).
	02 FILLER	PICTURE X(66).

FD	2SEG-BLOCK-RAN-SIX-FILE
	BLOCK CONTAINS 16 RECORDS
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "2BS   TMP"
	DATA RECORD IS 2BRS-REC.

01	2BRS-REC.
	02 2BRS-COUNT	PICTURE S9(6).
	02 2BRS-COUNT-1	PICTURE S9(6).
	02 FILLER	PICTURE X(66).

FD	1SEG-BLOCK1-SEQ-ASC-FILE
	BLOCK CONTAINS 1 RECORD
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "1BA   TMP"
	DATA RECORD IS 1B1SA-REC.

01	1B1SA-REC PIC X(78) DISPLAY-7.

FD	2SEG-BLOCK1-SEQ-ASC-FILE
	BLOCK CONTAINS 1 RECORD
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "2BA   TMP"
	DATA RECORD IS 2B1SA-REC.

01	2B1SA-REC PIC X(700); DISPLAY-7.

FD	1SEG-RAN-ASC-FILE
	BLOCK CONTAINS 1 RECORD
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "1BA   TMP"
	DATA RECORD IS 1BRA-REC.

01	1BRA-REC;	DISPLAY-7.
	02 1BRA-COUNT	PICTURE S9(6).
	02 1BRA-COUNT-1	PICTURE S9(6).
	02 FILLER	PICTURE X(66).

FD	2SEG-RAN-ASC-FILE
	BLOCK CONTAINS 1 RECORD
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS "2BA   TMP"
	DATA RECORD IS 2BRA-REC.

01	2BRA-REC;	DISPLAY-7.
	02 2BRA-COUNT	PICTURE S9(6).
	02 2BRA-COUNT-1	PICTURE S9(6).
	02 FILLER	PICTURE X(688).

WORKING-STORAGE SECTION.

77	COUNTER		PICTURE S9(6) COMPUTATIONAL.
77	HOLD-COUNT		PIC S9(6) COMP.
77	CONSTANT	PIC S9(5) COMP; VALUE 32771.
77	RANDOM-NUM	PIC S9(10) COMP.
77	TEMP		PIC S9(10) COMP.
77	I		PIC S9(10) COMP.
01	MESSAGE-1	DISPLAY-7.
	02 FILLER	PIC X(27) VALUE "?SOME AT END, NOT OTHERS...".
	02 FILLER	PIC X     VALUE QUOTE.
	02 END-FLAGS.
	  03 1BSS-FLAG	PIC X.
	  03 2BSS-FLAG	PIC X.
	  03 UBSS-FLAG	PIC X.
	  03 1BSA-FLAG	PIC X.
	  03 2BSA-FLAG	PIC X.
	  03 UBSA-FLAG	PIC X.
	02 FILLER	PIC X     VALUE QUOTE.
	02 FILLER	PIC X(11) VALUE " AT RECORD ".

01	RECORD-DATA.
	02 RECORD-COUNT	PIC S9(6).
	02 DUMMY-COUNT	PIC S9(6); VALUE ZERO.
	02 FILLER	PIC X(66); VALUE SPACES.

01	RW-TABLE.
	02 SEG-TYPE OCCURS 2 TIMES.
	  03 RW-ENTRY OCCURS 99 TIMES; PICTURE S9(6); COMP.

PROCEDURE DIVISION.
OPEN-OUT-1.
	OPEN OUTPUT	1SEG-BLOCK-SEQ-SIX-FILE,
			2SEG-BLOCK-SEQ-SIX-FILE,
			UNBLOCKED-SEQ-SIX-FILE,
			1SEG-BLOCK-SEQ-ASC-FILE,
			2SEG-BLOCK-SEQ-ASC-FILE,
			UNBLOCKED-SEQ-ASC-FILE.
	DISPLAY "SEQ FILES OPENED FOR OUTPUT".

	PERFORM WRITE-1 VARYING COUNTER FROM 1 BY 1
		UNTIL COUNTER IS > 99.
	DISPLAY "SEQ FILES WRITTEN".

	CLOSE	1SEG-BLOCK-SEQ-SIX-FILE,
		2SEG-BLOCK-SEQ-SIX-FILE,
		UNBLOCKED-SEQ-SIX-FILE,
		1SEG-BLOCK-SEQ-ASC-FILE,
		2SEG-BLOCK-SEQ-ASC-FILE,
		UNBLOCKED-SEQ-ASC-FILE.
	DISPLAY "SEQ FILES CLOSED".

OPEN-INPUT-1.
	OPEN INPUT	1SEG-BLOCK-SEQ-SIX-FILE,
		2SEG-BLOCK-SEQ-SIX-FILE,
		UNBLOCKED-SEQ-SIX-FILE,
		1SEG-BLOCK-SEQ-ASC-FILE,
		2SEG-BLOCK-SEQ-ASC-FILE,
		UNBLOCKED-SEQ-ASC-FILE.
	DISPLAY "SEQ FILES OPENED FOR INPUT".

	MOVE SPACES TO END-FLAGS.
	PERFORM READ-1 THRU READ1-EXIT VARYING COUNTER FROM 1 BY 1
		UNTIL COUNTER IS > 100.

	IF END-FLAGS NOT = "XXXXXX"
		DISPLAY "?NONE REACHED AT END"; STOP RUN.

	DISPLAY "SEQ FILES READ".

	CLOSE	1SEG-BLOCK-SEQ-SIX-FILE,
		2SEG-BLOCK-SEQ-SIX-FILE,
		UNBLOCKED-SEQ-SIX-FILE,
		1SEG-BLOCK-SEQ-ASC-FILE,
		2SEG-BLOCK-SEQ-ASC-FILE,
		UNBLOCKED-SEQ-ASC-FILE.
	DISPLAY "SEQ FILES CLOSED".

	DISPLAY SPACE.

FIND-NUMBER.
	DISPLAY "HOW MANY RANDOM READ-WRITES?"; ACCEPT COUNTER.
	IF COUNTER IS GREATER THAN 999999 OR COUNTER NEGATIVE GO TO FIND-NUMBER.
	IF COUNTER IS NOT POSITIVE STOP RUN.
	MOVE COUNTER TO HOLD-COUNT.

	OPEN INPUT-OUTPUT 1SEG-BLOCK-RAN-SIX-FILE, 2SEG-BLOCK-RAN-SIX-FILE.
	DISPLAY "SIXBIT RAN FILES OPENED FOR INPUT-OUTPUT".

	MOVE 1 TO RANDOM-NUM; MOVE LOW-VALUES TO RW-TABLE.

	PERFORM READ-2 THRU READ2-EXIT VARYING I FROM 1 BY 1 UNTIL I > 99.

RANDOM-1.
	MULTIPLY CONSTANT BY RANDOM-NUM.
	DIVIDE RANDOM-NUM BY 99 GIVING TEMP; REMAINDER I.
	SET I UP BY 1.

	PERFORM READ-2 THRU READ2-EXIT.
	SET COUNTER DOWN BY 1.
	IF COUNTER IS GREATER THAN ZERO GO TO RANDOM-1.

	DISPLAY "SIXBIT RANDOM READS AND WRITES DONE".

	CLOSE 1SEG-BLOCK-RAN-SIX-FILE, 2SEG-BLOCK-RAN-SIX-FILE.
	DISPLAY "ALL SIXBIT FILES CLOSED".

RANDOM-2.
	OPEN OUTPUT 1SEG-BLOCK1-SEQ-ASC-FILE, 2SEG-BLOCK1-SEQ-ASC-FILE.
	PERFORM WRITE-2 VARYING COUNTER FROM 1 BY 1 UNTIL COUNTER > 99.
	CLOSE 1SEG-BLOCK1-SEQ-ASC-FILE, 2SEG-BLOCK1-SEQ-ASC-FILE.
	DISPLAY "RANDOM ASCII FILES CREATED".

	OPEN INPUT-OUTPUT 1SEG-RAN-ASC-FILE, 2SEG-RAN-ASC-FILE.
	MOVE LOW-VALUES TO RW-TABLE; MOVE HOLD-COUNT TO COUNTER.

	PERFORM READ-3 THRU READ3-EXIT VARYING I FROM 1 BY 1 UNTIL I > 99.
RANDOM-2A.
	MULTIPLY CONSTANT BY RANDOM-NUM.
	DIVIDE RANDOM-NUM BY 99 GIVING TEMP; REMAINDER I.
	SET I UP BY 1.
	PERFORM READ-3 THRU READ3-EXIT.
	SET COUNTER DOWN BY 1.
	IF COUNTER IS POSITIVE GO TO RANDOM-2A.

	CLOSE 1SEG-RAN-ASC-FILE, 2SEG-RAN-ASC-FILE.
	DISPLAY "ASCII RANDOM READS AND WRITES DONE".

	STOP RUN.

*	NOTE WRITE OUT RECORDS FOR SEQUENTIAL TESTS.

WRITE-1. MOVE COUNTER TO RECORD-COUNT.
	WRITE 1BSA-REC FROM RECORD-DATA.
	WRITE 2BSA-REC FROM RECORD-DATA.
	WRITE UBSA-REC FROM RECORD-DATA.
	WRITE 1BSS-REC FROM RECORD-DATA.
	WRITE 2BSS-REC FROM RECORD-DATA.
	WRITE UBSS-REC FROM RECORD-DATA.

*NOTE WRITE OUT RECORDS FOR ASCII RANDOM TESTS.

WRITE-2.
	MOVE COUNTER TO RECORD-COUNT.
	WRITE 1B1SA-REC FROM RECORD-DATA.
	WRITE 2B1SA-REC FROM RECORD-DATA.

*	NOTE READ AND CHECK RECORDS FOR SEQUENTIAL FILES.

READ-1.
	READ 1SEG-BLOCK-SEQ-SIX-FILE; AT END MOVE "X" TO 1BSS-FLAG.
	READ 2SEG-BLOCK-SEQ-SIX-FILE; AT END MOVE "X" TO 2BSS-FLAG.
	READ UNBLOCKED-SEQ-SIX-FILE;  AT END MOVE "X" TO UBSS-FLAG.
	READ 1SEG-BLOCK-SEQ-ASC-FILE; AT END MOVE "X" TO 1BSA-FLAG.
	READ 2SEG-BLOCK-SEQ-ASC-FILE; AT END MOVE "X" TO 2BSA-FLAG.
	READ UNBLOCKED-SEQ-ASC-FILE;  AT END MOVE "X" TO UBSA-FLAG.

	IF END-FLAGS = ALL "X" AND COUNTER NOT = 100
		DISPLAY "?ALL AT END AT RECORD NUMBER ", COUNTER; GO TO READ1-A.
	IF END-FLAGS = ALL "X" GO TO READ1-EXIT.
	IF END-FLAGS NOT = SPACES
		DISPLAY MESSAGE-1, COUNTER;
			", FLAGS = ", QUOTE, END-FLAGS, QUOTE;
		GO TO READ1-A.

	IF 1BSS-COUNT NOT = COUNTER DISPLAY "?1BSS-COUNT = ", 1BSS-COUNT,
			", SHOULD BE ", COUNTER.
	IF 2BSS-COUNT NOT = COUNTER DISPLAY "?2BSS-COUNT = ", 2BSS-COUNT,
			", SHOULD BE ", COUNTER.
	IF UBSS-COUNT NOT = COUNTER DISPLAY "?UBSS-COUNT = ", UBSS-COUNT,
			", SHOULD BE ", COUNTER.
	IF 1BSA-COUNT NOT = COUNTER DISPLAY "?1BSA-COUNT = ", 1BSA-COUNT,
			", SHOULD BE ", COUNTER.
	IF 2BSA-COUNT NOT = COUNTER DISPLAY "?2BSA-COUNT = ", 2BSA-COUNT,
			", SHOULD BE ", COUNTER.
	IF UBSA-COUNT NOT = COUNTER DISPLAY "?UBSA-COUNT = ", UBSA-COUNT,
			", SHOULD BE ", COUNTER.

	GO TO READ1-EXIT.

READ1-A. MOVE 100 TO COUNTER; MOVE ALL "X" TO END-FLAGS.

READ1-EXIT. EXIT.

READ-2.
	READ 1SEG-BLOCK-RAN-SIX-FILE; INVALID KEY
		DISPLAY "?INVALID KEY ON INPUT 1BRS = ", I; GO TO READ2-B.
	IF 1BRS-COUNT NOT = I
		DISPLAY "?RECORD NUMBER ", 1BRS-COUNT, ",SHOULD BE ",
			I; GO TO READ2-B.
	IF 1BRS-COUNT-1 NOT = RW-ENTRY (1, I)
		DISPLAY "?1BRS R/W COUNT IS ", 1BRS-COUNT-1, ",SHOULD BE ",
			RW-ENTRY (1, I).

	ADD 1, RW-ENTRY (1, I) GIVING RW-ENTRY (1, I), 1BRS-COUNT-1.
	WRITE 1BRS-REC; INVALID KEY
		DISPLAY "?INVALID KEY ON OUTPUT 1BRS = ", I.

READ2-B.
	READ 2SEG-BLOCK-RAN-SIX-FILE; INVALID KEY
		DISPLAY "?INVALID KEY ON INPUT 2BRS = ", I; GO TO READ2-EXIT.
	IF 2BRS-COUNT NOT = I
		DISPLAY "?RECORD NUMBER ", 2BRS-COUNT, ",SHOULD BE ",
			I; GO TO READ2-EXIT.
	IF 2BRS-COUNT-1 NOT = RW-ENTRY (2, I)
		DISPLAY "?2BRS R/W COUNT IS ", 2BRS-COUNT-1, ",SHOULD BE ",
			RW-ENTRY (2, I).

	ADD 1, RW-ENTRY (2, I) GIVING RW-ENTRY (2, I), 2BRS-COUNT-1.
	WRITE 2BRS-REC; INVALID KEY
		DISPLAY "?INVALID KEY ON OUTPUT 2BRS = ", I.

READ2-EXIT. EXIT.

READ-3.
	READ 1SEG-RAN-ASC-FILE; INVALID KEY
		DISPLAY "?INVALID KEY ON INPUT 1BRA = ", I; GO TO READ3-B.
	IF 1BRA-COUNT NOT = I
		DISPLAY "?RECORD NUMBER ", 1BRA-COUNT, ",SHOULD BE ",
			I; GO TO READ3-B.
	IF 1BRA-COUNT-1 NOT = RW-ENTRY (1, I)
		DISPLAY "?1BRA R/W COUNT IS ", 1BRA-COUNT-1, ",SHOULD BE ",
			RW-ENTRY (1, I).

	ADD 1, RW-ENTRY (1, I) GIVING RW-ENTRY (1, I), 1BRA-COUNT-1.
	WRITE 1BRA-REC; INVALID KEY
		DISPLAY "?INVALID KEY ON OUTPUT 1BRA = ", I.

READ3-B.
	READ 2SEG-RAN-ASC-FILE; INVALID KEY
		DISPLAY "?INVALID KEY ON INPUT 2BRA = ", I; GO TO READ3-EXIT.
	IF 2BRA-COUNT NOT = I
		DISPLAY "?RECORD NUMBER ", 2BRA-COUNT, ",SHOULD BE ",
			I; GO TO READ3-EXIT.
	IF 2BRA-COUNT-1 NOT = RW-ENTRY (2, I)
		DISPLAY "?2BRA R/W COUNT IS ", 2BRA-COUNT-1, ",SHOULD BE ",
			RW-ENTRY (2, I).

	ADD 1, RW-ENTRY (2, I) GIVING RW-ENTRY (2, I), 2BRA-COUNT-1.
	WRITE 2BRA-REC; INVALID KEY
		DISPLAY "?INVALID KEY ON OUTPUT 2BRA = ", I.

READ3-EXIT. EXIT.
SKIP::
.SET WATCH VERSION
;TRY TO RUN IN VM
.R SETVM
.IF (ERROR) ;IGNORE
.R TECO
=ERII.CTL
*_IICBL::
=0,.K
=EWII.CBL
=NSKIP::0L
=.,ZKPWEF
.ASSIGN DSK DEV1
.ASSIGN DSK DEV2
.EXECUTE II.CBL
.IF (ERROR)  .GOTO B
*2000
.IF (ERROR) .GOTO B
.PLEASE II SUCCESSFUL
.DELETE II.LST
.GOTO A
B::
.PLEASE ERROR RUNNING II.CBL
.QUEUE II.LST/DISPOSE:DELETE
A::
%FIN:
.NOERROR
.DELETE *.TMP
.DELETE II.CBL,II.REL
.QUEUE INP:SHRH1=/MODIFY/DEPEND:-1
.QUEUE INP:SHRH2=/MODIFY/DEPEND:-1