Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

ID DIVISION.
PROGRAM-ID. PAN.
*
* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY
* BE USED OR COPIED ONLY IN ACCORDANCE WITH THE TERMS
* OF SUCH LICENSE.
*
* COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 1985.
* ALL RIGHTS RESERVED.
*
*	XTBL9S IS USED TO CHECK THE CONTENTS OF TABLE B.
*	IT HAS THREE ENTRY POINTS, PAN, PNUM AND PTABLE.
*	AFTER EACH TEST STATEMENT IS EXECUTED IN XTBL09,
*	THE ENTRY POINTS PAN AND PNUM ARE USED TO TEST
*	INDIVIDUAL FIELDS IN THE RESULT TABLE B.  WHEN ALL
*	THE FIELDS THAT SHOULD HAVE BEEN ALTERED BY THE
*	TEST STATEMENT HAVE BEEN CHECKD, THE ENTRY POINT
*	PTABLE IS CALLED TO CHECK THAT THE REMAINING FIELDS
*	OF TABLE B AND ALL THE FILLER CHARACTERS HAVE NOT
*	BEEN ALTERED.
DATA DIVISION.
WORKING-STORAGE SECTION.
01	SUBTABLE VALUE	"111112121122211212221222
-			"111112121122211212221222".
	03  SUBSGRP PIC 999 OCCURS 16 TIMES.
01	X	PIC X.
01	SLIST.
	03  S	PIC X OCCURS 16.
01	SSUB PIC S9(4) COMP.
01	3SUBS.
	03  SUB1	PIC 9.
	03  SUB2	PIC 9.
	03  SUB3	PIC 9.
01	BDEMO DISPLAY-7 PIC X(55) VALUE
	"  *  **  *  *  *  **  *  **
-	"  *  **  *  *  *  **  *  ***".
01	BSET DISPLAY-7 PIC X(55) VALUE
	"00*00**00*00*00*00**00*00**
-	"00*00**00*00*00*00**00*00***".
01	TEMP DISPLAY-7.
	03  1L OCCURS 2.
	    05  2L OCCURS 2.
		07  3LA OCCURS 2.
		    09  TA	PIC XX.
		    09  FILLER	PIC X.
		07  3LB OCCURS 2.
		    09  FILLER	PIC X.
		    09  TB PIC XX.
		07  FILLER	PIC X.
	    05  FILLER		PIC X.
	03  FILLER		PIC X.
01	A2		PIC S9(4) COMP.
01	A3		PIC S9(4) COMP.
01	A4		PIC S9(4) COMP.
LINKAGE SECTION.
01	T DISPLAY-7.
	03  FILLER	PIC X(20).
	03  TN		PIC 99.
	03  TSWITCH	PIC X.
01	A2X		PIC S9(4) COMP.
01	A3X		PIC S9(4) COMP.
01	A4X		PIC S9(4) COMP.
01	A5		PIC XX.
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 XX.
		07  FILLER	PIC X.
	    05  FILLER		PIC X.
	03  FILLER		PIC X.

*ENTRY HERE (PAN) IS USED TO CHECK AN ALPHANUMERIC
*FIELD IN TABLE B AND TO ELIMINATE IT
*FROM THE FINAL CHECK LIST.
PROCEDURE DIVISION USING T B A2X A3X A4X A5.
	MOVE A2X TO A2.
	MOVE A3X TO A3.
	MOVE A4X TO A4.
	MOVE 0 TO SSUB PERFORM SSET.
	IF AN (A2 A3 A4) = A5 EXIT PROGRAM.

	DISPLAY T.
	DISPLAY "  TABLE ENTRY AN(" A2 SPACE A3 SPACE A4 ") IS: "
		AN (A2 A3 A4).
	DISPLAY "  TABLE ENTRY VALUE SHOULD BE: " A5.
	MOVE "*" TO TSWITCH.
	EXIT PROGRAM.

