Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0169/lbld10.for
There is 1 other file named lbld10.for in the archive. Click here to see a list.
      SUBROUTINE FILOPN(ISTORE,IDISK ,ITTY  ,JTTY  ,IWRITE,
     1IFOPEN)
C     RENBR(/USER SPECIFICATION OF DECSYSTEM10/20 FILE)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine reads a file name typed by the user, and
C     attempts  to open the file.  The routine does not ask
C     the user for the file name.  The routine  reports  to
C     the calling program whether the file could be opened.
C     If the  file  cannot  be  opened,  then  the  calling
C     program  should  ask  the user to type the file name,
C     then call this routine again.
C
C     This version of  this  routine  is  written  for  the
C     DECsystem10,  or for the DECsystem20 using the TOPS10
C     emulator.  The file names which can be  processed  by
C     this routine must consist of 1 to 6 letters or digits
C     optionally followed by a period and then by up  to  3
C     letters or digits.
C
C
C     ISTORE = number assigned by the main program  to  all
C              of  the  files having a particular function.
C              ISTORE identifies where in the FILSTR  array
C              the  name  of  the file is stored so that it
C              can be used by other routines.
C     IDISK  = number of the unit from which the file is to
C              be  read  or  to  which  the  file  is to be
C              written.  This is the number  which  appears
C              first in the READ or WRITE statements.
C     ITTY   = number of the unit to which messages  to  be
C              seen by the user are to be written.
C     JTTY   = number of the unit from which the file names
C              typed  by the user on the terminal are to be
C              read.
C     IWRITE = determines whether file is opened to be read
C              or to be written.
C            = 0, open the file for reading.
C            = 1, open the file for writing.
C     IFOPEN = returned describing whether the  file  could
C              be opened.  The input value is ignored.
C            = -1,  returned  if  the  file  could  not  be
C              opened.   The  calling  program should issue
C              the prompt again and then call this  program
C              again.
C            = 0, returned if the user did  not  specify  a
C              file name.  The user just pressed the RETURN
C              key.
C            = 1,  returned  if   the   file   was   opened
C              successfully.
C
      COMMON/FILSTR/FILSTR(6)
      DOUBLE PRECISION FILNAM,FILSTR
      DIMENSION LTRFIL(20),LTRABC(26),LWRABC(26),LTRDGT(10)
C
C     LMTFIL = DIMENSION OF LTRFIL ARRAY.  MAXIMUM NUMBER OF
C              CHARACTERS, INCLUDING SPACES AND TABS, WHICH
C              CAN BE TYPED BY USER IN A FILE NAME.
C
      DATA LMTFIL/20/
C
C     LTRSPA = THE SPACE CHARACTER
C     LTRTAB = THE TAB CHARACTER.  SET TO SPACE IF THE
C              COMPUTER SYSTEM DOES NOT HAVE TAB CHARACTER
C     LTRDOT = THE PERIOD CHARACTER
C     LTRABC = UPPER CASE ALPHABETIC LETTERS A THROUGH Z
C     LWRABC = LOWER CASE ALPHABETIC LETTERS A THROUGH Z
C     LTRDGT = DIGITS ZERO THROUGH NINE
C
      DATA LTRSPA/1H /
      DATA LTRTAB/"045004020100/
      DATA LTRDOT/1H./
      DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
     2 1HX,1HY,1HZ/
      DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
     2 1Hx,1Hy,1Hz/
      DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     READ FILE NAME
      READ(JTTY,1,END=18)LTRFIL
    1 FORMAT(20A1)
C
C     REMOVE NON-PRINTING CHARACTERS FROM FILE NAME
      MAXFIL=0
      DO 2 I=1,LMTFIL
      IF(LTRFIL(I).EQ.LTRSPA)GO TO 2
      IF(LTRFIL(I).EQ.LTRTAB)GO TO 2
      MAXFIL=MAXFIL+1
      IF(MAXFIL.EQ.I)GO TO 2
      LTRFIL(MAXFIL)=LTRFIL(I)
      LTRFIL(I)=LTRSPA
    2 CONTINUE
      IF(MAXFIL.LE.0)GO TO 21
