Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/25/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.