*ENTRY HERE (PNUM) IS USED TO CHECK A NUMERIC
*FIELD IN TABLE B AND TO ELIMINATE IT FROM
*THE FINAL CHECK LIST.
ENTRY PNUM USING T B A2X A3X A4X A5.
	MOVE A2X TO A2.
	MOVE A3X TO A3.
	MOVE A4X TO A4.
	MOVE 8 TO SSUB PERFORM SSET.
	IF NUM (A2 A3 A4) = A5 EXIT PROGRAM.

	DISPLAY T.
	DISPLAY "  TABLE ENTRY NUM (" A2 SPACE A3 SPACE A4 ") IS: "
		NUM (A2 A3 A4).
	DISPLAY "  TABLE ENTRY VALUE SHOULD BE: " A5.
	MOVE "*" TO TSWITCH.
	EXIT PROGRAM.

*ENTRY HERE (PTABLE) IS USED TO TEST ALL THE
*REMAINING UNCHANGED ITEMS IN TABLE B AND ALL
*FILLER ITEMS IN TABLE B.
ENTRY PTABLE USING T B.
	PERFORM VALCHECK THRU VALEND
		VARYING SSUB FROM 1 BY 1 UNTIL SSUB > 16.
	IF TSWITCH = "*"
	  DISPLAY "  THE WHOLE TABLE LOOKS LIKE:"
	  DISPLAY B
	  GO TO P2.
	MOVE B TO TEMP.
	MOVE SPACE TO TA (1 1 1) TB (1 1 1).
	MOVE SPACE TO TA (1 1 2) TB (1 1 2).
	MOVE SPACE TO TA (1 2 1) TB (1 2 1).
	MOVE SPACE TO TA (1 2 2) TB (1 2 2).
	MOVE SPACE TO TA (2 1 1) TB (2 1 1).
	MOVE SPACE TO TA (2 1 2) TB (2 1 2).
	MOVE SPACE TO TA (2 2 1) TB (2 2 1).
	MOVE SPACE TO TA (2 2 2) TB (2 2 2).
	IF TEMP = BDEMO GO TO P2.
	DISPLAY T.
	DISPLAY "  FILLER VALUES CLOBBERED".
	DISPLAY "  FILLER SHOULD LOOK LIKE:".
	DISPLAY BDEMO.
	DISPLAY "  INSTEAD, FILLER LOOKS LIKE:".
	DISPLAY TEMP.
	DISPLAY "  AND THE WHOLE TABLE LOOKS LIKE:"
	DISPLAY  B.
	MOVE "*" TO TSWITCH.
P2.
*RESET ALL ITEMS FOR THE NEXT TEST.
	MOVE BSET TO B.
	ADD 1 TO TN.
	MOVE SPACES TO SLIST.
	EXIT PROGRAM.

VALCHECK.
	IF S (SSUB) = "X" GO TO VALEND.
	MOVE SUBSGRP (SSUB) TO 3SUBS.
	IF SSUB < 9 GO TO VAL2.
	IF NUM (SUB1 SUB2 SUB3) = "00" GO TO VALEND.
	DISPLAY T.
	DISPLAY "   WRONG VALUE ALTERED".
	DISPLAY "  NUM (" SUB1 SPACE SUB2 SPACE SUB3 ") IS: "
		NUM (SUB1 SUB2 SUB3).
	DISPLAY "  INSTEAD OF 00.".
	MOVE "*" TO TSWITCH.
	GO TO VALEND.
VAL2.
	IF AN (SUB1 SUB2 SUB3) = "00" GO TO VALEND.
	DISPLAY T "WRONG VALUE ALTERED".
	DISPLAY "  AN (" SUB1 SPACE SUB2 SPACE SUB3 ") IS:".
	DISPLAY AN (SUB1 SUB2 SUB3) " INSTEAD OF 00.".
	MOVE "*" TO TSWITCH.
VALEND.
	EXIT.
SSET.
	IF A2 = 2 ADD 4 TO SSUB.
	IF A3 = 2 ADD 2 TO SSUB.
	ADD A4 TO SSUB.
	MOVE "X" TO S (SSUB).