C
C     CHECK FOR ILLEGAL CHARACTER IN FILE NAME
      LOCDOT=0
      DO 6 I=1,MAXFIL
      LTRNOW=LTRFIL(I)
      IF(LTRNOW.EQ.LTRDOT)GO TO 5
      DO 3 J=1,26
      IF(LTRNOW.EQ.LTRABC(J))GO TO 6
      IF(LTRNOW.EQ.LWRABC(J))GO TO 6
    3 CONTINUE
      DO 4 J=1,10
      IF(LTRNOW.EQ.LTRDGT(J))GO TO 6
    4 CONTINUE
      GO TO 16
    5 IF(LOCDOT.GT.0)GO TO 16
      LOCDOT=I
    6 CONTINUE
C
C     CHECK LOCATION OF DOT
      IF(LOCDOT.GT.0)GO TO 7
      IF(MAXFIL.GT.6)GO TO 16
      GO TO 8
    7 IF(LOCDOT.EQ.1)GO TO 16
      IF(LOCDOT.GT.7)GO TO 16
      IF((MAXFIL-LOCDOT).GT.3)GO TO 16
    8 CONTINUE
C
C     CONVERT FROM A1 TO A10 FORM
      IF(LOCDOT.GT.0)GO TO 10
      ENCODE(10,9,FILNAM)(LTRFIL(I),I=1,6)
    9 FORMAT(6A1,4H.   )
      GO TO 12
   10 ENCODE(10,11,FILNAM)(LTRFIL(I),I=1,10)
   11 FORMAT(10A1)
C
C     OPEN FILE FOR OUTPUT, CREATING NEW FILE
   12 IF(IWRITE.EQ.0)GO TO 13
      OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='SEQOUT',ERR=14)
      GO TO 22
C
C     OPEN FILE FOR INPUT, READING OLD FILE
   13 OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='SEQIN',ERR=14)
      GO TO 22
C
C     ERROR MESSAGES
   14 WRITE(ITTY,15)
   15 FORMAT(' File cannot be opened'/1X)
      GO TO 20
   16 WRITE(ITTY,17)
   17 FORMAT(
     1' File name must be 1 to 6 letters or digits, optionally'/
     2' followed by a period and then 0 to 3 letters or digits.')
      GO TO 20
C
C     CONTROL-Z TYPED ON TERMINAL
   18 CLOSE(UNIT=JTTY)
      WRITE(ITTY,19)
   19 FORMAT(
     11X/' END-OF-FILE read from terminal but file name expected'/1X)
C
C     RETURN TO CALLING PROGRAM
   20 IFOPEN=-1
      GO TO 23
   21 IFOPEN=0
      GO TO 23
   22 IFOPEN=1
      IF(ISTORE.LE.0)GO TO 23
      FILSTR(ISTORE)=FILNAM
   23 RETURN
      END
      SUBROUTINE FILNXT(ISTORE,IDISK,ITTY,KNTFIL,IPRGRM)
