Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - acp010.lib
There are 4 other files named acp010.lib in the archive. Click here to see a list.
C\G,@C\G,RC
GuCvI6G4bCX9G4Y>>N)GlY>>N8Gz[LHG4[LIG4 ]>LzGg$[s[#g&\D$%g"~-	G8g"~-G;4
$JOB                                                                            
.NOERROR                                                                          
.R LIBARY                                                                         
(**=ACCEPT                                                                         
2**EXTRACT ACP1,ACP1.CTL                                                           
<**EXTRACT CHKACP,CHKACP.CTL                                                       
F**EXTRACT LOGTYP,LOGTYP.CBL                                                       
P**EXTRACT NEWTST,NEWTST.CBL                                                       
Z**EXTRACT SHORTL,SHORTL.CBL                                                       
d*                                                                                 
n..DELETE ACP1.LOG,CHKACP.LOG                                                      
xFiles deleted:                                                                    
% No file named DSK:ACP1.LOG                                                      

% No file named DSK:CHKACP.LOG                                                    
..SUB ACP1                                                                        
 Job ACP1 submitted                                                                
*..COMPILE LOGTYP                                                                  
4COBOL:	LOGTYP  [LOGTYP.CBL]                                                       
>EXIT                                                                              
H..COMPILE NEWTST                                                                  
RCOBOL:	NEWTST  [NEWTST.CBL]                                                       
\WARNINGS:                                                                         
f    0135  RIGHT-MOST TRUNCATION ON SINGLE-CHAR                                    
p    0143  MOST SIGNIFICANT DIGITS TRUNCATED ON PTR                                
z    0200  RIGHT-MOST TRUNCATION ON STARLINETEXT                                   
NO FATAL ERRORS, 3 WARNINGS                                                       
EXIT                                                                              
..COMPILE SHORTL                                                                  
"COBOL:	SHORTL  [SHORTL.CBL]                                                       
,EXIT                                                                              

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT1.
(* REDEFINES
2* VALUE CLAUSE
<* ONE DIMENSIONED TABLE
F* OPEN, CLOSE, READ, WRIT SEQUENTIAL FILES
P*   WITH BLOCKING AND ASCII/SIXBIT/BINARY MODES.
Z* SAME AREA
d* RERUN EVERY N RECORDS
n* MOVE ALL LITERAL
x* PERFORM N TIMES
* PERFORM VARYING

* ADD X TO Y
* GO TO
 * DISPLAY
** STRING
4ENVIRONMENT DIVISION.
>I-O SECTION.
HFILE-CONTROL.
R	SELECT WORK-1 ASSIGN TO DSK
\	RECORDING MODE IS SIXBIT.
f
p	SELECT WORK-2 ASSIGN TO DSK
z	RECORDING MODE IS BINARY.

	SELECT WORK-3 ASSIGN TO LOGDEV
	RECORDING MODE IS ASCII.
"
,I-O-CONTROL.
6	RERUN EVERY 300 RECORDS OF WORK-3
@	SAME AREA WORK-1 WORK-2 WORK-3.
J
TDATA DIVISION.
^FILE SECTION.
hFD	WORK-1
r	VALUE OF ID IS FILENAME
|	BLOCK CONTAINS 3 RECORDS.
01	RECORD-1 PIC X(80).

FD	WORK-2
$	VALUE OF ID 'WORK2    '.
.01	RECORD-2 PIC X(120).
8
BFD	WORK-3
L	VALUE OF ID 'TSTDATSEQ'.
V01	RECORD-3 DISPLAY-7.
`	3 RECKEY	PIC XXXXXX.
j	3 RECKEYREDEF REDEFINES RECKEY.
t	  5 RECKEY1	PIC XXX.
~	  5 RECNO	PIC 999.
	3 FILLER	PIC X(20).

WORKING-STORAGE SECTION.
&1	FILENAME	PIC X(9) VALUE "WORK1XXXX".
077	COUNT-1 PIC 99 VALUE 0.
:77	COUNT-2 PIC 99 VALUE 0.
D77	COUNT-3 PIC 9999 VALUE 0.
N1	TABLEOFVALUES.
X	3 RECVALUE PIC XXX OCCURS 999 TIMES.
b1	I	PIC S9(10) COMP.
l1	MESSAGEOUT	PIC X(28).
v
PROCEDURE DIVISION.

MAIN SECTION.
P0.
	MOVE ALL "AAABBBCCCDDDEEEFFFGGGHHHIIIJJJ" TO TABLEOFVALUES.
(	OPEN OUTPUT WORK-1.
2	MOVE 'TEST DATA ' TO RECORD-1.
<	PERFORM WRITE-1 10 TIMES.
F	CLOSE WORK-1.
P	STRING "  " FILENAME DELIMITED BY "X"
Z		"X.XXX WRITTEN           " DELIMITED BY SIZE
d		INTO MESSAGEOUT.
n	DISPLAY MESSAGEOUT.
x	OPEN OUTPUT WORK-2.
	MOVE 'TEST DATA' TO RECORD-2.

	PERFORM WRITE-2 20 TIMES.
	CLOSE WORK-2.
 	DISPLAY '  WORK2 CREATED'.
*	OPEN OUTPUT WORK-3.
4	MOVE 'XXXXXX TEST DATA' TO RECORD-3.
>	PERFORM WRITE-3 VARYING I FROM 1 BY 1 UNTIL I > 999.
H	CLOSE WORK-3.
R	DISPLAY '  TSTDAT.SEQ CREATED '.
\	OPEN INPUT WORK-1.
fLOOP1.
p	READ WORK-1 RECORD AT END GO TO B1.
z	ADD 1 TO COUNT-1.
	GO TO LOOP1.
B1.
	IF COUNT-1=10, DISPLAY '  WORK1 CHECKOUT O.K.', GO TO B2.
"	DISPLAY '? 10 RECORDS ARE EXPECTED FROM WORK1, ONLY ';
,	COUNT-1, ' RECORDS WERE READ.'.
6B2.
@
J	CLOSE WORK-1, WITH DELETE.
T	OPEN INPUT WORK-2.
^LOOP2.
h	READ WORK-2 AT END GO TO B3.
r	ADD 1 TO COUNT-2.
|	GO TO LOOP2.
B3.
	IF COUNT-2=20, DISPLAY '  WORK2 CHECKOUT O.K.', GO TO B4.
	DISPLAY '? 20 RECORDS ARE EXPECTED FROM WORK-2, ONLY ';
$	COUNT-2, ' RECORDS WERE READ.'.
.B4.
8	CLOSE WORK-2  WITH DELETE.
B	OPEN INPUT WORK-3.
LLOOP3.
V	READ WORK-3 AT END GO TO B5.
`	ADD 1 TO COUNT-3.
j	IF COUNT-3 NOT = RECNO
t	  DISPLAY "? EXPECTING RECORD #" COUNT-3 ", GOT RECORD #" RECNO.
~	GO TO LOOP3.
	B5.
		IF COUNT-3=999, DISPLAY ' TSTDAT.SEQ CHECKOUT O.K.', GO TO B6.
		DISPLAY '? 999 RECORDS ARE EXPECTED FROM TSTDAT.SEQ, ONLY ';
	&	COUNT-3, ' RECORDS WERE READ.'.
	0B6.
	:	CLOSE WORK-3.
	D	DISPLAY "END ACCPT1".
	N	STOP RUN.
	XWRITE-1.
	b	WRITE RECORD-1.
	lWRITE-2.
	v	WRITE RECORD-2.

WRITE-3.


	MOVE RECVALUE (I) TO RECKEY1.

	MOVE I TO RECNO.

	WRITE RECORD-3.

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT2.
(* OPEN, CLOSE, READ, WRITE ON RANDOM FILE
2* SORT WITH INPUT AND OUTPUT PROCEDURES.
<* REPORT WRITING FEATURES.
F* LINKED WITH COBDDT.REL, CHECKS COBDDT AD HISTOGRAM
PENVIRONMENT DIVISION.
ZINPUT-OUTPUT SECTION.
dFILE-CONTROL.
n	SELECT SEQFILE ASSIGN TO DSK.
x	SELECT RANFILE ASSIGN TO DSK
	  FILE-LIMIT IS ONETHOUSAND

	  ACCESS RANDOM
	  ACTUAL KEY ACTKEY
 	  RECORDING MODE IS SIXBIT.
*	SELECT REPFILE ASSIGN TO DSK.
4	SELECT SRTFILE ASSIGN TO DSK DSK DSK.
>DATA DIVISION.
HFILE SECTION.
RFD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
\1	SEQREC PIC X(26) DISPLAY-7.
fFD	RANFILE VALUE OF ID IS "TSTDATRAN"
p	  BLOCK CONTAINS 20 RECORDS.
z1	RANREC PIC X(26).
FD	REPFILE  VALUE OF ID IS "TSTDATREP"
	  REPORT IS REPTRY.
1	REPREC PIC X(45) DISPLAY-7.
"SD	SRTFILE.
,1	SRTREC.
6	3 KEY1 PIC XXX.
@	3 KEY2 PIC 999.
J	3 KEY2REDEF REDEFINES KEY2.
T	  5 DIGIT1 PIC 9.
^	  5 DIGIT2 PIC 9.
h	  5 DIGIT3 PIC 9.
r	3 KEY3 PIC X(20).
|WORKING-STORAGE SECTION.
1	ACTKEY	PIC S9(10) COMP.
1	I		PIC S9(10) COMP.
1	ONETHOUSAND	PIC S9(10) COMP VALUE 1000.
$1	OLDKEY		PIC XXX VALUE SPACE.
.REPORT SECTION.
8RD	REPTRY
B	  PAGE 60 LINES
L	  CONTROLS ARE FINAL DIGIT1 DIGIT2.
V1	  TYPE CONTROL FOOTING FINAL LINE PLUS 5.
`	3 COLUMN 1 PIC X(20) VALUE "FINAL LINE".
j	3 COLUMN 30 PIC XXX SOURCE KEY1.
t	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
~	3 COLUMN 40 PIC ZZZZ SOURCE I.
1	  TYPE CONTROL FOOTING DIGIT1 LINE PLUS 3.
	3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 1 ".
	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
&1	  TYPE CONTROL FOOTING DIGIT2 LINE PLUS 2.
0	3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 2".
:	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
D1	DETAILLINE TYPE DETAIL LINE PLUS 1.
N	3 COLUMN 1 PIC XXXXXX VALUE "DETAIL".
X	3 COLUMN 30 PIC XXX SOURCE KEY1.
b	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
l1	TYPE PAGE HEADING LINE 1 NEXT GROUP PLUS 3.
v	3 COLUMN 1 PIC X(35) VALUE "ACCEPTANCE TEST REPORT".
	3 COLUMN 30 PIC X(5) VALUE "PAGE".

	3 COLUMN 35 PIC ZZZ SOURCE PAGE-COUNTER.
PROCEDURE DIVISION.
MAINLINE SECTION.
(P0.
2	SORT SRTFILE ON ASCENDING KEY1
<	  INPUT PROCEDURE INPROCEDURE
F	  OUTPUT PROCEDURE OUTPROCEDURE.
P	DISPLAY "END ACCPT2".
Z	STOP RUN.
dINPROCEDURE SECTION.
nIP0.
x	OPEN INPUT SEQFILE, OUTPUT REPFILE.
	INITIATE REPTRY.

IP5.
	READ SEQFILE AT END GO TO IP10.
 	RELEASE SRTREC FROM SEQREC.
*	MOVE SEQREC TO SRTREC.
4	GENERATE DETAILLINE.
>	GO TO IP5.
HIP10.
R	DISPLAY "  PRESORT DONE".
\	TERMINATE REPTRY.
f	CLOSE REPFILE.
p	CLOSE SEQFILE.
z	DISPLAY "  TSTDAT.REP WRITTEN".

OUTPROCEDURE SECTION.
OP0.
"	OPEN OUTPUT RANFILE.
,	DISPLAY "  MERGE STARTED".
6OP5.
@	RETURN SRTFILE AT END GO TO OP10.
J	IF KEY1 NOT < OLDKEY
T	  NEXT SENTENCE
^	ELSE
h	  DISPLAY SPACE
r	  DISPLAY "? KEYS NOT IN ORDER, LAST = " OLDKEY
|	  ", THIS = " KEY1.
	MOVE KEY1 TO OLDKEY.
	MOVE KEY2 TO ACTKEY.
	WRITE RANREC FROM SRTREC INVALID KEY
$	  DISPLAY SPACE
.	  DISPLAY "? CAN'T WRITE RANDOM RECORD AT KEY VALUE " ACTKEY.
8	GO TO OP5.
BOP10.
L	CLOSE RANFILE.
V	DISPLAY "  MERGE ENDED".
`	DISPLAY "  TSTDAT.RAN WRITTEN".
j	MOVE 0 TO ACTKEY I.
t	OPEN INPUT RANFILE.
~OP15.
		READ RANFILE INTO SRTREC INVALID KEY
		  GO TO OP25.
		ADD 1 TO I.
	&	IF I NOT = KEY2
	0	  DISPLAY SPACE
	:	  DISPLAY "? RANDOM FILE RECORD OUT OF ORDER"
	D	  DISPLAY "  OR MISSING AT RECORD POSITION " I
	N	  DISPLAY "  RECORD FOUND THERE IS"
	X	  DISPLAY SRTREC.
	b	GO TO OP15.
	lOP25.
	v	CLOSE RANFILE.

	DISPLAY "  TSTDAT.RAN CHECK COMPLETED".

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT3.
(* CONDITION-NAMES
2* CALL
<* OPEN INPUT-OUTPUT, DELETE REWRITE ON INDEXED FILE.
F* COMPILED WITH /U SWITCH, LINKED AS ROOT FOR OVERLAY.
PENVIRONMENT DIVISION.
ZINPUT-OUTPUT SECTION.
dFILE-CONTROL.
n	SELECT SEQFILE ASSIGN TO DSK.
x	SELECT RANFILE ASSIGN TO DSK
	  ACCESS RANDOM

	  FILE LIMIT IS 1000
	  ACTUAL KEY IS ACTKEY.
 	SELECT IDXFILE ASSIGN TO DSK
*	  ACCESS INDEXED
4	  SYMBOLIC KEY IS SYMKEY
>	  RECORD KEY IS IDXKEY2.
H	SELECT REPFILE ASSIGN TO DSK.
RDATA DIVISION.
\FILE SECTION.
fFD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
p1	SEQREC	PIC X(26) DISPLAY-7.
z
FD	RANFILE VALUE OF ID IS "TSTDATRAN"
	  BLOCK CONTAINS 20 RECORDS.
1	RANREC	PIC X(26).
"
,FD	IDXFILE VALUE OF ID IS "TSTDATIDX"
6	  BLOCK CONTAINS 29 RECORDS.
@1	IDXREC.
J	3 IDXKEY1 PIC XXX.
T	88 RECORDTOBEDELETED VALUE "AAA" THRU "EEE".
^	88 RECORDTOBEREWRITTEN VALUE "FFF" "GGG" "HHH" "III" THRU "JJJ".
h	3 IDXKEY2 PIC 999.
r	3 IDXFILLER PIC X(20).
|
FD	REPFILE VALUE OF ID IS "TSTDATREP".
1	REPREC PIC X(45) DISPLAY-7.

$WORKING-STORAGE SECTION.
.1	ACTKEY		PIC S9(10) COMP.
81	SYMKEY	PIC 999 VALUE LOW-VALUE.
B1	OLDIDXKEY2	PIC 999 VALUE LOW-VALUE.
L1	I		PIC S9(10) COMP.
V1	RANWSREC	PIC X(26).
`1	REPWSREC DISPLAY-7.
j	88 ABORTSIGNALON VALUE ALL "Z".
t	3 FILLER	PIC XXXXXX.
~	88 ADETAILRECORD VALUE "DETAIL".
	3 FILLER	PIC X(39).
PROCEDURE DIVISION.
MAINLINE SECTION.
&P0.
0	OPEN INPUT SEQFILE REPFILE.
:	OPEN INPUT-OUTPUT RANFILE IDXFILE.
D	DISPLAY "  ALL FILES OPENED".
NP5.
X	ADD 1 TO I.
b	READ IDXFILE INVALID KEY GO TO ENDCHECK.
l	IF IDXKEY2 NOT > OLDIDXKEY2
v	  DISPLAY "? INDEXFILE RECORDS OUTOF ORDER.".
	MOVE IDXKEY2 TO OLDIDXKEY2.

	IF I NOT = IDXKEY2
	  DISPLAY "? ON READ NUMBER " I " WE GOT THIS RECORD:"
	  DISPLAY "  " IDXREC.
(	MOVE IDXKEY2 TO ACTKEY.
2	READ RANFILE INTO RANWSREC INVALID KEY
<	  DISPLAY "? CAN'T READ RECORD #" ACTKEY " ON RANDOM FILE.".
F	READ SEQFILE AT END
P	  DISPLAY "? PREMATURE AT END ON SEQUENTIAL FILE.".
ZP7.
d	READ REPFILE INTO REPWSREC AT END
n	  DISPLAY "? PREMATURE AT END ON REPORT FILE.".
x	IF NOT ADETAILRECORD GO TO P7.


	CALL ACCPT4 USING I SEQREC RANWSREC REPWSREC IDXREC.

 	IF ABORTSIGNALON
*	  DISPLAY "? RECORDS DO NOT MATCH, ABORTING EXECUTION"
4	  STOP RUN.
>	MOVE IDXKEY2 TO SYMKEY.
H	IF RECORDTOBEDELETED
R	  DELETE IDXREC INVALID KEY
\	    DISPLAY "? CAN'T DELETE RECORD ON INDEXED FILE.".
f	IF RECORDTOBEREWRITTEN
p	  MOVE SPACES TO IDXKEY1
z	  REWRITE IDXREC INVALID KEY
	    DISPLAY "? CAN'T REWRITE RECORD ON INDEXED FILE.".
	MOVE LOW-VALUE TO SYMKEY.
	GO TO P5.
"ENDCHECK.
,	READ SEQFILE AT END
6	  DISPLAY "  SEQUENTIAL FILE OK"
@	  GO TO P35.
J	DISPLAY "? TOO MANY RECORDS IN SEQUENTIAL FILE.".
TP35.
^	CLOSE SEQFILE RANFILE.
hP36.
r	READ REPFILE INTO REPWSREC AT END GO TO P37.
|	IF NOT ADETAILRECORD GO TO P36.
	DISPLAY "? TOO MANY DETAIL RECORDS IN REPORT FILE.".
P37.
	CLOSE REPFILE.
$	IF I = 1000 
.	  DISPLAY "  NORMAL END ACCPT3."
8	ELSE DISPLAY "? ABNORMAL END ACCPT3, ONLY " I " RECORDS COUNTED.".
B	STOP RUN.

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT4.
(* LINKAGE SECTION.
2* COMPILED WITH /U SWITCH, LINKED AS OVERLAY.
<DATA DIVISION.
FWORKING-STORAGE SECTION.
PLINKAGE SECTION.
Z1	I	PIC S9(10) COMP.
d1	SEQREC DISPLAY-7.
n	3 SEQKEY1		PIC XXX.
x	3 SEQKEY2		PIC 999.
	3 SEQKEY3		PIC X(20).

1	RANREC.
 	3 RANKEY1		PIC XXX.
*	3 RANKEY2		PIC 999.
4	3 RANKEY3		PIC X(20).
>
H1	IDXREC.
R	3 IDXKEY1		PIC XXX.
\	3 IDXKEY2		PIC 999.
f	3 IDXKEY3		PIC X(20).
p
z1	REPREC DISPLAY-7.
	3 REPKEY3		PIC X(29).
	3 REPKEY1		PIC XXX.
	3 FILLER		PIC XX.
"	3 REPKEY2		PIC 999.
,	3 FILLER 		PIC X(8).
6PROCEDURE DIVISION USING I SEQREC RANREC REPREC IDXREC.
@MANLINE SECTION.
JP0.
T	IF REPKEY1 NOT = RANKEY1
^	OR RANKEY1 NOT = SEQKEY1
h	OR SEQKEY1 NOT = IDXKEY1
r	OR IDXKEY1 NOT = REPKEY1
|	  DISPLAY "? KEY1 VALUES ARE NOT EQUAL, RECORD # " I
	  DISPLAY "  RANDOM  KEY = " RANKEY1
	  DISPLAY "  INDEXED KEY = " IDXKEY1
	  DISPLAY "  SEQUENT KEY = " SEQKEY1
$	  DISPLAY "  REPORT  KEY = " REPKEY1
.	  GO TO BADEXIT.
8	IF RANKEY2 = REPKEY2
B	AND REPKEY2 = SEQKEY2
L	AND IDXKEY2 = SEQKEY2
V	  GO TO GOODEXIT.
`	DISPLAY "? KEY2 VALUES NOT EQUAL, RECORD # " I
j	DISPLAY "  RANDOM  KEY = " RANKEY2
t	DISPLAY "  INDEXED KEY = " IDXKEY2
~	DISPLAY "  SEQUENT KEY = " SEQKEY2
	DISPLAY "  REPORT  KEY = " REPKEY2.
BADEXIT.
	MOVE ALL "Z" TO REPREC.
&GOODEXIT.
0	EXIT PROGRAM.


;$JOB
.NOERROR
(.R LIBARY
2*=ACP010
<*EXTRACT ACCPT1CB,ACCPT1.CBL
F*EXTRACT ACCPT2CB,ACCPT2.CBL
P*EXTRACT ACCPT3CB,ACCPT3.CBL
Z*EXTRACT ACCPT4CB,ACCPT4.CBL
d.R SETSRC                                                       
n*SYS  
x.ASS DSK SYS
.SET WATCH V

.RU COBOL
*=ACCPT1
 .RU COBOL
**=ACCPT2
4.RU COBOL
>*=ACCPT3/U/P
H.RU COBOL
R*=ACCPT4/U/P
\.R LINK
f*ACCPT1,LIBOL/SEA/G
p.SAVE ACCPT1
z.ASSIGN DSK LOGDEV
.RU ACCPT1
.DEAS LOGDEV
.GET RERUN
".ST
,*ACCPT1
6.ASSIGN DSK LOGDEV
@.CONT
J.RU ISAM
T*TSTDAT
^*A
h*S
r*26
|*UN4.3
*0
*29
*3
$*14
.*1
8*10
B*10
L*2000
V.R LINK
`*/DEB:C ACCPT2/G
j*BREAK OP25
t*HISTORY BEGIN TTY: 'ACCEPTANCE TEST OF HISTOGRAM'
~! I SHOULD HAVE VALUE OF 999
*DISPLAY I
*CLEAR
*WHERE
&*P
0.R LINK
:*ACCPT3.OVR/OV=ACCPT3/LINK:ROOT/SPACE:10000
D*ACCPT4/LINK/G
N.RU ACCPT3
X!NOTE - THIS HAS NOT WORKED FOR LO THESE MANY MONTHS ON TOPS
b!     - BECAUSE OF A LONG-STANDING LINK BUG WHICH DOES NOT R
l!     - INITIALIZE THE MODULE.   IF THE BUG SHOULD STILL EXI
v!     - THIS RUNNING, SUBSTITUTE A GET/SAVE/RUN SEQUENCE AFT
!     - THE ERROR MESSAGE IF YOU ENCOUNTER IT, WILL SAY:

!     - ?OVLOPP OVERLAY HANDLER IN PRIVATE PAGE
.K/F


.NOERROR
.RU LOGTYP
(*N
2*ACP1
<.RU SHORTL
F*N
P*ACPMAS
Z.R LIBARY
d*=ACP010
n*EXTRACT ACCEPTCK,ACPMAS.CHK
x.R FILCOM
*=ACPMAS.CHK,ACPMAS.SLG

.GOTO RESUME
*@MAILER
 *
**  ACP SUBSYSTEM
4*  IS DONE !!!
>*
H*
RRESUME::
\.K/F


.NOERROR
.DELE ACP???.BAK
(.DELE ACPMAS.*,ACPCHK.*,ACPDEL.CTL,ACP1.*
2.DELETE TSTDAT.RAN,TSTDAT.REP
<.DELETE TSTDAT.IDA,TSTDAT.IDX
F.DELETE TSTDAT.SEQ,WORK1X.XXX,WORK2
P.DELETE SHORTL.CBL,SHORTL.LST
Z.DELETE LOGTYP.CBL,LOGTYP.LST
d.DELETE NEWTST.CBL,NEWTST.LST
n.DELETE *.INP
x.DELETE ACCPT?.*
.K/F


;$JOB
.NOERROR
(DO10::
2.R LIBARY
<*=ACP010
F*EXTRACT ACP1CM,ACP1.CTL
P*EXTRACT ACPCHKCM,ACPCHK.CTL
Z*EXTRACT ACPDELCM,ACPDEL.CTL
d*EXTRACT LOGTYPCB,LOGTYP.CBL
n*EXTRACT NEWTSTCB,NEWTST.CBL
x*EXTRACT SHORTLCB,SHORTL.CBL
.GOTO RESUME::

DO20::
*=ACP020
 *EXTRACT ACP1CM,ACP1.CTL
**EXTRACT ACPCHKCM,ACPCHK.CTL
4*EXTRACT ACPDELCM,ACPDEL.CTL
>*EXTRACT LOGTY2CB,LOGTYP.CBL
H*EXTRACT NEWTSTCB,NEWTST.CBL
R*EXTRACT SETEOFMA,SETEOF.MAC
\*EXTRACT SHORT2CB,SHORTL.CBL
f*=SETEOF
pRESUME::
z.DELETE ACP1.LOG,ACPCHK.LOG
.SUB ACP1
.SUB ACPCHK
! BUG IN COMPILE STATEMENT, 1/4/77, <COBOL> SUBSTITUTED.
".R COBOL
,*=NEWTST/R
6.R CBL74
@*=SHORTL/R
J*=LOGTYP/R
T.R LINK
^*LOGTYP/G
h.SAVE LOGTYP
r.R LINK
|*NEWTST/G
.SAVE NEWTST
.R LINK
*SHORTL/G
$.SAVE SHORTL
..K/F

*26 DEC 75
ID DIVISION.
PROGRAM-ID. LOGTYP.
(*	READS AND TYPES .LOG FILES IN SHORT FORM.
2ENVIRONMENT DIVISION.
<INPUT-OUTPUT SECTION.
FFILE-CONTROL.
P	SELECT INFILE ASSIGN TO DSK.
ZDATA DIVISION.
dFILE SECTION.
nFD	INFILE VALUE OF ID IS INFILENAME.
x01	INREC DISPLAY-7.
	03  TABS	PIC XX.

	88  TABTAB VALUE "		".
	03  JOBFIELD.
 	88  JOBLINE	VALUE ";$JOB".
*	    05 FILLER	PIC X.
4	    88 TABTABQUESTION VALUE "?".
>	    05 FILLER	PIC XXXX.
H	03  FILLER	PIC XX.
R	03  INCODE	PIC X.
\	88  MONTR	VALUE "M" "T" "B" "F".
f	88 BATCH	VALUE "B" "T" "F".
p	88  USER	VALUE "U".
z	03  FILLER	PIC X(4).
	03  USERLINE.
	    05  CHR1	PIC X.
	    05  MONTRLINE.
"		07  CHRS2TO7.
,			88 KJOB VALUE "@@LOGO".
6		    09  CHR2	PIC X.
@		    09  FILLER	PIC X(5).
J		07  FILLER	PIC X(61).
TWORKING-STORAGE SECTION.
^1	STARTMARK	PIC S9(10) COMP.
h1	ENDMARK		PIC S9(10) COMP.
r1	MONTRMARK	PIC S9(10) COMP.
|1	QUESTIONMARK	PIC S9(10) COMP.
1	CURRENTLINE	PIC S9(10) COMP.
1	RESPONSE	PIC X.
	88 NOPE VALUE "N".
$	88 LEGALRESPONSE VALUE "N" "Y".
.1	INFILENAME.
8	3  FILENAME	PIC X(6).
B	3  FILLER	PIC XXX VALUE "LOG".
L1	PTR	PIC S9(5) COMP VALUE 1.
V1	FILENAMESTRING PIC X(72) DISPLAY-7.
`PROCEDURE DIVISION.
jP1.
t	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
~	ACCEPT RESPONSE.
	IF NOT LEGALRESPONSE
	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
	  GO TO P1.
&	DISPLAY "NAMES OF .LOG FILES: ".
0	ACCEPT FILENAMESTRING.
:	MOVE 1 TO PTR.
DP2.
N	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
X	  INTO FILENAME WITH POINTER PTR.
b	IF FILENAME = SPACE GO TO P1.
l	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
v	MOVE 10000 TO ENDMARK.
	IF NOPE GO TO P4.


*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.

(	OPEN INPUT INFILE.
2P3.
<	READ INFILE AT END GO TO P3C.
F	ADD 1 TO CURRENTLINE.
P	IF MONTR AND CHR2 = "@"
Z	  NEXT SENTENCE ELSE GO TO P3A.
d	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
n	  GO TO P3.
x*	  IGNORE THE @ST LINE IN ORDER TO GET THE PRECEDING LINES
*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.

	IF BATCH OR CHRS2TO7 = "@@ST" OR "@ST" OR "@" GO TO P3.
	MOVE CURRENTLINE TO MONTRMARK.
 	GO TO P3.
*P3A.
4	IF USER AND CHR1 = "?"
>	  GO TO P3B.
H	IF MONTR AND CHR2 = "?"
R	  GO TO P3B.
\	IF TABTABQUESTION GO TO P3B.
f	GO TO P3.
pP3B.
z	IF STARTMARK = 0
	  MOVE MONTRMARK TO STARTMARK.
	MOVE CURRENTLINE TO QUESTIONMARK.
	GO TO P3.
"P3C.
,	MOVE MONTRMARK TO ENDMARK.
6	MOVE 0 TO CURRENTLINE.
@	CLOSE INFILE.
J	IF STARTMARK = 0
T	  DISPLAY "NO ?'S FOUND IN " FILENAME
^	  GO TO P2.
hP4.
r	OPEN INPUT INFILE.
|	DISPLAY "**** " FILENAME.
P5.
	READ INFILE AT END GO TO P95.
	ADD 1 TO CURRENTLINE.
$	IF NOT JOBLINE GO TO P5.
.	IF CURRENTLINE < STARTMARK GO TO P10.
8	IF CURRENTLINE > ENDMARK GO TO P99.
B	MOVE "\\" TO TABS.
L	DISPLAY INREC.
VP10.
`	READ INFILE AT END GO TO P99.
j	ADD 1 TO CURRENTLINE
t	IF CURRENTLINE < STARTMARK GO TO P10.
~	IF CURRENTLINE > ENDMARK GO TO P99.
		IF KJOB GO TO P99.
		IF TABTAB
		  MOVE "\\" TO TABS
	&	  DISPLAY INREC
	0	  GO TO P10.
	:	IF MONTR AND CHRS2TO7 NOT = SPACE
	D	  DISPLAY MONTRLINE GO TO P10.
	N	IF USER AND USERLINE NOT = SPACE
	X	  DISPLAY USERLINE GO TO P10.
	b	GO TO P10.
	lP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
	vP99.	CLOSE INFILE GO TO P2.

 ID DIVISION.
PROGRAM-ID. LOGTYP.
ENVIRONMENT DIVISION.
(INPUT-OUTPUT SECTION.
2FILE-CONTROL.
<	SELECT INFILE ASSIGN TO DSK.
FDATA DIVISION.
PFILE SECTION.
ZFD	INFILE VALUE OF ID IS INFILENAME.
d01	INREC1 DISPLAY-7.
n	2 LINE1.
x	  3 DATE-USER	PIC X(14).
	  3 FIRST-CHAR	PIC X.

	  3 FILLER	PIC X(7).
	2 FILLER PIC X(61).
 01	INREC2 DISPLAY-7.
*	3 SLASHSLASH PIC XX.
4	3 FILLER PIC X(12).
>	3 OUTLINE PIC X(69).
H1	INREC3 DISPLAY-7.
R	2 FILLER PIC X(14).
\	2 USER-LINE.
f		3 FILLER PIC X.
p		3 TOPS-20-MONTR-LINE.
z		   4 FILLER PIC X.
		   4 TOPS-10-MONITR-LINE PIC X(67).

WORKING-STORAGE SECTION.
"1	STARTMARK	PIC S9(10) COMP.
,1	ENDMARK		PIC S9(10) COMP.
61	MONTRMARK	PIC S9(10) COMP.
@1	QUESTIONMARK	PIC S9(10) COMP.
J1	CURRENTLINE	PIC S9(10) COMP.
T1	RESPONSE	PIC X.
^	88 NOPE VALUE "N".
h	88 LEGALRESPONSE VALUE "N" "Y".
r1	INFILENAME.
|	3  FILENAME	PIC X(6).
	3  FILLER	PIC XXX VALUE "LOG".
1	PTR	PIC S9(5) COMP VALUE 1.
1	FILENAMESTRING PIC X(72) DISPLAY-7.
$1	TALLY1 PIC 9(10) COMP.
.1	TALLY2 PIC 9(10) COMP.
81	LOGIN-LINE1.
B	2 INDEXED-LINE PIC X OCCURS 22 TIMES.
L1	POINTER1	PIC 99.
V1	TOPS-TYPE PIC X VALUE " ".
`	88 FOUND-TOPS-TYPE VALUE "@" ".".
j	88 TOPS-20 VALUE "@".
t	88 TOPS-10 VALUE ".".
~1	MONLINE PIC X(7) USAGE IS DISPLAY-7.
PROCEDURE DIVISION.
P1.
	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
&	ACCEPT RESPONSE.
0	IF NOT LEGALRESPONSE
:	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
D	  GO TO P1.
N	DISPLAY "NAMES OF .LOG FILES: ".
X	ACCEPT FILENAMESTRING.
b	MOVE 1 TO PTR.
lP2.
v	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
	  INTO FILENAME WITH POINTER PTR.

	IF FILENAME = SPACE GO TO P1.
	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
	MOVE " " TO TOPS-TYPE.
(	MOVE 10000 TO ENDMARK.
2	IF NOPE GO TO P4.
<	MOVE "NOVALUE" TO MONLINE.
F
P*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
Z
d	OPEN INPUT INFILE.
nP3.
x	READ INFILE AT END GO TO P3C.
	IF NOT FOUND-TOPS-TYPE

		PERFORM FIND-TYPE.
	ADD 1 TO CURRENTLINE.
 	SET TALLY1 TO 0.
*	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE.
4	IF TALLY1 NOT = 1 GO TO P3A.
>	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
H	  GO TO P3.
R*	  IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
\*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
f	SET TALLY1 TO 0.
p	INSPECT LINE1 TALLYING TALLY1 FOR ALL "..ST",
z		TALLY1 FOR ALL ".ST",
		TALLY1 FOR ALL "@ST",
		TALLY1 FOR ALL "@@ST".
	IF TALLY1 = 1 GO TO P3.
"	MOVE CURRENTLINE TO MONTRMARK.
,	GO TO P3.
6P3A.
@	IF FIRST-CHAR = "?"
J		PERFORM P3B.
T	GO TO P3.
^P3B.
h	IF STARTMARK = 0
r	  MOVE MONTRMARK TO STARTMARK.
|	MOVE CURRENTLINE TO QUESTIONMARK.

P3C.
	MOVE MONTRMARK TO ENDMARK.
$	MOVE 0 TO CURRENTLINE.
.	CLOSE INFILE.
8	IF STARTMARK = 0
B	  DISPLAY "NO ?'S FOUND IN " FILENAME
L	  GO TO P2.
VP4.
`	OPEN INPUT INFILE.
j	DISPLAY "**** " FILENAME.
t	PERFORM FIND-MONLINE.
~P5.
		READ INFILE AT END GO TO P95.
		ADD 1 TO CURRENTLINE.
		SET TALLY1 TO 0.
	&	INSPECT LINE1 TALLYING TALLY1 FOR ALL ";$JOB".
	0	IF TALLY1 NOT = 1 GO TO P5.
	:	IF CURRENTLINE > ENDMARK GO TO P99.
	DP10.
	N	READ INFILE AT END GO TO P99.
	X	ADD 1 TO CURRENTLINE
	b	IF CURRENTLINE < STARTMARK GO TO P10.
	l	IF CURRENTLINE > ENDMARK GO TO P99.
	v	SET TALLY1 TO 0.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL "KJOB",


		TALLY1 FOR  ALL "LOGO".

	IF TALLY1 = 1 GO TO P99.

	SET TALLY1 TO 0.

(	INSPECT LINE1 TALLYING TALLY1 FOR ALL "		".

2	IF TALLY1 = 1

<		MOVE "\\" TO SLASHSLASH

F		DISPLAY  INREC2

P		GO TO P10.

Z	SET TALLY1 TO 0.

d	SET TALLY2 TO 0.

n	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE,

x		TALLY2 FOR ALL " USER	".
	IF TALLY1 = 1 

		IF TOPS-10
		    DISPLAY TOPS-10-MONITR-LINE
 		ELSE IF TOPS-20
*		    DISPLAY TOPS-20-MONTR-LINE.
4	IF TALLY2 = 1 AND USER-LINE NOT = SPACE
>		DISPLAY USER-LINE.
H	GO TO P10.
RP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
\P99.	CLOSE INFILE.
f	GO TO P2.
pFIND-TYPE.
z	MOVE 0 TO TALLY1.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL "LOGIN".

	MOVE 1 TO POINTER1.

	IF TALLY1 =1

"		UNSTRING LINE1 DELIMITED BY "LOGIN"

,			 INTO LOGIN-LINE1 WITH POINTER POINTER1

6		MOVE INDEXED-LINE (POINTER1 - 6) TO TOPS-TYPE

@		IF TOPS-20 

J			MOVE " MONTR	" TO MONLINE

T		ELSE IF TOPS-10

^			MOVE "MONITR	" TO MONLINE

h			ELSE 

r		DISPLAY"? SHORTL ERROR COULD NOT FIND TOPS TYPE".

|FIND-MONLINE.
AD INFILE AT END
DISPLAY "? COULDN'T FIND LOGIN LINE"
TOP RUN.
1 TO CURRENTLINE.
FORM FIND-TYPE.
F NOT FOUND-TOPS-TYPE GO TO FIND-MONLINE.


$JOB
.NOERROR
(.RU LIBARY
2*ACCCOM.DCY/D=ACCCOM
<*ACPCOM.DCY/D=ACPCOM
F*ADDCOM.DCY/D=ADDCOM
P*COMCOM.DCY/D=COMCOM
Z*DATCOM.DCY/D=DATCOM
d*DBMCOM.DCY/D=DBMCOM
n*DDTCOM.DCY/D=DDTCOM
x*DIVCOM.DCY/D=DIVCOM
*FILCOM.DCY/D=FILCOM

*GOTCOM.DCY/D=GOTCOM
*IFTCOM.DCY/D=IFTCOM
 *IPCCOM.DCY/D=IPCCOM
**LIBCOM.DCY/D=LIBCOM
4*MOVCOM.DCY/D=MOVCOM
>*MULCOM.DCY/D=MULCOM
H*REPCOM.DCY/D=REPCOM
R*SASCOM.DCY/D=SASCOM
\*SLRCOM.DCY/D=SLRCOM
f*SMUCOM.DCY/D=SMUCOM
p*SRTCOM.DCY/D=SRTCOM
z*STRCOM.DCY/D=STRCOM
*SUBCOM.DCY/D=SUBCOM
*TBLCOM.DCY/D=TBLCOM
*UNSCOM.DCY/D=UNSCOM
"*UTLCOM.DCY/D=UTILTY
,*DTMCOM.DCY/D=DATMOD
6*=ACP010
@*EXTRACT SETUPCB,SETUP.CBL
J.RU COBOL
T*=SETUP
^.LOAD SETUP
h.SAVE SETUP
r.DELE CONVRT.CTL
|.RU SETUP
*10
*I
*CONVRT
$*ACC
.*ACP
8*ADD
B*COM
L*DAT
V*DBM
`*DDT
j*DIV
t*FIL
~*GOT
*IFT
*IPC
*LIB
&*MOV
0*MUL
:*REP
D*SAS
N*SLR
X*SMU
b*SRT
l*STR
v*SUB
*TBL

*UNS
*QIT
.SUB CONVRT/TIME:10:00
(.KJOB


$JOB
*ACCCOM.DCY/D=ACCCOM
(*ACPCOM.DCY/D=ACPCOM
2*ADDCOM.DCY/D=ADDCOM
<*COMCOM.DCY/D=COMCOM
F*DATCOM.DCY/D=DATCOM
P*DBMCOM.DCY/D=DBMCOM
Z*DDTCOM.DCY/D=DDTCOM
d*DIVCOM.DCY/D=DIVCOM
n*FILCOM.DCY/D=FILCOM
x*GOTCOM.DCY/D=GOTCOM
*IFTCOM.DCY/D=IFTCOM

*IPCCOM.DCY/D=IPCCOM
*LIBCOM.DCY/D=LIBCOM
 *MOVCOM.DCY/D=MOVCOM
**MULCOM.DCY/D=MULCOM
4*REPCOM.DCY/D=REPCOM
>*SASCOM.DCY/D=SASCOM
H*SLRCOM.DCY/D=SLRCOM
R*SMUCOM.DCY/D=SMUCOM
\*SRTCOM.DCY/D=SRTCOM
f*STRCOM.DCY/D=STRCOM
p*SUBCOM.DCY/D=SUBCOM
z*TBLCOM.DCY/D=TBLCOM
*UNSCOM.DCY/D=UNSCOM
*UTLCOM.DCY/D=UTILTY
*DTMCOM.DCY/D=DATMOD
"*=ACP010
,*EXTRACT SETUPCB,SETUP.CBL
6*=SETUP
@*20
J*I
T*CONVRT
^*ACC
h*ACP
r*ADD
|*COM
*DAT
*DBM
*DDT
$*DIV
.*FIL
8*GOT
B*IFT
L*IPC
V*LIB
`*MOV
j*MUL
t*REP
~*SAS
*SLR
*SMU
*SRT
&*STR
0*SUB
:*TBL
D*UNS
N*QIT

* 27 JULY 75
ID DIVISION.
PROGRAM-ID. NEWTST.
(*	NEWTST IS A TEST UTILITY PROGRAM THAT IS USED TO GENERATE
2*	TEST PROGRAMS FROM TEST MODULES.  SEE THE FULL DESCRIPTION
<*	OF NEWTST IN THE DECSYSTEM-10 COBOL TEST SYSTEM DESCRIPTION.
F*+ NOTE THAT AL CHANGES DUE TO THE REMOVAL OF THE ":" FUNCTION
P*  HAVE BEEN PRECEDED AND FOLLOWED BY COMMENTS.  THE COMMENT LINES
Z*- BEGIN WITH A "+" AND END WITH A "-".
dENVIRONMENT DIVISION.
nINPUT-OUTPUT SECTION.
xFILE-CONTROL.
	SELECT INFILE ASSIGN TO DSK.

	SELECT OUTFILE ASSIGN TO DSK.
DATA DIVISION.
 FILE SECTION.
*FD	INFILE VALUE OF ID IS INFILENAME.
41	INLINE	PIC X(64) DISPLAY-7.
>
HFD	OUTFILE VALUE OF ID IS OUTFILENAME.
R1	OUTLINE	PIC X(64) DISPLAY-7.
\
fWORKING-STORAGE SECTION.
p1	ITERATION	PIC S9999 COMP.
z1	EDITED-ITERATION PIC XXXXX.
1	STEP		PIC S9999 COMP.
1	EDITED-STEP	PIC XXXXX.
1	RIGHT-EDIT	PIC ZZZZZ.
"1	RIGHT-EDITX REDEFINES RIGHT-EDIT PIC XXXXX.
,1	JUNK		PIC X.
61	SINGLE-CHAR	PIC X.
@1	TABCOMP		PIC S9999 COMP VALUE 18.
J1	TABR REDEFINES TABCOMP DISPLAY-7.
T	3 FILLER	PIC XXXX.
^	3 TAB		PIC X.
h1	REPLACESWITCH	PIC X.
r1	LINECOUNT	PIC S9999 COMP.
|1	LIST-NUMBER	PIC S9999 COMP.
1	LIST-ENTRY	PIC S9999 COMP.
1	L		PIC S9999 COMP.
1	K		PIC S9999.
$1	I		PIC S9999 COMP.
.1	SKLN		PIC S9999 COMP.
81	DIGIT		PIC 9.
B1	DIGIT2		PIC 9.
L1	N		PIC S9999 COMP.
V1	M		PIC S9999 COMP.
`1	T		PIC S9999 COMP.
j1	P		PIC S9999 COMP.
t1	PTR		PIC S9999 COMP.
~1	DEL	PIC X.
1	LNAME		PIC X(31).
1	TLINE		PIC X(64) DISPLAY-7.
1	INFILENAME DISPLAY-7.
&	3 IFNAME	PIC XXXXXX.
0	3 IFEXT		PIC XXX.
:1	OUTFILENAME DISPLAY-7.
D	3 OFNAME	PIC XXXXXX.
N	3 OFEXT 	PIC XXX VALUE "CBL".
X1	LIST-CONTROL-TABLE.
b	3 LT  OCCURS 9.
l	  5 LIST-START PIC S9999 COMP.
v	  5 LIST-LENGTH PIC S9999 COMP.
	  5 LIST-COUNT PIC S9999 COMP.

	  5 LIST-TYPE PIC X.
1	TABLES DISPLAY-7.
	3 TNAME	PIC X(31) OCCURS 125 TIMES.
(	3 SKL		PIC X(64) OCCURS 20 TIMES.
21	CHARS1 DISPLAY-7.
<	3  CHAR11	PIC X.
F	3  FILLER	PIC X(63).
P1	CHARS2 DISPLAY-7.
Z	3 CHAR21	PIC X.
d	3 FILLER	PIC X(63).
n1	SENDING-FIELDS DISPLAY-7.
x	3 SENDING-ITEM OCCURS 20.
	  5 SENDING-ITEM5CHARS PIC XXXXX.

	  5 FILLER PIC X(59).
1	D		PIC X DISPLAY-7.
 1	CHARX	PIC X DISPLAY-7.
*1	TEMPNAME	PIC X(31) DISPLAY-7.
41	PROGLINE DISPLAY-7 VALUE "PROGRAM-ID. XXXXXX.".
>	3 FILLER	PIC X(12).
H	3 PROGID	PIC X(6).
R	3 FILLER	PIC X.
\1	IDLINE DISPLAY-7 PIC X(12) VALUE "ID DIVISION.".
f1	DATLINE DISPLAY-7 PIC X(14) VALUE "DATA DIVISION.".
p1	WSLINE DISPLAY-7 PIC X(24) VALUE "WORKING-STORAGE SECTION.".
z1	PDLINE DISPLAY-7 PIC X(19) VALUE "PROCEDURE DIVISION.".
1	P0LINE DISPLAY-7 PIC X(3) VALUE "P0.".
1	ENDLINE DISPLAY-7 PIC X(28) VALUE "    DISPLAY 'END' STOP RUN.".
1	HLINE DISPLAY-7 VALUE "****XXXXXX.XXX****".
"	3 FILLER	PIC XXXX.
,	3 HLINENAME	PIC X(6).
6	3 FILLER	PIC X.
@	3 HLINEEXT	PIC XXX.
J	3 FILLER	PIC XXXX.
T1	STARLINE DISPLAY-7 VALUE "*".
^	3 FILLER	PIC X.
h	3 STARLINETEXT	PIC X(63).
r
|PROCEDURE DIVISION.
ND1 SECTION.
P0.
	MOVE ZERO TO REPLACESWITCH ITERATION STEP SKLN.
$	MOVE 1 TO LIST-ENTRY LIST-NUMBER.
.	DISPLAY "OUTPUT FILENAME? (6 CHARS) " WITH NO ADVANCING.
8	ACCEPT OFNAME.
B	IF OFNAME = SPACES STOP RUN.
L*+ NEXT LINE SKIPPED TO AVOID THE ":" FUNCTION.
V*	MOVE "TMP" TO OFEXT.
`*- END OF CHANGE.
j	OPEN OUTPUT OUTFILE.
t	MOVE 4 TO LINECOUNT.
~	WRITE OUTLINE FROM IDLINE.
		MOVE OFNAME TO PROGID.
		WRITE OUTLINE FROM PROGLINE.
		DISPLAY "COMMENTS:".
	&P5.
	0	ACCEPT OUTLINE.
	:	IF OUTLINE NOT = SPACES
	D	  WRITE OUTLINE
	N	  ADD 1 TO LINECOUNT
	X	  GO TO P5.
	b	WRITE OUTLINE FROM DATLINE.
	l	WRITE OUTLINE FROM WSLINE.
	vBL3.

	DISPLAY "INPUT FILENAME? (9 CHARS) " WITH NO ADVANCING.


	ACCEPT INFILENAME.

	OPEN INPUT INFILE.

	MOVE LIST-ENTRY TO LIST-START(LIST-NUMBER).

(	MOVE IFNAME TO HLINENAME.

2	MOVE IFEXT TO HLINEEXT.

<	IF IFEXT = "PM " GO TO BL20.

F	WRITE OUTLINE FROM HLINE.

P	ADD 1 TO LINECOUNT.

Z

dBL4.

n	READ INFILE AT END GO TO BL9.

x	MOVE INLINE TO SINGLE-CHAR.
BL5.

	EXAMINE INLINE TALLYING UNTIL FIRST "[".
	IF TALLY > 63
 	  WRITE OUTLINE FROM INLINE
*	  ADD 1 TO LINECOUNT
4	  GO TO BL4.
>	MOVE 0 TO K.
H	ADD 2 TALLY GIVING PTR.
R	UNSTRING INLINE DELIMITED BY "]"
\	  INTO LNAME COUNT IN K WITH POINTER PTR.
f	IF K > 30 MOVE 30 TO K
p	  DISPLAY "ITEM TRUNCATION = " LNAME.
z	ADD 1 TO K.

	STRING "\" DELIMITED BY SIZE INTO LNAME WITH POINTER K.

	EXAMINE INLINE REPLACING FIRST "[" BY SPACE

	EXAMINE INLINE REPLACING FIRST "]" BY SPACE.

"	IF LIST-ENTRY > 125

,	  DISPLAY "? TOO MANY BRACKETED ITEMS" LNAME

6	  STOP RUN.

@	MOVE LNAME TO TNAME(LIST-ENTRY).

J	ADD 1 TO LIST-ENTRY.

T	GO TO BL5.

^BL9.

h	CLOSE INFILE.

r	SUBTRACT LIST-START(LIST-NUMBER) FROM

|	  LIST-ENTRY GIVING LIST-LENGTH(LIST-NUMBER).
 1 TO LIST-COUNT(LIST-NUMBER).
ST-NUMBER = 9
 DISPLAY "? TOO MANY LISTS" STOP RUN.
DD 1 TO LIST-NUMBER.
TO BL3.

 OUTLINE FROM PDLINE.
TE OUTLINE FROM P0LINE.
TE OUTLINE FROM HLINE.
3 TO LINECOUNT.

INFILE AT END GO TO BL29.
 1 TO PTR.
BL22.
	UNSTRING INLINE DELIMITED BY "%" OR "!"
	  INTO  CHARS1 DELIMITER IN D
&	  WITH POINTER PTR.
0	IF PTR > 62 GO TO BL26.
:	UNSTRING INLINE INTO CHARX WITH POINTER PTR.
D	MOVE CHARX TO P.
N	IF P NOT < LIST-NUMBER
X	  DISPLAY "? BAD LIST DIGIT"
b	  DISPLAY INLINE STOP RUN.
l	IF D = "%"
v	  MOVE "I" TO LIST-TYPE(P) GO TO BL22.
	IF D = "!"

	  MOVE "D" TO LIST-TYPE(P) GO TO BL22.
	DISPLAY "?BL25" STOP RUN.
BL26.
(*+ THIS CODE IS TO BE SKIPPED TO AVOID ":" FUNCTION.
2*	EXAMINE INLINE TALLYING ALL ":".
<*	IF TALLY NOT = 0 MOVE "1" TO REPLACESWITCH.
F*- END OF CHANGE.
P	ADD 1 TO SKLN.
Z	IF SKLN > 20
d	  DISPLAY "TOO MANY LINES IN SKELETON"
n	  STOP RUN.
x	MOVE INLINE TO SKL(SKLN).
	MOVE INLINE TO STARLINETEXT.

	WRITE OUTLINE FROM STARLINE.
	ADD 1 TO LINECOUNT.
 	GO TO BL21.
*BL29.
4	CLOSE INFILE.
>	IF SKLN = 0
H	  DISPLAY "SKELETON EMPTY" STOP RUN.
R	IF LIST-NUMBER < 2
\	  DISPLAY "? NO LISTS" STOP RUN.
f	MOVE 0 TO N.
pVP0.
z	ADD 1 TO N.
	IF N = LIST-NUMBER GO TO XEXIT.
	IF LIST-TYPE(N) NOT = "I" GO TO VP0.
	GO TO VP2.
"VP1.
,	ADD 1 TO N.
6	IF N = LIST-NUMBER GO TO XEXIT.
@	IF LIST-TYPE(N) NOT = "I" GO TO VP1.
J	ADD 1 TO LIST-COUNT(N).
TVP2.
^	IF LIST-COUNT(N) > LIST-LENGTH(N)
h	  MOVE 1 TO LIST-COUNT(N) GO TO VP1.
r	MOVE 0 TO N.
|	PERFORM ITERATE.
X2.
	ADD 1 TO N.
	IF N NOT > SKLN GO TO X4.
$	MOVE 0 TO N.
.X3.
8	ADD 1 TO N.
B	IF LIST-TYPE(N) NOT = "I" GO TO X3.
L	ADD 1 TO LIST-COUNT(N).
V	GO TO VP2.
`X4.
j	MOVE SKL(N) TO TLINE.
t	PERFORM SENDING-ITEM-SET-UP VARYING I FROM 1 BY 1 UNTIL I > 20.
~	MOVE 0 TO I.
	MOVE 1 TO P.
X5.
	ADD 1 TO I.
&	UNSTRING TLINE DELIMITED BY "%" OR "!" OR "@" OR "#"
0 	  INTO SENDING-ITEM (I)
:	  DELIMITER IN DEL COUNT IN K WITH POINTER P.
D	IF P = 65 GO TO X25.
N	ADD 1 TO K.
X	STRING "\" DELIMITED BY SIZE
b	  INTO SENDING-ITEM (I) WITH POINTER K.
l	ADD 1 TO I.
v	IF DEL = "#" GO TO X20.
	IF DEL = "@" GO TO X15.

	IF DEL = "!" GO TO X10.
	IF DEL = "%" GO TO X8.
	DISPLAY "?X5" STOP RUN.
(X8.
2	UNSTRING TLINE INTO DIGIT WITH POINTER P.
<	MOVE LIST-COUNT(DIGIT) TO LIST-ENTRY.
F	SUBTRACT 1 FROM LIST-ENTRY.
P	ADD LIST-START(DIGIT) TO LIST-ENTRY.
Z	MOVE TNAME (LIST-ENTRY) TO SENDING-ITEM (I).
d	GO TO X5.
nX10.
x	UNSTRING TLINE INTO DIGIT DIGIT2
	  WITH  POINTER P.

	MOVE LIST-COUNT(DIGIT2) TO LIST-ENTRY.
	SUBTRACT 1 FROM LIST-ENTRY.
 	ADD LIST-START(DIGIT) TO LIST-ENTRY.
*	MOVE TNAME(LIST-ENTRY) TO SENDING-ITEM (I).
4	GO TO X5.
>X15.
H	MOVE EDITED-ITERATION TO SENDING-ITEM5CHARS (I).
R	GO TO X5.
\X20.
f	PERFORM STEPUP.
p	MOVE EDITED-STEP TO SENDING-ITEM5CHARS (I).
z	GO TO X5.
X25.
	STRING
	 SENDING-ITEM (1)
"	 SENDING-ITEM (2)
,	 SENDING-ITEM (3)
6	 SENDING-ITEM (4)
@	 SENDING-ITEM (5)
J	 SENDING-ITEM (6)
T	 SENDING-ITEM (7)
^	 SENDING-ITEM (8)
h	 SENDING-ITEM (9)
r	 SENDING-ITEM (10)
|	 SENDING-ITEM (11)
	 SENDING-ITEM (12)
	 SENDING-ITEM (13)
	 SENDING-ITEM (14)
$	 SENDING-ITEM (15)
.	 SENDING-ITEM (16)
8	 SENDING-ITEM (17)
B	 SENDING-ITEM (18)
L	 SENDING-ITEM (19)
V	 SENDING-ITEM (20)
`	  DELIMITED BY "\" INTO TLINE.
j	WRITE OUTLINE FROM TLINE.
t	ADD 1 TO LINECOUNT.
~	GO TO X2.
XEXIT.
	WRITE OUTLINE FROM ENDLINE.
	ADD 1 TO LINECOUNT.
&	CLOSE OUTFILE.
0	DISPLAY LINECOUNT " LINES GENERATED.".
:*+ THE FOLLOWING GO TO AND PARAGRAPH NAME ARE ADDED TO AVOID 
D*  THE ":" FUNCTION.
N	GO TO P0.
XRS0.
b*- END OF CHANGE.
l	MOVE OUTFILENAME TO INFILENAME.
v	MOVE "CBL" TO OFEXT.
	OPEN INPUT INFILE.

	OPEN OUTPUT OUTFILE.
RS1.
	READ INFILE INTO OUTLINE AT END GO TO X9.
(	MOVE 1 TO P.
2	IF REPLACESWITCH NOT = "1" GO TO TABOUT.
<	UNSTRING OUTLINE DELIMITED BY ":"
F	  INTO CHARS1 WITH POINTER P.
P	IF CHAR11 = "*" GO TO TABOUT.
Z	IF P = 65 GO TO TABOUT.
d	SUBTRACT 1 FROM P GIVING N.
n	STRING "\" DELIMITED BY SIZE
x	  INTO CHARS1 WITH POINTER N.
	UNSTRING OUTLINE INTO CHARS2 WITH POINTER P.

	DISPLAY OUTLINE.
	ACCEPT TEMPNAME.
 	STRING CHARS1 DELIMITED BY "\"
*	  TEMPNAME DELIMITED BY SPACE
4	  CHARS2 DELIMITED BY SIZE INTO OUTLINE.
>TABOUT.
H* IT SEEMS THAT THERE IS NO REAL NEED TO REMOVE TABS,
R* SO THE FOLLOWING STATEMENT SKIPS THE TABOUT CODE.
\	GO TO TB3.
fTB0.
p	MOVE SPACES TO TEMPNAME.
z	MOVE 1 TO P.
	UNSTRING OUTLINE DELIMITED BY TAB
	  INTO CHARS1 WITH POINTER P.
	IF P > 64 GO TO TB3.
"	SUBTRACT 1 FROM P GIVING N.
,	STRING "\" DELIMITED BY SIZE
6	  INTO CHARS1 WITH POINTER N.
@	MOVE P TO N.
J	UNSTRING OUTLINE INTO CHARS2 WITH POINTER N.
T	IF P < 5 SUBTRACT P FROM 7 GIVING P GO TO TB1.
^	IF P < 13 SUBTRACT P FROM 15 GIVING P GO TO TB1.
h	IF P < 21 SUBTRACT P FROM 23 GIVING P GO TO TB1.
r	IF P < 29 SUBTRACT P FROM 31 GIVING P GO TO TB1.
|	IF P < 37 SUBTRACT P FROM 39 GIVING P GO TO TB1.
	IF P < 45 SUBTRACT P FROM 47 GIVING P GO TO TB1.
	IF P < 53 SUBTRACT P FROM 55 GIVING P GO TO TB1.
	IF P < 61 SUBTRACT P FROM 63 GIVING P GO TO TB1.
$	IF P < 65 SUBTRACT P FROM 67 GIVING P GO TO TB1.
.TB1.
8	STRING "\" DELIMITED BY SIZE
B	  INTO TEMPNAME WITH POINTER P.
L	STRING CHARS1 TEMPNAME DELIMITED BY "\"
V	  CHARS2 DELIMITED BY SIZE INTO OUTLINE.
`	GO TO TABOUT.
jTB3.
t	WRITE OUTLINE.
~	GO TO RS1.
X9.
	CLOSE INFILE WITH DELETE.
	CLOSE OUTFILE.
&	GO TO P0.
0ITERATE.
:	ADD 1 TO ITERATION.
D	MOVE ITERATION TO RIGHT-EDIT.
N	UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
X	  INTO JUNK EDITED-ITERATION.
b	EXAMINE EDITED-ITERATION REPLACING ALL SPACE BY "\".
lSTEPUP.
v	ADD 1 TO STEP.
	MOVE STEP TO RIGHT-EDIT.

	UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
	  INTO JUNK EDITED-STEP.
	EXAMINE EDITED-STEP REPLACING ALL SPACE BY "\".
(SENDING-ITEM-SET-UP.
2	MOVE "\    " TO SENDING-ITEM5CHARS (I).

	TITLE SETEOF

	SEARCH MACSYM,MONSYM
(	.REQUIRE SYS:MACREL
2	SALL
<
F	SUBTTL LARRY CAMPBELL
P
Z;AC DEFINITIONS
dT1=1
nT2=2
xT3=3
T4=4

P1=5
P2=6
 P3=7
*P4=10
4P=17
>
H
R;PARAMETERS
\PDLLEN==50
f
p;IMPURE STORAGE
zPDL:	BLOCK PDLLEN


;START HERE
"
,SETEOF:	RESET
6	MOVE P,[IOWD PDLLEN,PDL]
@	TMSG <"0" TO SET AT END OF LAST PAGE
JSize to set file(s) to: >
T	MOVX T1,.PRIIN
^	MOVEI T3,^D10
h	NIN
r	 ERMSG
|	MOVEM T2,FILSIZ#
	MOVEM T2,FSFLAG#
	TMSG <File(s) to set: >
	MOVX T1,GJ%OLD!GJ%FNS!GJ%SHT!GJ%CFM!GJ%IFG
$	SETO T2,
.	GTJFN
8	 ERMSG
B	MOVEM T1,JFN#
L
VFILOOP:	SKIPE	FSFLAG
`	JRST	FILOO1
j	HRRZ	1,JFN
t	MOVE	2,[1,,11]	;GET .FBBYV FROM FDB
~	MOVEI	3,FBBYV#	;SAVE IT HERE
	GTFDB			;GET IT
	HRRZ	T1,FBBYV	;GET SIZE IN PAGES
	IMULI	T1,1000		;CNVRT TO WORDS
&	MOVEM	T1,FILSIZ	;RESTORE TO THIS SIZE
0FILOO1:	MOVE T1,JFN
:	HRLI T1,12
D	SETO T2,
N	MOVE T3,FILSIZ
X	CHFDB
b	 ERMSG
l	MOVE T1,JFN
v	GNJFN
	 JRST DONE

	JRST FILOOP

DONE:	TMSG <
(All done!
2>
<	HALTF
F	JRST SETEOF
P
Z
d
n	END SETEOF

* 26 JAN 77
ID DIVISION.
PROGRAM-ID. SETUP.
(* A PROGRAM TO CONVERT THE EXISTING .CTL FILES STORED ON .LIB FILES
2* IN THE COBOL TEST SYSTEM TO "COMMON CONTROL FILE" FORMAT.
<*  TO 10 OR 20 FORMAT, AS REQUESTED BY USER.
F*
P
Z
dENVIRONMENT DIVISION.
nI-O SECTION.
xFILE-CONTROL.
	SELECT INFILE

	  ASSIGN TO DSK RECORDING MODE ASCII.
	SELECT OUTFILE
 	  ASSIGN TO DSK RECORDING MODE ASCII.
*	SELECT CTLFILE
4	  ASSIGN TO DSK RECORDING MODE ASCII.
>	SELECT DCYFILE
H	  ASSIGN TO DSK RECORDING MODE ASCII.
RDATA DIVISION.
\FILE SECTION.
fFD	INFILE
p	VALUE OF ID INFILENAME.
z1	INREC DISPLAY-7.
  02  FIRSTNINE.
    88 DEFDSK VALUE  "@DEF SYS:".
    88 RSETSRC VALUE ".R SETSRC".
"	3 FIRSTFOURCHARS.
,	  88 STAR-SYS  VALUE  "*SYS".
6
@	  88 20-LOGOUT VALUE  "@LOG".
J	      9 FIRSTCHAR	PIC X.
T		88 FOR-BOTH   VALUE "B".
^		88 FOR-10     VALUE ".".
h		88 FOR-20     VALUE "@".
r	      9  COMMAND-CHARS PIC X(3).
|			88 DELETE-CMD VALUE 'DEL'.

	3 LASTFIVE PIC X(5).
  02  OTHERNINE REDEFINES FIRSTNINE.
$	3 FIRSTWOCHARS PIC X(2).
.	88 LIBID-LINE VALUE '*='.
8	3 LASTSEVEN PIC X(7).
B  02  RESTCHARS PIC X(55).
L
V
`FD	OUTFILE
j	VALUE OF ID OUTFILENAME.
t1	OUTREC DISPLAY-7.
~	3 OUTCHAR	PIC X.
	3 OUTSKIP	PIC X(63).
1	OUTREC01 PIC X(01) DISPLAY-7.
1	OUTREC02 PIC X(02) DISPLAY-7.
&1	OUTREC03 PIC X(03) DISPLAY-7.
01	OUTREC04 PIC X(04) DISPLAY-7.
:1	OUTREC05 PIC X(05) DISPLAY-7.
D1	OUTREC06 PIC X(06) DISPLAY-7.
N1	OUTREC07 PIC X(07) DISPLAY-7.
X1	OUTREC08 PIC X(08) DISPLAY-7.
b1	OUTREC09 PIC X(09) DISPLAY-7.
l1	OUTREC10 PIC X(10) DISPLAY-7.
v1	OUTREC11 PIC X(11) DISPLAY-7.
1	OUTREC12 PIC X(12) DISPLAY-7.

1	OUTREC13 PIC X(13) DISPLAY-7.
1	OUTREC14 PIC X(14) DISPLAY-7.
1	OUTREC15 PIC X(15) DISPLAY-7.
(1	OUTREC16 PIC X(16) DISPLAY-7.
21	OUTREC17 PIC X(17) DISPLAY-7.
<1	OUTREC18 PIC X(18) DISPLAY-7.
F1	OUTREC19 PIC X(19) DISPLAY-7.
P1	OUTREC20 PIC X(20) DISPLAY-7.
Z1	OUTREC21 PIC X(21) DISPLAY-7.
d1	OUTREC22 PIC X(22) DISPLAY-7.
n1	OUTREC23 PIC X(23) DISPLAY-7.
x1	OUTREC24 PIC X(24) DISPLAY-7.
1	OUTREC25 PIC X(25) DISPLAY-7.

1	OUTREC26 PIC X(26) DISPLAY-7.
1	OUTREC27 PIC X(27) DISPLAY-7.
 1	OUTREC28 PIC X(28) DISPLAY-7.
*1	OUTREC29 PIC X(29) DISPLAY-7.
41	OUTREC30 PIC X(30) DISPLAY-7.
>1	OUTREC31 PIC X(31) DISPLAY-7.
H1	OUTREC32 PIC X(32) DISPLAY-7.
R1	OUTREC33 PIC X(33) DISPLAY-7.
\1	OUTREC34 PIC X(34) DISPLAY-7.
f1	OUTREC35 PIC X(35) DISPLAY-7.
p1	OUTREC36 PIC X(36) DISPLAY-7.
z1	OUTREC37 PIC X(37) DISPLAY-7.
1	OUTREC38 PIC X(38) DISPLAY-7.
1	OUTREC39 PIC X(39) DISPLAY-7.
1	OUTREC40 PIC X(40) DISPLAY-7.
"1	OUTREC41 PIC X(41) DISPLAY-7.
,1	OUTREC42 PIC X(42) DISPLAY-7.
61	OUTREC43 PIC X(43) DISPLAY-7.
@1	OUTREC44 PIC X(44) DISPLAY-7.
J1	OUTREC45 PIC X(45) DISPLAY-7.
T1	OUTREC46 PIC X(46) DISPLAY-7.
^1	OUTREC47 PIC X(47) DISPLAY-7.
h1	OUTREC48 PIC X(48) DISPLAY-7.
r1	OUTREC49 PIC X(49) DISPLAY-7.
|1	OUTREC50 PIC X(50) DISPLAY-7.
1	OUTREC51 PIC X(51) DISPLAY-7.
1	OUTREC52 PIC X(52) DISPLAY-7.
1	OUTREC53 PIC X(53) DISPLAY-7.
$1	OUTREC54 PIC X(54) DISPLAY-7.
.1	OUTREC55 PIC X(55) DISPLAY-7.
81	OUTREC56 PIC X(56) DISPLAY-7.
B1	OUTREC57 PIC X(57) DISPLAY-7.
L1	OUTREC58 PIC X(58) DISPLAY-7.
V1	OUTREC59 PIC X(59) DISPLAY-7.
`1	OUTREC60 PIC X(60) DISPLAY-7.
j1	OUTREC61 PIC X(61) DISPLAY-7.
t1	OUTREC62 PIC X(62) DISPLAY-7.
~1	OUTREC63 PIC X(63) DISPLAY-7.
	1	OUTREC64 PIC X(64) DISPLAY-7.
	1	OUTRECTEST DISPLAY-7.
		3 TESTFOUR.
	&	   5 O4	PIC XXXX OCCURS 16.
	0	3 TESTONE REDEFINES TESTFOUR.
	:	   5 O1	PIC X OCCURS 64.
	DFD	CTLFILE
	N	VALUE OF ID CTLFILENAME.
	X1	CTLREC	PIC X(72) DISPLAY-7.
	b1	CTL01 PIC X(01) DISPLAY-7.
	l1	CTL02 PIC X(02) DISPLAY-7.
	v1	CTL03 PIC X(03) DISPLAY-7.

1	CTL04 PIC X(04) DISPLAY-7.


1	CTL05 PIC X(05) DISPLAY-7.

1	CTL06 PIC X(06) DISPLAY-7.

1	CTL07 PIC X(07) DISPLAY-7.

(1	CTL08 PIC X(08) DISPLAY-7.

21	CTL09 PIC X(09) DISPLAY-7.

<1	CTL10 PIC X(10) DISPLAY-7.

F1	CTL11 PIC X(11) DISPLAY-7.

P1	CTL12 PIC X(12) DISPLAY-7.

Z1	CTL13 PIC X(13) DISPLAY-7.

d1	CTL14 PIC X(14) DISPLAY-7.

n1	CTL15 PIC X(15) DISPLAY-7.

x1	CTL16 PIC X(16) DISPLAY-7.
1	CTL17 PIC X(17) DISPLAY-7.

1	CTL18 PIC X(18) DISPLAY-7.
1	CTL19 PIC X(19) DISPLAY-7.
 1	CTL20 PIC X(20) DISPLAY-7.
*1	CTL21 PIC X(21) DISPLAY-7.
41	CTL22 PIC X(22) DISPLAY-7.
>1	CTL23 PIC X(23) DISPLAY-7.
H1	CTL24 PIC X(24) DISPLAY-7.
R1	CTL25 PIC X(25) DISPLAY-7.
\1	CTL26 PIC X(26) DISPLAY-7.
f1	CTL28 PIC X(28) DISPLAY-7.
p1	CTL30 PIC X(30) DISPLAY-7.
z1	CTL32 PIC X(32) DISPLAY-7.

1	CTL34 PIC X(34) DISPLAY-7.

1	CTL44 PIC X(44) DISPLAY-7.

1	CTL50 PIC X(50) DISPLAY-7.

"

,

6

@

JFD	DCYFILE

T	VALUE OF ID DCYFILENAME.

^1	DCYREC  PIC X(10).

hWORKING-STORAGE SECTION.

r1	I	PIC S9(10) COMP.

|1	J	PIC S9(10) COMP.
C S9(10) COMP.
ILENAME DISPLAY-7.
 CTLFILENAMEONLY	PIC XXXXXX.
LER		PIC XXX VALUE "CTL".
ILENAME DISPLAY-7.
FILENAMEIN	PIC XXXXXX.
LER	PIC XXX VALUE "XTT".
ILENAME DISPLAY-7.
 FILENAMEOUT	PIC XXXXXX.
LLER	PIC XXX VALUE "CTL".
ILENAME DISPLAY-7.
 DCYFILENAMEONLY PIC X(6).
FILLER  PIC XXX  VALUE "DCY".
1	PTR		PIC S9(10) COMP.
1	STRINGPTR	PIC S9(10) COMP.
1	FILENAMESTRING DISPLAY-7 PIC X(65).
&1	JOBLINE		PIC XXXX DISPLAY-7 VALUE "$JOB".
01	NOERRORLINE	PIC X(8) DISPLAY-7 VALUE "@NOERROR".
:1	10-NOERRORLINE	PIC X(8) DISPLAY-7 VALUE ".NOERROR".
D1	DEFLINE		PIC X(20) DISPLAY-7 VALUE "@DEF DSK: DSK: ,SYS:".
N1	10-SETSRCLINE	PIC X(9) DISPLAY-7 VALUE ".R SETSRC".
X1	10-SYSLINE	PIC XXXX DISPLAY-7 VALUE "*SYS".
b1	10-ASSIGNLINE	PIC X(12) DISPLAY-7 VALUE ".ASS DSK SYS".
l1	EXELINE		PIC X(9) DISPLAY-7 VALUE "@RU SETUP".
v1	10-EXELINE	PIC X(9) DISPLAY-7 VALUE ".RU SETUP".
1	SYSTEMLINE DISPLAY-7.

	3 FILLER	PIC X VALUE "*".
	3 SYSTEMCHARS	PIC XX VALUE "10".
	88 TOPS-10 VALUE "10".
(	88 LEGALSYSTEM VALUE "10" "20".
21	RLINE  PIC XX DISPLAY-7  VALUE "*C".
<1	EXPUNGELINE  PIC X(5) DISPLAY-7 VALUE "@EXPU".
F1	IDLINE PIC X(32)  DISPLAY-7 VALUE '@INFORMATION (ABOUT) DISK-USAGE'.
P1	ILLINE PIC X(34) DISPLAY-7 VALUE '@INFORMATION (ABOUT) LOGICAL-NAMES'.
Z1	LIBARYLINE	PIC X(7) DISPLAY-7 VALUE "@LIBARY".
d1	10-LIBARYLINE	PIC X(9) DISPLAY-7 VALUE ".R LIBARY".
n1	LOGOUTLINE	PIC X(7) DISPLAY-7 VALUE "@LOGOUT".
x1	KFLINE		PIC XXXX DISPLAY-7 VALUE ".K/F".
1	MASTER-LINE DISPLAY-7.

	02 FILLER PIC X(2) VALUE '*='.
	02 MASTER-NAME.
 		03 MASTER-SUBSYS-ID PIC X(3).
*		03 MASTER-MACHINE-ID PIC X(3) VALUE 'MAS'.
41	SUBSTITUTE-LINE DISPLAY-7.
>	02 FILLER PIC X(2) VALUE '*='.
H	02 SUBSTITUTE-NAME.
R		04 SUBSYS-ID PIC X(3).
\		04 HOST-MACHINE-ID PIC X(3).
f1	SUBSYS-LINE  DISPLAY-7.
p	03 FILLER PIC X VALUE '*'.
z	03 PUT-SUBSYS PIC X(3).
1	IN-LIBARYNAMELINE DISPLAY-7.
	3 FILLER	PIC XX VALUE "*=".
	3 IN-LIBARYNAME.
"		5 IN-SUBSYS PIC X(3).
,			88 QUITTING VALUE 'QIT'.
6		5 FILLER PIC X(3) VALUE 'COM'.
@1	OUT-LIBARYNAMELINE DISPLAY-7.
J	3 FILLER	PIC XX VALUE "*=".
T	3 OUT-LIBARYNAME.
^		5 OUT-SUBSYS PIC X(3).
h		5 OUT-HOSTID PIC X(3).
r1	ENDLINE		PIC XXXX DISPLAY-7 VALUE "*END".
|1	NAMEHOLD2	PIC X(10) DISPLAY-7.
1	NAMEHOLD DISPLAY-7.
	3 FILLER	PIC X(6).
	3 LASTFEWCHARS	PIC XXXX.
$1	OLDNAMEHOLD	PIC X(10) DISPLAY-7.
.1	ON-A-LINE-FLAG PIC S9 COMP VALUE ZERO.
8		88 LINE-LIMIT VALUE 7.
B		88 LINE-EMPTY VALUE ZERO.
L1	LIBARYOPERATION PIC X(9) DISPLAY-7.
V1	NAMEEXTENSION	PIC XXXX DISPLAY-7.
`1	ERROREXIT	PIC 9 VALUE 0.
j1	HOLD-CTL-NAMES		PIC X(66) DISPLAY-7.
t1	IDENTIFY-LIB-FLAG  PIC S9 COMP VALUE ZERO.
~	88	IN-LIB  VALUE  1.
1	DELOUTLIB-LINE  DISPLAY-7.
	  3 DELOUT-HOST-CHAR  PIC X  VALUE '@'.
	  3 SYS-CMD  PIC X(4).
&	  3 FILLER  PIC X  VALUE SPACE.
0	  3 NAME-SLOT-1  PIC X(6)  JUSTIFIED RIGHT.
:	  3 FILLER  PIC X(4)  VALUE '.LIB'.
D	  3 ARG-DELIMITER  PIC X  VALUE SPACE.
N	  3 NAME-SLOT-2  PIC X(6)  JUSTIFIED RIGHT.
X	  3 FILLER  PIC X(5)  VALUE '.LIB '.
b1  HOST-LINE  DISPLAY-7.
l	02 FILLER PIC X VALUE "*".
v	02 HOST-CHARACTER PIC X.
	88  HOST-10  VALUE ".".

	88  HOST-20  VALUE "@".
1	COMMENT-CHARACTER PIC X VALUE "!".
1	SYS-COMMENT  PIC X(6)  DISPLAY-7    VALUE "! *SYS".
(1	CHARS-XFRD-COUNT PIC  S99  COMP  VALUE ZERO.
21	NAME-SUB  PIC S99  COMP  VALUE ZERO.
<	88 NAME-LIMIT  VALUE 99.
F1	CONTROLFILE-NAMES-TABLE.
P	03 NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.
Z1	ALT-NAMES-TABLE.
d	03 ALT-NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.
n1	NAME-TEMP.
x	02 N-T-3 PIC X(3).
		88 MASTR-CTL VALUE 'MAS'.

	02 FILLER PIC X(6).
1	TERM PIC X(5).
 1	CM-NAME-TEMP PIC X(9).
*1	DEL-CTL-LINE  DISPLAY-7.
4	  3 DEL-CTL-HOST-CHAR  PIC X  VALUE '@'.
>	  3 FILLER  PIC X(4) VALUE 'DELE'.
H	  3 FILLER  PIC X  VALUE SPACE.
R	  3 DEL-CTL-RIGHT PIC X(66).
\1	COMMENT-OPTION-FLAG PIC S9 COMP VALUE ZERO.
f	88 WANT-EXTRA-COMMENTS VALUE 1.
p
z


1	MAILERLINE  DISPLAY-7.
"	02 MAILSTAR	PIC X VALUE '*'.
,	02 MAILLINE	PIC X(5) VALUE '@MAIL'.
6	02 MAILEX	PIC X(2) VALUE 'ER'.
@1	MAILSUBJECT DISPLAY-7 PIC X(24) VALUE '* CONVERSION JOB IS DONE'.
J1	MAILTERM DISPLAY-7.
T	02 FILLER	PIC XX VALUE "*".
^PROCEDURE DIVISION.
hMAIN SECTION.
rSTART.
|	DISPLAY "CONVERT TO [10] OR [20]?  "  WITH NO ADVANCING
	ACCEPT SYSTEMCHARS.
	IF NOT LEGALSYSTEM
	  DISPLAY "INPUT '10' OR '20'"
$	  GO TO START.
.	IF TOPS-10
8		MOVE '010' TO OUT-HOSTID
B		MOVE '.' TO 	HOST-CHARACTER,
L				DELOUT-HOST-CHAR,
V				DEL-CTL-HOST-CHAR
`		ELSE MOVE '@' TO HOST-CHARACTER
j			MOVE '020' TO OUT-HOSTID.
t
~
GET-MODE.
	DISPLAY "[I]NITIATE OR [C]ONVERT MODE?  "  WITH NO ADVANCING
	ACCEPT FILENAMESTRING.
&	IF FILENAMESTRING = "I" GO TO CTL-INIT.
0	IF FILENAMESTRING = "C" GO TO PART2.
:	DISPLAY "REPLY WITH 'I' OR 'C'".
D	GO TO GET-MODE.
N
XCTL-INIT.
b	DISPLAY "NAME OUTPUT CONTROL FILE  " WITH NO ADVANCING
l	ACCEPT CTLFILENAMEONLY.
v	OPEN OUTPUT CTLFILE.


	WRITE CTL04 FROM JOBLINE.
	IF TOPS-10
	  WRITE CTL08 FROM 10-NOERRORLINE
(	  WRITE CTL09 FROM 10-SETSRCLINE
2	  WRITE CTL04 FROM 10-SYSLINE
<	  WRITE CTL12 FROM 10-ASSIGNLINE
F	  GO TO NEXTLIBS.
P	WRITE CTL08 FROM NOERRORLINE.
Z	WRITE CTL20 FROM DEFLINE.
d
nNEXTLIBS.
x	DISPLAY "NAME THE SUBSYSTEM  " WITH NO ADVANCING
	ACCEPT IN-SUBSYS.

	IF QUITTING GO TO WINDUP.
	MOVE IN-SUBSYS TO OUT-SUBSYS, MASTER-SUBSYS-ID.
 
*
4OPEN-UP.
>	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
H	OPEN  INPUT DCYFILE.
R
\	MOVE SPACES TO NAME-SLOT-2.
f	MOVE OUT-LIBARYNAME TO NAME-SLOT-1.
p	MOVE "DELE" TO SYS-CMD.
z	WRITE CTL16 FROM DELOUTLIB-LINE.

	IF TOPS-10
		MOVE '=' TO ARG-DELIMITER
"		MOVE OUT-LIBARYNAME TO NAME-SLOT-1
,		MOVE IN-LIBARYNAME TO NAME-SLOT-2
6	ELSE
@		MOVE IN-LIBARYNAME TO NAME-SLOT-1
J		MOVE OUT-LIBARYNAME TO NAME-SLOT-2.
T	MOVE "COPY" TO SYS-CMD.
^	WRITE CTL28 FROM DELOUTLIB-LINE.
h	MOVE SPACE TO ARG-DELIMITER.
r	PERFORM STACK-CONTROLFILE-NAMES.
|
LIB-EXTRACT.
	MOVE "*EXTRACT" TO LIBARYOPERATION.
	MOVE ".XTT" TO NAMEEXTENSION.
$	MOVE 0 TO ERROREXIT.
.	SET IDENTIFY-LIB-FLAG TO 1.
8	PERFORM LIBARYCOMMAND.
B	SET IDENTIFY-LIB-FLAG TO ZERO.
L	IF ERROREXIT = 1 
V	  CLOSE CTLFILE
`	  STOP RUN.
j
t
~MOD-EXE.
	IF TOPS-10
	  WRITE CTL09 FROM 10-EXELINE
	ELSE
&	  WRITE CTL09 FROM EXELINE.
0	WRITE CTL03 FROM SYSTEMLINE.
:	WRITE CTL02 FROM RLINE.
D
N	MOVE IN-SUBSYS TO PUT-SUBSYS.
X	WRITE CTL04 FROM SUBSYS-LINE.
bLIB-REPLACE.
l	MOVE "*REPLACE" TO LIBARYOPERATION.
v	MOVE ".CTL" TO NAMEEXTENSION.
	PERFORM LIBARYCOMMAND.

	WRITE CTL04 FROM ENDLINE.


(DELETE-AND-EXPUNGE.
2	PERFORM DELETE-CTLS.
<
F	IF NOT TOPS-10 WRITE CTL05 FROM EXPUNGELINE.
P
Z
dGO-BACK.
n
x	CLOSE DCYFILE
	GO TO NEXTLIBS.


 WINDUP.
*	IF TOPS-10
4	  WRITE CTL04 FROM KFLINE
>		ELSE
H	WRITE CTL05 FROM MAILLINE
R	WRITE CTL08 FROM MAILERLINE
\	WRITE CTL01 FROM MAILSTAR
f	WRITE CTL24 FROM MAILSUBJECT
p	WRITE CTL02 FROM MAILTERM
z	  WRITE CTL07 FROM LOGOUTLINE.
 	CLOSE CTLFILE .
 
 	DISPLAY  "END OF SETUP INITIATE SESSION".
 "	STOP RUN.
 ,DELETE-CTLS SECTION.
 6DC-INIT.
 @	SET PTR TO 1.
 J	SET NAME-SUB TO 1.
 T
 ^DC-LINE-START.
 h	MOVE SPACES TO HOLD-CTL-NAMES, DEL-CTL-RIGHT.
 r	SET ON-A-LINE-FLAG TO ZERO.
 |
!DC-LOOP.
!	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
!	IF NAME-TEMP EQUALS SPACES GO TO DC-EXIT.
!$	IF MASTR-CTL GO TO DC-L1.
!.	IF NAME-TEMP EQUALS MASTER-NAME
!8		MOVE '.XTT,' TO TERM
!B	ELSE
!L		MOVE '.*,' TO TERM.
!V	
!`	STRING NAME-TEMP TERM
!j		DELIMITED BY SPACE
!t		INTO HOLD-CTL-NAMES
!~		WITH POINTER PTR.
"	SET ON-A-LINE-FLAG UP BY 1.
"	IF NAME-LIMIT GO TO DC-EXIT.
"DC-L1.
"&	SET NAME-SUB UP BY 1.
"0	IF LINE-LIMIT GO TO DC-PUT.
":
"D	GO TO DC-LOOP.
"N
"XDC-PUT.
"b	PERFORM SPECIAL-PUT.
"l	GO TO DC-LINE-START.
"v
#DC-EXIT.
#
	IF NOT LINE-EMPTY
#		PERFORM SPECIAL-PUT.
#
#(
#2SPECIAL-PUT SECTION.
#<	STRING HOLD-CTL-NAMES
#F		DELIMITED BY ', '
#P		INTO DEL-CTL-RIGHT.
#Z	SET PTR TO 1.
#d	WRITE CTLREC FROM DEL-CTL-LINE.
#nSTACK-CONTROLFILE-NAMES SECTION.
#xSCN-START.
$	MOVE SPACES TO CONTROLFILE-NAMES-TABLE.
$
	MOVE SPACES TO ALT-NAMES-TABLE.
$	SET NAME-SUB TO 1.
$ 
$*
$4GET-NEXT-NAME.
$>	READ DCYFILE
$H		AT END
$R		GO TO SCN-EXIT.
$\
$f	MOVE 1 TO PTR.
$p	UNSTRING DCYREC INTO NAME-TEMP WITH POINTER PTR.
$z	MOVE 1 TO PTR.
%	UNSTRING NAME-TEMP DELIMITED BY 'CM '
%		INTO CM-NAME-TEMP WITH POINTER PTR.
%	IF NAME-TEMP EQUALS CM-NAME-TEMP
%"		GO TO GET-NEXT-NAME.
%,
%6
%@	MOVE NAME-TEMP TO NAME-HOLD (NAME-SUB).
%J	MOVE CM-NAME-TEMP TO ALT-NAME-HOLD (NAME-SUB).
%T
%^	IF NAME-LIMIT 
%h		DISPLAY "NAME LIMIT EXCEEDED"
%r		GO TO SCN-EXIT.
%|	SET NAME-SUB UP BY 1.
&	GO TO GET-NEXT-NAME.
&
&
&$SCN-EXIT.
&.	EXIT.
&8
&B
&L
&VLIBARYCOMMAND SECTION.
&`P0.
&j	IF TOPS-10 WRITE CTL09 FROM 10-LIBARYLINE
&t	ELSE
&~	  WRITE CTL07 FROM LIBARYLINE.
'	IF IN-LIB
'		WRITE CTL08 FROM IN-LIBARYNAMELINE
'		ELSE
'&		WRITE CTL08 FROM OUT-LIBARYNAMELINE.
'0	MOVE SPACE TO OLDNAMEHOLD.
':	SET NAME-SUB TO 1.
'D
'NNEXT-CTL.
'X	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAMEHOLD.
'b	IF NAMEHOLD = SPACE GO TO LIB-EXIT.
'l	MOVE 1 TO STRINGPTR.
'v	MOVE SPACES TO CTLREC.
(	MOVE NAME-HOLD (NAME-SUB) TO NAMEHOLD2.
(
	MOVE SPACES TO LASTFEWCHARS OF NAMEHOLD.
(	STRING LIBARYOPERATION
(		" "
((		NAMEHOLD2
(2		","
(<		NAMEHOLD
(F		NAMEEXTENSION DELIMITED BY "  "
(P	  INTO CTLREC WITH POINTER STRINGPTR.
(Z	WRITE CTL30.
(d	IF NAME-LIMIT
(n		GO TO LIB-EXIT.
(x	SET NAME-SUB UP BY 1.
)	GO TO NEXT-CTL.
)
)
) LIB-EXIT.
)*	EXIT.
)4
)>PART2 SECTION.
)HSTART-RUNMODE.
)R	DISPLAY "NAME THE SUBSYSTEM  " WITH NO ADVANCING
)\	ACCEPT IN-SUBSYS.
)f	MOVE IN-SUBSYS TO MASTER-SUBSYS-ID, OUT-SUBSYS.
)p	MOVE 'COM' TO MASTER-MACHINE-ID.
)z
*
*	MOVE OUT-LIBARYNAME TO SUBSTITUTE-NAME.
*	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
*"	OPEN INPUT DCYFILE.
*,	PERFORM STACK-CONTROLFILE-NAMES.
*6	CLOSE DCYFILE.
*@	SET NAME-SUB TO 1.
*J
*T
*^INIT-FILES.
*h	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
*r	UNSTRING NAME-TEMP DELIMITED BY SPACE 
*|		INTO FILENAMEIN.
+	IF FILENAMEIN = SPACE GO TO LEAVE.
+	MOVE FILENAMEIN TO FILENAMEOUT.
+
+$	OPEN INPUT INFILE.
+.	OPEN OUTPUT OUTFILE.
+8
+BGET-NEXT.
+L	READ INFILE AT END GO TO CTT-EXHAUST.
+V
+`
+jSUBSTITUTE-FIRST.
+t	IF LIBID-LINE AND INREC EQUALS MASTER-LINE
+~		WRITE OUTREC08 FROM SUBSTITUTE-LINE
,		GO TO GET-NEXT.
,
,	IF HOST-20 AND DEFDSK 
,&			WRITE OUTREC32 FROM IDLINE
,0			WRITE OUTREC34 FROM ILLINE.
,:	IF HOST-20 AND 20-LOGOUT WRITE OUTREC32 FROM IDLINE.
,D	IF RSETSRC PERFORM HANDLE-SETSRC 
,N		GO TO GET-NEXT.
,X	IF FOR-BOTH MOVE HOST-CHARACTER TO FIRSTCHAR
,b		GO TO MOV-REC.
,l	IF NOT FOR-10 AND NOT FOR-20 GO TO MOV-REC.
,v	IF FOR-10 AND HOST-10  GO TO MOV-REC.
-	IF FOR-20 AND HOST-20  GO TO MOV-REC.
-
	
-*
-*  FUNCTIONALITY HERE TO INCLUDE COMMANDS SPECIFIC TO THE
-(*  ALTERNATE SYSTEM AS COMMENT LINES.  THIS MAY BE ENABLED
-2*  BY SETTING THE DEFAULT VALUE OF COMMENT-OPTION-FLAG TO 1.
-<*
-F	IF WANT-EXTRA-COMMENTS
-P		MOVE COMMENT-CHARACTER TO FIRSTCHAR
-Z	ELSE
-d		GO TO GET-NEXT.
-n
-x
.
.
MOV-REC.
.	MOVE INREC TO OUTREC.
. WRITE-REC.
.*	IF O4 (8) = SPACE
.4	  IF O4 (4) = SPACE
.>	    IF O4 (2) = SPACE
.H		MOVE 1 TO I GO TO P70
.R	    ELSE
.\	      IF O4 (3) = SPACE
.f		MOVE 5 TO I GO TO P70
.p	      ELSE
.z		MOVE 9 TO I GO TO P70
/	  ELSE
/	    IF O4 (6) = SPACE
/	      IF O4 (5) = SPACE
/"		MOVE 13 TO I GO TO P70
/,	      ELSE
/6		MOVE 17 TO I GO TO P70
/@	    ELSE
/J	      IF O4 (7) = SPACE
/T		MOVE 21 TO I GO TO P70
/^	      ELSE
/h		MOVE 25 TO I GO TO P70
/r	ELSE
/|	  IF O4 (12) = SPACE
0	    IF O4 (10) = SPACE
0	      IF O4 (9) = SPACE
0		MOVE 29 TO I GO TO P70
0$	      ELSE
0.		MOVE 33 TO I GO TO P70
08	    ELSE
0B	      IF O4 (11) = SPACE
0L		MOVE 37 TO I GO TO P70
0V	      ELSE
0`		MOVE 41 TO I GO TO P70
0j	  ELSE
0t	    IF O4 (14) = SPACE
0~	      IF O4 (13) = SPACE
1		MOVE 45 TO I GO TO P70
1	      ELSE
1		MOVE 49 TO I GO TO P70
1&	    ELSE
10	      IF O4 (15) = SPACE
1:		MOVE 53 TO I GO TO P70
1D	      ELSE
1N		MOVE 57 TO I GO TO P70.
1X	IF O4 (16) NOT = SPACES MOVE 61 TO I.
1b
1lP70.
1v	IF O1 (I + 3) = SPACE
2	  IF O1 (I + 2) = SPACE
2
	    IF O1 (I + 1) = SPACE
2		NEXT SENTENCE
2	    ELSE ADD 1 TO I
2(	  ELSE ADD 2 TO I
22	ELSE ADD 3 TO I.
2<	GO TO 
2F		P70-01
2P		P70-02
2Z		P70-03
2d		P70-04
2n		P70-05
2x		P70-06
3		P70-07
3
		P70-08
3		P70-09
3 		P70-10
3*		P70-11
34		P70-12
3>		P70-13
3H		P70-14
3R		P70-15
3\		P70-16
3f		P70-17
3p		P70-18
3z		P70-19
4		P70-20
4		P70-21
4		P70-22
4"		P70-23
4,		P70-24
46		P70-25
4@		P70-26
4J		P70-27
4T		P70-28
4^		P70-29
4h		P70-30
4r		P70-31
4|		P70-32
5		P70-33
5		P70-34
5		P70-35
5$		P70-36
5.		P70-37
58		P70-38
5B		P70-39
5L		P70-40
5V		P70-41
5`		P70-42
5j		P70-43
5t		P70-44
5~		P70-45
6		P70-46
6		P70-47
6		P70-48
6&		P70-49
60		P70-50
6:		P70-51
6D		P70-52
6N		P70-53
6X		P70-54
6b		P70-55
6l		P70-56
6v		P70-57
7		P70-58
7
		P70-59
7		P70-60
7		P70-61
7(		P70-62
72		P70-63
7<		P70-64
7F		DEPENDING ON I.
7P	DISPLAY "? SOMETHING WRONG WITH THE BINARY TREE " I.
7Z	STOP RUN.
7dP70-01. WRITE OUTREC01. GO TO GET-NEXT.
7nP70-02. WRITE OUTREC02. GO TO GET-NEXT.
7xP70-03. WRITE OUTREC03. GO TO GET-NEXT.
8P70-04. WRITE OUTREC04. GO TO GET-NEXT.
8
P70-05. WRITE OUTREC05. GO TO GET-NEXT.
8P70-06. WRITE OUTREC06. GO TO GET-NEXT.
8 P70-07. WRITE OUTREC07. GO TO GET-NEXT.
8*P70-08. WRITE OUTREC08. GO TO GET-NEXT.
84P70-09. WRITE OUTREC09. GO TO GET-NEXT.
8>P70-10. WRITE OUTREC10. GO TO GET-NEXT.
8HP70-11. WRITE OUTREC11. GO TO GET-NEXT.
8RP70-12. WRITE OUTREC12. GO TO GET-NEXT.
8\P70-13. WRITE OUTREC13. GO TO GET-NEXT.
8fP70-14. WRITE OUTREC14. GO TO GET-NEXT.
8pP70-15. WRITE OUTREC15. GO TO GET-NEXT.
8zP70-16. WRITE OUTREC16. GO TO GET-NEXT.
9P70-17. WRITE OUTREC17. GO TO GET-NEXT.
9P70-18. WRITE OUTREC18. GO TO GET-NEXT.
9P70-19. WRITE OUTREC19. GO TO GET-NEXT.
9"P70-20. WRITE OUTREC20. GO TO GET-NEXT.
9,P70-21. WRITE OUTREC21. GO TO GET-NEXT.
96P70-22. WRITE OUTREC22. GO TO GET-NEXT.
9@P70-23. WRITE OUTREC23. GO TO GET-NEXT.
9JP70-24. WRITE OUTREC24. GO TO GET-NEXT.
9TP70-25. WRITE OUTREC25. GO TO GET-NEXT.
9^P70-26. WRITE OUTREC26. GO TO GET-NEXT.
9hP70-27. WRITE OUTREC27. GO TO GET-NEXT.
9rP70-28. WRITE OUTREC28. GO TO GET-NEXT.
9|P70-29. WRITE OUTREC29. GO TO GET-NEXT.
:P70-30. WRITE OUTREC30. GO TO GET-NEXT.
:P70-31. WRITE OUTREC31. GO TO GET-NEXT.
:P70-32. WRITE OUTREC32. GO TO GET-NEXT.
:$P70-33. WRITE OUTREC33. GO TO GET-NEXT.
:.P70-34. WRITE OUTREC34. GO TO GET-NEXT.
:8P70-35. WRITE OUTREC35. GO TO GET-NEXT.
:BP70-36. WRITE OUTREC36. GO TO GET-NEXT.
:LP70-37. WRITE OUTREC37. GO TO GET-NEXT.
:VP70-38. WRITE OUTREC38. GO TO GET-NEXT.
:`P70-39. WRITE OUTREC39. GO TO GET-NEXT.
:jP70-40. WRITE OUTREC40. GO TO GET-NEXT.
:tP70-41. WRITE OUTREC41. GO TO GET-NEXT.
:~P70-42. WRITE OUTREC42. GO TO GET-NEXT.
;P70-43. WRITE OUTREC43. GO TO GET-NEXT.
;P70-44. WRITE OUTREC44. GO TO GET-NEXT.
;P70-45. WRITE OUTREC45. GO TO GET-NEXT.
;&P70-46. WRITE OUTREC46. GO TO GET-NEXT.
;0P70-47. WRITE OUTREC47. GO TO GET-NEXT.
;:P70-48. WRITE OUTREC48. GO TO GET-NEXT.
;DP70-49. WRITE OUTREC49. GO TO GET-NEXT.
;NP70-50. WRITE OUTREC50. GO TO GET-NEXT.
;XP70-51. WRITE OUTREC51. GO TO GET-NEXT.
;bP70-52. WRITE OUTREC52. GO TO GET-NEXT.
;lP70-53. WRITE OUTREC53. GO TO GET-NEXT.
;vP70-54. WRITE OUTREC54. GO TO GET-NEXT.
<P70-55. WRITE OUTREC55. GO TO GET-NEXT.
<
P70-56. WRITE OUTREC56. GO TO GET-NEXT.
<P70-57. WRITE OUTREC57. GO TO GET-NEXT.
<P70-58. WRITE OUTREC58. GO TO GET-NEXT.
<(P70-59. WRITE OUTREC59. GO TO GET-NEXT.
<2P70-60. WRITE OUTREC60. GO TO GET-NEXT.
<<P70-61. WRITE OUTREC61. GO TO GET-NEXT.
<FP70-62. WRITE OUTREC62. GO TO GET-NEXT.
<PP70-63. WRITE OUTREC63. GO TO GET-NEXT.
<ZP70-64. WRITE OUTREC64. GO TO GET-NEXT.
<d
<n
<xCTT-EXHAUST.
=	CLOSE INFILE OUTFILE
=
	IF NOT NAME-LIMIT SET NAME-SUB UP BY 1
=	GO TO INIT-FILES.
= LEAVE.
=*	DISPLAY "END SETUP CONVERT SESSION"
=4	STOP RUN.
=>
=H
=R
=\
=fHANDLE-SETSRC SECTION.
=p	IF HOST-20
=z		MOVE COMMENT-CHARACTER TO FIRSTCHAR.
>	WRITE OUTREC FROM INREC.
>
>
>"GET-STAR-SYS.
>,	READ INFILE AT END
>6		DISPLAY "UNEXPECTED END ON SETSRC LINE"
>@		STOP RUN.
>J	IF NOT STAR-SYS
>T		DISPLAY "NO *SYS AFTER .R SETSRC"
>^		STOP RUN.
>h
>r
>|PUT-STAR-SYS.
?	IF HOST-20
?		WRITE OUTREC06 FROM SYS-COMMENT
?	ELSE
?$		WRITE OUTREC06 FROM INREC.
?.
?8
?B

* 26 DEC 75
ID DIVISION.
PROGRAM-ID. SHORTL.
(*	SHORTENS .LOG FILES BY REMOVING ALL THE GARBAGE.
2ENVIRONMENT DIVISION.
<INPUT-OUTPUT SECTION.
FFILE-CONTROL.
P	SELECT INFILE ASSIGN TO DSK.
Z	SELECT OUTFILE ASSIGN TO DSK.
dDATA DIVISION.
nFILE SECTION.
xFD	INFILE VALUE OF ID IS INFILENAME.
01	INREC DISPLAY-7.

	03  TABS	PIC XX.
	88  TABTAB VALUE "		".
 	03  JOBFIELD.
*	88  JOBLINE	VALUE ";$JOB".
4	    05 FILLER	PIC X.
>	    88 TABTABQUESTION VALUE "?".
H	    05 FILLER	PIC XXXX.
R	03  FILLER	PIC XX.
\	03  INCODE	PIC X.
f	88  MONTR	VALUE "M" "T" "F" "B".
p	88  BATCH	VALUE "B" "T" "F".
z	88  USER	VALUE "U".
	03  FILLER	PIC X(4).
	03  USERLINE.
	    05  CHR1	PIC X.
"	    05  MONTRLINE.
,		07  CHRS2TO7.
6			88 KJOB VALUE "@@LOGO".
@		    09  CHR2	PIC X.
J		    09  FILLER	PIC X(5).
T		07  FILLER	PIC X(61).
^FD	OUTFILE VALUE OF ID IS OUTFILENAME.
h1	OUTREC DISPLAY-7 PIC X(82).
rWORKING-STORAGE SECTION.
|1	STARTMARK	PIC S9(10) COMP.
1	ENDMARK		PIC S9(10) COMP.
1	MONTRMARK	PIC S9(10) COMP.
1	QUESTIONMARK	PIC S9(10) COMP.
$1	CURRENTLINE	PIC S9(10) COMP.
.1	RESPONSE	PIC X.
8	88 NOPE VALUE "N".
B	88 LEGALRESPONSE VALUE "N" "Y".
L1	INFILENAME.
V	3  FILENAME	PIC X(6).
`	3  FILLER	PIC XXX VALUE "LOG".
j1	OUTFILENAME.
t	3 OUTNAME	PIC XXXXXX.
~	3 FILLER	PIC XXX VALUE "SLG".
1	PTR	PIC S9(5) COMP VALUE 1.
1	FILENAMESTRING PIC X(72) DISPLAY-7.
PROCEDURE DIVISION.
&P1.
0	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
:	ACCEPT RESPONSE.
D	IF NOT LEGALRESPONSE
N	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
X	  GO TO P1.
b	DISPLAY "NAMES OF .LOG FILES: ".
l	ACCEPT FILENAMESTRING.
v	MOVE 1 TO PTR.
P2.

	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
	  INTO FILENAME WITH POINTER PTR.
	IF FILENAME = SPACE GO TO P1.
(	MOVE FILENAME TO OUTNAME.
2	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
<	MOVE 10000 TO ENDMARK.
F	IF NOPE GO TO P4.
P
Z*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
d
n	OPEN INPUT INFILE.
xP3.
	READ INFILE AT END GO TO P3C.

	ADD 1 TO CURRENTLINE.
	IF MONTR AND CHR2 = "@"
 	  NEXT SENTENCE ELSE GO TO P3A.
*	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
4	  GO TO P3.
>*	  IGNORE THE @ST LINE IN ORDER TO GET THE PRECEDING LINES
H*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
R	IF BATCH OR CHRS2TO7 = "@@ST" OR "@ST" OR "@" GO TO P3.
\	MOVE CURRENTLINE TO MONTRMARK.
f	GO TO P3.
pP3A.
z	IF USER AND CHR1 = "?"
	  GO TO P3B.
	IF MONTR AND CHR2 = "?"
	  GO TO P3B.
"	IF TABTABQUESTION GO TO P3B.
,	GO TO P3.
6P3B.
@	IF STARTMARK = 0
J	  MOVE MONTRMARK TO STARTMARK.
T	MOVE CURRENTLINE TO QUESTIONMARK.
^	GO TO P3.
hP3C.
r	MOVE MONTRMARK TO ENDMARK.
|	MOVE 0 TO CURRENTLINE.
	CLOSE INFILE.
	IF STARTMARK = 0
	  DISPLAY "NO ?'S FOUND IN " FILENAME
$	  GO TO P2.
.P4.
8	OPEN INPUT INFILE.
B	OPEN OUTPUT OUTFILE.
LP5.
V	READ INFILE AT END GO TO P95.
`	ADD 1 TO CURRENTLINE.
j	IF NOT JOBLINE GO TO P5.
t	IF CURRENTLINE < STARTMARK GO TO P10.
~	IF CURRENTLINE > ENDMARK GO TO P99.
		MOVE "\\" TO TABS.
		WRITE OUTREC FROM INREC.
	P10.
	&	READ INFILE AT END GO TO P99.
	0	ADD 1 TO CURRENTLINE
	:	IF CURRENTLINE < STARTMARK GO TO P10.
	D	IF CURRENTLINE > ENDMARK GO TO P99.
	N	IF KJOB GO TO P99.
	X	IF TABTAB
	b	  MOVE "\\" TO TABS
	l	  WRITE OUTREC FROM INREC
	v	  GO TO P10.

	IF MONTR AND CHRS2TO7 NOT = SPACE


	  WRITE OUTREC FROM MONTRLINE GO TO P10.

	IF USER AND USERLINE NOT = SPACE

	  WRITE OUTREC FROM USERLINE GO TO P10.

(	GO TO P10.

2P95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.

<P99.	CLOSE INFILE OUTFILE.

F	DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.

 ID DIVISION.
PROGRAM-ID. SHORTL.
*	SHORTENS .LOG FILES BY REMOVING ALL THE GARBAGE.
(ENVIRONMENT DIVISION.
2INPUT-OUTPUT SECTION.
<FILE-CONTROL.
F	SELECT INFILE ASSIGN TO DSK.
P	SELECT OUTFILE ASSIGN TO DSK.
ZDATA DIVISION.
dFILE SECTION.
nFD	INFILE VALUE OF ID IS INFILENAME.
x01	INREC1 DISPLAY-7.
	2 LINE1.

	  3 TIME-USER	PIC X(14).
	  3 FIRST-CHAR  PIC X.
 	  3 FILLER	PIC X(7).
*	2 FILLER PIC X(61).
401	INREC2 DISPLAY-7.
>	3 SLASHSLASH PIC XX.
H	3 FILLER PIC X(12).
R	3 OUTLINE PIC X(69).
\
f1	INREC3 DISPLAY-7.
p	2 FILLER PIC X(14).
z	2 USER-LINE.
		3 FILLER PIC X.
		3 TOPS-20-MONTR-LINE.
		    4 FILLER PIC X.
"		    4 TOPS-10-MONITR-LINE PIC X(67).
,FD	OUTFILE VALUE OF ID IS OUTFILENAME.
61	OUTREC DISPLAY-7 PIC X(83).
@WORKING-STORAGE SECTION.
J1	STARTMARK	PIC S9(10) COMP.
T1	ENDMARK		PIC S9(10) COMP.
^1	MONTRMARK	PIC S9(10) COMP.
h1	QUESTIONMARK	PIC S9(10) COMP.
r1	CURRENTLINE	PIC S9(10) COMP.
|1	RESPONSE	PIC X.
	88 NOPE VALUE "N".
	88 LEGALRESPONSE VALUE "N" "Y".
1	INFILENAME.
$	3  FILENAME	PIC X(6).
.	3  FILLER	PIC XXX VALUE "LOG".
81	OUTFILENAME.
B	3 OUTNAME	PIC XXXXXX.
L	3 FILLER	PIC XXX VALUE "SLG".
V1	PTR	PIC S9(5) COMP VALUE 1.
`1	FILENAMESTRING PIC X(72) DISPLAY-7.
j1	TALLY1 PIC 9(10) COMP.
t1	TALLY2 PIC 9(10) COMP.
~1	TALLY3 PIC 9(10) COMP.
1	LOGIN-LINE1.
	2 INDEXED-LINE PIC X OCCURS 22 TIMES.
1	POINTER1	PIC 99.
&1	TOPS-TYPE PIC X VALUE " ".
0	88 FOUND-TOPS-TYPE VALUE "@" ".".
:	88 TOPS-20 VALUE "@".
D	88 TOPS-10 VALUE ".".
N1	MONLINE PIC X(7) USAGE IS DISPLAY-7.
XPROCEDURE DIVISION.
bP1.
l	DISPLAY "ONLY LINES WITH QUESTIONMARKS? " WITH NO ADVANCING.
v	ACCEPT RESPONSE.
	IF NOT LEGALRESPONSE

	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
	  GO TO P1.
	DISPLAY "NAMES OF .LOG FILES: ".
(	ACCEPT FILENAMESTRING.
2	MOVE 1 TO PTR.
<P2.
F	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
P	  INTO FILENAME WITH POINTER PTR.
Z	IF FILENAME = SPACE GO TO P1.
d	MOVE FILENAME TO OUTNAME.
n	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
x	MOVE 10000 TO ENDMARK.
	MOVE " " TO TOPS-TYPE.

	IF NOPE GO TO P4.
	MOVE "NOVALUE" TO MONLINE.
 
**	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
4
>	OPEN INPUT INFILE.
HP3.
R	READ INFILE AT END GO TO P3C.
\	IF NOT FOUND-TOPS-TYPE
f		PERFORM FIND-TYPE.
p	ADD 1 TO CURRENTLINE.
z	SET TALLY1 TO 0.
	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE.
	IF TALLY1 NOT = 1 GO TO P3A.
	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
"	  GO TO P3.
,*	  IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
6*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
@	SET TALLY1 TO 0.
J	INSPECT LINE1 TALLYING TALLY1 FOR ALL "..ST",
T		TALLY1 FOR ALL ".ST",
^		TALLY1 FOR ALL "@ST",
h		TALLY1 FOR ALL "@@ST".
r	IF TALLY1 = 1 GO TO P3.
|	MOVE CURRENTLINE TO MONTRMARK.
	GO TO P3.
P3A.
	IF FIRST-CHAR = "?"
$		PERFORM P3B.
.	GO TO P3.
8P3B.
B	IF STARTMARK = 0
L	  MOVE MONTRMARK TO STARTMARK.
V	MOVE CURRENTLINE TO QUESTIONMARK.
`
jP3C.
t	MOVE MONTRMARK TO ENDMARK.
~	MOVE 0 TO CURRENTLINE.
		CLOSE INFILE.
		IF STARTMARK = 0
		  DISPLAY "NO ?'S FOUND IN " FILENAME
	&	  GO TO P2.
	0P4.
	:	OPEN INPUT INFILE.
	D	OPEN OUTPUT OUTFILE.
	N	PERFORM FIND-MONLINE.
	XP5.
	b	READ INFILE AT END GO TO P95.
	l	ADD 1 TO CURRENTLINE.
	v	SET TALLY1 TO 0.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL ";$JOB".


	IF TALLY1 NOT = 1 GO TO P5.

	IF CURRENTLINE > ENDMARK GO TO P99.

P10.

(	READ INFILE AT END GO TO P99.

2	ADD 1 TO CURRENTLINE

<	IF CURRENTLINE < STARTMARK GO TO P10.

F	IF CURRENTLINE > ENDMARK GO TO P99.

P	SET TALLY1 TO 0.

Z	INSPECT LINE1 TALLYING TALLY1 FOR ALL "KJOB",

d		TALLY1 FOR  ALL "LOGO".

n	IF TALLY1 = 1 GO TO P99.

x	SET TALLY1 TO 0.
	INSPECT LINE1 TALLYING TALLY1 FOR ALL "		".

	IF TALLY1 = 1
		MOVE "\\" TO SLASHSLASH
 		WRITE OUTREC FROM INREC2
*		GO TO P10.
4	SET TALLY1 TO 0.
>	SET TALLY2 TO 0.
H	SET TALLY3 TO 0.
R*	SHORTL IS SET TO IGNORE THE COMPILER VERSION NUMBER LINE
\	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE,
f		TALLY2 FOR ALL " USER	",
p		TALLY3 FOR ALL "C74OTS".
z	IF TALLY1 = 1  AND TALLY3 NOT = 1

		IF TOPS-10

		   WRITE OUTREC FROM TOPS-10-MONITR-LINE

		ELSE IF TOPS-20

"		   WRITE OUTREC FROM TOPS-20-MONTR-LINE.

,	IF TALLY2 = 1 AND USER-LINE NOT = SPACE AND TALLY3 NOT = 1

6		WRITE OUTREC FROM USER-LINE.

@	GO TO P10.

JP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.

TP99.	CLOSE INFILE OUTFILE.

^	DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.

hFIND-TYPE.

r	MOVE 0 TO TALLY1.

|	INSPECT LINE1 TALLYING TALLY1 FOR ALL "LOGIN".
E 1 TO POINTER1.
LLY1 =1
NSTRING LINE1 DELIMITED BY "LOGIN"
INTO LOGIN-LINE1 WITH POINTER POINTER1
VE INDEXED-LINE (POINTER1 - 6) TO TOPS-TYPE
 TOPS-20 
MOVE " MONTR	" TO MONLINE
LSE IF TOPS-10
OVE "MONITR	" TO MONLINE
ELSE 
ISPLAY"? SHORTL ERROR COULD NOT FIND TOPS TYPE".
MONLINE.
AD INFILE AT END
		DISPLAY "? COULDN'T FIND LOGIN LINE"
		STOP RUN.
	ADD 1 TO CURRENTLINE.
&	PERFORM FIND-TYPE.
0	IF NOT FOUND-TOPS-TYPE GO TO FIND-MONLINE.