Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/25/suterr.cbl
There is 1 other file named suterr.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
* THIS PROGRAM CREATES THE FILE SIMERR.ERR WHICH CONTAINS
* THE TABLES YE3D,YE3DL,YE3M AND YE3MI.THE TABLES WILL BE
* USED BY THE SIMULA-67 COMPILER TO CREATE ERROR MESSAGES.
* INPUT DATA IS TAKEN FROM THE FILE SIMLH2.RNO.
*
* WRITTEN BY STEPHAN OLDGREN JUL-73
* REVISED BY OLOF BJ@RNER SEP-73
* REVISED BY ELISABETH $LUND NOV -73
PROGRAM-ID.SUTERR.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*IF SIMLH2.RNO AND SIMERR.ERR ARE ASSIGNED TO ANOTHER DEVICE, CHANGE THE NEXT SENTENCES
SELECT DOCFILE ASSIGN TO DSK
RECORDING MODE ASCII.
SELECT ERRFILE ASSIGN TO DSK
RECORDING MODE BINARY.
DATA DIVISION.
FILE SECTION.
FD DOCFILE VALUE OF IDENTIFICATION IS "SIMLH2RNO".
01 D-RECORD USAGE DISPLAY-7.
02 D-DIGIT PIC X OCCURS 140 INDEXED BY I1.
01 HEADER USAGE DISPLAY-7.
02 HEADER-WORD PIC X(33).
88 START-OF-MESS VALUE "COMPILER SOURCE CODE DIAGNOSTICS:".
02 FILLER PIC X(107).
01 END-MESS USAGE DISPLAY-7.
02 END-WORD PIC X(39).
88 END-OF-MESS VALUE "END OF COMPILER SOURCE CODE DIAGNOSTICS".
02 FILLER PIC X(100).
FD ERRFILE VALUE OF IDENTIFICATION IS "SIMERRERR".
01 E-RECORD USAGE COMP.
02 E-WORD PIC S9(10) OCCURS 128 INDEXED BY I2.
WORKING-STORAGE SECTION.
77 R1 PIC S9(10) USAGE COMP.
77 R2 PIC S9(10) USAGE COMP.
77 D-NUM PIC S9(10) USAGE COMP.
77 DL-NUM PIC S9(10) USAGE COMP VALUE 16.
77 M-NUM PIC S9(10) USAGE COMP.
77 MI-NUM PIC S9(10) USAGE COMP.
77 LINE-CHECK PIC S9(10) USAGE COMP.
*QE3D AND QE3M =LENGTH OF TABLES YE3D AND YE3M,THUS IF CHANGED CHANGE LENGTH OF YE3D AND YE3M
*QE3D AND QE3M MUST HAVE THE SAME VALUE AS CORRESPONDING CONSTANTS IN SIMMAC.MAC
*THUS IF CHANGED HERE CHANGE THEM IN SIMMAC
77 QE3D PIC S9(10) USAGE COMP VALUE 448.
77 QE3M PIC S9(10) USAGE COMP VALUE 448.
*QE3M3=3*QE3M, MUST BE CHANGED IF QE3M IS CHANGED
77 QE3M3 PIC S9(10) USAGE COMP VALUE 1344.
01 D-CHECK USAGE DISPLAY-7.
02 C-WORD PIC XXX.
88 SIM VALUE "SIM".
* THE LIMITS OF T-NO MAY VARY.
* THE ACTUAL NUMBERS ARE DEFINED IN SIMMAC.MAC
02 T-NO PIC XXX.
88 OK-ERROR-NUMBER VALUES ARE 60 THRU 237
330 THRU 457
530 THRU 557.
* WHERE FIRST LOW LIMIT IS Q1.ERR AND HIGH Q1.TER-1
* AND SECOND Q2.ERR, HIGH IS Q2.TER-1
* AND THIRD Q3.ERR, HIGH IS Q3.TER-1
88 OK-TERM-NUMBER VALUES ARE 240 THRU 277
460 THRU 477
560 THRU 577.
* WHERE FIRST LOW LIMIT IS Q1.TER, HIGH IS Q2.WAR-1
* AND SECOND Q2.TER, HIGH IS Q3.WAR-1
* AND THIRD Q3.TER, HIGH IS 577
88 OK-WARNING-NUMBER VALUES ARE 1 THRU 57
300 THRU 327
500 THRU 527.
* WHERE FIRST LOW LIMIT IS QWAR1, HIGH IS Q1.ERR-1
* AND SECOND QWAR2, HIGH IS Q2.ERR-1
* AND THIRD Q3.WAR, HIGH IS Q3.ERR-1
02 FILLER PIC X.
02 ERR-TYPE PIC X.
88 W VALUE "W".
88 E VALUE "E".
88 T VALUE "T".
02 FILLER PIC X(132).
01 RUN-OFF-CHECK REDEFINES D-CHECK USAGE DISPLAY-7.
02 RUNOFF-WORD PIC X.
88 POINT VALUE ".".
02 FILLER PIC X(139).
01 HELP-WORD.
02 HW PIC X OCCURS 15 INDEXED BY I8.
01 COM-CHECK REDEFINES HELP-WORD.
02 COM-WORD PIC X(15).
88 COM VALUE "COMPILER ACTION".
01 USE-CHECK REDEFINES COM-CHECK.
02 USE-WORD PIC X(11).
88 USER VALUE "USER ACTION".
02 FILLER PIC X(4).
01 EXP-CHECK REDEFINES USE-CHECK.
02 EXP-WORD PIC X(11).
88 EXP VALUE "EXPLANATION".
02 FILLER PIC X(4).
01 WORD-CHECK REDEFINES EXP-CHECK.
02 TEXT PIC XXXX.
88 X VALUE "XXXX".
88 A VALUE "AAAA".
88 N VALUE "NNNN".
02 FILLER PIC X(11).
01 DH-WORD.
02 DH PIC X OCCURS 6 INDEXED BY I11.
01 H-WORD REDEFINES DH-WORD.
02 HW2 PIC S9(10) USAGE COMP.
01 ERR-MESSAGE.
02 EM0 PIC X(38)
VALUE "ERROR: WRONG NUMBER OF ERROR MESSAGE E".
02 EM1 PIC X(40)
VALUE "ERROR: WRONG NUMBER OF WARNING MESSAGE W".
02 EM2 PIC X(38)
VALUE "ERROR: TWO ERROR MESSAGES WITH NUMBER ".
02 EM3 PIC X(44)
VALUE "ERROR: WRONG NUMBER OF TERMINATION MESSAGE T".
02 EM4 PIC X(27)
VALUE "ERROR: WRONG MESSAGE NUMBER".
02 EM5 PIC X(32)
VALUE "ERROR:MESSAGE NUMBER NOT OCTAL ".
02 EM6 PIC X(37)
VALUE "ERROR: ERROR NUMBER OUT OF SEQUENCE ".
02 EM7 PIC X(37)
VALUE "ERROR: MORE THAN 100 WORDS OF LENGTH ".
02 EM8 PIC X(44)
VALUE "ERROR: WORD LENGTH>15 CHARACTERS IN MESSAGE ".
02 EM9 PIC X(62)
VALUE "ERROR: TOO MANY DIFFERENT WORDS IN LEXICON.MAKE YE3D GREATER.".
02 EM10 PIC X(62)
VALUE "ERROR: TOO MANY LONG ERROR MESSAGES.MAKE YE3M GREATER.".
02 EM11 PIC X(40)
VALUE "ERROR: MORE THAN 15 WORDS IN MESSAGE ".
02 EM12 PIC X(29)
VALUE "ERROR: WRONG TYPE OF MESSAGE ".
02 EM13 PIC X(42)
VALUE "ERROR: FAULTY START OF LINE AFTER MESSAGE ".
02 EM14 PIC X(30)
VALUE "ERROR: NO ERROR MESSAGES FOUND".
02 EM15 PIC X(31)
VALUE "ERROR: NO END OF MESSAGES FOUND".
02 WM01 PIC X(41)
VALUE "WARNING: ERROR MESSAGE OCCUPIES TWO LINES".
01 E3D.
02 W-TABLE OCCURS 15 INDEXED BY I6.
03 D-WORD OCCURS 100 INDEXED BY I7.
04 D-CH PIC X OCCURS 15 INDEXED BY I71.
01 E3DL USAGE COMP.
02 DL-WORD PIC S9(10) OCCURS 15 INDEXED BY I9.
*LENGTH = 3*QE3M, MUST BE CHANGED IF QE3M IS CHANGED AND VICE VERSA
01 E3DM USAGE COMP.
02 DM-WORD PIC S9(10) OCCURS 1344 INDEXED BY I5.
*LENGTH=3*QE3M, MUST BE CHANGED IF QE3M IS CHANGED
01 E3M USAGE COMP.
02 M-WORD PIC S9(10) OCCURS 1344 INDEXED BY I3.
01 E3MI USAGE COMP.
02 MI-WORD OCCURS 384 INDEXED BY I4.
03 ER-TYPE PIC S9(10).
03 WORD-NO PIC S9(10).
03 M-IND PIC S9(10).
*LENGTH =QE3D, HAS TO BE CHANGED IF QE3D IS CHANGED AND VICE VERSA
01 YE3D USAGE COMP.
02 YD-WORD PIC S9(10) OCCURS 448 INDEXED BY I10.
01 YE3DL USAGE COMP.
02 YDL-WORD PIC S9(10) OCCURS 16 INDEXED BY I91.
*LENGTH=QE3M, HAS TO BE CHANGED IF QE3D IS CHANGED AND VICE VERSA
01 YE3M USAGE COMP.
02 YM-WORD PIC S9(10) OCCURS 448 INDEXED BY I31.
01 YE3MI USAGE COMP.
02 YMI-WORD PIC S9(10) OCCURS 192 INDEXED BY I41.
01 O-VALUE.
02 O1 PIC 9.
88 OK-O1 VALUES ARE 0 THRU 7.
02 O2 PIC 9.
88 OK-O2 VALUES ARE 0 THRU 7.
02 O3 PIC 9.
88 OK-O3 VALUES ARE 0 THRU 7.
01 HMIL1 PIC S9(10) USAGE COMP.
01 HMIL2 REDEFINES HMIL1.
02 H21 PIC XXX.
02 H22 PIC XXX.
01 HMIR1 PIC S9(10) USAGE COMP.
01 HMIR2 REDEFINES HMIR1.
02 H23 PIC XXX.
02 H24 PIC XXX.
01 HM1 PIC S9(10) USAGE COMP.
01 HM2 REDEFINES HM1.
02 HM21 PIC XX.
02 HM22 PIC XX.
02 HM23 PIC XX.
01 HM3 PIC S9(10) USAGE COMP.
01 HM4 REDEFINES HM3.
02 HM41 PIC X(4).
02 HM42 PIC XX.
PROCEDURE DIVISION.
RESET.
* THIS PROCEDURE ZEROES SOME GLOBAL VARIABLES AND TABLES.
MOVE 0 TO D-NUM,M-NUM,MI-NUM.
PERFORM MI-Z VARYING I4 FROM 1 BY 1 UNTIL I4 > 384.
PERFORM DL-Z VARYING I9 FROM 1 BY 1 UNTIL I9 > 15.
PERFORM YM-Z VARYING I31 FROM 1 BY 1 UNTIL I31 > QE3M.
GO TO START.
MI-Z.
MOVE 0 TO WORD-NO (I4).
DL-Z.
MOVE 0 TO DL-WORD (I9).
YM-Z.
MOVE 0 TO YM-WORD (I31).
START.
OPEN INPUT DOCFILE.
*FIND START OF HEADER
FIND-HEADER.
READ DOCFILE AT END CLOSE DOCFILE GO TO START-ERR.
IF NOT START-OF-MESS GO TO FIND-HEADER.
SET I3,I4,I5,I8 TO 1.
READ-LINE.
* THIS PROCEDURE CHECKS THE TYPE OF INPUT LINE.
SET I1,I8 TO 1.
READ DOCFILE AT END CLOSE DOCFILE GO TO END-ERR.
MOVE D-RECORD TO D-CHECK.
IF END-OF-MESS CLOSE DOCFILE GO TO M-EDIT.
*LINE STRATING WITH . IS FOR RUN OFF
IF POINT GO TO READ-LINE.
IF SIM GO TO E-CHECK.
IF D-DIGIT (I1) NOT = " " GO TO LINE-ERR.
IF LINE-CHECK = 1 GO TO READ-LINE.
BLANKS.
SET I1 UP BY 1.
* MAX 10 LEADING SPACE
IF I1 > 11 GO TO LINE-ERR.
IF D-DIGIT (I1) = SPACE GO TO BLANKS.
START-LINE.
IF I8 > 15 OR D-DIGIT(I1) = ":" NEXT SENTENCE
ELSE MOVE D-DIGIT (I1) TO HW (I8)
SET I1,I8 UP BY 1 GO TO START-LINE.
IF COM OR USER OR EXP MOVE 1 TO LINE-CHECK GO TO READ-LINE.
DISPLAY WM01.
SUBTRACT I8 FROM I1.
SET I8 TO 1.
PERFORM TEXT-MOVE THRU EXIT-T UNTIL I1 > 140.
GO TO READ-LINE.
E-CHECK.
IF E NEXT SENTENCE ELSE GO TO T-CHECK.
IF OK-ERROR-NUMBER GO TO SIM-IN.
MOVE 1 TO LINE-CHECK.
DISPLAY EM0,T-NO.
GO TO READ-LINE.
T-CHECK.
* THIS PROCEDURE CHECKS THE ERRORNUMBER OF ERRORMESSAGES TYPE T.
IF T NEXT SENTENCE ELSE GO TO W-CHECK.
IF OK-TERM-NUMBER GO TO SIM-IN.
MOVE 1 TO LINE-CHECK.
DISPLAY EM3,T-NO.
GO TO READ-LINE.
LINE-ERR.
* FAULTY START OF LINE
* LINE MUST BEGIN WITH SIM??? OR TAB AND NOT MORE THAN 10 SPACE
MOVE 1 TO LINE-CHECK.
DISPLAY EM13,O-VALUE.
GO TO READ-LINE.
START-ERR.
* NO MESSAGES FOUND
DISPLAY EM14.
GO TO SUTEND.
END-ERR.
*NO END OF MESSAGES FOUND
DISPLAY EM15.
GO TO SUTEND.
W-CHECK.
* THIS PROCEDURE CHECKS THE ERRORNUMBER OF ERRORMESSAGES TYPE W.
IF W NEXT SENTENCE ELSE GO TO NUM-TYPE-ERR.
IF NOT OK-WARNING-NUMBER
MOVE 1 TO LINE-CHECK
DISPLAY EM1,T-NO
GO TO READ-LINE.
SIM-IN.
* THIS PROCEDURE TREATS THE INPUT LINES TYPE SIM.
MOVE T-NO TO O-VALUE.
IF NOT OK-O1 GO TO OCT-ERR.
IF NOT OK-O2 GO TO OCT-ERR.
IF NOT OK-O3 GO TO OCT-ERR.
* SET THE INDEX TO E3MI TO ERROR NUMBER.
COMPUTE R1 = O3 + 8 * O2 + 64 * O1 .
IF R1 < I4
MOVE 1 TO LINE-CHECK
DISPLAY EM6,T-NO GO TO READ-LINE.
SET I4 TO R1.
IF WORD-NO (I4) = 0 NEXT SENTENCE
ELSE MOVE 1 TO LINE-CHECK
DISPLAY EM2,T-NO
GO TO READ-LINE.
IF R1 > MI-NUM MOVE R1 TO MI-NUM.
* MOVE INDEX TO E3M TO M-IND.
SUBTRACT 1 FROM I3 GIVING M-IND (I4).
* MOVE TYPE OF ERROR TO ER-TYPE.
IF W MOVE 2 TO ER-TYPE (I4) ELSE
IF E MOVE 0 TO ER-TYPE (I4) ELSE
IF T MOVE 1 TO ER-TYPE(I4) .
SET I1 TO 10.
* MOVE THE ERROR MESSAGE WORDS TO E3D.
PERFORM TEXT-MOVE THRU EXIT-T UNTIL I1 > 140.
MOVE 0 TO LINE-CHECK.
GO TO READ-LINE.
NUM-TYPE-ERR.
*ERROR ON NUMBER OR TYPE
MOVE 1 TO LINE-CHECK.
IF NOT OK-ERROR-NUMBER DISPLAY EM4,T-NO ELSE
DISPLAY EM12,T-NO.
GO TO READ-LINE.
OCT-ERR.
MOVE 1 TO LINE-CHECK.
DISPLAY EM5,T-NO.
GO TO READ-LINE.
TEXT-MOVE.
MOVE SPACE TO HELP-WORD.
DIGIT-MOVE.
IF D-DIGIT (I1) = SPACE GO TO X-CHECK.
IF I8 > 15
DISPLAY EM8,T-NO
GO TO X-CHECK.
MOVE D-DIGIT (I1) TO HW (I8).
SET I1,I8 UP BY 1.
DIGIT-MOVET.
IF I1 > 140 GO TO EXIT-T.
GO TO DIGIT-MOVE.
X-CHECK.
* CHECK IF ERROR MESSAGE WORD IS XXXX OR AAAA.
IF X MOVE 4095 TO M-WORD (I3) GO TO ADD-I.
IF A MOVE 4094 TO M-WORD (I3) GO TO ADD-I.
IF N MOVE 4093 TO M-WORD (I3) GO TO ADD-I.
IF I8 = 1 SET I1 UP BY 1 GO TO DIGIT-MOVET.
SET I6 TO I8.
SET I6 DOWN BY 1.
PERFORM DW-MOVE VARYING I7 FROM 1 BY 1 UNTIL I7 > 100.
IF I7 = 101
DISPLAY EM7,I6
GO TO SUTEND.
MOVE I6 TO DM-WORD (I5).
MOVE R2 TO M-WORD (I3).
ADD-I.
SET I1,I3,I5 UP BY 1.
IF I3 > QE3M3
DISPLAY EM10,T-NO
GO TO SUTEND.
SET I8 TO 1.
ADD 1 TO WORD-NO (I4),M-NUM.
IF WORD-NO (I4) > 15
MOVE 1 TO LINE-CHECK
DISPLAY EM11,T-NO
GO TO READ-LINE.
EXIT-T.
EXIT.
DW-MOVE.
IF D-WORD (I6,I7) = SPACE
MOVE HELP-WORD TO D-WORD (I6,I7)
SET I9 TO I6
ADD 1 TO DL-WORD (I9).
IF D-WORD (I6,I7) = HELP-WORD
MOVE I7 TO R2
MOVE 102 TO I7.
M-EDIT.
* THIS PROCEDURE CREATES YE3M USING E3M.
ADD 1 TO M-NUM.
DIVIDE 3 INTO M-NUM ROUNDED.
PERFORM M-ADD VARYING I3 FROM 1 BY 1 UNTIL I3 > QE3M3
SET I3 TO 1.
PERFORM M-PACK VARYING I31 FROM 1 BY 1 UNTIL I31 > QE3M.
GO TO MI-EDIT.
M-ADD.
* ADD NUMBER OF WORDS IN E3D TO M-WORD.
MOVE 0 TO R2.
SET I5 TO I3.
MOVE DM-WORD (I5) TO R1.
PERFORM W-ADD VARYING I9 FROM 1 BY 1 UNTIL I9 > R1 - 1.
ADD R2 TO M-WORD (I3).
W-ADD.
ADD DL-WORD (I9) TO R2.
M-PACK.
* PACK THREE M-WORDS TO ONE YM-WORD.
MOVE M-WORD (I3) TO HM3.
MOVE HM42 TO HM21.
SET I3 UP BY 1.
MOVE M-WORD (I3) TO HM3.
MOVE HM42 TO HM22.
SET I3 UP BY 1.
MOVE M-WORD (I3) TO HM3.
MOVE HM42 TO HM23.
MOVE HM1 TO YM-WORD (I31).
SET I3 UP BY 1.
MI-EDIT.
* THIS PROCEDURE CREATES YE3MI USING E3MI.
SET I4 TO 1.
PERFORM MI-PACK VARYING I41 FROM 1 BY 1 UNTIL I41 > 192.
GO TO DL-EDIT.
MI-PACK.
* PACK ER-TYPE,WORD-NO,M-IND INTO THE RIGHT AND LEFT HALF OF YMI-WORD.
COMPUTE HMIL1 = ER-TYPE (I4) * 2 ** 16
+ WORD-NO (I4) * 2 ** 12 + M-IND (I4).
COMPUTE HMIR1 = ER-TYPE (I4 + 1 ) * 2 ** 16
+ WORD-NO (I4 + 1 ) * 2 ** 12 + M-IND ( I4 + 1 )
MOVE H22 TO H23.
MOVE HMIR1 TO YMI-WORD (I41).
SET I4 UP BY 2.
DL-EDIT.
* THIS PROCEDURE CREATES YE3DL USING E3DL.
SET I9 TO 14.
PERFORM DL-ADD VARYING R2 FROM 14 BY -1 UNTIL R2 < 1.
MOVE 0 TO YDL-WORD (1).
MOVE DL-WORD (1) TO YDL-WORD (2),R1.
SET I91 TO 3.
PERFORM DL-MOVE VARYING I9 FROM 2 BY 1 UNTIL I9 > 15.
GO TO D-EDIT.
DL-ADD.
COMPUTE R1 = DL-WORD (I9) * R2 * 2 ** 18.
ADD R1 TO DL-WORD (I9 + 1).
SET I9 DOWN BY 1.
DL-MOVE.
COMPUTE YDL-WORD (I91) = DL-WORD (I9) + R1.
ADD DL-WORD (I9) TO R1.
SET I91 UP BY 1.
D-EDIT.
* THIS PROCEDURES CREATES YE3D USING E3D.
SET I6,I7,I10,I11,I71 TO 1.
PREP-MOVE.
IF I6 = 16 GO TO D-END.
IF D-WORD (I6,I7) = SPACE SET I6 UP BY 1
SET I7 TO 1
GO TO PREP-MOVE.
IF I6 = 16 GO TO D-END.
SET I71 TO 1.
PERFORM D-MOVE UNTIL I71 = I6 + 1.
SET I7 UP BY 1.
GO TO PREP-MOVE.
D-MOVE.
MOVE D-CH (I6,I7,I71) TO DH (I11).
SET I71,I11 UP BY 1.
IF I11 > 6 MOVE HW2 TO YD-WORD (I10)
MOVE SPACE TO DH-WORD
SET I10 UP BY 1
SET I11 TO 1
IF I10 > 1000 DISPLAY EM9
GO TO SUTEND.
D-END.
IF I11 > 1 PERFORM DZ-MOVE UNTIL I11 = 1.
SUBTRACT 1 FROM I10 GIVING D-NUM.
GO TO WRITE-OUT.
DZ-MOVE.
MOVE SPACE TO DH (I11).
SET I11 UP BY 1.
IF I11 > 6 MOVE HW2 TO YD-WORD (I10)
SET I10 UP BY 1
SET I11 TO 1.
WRITE-OUT.
* THIS PROCEDURE WRITES YE3D,YE3DL,YE3M,YE3MI AND THEIR LENGTH
* ON FILE DSK:SIMERR.ERR.
OPEN OUTPUT ERRFILE.
MOVE DL-NUM TO E-WORD (1).
MOVE D-NUM TO E-WORD (2).
MOVE M-NUM TO E-WORD (3).
DIVIDE 2 INTO MI-NUM ROUNDED
MOVE MI-NUM TO E-WORD (4).
SET I2 TO 5.
PERFORM DL-OUT VARYING I91 FROM 1 BY 1 UNTIL I91 = DL-NUM + 1.
PERFORM D-OUT VARYING I10 FROM 1 BY 1 UNTIL I10 = D-NUM + 1.
PERFORM Z-OUT UNTIL I2 = 1.
PERFORM M-OUT VARYING I31 FROM 1 BY 1 UNTIL I31 = M-NUM + 1.
PERFORM Z-OUT UNTIL I2 = 1.
PERFORM MI-OUT VARYING I41 FROM 1 BY 1 UNTIL I41 = MI-NUM + 1.
PERFORM Z-OUT UNTIL I2 = 1.
CLOSE ERRFILE.
SUTEND.
DISPLAY "END OF SUTERR".
STOP RUN.
D-OUT.
MOVE YD-WORD (I10) TO E-WORD (I2).
PERFORM I2-ADD.
DL-OUT.
MOVE YDL-WORD (I91) TO E-WORD (I2).
PERFORM I2-ADD.
M-OUT.
MOVE YM-WORD (I31) TO E-WORD (I2).
PERFORM I2-ADD.
MI-OUT.
MOVE YMI-WORD (I41) TO E-WORD (I2).
PERFORM I2-ADD.
Z-OUT.
MOVE 0 TO E-WORD (I2).
PERFORM I2-ADD.
I2-ADD.
SET I2 UP BY 1.
IF I2 > 128 WRITE E-RECORD
SET I2 TO 1.