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