Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/build/acp020.lib
There are no other files named acp020.lib in the archive.
C \G, @C \G, WC
G v %C(v KC:G4 ,CI6G4 jCX9G4 Y>>N)G Y>>N8G ![ LHG4 @[ LIG4 /]>LzG 32&:e0 &]eI:IG *%eI:LRG ->eI:MzG 1!g$[s[ 48g&\D 5&g"~- G I g"~-G LN
@INFORMATION (ABOUT) DISK-USAGE
@@INFORMATION (ABOUT) LOGICAL-NAMES
( @@DEF SYS: DSK:,SYS:
2 @
< @LIBARY
F**=ACP020
P**EXTRACT ACP1CM,ACP1.CTL
Z**EXTRACT ACP2CM,ACP2.CTL
d**EXTRACT ACPCHKCM,ACPCHK.CTL
n**EXTRACT ACPDELCM,ACPDEL.CTL
x**EXTRACT LOGTYPCB,LOGTYP.CBL
**EXTRACT NEWTSTCB,NEWTST.CBL
**EXTRACT SETEOFMA,SETEOF.MAC
**EXTRACT SHORTLCB,SHORTL.CBL
*^C
* @@MACRO
4**=SETEOF
>NO ERRORS DETECTED
HPROGRAM BREAK IS 000136
RCPU TIME USED 00:01.058
\68P CORE USED
f*^C
p @@LOAD SETEOF
zMACRO: SETEOF
LINK: Loading
EXIT
@@SAVE
" @
, @DELETE ACP1.LOG
6 @@SUB ACP1
@ @@SUB ACP2
J @@SUB ACPCHK
T @@CBL74
^**=LOGTYP
hPHASE C
rPHASE D
|PHASE E
PHASE F
**=SHORTL
PHASE C
$PHASE D
.PHASE E
8PHASE F
B*^C
L @@COBOL
V**=NEWTST
`PHASE C
jPHASE D
tPHASE E
~PHASE F
WARNINGS:
0140 Right-most truncation on SINGLE-CHAR
0148 Most significant digits truncated on PTR
&0205 Right-most truncation on STARLINETEXT
0No Fatal Errors, 3 Warnings
:*^C
D @@INFORMATION (ABOUT) DISK-USAGE
N @
* MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT1.
2* REDEFINES
<* VALUE CLAUSE
F* ONE DIMENSIONED TABLE
P* OPEN, CLOSE, READ, WRIT SEQUENTIAL FILES
Z* WITH BLOCKING AND ASCII/SIXBIT/BINARY MODES.
d* SAME AREA
n* RERUN EVERY N RECORDS
x* MOVE ALL LITERAL
* PERFORM N TIMES
* PERFORM VARYING
* ADD X TO Y
* GO TO
** DISPLAY
4* STRING
>ENVIRONMENT DIVISION.
HI-O SECTION.
RFILE-CONTROL.
\ SELECT WORK-1 ASSIGN TO DSK
f RECORDING MODE IS SIXBIT.
p
z SELECT WORK-2 ASSIGN TO DSK
RECORDING MODE IS BINARY.
SELECT WORK-3 ASSIGN TO LOGDEV
" RECORDING MODE IS ASCII.
,
6I-O-CONTROL.
@ RERUN EVERY 300 RECORDS OF WORK-3
J SAME AREA WORK-1 WORK-2 WORK-3.
T
^DATA DIVISION.
hFILE SECTION.
rFD WORK-1
| VALUE OF ID IS FILENAME
BLOCK CONTAINS 3 RECORDS.
01 RECORD-1 PIC X(80).
$FD WORK-2
. VALUE OF ID 'WORK2 '.
801 RECORD-2 PIC X(120).
B
LFD WORK-3
V VALUE OF ID 'TSTDATSEQ'.
`01 RECORD-3 DISPLAY-7.
j 3 RECKEY PIC XXXXXX.
t 3 RECKEYREDEF REDEFINES RECKEY.
~ 5 RECKEY1 PIC XXX.
5 RECNO PIC 999.
3 FILLER PIC X(20).
&WORKING-STORAGE SECTION.
01 FILENAME PIC X(9) VALUE "WORK1XXXX".
:77 COUNT-1 PIC 99 VALUE 0.
D77 COUNT-2 PIC 99 VALUE 0.
N77 COUNT-3 PIC 9999 VALUE 0.
X1 TABLEOFVALUES.
b 3 RECVALUE PIC XXX OCCURS 999 TIMES.
l1 I PIC S9(10) COMP.
v1 MESSAGEOUT PIC X(28).
PROCEDURE DIVISION.
MAIN SECTION.
P0.
( MOVE ALL "AAABBBCCCDDDEEEFFFGGGHHHIIIJJJ" TO TABLEOFVALUES.
2 OPEN OUTPUT WORK-1.
< MOVE 'TEST DATA ' TO RECORD-1.
F PERFORM WRITE-1 10 TIMES.
P CLOSE WORK-1.
Z STRING " " FILENAME DELIMITED BY "X"
d "X.XXX WRITTEN " DELIMITED BY SIZE
n INTO MESSAGEOUT.
x DISPLAY MESSAGEOUT.
OPEN OUTPUT WORK-2.
MOVE 'TEST DATA' TO RECORD-2.
PERFORM WRITE-2 20 TIMES.
CLOSE WORK-2.
* DISPLAY ' WORK2 CREATED'.
4 OPEN OUTPUT WORK-3.
> MOVE 'XXXXXX TEST DATA' TO RECORD-3.
H PERFORM WRITE-3 VARYING I FROM 1 BY 1 UNTIL I > 999.
R CLOSE WORK-3.
\ DISPLAY ' TSTDAT.SEQ CREATED '.
f OPEN INPUT WORK-1.
pLOOP1.
z READ WORK-1 RECORD AT END GO TO B1.
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 ';
6 COUNT-1, ' RECORDS WERE READ.'.
@B2.
J
T CLOSE WORK-1, WITH DELETE.
^ OPEN INPUT WORK-2.
hLOOP2.
r READ WORK-2 AT END GO TO B3.
| 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.'.
8B4.
B CLOSE WORK-2 WITH DELETE.
L OPEN INPUT WORK-3.
VLOOP3.
` READ WORK-3 AT END GO TO B5.
j ADD 1 TO COUNT-3.
t IF COUNT-3 NOT = RECNO
~ 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 ';
0 COUNT-3, ' RECORDS WERE READ.'.
:B6.
D CLOSE WORK-3.
N DISPLAY "END ACCPT1".
X STOP RUN.
bWRITE-1.
l WRITE RECORD-1.
vWRITE-2.
WRITE RECORD-2.
WRITE-3.
MOVE RECVALUE (I) TO RECKEY1.
MOVE I TO RECNO.
( WRITE RECORD-3.
* MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT2.
2* OPEN, CLOSE, READ, WRITE ON RANDOM FILE
<* SORT WITH INPUT AND OUTPUT PROCEDURES.
F* REPORT WRITING FEATURES.
P* LINKED WITH COBDDT.REL, CHECKS COBDDT AD HISTOGRAM
ZENVIRONMENT DIVISION.
dINPUT-OUTPUT SECTION.
nFILE-CONTROL.
x SELECT SEQFILE ASSIGN TO DSK.
SELECT RANFILE ASSIGN TO DSK
ORGANIZATION RELATIVE
ACCESS DYNAMIC
RELATIVE KEY ACTKEY
* RECORDING MODE IS SIXBIT.
4 SELECT REPFILE ASSIGN TO DSK.
> SELECT SRTFILE ASSIGN TO DSK DSK DSK.
HDATA DIVISION.
RFILE SECTION.
\FD SEQFILE VALUE OF ID IS "TSTDATSEQ".
f1 SEQREC PIC X(26) DISPLAY-7.
pFD RANFILE VALUE OF ID IS "TSTDATRAN"
z BLOCK CONTAINS 20 RECORDS.
1 RANREC PIC X(26).
FD REPFILE VALUE OF ID IS "TSTDATREP"
REPORT IS REPTRY.
"1 REPREC PIC X(45) DISPLAY-7.
,SD SRTFILE.
61 SRTREC.
@ 3 KEY1 PIC XXX.
J 3 KEY2 PIC 999.
T 3 KEY2REDEF REDEFINES KEY2.
^ 5 DIGIT1 PIC 9.
h 5 DIGIT2 PIC 9.
r 5 DIGIT3 PIC 9.
| 3 KEY3 PIC X(20).
WORKING-STORAGE SECTION.
1 ACTKEY PIC 9(10) COMP.
1 I PIC 9(10) COMP.
$1 ONETHOUSAND PIC 9(10) COMP VALUE 1000.
.1 OLDKEY PIC XXX VALUE SPACE.
8REPORT SECTION.
BRD REPTRY
L PAGE 60 LINES
V CONTROLS ARE FINAL DIGIT1 DIGIT2.
`1 TYPE CONTROL FOOTING FINAL LINE PLUS 5.
j 3 COLUMN 1 PIC X(20) VALUE "FINAL LINE".
t 3 COLUMN 30 PIC XXX SOURCE KEY1.
~ 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.
01 TYPE CONTROL FOOTING DIGIT2 LINE PLUS 2.
: 3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 2".
D 3 COLUMN 35 PIC ZZZ SOURCE KEY2.
N1 DETAILLINE TYPE DETAIL LINE PLUS 1.
X 3 COLUMN 1 PIC XXXXXX VALUE "DETAIL".
b 3 COLUMN 30 PIC XXX SOURCE KEY1.
l 3 COLUMN 35 PIC ZZZ SOURCE KEY2.
v1 TYPE PAGE HEADING LINE 1 NEXT GROUP PLUS 3.
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.
2P0.
< SORT SRTFILE ON ASCENDING KEY1
F INPUT PROCEDURE INPROCEDURE
P OUTPUT PROCEDURE OUTPROCEDURE.
Z DISPLAY "END ACCPT2".
d STOP RUN.
nINPROCEDURE SECTION.
xIP0.
OPEN INPUT SEQFILE, OUTPUT REPFILE.
INITIATE REPTRY.
IP5.
READ SEQFILE AT END GO TO IP10.
* RELEASE SRTREC FROM SEQREC.
4 MOVE SEQREC TO SRTREC.
> GENERATE DETAILLINE.
H GO TO IP5.
RIP10.
\ DISPLAY " PRESORT DONE".
f TERMINATE REPTRY.
p CLOSE REPFILE.
z CLOSE SEQFILE.
DISPLAY " TSTDAT.REP WRITTEN".
OUTPROCEDURE SECTION.
"OP0.
, OPEN OUTPUT RANFILE.
6 DISPLAY " MERGE STARTED".
@OP5.
J RETURN SRTFILE AT END GO TO OP10.
T IF KEY1 NOT < OLDKEY
^ NEXT SENTENCE
h ELSE
r DISPLAY SPACE
| DISPLAY "? KEYS NOT IN ORDER, LAST = " OLDKEY
", THIS = " KEY1.
MOVE KEY1 TO OLDKEY.
MOVE KEY2 TO ACTKEY.
$ WRITE RANREC FROM SRTREC INVALID KEY
. REWRITE RANREC FROM SRTREC INVALID KEY
8 DISPLAY SPACE
B DISPLAY "? CAN'T WRITE RANDOM RECORD AT KEY VALUE " ACTKEY.
L GO TO OP5.
VOP10.
` CLOSE RANFILE.
j DISPLAY " MERGE ENDED".
t DISPLAY " TSTDAT.RAN WRITTEN".
~ MOVE 0 TO ACTKEY I.
OPEN INPUT RANFILE.
OP15.
READ RANFILE NEXT RECORD INTO SRTREC AT END
& GO TO OP25.
0 ADD 1 TO I.
: IF I NOT = KEY2
D DISPLAY SPACE
N DISPLAY "? RANDOM FILE RECORD OUT OF ORDER"
X DISPLAY " OR MISSING AT RECORD POSITION " I
b DISPLAY " RECORD FOUND THERE IS"
l DISPLAY SRTREC.
v GO TO OP15.
OP25.
CLOSE RANFILE.
DISPLAY " TSTDAT.RAN CHECK COMPLETED".
* MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT3.
2* CONDITION-NAMES
<* CALL
F* OPEN INPUT-OUTPUT, DELETE REWRITE ON INDEXED FILE.
P* COMPILED WITH /U SWITCH, LINKED AS ROOT FOR OVERLAY.
ZENVIRONMENT DIVISION.
dINPUT-OUTPUT SECTION.
nFILE-CONTROL.
x SELECT SEQFILE ASSIGN TO DSK.
SELECT RANFILE ASSIGN TO DSK
ORGANIZATION RELATIVE
ACCESS RANDOM
RELATIVE KEY IS ACTKEY.
* SELECT IDXFILE ASSIGN TO DSK
4 ORGANIZATION INDEXED
> ACCESS RANDOM
H RECORD KEY IS IDXKEY2.
R SELECT REPFILE ASSIGN TO DSK.
\DATA DIVISION.
fFILE SECTION.
pFD SEQFILE VALUE OF ID IS "TSTDATSEQ".
z1 SEQREC PIC X(26) DISPLAY-7.
FD RANFILE VALUE OF ID IS "TSTDATRAN"
BLOCK CONTAINS 20 RECORDS.
"1 RANREC PIC X(26).
,
6FD IDXFILE VALUE OF ID IS "TSTDATIDX"
@ BLOCK CONTAINS 29 RECORDS.
J1 IDXREC.
T 3 IDXKEY1 PIC XXX.
^ 88 RECORDTOBEDELETED VALUE "AAA" THRU "EEE".
h 88 RECORDTOBEREWRITTEN VALUE "FFF" "GGG" "HHH" "III" THRU "JJJ".
r 3 IDXKEY2 PIC 999.
| 3 IDXFILLER PIC X(20).
FD REPFILE VALUE OF ID IS "TSTDATREP".
1 REPREC PIC X(45) DISPLAY-7.
$
.WORKING-STORAGE SECTION.
81 ACTKEY PIC 9(10) COMP.
B1 I PIC 9(10) COMP.
L1 RANWSREC PIC X(26).
V1 REPWSREC DISPLAY-7.
` 88 ABORTSIGNALON VALUE ALL "Z".
j 3 FILLER PIC XXXXXX.
t 88 ADETAILRECORD VALUE "DETAIL".
~ 3 FILLER PIC X(39).
PROCEDURE DIVISION.
MAINLINE SECTION.
P0.
& OPEN INPUT SEQFILE REPFILE.
0 OPEN INPUT-OUTPUT RANFILE IDXFILE.
: DISPLAY " ALL FILES OPENED".
DP5.
N ADD 1 TO I.
X READ IDXFILE NEXT RECORD AT END GO TO ENDCHECK.
b IF I NOT = IDXKEY2
l DISPLAY "? ON READ NUMBER " I " WE GOT THIS RECORD:"
v DISPLAY " " IDXREC.
MOVE IDXKEY2 TO ACTKEY.
READ RANFILE INTO RANWSREC INVALID KEY
DISPLAY "? CAN'T READ RECORD #" ACTKEY " ON RANDOM FILE.".
READ SEQFILE AT END
( DISPLAY "? PREMATURE AT END ON SEQUENTIAL FILE.".
2P7.
< READ REPFILE INTO REPWSREC AT END
F DISPLAY "? PREMATURE AT END ON REPORT FILE.".
P IF NOT ADETAILRECORD GO TO P7.
Z
d CALL ACCPT4 USING I SEQREC RANWSREC REPWSREC IDXREC.
n
x IF ABORTSIGNALON
DISPLAY "? RECORDS DO NOT MATCH, ABORTING EXECUTION"
STOP RUN.
IF RECORDTOBEDELETED
DELETE IDXFILE INVALID KEY
* DISPLAY "? CAN'T DELETE RECORD ON INDEXED FILE.".
4 IF RECORDTOBEREWRITTEN
> MOVE SPACES TO IDXKEY1
H REWRITE IDXREC INVALID KEY
R DISPLAY "? CAN'T REWRITE RECORD ON INDEXED FILE.".
\ GO TO P5.
fENDCHECK.
p READ SEQFILE AT END
z DISPLAY " SEQUENTIAL FILE OK"
GO TO P35.
DISPLAY "? TOO MANY RECORDS IN SEQUENTIAL FILE.".
P35.
" CLOSE SEQFILE RANFILE.
,P36.
6 READ REPFILE INTO REPWSREC AT END GO TO P37.
@ IF NOT ADETAILRECORD GO TO P36.
J DISPLAY "? TOO MANY DETAIL RECORDS IN REPORT FILE.".
TP37.
^ CLOSE REPFILE.
h IF I = 1000
r DISPLAY " NORMAL END ACCPT3."
| ELSE DISPLAY "? ABNORMAL END ACCPT3, ONLY " I " RECORDS COUNTED.".
STOP RUN.
* MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT4.
2* LINKAGE SECTION.
<* COMPILED WITH /U SWITCH, LINKED AS OVERLAY.
FDATA DIVISION.
PWORKING-STORAGE SECTION.
ZLINKAGE SECTION.
d1 I PIC S9(10) COMP.
n1 SEQREC DISPLAY-7.
x 3 SEQKEY1 PIC XXX.
3 SEQKEY2 PIC 999.
3 SEQKEY3 PIC X(20).
1 RANREC.
* 3 RANKEY1 PIC XXX.
4 3 RANKEY2 PIC 999.
> 3 RANKEY3 PIC X(20).
H
R1 IDXREC.
\ 3 IDXKEY1 PIC XXX.
f 3 IDXKEY2 PIC 999.
p 3 IDXKEY3 PIC X(20).
z
1 REPREC DISPLAY-7.
3 REPKEY3 PIC X(29).
3 REPKEY1 PIC XXX.
" 3 FILLER PIC XX.
, 3 REPKEY2 PIC 999.
6 3 FILLER PIC X(8).
@PROCEDURE DIVISION USING I SEQREC RANREC REPREC IDXREC.
JMANLINE SECTION.
TP0.
^ IF REPKEY1 NOT = RANKEY1
h OR RANKEY1 NOT = SEQKEY1
r OR SEQKEY1 NOT = IDXKEY1
| 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
8 GO TO BADEXIT.
B IF RANKEY2 = REPKEY2
L AND REPKEY2 = SEQKEY2
V AND IDXKEY2 = SEQKEY2
` GO TO GOODEXIT.
j DISPLAY "? KEY2 VALUES NOT EQUAL, RECORD # " I
t DISPLAY " RANDOM KEY = " RANKEY2
~ DISPLAY " INDEXED KEY = " IDXKEY2
DISPLAY " SEQUENT KEY = " SEQKEY2
DISPLAY " REPORT KEY = " REPKEY2.
BADEXIT.
& MOVE ALL "Z" TO REPREC.
0GOODEXIT.
: EXIT PROGRAM.
;$JOB
@NOERROR
@INFORMATION (ABOUT) DISK-USAGE
(@INFORMATION (ABOUT) LOGICAL-NAMES
2@DEF SYS: DSK:,SYS:
<!R SETSRC
F! *SYS
P@R LIBARY
Z*=ACP020
d*EXTRACT ACCPT1CB,ACCPT1.CBL
n*EXTRACT ACCPT2CB,ACCPT2.CBL
x*EXTRACT ACCPT3CB,ACCPT3.CBL
*EXTRACT ACCPT4CB,ACCPT4.CBL
@CBL74
*=ACCPT1
@CBL74
**=ACCPT2
4@CBL74
>*=ACCPT3/P/U
H@CBL74
R*=ACCPT4/P/U
\@LINK
f*ACCPT1/G
p@SAVE ACCPT1
z@DEFINE LOGDEV: DSK:
@RU ACCPT1
@DEFINE LOGDEV:
@R RERUN
"*ACCPT1
,@DEFINE LOGDEV: DSK:
6@CONT
@@R ISAM
J*TSTDAT
T*A
^*S
h*26
r*UN4.3
|*0
*29
*3
*14
$*1
.*10
8*10
B*2000
L@R LINK
V*/DEB:C ACCPT2/G
`*BREAK OP25
j*HISTORY BEGIN TTY: 'ACCEPTANCE TEST OF HISTOGRAM'
t! I SHOULD HAVE VALUE OF 999
~*DISPLAY I
*CLEAR
*WHERE
*P
&@R LINK
0*ACCPT3.OVR/OV=ACCPT3/LINK:ROOT/SPACE:10000
:*ACCPT4/LINK/G
D!NOTE - THIS HAS NOT WORKED FOR LO THESE MANY MONTHS
N! ON TOPS-20 BECAUSE OF A LONG-STANDING LINK BUG
X! WHICH DOES NOT RIGHTLY INITIALIZE THE MODULE.
b! IF THE BUG SHOULD STILL EXIST AT THIS RUNNING,
l! SUBSTITUTE A GET/SAVE/RUN SEQUENCE AFTER LINK.
v! THE ERROR MESSAGE IF YOU ENCOUNTER IT, WILL SAY:
! - ?OVLOPP OVERLAY HANDLER IN PRIVATE PAGE
@RU ACCPT3
@INFORMATION (ABOUT) DISK-USAGE
@LOGOUT
;$JOB
@NOERROR
@INFORMATION (ABOUT) DISK-USAGE
(@INFORMATION (ABOUT) LOGICAL-NAMES
2@DEF SYS: DSK:,SYS:
<!R SETSRC
F! *SYS
P@DELETE RAN*.DAT,ISMDAT.*,*.CKP
Z@LIBARY
d*=ACP020
n*EXTRACT RR74DLCB,RR74DL.CBL
x*EXTRACT RR74RDCB,RR74RD.CBL
*EXTRACT RR74WTCB,RR74WT.CBL
@CBL74
*=RR74WT
*=RR74RD
**=RR74DL
4@LINK
>*RR74WT/G
H@SAVE RR74WT
R@ISAM
\*ISMDAT=NUL:
f*S
p*A
z*15
*X11.5
*0
*2
"*1
,*4
6*1
@*10
J*10
T*1000
^@RU RR74WT
h@R LINK
r*RR74RD/G
|@SAVE RR74RD
@START
@R LINK
*RR74DL/G
$@START
.@R RERUN
8*RR74WT
B@RUN RR74RD
L@DELETE RAN*.DAT,ISMDAT.*,*.CKP
V@DELETE RR74*.*
`@INFORMATION (ABOUT) DISK-USAGE
j@LOGO
@NOERROR
@INFORMATION (ABOUT) DISK-USAGE
@INFORMATION (ABOUT) LOGICAL-NAMES
(@DEF SYS: DSK:,SYS:
2!R SETSRC
<! *SYS
F@R LOGTYP
P*N
Z*ACP1
d@R LOGTYP
n*YES
x*ACP2
@R SHORTL
*N
*ACPMAS
@R LIBARY
**=ACP020
4*EXTRACT ACCEPTCK,ACPMAS.CHK
>@R FILCOM
H*=ACPMAS.CHK,ACPMAS.SLG
R@MAIL
\*@MAILER
f*
p* ACP SUBSYSTEM
z* IS DONE !!!
*
*
RESUME::
"@INFORMATION (ABOUT) DISK-USAGE
,@LOGOUT
@NOERROR
@DELE ACP*.BAK
@DELE ACPMAS.*,ACPCHK.*,ACPDEL.CTL,ACP1.*,ACP2.*
(@DELETE TSTDAT.RAN,TSTDAT.REP
2@DELETE TSTDAT.IDA,TSTDAT.IDX
<@DELETE TSTDAT.SEQ,WORK1X.XXX,WORK2
F@DELETE SHORTL.CBL,SHORTL.LST
P@DELETE LOGTYP.CBL,LOGTYP.LST
Z@DELETE NEWTST.CBL,NEWTST.LST
d@DELETE *.INP
n@DELETE ACCPT%.*
x@EXPU
@INFORMATION (ABOUT) DISK-USAGE
@LOGOUT
;$JOB
@NOERROR
@INFORMATION (ABOUT) DISK-USAGE
(@INFORMATION (ABOUT) LOGICAL-NAMES
2@DEF SYS: DSK:,SYS:
<!R SETSRC
F! *SYS
P@GOTO DO20::
ZDO10::
d*=ACP010
n*EXTRACT ACP1CM,ACP1.CTL
x*EXTRACT ACP2CM,ACP2.CTL
*EXTRACT ACPCHKCM,ACPCHK.CTL
*EXTRACT ACPDELCM,ACPDEL.CTL
*EXTRACT LOGTYPCB,LOGTYP.CBL
*EXTRACT NEWTSTCB,NEWTST.CBL
**EXTRACT SHORTLCB,SHORTL.CBL
4DO20::
>@LIBARY
H*=ACP020
R*EXTRACT ACP1CM,ACP1.CTL
\*EXTRACT ACP2CM,ACP2.CTL
f*EXTRACT ACPCHKCM,ACPCHK.CTL
p*EXTRACT ACPDELCM,ACPDEL.CTL
z*EXTRACT LOGTYPCB,LOGTYP.CBL
*EXTRACT NEWTSTCB,NEWTST.CBL
*EXTRACT SETEOFMA,SETEOF.MAC
*EXTRACT SHORTLCB,SHORTL.CBL
"@MACRO
,*=SETEOF
6@LOAD SETEOF
@@SAVE
JRESUME::
T@DELETE ACP1.LOG
^@SUB ACP1
h@SUB ACP2
r@SUB ACPCHK
|@CBL74
*=LOGTYP/R
*=SHORTL/R
*=NEWTST/R
$@LINK
.*LOGTYP/G
8@SAVE LOGTYP
B@LINK
L*SHORTL/G
V@SAVE SHORTL
`@LINK
j*NEWTST/G
t@SAVE NEWTST
~@INFORMATION (ABOUT) DISK-USAGE
@LOGOUT
*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 PIC X(22).
x 2 FILLER PIC X(61).
01 INREC2 DISPLAY-7.
3 SLASHSLASH PIC XX.
3 FILLER PIC X(12).
3 OUTLINE PIC X(69).
*1 INREC3 DISPLAY-7.
4 2 FILLER PIC X(14).
> 2 USER-LINE.
H 3 FILLER PIC X.
R 3 TOPS-20-MONTR-LINE.
\ 4 FILLER PIC X.
f 4 TOPS-10-MONITR-LINE PIC X(67).
p
zWORKING-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.
61 RESPONSE PIC X.
@ 88 NOPE VALUE "N".
J 88 LEGALRESPONSE VALUE "N" "Y".
T1 INFILENAME.
^ 3 FILENAME PIC X(6).
h 3 FILLER PIC XXX VALUE "LOG".
r1 PTR PIC S9(5) COMP VALUE 1.
|1 FILENAMESTRING PIC X(72) DISPLAY-7.
1 TALLY1 PIC 9999999999.
1 TALLY2 PIC 9999999999.
1 LOGIN-LINE1.
$ 2 INDEXED-LINE PIC X OCCURS 22 TIMES.
.1 POINTER1 PIC 99.
81 TOPS-TYPE PIC X VALUE " ".
B 88 FOUND-TOPS-TYPE VALUE "@" ".".
L 88 TOPS-20 VALUE "@".
V 88 TOPS-10 VALUE ".".
`1 MONLINE PIC X(7) USAGE IS DISPLAY-7.
jPROCEDURE DIVISION.
tP1.
~ DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
ACCEPT RESPONSE.
IF NOT LEGALRESPONSE
DISPLAY "TYPE ONLY 'Y' OR 'N'"
& GO TO P1.
0 DISPLAY "NAMES OF .LOG FILES: ".
: ACCEPT FILENAMESTRING.
D MOVE 1 TO PTR.
NP2.
X UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
b INTO FILENAME WITH POINTER PTR.
l IF FILENAME = SPACE GO TO P1.
v MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
MOVE " " TO TOPS-TYPE.
MOVE 10000 TO ENDMARK.
IF NOPE GO TO P4.
MOVE "NOVALUE" TO MONLINE.
(
2* DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
<
F OPEN INPUT INFILE.
PP3.
Z READ INFILE AT END GO TO P3C.
d IF NOT FOUND-TOPS-TYPE
n PERFORM FIND-TYPE.
x ADD 1 TO CURRENTLINE.
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.
4* IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
>* WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
H SET TALLY1 TO 0.
R INSPECT LINE1 TALLYING TALLY1 FOR ALL "..ST",
\ TALLY1 FOR ALL ".ST",
f TALLY1 FOR ALL "@ST",
p TALLY1 FOR ALL "@@ST".
z IF TALLY1 = 1 GO TO P3.
MOVE CURRENTLINE TO MONTRMARK.
GO TO P3.
P3A.
" SET TALLY1 TO 0.
, INSPECT LINE1 TALLYING TALLY1 FOR ALL "?".
6 IF TALLY1 NOT < 1 PERFORM P3B.
@ GO TO P3.
JP3B.
T IF STARTMARK = 0
^ MOVE MONTRMARK TO STARTMARK.
h MOVE CURRENTLINE TO QUESTIONMARK.
r
|P3C.
MOVE MONTRMARK TO ENDMARK.
MOVE 0 TO CURRENTLINE.
CLOSE INFILE.
$ IF STARTMARK = 0
. DISPLAY "NO ?'S FOUND IN " FILENAME
8 GO TO P2.
BP4.
L OPEN INPUT INFILE.
V DISPLAY "**** " FILENAME.
` PERFORM FIND-MONLINE.
jP5.
t READ INFILE AT END GO TO P95.
~ ADD 1 TO CURRENTLINE.
SET TALLY1 TO 0.
INSPECT LINE1 TALLYING TALLY1 FOR ALL ";$JOB".
IF TALLY1 NOT = 1 GO TO P5.
& IF CURRENTLINE > ENDMARK GO TO P99.
0P10.
: READ INFILE AT END GO TO P99.
D ADD 1 TO CURRENTLINE
N IF CURRENTLINE < STARTMARK GO TO P10.
X IF CURRENTLINE > ENDMARK GO TO P99.
b SET TALLY1 TO 0.
l INSPECT LINE1 TALLYING TALLY1 FOR ALL "KJOB",
v TALLY1 FOR ALL "LOGO".
IF TALLY1 = 1 GO TO P99.
SET TALLY1 TO 0.
INSPECT LINE1 TALLYING TALLY1 FOR ALL " ".
IF TALLY1 = 1
( MOVE "\\" TO SLASHSLASH
2 DISPLAY INREC2
< GO TO P10.
F SET TALLY1 TO 0.
P SET TALLY2 TO 0.
Z INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE,
d TALLY2 FOR ALL " USER ".
n IF TALLY1 = 1
x IF TOPS-10
DISPLAY TOPS-10-MONITR-LINE
ELSE IF TOPS-20
DISPLAY TOPS-20-MONTR-LINE.
IF TALLY2 = 1 AND USER-LINE NOT = SPACE
* DISPLAY USER-LINE.
4 GO TO P10.
>P95. DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
HP99. CLOSE INFILE.
R GO TO P2.
\FIND-TYPE.
f MOVE 0 TO TALLY1.
p INSPECT LINE1 TALLYING TALLY1 FOR ALL "LOGIN".
z MOVE 1 TO POINTER1.
IF TALLY1 =1
UNSTRING LINE1 DELIMITED BY "LOGIN"
INTO LOGIN-LINE1 WITH POINTER POINTER1
" MOVE INDEXED-LINE (POINTER1 - 6) TO TOPS-TYPE
, IF TOPS-20
6 MOVE " MONTR " TO MONLINE
@ ELSE IF TOPS-10
J MOVE "MONITR " TO MONLINE
T ELSE
^ DISPLAY"? SHORTL ERROR COULD NOT FIND TOPS TYPE".
hFIND-MONLINE.
r READ 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
*ACCCOM.DCY/D=ACCCOM
*ACPCOM.DCY/D=ACPCOM
(*ADDCOM.DCY/D=ADDCOM
2*COMCOM.DCY/D=COMCOM
<*DATCOM.DCY/D=DATCOM
F*DBMCOM.DCY/D=DBMCOM
P*DDTCOM.DCY/D=DDTCOM
Z*DIVCOM.DCY/D=DIVCOM
d*FILCOM.DCY/D=FILCOM
n*GOTCOM.DCY/D=GOTCOM
x*IFTCOM.DCY/D=IFTCOM
*IPCCOM.DCY/D=IPCCOM
*LIBCOM.DCY/D=LIBCOM
*MOVCOM.DCY/D=MOVCOM
*MULCOM.DCY/D=MULCOM
**REPCOM.DCY/D=REPCOM
4*SASCOM.DCY/D=SASCOM
>*SMUCOM.DCY/D=SMUCOM
H*SRTCOM.DCY/D=SRTCOM
R*STRCOM.DCY/D=STRCOM
\*SUBCOM.DCY/D=SUBCOM
f*TBLCOM.DCY/D=TBLCOM
p*UNSCOM.DCY/D=UNSCOM
z*UTLCOM.DCY/D=UTILTY
*DTMCOM.DCY/D=DATMOD
*=ACP020
*EXTRACT SETUP,SETUP.CBL
"*END
,*=SETUP
6*20
@*I
J*CONVRT
T*ACC
^*ACP
h*ADD
r*COM
|*DAT
*DBM
*DDT
*DIV
$*FIL
.*GOT
8*IFT
B*IPC
L*LIB
V*MOV
`*MUL
j*REP
t*SAS
~*SMU
*SRT
*STR
*SUB
&*TBL
0*UNS
:*QIT
$JOB
@NOERROR
@RU LIBARY
(*ACCCOM.DCY/D=ACCCOM
2*ACPCOM.DCY/D=ACPCOM
<*ADDCOM.DCY/D=ADDCOM
F*COMCOM.DCY/D=COMCOM
P*DATCOM.DCY/D=DATCOM
Z*DBMCOM.DCY/D=DBMCOM
d*DDTCOM.DCY/D=DDTCOM
n*DIVCOM.DCY/D=DIVCOM
x*FILCOM.DCY/D=FILCOM
*GOTCOM.DCY/D=GOTCOM
*IFTCOM.DCY/D=IFTCOM
*IPCCOM.DCY/D=IPCCOM
*LIBCOM.DCY/D=LIBCOM
**MOVCOM.DCY/D=MOVCOM
4*MULCOM.DCY/D=MULCOM
>*REPCOM.DCY/D=REPCOM
H*SASCOM.DCY/D=SASCOM
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
"*=ACP020
,*EXTRACT SETUPCB,SETUP.CBL
6@DELE CONVRT.CTL
@@COBOL
J*=SETUP
T@LOAD SETUP
^@SAVE SETUP
h@RU SETUP
r*20
|*I
*CONVRT
*ACC
*ACP
$*ADD
.*COM
8*DAT
B*DBM
L*DDT
V*DIV
`*FIL
j*GOT
t*IFT
~*IPC
*LIB
*MOV
*MUL
&*REP
0*SAS
:*SMU
D*SRT
N*STR
X*SUB
b*TBL
l*UNS
v*QIT
@SUB CONVRT/TIME:0:10:00
@INFORMATION (ABOUT) DISK-USAGE
@LOGOUT
* 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.
p01 TALLY PIC S9(10) COMP.
z1 ITERATION PIC S9999 COMP.
1 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.
61 JUNK PIC X.
@1 SINGLE-CHAR PIC X.
J1 TABCOMP PIC S9999 COMP VALUE 18.
T1 TABR REDEFINES TABCOMP DISPLAY-7.
^ 3 FILLER PIC XXXX.
h 3 TAB PIC X.
r1 REPLACESWITCH PIC X.
|1 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.
81 SKLN PIC S9999 COMP.
B1 DIGIT PIC 9.
L1 DIGIT2 PIC 9.
V1 N PIC S9999 COMP.
`1 M PIC S9999 COMP.
j1 T PIC S9999 COMP.
t1 P PIC S9999 COMP.
~1 PTR PIC S9999 COMP.
1 DEL PIC X.
1 LNAME PIC X(31).
1 TLINE PIC X(64) DISPLAY-7.
&1 INFILENAME DISPLAY-7.
0 3 IFNAME PIC XXXXXX.
: 3 IFEXT PIC XXX.
D1 OUTFILENAME DISPLAY-7.
N 3 OFNAME PIC XXXXXX.
X 3 OFEXT PIC XXX VALUE "CBL".
b1 LIST-CONTROL-TABLE.
l 3 LT OCCURS 9.
v 5 LIST-START PIC S9999 COMP.
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.
2 3 SKL PIC X(64) OCCURS 20 TIMES.
<1 CHARS1 DISPLAY-7.
F 3 CHAR11 PIC X.
P 3 FILLER PIC X(63).
Z1 CHARS2 DISPLAY-7.
d 3 CHAR21 PIC X.
n 3 FILLER PIC X(63).
x1 SENDING-FIELDS DISPLAY-7.
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.
41 TEMPNAME PIC X(31) DISPLAY-7.
>1 PROGLINE DISPLAY-7 VALUE "PROGRAM-ID. XXXXXX.".
H 3 FILLER PIC X(12).
R 3 PROGID PIC X(6).
\ 3 FILLER PIC X.
f1 IDLINE DISPLAY-7 PIC X(12) VALUE "ID DIVISION.".
p1 DATLINE DISPLAY-7 PIC X(14) VALUE "DATA DIVISION.".
z1 WSLINE DISPLAY-7 PIC X(24) VALUE "WORKING-STORAGE SECTION.".
1 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.
6 3 HLINENAME PIC X(6).
@ 3 FILLER PIC X.
J 3 HLINEEXT PIC XXX.
T 3 FILLER PIC XXXX.
^1 STARLINE DISPLAY-7 VALUE "*".
h 3 FILLER PIC X.
r 3 STARLINETEXT PIC X(63).
|
PROCEDURE DIVISION.
ND1 SECTION.
P0.
$ MOVE ZERO TO REPLACESWITCH ITERATION STEP SKLN.
. MOVE 1 TO LIST-ENTRY LIST-NUMBER.
8 DISPLAY "OUTPUT FILENAME? (6 CHARS) " WITH NO ADVANCING.
B ACCEPT OFNAME.
L IF OFNAME = SPACES STOP RUN.
V*+ NEXT LINE SKIPPED TO AVOID THE ":" FUNCTION.
`* MOVE "TMP" TO OFEXT.
j*- END OF CHANGE.
t OPEN OUTPUT OUTFILE.
~ MOVE 4 TO LINECOUNT.
WRITE OUTLINE FROM IDLINE BEFORE ADVANCING 1 LINE.
MOVE OFNAME TO PROGID.
WRITE OUTLINE FROM PROGLINE BEFORE ADVANCING 1 LINE.
& DISPLAY "COMMENTS:".
0P5.
: ACCEPT OUTLINE.
D IF OUTLINE NOT = SPACES
N WRITE OUTLINE BEFORE ADVANCING 1 LINE
X ADD 1 TO LINECOUNT
b GO TO P5.
l WRITE OUTLINE FROM DATLINE BEFORE ADVANCING 1 LINE.
v WRITE OUTLINE FROM WSLINE BEFORE ADVANCING 1 LINE.
BL3.
DISPLAY "INPUT FILENAME? (9 CHARS) " WITH NO ADVANCING.
ACCEPT INFILENAME.
OPEN INPUT INFILE.
( MOVE LIST-ENTRY TO LIST-START(LIST-NUMBER).
2 MOVE IFNAME TO HLINENAME.
< MOVE IFEXT TO HLINEEXT.
F IF IFEXT = "PM " GO TO BL20.
P WRITE OUTLINE FROM HLINE BEFORE ADVANCING 1 LINE.
Z ADD 1 TO LINECOUNT.
d
nBL4.
x READ INFILE AT END GO TO BL9.
MOVE INLINE TO SINGLE-CHAR.
BL5.
MOVE 0 TO TALLY.
INSPECT INLINE TALLYING TALLY FOR CHARACTERS
* BEFORE INITIAL "[".
4 IF TALLY > 63
> WRITE OUTLINE FROM INLINE BEFORE ADVANCING 1 LINE
H ADD 1 TO LINECOUNT
R GO TO BL4.
\ MOVE 0 TO K.
f ADD 2 TALLY GIVING PTR.
p UNSTRING INLINE DELIMITED BY "]"
z INTO LNAME COUNT IN K WITH POINTER PTR.
IF K > 30 MOVE 30 TO K
DISPLAY "ITEM TRUNCATION = " LNAME.
ADD 1 TO K.
" STRING "\" DELIMITED BY SIZE INTO LNAME WITH POINTER K.
, INSPECT INLINE REPLACING FIRST "[" BY SPACE
6 INSPECT INLINE REPLACING FIRST "]" BY SPACE.
@ IF LIST-ENTRY > 125
J DISPLAY "? TOO MANY BRACKETED ITEMS" LNAME
T STOP RUN.
^ MOVE LNAME TO TNAME(LIST-ENTRY).
h ADD 1 TO LIST-ENTRY.
r GO TO BL5.
|BL9.
LOSE INFILE.
UBTRACT 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 BEFORE ADVANCING 1 LINE.
E OUTLINE FROM P0LINE BEFORE ADVANCING 1 LINE.
E OUTLINE FROM HLINE BEFORE ADVANCING 1 LINE.
TO LINECOUNT.
BL21.
READ INFILE AT END GO TO BL29.
MOVE 1 TO PTR.
&BL22.
0 UNSTRING INLINE DELIMITED BY "%" OR "!"
: INTO CHARS1 DELIMITER IN D
D WITH POINTER PTR.
N IF PTR > 62 GO TO BL26.
X UNSTRING INLINE INTO CHARX WITH POINTER PTR.
b MOVE CHARX TO P.
l IF P NOT < LIST-NUMBER
v DISPLAY "? BAD LIST DIGIT"
DISPLAY INLINE STOP RUN.
IF D = "%"
MOVE "I" TO LIST-TYPE(P) GO TO BL22.
IF D = "!"
( MOVE "D" TO LIST-TYPE(P) GO TO BL22.
2 DISPLAY "?BL25" STOP RUN.
<BL26.
F*+ THIS CODE IS TO BE SKIPPED TO AVOID ":" FUNCTION.
P* INSPECT INLINE TALLYING TALLY FOR ALL ":".
Z* IF TALLY NOT = 0 MOVE "1" TO REPLACESWITCH.
d*- END OF CHANGE.
n ADD 1 TO SKLN.
x IF SKLN > 20
DISPLAY "TOO MANY LINES IN SKELETON"
STOP RUN.
MOVE INLINE TO SKL(SKLN).
MOVE INLINE TO STARLINETEXT.
* WRITE OUTLINE FROM STARLINE BEFORE ADVANCING 1 LINE.
4 ADD 1 TO LINECOUNT.
> GO TO BL21.
HBL29.
R CLOSE INFILE.
\ IF SKLN = 0
f DISPLAY "SKELETON EMPTY" STOP RUN.
p IF LIST-NUMBER < 2
z DISPLAY "? NO LISTS" STOP RUN.
MOVE 0 TO N.
VP0.
ADD 1 TO N.
" IF N = LIST-NUMBER GO TO XEXIT.
, IF LIST-TYPE(N) NOT = "I" GO TO VP0.
6 GO TO VP2.
@VP1.
J ADD 1 TO N.
T IF N = LIST-NUMBER GO TO XEXIT.
^ IF LIST-TYPE(N) NOT = "I" GO TO VP1.
h ADD 1 TO LIST-COUNT(N).
rVP2.
| IF LIST-COUNT(N) > LIST-LENGTH(N)
MOVE 1 TO LIST-COUNT(N) GO TO VP1.
MOVE 0 TO N.
PERFORM ITERATE.
$X2.
. ADD 1 TO N.
8 IF N NOT > SKLN GO TO X4.
B MOVE 0 TO N.
LX3.
V ADD 1 TO N.
` IF LIST-TYPE(N) NOT = "I" GO TO X3.
j ADD 1 TO LIST-COUNT(N).
t GO TO VP2.
~X4.
MOVE SKL(N) TO TLINE.
PERFORM SENDING-ITEM-SET-UP VARYING I FROM 1 BY 1 UNTIL I > 20.
MOVE 0 TO I.
& MOVE 1 TO P.
0X5.
: ADD 1 TO I.
D UNSTRING TLINE DELIMITED BY "%" OR "!" OR "@" OR "#"
N INTO SENDING-ITEM (I)
X DELIMITER IN DEL COUNT IN K WITH POINTER P.
b IF P = 65 GO TO X25.
l ADD 1 TO K.
v STRING "\" DELIMITED BY SIZE
INTO SENDING-ITEM (I) WITH POINTER K.
ADD 1 TO I.
IF DEL = "#" GO TO X20.
IF DEL = "@" GO TO X15.
( IF DEL = "!" GO TO X10.
2 IF DEL = "%" GO TO X8.
< DISPLAY "?X5" STOP RUN.
FX8.
P UNSTRING TLINE INTO DIGIT WITH POINTER P.
Z MOVE LIST-COUNT(DIGIT) TO LIST-ENTRY.
d SUBTRACT 1 FROM LIST-ENTRY.
n ADD LIST-START(DIGIT) TO LIST-ENTRY.
x MOVE TNAME (LIST-ENTRY) TO SENDING-ITEM (I).
GO TO X5.
X10.
UNSTRING TLINE INTO DIGIT DIGIT2
WITH POINTER P.
* MOVE LIST-COUNT(DIGIT2) TO LIST-ENTRY.
4 SUBTRACT 1 FROM LIST-ENTRY.
> ADD LIST-START(DIGIT) TO LIST-ENTRY.
H MOVE TNAME(LIST-ENTRY) TO SENDING-ITEM (I).
R GO TO X5.
\X15.
f MOVE EDITED-ITERATION TO SENDING-ITEM5CHARS (I).
p GO TO X5.
zX20.
PERFORM STEPUP.
MOVE EDITED-STEP TO SENDING-ITEM5CHARS (I).
GO TO X5.
"X25.
, STRING
6 SENDING-ITEM (1)
@ SENDING-ITEM (2)
J SENDING-ITEM (3)
T SENDING-ITEM (4)
^ SENDING-ITEM (5)
h SENDING-ITEM (6)
r SENDING-ITEM (7)
| SENDING-ITEM (8)
SENDING-ITEM (9)
SENDING-ITEM (10)
SENDING-ITEM (11)
$ SENDING-ITEM (12)
. SENDING-ITEM (13)
8 SENDING-ITEM (14)
B SENDING-ITEM (15)
L SENDING-ITEM (16)
V SENDING-ITEM (17)
` SENDING-ITEM (18)
j SENDING-ITEM (19)
t SENDING-ITEM (20)
~ DELIMITED BY "\" INTO TLINE.
WRITE OUTLINE FROM TLINE BEFORE ADVANCING 1 LINE.
ADD 1 TO LINECOUNT.
GO TO X2.
&XEXIT.
0 WRITE OUTLINE FROM ENDLINE BEFORE ADVANCING 1 LINE.
: ADD 1 TO LINECOUNT.
D CLOSE OUTFILE.
N DISPLAY LINECOUNT " LINES GENERATED.".
X*+ THE FOLLOWING GO TO AND PARAGRAPH NAME ARE ADDED TO AVOID
b* THE ":" FUNCTION.
l GO TO P0.
vRS0.
*- END OF CHANGE.
MOVE OUTFILENAME TO INFILENAME.
MOVE "CBL" TO OFEXT.
OPEN INPUT INFILE.
( OPEN OUTPUT OUTFILE.
2RS1.
< READ INFILE INTO OUTLINE AT END GO TO X9.
F MOVE 1 TO P.
P IF REPLACESWITCH NOT = "1" GO TO TABOUT.
Z UNSTRING OUTLINE DELIMITED BY ":"
d INTO CHARS1 WITH POINTER P.
n IF CHAR11 = "*" GO TO TABOUT.
x IF P = 65 GO TO TABOUT.
SUBTRACT 1 FROM P GIVING N.
STRING "\" DELIMITED BY SIZE
INTO CHARS1 WITH POINTER N.
UNSTRING OUTLINE INTO CHARS2 WITH POINTER P.
* DISPLAY OUTLINE.
4 ACCEPT TEMPNAME.
> STRING CHARS1 DELIMITED BY "\"
H TEMPNAME DELIMITED BY SPACE
R CHARS2 DELIMITED BY SIZE INTO OUTLINE.
\TABOUT.
f* IT SEEMS THAT THERE IS NO REAL NEED TO REMOVE TABS,
p* SO THE FOLLOWING STATEMENT SKIPS THE TABOUT CODE.
z GO TO TB3.
TB0.
MOVE SPACES TO TEMPNAME.
MOVE 1 TO P.
" UNSTRING OUTLINE DELIMITED BY TAB
, INTO CHARS1 WITH POINTER P.
6 IF P > 64 GO TO TB3.
@ SUBTRACT 1 FROM P GIVING N.
J STRING "\" DELIMITED BY SIZE
T INTO CHARS1 WITH POINTER N.
^ MOVE P TO N.
h UNSTRING OUTLINE INTO CHARS2 WITH POINTER N.
r IF P < 5 SUBTRACT P FROM 7 GIVING P GO TO TB1.
| IF P < 13 SUBTRACT P FROM 15 GIVING P GO TO TB1.
IF P < 21 SUBTRACT P FROM 23 GIVING P GO TO TB1.
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.
8 IF P < 61 SUBTRACT P FROM 63 GIVING P GO TO TB1.
B IF P < 65 SUBTRACT P FROM 67 GIVING P GO TO TB1.
LTB1.
V STRING "\" DELIMITED BY SIZE
` INTO TEMPNAME WITH POINTER P.
j STRING CHARS1 TEMPNAME DELIMITED BY "\"
t CHARS2 DELIMITED BY SIZE INTO OUTLINE.
~ GO TO TABOUT.
TB3.
WRITE OUTLINE BEFORE ADVANCING 1 LINE.
GO TO RS1.
&X9.
0 CLOSE INFILE WITH DELETE.
: CLOSE OUTFILE.
D GO TO P0.
NITERATE.
X ADD 1 TO ITERATION.
b MOVE ITERATION TO RIGHT-EDIT.
l UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
v INTO JUNK EDITED-ITERATION.
INSPECT EDITED-ITERATION REPLACING ALL SPACE BY "\".
STEPUP.
ADD 1 TO STEP.
MOVE STEP TO RIGHT-EDIT.
( UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
2 INTO JUNK EDITED-STEP.
< INSPECT EDITED-STEP REPLACING ALL SPACE BY "\".
FSENDING-ITEM-SET-UP.
P MOVE "\ " TO SENDING-ITEM5CHARS (I).
* 20 NOV 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 "..K/F".
@ 08 CHR23.
J 09 CHR2 PIC X.
T 09 FILLER PIC X.
^ 08 FILLER PIC X(4).
h 07 FILLER PIC X(61).
rFD OUTFILE VALUE OF ID IS OUTFILENAME.
|1 OUTREC DISPLAY-7 PIC X(82).
WORKING-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.
81 CURRENTLINE PIC S9(10) COMP.
B1 RESPONSE PIC X.
L 88 NOPE VALUE "N".
V 88 LEGALRESPONSE VALUE "N" "Y".
`1 INFILENAME.
j 3 FILENAME PIC X(6).
t 3 FILLER PIC XXX VALUE "LOG".
~1 OUTFILENAME.
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.
0PROCEDURE DIVISION.
:P1.
D DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
N ACCEPT RESPONSE.
X IF NOT LEGALRESPONSE
b DISPLAY "TYPE ONLY 'Y' OR 'N'"
l GO TO P1.
v DISPLAY "NAMES OF .LOG FILES: ".
ACCEPT FILENAMESTRING.
MOVE 1 TO PTR.
P2.
UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
( INTO FILENAME WITH POINTER PTR.
2 IF FILENAME = SPACE GO TO P1.
< MOVE FILENAME TO OUTNAME.
F MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
P MOVE 10000 TO ENDMARK.
Z IF NOPE GO TO P4.
d
n* DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
x
OPEN INPUT INFILE.
P3.
READ INFILE AT END GO TO P3C.
IF MONTR PERFORM 20-TO-10.
* ADD 1 TO CURRENTLINE.
4 IF MONTR AND CHR2 = "."
> NEXT SENTENCE ELSE GO TO P3A.
H IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
R GO TO P3.
\* IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
f* WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
p IF BATCH OR CHRS2TO7 = "..ST" OR ".ST" OR "." GO TO P3.
z MOVE CURRENTLINE TO MONTRMARK.
GO TO P3.
P3A.
IF TABTABQUESTION GO TO P3B.
" IF USER AND CHR1 = "?"
, GO TO P3B.
6 IF MONTR AND CHR2 = "?"
@ GO TO P3B.
J GO TO P3.
TP3B.
^ IF STARTMARK = 0
h MOVE MONTRMARK TO STARTMARK.
r MOVE CURRENTLINE TO QUESTIONMARK.
| GO TO P3.
P3C.
MOVE MONTRMARK TO ENDMARK.
MOVE 0 TO CURRENTLINE.
$ CLOSE INFILE.
. IF STARTMARK = 0
8 DISPLAY "NO ?'S FOUND IN " FILENAME
B GO TO P2.
LP4.
V OPEN INPUT INFILE.
` OPEN OUTPUT OUTFILE.
jP5.
t READ INFILE AT END GO TO P95.
~ ADD 1 TO CURRENTLINE.
IF NOT JOBLINE GO TO P5.
IF CURRENTLINE < STARTMARK GO TO P10.
IF CURRENTLINE > ENDMARK GO TO P99.
& MOVE "\\" TO TABS.
0 WRITE OUTREC FROM INREC.
:P10.
D READ INFILE AT END GO TO P99.
N ADD 1 TO CURRENTLINE
X IF CURRENTLINE < STARTMARK GO TO P10.
b IF CURRENTLINE > ENDMARK GO TO P99.
l IF KJOB GO TO P99.
v IF TABTAB
MOVE "\\" TO TABS
WRITE OUTREC FROM INREC
GO TO P10.
IF MONTR AND CHRS2TO7 NOT = SPACE
( PERFORM 20-TO-10
2 WRITE OUTREC FROM MONTRLINE GO TO P10.
< IF USER AND USERLINE NOT = SPACE
F WRITE OUTREC FROM USERLINE GO TO P10.
P GO TO P10.
ZP95. DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
dP99. CLOSE INFILE OUTFILE.
n DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.
x20-TO-10.
IF CHR1 = "@" MOVE "." TO CHR1.
IF CHR2 = "@" MOVE "." TO CHR2.
IF CHR23 = ".@" MOVE ".." TO CHR23.
ID DIVISION.
PROGRAM-ID. RR74DL.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z SELECT RANE ASSIGN TO DSK
d ORGANIZATION IS RELATIVE
n ACCESS IS RANDOM
x RELATIVE KEY IS RANKEY
RECORDING MODE IS ASCII.
SELECT RAN1 ASSIGN TO DSK
ORGANIZATION IS RELATIVE
* ACCESS IS RANDOM
4 RELATIVE KEY IS RNKEY1
> RECORDING MODE IS ASCII.
H
R SELECT RAN2 ASSIGN TO DSK
\ ORGANIZATION IS RELATIVE
f ACCESS IS RANDOM
p RELATIVE KEY IS RNKEY2
z RECORDING MODE IS ASCII.
SELECT ISM ASSIGN TO DSK
ORGANIZATION IS INDEXED
" ACCESS MODE IS RANDOM
, RECORD KEY IS RKEY
6 RECORDING MODE IS ASCII.
@
J SELECT RANSQ ASSIGN TO DSK
T RECORDING MODE IS ASCII.
^
hDATA DIVISION.
rFILE SECTION.
|FD RANE
VALUE OF ID IS "RANFILDAT"
LABEL RECORD IS STANDARD.
01 RANREC PIC X(10).
$
.FD RAN1
8 VALUE OF ID IS "RANFL1DAT"
B LABEL RECORD IS STANDARD.
L01 RNREC1 PIC X(10).
V
`FD RAN2
j VALUE OF ID IS "RANFL2DAT"
t LABEL RECORD IS STANDARD.
~01 RNREC2 PIC X(10).
FD ISM
VALUE OF ID IS "ISMDATIDX"
& BLOCK 2 RECORDS
0 LABEL RECORD IS STANDARD.
:01 ISMREC .
D 02 REC2 PIC X(10).
N 02 RKEY PIC X(5).
X
bFD RANSQ
l VALUE OF ID IS "RANSQ DAT"
v BLOCK CONTAINS 5 RECORDS
LABEL RECORD STANDARD.
01 RECC.
02 RECC1 PIC X(10).
02 RECC2 PIC X(90).
(
2WORKING-STORAGE SECTION.
<01 END-COUNT PIC S9(10) VALUE 0000000041.
F01 CHK-COUNT PIC S9(10) VALUE 0000000001.
P77 REC-CNT PIC S9(10) COMP VALUE IS 22.
Z77 REC-CN1 PIC S9(10) COMP VALUE IS 22.
d77 REC-CN2 PIC S9(10) COMP VALUE IS 22.
n77 REC-CN3 PIC S9(10) COMP VALUE IS 22.
x77 REC-SQ PIC S9(10) COMP VALUE IS 22.
77 RANKEY PIC 9(10).
77 RNKEY1 PIC 9(10).
77 RNKEY2 PIC 9(10).
PROCEDURE DIVISION.
* OPEN I-O RANSQ.
4
> PERFORM SEQINI THRU SEQINIX.
H PERFORM WRTSEQ THRU WRTSEQX 19 TIMES.
R
\ OPEN I-O RANE.
f
p PERFORM WRTFIL 19 TIMES.
z
OPEN I-O RAN1.
PERFORM WRTFL1 19 TIMES.
"
, OPEN I-O RAN2.
6
@ PERFORM WRTFL2 19 TIMES.
J
T OPEN I-O ISM.
^
h PERFORM WRTISM 19 TIMES.
r
|
$
. GO TO DONE.
8
B
LWRTFIL.
V MOVE REC-CNT TO RANKEY.
` DELETE RANE, INVALID KEY GO TO WRT-ER.
j ADD 1 TO REC-CNT.
t
~WRTFL1.
MOVE REC-CN1 TO RNKEY1.
DELETE RAN1, INVALID KEY GO TO WRT-ER.
ADD 1 TO REC-CN1.
&
0WRTFL2.
: MOVE REC-CN2 TO RNKEY2
D DELETE RAN2, INVALID KEY GO TO WRT-ER.
N ADD 1 TO REC-CN2.
X
bWRTISM.
l MOVE REC-CN3 TO RKEY.
v DELETE ISM, INVALID KEY GO TO WRT-ER.
ADD 1 TO REC-CN3.
WRTSEQ.
READ RANSQ, AT END GO TO WRTSEQX.
( MOVE 0000000000 TO RECC1.
2 REWRITE RECC.
< ADD 1 TO REC-SQ.
FWRTSEQX.
P
ZSEQINI.
d MOVE 1 TO REC-SQ.
nINI-LP.
x READ RANSQ, AT END
DISPLAY "??ERROR READ SEQ INIT AT END RECORD ",REC-SQ
GO TO DONE.
ADD 1 TO REC-SQ.
IF REC-SQ < 22 GO TO INI-LP.
*
4SEQINIX.
>
H
R
\
f
p
zRDER.
DISPLAY "???READ ERROR, KEY = ",RANKEY,RNKEY1,RNKEY2,RKEY.
GO TO DONE.
"
,WRT-ER.
6 DISPLAY "???WRT-LOOP ERROR ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.
@
JDONE.
T
^ CLOSE RANE,RAN1,RAN2,ISM,RANSQ.
h
r STOP RUN.
ID DIVISION.
PROGRAM-ID. RR74RD.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z SELECT RANE ASSIGN TO DSK
d ORGANIZATION IS RELATIVE
n ACCESS IS RANDOM
x RELATIVE KEY IS RANKEY
RECORDING MODE IS ASCII.
SELECT RAN1 ASSIGN TO DSK
ORGANIZATION IS RELATIVE
* ACCESS IS RANDOM
4 RELATIVE KEY IS RNKEY1
> RECORDING MODE IS ASCII.
H
R SELECT RAN2 ASSIGN TO DSK
\ ORGANIZATION IS RELATIVE
f ACCESS IS RANDOM
p RELATIVE KEY IS RNKEY2
z RECORDING MODE IS ASCII.
SELECT ISM ASSIGN TO DSK
ORGANIZATION IS INDEXED
" ACCESS MODE IS RANDOM
, RECORD KEY IS RKEY
6 RECORDING MODE IS ASCII.
@
J SELECT RANSQ ASSIGN TO DSK
T RECORDING MODE IS ASCII.
^
hDATA DIVISION.
rFILE SECTION.
|FD RANE
VALUE OF ID IS "RANFILDAT"
LABEL RECORD IS STANDARD.
01 RANREC PIC X(10).
$
.FD RAN1
8 VALUE OF ID IS "RANFL1DAT"
B LABEL RECORD IS STANDARD.
L01 RNREC1 PIC X(10).
V
`FD RAN2
j VALUE OF ID IS "RANFL2DAT"
t LABEL RECORD IS STANDARD.
~01 RNREC2 PIC X(10).
FD ISM
VALUE OF ID IS "ISMDATIDX"
& BLOCK 2 RECORDS
0 LABEL RECORD IS STANDARD.
:01 ISMREC .
D 02 REC2 PIC X(10).
N 02 RKEY PIC X(5).
X
bFD RANSQ
l VALUE OF ID IS "RANSQ DAT"
v BLOCK CONTAINS 5 RECORDS
LABEL RECORD STANDARD.
01 RECC.
02 RECC1 PIC X(10).
02 RECC2 PIC X(90).
(
2WORKING-STORAGE SECTION.
<01 ERR PIC S9(10) COMP VALUE 0.
F 88 ALL-OK VALUE 0.
P01 END-COUNT PIC S9(10) VALUE 0000000041.
Z01 CHK-COUNT PIC S9(10) VALUE 0000000001.
d77 REC-CNT PIC S9(10) COMP VALUE IS 1.
n77 REC-CN1 PIC S9(10) COMP VALUE IS 1.
x77 REC-CN2 PIC S9(10) COMP VALUE IS 1.
77 REC-CN3 PIC S9(10) COMP VALUE IS 1.
77 REC-SQ PIC S9(10) COMP VALUE IS 1.
77 RANKEY PIC 9(10).
77 RNKEY1 PIC 9(10).
*77 RNKEY2 PIC 9(10).
4PROCEDURE DIVISION.
>
H OPEN INPUT RANE,RAN1,RAN2,ISM,RANSQ.
R
\ MOVE 00001 TO RANKEY,RNKEY1,RNKEY2,CHK-COUNT,RKEY.
f READ RANE, INVALID KEY GO TO RDER.
p READ RAN1, INVALID KEY GO TO RDER.
z READ RAN2, INVALID KEY GO TO RDER.
READ ISM, INVALID KEY GO TO RDER.
READ RANSQ, AT END GO TO RDER.
" PERFORM READ-CHECK.
,
6* DISPLAY RANKEY," KEY ",RANREC, " REC AFTER READ".
@* DISPLAY RNKEY1," KEY ",RNREC1, " REC AFTER READ".
J* DISPLAY RNKEY2," KEY ",RNREC2, " REC AFTER READ".
T* DISPLAY RKEY," KEY ",REC2, " REC AFTER READ".
^* DISPLAY RKEY," KEY ",RECC1, " REC AFTER READ".
h
rRD-LPP.
| ADD 1 TO CHK-COUNT.
READ RAN1 NEXT, AT END
PERFORM END-CHECK
$ GO TO RD21.
.RD21.
8 READ RAN2 NEXT, AT END
B PERFORM END-CHECK
L GO TO RD23.
VRD23.
` READ RANE NEXT, AT END
j PERFORM END-CHECK
t GO TO RD24.
~RD24.
READ ISM NEXT, AT END
PERFORM END-CHECK
GO TO RD25.
&RD25.
0 READ RANSQ, AT END GO TO RD22.
:
D* DISPLAY "......".
N*
X* DISPLAY "RD NEXT ",RANREC," KEY ",RANKEY.
b* DISPLAY "RD NEXT ",RNREC1," KEY ",RNKEY1.
l* DISPLAY "RD NEXT ",RNREC2," KEY ",RNKEY2.
v* DISPLAY "RD NEXT ",REC2," KEY ",RKEY.
* DISPLAY "RD NEXT ",RECC1," KEY ",RKEY.
PERFORM READ-CHECK.
( GO TO RD-LPP.
2RD22.
<
F PERFORM END-CHECK.
P IF ALL-OK
Z DISPLAY "ALL CHECKED AND FOUND OK.".
d GO TO DONE.
n
x
READ-CHECK.
*
4 IF CHK-COUNT NOT = RANREC OR
> RANREC NOT = RNREC1 OR
H RNREC1 NOT = RNREC2 OR
R RNREC2 NOT = REC2 OR
\ REC2 NOT = RECC1
f
p ADD 1 TO ERR
z DISPLAY
"???ERROR READING FILES AT RECORD NUMBER ",CHK-COUNT.
END-CHECK.
"
, IF CHK-COUNT NOT = END-COUNT
6 ADD 1 TO ERR
@ DISPLAY "???ERROR AT READ END RECORD NUMBER ",CHK-COUNT.
J
T
^
h
rRDER.
| DISPLAY "???READ ERROR, KEY = ",RANKEY,RNKEY1,RNKEY2,RKEY.
O TO DONE.
.
PLAY "???WRT-LOOP ERROR ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.
RANE,RAN1,RAN2,ISM,RANSQ.
RUN.
ID DIVISION.
PROGRAM-ID. RR74WT.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z SELECT RANE ASSIGN TO DSK
d ORGANIZATION IS RELATIVE
n ACCESS IS RANDOM
x RELATIVE KEY IS RANKEY
RECORDING MODE IS ASCII.
SELECT RAN1 ASSIGN TO DSK
ORGANIZATION IS RELATIVE
* ACCESS IS RANDOM
4 RELATIVE KEY IS RNKEY1
> RECORDING MODE IS ASCII.
H
R SELECT RAN2 ASSIGN TO DSK
\ ORGANIZATION IS RELATIVE
f ACCESS IS RANDOM
p RELATIVE KEY IS RNKEY2
z RECORDING MODE IS ASCII.
SELECT ISM ASSIGN TO DSK
ORGANIZATION IS INDEXED
" ACCESS MODE IS RANDOM
, RECORD KEY IS RKEY
6 RECORDING MODE IS ASCII.
@
J SELECT RANSQ ASSIGN TO DSK
T RECORDING MODE IS ASCII.
^
hI-O-CONTROL.
r RERUN EVERY 21 RECORDS OF RANE.
| RERUN EVERY 21 RECORDS OF RAN1.
RERUN EVERY 21 RECORDS OF RANSQ.
RERUN EVERY 21 RECORDS OF ISM.
DATA DIVISION.
$FILE SECTION.
.FD RANE
8 VALUE OF ID IS "RANFILDAT"
B LABEL RECORD IS STANDARD.
L01 RANREC PIC X(10).
V
`FD RAN1
j VALUE OF ID IS "RANFL1DAT"
t LABEL RECORD IS STANDARD.
~01 RNREC1 PIC X(10).
FD RAN2
VALUE OF ID IS "RANFL2DAT"
& LABEL RECORD IS STANDARD.
001 RNREC2 PIC X(10).
:
DFD ISM
N VALUE OF ID IS "ISMDATIDX"
X BLOCK 2 RECORDS
b LABEL RECORD IS STANDARD.
l01 ISMREC .
v 02 REC2 PIC X(10).
02 RKEY PIC X(5).
FD RANSQ
VALUE OF ID IS "RANSQ DAT"
( BLOCK CONTAINS 5 RECORDS
2 LABEL RECORD STANDARD.
<01 RECC.
F 02 RECC1 PIC X(10).
P 02 RECC2 PIC X(90).
Z
dWORKING-STORAGE SECTION.
n01 END-COUNT PIC S9(10) VALUE 0000000041.
x01 CHK-COUNT PIC S9(10) VALUE 0000000001.
77 REC-CNT PIC S9(10) COMP VALUE IS 1.
77 REC-CN1 PIC S9(10) COMP VALUE IS 1.
77 REC-CN2 PIC S9(10) COMP VALUE IS 1.
77 REC-CN3 PIC S9(10) COMP VALUE IS 1.
*77 REC-SQ PIC S9(10) COMP VALUE IS 1.
477 RANKEY PIC 9(10).
>77 RNKEY1 PIC 9(10).
H77 RNKEY2 PIC 9(10).
RPROCEDURE DIVISION.
\ OPEN OUTPUT RANE.
f
p PERFORM WRTFIL 20 TIMES.
z
OPEN OUTPUT RAN1.
PERFORM WRTFL1 20 TIMES.
"
, OPEN OUTPUT RAN2.
6
@ PERFORM WRTFL2 20 TIMES.
J
T OPEN OUTPUT ISM.
^
h PERFORM WRTISM 20 TIMES.
r
| OPEN OUTPUT RANSQ.
PERFORM WRTSEQ 20 TIMES.
$ DISPLAY " NOW RERUNING ,ALL OPEN".
.
8
B PERFORM WRTFILS 20 TIMES.
L
V
`
j
t GO TO DONE.
~
WRTFILS.
PERFORM WRTFIL.
& PERFORM WRTFL1.
0 PERFORM WRTFL2.
: PERFORM WRTISM.
D PERFORM WRTSEQ.
N
X
b
lWRTFIL.
v MOVE REC-CNT TO RANKEY,RANREC.
WRITE RANREC, INVALID KEY GO TO WRT-ER.
ADD 1 TO REC-CNT.
WRTFL1.
( MOVE REC-CN1 TO RNKEY1,RNREC1.
2 WRITE RNREC1, INVALID KEY GO TO WRT-ER.
< ADD 1 TO REC-CN1.
F
PWRTFL2.
Z MOVE REC-CN2 TO RNKEY2,RNREC2.
d WRITE RNREC2, INVALID KEY GO TO WRT-ER.
n ADD 1 TO REC-CN2.
x
WRTISM.
MOVE REC-CN3 TO RKEY,REC2.
WRITE ISMREC, INVALID KEY GO TO WRT-ER.
ADD 1 TO REC-CN3.
*
4WRTSEQ.
> MOVE REC-SQ TO RECC1.
H WRITE RECC.
R ADD 1 TO REC-SQ.
\
f
p
zWRT-ER.
DISPLAY "???WRT-LOOP ERROR ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.
DONE.
"
, CLOSE RANE,RAN1,RAN2,ISM,RANSQ.
6
@ STOP RUN.
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 <Size to set file(s) to: >
J MOVX T1,.PRIIN
T MOVEI T3,^D10
^ NIN
h ERMSG
r MOVEM T2,FILSIZ#
| TMSG <File(s) to set: >
MOVX T1,GJ%OLD!GJ%FNS!GJ%SHT!GJ%CFM!GJ%IFG
SETO T2,
GTJFN
$ ERMSG
. MOVEM T1,JFN#
8
BFILOOP: HRLI T1,12
L SETO T2,
V MOVE T3,FILSIZ
` CHFDB
j ERMSG
t MOVE T1,JFN
~ GNJFN
JRST DONE
JRST FILOOP
&DONE: TMSG <
0All done!
:>
D HALTF
N JRST SETEOF
X
b
l
v 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 XXXXX DISPLAY-7 VALUE ";$JOB".
0****************************************** /\
:* CHANGED $JOB TO ;$JOB ON APRIL 14 1980 * ||
D* TO REFLECT NEW REQUIREMENTS OF BATCON *----------++
N* PWK *
X******************************************
b1 NOERRORLINE PIC X(8) DISPLAY-7 VALUE "@NOERROR".
l1 10-NOERRORLINE PIC X(8) DISPLAY-7 VALUE ".NOERROR".
v1 DEFLINE PIC X(20) DISPLAY-7 VALUE "@DEF SYS: DSK:,SYS:".
1 10-SETSRCLINE PIC X(9) DISPLAY-7 VALUE ".R SETSRC".
1 10-SYSLINE PIC XXXX DISPLAY-7 VALUE "*SYS".
1 10-ASSIGNLINE PIC X(12) DISPLAY-7 VALUE ".ASS DSK SYS".
1 EXELINE PIC X(9) DISPLAY-7 VALUE "@RU SETUP".
(1 10-EXELINE PIC X(9) DISPLAY-7 VALUE ".RU SETUP".
21 SYSTEMLINE DISPLAY-7.
< 3 FILLER PIC X VALUE "*".
F 3 SYSTEMCHARS PIC XX VALUE "10".
P 88 TOPS-10 VALUE "10".
Z 88 LEGALSYSTEM VALUE "10" "20".
d1 RLINE PIC XX DISPLAY-7 VALUE "*C".
n1 EXPUNGELINE PIC X(5) DISPLAY-7 VALUE "@EXPU".
x1 IDLINE PIC X(32) DISPLAY-7 VALUE '@INFORMATION (ABOUT) DISK-USAGE'.
1 ILLINE PIC X(34) DISPLAY-7 VALUE '@INFORMATION (ABOUT) LOGICAL-NAMES'.
1 LIBARYLINE PIC X(7) DISPLAY-7 VALUE "@LIBARY".
1 10-LIBARYLINE PIC X(9) DISPLAY-7 VALUE ".R LIBARY".
1 LOGOUTLINE PIC X(7) DISPLAY-7 VALUE "@LOGOUT".
*1 KFLINE PIC XXXX DISPLAY-7 VALUE ".K/F".
41 MASTER-LINE DISPLAY-7.
> 02 FILLER PIC X(2) VALUE '*='.
H 02 MASTER-NAME.
R 03 MASTER-SUBSYS-ID PIC X(3).
\ 03 MASTER-MACHINE-ID PIC X(3) VALUE 'MAS'.
f1 SUBSTITUTE-LINE DISPLAY-7.
p 02 FILLER PIC X(2) VALUE '*='.
z 02 SUBSTITUTE-NAME.
04 SUBSYS-ID PIC X(3).
04 HOST-MACHINE-ID PIC X(3).
1 SUBSYS-LINE DISPLAY-7.
" 03 FILLER PIC X VALUE '*'.
, 03 PUT-SUBSYS PIC X(3).
61 IN-LIBARYNAMELINE DISPLAY-7.
@ 3 FILLER PIC XX VALUE "*=".
J 3 IN-LIBARYNAME.
T 5 IN-SUBSYS PIC X(3).
^ 88 QUITTING VALUE 'QIT'.
h 5 FILLER PIC X(3) VALUE 'COM'.
r1 OUT-LIBARYNAMELINE DISPLAY-7.
| 3 FILLER PIC XX VALUE "*=".
3 OUT-LIBARYNAME.
5 OUT-SUBSYS PIC X(3).
5 OUT-HOSTID PIC X(3).
$1 ENDLINE PIC XXXX DISPLAY-7 VALUE "*END".
.1 NAMEHOLD2 PIC X(10) DISPLAY-7.
81 NAMEHOLD DISPLAY-7.
B 3 FILLER PIC X(6).
L 3 LASTFEWCHARS PIC XXXX.
V1 OLDNAMEHOLD PIC X(10) DISPLAY-7.
`1 ON-A-LINE-FLAG PIC S9 COMP VALUE ZERO.
j 88 LINE-LIMIT VALUE 7.
t 88 LINE-EMPTY VALUE ZERO.
~1 LIBARYOPERATION PIC X(9) DISPLAY-7.
1 NAMEEXTENSION PIC XXXX DISPLAY-7.
1 ERROREXIT PIC 9 VALUE 0.
1 HOLD-CTL-NAMES PIC X(66) DISPLAY-7.
&1 IDENTIFY-LIB-FLAG PIC S9 COMP VALUE ZERO.
0 88 IN-LIB VALUE 1.
:1 DELOUTLIB-LINE DISPLAY-7.
D 3 DELOUT-HOST-CHAR PIC X VALUE '@'.
N 3 SYS-CMD PIC X(4).
X 3 FILLER PIC X VALUE SPACE.
b 3 NAME-SLOT-1 PIC X(6) JUSTIFIED RIGHT.
l 3 FILLER PIC X(4) VALUE '.LIB'.
v 3 ARG-DELIMITER PIC X VALUE SPACE.
3 NAME-SLOT-2 PIC X(6) JUSTIFIED RIGHT.
3 FILLER PIC X(5) VALUE '.LIB '.
1 HOST-LINE DISPLAY-7.
02 FILLER PIC X VALUE "*".
( 02 HOST-CHARACTER PIC X.
2 88 HOST-10 VALUE ".".
< 88 HOST-20 VALUE "@".
F1 COMMENT-CHARACTER PIC X VALUE "!".
P1 SYS-COMMENT PIC X(6) DISPLAY-7 VALUE "! *SYS".
Z1 CHARS-XFRD-COUNT PIC S99 COMP VALUE ZERO.
d1 NAME-SUB PIC S99 COMP VALUE ZERO.
n 88 NAME-LIMIT VALUE 99.
x1 CONTROLFILE-NAMES-TABLE.
03 NAME-HOLD PIC X(9) OCCURS 99 TIMES.
1 ALT-NAMES-TABLE.
03 ALT-NAME-HOLD PIC X(9) OCCURS 99 TIMES.
1 NAME-TEMP.
* 02 N-T-3 PIC X(3).
4 88 MASTR-CTL VALUE 'MAS'.
> 02 FILLER PIC X(6).
H1 TERM PIC X(5).
R1 CM-NAME-TEMP PIC X(9).
\1 DEL-CTL-LINE DISPLAY-7.
f 3 DEL-CTL-HOST-CHAR PIC X VALUE '@'.
p 3 FILLER PIC X(4) VALUE 'DELE'.
z 3 FILLER PIC X VALUE SPACE.
3 DEL-CTL-RIGHT PIC X(66).
1 COMMENT-OPTION-FLAG PIC S9 COMP VALUE ZERO.
88 WANT-EXTRA-COMMENTS VALUE 1.
"
,
6
@
J1 MAILERLINE DISPLAY-7.
T 02 MAILSTAR PIC X VALUE '*'.
^ 02 MAILLINE PIC X(5) VALUE '@MAIL'.
h 02 MAILEX PIC X(2) VALUE 'ER'.
r1 MAILSUBJECT DISPLAY-7 PIC X(24) VALUE '* CONVERSION JOB IS DONE'.
|1 MAILTERM DISPLAY-7.
02 FILLER PIC XX VALUE "*".
PROCEDURE DIVISION.
MAIN SECTION.
$START1.
. DISPLAY "CONVERT TO [10] OR [20]? " WITH NO ADVANCING
8 ACCEPT SYSTEMCHARS.
B IF NOT LEGALSYSTEM
L DISPLAY "INPUT '10' OR '20'"
V GO TO START1.
` IF TOPS-10
j MOVE '010' TO OUT-HOSTID
t MOVE '.' TO HOST-CHARACTER,
~ DELOUT-HOST-CHAR,
DEL-CTL-HOST-CHAR
ELSE MOVE '@' TO HOST-CHARACTER
MOVE '020' TO OUT-HOSTID.
&
0
:GET-MODE.
D DISPLAY "[I]NITIATE OR [C]ONVERT MODE? " WITH NO ADVANCING
N ACCEPT FILENAMESTRING.
X IF FILENAMESTRING = "I" GO TO CTL-INIT.
b IF FILENAMESTRING = "C" GO TO PART2.
l DISPLAY "REPLY WITH 'I' OR 'C'".
v GO TO GET-MODE.
CTL-INIT.
DISPLAY "NAME OUTPUT CONTROL FILE " WITH NO ADVANCING
ACCEPT CTLFILENAMEONLY.
( OPEN OUTPUT CTLFILE.
2
< WRITE CTL05 FROM JOBLINE.
F IF TOPS-10
P WRITE CTL08 FROM 10-NOERRORLINE
Z WRITE CTL09 FROM 10-SETSRCLINE
d WRITE CTL04 FROM 10-SYSLINE
n WRITE CTL12 FROM 10-ASSIGNLINE
x GO TO NEXTLIBS.
WRITE CTL08 FROM NOERRORLINE.
WRITE CTL20 FROM DEFLINE.
NEXTLIBS.
* DISPLAY "NAME THE SUBSYSTEM " WITH NO ADVANCING
4 ACCEPT IN-SUBSYS.
> IF QUITTING GO TO WINDUP.
H MOVE IN-SUBSYS TO OUT-SUBSYS, MASTER-SUBSYS-ID.
R
\
fOPEN-UP.
p MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
z OPEN INPUT DCYFILE.
MOVE SPACES TO NAME-SLOT-2.
MOVE OUT-LIBARYNAME TO NAME-SLOT-1.
" MOVE "DELE" TO SYS-CMD.
, WRITE CTL16 FROM DELOUTLIB-LINE.
6
@ IF TOPS-10
J MOVE '=' TO ARG-DELIMITER
T MOVE OUT-LIBARYNAME TO NAME-SLOT-1
^ MOVE IN-LIBARYNAME TO NAME-SLOT-2
h ELSE
r MOVE IN-LIBARYNAME TO NAME-SLOT-1
| MOVE OUT-LIBARYNAME TO NAME-SLOT-2.
MOVE "COPY" TO SYS-CMD.
WRITE CTL28 FROM DELOUTLIB-LINE.
MOVE SPACE TO ARG-DELIMITER.
$ PERFORM STACK-CONTROLFILE-NAMES.
.
8LIB-EXTRACT.
B MOVE "*EXTRACT" TO LIBARYOPERATION.
L MOVE ".XTT" TO NAMEEXTENSION.
V MOVE 0 TO ERROREXIT.
` SET IDENTIFY-LIB-FLAG TO 1.
j PERFORM LIBARYCOMMAND.
t SET IDENTIFY-LIB-FLAG TO ZERO.
~ IF ERROREXIT = 1
CLOSE CTLFILE
STOP RUN.
&
0MOD-EXE.
: IF TOPS-10
D WRITE CTL09 FROM 10-EXELINE
N ELSE
X WRITE CTL09 FROM EXELINE.
b WRITE CTL03 FROM SYSTEMLINE.
l WRITE CTL02 FROM RLINE.
v
MOVE IN-SUBSYS TO PUT-SUBSYS.
WRITE CTL04 FROM SUBSYS-LINE.
LIB-REPLACE.
MOVE "*REPLACE" TO LIBARYOPERATION.
( MOVE ".CTL" TO NAMEEXTENSION.
2 PERFORM LIBARYCOMMAND.
< WRITE CTL04 FROM ENDLINE.
F
P
ZDELETE-AND-EXPUNGE.
d PERFORM DELETE-CTLS.
n
x IF NOT TOPS-10 WRITE CTL05 FROM EXPUNGELINE.
GO-BACK.
* CLOSE DCYFILE
4 GO TO NEXTLIBS.
>
H
RWINDUP.
\ IF TOPS-10
f WRITE CTL04 FROM KFLINE
p ELSE
z WRITE CTL05 FROM MAILLINE
WRITE CTL08 FROM MAILERLINE
WRITE CTL01 FROM MAILSTAR
WRITE CTL24 FROM MAILSUBJECT
" WRITE CTL02 FROM MAILTERM
, WRITE CTL07 FROM LOGOUTLINE.
6 CLOSE CTLFILE .
@
J DISPLAY "END OF SETUP INITIATE SESSION".
T STOP RUN.
^DELETE-CTLS SECTION.
hDC-INIT.
r SET PTR TO 1.
| SET NAME-SUB TO 1.
!
!DC-LINE-START.
! MOVE SPACES TO HOLD-CTL-NAMES, DEL-CTL-RIGHT.
!$ SET ON-A-LINE-FLAG TO ZERO.
!.
!8DC-LOOP.
!B MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
!L IF NAME-TEMP EQUALS SPACES GO TO DC-EXIT.
!V IF MASTR-CTL GO TO DC-L1.
!` IF NAME-TEMP EQUALS MASTER-NAME
!j MOVE '.XTT,' TO TERM
!t ELSE
!~ MOVE '.*,' TO TERM.
"
" STRING NAME-TEMP TERM
" DELIMITED BY SPACE
"& INTO HOLD-CTL-NAMES
"0 WITH POINTER PTR.
": SET ON-A-LINE-FLAG UP BY 1.
"D IF NAME-LIMIT GO TO DC-EXIT.
"NDC-L1.
"X SET NAME-SUB UP BY 1.
"b IF LINE-LIMIT GO TO DC-PUT.
"l
"v GO TO DC-LOOP.
#
#
DC-PUT.
# PERFORM SPECIAL-PUT.
# GO TO DC-LINE-START.
#(
#2DC-EXIT.
#< IF NOT LINE-EMPTY
#F PERFORM SPECIAL-PUT.
#P
#Z
#dSPECIAL-PUT SECTION.
#n STRING HOLD-CTL-NAMES
#x DELIMITED BY ', '
$ INTO DEL-CTL-RIGHT.
$
SET PTR TO 1.
$ WRITE CTLREC FROM DEL-CTL-LINE.
$ STACK-CONTROLFILE-NAMES SECTION.
$*SCN-START.
$4 MOVE SPACES TO CONTROLFILE-NAMES-TABLE.
$> MOVE SPACES TO ALT-NAMES-TABLE.
$H SET NAME-SUB TO 1.
$R
$\
$fGET-NEXT-NAME.
$p READ DCYFILE
$z AT END
% GO TO SCN-EXIT.
%
% MOVE 1 TO PTR.
%" UNSTRING DCYREC INTO NAME-TEMP WITH POINTER PTR.
%, MOVE 1 TO PTR.
%6 UNSTRING NAME-TEMP DELIMITED BY 'CM '
%@ INTO CM-NAME-TEMP WITH POINTER PTR.
%J IF NAME-TEMP EQUALS CM-NAME-TEMP
%T GO TO GET-NEXT-NAME.
%^
%h
%r MOVE NAME-TEMP TO NAME-HOLD (NAME-SUB).
%| MOVE CM-NAME-TEMP TO ALT-NAME-HOLD (NAME-SUB).
&
& IF NAME-LIMIT
& DISPLAY "NAME LIMIT EXCEEDED"
&$ GO TO SCN-EXIT.
&. SET NAME-SUB UP BY 1.
&8 GO TO GET-NEXT-NAME.
&B
&L
&VSCN-EXIT.
&` EXIT.
&j
&t
&~
'LIBARYCOMMAND SECTION.
'P0.
' IF TOPS-10 WRITE CTL09 FROM 10-LIBARYLINE
'& ELSE
'0 WRITE CTL07 FROM LIBARYLINE.
': IF IN-LIB
'D WRITE CTL08 FROM IN-LIBARYNAMELINE
'N ELSE
'X WRITE CTL08 FROM OUT-LIBARYNAMELINE.
'b MOVE SPACE TO OLDNAMEHOLD.
'l SET NAME-SUB TO 1.
'v
( NEXT-CTL.
(
MOVE ALT-NAME-HOLD (NAME-SUB) TO NAMEHOLD.
( IF NAMEHOLD = SPACE GO TO LIB-EXIT.
( MOVE 1 TO STRINGPTR.
(( MOVE SPACES TO CTLREC.
(2 MOVE NAME-HOLD (NAME-SUB) TO NAMEHOLD2.
(< MOVE SPACES TO LASTFEWCHARS OF NAMEHOLD.
(F STRING LIBARYOPERATION
(P " "
(Z NAMEHOLD2
(d ","
(n NAMEHOLD
(x NAMEEXTENSION DELIMITED BY " "
) INTO CTLREC WITH POINTER STRINGPTR.
)
WRITE CTL30.
) IF NAME-LIMIT
) GO TO LIB-EXIT.
)* SET NAME-SUB UP BY 1.
)4 GO TO NEXT-CTL.
)>
)H
)RLIB-EXIT.
)\ EXIT.
)f
)pPART2 SECTION.
)zSTART-RUNMODE.
* DISPLAY "NAME THE SUBSYSTEM " WITH NO ADVANCING
* ACCEPT IN-SUBSYS.
* MOVE IN-SUBSYS TO MASTER-SUBSYS-ID, OUT-SUBSYS.
*" MOVE 'COM' TO MASTER-MACHINE-ID.
*,
*6
*@ MOVE OUT-LIBARYNAME TO SUBSTITUTE-NAME.
*J MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
*T OPEN INPUT DCYFILE.
*^ PERFORM STACK-CONTROLFILE-NAMES.
*h CLOSE DCYFILE.
*r SET NAME-SUB TO 1.
*|
+
+INIT-FILES.
+ MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
+$ UNSTRING NAME-TEMP DELIMITED BY SPACE
+. INTO FILENAMEIN.
+8 IF FILENAMEIN = SPACE GO TO LEAVE.
+B MOVE FILENAMEIN TO FILENAMEOUT.
+L
+V OPEN INPUT INFILE.
+` OPEN OUTPUT OUTFILE.
+j
+tGET-NEXT.
+~ READ INFILE AT END GO TO CTT-EXHAUST.
,
,
, SUBSTITUTE-FIRST.
,& IF LIBID-LINE AND INREC EQUALS MASTER-LINE
,0 WRITE OUTREC08 FROM SUBSTITUTE-LINE
,: GO TO GET-NEXT.
,D
,N IF HOST-20 AND DEFDSK
,X WRITE OUTREC32 FROM IDLINE
,b WRITE OUTREC34 FROM ILLINE.
,l IF HOST-20 AND 20-LOGOUT WRITE OUTREC32 FROM IDLINE.
,v IF RSETSRC PERFORM HANDLE-SETSRC
- GO TO GET-NEXT.
-
IF FOR-BOTH MOVE HOST-CHARACTER TO FIRSTCHAR
- GO TO MOV-REC.
- IF NOT FOR-10 AND NOT FOR-20 GO TO MOV-REC.
-( IF FOR-10 AND HOST-10 GO TO MOV-REC.
-2 IF FOR-20 AND HOST-20 GO TO MOV-REC.
-<
-F*
-P* FUNCTIONALITY HERE TO INCLUDE COMMANDS SPECIFIC TO THE
-Z* ALTERNATE SYSTEM AS COMMENT LINES. THIS MAY BE ENABLED
-d* BY SETTING THE DEFAULT VALUE OF COMMENT-OPTION-FLAG TO 1.
-n*
-x IF WANT-EXTRA-COMMENTS
. MOVE COMMENT-CHARACTER TO FIRSTCHAR
.
ELSE
. GO TO GET-NEXT.
.
.*
.4
.>MOV-REC.
.H MOVE INREC TO OUTREC.
.RWRITE-REC.
.\ IF O4 (8) = SPACE
.f IF O4 (4) = SPACE
.p IF O4 (2) = SPACE
.z MOVE 1 TO I GO TO P70
/ ELSE
/ IF O4 (3) = SPACE
/ MOVE 5 TO I GO TO P70
/" ELSE
/, MOVE 9 TO I GO TO P70
/6 ELSE
/@ IF O4 (6) = SPACE
/J IF O4 (5) = SPACE
/T MOVE 13 TO I GO TO P70
/^ ELSE
/h MOVE 17 TO I GO TO P70
/r ELSE
/| IF O4 (7) = SPACE
0 MOVE 21 TO I GO TO P70
0 ELSE
0 MOVE 25 TO I GO TO P70
0$ ELSE
0. IF O4 (12) = SPACE
08 IF O4 (10) = SPACE
0B IF O4 (9) = SPACE
0L MOVE 29 TO I GO TO P70
0V ELSE
0` MOVE 33 TO I GO TO P70
0j ELSE
0t IF O4 (11) = SPACE
0~ MOVE 37 TO I GO TO P70
1 ELSE
1 MOVE 41 TO I GO TO P70
1 ELSE
1& IF O4 (14) = SPACE
10 IF O4 (13) = SPACE
1: MOVE 45 TO I GO TO P70
1D ELSE
1N MOVE 49 TO I GO TO P70
1X ELSE
1b IF O4 (15) = SPACE
1l MOVE 53 TO I GO TO P70
1v ELSE
2 MOVE 57 TO I GO TO P70.
2
IF O4 (16) NOT = SPACES MOVE 61 TO I.
2
2 P70.
2( IF O1 (I + 3) = SPACE
22 IF O1 (I + 2) = SPACE
2< IF O1 (I + 1) = SPACE
2F NEXT SENTENCE
2P ELSE ADD 1 TO I
2Z ELSE ADD 2 TO I
2d ELSE ADD 3 TO I.
2n GO TO
2x P70-01
3 P70-02
3
P70-03
3 P70-04
3 P70-05
3* P70-06
34 P70-07
3> P70-08
3H P70-09
3R P70-10
3\ P70-11
3f P70-12
3p P70-13
3z P70-14
4 P70-15
4 P70-16
4 P70-17
4" P70-18
4, P70-19
46 P70-20
4@ P70-21
4J P70-22
4T P70-23
4^ P70-24
4h P70-25
4r P70-26
4| P70-27
5 P70-28
5 P70-29
5 P70-30
5$ P70-31
5. P70-32
58 P70-33
5B P70-34
5L P70-35
5V P70-36
5` P70-37
5j P70-38
5t P70-39
5~ P70-40
6 P70-41
6 P70-42
6 P70-43
6& P70-44
60 P70-45
6: P70-46
6D P70-47
6N P70-48
6X P70-49
6b P70-50
6l P70-51
6v P70-52
7 P70-53
7
P70-54
7 P70-55
7 P70-56
7( P70-57
72 P70-58
7< P70-59
7F P70-60
7P P70-61
7Z P70-62
7d P70-63
7n P70-64
7x DEPENDING ON I.
8 DISPLAY "? SOMETHING WRONG WITH THE BINARY TREE " I.
8
STOP RUN.
8P70-01. WRITE OUTREC01. GO TO GET-NEXT.
8 P70-02. WRITE OUTREC02. GO TO GET-NEXT.
8*P70-03. WRITE OUTREC03. GO TO GET-NEXT.
84P70-04. WRITE OUTREC04. GO TO GET-NEXT.
8>P70-05. WRITE OUTREC05. GO TO GET-NEXT.
8HP70-06. WRITE OUTREC06. GO TO GET-NEXT.
8RP70-07. WRITE OUTREC07. GO TO GET-NEXT.
8\P70-08. WRITE OUTREC08. GO TO GET-NEXT.
8fP70-09. WRITE OUTREC09. GO TO GET-NEXT.
8pP70-10. WRITE OUTREC10. GO TO GET-NEXT.
8zP70-11. WRITE OUTREC11. GO TO GET-NEXT.
9P70-12. WRITE OUTREC12. GO TO GET-NEXT.
9P70-13. WRITE OUTREC13. GO TO GET-NEXT.
9P70-14. WRITE OUTREC14. GO TO GET-NEXT.
9"P70-15. WRITE OUTREC15. GO TO GET-NEXT.
9,P70-16. WRITE OUTREC16. GO TO GET-NEXT.
96P70-17. WRITE OUTREC17. GO TO GET-NEXT.
9@P70-18. WRITE OUTREC18. GO TO GET-NEXT.
9JP70-19. WRITE OUTREC19. GO TO GET-NEXT.
9TP70-20. WRITE OUTREC20. GO TO GET-NEXT.
9^P70-21. WRITE OUTREC21. GO TO GET-NEXT.
9hP70-22. WRITE OUTREC22. GO TO GET-NEXT.
9rP70-23. WRITE OUTREC23. GO TO GET-NEXT.
9|P70-24. WRITE OUTREC24. GO TO GET-NEXT.
:P70-25. WRITE OUTREC25. GO TO GET-NEXT.
:P70-26. WRITE OUTREC26. GO TO GET-NEXT.
:P70-27. WRITE OUTREC27. GO TO GET-NEXT.
:$P70-28. WRITE OUTREC28. GO TO GET-NEXT.
:.P70-29. WRITE OUTREC29. GO TO GET-NEXT.
:8P70-30. WRITE OUTREC30. GO TO GET-NEXT.
:BP70-31. WRITE OUTREC31. GO TO GET-NEXT.
:LP70-32. WRITE OUTREC32. GO TO GET-NEXT.
:VP70-33. WRITE OUTREC33. GO TO GET-NEXT.
:`P70-34. WRITE OUTREC34. GO TO GET-NEXT.
:jP70-35. WRITE OUTREC35. GO TO GET-NEXT.
:tP70-36. WRITE OUTREC36. GO TO GET-NEXT.
:~P70-37. WRITE OUTREC37. GO TO GET-NEXT.
;P70-38. WRITE OUTREC38. GO TO GET-NEXT.
;P70-39. WRITE OUTREC39. GO TO GET-NEXT.
; P70-40. WRITE OUTREC40. GO TO GET-NEXT.
;&P70-41. WRITE OUTREC41. GO TO GET-NEXT.
;0P70-42. WRITE OUTREC42. GO TO GET-NEXT.
;:P70-43. WRITE OUTREC43. GO TO GET-NEXT.
;DP70-44. WRITE OUTREC44. GO TO GET-NEXT.
;NP70-45. WRITE OUTREC45. GO TO GET-NEXT.
;XP70-46. WRITE OUTREC46. GO TO GET-NEXT.
;bP70-47. WRITE OUTREC47. GO TO GET-NEXT.
;lP70-48. WRITE OUTREC48. GO TO GET-NEXT.
;vP70-49. WRITE OUTREC49. GO TO GET-NEXT.
< P70-50. WRITE OUTREC50. GO TO GET-NEXT.
<
P70-51. WRITE OUTREC51. GO TO GET-NEXT.
<P70-52. WRITE OUTREC52. GO TO GET-NEXT.
< P70-53. WRITE OUTREC53. GO TO GET-NEXT.
<(P70-54. WRITE OUTREC54. GO TO GET-NEXT.
<2P70-55. WRITE OUTREC55. GO TO GET-NEXT.
<<P70-56. WRITE OUTREC56. GO TO GET-NEXT.
<FP70-57. WRITE OUTREC57. GO TO GET-NEXT.
<PP70-58. WRITE OUTREC58. GO TO GET-NEXT.
<ZP70-59. WRITE OUTREC59. GO TO GET-NEXT.
<dP70-60. WRITE OUTREC60. GO TO GET-NEXT.
<nP70-61. WRITE OUTREC61. GO TO GET-NEXT.
<xP70-62. WRITE OUTREC62. GO TO GET-NEXT.
=P70-63. WRITE OUTREC63. GO TO GET-NEXT.
=
P70-64. WRITE OUTREC64. GO TO GET-NEXT.
=
=
=*CTT-EXHAUST.
=4 CLOSE INFILE OUTFILE
=> IF NOT NAME-LIMIT SET NAME-SUB UP BY 1
=H GO TO INIT-FILES.
=RLEAVE.
=\ DISPLAY "END SETUP CONVERT SESSION"
=f STOP RUN.
=p
=z
>
>
>HANDLE-SETSRC SECTION.
>" IF HOST-20
>, MOVE COMMENT-CHARACTER TO FIRSTCHAR.
>6 WRITE OUTREC FROM INREC.
>@
>J
>TGET-STAR-SYS.
>^ READ INFILE AT END
>h DISPLAY "UNEXPECTED END ON SETSRC LINE"
>r STOP RUN.
>| IF NOT STAR-SYS
? DISPLAY "NO *SYS AFTER .R SETSRC"
? STOP RUN.
?
?$
?.PUT-STAR-SYS.
?8 IF HOST-20
?B WRITE OUTREC06 FROM SYS-COMMENT
?L ELSE
?V WRITE OUTREC06 FROM INREC.
?`
?j
?t
* 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.