Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/maint/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.