Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/25/suteds.cbl
There is 1 other file named suteds.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
*	THIS PROGRAM CREATES THE FILE SIMEDS.MAC WHICH CONTAINS
*	THE TABLES YE3DL,YE3D,YE3M AND YE3MI.THE TABLES WILL BE
*	USED BY THE SIMDDT SYSTEM 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 FOR SIMDDT BY I WENNERSTR@M NOV-74
PROGRAM-ID.SUTEDS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT DOCFILE ASSIGN TO DSK
	RECORDING MODE ASCII.
	SELECT ERRFILE ASSIGN TO DSK
	RECORDING MODE ASCII.
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(35).
	 88 START-OF-MESS	VALUE	"D.2 RUN-TIME AND DEBUG DIAGNOSTICS:".
	02 FILLER	PIC	X(105).
01	END-MESS USAGE DISPLAY-7.
	02 END-WORD	PIC X(37).
	 88 END-OF-MESS VALUE	"END OF RUN-TIME AND DEBUG DIAGNOSTICS".
	02 FILLER	PIC X(103).

FD	ERRFILE VALUE OF IDENTIFICATION IS "SIMEDSMAC".
01	E-RECORD USAGE DISPLAY-7.
	02 EO-RECORD	PIC X(20).

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.

01	WORK-RECORD USAGE DISPLAY-7.
	02  FILLER	PIC X(5) VALUE "	XWD	".
	02  ER-WORD OCCURS 2 INDEXED BY I2.
		03  E-WORD	PIC 9(6).
		03  KOMMA	PIC X.    

01	D-CHECK USAGE DISPLAY-7.
	02 C-WORD	PIC XXX.
	 88 ZYQ		VALUE "ZYQ".
	 88 ZYD		VALUE "ZYD".
*	THE LIMITS OF T-NO MAY VARY
*	THE ACTUAL NUMBERS ARE DEFINED IN SIMDDT SUBROUTINE DSPM
*	EDIT  RTS[22]  UPPER LIMIT FOR ZYQ CHANGED FROM 177 TO 217
	02 T-NO		PIC 999.
	 88	OK-RTS-NUMBER VALUES ARE 001 THRU 217.
	 88	OK-DDT-NUMBER VALUES ARE 500 THRU 777.
*	ZYQ LOW LIMIT IS 0 ,HIGH IS QZYQLN
*	ZYD LOW LIMIT IS QZYDFN,HIGH IS QZYDLN

	02 FILLER	PIC X.
	02 ERR-TYPE	PIC X.
	 88 W		VALUE "W".
	 88 E		VALUE "E".
	 88 T		VALUE "T".
	 88 B		VALUE "#".
	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	RTS-CHECK REDEFINES D-CHECK USAGE DISPLAY-7.
	02 RTS-WORD	PIC X(10).
	 88 RTS		VALUE "RTS ACTION".
	02 FILLER	PIC X(130).

01	DDT-CHECK REDEFINES RTS-CHECK USAGE DISPLAY-7.
	02 DDT-WORD	PIC X(13).
	 88 DDT		VALUE "SIMDDT ACTION".
	02 FILLER	PIC X(127).

01	USE-CHECK REDEFINES DDT-CHECK USAGE DISPLAY-7.
	02 USE-WORD	PIC X(11).
	 88 USER	VALUE "USER ACTION".
	02 FILLER	PIC X(129).

01	EXP-CHECK REDEFINES USE-CHECK USAGE DISPLAY-7.
	02 EXP-WORD	PIC X(11).
	 88 EXP		VALUE "EXPLANATION".
	02 FILLER	PIC X(129).

01	HELP-WORD.
	02 HW		PIC X OCCURS 15 INDEXED BY I8.

01	WORD-CHECK REDEFINES HELP-WORD.
	02 TEXT		PIC XXXX.
	 88 X		VALUE "XXXX".
	 88 A 		VALUE "AAAA".
	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 EM1		PIC X(36) 
	VALUE "ERROR: WRONG NUMBER OF ZYQ MESSAGE  ".
	02 EM2		PIC X(38) 
	VALUE "ERROR: TWO ERROR MESSAGES WITH NUMBER ".
	02 EM3		PIC X(36) 
	VALUE "ERROR: WRONG NUMBER OF ZYD MESSAGE  ".
	02 EM4		PIC X(29) 
	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(43)
	VALUE "ERROR: I10>1000,LENGTH OF YEDD>1000 WORDS".
	02 EM10		PIC X(40)
	VALUE "ERROR: NUMBER OF WORDS >2100 AT MESSAGE ".
	02 EM11		PIC X(40)
	VALUE "ERROR: MORE THAN 15 WORDS IN MESSAGE  , ".
	02 EM12		PIC X(30)
	VALUE "ERROR: ERROR TYPE INVALID   , ".
	02 EM14	PIC X(30)
	VALUE "ERROR: NO ERROR MESSAGES FOUND".
	02 EM15	PIC X(31)
	VALUE "ERROR: NO END OF MESSAGES FOUND".

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.

