Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
uetp/lib/xtbl9s.cbl
There are 20 other files named xtbl9s.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.
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).