PDP-10 Archive: uetp/lib/xtbl09.cbl from BB-H137C-BM

Trailing-Edge - PDP-10 Archives - BB-H137C-BM - uetp/lib/xtbl09.cbl
There are 20 other files named xtbl09.cbl in the archive. Click here to see a list.
* 24 JULY 75
ID DIVISION.
PROGRAM-ID. XTBL09.
*	XTBL09 SAMPLES ALL STATEMENTS USING REFERENCES TO
*	A THREE DIMENSIONAL TABLE IN ALL POSITIONS IN
*	WHICH SUBSCRIPTING IS ALLOWED.  SUBSCRIPTS ARE LITERAL,
*	IDENTIFIERS (COMP AND DISPLAY) AND RELATIVE (COMP
*	AND DISPLAY).  THE INTENT IS TO INSURE THAT ALL VERB
*	PROCESSORS ALLOW THE FULL RANGE OF SUBSCRIPT
*	POSSIBILITIES IMPLIED BY THE WORD 'IDENTIFIER'.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT TESTFILE ASSIGN TO DSK.
	SELECT SORTFILE ASSIGN TO DSK DSK DSK.
	SELECT PRNTFILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD	TESTFILE LABEL RECORDS STANDARD
		VALUE OF ID "XTBL09DAT".
01	TESTREC	PIC X(5) DISPLAY-7.

FD	PRNTFILE LABEL RECORDS STANDARD
		VALUE OF ID "PRNTFILE ".
01	PRINTREC	PIC X(25) DISPLAY-7.

SD	SORTFILE.
01	SORTREC.
	03  5CHARS	PIC X(5).
WORKING-STORAGE SECTION.
01	SORTTABLES VALUE
	 "010201010101020201020101000000010102010202020102020202000000".
	03  SORTGRP1	PIC 999999 OCCURS 5 TIMES.
	03  SORTGRP2	PIC 999999 OCCURS 5 TIMES.
01	3SUBS.
	03  SUB1	PIC 99.
	03  SUB2	PIC 99.
	03  SUB3	PIC 99.
01	SSUB	PIC 9.
01	SD0	PIC S9(4) VALUE 0.
01	SD1	PIC S9(4) VALUE 1.
01	SD2	PIC S9(4) VALUE 2.
01	SC0	PIC S9(4) COMP VALUE 0.
01	SC1	PIC S9(4) COMP VALUE 1.
01	SC2	PIC S9(4) COMP VALUE 2.
01	ONE	PIC S9(4) COMP VALUE 1.
01	TWO	PIC S9(4) COMP VALUE 2.
01	DUMMY	PIC 99.
01	A5	PIC XX.
01	T DISPLAY-7.
	03  FILLER	PIC X(20).
	03  TN		PIC 99.
	03  TSWITCH	PIC X.
	    88 TS VALUE SPACE.
01	ASET	PIC X(55) VALUE
	"####AA#BB01#01#
-	  "##CC#DD04#08#
-	 "###EE#FF09#27#
-	  "##GG#HH16#64#".
01	BSET	PIC X(55) VALUE
	"00*00**00*00*
-	"00*00**00*00**
-	"00*00**00*00*
-	"00*00**00*00***".
01	BINIT DISPLAY-7 PIC X(55) VALUE
	"AA*BB**01*01*
-	"CC*DD**04*08**
-	"EE*FF**09*27*
-	"GG*HH**16*64***".
01	A.
	03  FILLER		PIC X.
	03  1L OCCURS 2 INDEXED BY I.
	    05  FILLER		PIC X.
	    05  2L OCCURS 2 INDEXED BY J.
		07  FILLER	PIC X.
		07  3LA OCCURS 2 INDEXED BY K ASCENDING AN OF A.
		    09  FILLER	PIC X.
		    09  AN	PIC XX.
		07  3LB OCCURS 2.
		    09  NUM	PIC 99.
		    09  FILLER	PIC X.
01	B DISPLAY-7.
	03  1L OCCURS 2.
	    05  2L OCCURS 2.
		07  3LA OCCURS 2.
		    09  AN	PIC XX.
		    09  FILLER	PIC X.
		07  3LB OCCURS 2.
		    09  FILLER	PIC X.
		    09  NUM	PIC 99.
		07  FILLER	PIC X.
	    05  FILLER		PIC X.
	03  FILLER		PIC X.
