Trailing-Edge
-
PDP-10 Archives
-
decuslib20-09
-
decus/20-34/recut.for
There are 3 other files named recut.for in the archive. Click here to see a list.
C RENBR(RECUT/SPLITS OR MERGES RENBR SOURCE FILES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS PROGRAM SPLITS UP A COMPOSITE SOURCE FILE OF RENBR
C OR PRODUCES SUCH A COMPOSITE FILE FROM SMALL FILES.
C THE END STATEMENTS MUST IN COLUMN FORMAT AND HAVE THE
C WORD END IN COLUMNS 7, 8 AND 9.
C
CHARACTER*1 LTRBFR(72),LTREND(9),LTRSPA,LTRNOW
CHARACTER*10 FILNAM(24),FILINP,FILOUT
DIMENSION MAXSUB(24)
C
C MAXLOG = NUMBER OF SMALL FILES CONTAINING LOGIC
C MAXFIL = NUMBER OF ALL SMALL FILES. THESE CONTAIN EITHER
C LOGIC, OR USER INTERACTION OR MACHINE SPECIFIC CODE.
C FILNAM = NAMES OF THE OUTPUT FILES
C MAXSUB = NUMBER OF SUBROUTINES IN EACH OUTPUT FILE
C THIS IS PARALLEL TO NAMES IN FILNAM ARRAY
DATA MAXLOG,MAXFIL/16,24/
DATA FILNAM/
1 'BLOCK.FOR ','REMAIN.FOR','RESET.FOR ','RECHCK.FOR',
2 'RE1ST.FOR ','RE2ND.FOR ','REPLAC.FOR','REOUT.FOR ',
3 'REDONE.FOR','RENUMB.FOR','REINDX.FOR','RECMND.FOR',
4 'RETITL.FOR','RENEXT.FOR','RETOP.FOR ','DASORT.FOR',
5 'REUSR1.FOR','RETMP1.FOR','REUSR2.FOR','REUSR3.FOR',
6 'REUSR4.FOR','REUSR5.FOR','RETMP5.FOR','REUSR6.FOR'/
DATA MAXSUB/
1 1,1,1,1,
2 1,1,1,1,
3 1,1,1,1,
4 1,1,1,1,
5 6,3,1,1,
6 8,6,3,1/
C
C MAXEND = NUMBER OF CHARACTERS TO MATCH IN END STATEMENT
C LTREND = CHARACTERS OF END STATEMENT
DATA MAXEND/9/
DATA LTREND/' ',' ',' ',' ',' ',' ','E','N','D'/
C
C LTRSPA = THE SPACE CHARACTER
DATA LTRSPA/' '/
C
C IDISK = INPUT UNIT
C JDISK = OUTPUT UNIT
DATA IDISK,JDISK/1,20/
C
C TELL USER WHAT PROGRAM THIS IS
TYPE 1
1 FORMAT(' RECUT'/
1' SPLITS OR MERGES RENBR SOURCE FILES'/)
C
C ASK IF MERGE OR SPLIT OPERATION
2 TYPE 3
3 FORMAT(' MERGE OR SPLIT FILES (M OR S)? ',$)
ACCEPT 4,LTRNOW
4 FORMAT(1A1)
ISPLIT=0
IF(LTRNOW.EQ.'S')ISPLIT=1
IF(LTRNOW.EQ.'s')ISPLIT=1
IF(LTRNOW.EQ.'M')ISPLIT=2
IF(LTRNOW.EQ.'m')ISPLIT=2
IF(ISPLIT.NE.0)GO TO 6
TYPE 5
5 FORMAT(' TYPE'/
1' M TO MERGE SMALL FILES INTO 1 LARGE FILE'/
2' S TO SPLIT LARGE FILE INTO SMALL FILES')
GO TO 2
6 CONTINUE
C
C ASK USER WHICH TYPE OF FILES ARE TO BE MERGED
7 TYPE 8
8 FORMAT(' PROCESS ALL SOURCES OR LOGIC ONLY (A OR L)? ',$)
ACCEPT 9,LTRNOW
9 FORMAT(1A1)
MAXMRG=0
IF(LTRNOW.EQ.'A')MAXMRG=MAXFIL
IF(LTRNOW.EQ.'a')MAXMRG=MAXFIL
IF(LTRNOW.EQ.'L')MAXMRG=MAXLOG
IF(LTRNOW.EQ.'l')MAXMRG=MAXLOG
IF(MAXMRG.NE.0)GO TO 11
TYPE 10
10 FORMAT(' TYPE'/
1' A TO PROCESS ALL SOURCES'/
2' L TO PROCESS ONLY SOURCES CONTAINING LOGIC')
GO TO 7
11 CONTINUE
C
C TRANSFER ACCORDING TO IF MERGING OR SPLITTING
IF(ISPLIT.EQ.2)GO TO 34
C
C **********************
C * *
C * SPLIT LARGE FILE *
C * *
C **********************
C
C OPEN INPUT FILE
12 TYPE 13
13 FORMAT(' NAME OF INPUT FILE? ',$)
ACCEPT 14,FILINP
14 FORMAT(1A10)
OPEN(UNIT=IDISK,FILE=FILINP,ACCESS='SEQIN',ERR=15)
GO TO 17
15 TYPE 16
16 FORMAT(' CANNOT OPEN INPUT FILE')
GO TO 12
17 CONTINUE
C
C READ LARGE FILE
KNTFIL=0
IFSHOW=1
18 READ(IDISK,19,END=31)LTRBFR
19 FORMAT(72A1)
MAXBFR=72
20 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 21
MAXBFR=MAXBFR-1
IF(MAXBFR.GT.1)GO TO 20
21 CONTINUE
C
C CHECK IF MUST OPEN A NEW OUTPUT FILE FOR THIS LINE
IF(KNTFIL.EQ.0)GO TO 22
IF(KNTSUB.LT.MAXSUB(KNTFIL))GO TO 24
22 KNTSUB=0
KNTFIL=KNTFIL+1
FILOUT=FILNAM(KNTFIL)
OPEN(UNIT=JDISK,FILE=FILOUT,ACCESS='SEQOUT',ERR=28)
TYPE 23,FILOUT
23 FORMAT(' FILE: ',1A10)
24 IF(IFSHOW.NE.0)TYPE 25,(LTRBFR(I),I=1,MAXBFR)
25 FORMAT(1X,72A1)
WRITE(JDISK,26)(LTRBFR(I),I=1,MAXBFR)
26 FORMAT(72A1)
IFSHOW=0
C
C CHECK IF THIS IS AN END LINE
IF(MAXBFR.NE.MAXEND)GO TO 18
DO 27 INDEX=1,MAXEND
IF(LTRBFR(INDEX).NE.LTREND(INDEX))GO TO 18
27 CONTINUE
IFSHOW=1
KNTSUB=KNTSUB+1
IF(KNTSUB.LT.MAXSUB(KNTFIL))GO TO 18
CLOSE(UNIT=JDISK)
IF(KNTFIL.LT.MAXMRG)GO TO 18
GO TO 31
C
C ERROR MESSAGES
28 TYPE 29,FILOUT
29 FORMAT(' CANNOT OPEN OUTPUT FILE ',1A10)
TYPE 30
30 FORMAT(' RUN TERMINATED')
31 IF(KNTFIL.LT.MAXMRG)TYPE 32,KNTFIL,MAXMRG
32 FORMAT(' ONLY',I3,' OF',I3,' OUTPUT FILES WERE WRITTEN')
IF(KNTSUB.LT.MAXSUB(KNTFIL))TYPE 33,KNTSUB,MAXSUB(KNTFIL)
33 FORMAT(' ONLY',I3,' OF',I3,' SUBROUTINES WERE IN FINAL FILE')
IF(KNTSUB.LT.MAXSUB(KNTFIL))CLOSE(UNIT=JDISK)
GO TO 51
C
C ***********************
C * *
C * MERGE SMALL FILES *
C * *
C ***********************
C
C OPEN OUTPUT FILE
34 TYPE 35
35 FORMAT(' NAME OF OUTPUT FILE? ',$)
ACCEPT 36,FILOUT
36 FORMAT(1A10)
OPEN(UNIT=JDISK,FILE=FILOUT,ACCESS='SEQOUT',ERR=37)
GO TO 39
37 TYPE 38
38 FORMAT(' CANNOT OPEN OUTPUT FILE')
GO TO 34
39 CONTINUE
C
C OPEN SMALL COMPONENT FILES
KNTFIL=0
40 KNTFIL=KNTFIL+1
FILINP=FILNAM(KNTFIL)
OPEN(UNIT=IDISK,FILE=FILINP,ACCESS='SEQIN',ERR=47)
TYPE 23,FILINP
IFSHOW=1
KNTSUB=0
C
C READ AND COPY NEXT LINE OF INPUT FILE
41 READ(IDISK,19,END=45)LTRBFR
MAXBFR=72
42 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 43
MAXBFR=MAXBFR-1
IF(MAXBFR.GT.1)GO TO 42
43 IF(IFSHOW.NE.0)TYPE 25,(LTRBFR(I),I=1,MAXBFR)
WRITE(JDISK,26)(LTRBFR(I),I=1,MAXBFR)
IFSHOW=0
C
C CHECK IF THIS IS AN END LINE
IF(MAXBFR.NE.MAXEND)GO TO 41
DO 44 INDEX=1,MAXEND
IF(LTRBFR(INDEX).NE.LTREND(INDEX))GO TO 41
44 CONTINUE
IFSHOW=1
KNTSUB=KNTSUB+1
IF(KNTSUB.LT.MAXSUB(KNTFIL))GO TO 41
CLOSE(UNIT=IDISK)
IF(KNTFIL.LT.MAXMRG)GO TO 40
GO TO 50
C
C ERROR MESSAGES
45 TYPE 46,KNTSUB,MAXSUB(KNTFIL)
46 FORMAT(' INPUT FILE CONTAINS ONLY',I3,' OF',I3,' ROUTINES')
GO TO 49
47 TYPE 48,FILINP
48 FORMAT(' CANNOT OPEN INPUT FILE ',1A10)
49 TYPE 30
50 CLOSE(UNIT=JDISK)
GO TO 51
51 STOP
END