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
G uCv I6G4 bCX9G4 Y>>N)G lY>>N8G z[ LHG4 [ LIG4 ]>LzG g$[s[ #g&\D $%g"~- G 8g"~-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.