Trailing-Edge
-
PDP-10 Archives
-
k20v7d
-
uetp/lib/xt749s.cbl
There are 7 other files named xt749s.cbl in the archive. Click here to see a list.
ID DIVISION.
PROGRAM-ID. PAN.
* 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.
* MODIFIED 4/7/82 TO INCLUDE MORE SUBSCRIPTS.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SUBTABLES.
02 S1 PIC X(40) VALUE "1111111112111211112211211112121122111222".
02 S2 PIC X(40) VALUE "1211112112121211212212211122121222112222".
02 S3 PIC X(40) VALUE "2111121112211212112221211212122122121222".
02 S4 PIC X(40) VALUE "2211122112221212212222211222122222122222".
02 S5 PIC X(40) VALUE "1111111112111211112211211112121122111222".
02 S6 PIC X(40) VALUE "1211112112121211212212211122121222112222".
02 S7 PIC X(40) VALUE "2111121112211212112221211212122122121222".
02 S8 PIC X(40) VALUE "2211122112221212212222211222122222122222".
01 SUBTABLE REDEFINES SUBTABLES.
03 SUBSGRP PIC 99999 OCCURS 64 TIMES.
01 X PIC X.
01 SLIST.
03 S PIC X OCCURS 64.
01 SSUB PIC S9(4) COMP.
01 5SUBS.
03 SUB1 PIC 9.
03 SUB2 PIC 9.
03 SUB3 PIC 9.
03 SUB4 PIC 9.
03 SUB5 PIC 9.
01 BDEMOS DISPLAY-7.
02 BDEMO1 PIC X(55) VALUE
" * ** * * * ** * ** * ** * * * ** * ***".
02 BDEMO2 PIC X(56) VALUE
" * ** * * * ** * ** * ** * * * ** * ****".
02 BDEMO3 PIC X(55) VALUE
" * ** * * * ** * ** * ** * * * ** * ***".
02 BDEMO4 PIC X(57) VALUE
" * ** * * * ** * ** * ** * * * ** * *****".
01 BDEMO REDEFINES BDEMOS DISPLAY-7 PIC X(223).
01 BSETS DISPLAY-7.
02 BSET1 PIC X(27) VALUE "00*00**00*00*00*00**00*00**".
02 BSET2 PIC X(28) VALUE "00*00**00*00*00*00**00*00***".
02 BSET3 PIC X(27) VALUE "00*00**00*00*00*00**00*00**".
02 BSET4 PIC X(29) VALUE "00*00**00*00*00*00**00*00****".
02 BSET5 PIC X(27) VALUE "00*00**00*00*00*00**00*00**".
02 BSET6 PIC X(28) VALUE "00*00**00*00*00*00**00*00***".
02 BSET7 PIC X(27) VALUE "00*00**00*00*00*00**00*00**".
02 BSET8 PIC X(30) VALUE "00*00**00*00*00*00**00*00*****".
01 BSET REDEFINES BSETS DISPLAY-7 PIC X(223).
01 TEMP DISPLAY-7.
02 1L OCCURS 2.
03 2L OCCURS 2.
04 3L OCCURS 2.
05 4L OCCURS 2.
06 5LA OCCURS 2.
07 TA PIC XX.
07 FILLER PIC X.
06 5LB OCCURS 2.
07 FILLER PIC X.
07 TB PIC XX.
06 FILLER PIC X.
05 FILLER PIC X.
04 FILLER PIC X.
03 FILLER PIC X.
02 FILLER PIC X.
01 A2 PIC S9(4) COMP.
01 A3 PIC S9(4) COMP.
01 A4 PIC S9(4) COMP.
01 A5 PIC S9(4) COMP.
01 A6 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 A5X PIC S9(4) COMP.
01 A6X PIC S9(4) COMP.
01 B5 PIC XX.
01 B DISPLAY-7.
02 1L OCCURS 2.
03 2L OCCURS 2.
04 3L OCCURS 2.
05 4L OCCURS 2.
06 5LA OCCURS 2.
07 AN PIC XX.
07 FILLER PIC X.
06 5LB OCCURS 2.
07 FILLER PIC X.
07 NUM PIC XX.
06 FILLER PIC X.
05 FILLER PIC X.
04 FILLER PIC X.
03 FILLER PIC X.
02 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 A5X A6X B5.
MOVE A2X TO A2.
MOVE A3X TO A3.
MOVE A4X TO A4.
MOVE A5X TO A5.
MOVE A6X TO A6.
MOVE 0 TO SSUB PERFORM SSET.
IF AN (A2 A3 A4 A5 A6) = B5 EXIT PROGRAM.
DISPLAY T.
DISPLAY
" TABLE ENTRY AN (" A2 SPACE A3 SPACE A4 SPACE A5 SPACE A6 ") IS: "
AN (A2 A3 A4 A5 A6).
DISPLAY " TABLE ENTRY VALUE SHOULD BE: " B5.
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 A5X A6X B5.
MOVE A2X TO A2.
MOVE A3X TO A3.
MOVE A4X TO A4.
MOVE A5X TO A5.
MOVE A6X TO A6.
MOVE 32 TO SSUB PERFORM SSET.
IF NUM (A2 A3 A4 A5 A6) = B5 EXIT PROGRAM.
DISPLAY T.
DISPLAY
" TABLE ENTRY NUM (" A2 SPACE A3 SPACE A4 SPACE A5 SPACE A6 ") IS: "
NUM (A2 A3 A4 A5 A6).
DISPLAY " TABLE ENTRY VALUE SHOULD BE: " B5.
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 > 64.
IF TSWITCH = "*"
DISPLAY " THE WHOLE TABLE LOOKS LIKE:"
DISPLAY B
GO TO P2.
MOVE B TO TEMP.
MOVE SPACE TO TA (1 1 1 1 1) TB (1 1 1 1 1).
MOVE SPACE TO TA (1 1 1 1 2) TB (1 1 1 1 2).
MOVE SPACE TO TA (1 1 1 2 1) TB (1 1 1 2 1).
MOVE SPACE TO TA (1 1 1 2 2) TB (1 1 1 2 2).
MOVE SPACE TO TA (1 1 2 1 1) TB (1 1 2 1 1).
MOVE SPACE TO TA (1 1 2 1 2) TB (1 1 2 1 2).
MOVE SPACE TO TA (1 1 2 2 1) TB (1 1 2 2 1).
MOVE SPACE TO TA (1 1 2 2 2) TB (1 1 2 2 2).
MOVE SPACE TO TA (1 2 1 1 1) TB (1 2 1 1 1).
MOVE SPACE TO TA (1 2 1 1 2) TB (1 2 1 1 2).
MOVE SPACE TO TA (1 2 1 2 1) TB (1 2 1 2 1).
MOVE SPACE TO TA (1 2 1 2 2) TB (1 2 1 2 2).
MOVE SPACE TO TA (1 2 2 1 1) TB (1 2 2 1 1).
MOVE SPACE TO TA (1 2 2 1 2) TB (1 2 2 1 2).
MOVE SPACE TO TA (1 2 2 2 1) TB (1 2 2 2 1).
MOVE SPACE TO TA (1 2 2 2 2) TB (1 2 2 2 2).
MOVE SPACE TO TA (2 1 1 1 1) TB (2 1 1 1 1).
MOVE SPACE TO TA (2 1 1 1 2) TB (2 1 1 1 2).
MOVE SPACE TO TA (2 1 1 2 1) TB (2 1 1 2 1).
MOVE SPACE TO TA (2 1 1 2 2) TB (2 1 1 2 2).
MOVE SPACE TO TA (2 1 2 1 1) TB (2 1 2 1 1).
MOVE SPACE TO TA (2 1 2 1 2) TB (2 1 2 1 2).
MOVE SPACE TO TA (2 1 2 2 1) TB (2 1 2 2 1).
MOVE SPACE TO TA (2 1 2 2 2) TB (2 1 2 2 2).
MOVE SPACE TO TA (2 2 1 1 1) TB (2 2 1 1 1).
MOVE SPACE TO TA (2 2 1 1 2) TB (2 2 1 1 2).
MOVE SPACE TO TA (2 2 1 2 1) TB (2 2 1 2 1).
MOVE SPACE TO TA (2 2 1 2 2) TB (2 2 1 2 2).
MOVE SPACE TO TA (2 2 2 1 1) TB (2 2 2 1 1).
MOVE SPACE TO TA (2 2 2 1 2) TB (2 2 2 1 2).
MOVE SPACE TO TA (2 2 2 2 1) TB (2 2 2 2 1).
MOVE SPACE TO TA (2 2 2 2 2) TB (2 2 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 TSWITCH.
MOVE SPACES TO SLIST.
EXIT PROGRAM.
VALCHECK.
IF S (SSUB) = "X" GO TO VALEND.
MOVE SUBSGRP (SSUB) TO 5SUBS.
IF SSUB < 33 GO TO VAL2.
IF NUM (SUB1 SUB2 SUB3 SUB4 SUB5) = "00" GO TO VALEND.
DISPLAY T.
DISPLAY " WRONG VALUE ALTERED".
DISPLAY
" NUM (" SUB1 SPACE SUB2 SPACE SUB3 SPACE SUB4 SPACE SUB5 ") IS: "
NUM (SUB1 SUB2 SUB3 SUB4 SUB5).
DISPLAY " INSTEAD OF 00.".
MOVE "*" TO TSWITCH.
GO TO VALEND.
VAL2.
IF AN (SUB1 SUB2 SUB3 SUB4 SUB5) = "00" GO TO VALEND.
DISPLAY T "WRONG VALUE ALTERED".
DISPLAY
" AN (" SUB1 SPACE SUB2 SPACE SUB3 SPACE SUB4 SPACE SUB5 ") IS:".
DISPLAY AN (SUB1 SUB2 SUB3 SUB4 SUB5) " INSTEAD OF 00.".
MOVE "*" TO TSWITCH.
VALEND.
EXIT.
SSET.
IF A2 = 2 ADD 16 TO SSUB.
IF A3 = 2 ADD 8 TO SSUB.
IF A4 = 2 ADD 4 TO SSUB.
IF A5 = 2 ADD 2 TO SSUB.
ADD A6 TO SSUB.
MOVE "X" TO S (SSUB).