PROCEDURE DIVISION.
P0.
* FIRST, TEST MOVES TO SEE IF SIMPLE ACCESS
*TO TABLE A IS POSSIBLE AND IF TABLE A IS
*MAPPED CORRECTLY.
	MOVE ALL "#" TO A.
	MOVE "AA" TO AN OF A (1 1 1).
	MOVE "BB" TO AN OF A (1 1 2).
	MOVE "CC" TO AN OF A (1 2 1).
	MOVE "DD" TO AN OF A (1 2 2).
	MOVE "EE" TO AN OF A (2 1 1).
	MOVE "FF" TO AN OF A (2 1 2).
	MOVE "GG" TO AN OF A (2 2 1).
	MOVE "HH" TO AN OF A (2 2 2).
	MOVE 01 TO NUM OF A (1 1 1).
	MOVE 01 TO NUM OF A (1 1 2).
	MOVE 04 TO NUM OF A (1 2 1).
	MOVE 08 TO NUM OF A (1 2 2).
	MOVE 09 TO NUM OF A (2 1 1).
	MOVE 27 TO NUM OF A (2 1 2).
	MOVE 16 TO NUM OF A (2 2 1).
	MOVE 64 TO NUM OF A (2 2 2).
	IF A NOT = ASET
	  DISPLAY "? TABLE A CANNOT BE CORRECTLY INITIALIZED."
	  DISPLAY "  TABLE SHOULD CONTAIN:"
	  DISPLAY ASET
	  DISPLAY "  TABLE INSTEAD CONTAINS:"
	  DISPLAY A
	  DISPLAY "TEST TERMINATED EARLY."
	  STOP RUN.

*NEXT TEST WHETHER THE SUBPROGRAM CAN BE USED TO
*CHECK THE RESULTS OF ALL FIELDS IN TABLE B.

	MOVE BSET TO B.
	MOVE "AA" TO AN OF B (1 1 1).
	MOVE "BB" TO AN OF B (1 1 2).
	MOVE "CC" TO AN OF B (1 2 1).
	MOVE "DD" TO AN OF B (1 2 2).
	MOVE "EE" TO AN OF B (2 1 1).
	MOVE "FF" TO AN OF B (2 1 2).
	MOVE "GG" TO AN OF B (2 2 1).
	MOVE "HH" TO AN OF B (2 2 2).
	MOVE 01 TO NUM OF B (1 1 1).
	MOVE 01 TO NUM OF B (1 1 2).
	MOVE 04 TO NUM OF B (1 2 1).
	MOVE 08 TO NUM OF B (1 2 2).
	MOVE 09 TO NUM OF B (2 1 1).
	MOVE 27 TO NUM OF B (2 1 2).
	MOVE 16 TO NUM OF B (2 2 1).
	MOVE 64 TO NUM OF B (2 2 2).
	IF B NOT = BINIT
	  DISPLAY "? TABLE B CANNOT BE CORRECTLY INITIALIZED"
	  DISPLAY "  TABLE SHOULD CONTAIN:"
	  DISPLAY BINIT
	  DISPLAY "  TABLE INSTEAD CONTAINS:"
	  DISPLAY B
	  DISPLAY "TEST TERMINATED EARLY."
	  STOP RUN.
	MOVE "? INITIAL TEST FAILS" TO T.
	MOVE "AA" TO A5.
	IF TS CALL PAN USING T B ONE ONE ONE A5.
	MOVE "BB" TO A5.
	IF TS CALL PAN USING T B ONE ONE TWO A5.
	MOVE "CC" TO A5.
	IF TS CALL PAN USING T B ONE TWO ONE A5.
	MOVE "DD" TO A5.
	IF TS CALL PAN USING T B ONE TWO TWO A5.
	MOVE "EE" TO A5.
	IF TS CALL PAN USING T B TWO ONE ONE A5.
	MOVE "FF" TO A5.
	IF TS CALL PAN USING T B TWO ONE TWO A5.
	MOVE "GG" TO A5.
	IF TS CALL PAN USING T B TWO TWO ONE A5.
	MOVE "HH" TO A5.
	IF TS CALL PAN USING T B TWO TWO TWO A5.
	MOVE "01" TO A5.
	IF TS CALL PNUM USING T B ONE ONE ONE A5.
	IF TS CALL PNUM USING T B ONE ONE TWO A5.
	MOVE "04" TO A5.
	IF TS CALL PNUM USING T B ONE TWO ONE A5.
	MOVE "08" TO A5.
	IF TS CALL PNUM USING T B ONE TWO TWO A5.
	MOVE "09" TO A5.
	IF TS CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "27" TO A5.
	IF TS CALL PNUM USING T B TWO ONE TWO A5.
	MOVE "16" TO A5.
	IF TS CALL PNUM USING T B TWO TWO ONE A5.
	MOVE "64" TO A5.
	IF TS CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.
