Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/maint/sutls1.cbl
There is 1 other file named sutls1.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
*
* WRITTEN BY STEPHAN OLDGREN, ENEA, JUN-73
* REVISED BY OLOF BJ@RNER, ENEA, SEP-73
*
* THIS PROGRAM LISTS THE TEMPORARY FILE NNNLS1.TMP
* WRITTEN BY THE SIMULA COMPILER DURING PASS 1.
*
* REVISION HISTORY
* ----------------
*
*
PROGRAM-ID.SUTLS1.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INFILE ASSIGN TO DSK
RECORDING MODE BINARY.
SELECT LISTFILE ASSIGN TO DSK
RECORDING MODE ASCII.
DATA DIVISION.
FILE SECTION.
FD INFILE VALUE OF IDENTIFICATION IS TEMPFILE
USER-NUMBER IS OCTAL-PPN.
01 INRECORD USAGE COMP.
02 IN-WORD PIC S9(10) OCCURS 128 INDEXED BY I1.
FD LISTFILE VALUE OF IDENTIFICATION IS "LS1REDLST".
01 LISTRECORD PIC X(110) USAGE DISPLAY-7.
WORKING-STORAGE SECTION.
77 ZLNSRC PIC S9(10) COMP.
77 ZLNOK PIC S9(10) COMP.
77 ZLNIND PIC S9(10) COMP.
77 ZLNSRC1 PIC S9(10) COMP.
77 ZLNOK1 PIC S9(10) COMP.
77 ZLNIND1 PIC S9(10) COMP.
77 ANSWER PIC X(10).
88 NOBBEN VALUE "NO".
77 R1 PIC 9(10).
77 G1 PIC 9(10).
77 G2 PIC 9(10).
77 HALF-NUM PIC S9(7) USAGE COMP.
77 OCTAL-PPN PIC S9(10) USAGE COMP VALUE ZERO.
01 IN-NUM USAGE DISPLAY-7.
02 IN1 PIC X OCCURS 18 INDEXED BY I6.
01 IN-JOB.
02 IN-J PIC X OCCURS 3 INDEXED BY I7.
01 IN-JOB2 REDEFINES IN-JOB.
02 IN-J2 PIC 999.
01 IN-PJ.
02 PJ PIC X OCCURS 6 INDEXED BY I8.
01 IN-PJ2 REDEFINES IN-PJ.
02 PROJ-NUM PIC 9(6).
01 IN-PG.
02 PG PIC X OCCURS 6 INDEXED BY I9.
01 IN-PG2 REDEFINES IN-PG.
02 PROG-NUM PIC 9(6).
01 P-NUM.
02 PP-NUM PIC 9(6).
02 X REDEFINES PP-NUM.
03 PP-DIGIT PIC 9 OCCURS 6 INDEXED BY I4.
01 IN-W1 PIC S9(10) USAGE COMP.
01 IN-W2 REDEFINES IN-W1 PIC X(5) USAGE DISPLAY-7.
01 EDITLINE USAGE DISPLAY-7.
02 T PIC X OCCURS 100 INDEXED BY I2.
01 C-WORD USAGE DISPLAY-7.
02 C-DIGIT1 PIC X.
88 S VALUE "S".
88 N VALUE "N".
88 MINUS VALUE "-".
88 L VALUE "L".
88 P VALUE "P".
88 F VALUE "F".
88 I VALUE "I".
88 E VALUE "E".
88 B VALUE "B".
02 C-DIGIT2 PIC X.
02 C-DIGIT3 PIC X.
02 C-DIGIT4 PIC X.
02 C-DIGIT5 PIC X.
01 TEMPFILE.
02 JOB-NO PIC 999.
02 NAME-TEXT PIC X(6) VALUE "LS1TMP".
01 ERROR-M USAGE DISPLAY-7.
02 E-TEXT1 PIC X(27) VALUE "*** ILL CONTROL RECORD : <".
02 E-TEXT2 PIC X(5).
02 E-TEXT3 PIC X(6) VALUE " > ***".
01 HEADLINE.
02 HT-1 PIC X(17) VALUE "CONTENT OF FILE ".
02 NUM PIC 999.
02 HT-2 PIC X(7) VALUE "LS1.TMP".
01 LOOKUPTEXT USAGE DISPLAY-7.
02 FILENAME PIC X(6).
02 POINT PIC X VALUE ".".
02 EXTENTION PIC X(3).
02 PAR1 PIC X VALUE "[".
02 P-NUM.
03 N1 PIC 9.
03 N2 PIC 9.
03 N3 PIC 9.
03 N4 PIC 9.
03 N5 PIC 9.
03 N6 PIC 9.
02 PAR2 PIC X VALUE "]".
01 L-TEXT REDEFINES LOOKUPTEXT USAGE DISPLAY-7.
02 L-T PIC X OCCURS 18 INDEXED BY I3.
01 I-WORD PIC S9(10) USAGE COMP.
01 SIX-WORD REDEFINES I-WORD.
02 S-1 PIC XXX.
02 S-2 PIC XXX.
PROCEDURE DIVISION.
BEGIN.
* THIS PROCEDURE GETS THE JOB NUMBER AND THE PROJ.-PROG. NUMBER
* FOR THE INPUT FILE FROM THE USER AND OPENS THE FILES.
MOVE SPACE TO EDITLINE,C-WORD.
DISPLAY "JOB NO ?" WITH NO ADVANCING.
SET I4,I6,I7,I8,I9 TO 1.
ACCEPT IN-NUM.
PERFORM BREAKUP THRU EX-B.
OPEN INPUT INFILE.
OPEN OUTPUT LISTFILE.
MOVE JOB-NO TO NUM.
WRITE LISTRECORD FROM HEADLINE BEFORE 3.
SET I2 TO 1.
GO TO READ-IN.
BREAKUP.
MOVE IN1 (I6) TO IN-J (I7).
SET I6,I7 UP BY 1.
MOVE IN1 (I6) TO IN-J (I7).
SET I6,I7 UP BY 1.
MOVE IN1 (I6) TO IN-J (I7).
MOVE IN-J2 TO JOB-NO.
SET I6 UP BY 1.
IF IN1 (I6) NOT = "[" GO TO EX-B.
SET I6 UP BY 1.
B-PROJ.
IF IN1 (I6) = "," SET I6 UP BY 1 GO TO B-PROG.
MOVE IN1 (I6) TO PJ (I8).
SET I6,I8 UP BY 1.
GO TO B-PROJ.
B-PROG.
IF IN1 (I6) = "]" GO TO OCT-C.
MOVE IN1 (I6) TO PG (I9).
SET I6,I9 UP BY 1.
GO TO B-PROG.
OCT-C.
MOVE PROJ-NUM TO PP-NUM.
MOVE 0 TO HALF-NUM.
PERFORM CONVERT VARYING I4 FROM 1 BY 1 UNTIL I4 > 6.
COMPUTE OCTAL-PPN = HALF-NUM * 262144.
MOVE PROG-NUM TO PP-NUM.
MOVE 0 TO HALF-NUM.
PERFORM CONVERT VARYING I4 FROM 1 BY 1 UNTIL I4 > 6.
COMPUTE OCTAL-PPN = OCTAL-PPN + HALF-NUM.
GO TO EX-B.
CONVERT.
COMPUTE HALF-NUM = 8 * HALF-NUM + PP-DIGIT (I4).
EX-B.
EXIT.
READ-IN.
READ INFILE AT END CLOSE INFILE,LISTFILE GO TO LIST-ROUTINE.
SET I1 TO 0.
WORD-IN.
* THIS PROCEDURE SEPARATES BIT 35 FROM THE REST OF ONE
* INPUT WORD. BIT 35 DECIDES WHICH TYPE OF RECORD IT IS.
SET I1 UP BY 1.
IF I1 = 129 GO TO EXIT-CH.
DIVIDE 2 INTO IN-WORD (I1) GIVING G1 REMAINDER R1.
CHECK-P.
* THIS PROCEDURE CHECKS WHICH TYPE OF CONTROL RECORD THE
* INPUT WORD IS.
IF R1 = 0 GO TO TEXT-OUT.
MOVE IN-WORD (I1) TO IN-W1.
MOVE IN-W2 TO C-WORD.
IF S GO TO S-TYPE.
IF N OR MINUS OR L OR F GO TO N-TYPE.
IF P GO TO P-TYPE.
IF I GO TO I-TYPE.
IF E OR B GO TO B-TYPE.
IF C-DIGIT1 NUMERIC GO TO NUMERIC-CHECK.
MOVE IN-WORD (I1) TO IN-W1.
MOVE IN-W2 TO E-TEXT2.
WRITE LISTRECORD FROM ERROR-M.
EXIT-CH.
IF I1 > 128 GO TO READ-IN
ELSE GO TO WORD-IN.
NUMERIC-CHECK.
IF C-DIGIT2 = "P" GO TO P-TYPE.
IF C-DIGIT3 = "P" GO TO P-TYPE.
PERFORM TEXT-MOVE.
GO TO EXIT-CH.
TEXT-OUT.
* THIS PROCEDURE MOVES TEXT RECORDS TO THE EDITLINE.
IF I2 > 95 PERFORM WRITE-LINE.
MOVE IN-WORD (I1) TO IN-W1.
MOVE IN-W2 TO C-WORD.
PERFORM TEXT-MOVE.
PERFORM WORD-IN.
IF R1 = 1 PERFORM WRITE-LINE
GO TO CHECK-P.
GO TO TEXT-OUT.
S-TYPE.
* THIS PROCEDURE TREATS TYPE 9 CONTROL RECORDS
MOVE "S" TO T (I2).
SET I1,I2 UP BY 1.
IF I1 = 129 GO TO EXIT-CH.
MOVE IN-WORD (I1) TO I-WORD.
MOVE SIX-WORD TO FILENAME.
SET I1 UP BY 1.
IF I1 = 129 GO TO EXIT-CH.
MOVE IN-WORD (I1) TO I-WORD.
MOVE S-1 TO EXTENTION.
SET I1 UP BY 1.
IF I1 = 129 GO TO EXIT-CH.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N6.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N5.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N4.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N3.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N2.
DIVIDE 8 INTO IN-WORD (I1) REMAINDER N1.
SET I3 TO 1.
S-WRITE.
SET I2 UP BY 1.
MOVE L-T (I3) TO T (I2).
SET I3 UP BY 1.
IF I3 < 19 GO TO S-WRITE.
PERFORM WRITE-LINE.
GO TO EXIT-CH.
N-TYPE.
* THIS PROCEDURE TREATS TYPE 5,7 AND 8 CONTROL RECORDS.
IF I2 > 97 PERFORM WRITE-LINE.
MOVE C-DIGIT1 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT2 TO T (I2).
SET I2 UP BY 2.
GO TO EXIT-CH.
P-TYPE.
* THIS PROCEDURE TREATS TYPE 6 CONTROL RECORDS.
IF I2 > 97 PERFORM WRITE-LINE.
MOVE C-DIGIT1 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT2 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT3 TO T (I2).
SET I2 UP BY 2.
PERFORM WORD-IN.
IF R1 = 0 PERFORM WRITE-LINE
GO TO TEXT-OUT.
GO TO EXIT-CH.
I-TYPE.
* THIS PROCEDURE TREATS TYPE 4 CONTROL RECORDS.
IF I2 > 87 PERFORM WRITE-LINE.
MOVE IN-WORD (I1) TO I-WORD.
IB1.
ENTER MACRO TYPE4 USING I-WORD ZLNSRC ZLNOK ZLNIND ZLNSRC1 ZLNOK1 ZLNIND1.
IB2.
PERFORM EDIT-TYPE4.
IF ZLNSRC1 = -1 GO TO EXIT-CH.
MOVE ZLNSRC1 TO ZLNSRC.
MOVE ZLNOK1 TO ZLNOK.
MOVE ZLNIND1 TO ZLNIND.
PERFORM EDIT-TYPE4.
GO TO EXIT-CH.
B-TYPE.
* THIS PROCEDURE TREATS TYPE 2 AND 3 CONTROL RECORDS.
IF I2 > 94 PERFORM WRITE-LINE.
MOVE IN-WORD (I1) TO I-WORD.
MOVE SPACE TO S-1.
DIVIDE 2 INTO I-WORD.
MOVE C-DIGIT1 TO T (I2).
SET I2 UP BY 1.
MOVE I-WORD TO C-WORD.
PERFORM TEXT-MOVE.
SET I2 UP BY 1.
GO TO EXIT-CH.
WRITE-LINE.
* THIS PROCEDURE WRITES THE EDITLINE ON FILE DSK:LS1RED.LST.
WRITE LISTRECORD FROM EDITLINE.
SET I2 TO 1.
MOVE SPACE TO EDITLINE.
TEXT-MOVE.
MOVE C-DIGIT1 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT2 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT3 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT4 TO T (I2).
SET I2 UP BY 1.
MOVE C-DIGIT5 TO T (I2).
SET I2 UP BY 1.
LIST-ROUTINE.
DISPLAY "OUT ON TTY?".
ACCEPT ANSWER.
IF NOBBEN STOP RUN.
OPEN INPUT LISTFILE.
LIST-LOOP.
READ LISTFILE AT END CLOSE LISTFILE STOP RUN.
DISPLAY LISTRECORD GO TO LIST-LOOP.
EDIT-TYPE4.
MOVE "I" TO T (I2).
SET I2 UP BY 2.
MOVE ZLNSRC TO T (I2).
SET I2 UP BY 1.
MOVE ZLNOK TO T(I2).
SET I2 UP BY 2.
MOVE ZLNIND TO T (I2).
PERFORM WRITE-LINE.