01	E3DM USAGE COMP.
	02 DM-WORD	PIC S9(10) OCCURS 2100 INDEXED BY I5.

01	E3M USAGE COMP.
	02 M-WORD	PIC S9(10) OCCURS 2100 INDEXED BY I3.

01	E3MI USAGE COMP.
	02 MI-WORD OCCURS 512 INDEXED BY I4.
	 03 ER-TYPE	PIC S9(10).
	 03 WORD-NO	PIC S9(10).
	 03 M-IND	PIC S9(10).

01	YE3D USAGE COMP.
	02 YD-WORD	PIC S9(10) OCCURS 1000 INDEXED BY I10.

01	YE3DL USAGE COMP.
	02 YDL-WORD	PIC S9(10) OCCURS 16 INDEXED BY I91.

01	YE3M USAGE COMP.
	02 YM-WORD	PIC S9(10) OCCURS 525 INDEXED BY I31.

01	YE3MI USAGE COMP.
	02 YMI-WORD	PIC S9(10) OCCURS 512 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 XXX.
	02 HM22		PIC XXX.

01	HM3		PIC S9(10) USAGE COMP.

01	HM4 REDEFINES HM3.
	02 HM41		PIC X(3).
	02 HM42		PIC XXX.
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 > 512.
	PERFORM DL-Z VARYING I9 FROM 1 BY 1 UNTIL I9 > 15.
	PERFORM YM-Z VARYING I31 FROM 1 BY 1 UNTIL I31 > 525.
	MOVE "," TO KOMMA(1).
	GO TO BEGIN.
MI-Z.
	MOVE 0 TO WORD-NO (I4).
DL-Z.
	MOVE 0 TO DL-WORD (I9).
YM-Z.
	MOVE 0 TO YM-WORD (I31).
BEGIN.
	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 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 STARTING WITH . IS FOR RUNOFF
	IF	POINT GO TO READ-LINE.
	IF ZYQ GO TO T1-CHECK.
	IF ZYD GO TO T2-CHECK.
	IF RTS OR DDT OR USER OR EXP
		MOVE 1 TO LINE-CHECK
		 GO TO READ-LINE.
	IF LINE-CHECK = 1 GO TO READ-LINE.
	PERFORM TEXT-MOVE THRU EXIT-T UNTIL I1 > 140.
	GO TO READ-LINE.
START-ERR.
* NO MESSAGE S FOUND
	DISPLAY EM14.
	GO TO SUTEND.
END-ERR.
* NO END OF MESSAGES FOUND
	DISPLAY EM15.
	GO TO SUTEND.
T1-CHECK.
*	CHECK ZYQ ERROR NUMBERS
	IF NOT OK-RTS-NUMBER
	MOVE 1 TO LINE-CHECK
	DISPLAY EM1,T-NO
	GO TO READ-LINE.
*	CALCULATE INDEX ,WHICH STARTS WITH 0
	MOVE 0 TO R1.
	GO TO MESS-IN.
T2-CHECK.
*	CHECK ZYD ERROR NUMBERS
	IF NOT OK-DDT-NUMBER
	MOVE 1 TO LINE-CHECK
	DISPLAY EM3,T-NO
	GO TO READ-LINE.
*	CALCULATE INDEX WHICH STARTS AT QZYDFN-QZYQLN-1
*		OCTAL 260 = 6*8 + 2*64 = 176	;EDIT [14 22 15]  RTS[22]
	MOVE 176 TO R1.
MESS-IN.
*	THIS PROCEDURE TREATS THE INPUT LINES TYPE ZYQ AND ZYD.
	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 - R1.
	COMPUTE R1 = O3 + 8 * O2 + 64 * O1 - R1.
	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) GO TO OK-TYPE.
	IF E MOVE 0 TO ER-TYPE (I4) GO TO OK-TYPE.
	IF T MOVE 1 TO ER-TYPE (I4) GO TO OK-TYPE.
	IF B MOVE 0 TO ER-TYPE (I4) GO TO OK-TYPE.
	MOVE 1 TO LINE-CHECK.
	DISPLAY EM12,T-NO.
	GO TO READ-LINE.