* NOW ONCE MORE TO BE SURE THAT PTABLE REALLY DID RESET
* TABLE B VALUES AND THAT IT FINDS THEM RESET.
	CALL PTABLE USING T B.
	IF NOT TS
	  DISPLAY "? SUBROUTINE CHECK NOT WORKING."
	  DISPLAY "  TEST TERMINATED EARLY."
	  STOP RUN.

*IF WE REACHED THIS POINT ASSUME THAT THE TABLES ARE
*MAPPED OK AND THAT SIMPLE IF AND MOVE OPERATIONS
*WORK OK, AND THE SUBPROGRAM CAN BE USED TO TEST THEM.
*NOW BEGIN ACTUAL STATEMENT TESTS.

*ACCEPT
	DISPLAY "ACCEPT TEST".
*SUBSCRIPTING ON OP OF "ACCEPT OP".
	MOVE "? ACCEPT FAILS" TO T.
	MOVE 1 TO TN.
	MOVE "X " TO A5.
	DISPLAY "TYPE X<CR> TWICE".
	ACCEPT AN OF B (SC1 + 1 2 SD2).
	CALL PAN USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.
	ACCEPT AN OF B (2 SD2 SC1 + 1).
	CALL PAN USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.
	DISPLAY "TYPE 1<CR> TWICE".
	MOVE "01" TO A5.
	ACCEPT NUM OF B (SD2 SC1 + 1 2).
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.
	ACCEPT NUM OF B (SD0 + 2 SC0 + 2 SC2).
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*ADD
	DISPLAY "ADD TEST".
*SUBSCRIPTING ON OPS OF "ADD OP OP ... TO OP".
	MOVE "? ADD FAILS" TO T.
	MOVE 1 TO TN.
	MOVE "66" TO A5.
	ADD	NUM OF A (1 SC1 SD1) 
		NUM OF A (SD2 SC2 2)
		NUM OF A (SC2 - 1 SD2 - 1 2) TO
		NUM OF B (1 SC2 SD1).
	CALL PNUM USING T B ONE TWO ONE A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON RECEIVING FIELDS OF "ADD ... TO OP OP ...".
	MOVE "03" TO A5.
	ADD ONE TWO TO
		NUM OF B (1 SC1 SD1) ROUNDED
		NUM OF B (2 SC2 SD2)
		NUM OF B (SC0 + 2 SD1 + 1 1).
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PNUM USING T B TWO TWO ONE A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "ADD OP OP GIVING OP OP...".
	ADD	NUM OF A (SC0 + 1 SD0 + 1 SD2 - 1)
		NUM OF A (SC2 - 1 SD2 - 1 SC0 + 1) GIVING
		NUM OF B (1 SC1 SC1)
		NUM OF B (SD1 SC1 2) ROUNDED
		NUM OF B (SC1 2 SD1).
	MOVE "02" TO A5.
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PNUM USING T B ONE ONE TWO A5.
	CALL PNUM USING T B ONE TWO ONE A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "ADD CORR OP TO OP".
	MOVE "04" TO A5.
	ADD CORR 3LB OF A (SC1 2 SD0 + 1) TO
		3LB OF B (SD1 + 1 SC1 1).
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PTABLE USING T B.

*COMPUTE
	DISPLAY "COMPUTE TEST".
*SUBSCRIPTING ON OPS OF "COMPUTE OP = OP".
	MOVE "? COMPUTE FAILS" TO T.
	MOVE 1 TO TN.
	COMPUTE NUM OF B (SC1 SD2 1) = NUM OF A (1 SD1 SC2).
	MOVE "01" TO A5.
	CALL PNUM USING T B ONE TWO ONE A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "COMPUTE OP = (ARITHMETIC EXPRESSION OF OPS)".
	MOVE "11" TO A5.
	COMPUTE	NUM OF B (SD0 + 2 SC2 SC2) =
	       (NUM OF A (SC2 SD2 1) *
		NUM OF A (1 2 SD2 - 1) -
		NUM OF A (SC1 SD0 + 1 2))/
		NUM OF A (SC0 + 2 SC1 SD1) +
		NUM OF A (SD0 + 1 2 SD0 + 1).