C     RENBR(/OPEN NEXT UNUSED FILE IN SEQUENCE LABELS.NNN)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     Too many labels  might  be  produced  by  the  LABELS
C     program  to fit into a single output file.  The files
C     are given names based upon a serial number  which  is
C     increased  each  time  that  this  routine is called.
C     This routine opens the  next  output  file  to  which
C     these  labels  are to be written.  The routine checks
C     to see if the file already exists.  If  it  does  not
C     exist,  then it is used for producing the new labels.
C     If it already exists, then the next serial number  is
C     tried instead.
C
C     This version of  this  routine  is  written  for  the
C     DECsystem10,  or for the DECsystem20 using the TOPS10
C     emulator.  The file names produced  by  this  routine
C     have  the  form  LABELS.nnn  where nnn represents a 3
C     digit serial number ranging from 001 through 999.
C
C
C     ISTORE = number assigned by the main program  to  all
C              of  the  files having a particular function.
C              This  has  no  relationship  to  the  KNTFIL
C              argument,  which  counts the number of files
C              having names based upon a particular  naming
C              scheme.   ISTORE  identifies  where  in  the
C              FILSTR array the name of the file is  to  be
C              stored  so  that  it  can  be  used by other
C              routines.
C     IDISK  = number of the unit to which the file  is  to
C              be   written.   This  is  the  number  which
C              appears first in the WRITE statements.
C     ITTY   = number of the unit to which messages  to  be
C              seen by the user are to be written.
C     KNTFIL = serial number of the previous file which was
C              written by  the current run of  the program.
C              This is  the number  used to  construct  the
C              name of the previous file in the sequence.
C            = 0, input if this is the first time that this
C              routine has been called.
C            = returned containing the serial number of the
C              new file.
C            = 0, returned if no file could be opened.
C     IPRGRM = identifies which program called this routine
C              and which stem is used for file names
C            = 1, called by LABELS program.
C            = 2, called by ENVELO program.
C
      COMMON/FILSTR/FILSTR(6)
      DOUBLE PRECISION FILNAM,FILSTR,FILNOW,FILSTM(2)
      DATA FILSTM/'LABELS    ','ENVELO    '/
C
C     CONSTRUCT NEXT NAME IN SEQUENCE
      FILNOW=FILSTM(IPRGRM)
    1 KNTFIL=KNTFIL+1
      IF(KNTFIL.GE.1000)GO TO 10
      IF(KNTFIL.GE.100)GO TO 5
      IF(KNTFIL.GE.10)GO TO 3
      IF(KNTFIL.LE.0)KNTFIL=1
      ENCODE(10,2,FILNAM)FILNOW,KNTFIL
    2 FORMAT(1A6,'.00',1I1)
      GO TO 7
    3 ENCODE(10,4,FILNAM)FILNOW,KNTFIL
    4 FORMAT(1A6,'.0',1I2)
      GO TO 7
    5 ENCODE(10,6,FILNAM)FILNOW,KNTFIL
    6 FORMAT(1A6,'.',1I3)
    7 OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='SEQIN',ERR=8)
      CLOSE(UNIT=IDISK)
      GOTO 1
C
C     OPEN UNUSED NAME AS AN OUTPUT FILE
    8 OPEN(UNIT=IDISK,ACCESS='SEQOUT',FILE=FILNAM,ERR=1)
      WRITE(ITTY,9)KNTFIL,FILNAM
    9 FORMAT(' Output file number',1I4,' is named ',1A10)
      FILSTR(ISTORE)=FILNAM
      GO TO 11
C
C     ALL SEQUENCE NUMBERS 1 THROUGH 999 IN USE
   10 KNTFIL=0
C
C     RETURN TO CALLING PROGRAM
   11 RETURN
      END
      SUBROUTINE FILOLD(ISTORE,IDISK ,ITTY  ,IFOPEN)
C     RENBR(/REOPEN FILE SPECIFIED BEFORE BY USER)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine reopens an input file earlier  specified
C     by  the  user.   Each  file which must be opened more
C     than once is assigned  a  number  when  it  is  first
C     opened.   This routine uses that number to locate the
C     file name in the storage of all of the file names.
C
C     This version of  this  routine  is  written  for  the
C     DECsystem10,  or for the DECsystem20 using the TOPS10
C     emulator.
C
C
C     ISTORE = number assigned by the main program  to  all
C              of  the  files having a particular function.
C              ISTORE identifies where in the FILSTR  array
C              the  name  of  the file is stored so that it
C              can be used by other routines.
C     IDISK  = number of the unit from which the file is to
C              be  read.   This is the number which appears
C              first in the READ statements.
C     ITTY   = number of the unit to which messages  to  be
C              seen by the user are to be written.
C     IFOPEN = returned describing whether the  file  could
C              be opened.  The input value is ignored.
C            = -1,  returned  if  the  file  could  not  be
C              opened.
C            = 1,  returned  if   the   file   was   opened
C              successfully.
C
      COMMON/FILSTR/FILSTR(6)
      DOUBLE PRECISION FILNAM,FILSTR
C
C     GET FILE NAME
      FILNAM=FILSTR(ISTORE)