OK-TYPE.
	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.
	
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 D-DIGIT (I1) = "#" 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.
*	NO INSERTIONS PROGRAMMED YET
	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  > 2100
	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 4 INTO M-NUM ROUNDED.
	PERFORM M-ADD VARYING I3 FROM 1 BY 1 UNTIL I3 > 2100.
	SET I3 TO 1.
	PERFORM M-PACK VARYING I31 FROM 1 BY 1 UNTIL I31 > 525.
	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 FOUR M-WORDS TO ONE YM-WORD.
	MOVE M-WORD (I3) TO HM3.
	SET I3 UP BY 1.
	COMPUTE HM3 = HM3 * 512 + M-WORD (I3).
	MOVE HM42 TO HM21.

	SET I3 UP BY 1.
	MOVE M-WORD (I3) TO HM3.
	SET I3 UP BY 1.
	COMPUTE HM3 = HM3 * 512 + M-WORD (I3).
	MOVE HM42 TO HM22.
	SET I3 UP BY 1.

	MOVE HM1 TO YM-WORD (I31).
MI-EDIT.
*	THIS PROCEDURE CREATES YE3MI USING E3MI.
	SET I4 TO 1.
	PERFORM MI-PACK VARYING I41 FROM 1 BY 1 UNTIL I41 > 512.
	GO TO DL-EDIT.
MI-PACK.
*	PACK ER-TYPE,WORD-NO,M-IND INTO THE    YMI-WORD.

	COMPUTE YMI-WORD (I41) = ER-TYPE (I4) * 2 ** 16 
	+ WORD-NO (I4) * 2 ** 12 + M-IND (I4).  

	SET I4 UP BY 1 .
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.

	SUBTRACT 1 FROM DL-NUM GIVING DL-NUM.
	MOVE DL-NUM TO E-WORD (2).
	PERFORM Z-WRITE.


	MOVE D-NUM TO E-WORD (2).
	PERFORM Z-WRITE.

	MOVE M-NUM TO E-WORD (2).
	PERFORM Z-WRITE.

	DIVIDE 2 INTO MI-NUM ROUNDED.
	MOVE MI-NUM TO E-WORD (2).
	PERFORM Z-WRITE.


	PERFORM DL-OUT VARYING I91 FROM 2 BY 1 UNTIL I91 = DL-NUM + 2.

	PERFORM D-OUT VARYING I10 FROM 1 BY 1 UNTIL I10 = D-NUM + 1.

	PERFORM M-OUT VARYING I31 FROM 1 BY 1 UNTIL I31 = M-NUM + 1.

	ADD MI-NUM TO MI-NUM .
	PERFORM MI-OUT VARYING I41 FROM 1 BY 2 UNTIL I41 = MI-NUM + 1.

	CLOSE ERRFILE.

SUTEND.
	DISPLAY "END OF SUTEDS".

	STOP RUN.

D-OUT.
	MOVE YD-WORD (I10) TO HMIR1.
	PERFORM I2-ADD.
DL-OUT.
	MOVE YDL-WORD (I91) TO HMIR1.
	PERFORM I2-ADD.
M-OUT.
	MOVE YM-WORD(I31) TO HMIR1.
	PERFORM I2-ADD.
MI-OUT.
	MOVE YMI-WORD (I41) TO E-WORD (1).
	MOVE YMI-WORD (I41 + 1 ) TO E-WORD (2).
	WRITE E-RECORD FROM WORK-RECORD.
Z-OUT.
	MOVE 0 TO E-WORD (I2).
	PERFORM I2-ADD.
I2-ADD.
	MOVE H23 TO H22.
	MOVE SPACE TO H21.
	MOVE SPACE TO H23.
	MOVE HMIL1 TO E-WORD (1).
	MOVE HMIR1 TO E-WORD (2).
	WRITE E-RECORD FROM WORK-RECORD.
Z-WRITE.
	MOVE 0 TO E-WORD (1).
	WRITE E-RECORD FROM WORK-RECORD.



*	WARNINGS THAT ARE ACCEPTABLE
*MOST SIGNIFICANT DIGITS TRUNCATED ON I4,HM3,E-WORD AND YMI-WORD