*THE ABOVE EXPRESSION IS (16*4-1)/9+4 = 11.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*DISPLAY
	DISPLAY "DISPLAY TEST".
*SUBSCRIPTING ON OPS OF "DISPLAY OP, OP ...".
	DISPLAY "DISPLAY FAILS IF NEXT TWO LINES ARE NOT IDENTICAL".
	MOVE SPACE TO TSWITCH.
	DISPLAY "AA BB CC DD".
	DISPLAY AN OF A (SC1 SD1 1) SPACE
		AN OF A (SD1 1 SC2) " "
		AN OF A (SD0 + 1 SC2 SC2 - 1) TSWITCH
		AN OF A (SD2 - 1 2 SC0 + 2).

*DIVIDE
	DISPLAY "DIVIDE TEST".
*SUBSCRIPTING ON OPS OF "DIVIDE OP INTO OP REMAINDER OP".
	MOVE "? DIVIDE FAILS" TO T.
	MOVE 1 TO TN.
	MOVE 27 TO NUM OF B (2 1 1).
	DIVIDE NUM OF A (SC0 + 1 SD2 1) INTO
		NUM OF B (SD0 + 2 SD2 - 1 1) REMAINDER
		NUM OF B (SC2 SC0 + 1 SD2).
*(THE ARITHMETIC IS 27/4 = 6 WITH REMAINDER 3).
	MOVE "06" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "03" TO A5.
	CALL PNUM USING T B TWO ONE TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "DIVIDE OP BY OP REMAINDER OP".
	MOVE 4 TO NUM OF B (2 1 1).
	DIVIDE	NUM OF A (SD0 + 2 SD2 - 1 2) BY
		NUM OF B (SD0 + 2 SD2 - 1 1) REMAINDER
		NUM OF B (SC2 SC0 + 1 SD2).
	MOVE "06" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "03" TO A5.
	CALL PNUM USING T B TWO ONE TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "DIVIDE OP INTO OP GIVING OP REMAINDER OP".
	DIVIDE NUM OF A (SC0 + 1 SD2 1) INTO
		NUM OF A (SD0 + 2 SD2 - 1 2) GIVING
		NUM OF B (SD0 + 2 SD2 - 1 1) REMAINDER
		NUM OF B (SC2 SC0 + 1 SD2).
	MOVE "06" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "03" TO A5.
	CALL PNUM USING T B TWO ONE TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "DIVIDE OP BY OP GIVING OP REMAINDER OP".
	DIVIDE NUM OF A (SD0 + 2 SD2 - 1 2) BY
		NUM OF A (SC0 + 1 SD2 1) GIVING
		NUM OF B (SD0 + 2 SD2 - 1 1) REMAINDER
		NUM OF B (SC2 SC0 + 1 SD2).
	MOVE "06" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "03" TO A5.
	CALL PNUM USING T B TWO ONE TWO A5.
	CALL PTABLE USING T B.

*EXAMINE
	DISPLAY "EXAMINE TEST".
*SUBSCRIPTING ON OPS OF "EXAMINE OP ...".
	MOVE "? EXAMINE FAILS" TO T.
	MOVE 1 TO TN.
	EXAMINE 3LA OF B (SC0 + 1 SC2 - 1 SD2)
		TALLYING UNTIL FIRST "*" REPLACING BY "1".
	MOVE "11" TO A5.
	CALL PAN USING T B ONE ONE TWO A5.
	CALL PTABLE USING T B.

	EXAMINE 2L OF B (SC2 - 1 SD0 + 2)
		TALLYING ALL "0" REPLACING BY "7".
	IF TALLY NOT = 8
	  DISPLAY T "TALLY COUNTER IS: " TALLY ", SHOULD BE 8".
	MOVE "77" TO A5.
	CALL PAN USING T B ONE TWO ONE A5.
	CALL PAN USING T B ONE TWO TWO A5.
	CALL PNUM USING T B ONE TWO ONE A5.
	CALL PNUM USING T B ONE TWO TWO A5.
	CALL PTABLE USING T B.

	EXAMINE 1L OF B (SD1 + 1)
		REPLACING ALL "0" BY "9".
	MOVE "99" TO A5.
	CALL PAN USING T B TWO ONE ONE A5.
	CALL PAN USING T B TWO ONE TWO A5.
	CALL PAN USING T B TWO TWO ONE A5.
	CALL PAN USING T B TWO TWO TWO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PNUM USING T B TWO ONE TWO A5.
	CALL PNUM USING T B TWO TWO ONE A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*GO TO ... DEPENDING
