Google
 

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