C
C     OPEN FILE FOR INPUT
      OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='SEQIN',ERR=1)
      GO TO 4
C
C     ERROR MESSAGES
    1 WRITE(ITTY,2)
    2 FORMAT(' File cannot be reopened'/1X)
      GO TO 3
C
C     RETURN TO CALLING PROGRAM
    3 IFOPEN=-1
      GO TO 5
    4 IFOPEN=1
    5 RETURN
      END
      SUBROUTINE FILCUT(ISTORE,IDISK)
C     RENBR(/INSURE THAT LABELS SO FAR ARE IN OUTPUT FILE)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine insures that the labels written  to  the
C     output  file  will actually be found in the file even
C     if  the  program  is  terminated   abnormally   while
C     processing  a  subsequent  input  file.  The calls to
C     this routine  can  be  removed  without  hurting  the
C     functionality  of  the  program.   The routine is not
C     necessary if the program which  calls  it  terminates
C     normally.
C
C     This version of  this  routine  is  written  for  the
C     DECsystem10,  or for the DECsystem20 using the TOPS10
C     emulator.  The routine closes the file  so  that  any
C     labels  which  might  be  in  the  output  buffer are
C     written to the file, then reopens the file in  append
C     mode  so  that  any  additional labels which might be
C     written to the file are appended to the  end,  rather
C     than replacing those just written.
C
C
C     ISTORE = number assigned to  the  file  by  the  main
C              program  when it called either the FILOPN or
C              FILNXT  routine  to  open  the  file.   This
C              number  identifies where in the FILSTR array
C              the name of the file is  to  be  found  when
C              needed.
C     IDISK  = number of the unit  to  which  the  file  is
C              being  written.   This  is  the number which
C              appears first in the WRITE statements.
C
      COMMON/FILSTR/FILSTR(6)
      DOUBLE PRECISION FILNAM,FILSTR
C
C     GET THE NAME OF THE LABEL FILE
      FILNAM=FILSTR(ISTORE)
C
C     CLOSE THE FILE TO WRITE OUT LABELS IN BUFFER
      CLOSE(UNIT=IDISK)
C
C     REOPEN FILE IN APPEND MODE SO CAN ADD TO IT
      OPEN(UNIT=IDISK,FILE=FILNAM,ACCESS='APPEND')
      RETURN
      END
      SUBROUTINE FILEND(ISTORE,IDISK)
C     RENBR(/CLOSE OUTPUT FILE)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine closes  the  output  file  indicated  by
C     ISTORE.   This  routine is not really necessary.  The
C     call to this routine can be replaced by just a  CLOSE
C     statement.
C
C     This version of  this  routine  is  written  for  the
C     DECsystem10,  or for the DECsystem20 using the TOPS10
C     emulator.
C
C
C     ISTORE = number assigned to  the  file  by  the  main
C              program  when it called either the FILOPN or
C              FILNXT  routine  to  open  the  file.   This
C              number  identifies where in the FILSTR array
C              the name of the file is  to  be  found  when
C              needed.
C     IDISK  = number of the unit  to  which  the  file  is
C              being  written.   This  is  the number which
C              appears first in the WRITE statements.
C
      COMMON/FILSTR/FILSTR(6)
      DOUBLE PRECISION FILNAM,FILSTR
C
C     GET THE NAME OF THE LABEL FILE
      FILNAM=FILSTR(ISTORE)
C
C     CLOSE THE FILE
      CLOSE(UNIT=IDISK)
      RETURN
      END
      SUBROUTINE TTYEOF(JTTY)
C     RENBR(/CLEAR END-OF-FILE READ FROM TERMINAL)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine allows the program to accept  more  text
C     typed  by  the user after an end-of-file or control-Z
C     has   been   typed.    Without   this,   under   some
C     DECsystem-10  operating systems, the program would go
C     into an infinite loop after reading  the  end-of-file
C     with  a READ statement having an END= test, since the
C     end-of-file would be not  be  cleared  and  would  be
C     sensed  each  time  the program attempted to read the
C     next line typed by the user.
C
C
C     JTTY   = number of the unit from which the text typed
C              by the user is read.
C
      CLOSE(UNIT=JTTY)
      RETURN
      END
      SUBROUTINE TSTOPS(LTRLIN,IFINAL,JFINAL,LTROUT,MAXPRT)