*SUBSCRIPTING ON OP OF "GO TO ... DEPENDING ON OP".
	DISPLAY "GO ... DEP TEST".
	GO TO GTD1
	      GTD2
	      GTD3
	      DEPENDING ON NUM OF A (SD0 + 1 SD2 - 1 SC2).
	DISPLAY "? GO TO FAILS, FALL THROUGH".
	GO TO GTD1.
GTD3.
	DISPLAY "? GO TO FAILS, WENT TO GTD3.".
	GO TO GTD1.
GTD2.
	DISPLAY "? GO TO FAILS, WENT TO GTD2.".
GTD1.

*MOVE
*SUBSCRIPTING ON OPS OF MOVE OP TO OP OP ...".
	DISPLAY "MOVE TEST".
	MOVE "? MOVE FAILS" TO T.
	MOVE 1 TO TN.
	MOVE	AN OF A (SC0 + 2 SD1 + 1 SD0 + 1) TO
		AN OF B (SC1 SC0 + 1 SD2 - 1)
		AN OF B (SD1 SD1 + 1 2)
		AN OF B (2 SD1 1)
		AN OF B (SC0 + 2 SD0 + 2 SD0 + 1).
	MOVE "GG" TO A5.
	CALL PAN USING T B ONE ONE ONE A5.
	CALL PAN USING T B ONE TWO TWO A5.
	CALL PAN USING T B TWO ONE ONE A5.
	CALL PAN USING T B TWO TWO ONE A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "MOVE CORR OP TO OP".
	MOVE "? MOVE CORR FAILED" TO T.
	MOVE 1 TO TN.
	MOVE CORR 3LA OF A (SD2 SC1 SC0 + 2) TO
		3LA OF B (SD0 + 1 2 SD1).
	MOVE "FF" TO A5.
	CALL PAN USING T B ONE TWO ONE A5.
	CALL PTABLE USING T B.

	MOVE CORR 2L OF A(SC2 1) TO 2L OF B (2 SD0 + 2).
*SINCE ALL ITEMS HAVE OCCURS CLAUSES, NOTHING SHOULD BE MOVED.
	CALL PTABLE USING T B.

*MULTIPLY
*SUBSCRIPTING ON OPS OF "MULTIPLY OP BY OP".
	DISPLAY "MULTIPLY TEST".
	MOVE "? MULTIPLY FAILS" TO T.
	MOVE 1 TO TN.
	MOVE 4 TO NUM OF B (1 2 2).
	MULTIPLY NUM OF A (SC2 SD0 + 1 SD1) BY
		NUM OF B (1 SC1 + 1 SD0 + 2).
	IF NUM OF A (2 1 1) NOT = 9
	  DISPLAY T "MULTIPLY OP A BY OP B"
	  DISPLAY "  CLOBBERED OP A VALUE"
	  DISPLAY "  OP A VALUE IS " NUM OF A (2 1 1) ", IT SHOULD BE 09".
	MOVE "36" TO A5.
	CALL PNUM USING T B ONE TWO TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "MULTIPLY OP BY OP GIVING OP".
	MULTIPLY NUM OF A (2 SC1 SD0 + 1) BY
		NUM OF A (SD1 SD1 + 1 SD0 + 1) GIVING
		NUM OF B (1 SC0 + 1 SD1 + 1).
	MOVE "36" TO A5.
	CALL PNUM USING T B ONE ONE TWO A5.
	CALL PTABLE USING T B.