C     RENBR(/CONVERT MULTIPLE SPACES TO TAB CHARACTERS)
C
C     DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C     *****************************************************
C     * THIS ROUTINE MUST BE CHANGED FOR OTHER COMPUTERS. *
C     * THIS VERSION IS FOR THE DECSYSTEM10 COMPUTER      *
C     * OR FOR THE DECSYSTEM20 WITH TOPS10 EMULATOR.      *
C     *****************************************************
C
C     This routine converts the spaces between  columns  of
C     labels  to  tab characters so that the labels require
C     less disk space to store and so that the  labels  can
C     be  typed faster on slow transmission lines.  The tab
C     character is a single ASCII  character  which  causes
C     the next character after it to be printed in the next
C     column to the right of the next integral multiple  of
C     8 columns.
C
C     The program  which  calls  this  routine  will  still
C     perform  correctly  if  this  routine  is  changed to
C     merely copy all of the characters input in  LTRLIN(1)
C     through  LTRLIN(IFINAL)  into  the  LTROUT array, and
C     return MAXPRT set to the value of IFINAL.
C
C
C     LTRLIN = array input containing the characters  in  a
C              single  line across all of the parallel rows
C              of  labels  before  conversion  of  multiple
C              spaces to tabs.  The blank space between the
C              printing  characters   consists   of   space
C              characters,    one   per   printing   column
C              position.
C     IFINAL = total number of characters which are in  the
C              input   array   counting  each  space  as  a
C              separate character.
C     JFINAL = maximum number of characters which can be in
C              the line after conversion of multiple spaces
C              to tabs.  Dimension of the LTROUT array.
C     LTROUT = array returned containing the characters  in
C              a  single  line  across  all of the parallel
C              rows of labels after conversion of  multiple
C              spaces to tabs.
C     MAXPRT = returned  specifying  the  position  in  the
C              LTROUT   array  of  the  rightmost  printing
C              character.
C
C
      DIMENSION LTRLIN(IFINAL),LTROUT(JFINAL)
C
C     LTRSPA = the space character
C     LTRTAB = the tab character,  causes next character to
C              appear to  the  right  of the  next integral
C              multiple of 8 columns.  LTRTAB is defined in
C              octal notation since the editor used at Yale
C              converts  tab  characters  in  a  file being
C              edited to spaces directly.
C
      DATA LTRSPA,LTRTAB/1H ,"045004020100/
C
C     MLTTAB = the tab stop interval.
      DATA MLTTAB/8/
C
      NXTTAB=0
      JUSED=0
      MAXPRT=0
      IF(IFINAL.LE.0)GO TO 6
      KOLUMN=1
    1 IF(JUSED.GE.JFINAL)GO TO 7
      IF(KOLUMN.GT.NXTTAB)NXTTAB=NXTTAB+MLTTAB
      IF(LTRLIN(KOLUMN).NE.LTRSPA)GO TO 4
      IF(NXTTAB.GT.IFINAL)GO TO 3
      DO 2 ITEST=KOLUMN,NXTTAB
      IF(LTRLIN(ITEST).NE.LTRSPA)GO TO 3
    2 CONTINUE
      JUSED=JUSED+1
      LTROUT(JUSED)=LTRTAB
      KOLUMN=NXTTAB
      GO TO 5
    3 JUSED=JUSED+1
      LTROUT(JUSED)=LTRLIN(KOLUMN)
      GO TO 5
    4 JUSED=JUSED+1
      LTROUT(JUSED)=LTRLIN(KOLUMN)
      MAXPRT=JUSED
    5 KOLUMN=KOLUMN+1
      IF(KOLUMN.LE.IFINAL)GO TO 1
      GO TO 7
    6 MAXPRT=1
      LTROUT(1)=LTRSPA
    7 RETURN
      END