*PERFORM
*SUBSCRIPTING ON OPS OF PERFORM ... OP TIMES.
	DISPLAY "PERFORM TEST".
	MOVE "? PERFORM FAILS" TO T.
	MOVE 1 TO TN.
	MOVE 0 TO SUB1.
	DISPLAY "STARTING VARIABLE PERFORM TEST 1".
	PERFORM P2 NUM OF A (SD1 + 1 1 SC0 + 1) TIMES.
	DISPLAY "  PERFORM TEST 1 FINISHED".
	IF SUB1 NOT = 9
	  DISPLAY T "COUNT OF EXECUTIONS IS:"
	  DISPLAY SUB1 ", AND SHOULD BE 09".
	ADD 1 TO TN.

*SUBSCRIPTING ON OPS OF THE CONDITION IN PERFORM ... UNTIL COND".
	MOVE 0 TO SUB1.
	DISPLAY "STARTING VARIABLE PERFORM TEST 2".
	PERFORM P2 UNTIL SUB1 = NUM OF A (SC0 + 2 SD1 1).
	DISPLAY "  PERFORM TEST 2 FINISHED".
	IF SUB1 NOT = 9
	  DISPLAY T "COUNT OF EXECUTIONS IS:"
	  DISPLAY SUB1 ", AND SHOULD BE 09".
	ADD 1 TO TN.

*SUBSCRIPTING ON OPS OF THE CONDITION IN "PERFORM ...
*        UNTIL COND" WHERE THE SUBSCRIPT ITSELF IS THE VARIABLE.
	MOVE 1 TO SUB1.
	MOVE 2 TO NUM OF B (2 1 1).
	DISPLAY "STARTING VARIABLE PERFORM TEST 3".
	PERFORM P2 UNTIL 2 = NUM OF B (SUB1 SC0 + 1 SD1)
	DISPLAY "  PERFORM TEST 3 FINISHED".
	MOVE BSET TO B.
	IF SUB1 NOT = 2
	  DISPLAY T "VALUE OF SUB1 IS:"
	  DISPLAY SUB1 ", AND SHOULD BE 2".
	ADD 1 TO TN.

*SUBSCRIPTING ON OPS OF "PERFORM ... VARYING OP FROM OP BY OP
*	UNTIL OP = OP AFTER ...".
	DISPLAY "STARTING VARIABLE PERFORM TEST 4".
	MOVE 0 TO SUB1.
	PERFORM P2 VARYING NUM OF B (SC0 + 1 SD1 1)
		FROM	NUM OF A (1 SD1 SD2 - 1)
		BY	NUM OF A (SC0 + 1 1 SD2)
		UNTIL 	NUM OF B (1 SD1 SC0 + 1)
		>	NUM OF A (1 SC2 SD1)
	AFTER VARYING	NUM OF B (SD2 SD2 - 1 SD2 - 1)
		FROM 	NUM OF B (SC1 SC0 + 1 SC1 + 1)
		BY 	NUM OF A (SC1 SC2 SC1)
		UNTIL	15 < NUM OF B (SC2 SC2 - 1 SC2 - 1)
	AFTER VARYING	NUM OF B (2 SD0 + 2 SC1 + 1)
		FROM	NUM OF B (2 2 1)
		BY	NUM OF A (2 2 1)
		UNTIL 	NUM OF A (SC2 SD2 2)
		=	NUM OF B (SC0 + 2 2 2).
	DISPLAY "  PERFORM TEST 4 FINISHED".
	IF SUB1 NOT = 64
	  DISPLAY T
	  DISPLAY "SUB1 VALUE IS: " SUB1 ", SHOULD BE 64".
	MOVE ZERO TO A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	MOVE ZERO TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "05" TO A5.
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PTABLE USING T B.

*WRITE
*SUBSCRIPTING ON OP OF "WRITE REC FROM OP".
	DISPLAY "WRITE TEST".
	OPEN OUTPUT TESTFILE.
	WRITE TESTREC FROM AN OF A (SC0 + 1 SD1 SC1).
	WRITE TESTREC FROM AN OF A (SD1 + 1 SD0 + 1 SD1).
	WRITE TESTREC FROM AN OF A (SC2 2 SD2).
	CLOSE TESTFILE.
	OPEN INPUT TESTFILE.
	MOVE "? WRITE FAILS" TO T.
	READ TESTFILE AT END DISPLAY T "AT END ON 1ST READ" GO TO WRITE1.
	IF TESTREC NOT = "AA   "
	  DISPLAY T "RECORD 1 IS: " TESTREC.
	READ TESTFILE AT END DISPLAY T "AT END ON 2ND READ" GO TO WRITE1.
	IF TESTREC NOT = "EE   "
	  DISPLAY T "RECORD 2 IS: " TESTREC.
	READ TESTFILE AT END DISPLAY T "AT END ON 3RD READ" GO TO WRITE1.
	IF TESTREC NOT = "HH   "
	  DISPLAY T "RECORD 3 IS: " TESTREC.
	READ TESTFILE AT END GO TO WRITE1.
	DISPLAY T "NO AT END ON 4TH READ".
WRITE1.
	CLOSE TESTFILE.

*SUBSCRIPTING ON OP OF "WRITE ... ADVANCING OP".
	OPEN OUTPUT PRNTFILE.
	MOVE "THREE BLANK LINES FOLLOW" TO PRINTREC.
	WRITE PRINTREC BEFORE ADVANCING NUM OF A (SC0 + 1 SD2 SC2 - 1).
	MOVE "15 BLANK LINES FOLLOW" TO PRINTREC.
	WRITE PRINTREC BEFORE ADVANCING NUM OF A (2 SD2 SC2 - 1).
	MOVE "NO BLANK LINES FOLLOW" TO PRINTREC.
	WRITE PRINTREC BEFORE ADVANCING NUM OF A (1 1 1).
	WRITE PRINTREC BEFORE ADVANCING NUM OF A (SC1 SD1 SD1 + 1).
	MOVE "ENDLINE " TO PRINTREC.
	WRITE PRINTREC.
	CLOSE PRNTFILE.

*READ
*SUBSCRIPTING ON OP OF "READ ... INTO OP".
	DISPLAY "READ TEST".
	MOVE "? READ FAILS" TO T.
	OPEN INPUT TESTFILE.
	READ TESTFILE INTO AN OF B (SC0 + 1 SC2 SD2 - 1) AT END
	  DISPLAY T "CAN'T READ 1ST RECORD OF INPUT FILE"
	  GO TO READ1.
	READ TESTFILE INTO AN OF B (SD0 + 2 1 SC1) AT END
	  DISPLAY T "CAN'T READ 2ND RECORD OF INPUT FILE"
	  GO TO READ1.
	READ TESTFILE INTO AN OF B (SC2 SD2 SC0 + 1) AT END
	  DISPLAY T "CAN'T READ 3RD RECORD OF INPUT FILE"
	  GO TO READ1.
	READ TESTFILE AT END GO TO READ1.
	DISPLAY "? NO AT END ON FOURTH READ OF INPUT FILE".
READ1.
	CLOSE TESTFILE.
	MOVE "AA" TO A5.
	CALL PAN USING T B ONE TWO ONE A5.
	MOVE "EE" TO A5.
	CALL PAN USING T B TWO ONE ONE A5.
	MOVE "HH" TO A5.
	CALL PAN USING T B TWO TWO ONE A5.
	CALL PTABLE USING T B.

*RELEASE AND RETURN
*SUBSCRIPTING ON OPS OF "RELEASE ... FROM OP" AND
*	"RETURN ... INTO OP".
	DISPLAY "RELEASE & RETURN TEST".
	MOVE "? SORT FAILS SOMEWHERE" TO T.
	SORT SORTFILE ON ASCENDING 5CHARS
	  INPUT PROCEDURE IS P3 THRU P3A
	  OUTPUT PROCEDURE IS P4 THRU P4B.
	MOVE "AA" TO A5.
	CALL PAN USING T B ONE ONE TWO A5.
	MOVE "CC" TO A5.
	CALL PAN USING T B ONE TWO TWO A5.
	MOVE "EE" TO A5.
	CALL PAN USING T B TWO ONE TWO A5.
	MOVE "GG" TO A5.
	CALL PAN USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*SEARCH
*SUBSCRIPTING ON OPS OF "SEARCH ... VARYING OP ...".
	DISPLAY "SEARCH TEST".
	MOVE 1 TO I J K.
	MOVE "? SEARCH FAILS" TO T.
	SEARCH 3LA OF A VARYING NUM OF B (SC0 + 1 SD2 SC1 + 1)
		WHEN AN OF A (I J K) = "BB" NEXT SENTENCE.
	MOVE "02" TO A5.
	CALL PNUM USING T B ONE TWO TWO A5.
	CALL PTABLE USING T B.

*SET
*SUBSCRIPTING ON OPS OF "SET OP OP ... TO OP".
	DISPLAY "SET TEST".
	MOVE "? SET FAILS" TO T.
	MOVE 1 TO TN.
	SET NUM OF B (SC0 + 1 1 SD1)
	    NUM OF B (2 SD2 - 1 SD0 + 1)
	    NUM OF B (2 SD1 + 1 SC1 + 1) TO
	    NUM OF A (SD2 SC2 2).
	MOVE "64" TO A5.
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "SET OP OP ... UP BY OP".
	SET NUM OF B (1 SC0 + 1 1)
	    NUM OF B (SD2 1 SC1)
	    NUM OF B (SC2 2 SD2) UP BY
	    NUM OF A (2 SD2 SC1 + 1).
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*SUBTRACT
*SUBSCRIPTING ON OPS OF "SUBTRACT OP OP ... FROM OP OP".
	DISPLAY "SUBTRACT TEST".
	MOVE "? SUBTRACT FAILS" TO T.
	MOVE 1 TO TN.
	MOVE 25 TO NUM OF B (1 1 1).
	MOVE 37 TO NUM OF B (2 1 1).
	MOVE 42 TO NUM OF B (2 2 2).
	SUBTRACT NUM OF A (SC0 + 1 SD1 1)
		NUM OF A (SC2 - 1 SC2 SD2 - 1)
		NUM OF A (SD2 SC2 - 1 SC0 + 1) FROM
		NUM OF B (SC1 SD1 1)
		NUM OF B (SC1 + 1 SD2 - 1 SD1) ROUNDED
		NUM OF B (SC1 + 1 SD1 + 1 SC0 + 2).
	MOVE "11" TO A5.
	CALL PNUM USING T B ONE ONE ONE A5.
	MOVE "23" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	MOVE "28" TO A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "SUBTRACT OP OP FROM OP GIVING OP OP".
	SUBTRACT NUM OF A (SD1 + 1 1 SC0 + 1)
		NUM OF A (SC2 SD1 SC0 + 1) FROM
		NUM OF A (SC0 + 2 SC1 + 1 SC2) GIVING
		NUM OF B (SC0 + 1 SC1 SD1)
		NUM OF B (SD2 SC2 - 1 SD2 - 1) ROUNDED
		NUM OF B (SD2 SC0 + 2 SD0 + 2).
	MOVE "46" TO A5.
	CALL PNUM USING T B ONE ONE ONE A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PNUM USING T B TWO TWO TWO A5.
	CALL PTABLE USING T B.

*SUBSCRIPTING ON OPS OF "SUBTRACT CORR OP FROM OP".
	MOVE 64 TO NUM OF B (2 1 1).
	SUBTRACT CORR 3LB OF A (SD0 + 1 SD2 1) FROM
			3LB OF B (SC1 + 1 1 SD2 - 1).
	MOVE "60" TO A5.
	CALL PNUM USING T B TWO ONE ONE A5.
	CALL PTABLE USING T B.
	DISPLAY "END OF TESTS".
	STOP RUN.

*THIS IS THE PERFORM RANGE FOR PERFORM TESTS.
P2.
	ADD 1 TO SUB1.

*THIS IS THE INPUT PROCEDURE FOR THE SORT TEST.
*IT PICKS UP THE 1, 3, 5, AND 7TH ALPHANUMERIC
*ITEMS OUT OF TABLE A (OUT OF ORDER) AND GIVES THEM TO
*THE SORT.
P3.
	MOVE 1 TO SSUB.
P3A.
	MOVE SORTGRP1 (SSUB) TO 3SUBS.
	RELEASE SORTREC FROM AN OF A (SUB1, SUB2, SUB3).
	ADD 1 TO SSUB.
	IF SSUB < 5 GO TO P3A.

*THIS IS THE OUTPUT PROCEDURE FOR THE SORT TEST.
*IT RETURNS THE FOUR SORTED (ASCENDING) ITEMS TO ALPHANUMERIC
*POSITIONS 2, 4, 6, AND 8 OF TABLE B.
P4.
	MOVE 1 TO SSUB.
P4A.
	MOVE SORTGRP2 (SSUB) TO 3SUBS.
	RETURN SORTFILE INTO AN OF B (SUB1 SUB2 SUB3) AT END
	  GO TO P4B.
	ADD 1 TO SSUB.
	GO TO P4A.
P4B.
	EXIT.