Trailing-Edge
-
PDP-10 Archives
-
decuslib10-13
-
reusr5.for
There are 3 other files named reusr5.for in the archive. Click here to see a list.
SUBROUTINE REUSER
C RENBR(REUSR5/PDP10 FILE SPECIFICATION DIALOG)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VERSION OF THE USER COMMAND DIALOG PROCESSOR
C FOR RENBR IS BASED UPON THAT IN REUSR1, BUT USES
C CHARACTER STRINGS RATHER THAN HOLLERITH ARRAYS. THIS
C VERSION MUST BE USED WITH THE VERSION OF RENBR WHICH
C HAS BEEN CONVERTED TO USE CHARACTER STRINGS.
C
C FOR USE OF THIS VERSION ON THE DECSYSTEM10 COMPUTER,
C IT SHOULD BE COMPILED WITH VERSION 7 OF THE FORTRAN10
C COMPILER. COMMANDS TYPED BY THE USER CONSIST OF THE
C NAME OF THE OUTPUT RENUMBERED FILE AND/OR THE NAME OF
C THE OUTPUT LISTING FILE, THEN AN EQUAL SIGN CHARACTER
C AND A LIST OF INPUT FILES USING 80 CHARACTERS OR LESS
C PER LINE. AN AMPERSAND OR A COMMA MUST TERMINATE THE
C LINE IF THE NEXT LINE CONTINUES THE COMMAND. THE
C COMMAND CAN BE READ FROM A FILE IF THE NAME OF THE
C FILE IS TYPED WITH AN AT SIGN CHARACTER. THE
C EXTENSIONS .NEW, .LPT, .FOR AND .RNB ARE THE DEFAULTS
C FOR THE RENUMBERING, THE LISTING, THE INPUT AND THE
C COMMAND FILES RESPECTIVELY. FILE NAMES CAN INCLUDE
C DEVICE AND PATH SPECIFICATION TO 1 SFD LEVEL. IF 2
C OUTPUT NAMES ARE GIVEN, THEN A COMMA SHOULD SEPARATE
C THESE AND A SWITCH WITH AT LEAST 1 MUST IMPLY USE.
C SWITCHES HAVE THE FORM /LETTER:NUMBER:NUMBER WHERE
C THE NUMBERS ARE OPTIONAL. THE TITLE FOR EACH PAGE
C CAN BE SPECIFIED BETWEEN APOSTROPHES AND IMPLIES THAT
C THE ASSOCIATED NAME IS OF THE LISTING FILE. AFTER
C THE FILES SPECIFIED IN THE COMMAND HAVE BEEN
C PROCESSED, RENBR WILL AGAIN ASK FOR ANOTHER COMMAND.
C TYPING A BLANK COMMAND TERMINATES PROCESSING.
C
COMMON/RNBONE/I ,IALPHA,IBASE ,IBR ,IBREAK,
1IEND ,IENTER,IEOF ,IERR ,IFILL ,IFORM ,IFREAR,
2IHIHDO,IIN ,ILEVEL,ILPT ,INCR ,INCSAV,INDENT,
3INDSAV,ININAM,INIOPR,INIPRT,INITOC,INRCPY,INRFND,
4IOUT ,IPAGE ,IPASS ,IPOINT,ISPACE,ISPLIT,ISPR ,
5ISTART,ISTN ,ITAB ,ITBL ,ITITLE,ITRACE,ITTY ,
6J ,JBGN ,JBREAK,JEND ,JEOF ,JFORM ,JIN ,
7JIN1 ,JLEVEL,JMPBGN,JMPEND,JOBNUM,JOUT ,JPASS ,
8JPOINT,JSPLIT,JSTN ,JTAB ,JTBL ,JTTY ,K ,
9KBGN ,KEND ,KLEVEL,KMDMAX,KMDMIN,KNDGRP,KNT
C
COMMON/RNBTWO/KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
1KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE ,KPASS ,
2KPOINT,KPYEND,KSTN ,KTAB ,KUTNUM,KUTPAG,KUTPNT,
3KUTSPL,L ,LCLNUM,LCLPNT,LCLSPL,LEFT ,LEND ,
4LIKE ,LMTTOC,LNGCOM,LNGNAM,LNGNXT,LOWDO ,LOWER ,
5LOWSHO,LOWTOC,LOW1 ,LOW2 ,LPOINT,LPTTTY,LRGNUM,
6LRGPNT,LRGSPL,LRGTOC,LSTKNT,LSTN ,LSTSTN,LTAB ,
7M ,MANY ,MASTER,MAXCOM,MAXEND,MAXLIN,MAXPNT,
8MAXPRT,MAXSPL,MAXTOC,MID ,MODBAS,MODINC,MODMAX,
9MODMIN,MODNEW,MODOLD,MOST ,MOVE ,MSTN ,MTAB
C
COMMON/RNBTHR/N ,NCD ,NEED ,NEWNUM,NEWSTN,
1NONFOR,NOWTOC,NSTN ,NTAB ,NUM ,NXTEND,NXTLST
C
COMMON/RNBFOU/INRSTR(21) ,JPNT(10) ,LINREF(9) ,
1 MCHOPR(51) ,NNEW(1000) ,NOLD(1000) ,NOTOPR(51) ,
2 NUMPNT(5000),NUMPRS(655) ,NUMTOC(112) ,NUMTYP(7)
C
COMMON/RNBFIV/LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
1LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,LTRQOT,
2LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,LTRTAB,LTR1ST,
3LTR2ND,LWRDDD,LWREEE,LWRHHH
C
COMMON/RNBSIX/LTRABC(26) ,LTRBGN(5) ,LTRBIG(2211),
1 LTRCOM(6) ,LTRDGT(10) ,LTREND(3) ,LTRFLG(8) ,
2 LTRKEY(5) ,LTRNAM(10) ,LTROPR(51) ,LTRPRS(331) ,
3 LTRSPL(2000),LTRSRT(26) ,LTRTOC(168) ,LTRTOP(117) ,
4 LTRTTL(5) ,LTRTYP(55) ,LTRUSE(6) ,LTR120(120) ,
5 LWRABC(26) ,LWRBGN(5) ,LWREND(3) ,LWRFLG(8) ,
6 LWRKEY(5) ,LWRPRS(331) ,LWRSRT(26) ,LWRTTL(5)
C
C SINGLE CHARACTER VARIABLES IN COMMON/RNBFIV/
CHARACTER*1 LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
1 LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,
2 LTRQOT,LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,
3 LTRTAB,LTR1ST,LTR2ND,LWRDDD,LWREEE,LWRHHH
C
C CHARACTER ARRAYS IN COMMON/RNBSIX/
CHARACTER*1 LTRABC,LTRBGN,LTRBIG,LTRCOM,LTRDGT,
1 LTREND,LTRFLG,LTRKEY,LTRNAM,LTROPR,LTRPRS,
2 LTRSPL,LTRSRT,LTRTOC,LTRTOP,LTRTTL,LTRTYP,
3 LTRUSE,LTR120,LWRABC,LWRBGN,LWREND,LWRFLG,
4 LWRKEY,LWRPRS,LWRSRT,LWRTTL
C
C ITEMS WHICH MUST BE KEPT FROM LAST CALL OF REUSER
COMMON/RNBSEV/KIND,LCNRIT,LNGFIL(3)
COMMON/RNBEIG/LTRCMD(80),LTRFIL(80,3)
C
CHARACTER*1 LTRCMD,LTRFIL,LTRMRK
C
C ITEMS WHICH ARE NOT KEPT FROM LAST CALL OF REUSER
DIMENSION INILOC(3),KNTCHR(3)
DATA MAXFIL,MAXCHR,MAXSTR,MAXBFR/3,80,3,80/
DATA LTRMRK/''''/
DATA ICMD/24/
C
C CLEAR DEFAULT VALUES
JPASS=1
IF(MASTER.LE.1)GO TO 1
CLOSE(UNIT=IIN)
GO TO 6
1 JIN=JTAB
JBGN=IFORM
JEND=JFORM
IF(MASTER.LE.0)GO TO 4
WRITE(ITTY,2)
2 FORMAT(' RENBR (03/85)'/' Type /H for Help')
3 KIND=0
IF(MASTER.NE.1)KIND=1
4 IPAGE=0
ISPACE=0
INCR=0
IBASE=0
INDENT=0
ISPLIT=0
IFILL=0
ITAB=0
IFORM=JBGN
JFORM=JEND
JTAB=JIN
LTAB=0
ITBL=1
JMPEND=0
JMPBGN=0
KMDMIN=0
KMDMAX=0
KNDONE=0
KNDTWO=0
KNDTHR=0
LPTTTY=0
ITRACE=0
C
C INSERT DEFAULT TITLE SIMILAR TO 12-MAY-78 15:30
DO 5 I=1,54
5 LTRTOP(I)=LTRSPC
CALL REDATE(LTRTOP)
C
C GET NEXT COMPONENT OF COMMAND TYPED BY USER
6 CALL REFILE(MAXFIL,ITTY,JTTY,ICMD,MAXSTR,
1MAXBFR,MAXCHR,ITRACE,KIND,LTRFIL,LNGFIL,LCNRIT,
2LTRCMD,MAXFLG,INILOC,KNTCHR,LCNOWN)
GO TO(112,113,112,57,63,7),KIND
C
C DECIDE WHICH SWITCH WAS GIVEN
7 IF(MAXFLG.LE.0)GO TO 6
IF(KNTCHR(1).LE.0)GO TO 6
LOCFLG=INILOC(1)
LTRNOW=LTRCMD(LOCFLG)
KNDFLG=0
IF(LTRNOW.EQ.LTRMRK)GO TO 53
IF(MASTER.GT.1)GO TO 6
KNTFLG=1
8 KNDFLG=KNDFLG+1
IF(KNDFLG.GT.26)GO TO 6
IF(LTRABC(KNDFLG).EQ.LTRNOW)GO TO 9
IF(LWRABC(KNDFLG).NE.LTRNOW)GO TO 8
C GO TO( A, B, C, D, E, F, G, H, I, J,
C 1 K, L, M, N, O, P, Q, R, S, T,
C 2 U, V, W, X, Y, Z),KNDFLG
9 GO TO(26,16,12,26,21,21,21,56,17,21,
1 10,21,16,26,26,22,26,26,21,11,
2 13,14,26,26,26,15),KNDFLG
10 ISPLIT=0
GO TO 21
11 ITAB=1
GO TO 16
12 ITAB=0
GO TO 16
13 ITAB=-1
GO TO 16
14 LPTTTY=1
GO TO 21
15 ITRACE=1
GO TO 26
C
C MARK THAT FILE CONTAINS RENUMBERED PROGRAM
16 IF(INCR.EQ.0)INCR=1
17 GO TO(18,19,20),LCNOWN
18 IF(KNDONE.EQ.1)GO TO 26
IF(KNDONE.NE.3)KNDONE=KNDONE+1
GO TO 26
19 IF(KNDTWO.EQ.1)GO TO 26
IF(KNDTWO.NE.3)KNDTWO=KNDTWO+1
GO TO 26
20 IF(KNDTHR.EQ.1)GO TO 26
IF(KNDTHR.NE.3)KNDTHR=KNDTHR+1
GO TO 26
C
C MARK THAT FILE CONTAINS LISTING OF PROGRAM
21 IF(IPAGE.EQ.0)IPAGE=1
22 GO TO(23,24,25),LCNOWN
23 IF(KNDONE.LE.1)KNDONE=KNDONE+2
GO TO 26
24 IF(KNDTWO.LE.1)KNDTWO=KNDTWO+2
GO TO 26
25 IF(KNDTHR.LE.1)KNDTHR=KNDTHR+2
C
C EVALUATE NUMBERS IN RANGE OF SWITCH
26 IF(KNDFLG.LE.0)GO TO 6
LMTFLG=LOCFLG+KNTCHR(1)
LOCFLG=LOCFLG+1
27 NUMFLG=0
IF(LOCFLG.GE.LMTFLG)GO TO 29
LTRNOW=LTRCMD(LOCFLG)
IF(LTRNOW.EQ.LTRPLS)GO TO 30
IF(LTRNOW.EQ.LTRMNS)GO TO 30
DO 28 L=1,10
IF(LTRNOW.EQ.LTRDGT(L))GO TO 30
28 CONTINUE
29 IF(KNTFLG.GE.MAXFLG)GO TO 34
KNTFLG=KNTFLG+1
IF(KNTCHR(KNTFLG).LE.0)GO TO 34
LOCFLG=INILOC(KNTFLG)
LMTFLG=LOCFLG+KNTCHR(KNTFLG)
30 I=0
IF(LTRCMD(LOCFLG).EQ.LTRPLS)GO TO 31
IF(LTRCMD(LOCFLG).NE.LTRMNS)GO TO 32
I=1
31 LOCFLG=LOCFLG+1
32 IF(LOCFLG.GE.LMTFLG)GO TO 34
LTRNOW=LTRCMD(LOCFLG)
LOCFLG=LOCFLG+1
DO 33 L=1,10
IF(LTRDGT(L).NE.LTRNOW)GO TO 33
NUMFLG=(10*NUMFLG)+L-1
GO TO 32
33 CONTINUE
LOCFLG=LOCFLG-1
34 IF(I.EQ.0)GO TO 35
NUMFLG=-NUMFLG
IF(KNDFLG.NE.9)NUMFLG=0
C GO TO( A, B, C, D, E, F, G, H, I, J,
C 1 K, L, M, N, O, P, Q, R, S, T,
C 2 U, V, W, X, Y, Z,L/,J/,M/),KNDFLG
35 GO TO(37,39, 6, 6,51,48,38, 6,40,41,
1 6,49,42, 6, 6,36, 6, 6,52, 6,
2 6, 6,46, 6, 6, 6,47,43,44),KNDFLG
36 IPAGE=NUMFLG
IF(IPAGE.EQ.0)IPAGE=1
GO TO 6
37 INDENT=NUMFLG
IF(INDENT.EQ.0)INDENT=1
GO TO 6
38 ISPACE=NUMFLG
IF(ISPACE.EQ.0)ISPACE=1
GO TO 6
39 IBASE=NUMFLG
GO TO 6
40 INCR=NUMFLG
IF(INCR.EQ.0)INCR=1
GO TO 6
41 JMPBGN=NUMFLG
KNDFLG=28
GO TO 27
42 KMDMIN=NUMFLG
KNDFLG=29
GO TO 27
43 JMPEND=NUMFLG
GO TO 6
44 IF(NUMFLG.GT.0)GO TO 45
IF(KMDMIN.GT.0)NUMFLG=99999
IF(KMDMIN.EQ.0)KMDMIN=-1
45 IF(KMDMIN.EQ.0)KMDMIN=1
KMDMAX=NUMFLG
GO TO 6
46 JTAB=NUMFLG
IF(JTAB.EQ.0)JTAB=JIN
LTAB=1
GO TO 6
47 IF(NUMFLG.GT.10)IFORM=NUMFLG
GO TO 6
48 IFILL=0
GO TO 50
49 IFILL=1
50 JFORM=NUMFLG
IF(JFORM.LE.10)JFORM=JEND
IFORM=JBGN
IF(IFILL.EQ.0)GO TO 6
IF(ISPLIT.EQ.0)ISPLIT=1
KNDFLG=27
GO TO 27
51 ITBL=NUMFLG+1
IF(ITBL.EQ.1)ITBL=2
GO TO 6
52 ISPLIT=NUMFLG+1
GO TO 6
C
C TITLE IS ENCLOSED IN APOSTRPHES
53 IF(MASTER.LE.1)GO TO 54
IF(IPAGE.EQ.0)GO TO 6
54 LMTFLG=LOCFLG+KNTCHR(1)
DO 55 I=1,54
LTRTOP(I)=LTRSPC
LOCFLG=LOCFLG+1
55 IF(LOCFLG.LT.LMTFLG)LTRTOP(I)=LTRCMD(LOCFLG)
IF(MASTER.LE.1)GO TO 21
GO TO 6
C
C ISSUE HELP MESSAGE
56 CALL REHELP(ITTY)
GO TO 3
C
C SET DEFAULT OUPUT DEVICE NAMES AND PATHS
57 IF(IPAGE.NE.0)GO TO 58
IF(INCR.EQ.0)INCR=1
58 GO TO(63,59,62),LCNRIT
C
C SINGLE FILE LEFT OF EQUAL SIGN
59 IF(LNGFIL(1).EQ.0)GO TO 63
IF(KNDONE.GE.3)GO TO 74
IF(KNDONE.EQ.2)GO TO 61
IF(KNDONE.EQ.1)GO TO 60
IF(KNDTWO.EQ.2)GO TO 61
IF(KNDTWO.GE.3)GO TO 74
60 KNDONE=1
KNDTWO=0
GO TO 63
61 KNDONE=0
KNDTWO=1
GO TO 63
C
C TWO FILES LEFT OF EQUAL SIGN
62 IF(KNDONE.GE.3)GO TO 74
IF(KNDTWO.GE.3)GO TO 74
IF(KNDONE.EQ.KNDTWO)GO TO 74
IF(INCR.EQ.0)INCR=1
IF(IPAGE.EQ.0)IPAGE=1
IF(KNDONE.EQ.0)KNDONE=3-KNDTWO
IF(KNDTWO.EQ.0)KNDTWO=3-KNDONE
C
C OPEN FILES
63 IF(MASTER.GT.1)GO TO 65
IF(LNGFIL(LCNRIT).LE.0)GO TO 76
CALL REOPEN(2,IIN,LCNRIT,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 70
IF(INCR.EQ.0)GO TO 64
IF(KNDONE.GE.LCNRIT)KNDONE=0
CALL REOPEN(3,IOUT,KNDONE,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 66
IF(IPAGE.EQ.0)GO TO 78
64 IF(KNDTWO.GE.LCNRIT)KNDTWO=0
CALL REOPEN(4,ILPT,KNDTWO,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 68
GO TO 78
65 IF(LNGFIL(LCNRIT).EQ.0)GO TO 6
CALL REOPEN(5,IIN,LCNRIT,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
IF(NOTOPN.NE.0)GO TO 72
GO TO 114
C
C ERROR IN COMMAND TYPED BY USER
66 I=LNGFIL(KNDONE)
WRITE(ITTY,67)(LTRFIL(J,KNDONE),J=1,I)
67 FORMAT(' Cannot write renumbered file ',100A1)
GO TO 3
68 I=LNGFIL(KNDTWO)
WRITE(ITTY,69)(LTRFIL(J,KNDTWO),J=1,I)
69 FORMAT(' Cannot write listing file ',100A1)
GO TO 3
70 I=LNGFIL(LCNRIT)
WRITE(ITTY,71)(LTRFIL(J,LCNRIT),J=1,I)
71 FORMAT(' Cannot read source file ',100A1)
GO TO 3
72 I=LNGFIL(LCNRIT)
WRITE(ITTY,73)(LTRFIL(J,LCNRIT),J=1,I)
73 FORMAT(' Cannot read source file ',100A1)
GO TO 6
74 WRITE(ITTY,75)
75 FORMAT(' Ambiguous output specification')
GO TO 3
76 WRITE(ITTY,77)
77 FORMAT(' 1st source file must be specified')
GO TO 3
C
C REPORT OPTIONS SELECTED
78 IF(INDENT.GT.0)WRITE(ITTY,79)INDENT
79 FORMAT(4X,'Add Block Indent',1I5)
IF(LTAB.NE.0)WRITE(ITTY,80)JTAB
80 FORMAT(2X,'Width OF Tab Stops',1I5)
IF(IPAGE.EQ.0)GO TO 94
WRITE(ITTY,81)
81 FORMAT(10X,'Listing Options')
I=54
82 IF(LTRTOP(I).NE.LTRSPC)GO TO 83
I=I-1
IF(I.GT.0)GO TO 82
GO TO 85
83 WRITE(ITTY,84)(LTRTOP(J),J=1,I)
84 FORMAT(15X,'Title ',54A1)
85 WRITE(ITTY,86)IPAGE
86 FORMAT(9X,'Page Number',1I5)
IF(ISPACE.NE.0)WRITE(ITTY,87)ISPACE
87 FORMAT(2X,'Gap Interstatement',1I5)
IF(IFILL.EQ.0)WRITE(ITTY,88)JFORM
88 FORMAT(10X,'Form Feeds',1I5)
IF(IFILL.NE.0)WRITE(ITTY,89)JFORM,IFORM
89 FORMAT(10X,'Line Feeds',1I5,':',1I5)
IF((JMPBGN+JMPEND).NE.0)WRITE(ITTY,90)JMPBGN,JMPEND
90 FORMAT(2X,'Jump at Top/Bottom',1I5,':',1I5)
IF(ISPLIT.EQ.0)WRITE(ITTY,91)
91 FORMAT(3X,'Keep Lines Intact')
I=ISPLIT-1
IF(ISPLIT.NE.0)WRITE(ITTY,92)I
92 FORMAT(4X,'Split Long Lines',1I5)
I=ITBL-1
IF(I.NE.0)WRITE(ITTY,93)I
93 FORMAT(1X,'Extra Table Content',1I5)
IF(INCR.EQ.0)GO TO 106
94 WRITE(ITTY,95)
95 FORMAT(6X,'Renumbering Options')
IF(KMDMIN.GT.0)GO TO 97
IF(KMDMIN.EQ.0)GO TO 99
WRITE(ITTY,96)
96 FORMAT(2X,'Maintain Numbering')
GO TO 102
97 WRITE(ITTY,98)KMDMIN,KMDMAX
98 FORMAT(3X,'Modify Only Range',1I5,':',1I5)
99 WRITE(ITTY,100)INCR
100 FORMAT(11X,'Increment',1I5)
IF(IBASE.NE.0)WRITE(ITTY,101)IBASE
101 FORMAT(16X,'Base',1I5)
102 IF(ITAB.LT.0)WRITE(ITTY,103)
103 FORMAT(' Uniform Left Margin')
IF(ITAB.EQ.0)WRITE(ITTY,104)
104 FORMAT(7X,'Column Format')
IF(ITAB.GT.0)WRITE(ITTY,105)
105 FORMAT(10X,'Tab Format')
C
C POSITION PAPER IF TELETYPE OUTPUT
106 IF(IPAGE.EQ.0)GO TO 110
IF(LPTTTY.EQ.0)GO TO 110
IF(IFILL.EQ.0)GO TO 110
WRITE(ITTY,107)
107 FORMAT(1X/' Position paper',
1' (carriage return or local line feed)'/
2' then type non-space character',
3' and carriage return')
108 READ(JTTY,109)LTRNOW
109 FORMAT(1A1)
IF(LTRNOW.EQ.LTRSPC)GO TO 108
GO TO 114
110 WRITE(ITTY,111)
111 FORMAT(' ')
GO TO 114
C
C RETURN TO MAIN PROGRAM
112 IF(MASTER.LE.1)GO TO 3
113 JPASS=0
114 RETURN
END
SUBROUTINE REFILE(MAXFIL, ITTY, JTTY, ICMD,MAXSTR,
1 MAXBFR,MAXCHR,ITRACE, KIND,LTRFIL,LNGFIL,LCNRIT,
2 LTRCMD,MAXFLG,INILOC,KNTCHR,LCNOWN)
C RENBR(REFIL5/PDP10 STORE OUTPUT AND INPUT FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C ITTY = NUMBER OF UNIT TO WHICH TERMINAL OUTPUT IS
C TO BE WRITTEN.
C JTTY = NUMBER OF UNIT FROM WHICH TERMINAL INPUT IS
C TO BE READ.
C ICMD = NUMBER OF UNIT FROM WHICH COMMAND FILE
C INDICATED BY AT SIGN IS TO BE READ.
C MAXSTR = DIMENSION OF INILOC AND KNTCHR ARRAYS IN
C WHICH DESCRIPTIONS OF COMPONENTS OF SWITCHES
C ARE RETURNED AND WHICH ARE USED INTERNALLY
C WITHIN THIS ROUTINE FOR STORAGE OF
C DESCRIPTIONS OF COMPONENTS OF EACH FILE
C SPECIFICATION. MAXSTR SHOULD HAVE VALUE OF
C AT LEAST 3.
C MAXBFR = DIMENSION OF LTRCMD ARRAY INTO WHICH EACH
C LINE OF COMMANDS TYPED BY USER OR READ FROM
C COMMAND FILE ARE STORED IN MULTIPLE OF A1
C FORMAT. MAXBFR IS MAXIMUM NUMBER OF
C CHARACTERS WHICH CAN APPEAR IN SINGLE
C COMMAND LINE. MAXBFR MUST NOT EXCEED 132.
C MAXCHR = MAXIMUM NUMBER OF CHARACTERS WHICH CAN BE
C STORED IN ANY ONE FILE SPECIFICATION.
C MAXCHR IS FIRST DIMENSION OF LTRFIL ARRAY.
C ITRACE = 0, INPUT IF DESCRIPTIONS OF FILES ARE NOT TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C = 1, INPUT IF USER SELECTS /Z SWITCH
C INDICATING THAT DESCRIPTIONS OF FILES ARE TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C
C FOLLOWING ARGUMENT MUST BE SET BEFORE THIS ROUTINE IS
C FIRST CALLED, BUT THEN VALUE RETURNED BY THIS ROUTINE
C SHOULD BE SENT TO FOLLOWING CALL OF THIS ROUTINE
C UNCHANGED.
C
C KIND = SHOULD BE INPUT SET TO ZERO WHEN THIS
C ROUTINE IS FIRST CALLED, OR WHENEVER
C INTERPRETATION OF PREVIOUS SET OF COMMANDS
C IS TO BE ABANDONED. KIND IS RETURNED
C DESCRIBING REASON WHY CONTROL HAS BEEN
C TRANSFERRED BACK TO CALLING PROGRAM, AND
C SHOULD NOT BE CHANGED BY CALLING PROGRAM IF
C THIS ROUTINE IS TO BE CALLED AGAIN TO
C CONTINUE INTERPRETATION OF SAME SEQUENCE OF
C COMMANDS.
C = 1, RETURNED IF NO MORE FILE SPECIFICATIONS
C REMAIN TO BE EVALUATED.
C = 2, RETURNED IF KIND WAS INPUT CONTAINING THE
C VALUE 1 OR 2 AND THE NEXT LINE TYPED BY THE
C USER IS EMPTY.
C = 3, RETURNED IF SEMICOLON WAS FOUND. IF THIS
C ROUTINE IS CALLED AGAIN WITHOUT KIND HAVING
C FIRST BEEN ZEROED, THEN EVALUATION OF NEW
C SET OF FILE SPECIFICATIONS WILL BE BEGUN IN
C TEXT APPEARING TO RIGHT OF SEMICOLON.
C APPEARANCE OF SEMICOLON WHEN FILE
C SPECIFICATION IS KNOWN BY THIS ROUTINE TO BE
C INCOMPLETE WILL NOT BE REPORTED SINCE TEXT
C TO RIGHT OF SEMICOLON IS TREATED AS IF IT
C CONTINUED FILE SPECIFICATIONS ON SUBSEQUENT
C LINE OF INPUT.
C = 4, RETURNED IF THIS ROUTINE IS REPORTING ALL
C OF FILE SPECIFICATIONS APPEARING TO LEFT OF
C EQUAL SIGN TOGETHER WITH FIRST FILE
C SPECIFICATION TO RIGHT OF EQUAL SIGN, OR IF
C THIS ROUTINE IS REPORTING FIRST FILE
C SPECIFICATION IN SERIES OF FILE
C SPECIFICATIONS WHICH DOES NOT INCLUDE EQUAL
C SIGN.
C = 5, RETURNED IF THIS ROUTINE IS REPORTING
C SECOND OR SUBSEQUENT FILE SPECIFICATION TO
C RIGHT OF EQUAL SIGN, OR IF THIS ROUTINE IS
C REPORTING SECOND OR SUBSEQUENT FILE
C SPECIFICATION IN SERIES OF FILE
C SPECIFICATIONS WHICH DOES NOT INCLUDE EQUAL
C SIGN.
C = 6, RETURNED IF THIS ROUTINE IS RETURNING
C DESCRIPTION OF SWITCH IN INITAL AND LENGTH
C ARRAY LOCATIONS HAVING SUBSCRIPTS 1 THROUGH
C MAXFLG. LCNOWN IS RETURNED CONTAINING VALUE
C OF SUBSCRIPT OF LOCATIONS IN NEWNUL, NEWDSK,
C NEWNAM AND NEWPTH ARRAYS WHICH WILL DESCRIBE
C FILE SPECIFICATION WHEN KIND IS NEXT
C RETURNED SET TO EITHER 4 OR 5.
C
C FOLLOWING ARGUMENTS ARE USED BOTH FOR RETURNING
C INFORMATION TO CALLING PROGRAM AND FOR COMMUNICATING
C WITH SUBSEQUENT CALLS OF THIS ROUTINE. ORIGINAL
C CONTENTS OF THESE ARGUMENTS ARE IGNORED.
C
C LTRFIL = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN LOCATIONS IN LTRFIL ARRAY HAVING SECOND
C SUBSCRIPTS 1 THROUGH LCNRIT ARE RETURNED
C CONTAINING THE CHARACTERS FORMING THE FILE
C SPECIFICATIONS AS TYPED BY THE USER.
C LGNFIL = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN THE LNGFIL ARRAY CONTAINS THE NUMBER OF
C CHARACTERS IN EACH OF THE FILE
C SPECIFICATIONS RETURNED IN THE LTRFIL ARRAY.
C LCNRIT = IF KIND IS RETURNED SET TO EITHER 4 OR 5,
C THEN LCNRIT IS RETURNED CONTAINING VALUE OF
C SUBSCRIPT OF LOCATIONS IN LNGFIL ARRAY AND
C SECOND SUBSCRIPT OF LOCATIONS IN LTRFIL
C ARRAY WHICH DESCRIBE FILE SPECIFICATION
C WHICH APPEARS TO RIGHT OF EQUAL SIGN. IF
C KIND IS RETURNED SET TO 4 AND IF LCNRIT IS
C GREATER THAN ONE, THEN LOWER LOCATIONS IN
C THESE ARRAYS DESCRIBE FILE SPECIFICATIONS
C APPEARING TO LEFT OF EQUAL SIGN. IF KIND IS
C RETURNED SET TO 5, THEN LOCATIONS WITHIN
C THESE ARRAYS HAVING LOWER SUBSCRIPTS SHOULD
C BE IGNORED.
C LTRCMD = ARRAY INTO WHICH THIS ROUTINE CAN READ
C CHARACTERS TYPED BY USER OR READ FROM
C COMMAND FILE.
C MAXFLG = IF KIND IS RETURNED SET TO 6, THEN MAXFLG IS
C RETURNED CONTAINING SUPSCRIPT OF LOCATIONS
C IN INILOC AND KNTCHR ARRAYS WHICH DESCRIBE
C RIGHTMOST COMPONENT OF SWITCH.
C INILOC = IF KIND IS RETURNED SET TO 6, THEN LOCATIONS
C IN INILOC ARRAY HAVING SUBSCRIPTS 1 THROUGH
C VALUE OF MAXFLG ARE RETURNED CONTAINING
C VALUES OF SUBSCRIPTS OF LOCATIONS WITHIN
C LTRCMD ARRAY AT WHICH EACH OF COMPONENTS OF
C SWITCH START.
C KNTCHR = IF KIND IS RETURNED SET TO 6, THEN LOCATIONS
C IN INILOC ARRAY HAVING SUBSCRIPTS 1 THROUGH
C VALUE OF MAXFLG ARE RETURNED CONTAINING
C NUMBER OF CHARACTERS WITHIN EACH OF
C COMPONENTS OF SWITCH. MISSING COMPONENT OF
C SWITCH IS INDICATED BY ZERO VALUE IN KNTCHR
C ARRAY.
C LCNOWN = IF KIND IS RETURNED SET TO 6, THEN LCNOWN IS
C RETURNED CONTAINING VALUE OF SUBSCRIPT OF
C LOCATIONS IN LNGFIL AND LTRFIL ARRAYS WHICH
C WILL DESCRIBE FILE SPECIFICATION WHEN KIND
C IS NEXT RETURNED SET TO EITHER 4 OR 5.
C
COMMON/RNBNIN/KNTFIL,MANY,IEOF,IAFTER,LOWBFR
DIMENSION LTRFIL(MAXCHR,MAXFIL),LNGFIL(MAXFIL)
DIMENSION INILOC(MAXSTR),KNTCHR(MAXSTR),
1LTRCMD(MAXBFR)
C
CHARACTER*1 LTRCMD,LTRFIL
C
C DECIDE WHETHER ARE STARTING OR CONTINUING EVALUATION
INIKND=KIND
IF(KIND.EQ.6)GO TO 9
IF(KIND.GE.4)GO TO 30
LCNRIT=0
KNTFIL=0
IAFTER=0
MANY=0
IF(KIND.EQ.3)GO TO 9
C
C READ CONTENTS OF NEXT LINE
WRITE(ITTY,1)
1 FORMAT(' *',$)
GO TO 4
2 WRITE(ITTY,3)
3 FORMAT(' &',$)
4 READ(JTTY,5,END=10)LTRCMD
5 FORMAT(132A1)
IEOF=0
GO TO 7
6 READ(ICMD,5,END=10)LTRCMD
IEOF=1
7 LOWBFR=1
GO TO 9
8 LCNRIT=1
KNTFIL=0
C
C LOCATE NEXT FILE SPECIFICATION
9 CALL REFLAG(1,MAXSTR,MAXBFR,LTRCMD,
1LOWBFR,MANY,KIND,INILOC,KNTCHR,MAXNAM,
2MAXFLG,KONTNT,MINPRT)
GO TO(11,11,14,16,18,19),KIND
C
C END OF LINE, END OF FILE OR SEMICOLON FOUND
10 KIND=1
IEOF=0
11 IF(IAFTER.LT.0)GO TO 15
IF(IAFTER.EQ.1)GO TO 15
IF(KNTFIL.GT.0)GO TO 13
IF(LCNRIT.EQ.0)GO TO 17
IF(KIND.EQ.2)GO TO 12
IF(IEOF.EQ.0)GO TO 33
GO TO 6
12 KIND=3
GO TO 33
13 IF(KIND.EQ.2)LOWBFR=LOWBFR-1
GO TO 29
C
C EQUAL SIGN FOUND
14 IF(IAFTER.GT.0)GO TO 27
MANY=-1
IAFTER=0
LCNRIT=-1
GO TO 9
C
C AMPERSAND FOUND OR MORE FILES NEEDED
15 KNTFIL=KNTFIL-1
MANY=-1
IAFTER=0
16 INIKND=0
17 IF(KIND.EQ.2)GO TO 9
IF(IEOF.NE.0)GO TO 6
IF(INIKND.LE.0)GO TO 2
IF(INIKND.GT.2)GO TO 2
KIND=2
GO TO 33
C
C EXTRA COMMA FOUND
18 IF(IAFTER.GT.0)GO TO 27
KNTFIL=KNTFIL+1
LNGFIL(KNTFIL)=0
IAFTER=1
GO TO 22
C
C STORE FILE SPECIFICATION
19 IF(KONTNT.EQ.0)GO TO 23
IF(IAFTER.GT.0)GO TO 28
NXTFIL=KNTFIL+1
LNGFIL(NXTFIL)=0
IF(MAXNAM.LE.0)GO TO 21
J=KNTCHR(1)
IF(J.GT.MAXCHR)J=MAXCHR
IF(J.LE.0)GO TO 21
LNGFIL(NXTFIL)=J
K=INILOC(1)
DO 20 I=1,J
LTRFIL(I,NXTFIL)=LTRCMD(K)
20 K=K+1
21 IF(KONTNT.GE.2)GO TO 24
KNTFIL=NXTFIL
IAFTER=2
22 IF(LCNRIT.NE.0)GO TO 9
IF(KNTFIL.LT.MAXFIL)IAFTER=IAFTER-2
GO TO 9
C
C ALLOW CALLING PROGRAM TO EVALUATE SWITCH
23 LCNOWN=KNTFIL
KIND=6
IF(MANY.GT.0)GO TO 33
IF(IAFTER.GT.0)GO TO 28
MANY=-1
LCNOWN=LCNOWN+1
GO TO 33
C
C OPEN COMMAND FILE SPECIFIED BY USER
24 CALL REOPEN(1,ICMD,NXTFIL,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,I,IERR)
IF(IERR.EQ.0)GO TO 6
J=LNGFIL(NXTFIL)
IF(J.LE.0)GO TO 26
WRITE(ITTY,25)(LTRFIL(I,NXTFIL),I=1,J)
25 FORMAT(' Cannot read command file ',100A1)
GO TO 2
26 WRITE(ITTY,25)
GO TO 2
C
C PREPARE TO RETURN RESULTS TO CALLING PROGRAM
27 MANY=-1
GO TO 29
28 LOWBFR=MINPRT
29 IAFTER=0
IF(LCNRIT.GT.0)GO TO 31
KIND=4
IF(LCNRIT.LT.0)GO TO 32
LCNRIT=1
GO TO 33
30 LCNRIT=LCNRIT+1
31 IF(LCNRIT.GT.KNTFIL)GO TO 8
KIND=5
GO TO 33
32 LCNRIT=KNTFIL
C
C RETURN TO CALLING PROGRAM
33 RETURN
END
SUBROUTINE REFLAG(LOWSTR,MAXSTR,MAXBFR,LTRCMD,LOWBFR,
1 MANY ,KIND ,INILOC,KNTCHR,MAXNAM,MAXFLG,KONTNT,
2 MINPRT)
C RENBR(REFLG5/PDP10 FIND SWITCHES AND FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO LOCATE FILE SPECIFICATIONS AND SWITCHES IN
C TEXT TYPED BY USER. THE FILE SPECIFICATION OR THE
C COMPONENTS OF THE SWITCH FIELD ARE IDENTIFIED BY
C LOCATION AND LENGTH IN THE BUFFER.
C
C THE FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C LOWSTR = SUBSCRIPT OF FIRST LOCATION WITHIN INILOC
C AND KNTCHR WHICH CAN BE USED TO HOLD
C POSITION AND LENGTH OF FILE SPECIFICATION OR
C OF COMPONENTS OF SWITCH.
C MAXSTR = SUBSCRIPT OF FINAL LOCATION WITHIN INILOC
C AND KNTCHR WHICH CAN BE USED TO HOLD
C POSITION AND LENGTH OF FILE SPECIFICATION OR
C OF COMPONENTS OF SWITCH.
C MAXBFR = SUBSCRIPT OF LOCATION WITHIN LTRCMD ARRAY
C WHICH CONTAINS RIGHTMOST CHARACTER TYPED BY
C USER.
C
C FOLLOWING ARGUMENTS ARE USED FOR BOTH INPUT TO, AND
C OUTPUT FROM THIS ROUTINE.
C
C LTRCMD = ARRAY CONTAINING IN LOCATIONS LTRCMD(LOWBFR)
C THROUGH LTRCMD(MAXBFR) CHARACTERS READ BY
C CALLING PROGRAM WITH MULTIPLE OF A1 FORMAT
C AND WHICH CAN FORM FILE SPECIFICATION.
C CONTENTS OF LTRCMD ARRAY ARE RETURNED
C UNCHANGED, WITH EXCEPTION THAT PORTION OF
C TEXT STRING TO RIGHT OF ADJACENT APOSTROPHES
C IS MOVED 1 CHARACTER TO LEFT.
C LOWBFR = SUBSCRIPT OF FIRST (LEFTMOST) LOCATION
C WITHIN LTRCMD ARRAY WHICH CONTAINS CHARACTER
C WHICH CAN BE PART OF FILE SPECIFICATION.
C LOWBFR IS RETURNED POINTING TO FIRST
C CHARACTER WHICH SHOULD BE EVALUATED BY
C SUBSEQUENT CALL TO THIS ROUTINE, OR ELSE IS
C RETURNED POINTING BEYOND END OF BUFFER IF
C BUFFER IS EMPTY OR IF BUFFER CONTAINS MERELY
C COMMENT.
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF A NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF A LINE
C OF TEXT NOT TIED TO THE PREVIOUS LINE BY AN
C AMPERSAND AT THE END OF THE PREVIOUS LINE,
C OR WHEN PROCESSING THE TEXT TO THE RIGHT OF
C A SEMICOLON OR TO THE RIGHT OF AN EQUALS
C SIGN.
C = RETURNED CONTAINING THE VALUE WHICH MANY
C SHOULD HAVE WHEN THIS ROUTINE OR ANY OTHER
C IN THE FASP PACKAGE HAVING MANY AS AN
C ARGUMENT IS NEXT CALLED. THE RETURNED VALUE
C OF MANY SHOULD NOT BE CHANGED BY THE CALLING
C PROGRAM UNLESS THE INTERPRETATION OF THE
C CONTENTS OF THE BUFFER IS BEING ABANDONED
C PREMATURELY, IN WHICH CASE MANY SHOULD BE
C RESET TO HAVE A ZERO VALUE.
C = -1, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING -1 IF
C A COMMA PRECEDES EITHER AN AMPERSAND OR A
C SWITCH FIELD.
C = 0, RETURNED IF A MISSING ITEM IS TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA, BUT A MISSING ITEM IS NOT
C INDICATED IF THE BUFFER CONTAINS NOTHING
C OTHER THAN A POSSIBLE COMMENT. MANY IS
C RETURNED CONTAINING ZERO IF BUFFER IS FOUND
C TO BE EMPTY, OR IF FIRST PRINTING CHARACTER
C AT OR TO RIGHT OF LTRCMD(LOWBFR) IS FOUND TO
C BE EXCLAMATION POINT, SEMICOLON OR EQUALS
C SIGN. THESE ARE ALL CONDITIONS UNDER WHICH
C NEXT CALL TO THIS ROUTINE WOULD EVALUATE
C START OF NEW GROUP OF FILE SPECIFICATIONS.
C MANY IS RETURNED UNCHANGED IF A SWITCH FIELD
C IS FOUND AT THE START OF THE CONTENTS OF THE
C BUFFER.
C = 1, RETURNED IF A MISSING ITEM IS NOT TO BE
C INDICATED IF THE NEXT ROUTINE ENCOUNTERS A
C LEADING COMMA OR FINDS THAT THE BUFFER
C CONTAINS NOTHING OTHER THAN A POSSIBLE
C COMMENT. MANY IS RETURNED CONTAINING ONE IF
C A FILE SPECIFICATION CONSISTING OF MORE THAN
C JUST A SWITCH FIELD IS FOUND, OR IF A
C MISSING ITEM IS BEING INDICATED.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT. THEIR
C INPUT VALUES ARE IGNORED.
C
C KIND = RETURNED DESCRIBING TYPE OF ITEM
C ENCOUNTERED.
C = 1, NOTHING, EXCEPT POSSIBLY COMMENT
C INDICATED BY LEADING EXCLAMATION POINT, WAS
C FOUND AT OR TO RIGHT OF LTRCMD(LOWBFR).
C LOWBFR IS RETURNED POINTING BEYOND END OF
C BUFFER.
C = 2, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS SEMICOLON. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C SEMICOLON. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS INDICATION BY USER
C THAT PRECEDING COMMAND HAS BEEN COMPLETED
C AND THAT SUBSEQUENT COMMAND WILL FOLLOW ON
C SAME LINE.
C = 3, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS EQUALS SIGN. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO RIGHT OF
C EQUALS SIGN.
C = 4, FIRST PRINTING CHARACTER AT OR TO RIGHT
C OF LTRCMD(LOWBFR) IS AMPERSAND. CHARACTERS
C TO RIGHT OF AMPERSAND ARE TAKEN TO BE
C COMMENT. LOWBFR IS RETURNED POINTING BEYOND
C END OF BUFFER. IT IS SUGGESTED THAT CALLING
C PROGRAM TREAT THIS AS REQUEST BY USER THAT
C COMMAND BE CONTINUED ON FOLLOWING LINE.
C EFFECT IS NOT QUITE SAME AS IF USER HAD
C TYPED ALL OF FILE SPECIFICATIONS ON SINGLE
C LINE SINCE FILE SPECIFICATION CANNOT BE
C SPLIT ACROSS LINE BOUNDARY.
C = 5, MISSING FILE SPECIFICATION WAS INDICATED
C BY AN EXTRA COMMA.
C = 6, FILE SPECIFICATION IS BEING RETURNED IF
C MAXNAM IS RETURNED EQUAL TO LOWSTR, OR
C SWITCH IS RETURNED IF MAXFLG IS RETURNED SET
C GREATER THAN OR EQUAL TO LOWSTR.
C INILOC = IF KIND IS RETURNED CONTAINING 6 AND MAXNAM
C IS RETURNED SET EQUAL TO LOWSTR, THEN
C INILOC(LOWSTR) IS RETURNED CONTAINING THE
C SUBSCRIPT OF THE LTRCMD ARRAY LOCATION WHICH
C CONTAINS THE FIRST PRINTING CHARACTER OF THE
C FILE SPECIFICATION AND KNTCHR(LOWSTR) IS
C RETURNED CONTAINING THE NUMBER OF CHARACTERS
C (INCLUDING EMBEDDED SPACES) IN THE FILE
C SPECIFICATION.
C = IF KIND IS RETURNED CONTAINING 6 AND MAXFLG
C IS RETURNED SET TO LOWSTR OR GREATER, THEN
C LOCATIONS INILOC(LOWSTR) THROUGH
C INILOC(MAXFLG) CONTAIN LOCATIONS IN BUFFER
C OF INITIAL CHARACTERS OF WORDS IN SWITCH
C FIELD, AND LOCATIONS KNTCHR(LOWSTR) THROUGH
C KNTCHR(MAXFLG) CONTAINING NUMBERS OF
C CHARACTERS IN WORDS IN SWITCH FIELD. IF A
C TEXT STRING DELIMITED BY APOSTROPHES IS
C FOUND, THEN MAXFLG WILL BE RETURNED SET TO
C LOWSTR, AND THE INITIAL APOSTROPHE WILL BE
C POINTED TO BY INILOC(LOWSTR).
C KNTCHR = ARRAY RETURNED CONTAINING NUMBERS OF
C CHARACTERS IN EACH OF WORDS FOR WHICH FIRST
C CHARACTERS ARE IN BUFFER LOCATIONS INDICATED
C BY VALUES IN INILOC ARRAY. SUBSCRIPTS OF
C INILOC ARRAY AND KNTCHR ARRAY LOCATIONS
C DESCRIBING PARTICULAR WORD ARE IDENTICAL.
C MAXNAM = RETURNED SET TO LOWSTR-1 IF A FILE
C SPECIFICATION WAS NOT FOUND.
C = RETURNED SET TO LOWSTR IF A FILE
C SPECIFICATION WAS FOUND.
C MAXFLG = RETURNED SET TO LOWSTR-1 IF A SWITCH FIELD
C OR TEXT STRING DELIMITED BY APOSTROPHES WAS
C NOT FOUND.
C = IF A SWITCH FIELD OR TEXT STRING DELIMITED
C BY APOSTROPHES WAS FOUND, THEN MAXFLG IS
C RETURNED CONTAINING SUBSCRIPT OF INILOC AND
C KNTCHR ARRAY LOCATIONS DESCRIBING RIGHTMOST
C WORD OF SWITCH FIELD.
C KONTNT = 0, NEITHER FILE SPECIFICATION NOR AT SIGN
C FOUND.
C = 1, FILE SPECIFICATION BUT NOT AT SIGN FOUND.
C = 2, AT SIGN BUT NOT FILE SPECIFICATION FOUND.
C = 3, BOTH FILE SPECIFICATION AND AT SIGN
C FOUND.
C MINPRT = SUBSCRIPT OF LTRCMD ARRAY LOCATION WHICH
C CONTAINS FIRST CHARACTER OF FILE
C SPECIFICATION OR SWITCH IF KIND IS RETURNED
C CONTAINING VALUE OF 6.
C
DIMENSION KNTCHR(MAXSTR),INILOC(MAXSTR),
1LTRCMD(MAXBFR)
C
CHARACTER *1 LTRAND,LTRATS,LTRCLN,LTRCLS,LTRCMA,
1 LTRCMD,LTREQL,LTREXC,LTRNOW,LTROPN,LTRQOT,
2 LTRSEM,LTRSLA,LTRSPC,LTRTAB
C
C CCCC AAA UU UU TTTTTTTT IIII OOOO NN NN
C CC AAAA UU UU TT II OO OO NNN NN
C CC AA AA UU UU TT II OO OO NNNN NN
C CC AA AA UU UU TT II OO OO NN NN NN
C CC AAAAAAA UU UU TT II OO OO NN NNNN
C CC AA AA UU UU TT II OO OO NN NNN
C CCCC AA AA UUU TT IIII OOOO NN NN
C
C LEFT AND RIGHT SQUARE BRACKETS MUST BE DEFINED USING
C OCTAL NOTATION FOR PDP10 F40 COMPILER. LET FOLLOWING
C COMMENT BE THE COMPILED DATA STATEMENT IF F40 IS USED
C DATA LTROPN,LTRCLS/"555004020100,"565004020100/
DATA LTROPN,LTRCLS/'[',']'/
C
DATA LTRCLN,LTRCMA,LTRSLA,LTRQOT,LTRSEM,
1LTRAND,LTREXC,LTREQL,LTRATS/
2':',',','/','''',';','&','!','=','@'/
DATA LTRSPC/' '/,LTRTAB/' '/
C
C MAJOR = -2 OR LESS, NAME IN RANGE OF LEFT BRACKET
C = -1, NAME BUT NOT IN RANGE OF LEFT BRACKET
C = 0, NEITHER NAME OR SWITCH FOUND YET
C = 1, AFTER SLASH OR COLON AFTER SLASH
C
MAXNAM=0
MAXFLG=0
KONTNT=0
KIND=1
MAJOR=0
IF(MANY.GE.0)GO TO 3
KIND=5
MANY=1
GO TO 3
1 KOUNT=0
INIBFR=LOWBFR
2 LOWBFR=LOWBFR+1
3 IF(LOWBFR.GT.MAXBFR)GO TO 24
LTRNOW=LTRCMD(LOWBFR)
IF(LTRNOW.EQ.LTRSPC)GO TO 2
IF(LTRNOW.EQ.LTRTAB)GO TO 2
IF(MAJOR.EQ.0)MINPRT=LOWBFR
C
C CHECK FOR GENERAL PUNCTUATION CHARACTERS
IF(LTRNOW.EQ.LTRSEM)GO TO 19
IF(LTRNOW.EQ.LTRAND)GO TO 22
IF(LTRNOW.EQ.LTREXC)GO TO 23
IF(LTRNOW.EQ.LTREQL)GO TO 20
IF(LTRNOW.EQ.LTRSLA)GO TO 16
IF(LTRNOW.EQ.LTRATS)GO TO 14
IF(LTRNOW.EQ.LTRQOT)GO TO 9
IF(MAJOR.LT.-1)GO TO 8
IF(LTRNOW.EQ.LTRCMA)GO TO 18
IF(MAJOR.EQ.0)GO TO 4
IF(KOUNT.GT.0)GO TO 5
4 INIBFR=LOWBFR
IF(MAJOR.LE.0)GO TO 7
5 IF(MAJOR.LE.0)GO TO 8
C
C EXTEND SWITCH FIELD
6 IF(LTRNOW.EQ.LTRCLN)GO TO 26
IF((INIBFR+KOUNT).LT.LOWBFR)GO TO 24
KOUNT=KOUNT+1
GO TO 2
C
C FIRST CHARACTER IN NAME
7 INDRCT=MANY
IF(KIND.EQ.5)INDRCT=-1
MANY=1
KIND=6
MAJOR=-1
C
C EXTEND NAME
8 KOUNT=LOWBFR-INIBFR+1
IF(LTRNOW.EQ.LTROPN)MAJOR=MAJOR-1
IF(LTRNOW.EQ.LTRCLS)MAJOR=MAJOR+1
IF(MAJOR.GE.0)MAJOR=-1
GO TO 2
C
C APOSTROPHE STARTS TEXT STRING
9 IF(MAJOR.NE.0)GO TO 24
IF(KIND.EQ.5)MANY=-1
KIND=6
INIBFR=LOWBFR
I=LOWBFR
MIDPRT=LOWBFR
10 IF(I.GE.MAXBFR)GO TO 12
I=I+1
LOWBFR=LOWBFR+1
LTRCMD(LOWBFR)=LTRCMD(I)
IF(LTRCMD(I).EQ.LTRSPC)GO TO 10
IF(LTRCMD(I).EQ.LTRTAB)GO TO 10
MIDPRT=LOWBFR
IF(LTRCMD(I).NE.LTRQOT)GO TO 10
IF(I.GE.MAXBFR)GO TO 11
IF(LTRCMD(I+1).NE.LTRQOT)GO TO 11
I=I+1
GO TO 10
11 MIDPRT=MIDPRT-1
12 KOUNT=MIDPRT-INIBFR+1
13 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.I)GO TO 26
LTRCMD(LOWBFR)=LTRSPC
GO TO 13
C
C AT SIGN
14 IF(MAJOR.GT.0)GO TO 24
IF(KONTNT.GE.2)GO TO 24
KONTNT=KONTNT+2
IF(MAJOR.EQ.0)GO TO 15
MANY=INDRCT
GO TO 24
15 MAJOR=-1
GO TO 17
C
C INITIAL SLASH FOUND
16 IF(MAJOR.NE.0)GO TO 24
MAJOR=1
17 IF(KIND.EQ.5)MANY=-1
KIND=6
GO TO 1
C
C COMMA FOUND OTHER THAN IN NUMBER SECTION
18 IF(KIND.NE.1)GO TO 24
KIND=5
IF(MANY.GT.0)GO TO 2
GO TO 29
C
C SEMICOLON FOUND
19 IF(KIND.NE.1)GO TO 24
KIND=2
GO TO 21
C
C EQUALS SIGN FOUND
20 IF(KIND.NE.1)GO TO 24
KIND=3
21 LOWBFR=LOWBFR+1
GO TO 29
C
C AMPERSAND FOUND
22 IF(MAJOR.NE.0)GO TO 24
IF(KIND.EQ.5)MANY=-1
KIND=4
C
C EXCLAMATION POINT FOUND
23 LOWBFR=MAXBFR+1
C
C TERMINATE GROUP OF NAMES OR NUMBERS
24 IF(MAJOR.EQ.0)GO TO 29
IF(MAJOR.GT.0)GO TO 25
IF(KONTNT.EQ.0)KONTNT=1
IF(KONTNT.EQ.2)KONTNT=3
MAXNAM=1
KNTCHR(1)=KOUNT
INILOC(1)=INIBFR
GO TO 29
25 MAJOR=0
26 IF(MAXFLG.GE.MAXSTR)GO TO 28
MAXFLG=MAXFLG+1
27 KNTCHR(MAXFLG)=KOUNT
INILOC(MAXFLG)=INIBFR
28 IF(MAJOR.GT.0)GO TO 1
C
C RETURN TO CALLING PROGRAM
29 IF(KIND.EQ.5)MANY=1
IF(KIND.LT.4)MANY=0
RETURN
END
SUBROUTINE REOPEN(KNDFIL,IUNIT,LOCFIL,LNGFIL,LTRFIL,
1MAXFIL,MAXCHR,ITRACE,ITTY,LPTTTY,NOTOPN)
C RENBR(REOPN5/PDP10 OPEN INPUT AND OUTPUT FILES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS DECSYSTEM10 ROUTINE OPENS THE INPUT AND OUTPUT
C FILES WHICH HAVE BEEN SPECIFIED BY THE USER. THE
C REPART ROUTINE IS FIRST CALLED TO SPLIT THE FILE
C SPECIFICATION INTO ITS COMPONENT PARTS: THE DEVICE
C NAME, THE FILE NAME, AND THE DIRECTORY. MISSING
C COMPONENTS ARE SUPPLIED BY THIS ROUTINE, AND THE
C FILES ARE THEN OPENED.
C
C KNDFIL = SPECIFIES TYPE OF FILE TO BE OPENED.
C = 1, OPEN INPUT COMMAND FILE.
C = 2, OPEN FIRST INPUT SOURCE FILE. OUTPUT
C FILES HAVE NOT YET BEEN OPENED.
C = 3, OPEN OUTPUT RENUMBERED FILE.
C = 4, OPEN OUTPUT LISTING FILE.
C = 5, OPEN SECOND OR SUBSEQUENT INPUT SOURCE
C FILE. ALL OUTPUT FILES HAVE ALREADY BEEN
C OPENED.
C IUNIT = NUMBER SELECTING THE DEVICE UPON WHICH THE
C FILE IS TO BE OPENED.
C LOCFIL = SERIAL NUMBER WITHIN THE LNGFIL AND LTRFIL
C ARRAYS OF THE DESCRIPTION OF THE CURRENT
C FILE RELATIVE TO THE DESCRIPTIONS OF ALL
C FILES.
C LNGFIL = ARRAY CONTAINING NUMBERS OF CHARACTERS IN
C FILE DESCRIPTIONS IN THE LTRFIL ARRAY.
C LTRFIL = ARRAY CONTAINING THE FILE DESCRIPTIONS TYPED
C BY THE USER.
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C MAXCHR = MAXIMUM NUMBER OF CHARACTERS IN ANY 1 FILE
C DESCRIPTION IN THE LTRFIL ARRAY.
C ITRACE = 0, INPUT IF DESCRIPTIONS OF FILES ARE NOT TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C = 1, INPUT IF USER SELECTS /Z SWITCH
C INDICATING THAT DESCRIPTIONS OF FILES ARE TO
C BE WRITTEN TO USER TERMINAL WHENEVER FILES
C ARE OPENED.
C ITTY = UNIT NUMBER TO WHICH DESCRIPTIONS ARE
C WRITTEN IF ITRACE=1.
C LPTTTY = INPUT CONTAINING 0 IF USER DID NOT SPECIFY
C /V SWITCH. THE /V SWITCH FORCES THE LISTING
C TO BE WRITTEN ONTO THE CONTROLLING TERMINAL.
C = INPUT CONTAINING 1 IF USER SPECIFIED /V
C SWITCH.
C = RETURNED SET TO 1 IF LPTTTY WAS INPUT SET TO
C 1 OR IF THE NAME OF THE OUTPUT DEVICE FOR
C THE LISTING WAS TTY:.
C NOTOPN = RETURNED SET TO 0 IF FILE WAS SUCCESSFULLY
C OPENED.
C = RETURNED SET TO 1 IF FILE COULD NOT BE
C OPENED.
C
C MISONE = NUMBER OF CHARACTERS IN PATH SPECIFICATION
C ISSUED EARLIER IN THE LIST OF INPUT FILES.
COMMON/RNBTEN/MISONE
C
C NUMBER OF CHARACTERS IN PARTS OF FILE SPECIFICATION
C MAXDVC = NUMBER OF CHARACTERS IN LTRDVC, LTRDFD, LA5DVC
C MAXPTH = NUMBER OF CHARACTERS IN LTRPTH, LTRDFP, LA5PTH
C MAXNAM = NUMBER OF CHARACTERS IN LTRNAM, LTRDFN, LA5NAM
C
C ARRAYS HOLDING PORTIONS OF PREVIOUS FILE SPECIFICATION
COMMON/RNBELE/LTRDFD(40),LTRDFP(40),LTRDFN(40)
C
C ARRAYS HOLDING PORTIONS OF CURRENT FILE SPECIFICATION
DIMENSION LTRDVC(40),LTRPTH(40),LTRNAM(40)
C
C ARRAYS HOLDING PACKED CHARACTERS FOR OPEN STATEMENTS
CHARACTER LA5DVC*40,LA5PTH*40,LA5NAM*40
C
C ARRAYS HOLDING BUILT IN DEFAULT NAMES
DIMENSION LNGFIL(MAXFIL),LTRFIL(MAXCHR,MAXFIL),
1LTREXT(15),LTRRNB(5),
2LTRTTY(5),LWRTTY(3),LTRDSK(5),LTRLPT(5),LWRLPT(3)
C
C CHARACTER STATEMENTS
CHARACTER*1 LTRDOT,LTRDSK,LTRDVC,LTREXT,LTRFIL,
1 LTRDFN,LTRLPT,LTRNAM,LTRDFD,LTRRNB,LTRPTH,
2 LTRDFP,LTRSPC,LTRTTY,LWRLPT,LWRTTY
C
C MAXDVC = MAXIMUM LENGTH OF DEVICE NAME
C MAXNAM = MAXIMUM LENGTH OF FILE NAME
C MAXPTH = MAXIMUM LENGTH OF ACCOUNT NAME
DATA MAXDVC,MAXNAM,MAXPTH/40,40,40/
C
C DEFAULTS IF NOTHING TYPED BY USER
DATA LTREXT/'R','N','B',
1 'F','O','R',
2 'N','E','W',
3 'L','P','T',
4 'F','O','R'/
DATA LTRRNB/'R','E','N','B','R'/
DATA LTRTTY/'T','T','Y',' ',' '/
DATA LWRTTY/'t','t','y'/
DATA LTRDSK/'D','S','K',' ',' '/
DATA LTRLPT/'L','P','T',' ',' '/
DATA LWRLPT/'l','p','t'/
DATA LTRDOT,LTRSPC/'.',' '/
C
C PARSE DECSYSTEM10 FILE SPECIFICATION
CALL REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1MAXNAM,LNGNAM,LTRNAM,MAXDVC,LNGDVC,LTRDVC,
2MAXPTH,LNGPTH,LTRPTH)
C
C CHECK IF MUST SUPPLY DEFAULT FILE NAME OR IF MUST STORE NAME
IF(LNGNAM.EQ.0)GO TO 1
IF(LTRNAM(1).EQ.LTRDOT)GO TO 1
C 1=COMMAND,2=FIRST INPUT,3=RENUMBERED,4=LISTING,5=NEXT INPUT
GO TO(14,2,14,14,14),KNDFIL
1 GO TO(4,46,8,8,46),KNDFIL
C
C IF FIRST INPUT FILE, SAVE PORTION OF NAME LEFT OF PERIOD
2 J=0
DO 3 I=1,MAXNAM
IF(LTRNAM(I).EQ.LTRDOT)J=1
LTRDFN(I)=LTRSPC
IF(J.EQ.0)LTRDFN(I)=LTRNAM(I)
3 CONTINUE
GO TO 14
C
C FOR COMMAND FILE, IF NOTHING IS LEFT OF PERIOD,
C THEN INSERT RENBR AS FIRST PART OF FILE NAME
4 I=MAXNAM
J=MAXNAM-5
5 IF(J.LE.0)GO TO 6
LTRNAM(I)=LTRNAM(J)
I=I-1
J=J-1
GO TO 5
6 IF(I.LE.0)GO TO 7
LTRNAM(I)=LTRRNB(I)
I=I-1
GO TO 6
7 GO TO 14
C
C FOR RENUMBERED OR LISTING FILE, IF NOTHING IS LEFT OF PERIOD,
C THEN INSERT FIRST PART OF NAME OF FIRST INPUT FILE
8 J=0
DO 9 I=1,MAXNAM
IF(LTRDFN(I).EQ.LTRSPC)GO TO 10
9 J=J+1
10 I=MAXNAM
J=MAXNAM-J
11 IF(J.LE.0)GO TO 12
LTRNAM(I)=LTRNAM(J)
I=I-1
J=J-1
GO TO 11
12 IF(I.LE.0)GO TO 13
LTRNAM(I)=LTRDFN(I)
I=I-1
GO TO 12
13 GO TO 14
C
C SUPPLY DEFAULT EXTENSION IF NEEDED
14 K=0
DO 15 I=1,MAXNAM
IF(LTRNAM(I).EQ.LTRDOT)GO TO 17
IF(LTRNAM(I).NE.LTRSPC)GO TO 15
IF(K.EQ.0)K=I
15 CONTINUE
IF(K.EQ.0)GO TO 17
LTRNAM(K)=LTRDOT
J=(3*KNDFIL)-2
DO 16 I=1,3
IF(K.GE.MAXNAM)GO TO 17
K=K+1
LTRNAM(K)=LTREXT(J)
16 J=J+1
17 CONTINUE
C
C SUPPLY DEFAULT DEVICE IF NEEDED
IF(LNGDVC.EQ.0)GO TO 23
GO TO(34,30,34,18,30),KNDFIL
18 DO 19 I=1,3
IF(LTRDVC(I).EQ.LTRTTY(I))GO TO 19
IF(LTRDVC(I).NE.LWRTTY(I))GO TO 20
19 CONTINUE
LPTTTY=1
GO TO 34
20 DO 21 I=1,3
IF(LTRDVC(I).EQ.LTRLPT(I))GO TO 21
IF(LTRDVC(I).NE.LWRLPT(I))GO TO 22
21 CONTINUE
LPTTTY=-1
GO TO 34
22 LPTTTY=0
GO TO 34
23 GO TO(28,28,28,24,32),KNDFIL
24 IF(LPTTTY.GT.0)GO TO 26
LNGDVC=3
DO 25 I=1,LNGDVC
25 LTRDVC(I)=LTRLPT(I)
LPTTTY=-1
GO TO 34
26 LNGDVC=3
DO 27 I=1,LNGDVC
27 LTRDVC(I)=LTRTTY(I)
GO TO 34
28 LNGDVC=3
DO 29 I=1,LNGDVC
29 LTRDVC(I)=LTRDSK(I)
IF(KNDFIL.NE.2)GO TO 34
30 DO 31 I=1,MAXDVC
31 LTRDFD(I)=LTRDVC(I)
GO TO 34
32 DO 33 I=1,MAXDVC
33 LTRDVC(I)=LTRDFD(I)
C
C SUPPLY DEFAULT PATH IF NEEDED
34 GO TO(39,37,39,39,35),KNDFIL
35 IF(LNGPTH.NE.0)GO TO 37
LNGPTH=MISONE
DO 36 I=1,MAXPTH
36 LTRPTH(I)=LTRDFP(I)
37 MISONE=LNGPTH
DO 38 I=1,MAXPTH
38 LTRDFP(I)=LTRPTH(I)
C
C CONVERT USER SPECIFIED INFORMATION TO A5 FORM
39 WRITE(LA5DVC,40)LTRDVC
40 FORMAT(40A1)
WRITE(LA5NAM,41)LTRNAM
41 FORMAT(40A1)
WRITE(LA5PTH,42)LTRPTH
42 FORMAT(40A1)
C
C ATTEMPT TO OPEN THE FILE
NOTOPN=0
IF(KNDFIL.EQ.3)GO TO 44
IF(KNDFIL.EQ.4)GO TO 44
C
C OPEN INPUT FILE
IF(LNGPTH.NE.0)GO TO 43
C SEPARATE OPEN IF NO PATH, SINCE WANT LOCAL FILE
OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1ACCESS='SEQIN',ERR=46)
GO TO 47
43 OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1DIRECTORY=LA5PTH,ACCESS='SEQIN',ERR=46)
GO TO 47
C
C OPEN OUTPUT FILE
44 IF(LNGPTH.NE.0)GO TO 45
C SEPARATE OPEN IF NO PATH, SINCE WANT LOCAL FILE
OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1ACCESS='SEQOUT',ERR=46)
GO TO 47
45 OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1DIRECTORY=LA5PTH,ACCESS='SEQOUT',ERR=46)
GO TO 47
C
C RETURN TO CALLING PROGRAM
46 NOTOPN=1
47 IF(ITRACE.NE.0)WRITE(ITTY,48)KNDFIL,NOTOPN,LA5DVC,
1LA5NAM,LA5PTH
48 FORMAT(1X,'KND',1I2,1X,'ERR',I2,1X/
1' DEVICE: ',1A40/' NAME: ',1A40/' PATH: ',1A40)
RETURN
END
SUBROUTINE REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1MAXNAM,LNGNAM,LTRNAM,MAXDVC,LNGDVC,LTRDVC,
2MAXPTH,LNGPTH,LTRPTH)
C RENBR(REPRT5/PDP10 FIND COMPONENTS OF FILE NAMES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS DECSYSTEM10 ROUTINE SPLITS THE FILE
C SPECIFICATION TYPED BY THE USER INTO ITS COMPONENT
C PARTS.
C
C MAXFIL = 1 MORE THAN NUMBER OF FILE SPECIFICATIONS
C WHICH CAN APPEAR TO LEFT OF EQUAL SIGN.
C THIS IS MAXIMUM VALUE OF SUBSCRIPT OF LNGFIL
C ARRAY AND MAXIMUM VALUE OF SECOND SUBSCRIPT
C OF LTRFIL ARRAY.
C LTRFIL = ARRAY CONTAINING THE FILE DESCRIPTIONS TYPED
C BY THE USER.
C MAXCHR = MAXIMUM NUMBER OF CHARACTERS IN ANY 1 FILE
C DESCRIPTION IN THE LTRFIL ARRAY.
C LOCFIL = SERIAL NUMBER WITHIN THE LNGFIL AND LTRFIL
C ARRAYS OF THE DESCRIPTION OF THE CURRENT
C FILE RELATIVE TO THE DESCRIPTIONS OF ALL
C FILES.
C LNGFIL = ARRAY CONTAINING NUMBERS OF CHARACTERS IN
C FILE DESCRIPTIONS IN THE LTRFIL ARRAY.
C MAXNAM = MAXIMUM NUMBER OF CHARACTERS IN FILE NAME.
C LNGNAM = RETURNED WITH LENGTH OF FILE NAME.
C LTRNAM = RETURNED CONTAINING FILE NAME.
C MAXDVC = MAXIMUM NUMBER OF CHARACTERS IN DEVICE NAME.
C LNGDVC = RETURNED WITH LENGTH OF DEVICE NAME.
C LTRDVC = RETURNED CONTAINING DEVICE NAME.
C MAXPTH = MAXIMUM NUMBER OF CHARACTERS IN ACCOUNT NAME
C LNGPTH = RETURNED WITH LENGTH OF ACCOUNT NAME.
C LTRPTH = RETURNED CONTAINING ACCOUNT NAME.
C
DIMENSION LTRFIL(MAXCHR,MAXFIL),LNGFIL(MAXFIL),
1LTRDVC(MAXDVC),LTRPTH(MAXPTH),LTRNAM(MAXNAM)
C
CHARACTER*1 LTRCLN,LTRCLS,LTRCMA,LTRDOT,
1 LTRDVC,LTRFIL,LTRNAM,LTRNOW,LTROPN,LTRPTH,
2 LTRSPC,LTRTAB,LTRLES,LTRGRE
C
DATA LTROPN,LTRCLS/'[',']'/
DATA LTRLES,LTRGRE/'<','>'/
DATA LTRDOT,LTRCLN,LTRCMA/
1'.',':',','/
DATA LTRSPC/' '/,LTRTAB/' '/
MAXPRT=0
IF(LOCFIL.GT.0)MAXPRT=LNGFIL(LOCFIL)
C
C LOCATE ACCOUNT NAME INSIDE SQUARE OR ANGLE BRACKETS
INIPTH=0
1 INIPTH=INIPTH+1
IF(INIPTH.GT.MAXPRT)GO TO 4
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTROPN)GO TO 2
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTRLES)GO TO 2
GO TO 1
2 LMTPTH=INIPTH
3 LMTPTH=LMTPTH+1
IF(LMTPTH.GT.MAXPRT)GO TO 5
IF(LTRFIL(LMTPTH,LOCFIL).EQ.LTRCLS)GO TO 5
IF(LTRFIL(LMTPTH,LOCFIL).EQ.LTRGRE)GO TO 5
GO TO 3
4 LMTPTH=INIPTH-1
5 CONTINUE
C
C LOCATE DEVICE NAME TO LEFT OF COLON
LMTDSK=0
6 LMTDSK=LMTDSK+1
IF(LMTDSK.GT.MAXPRT)GO TO 8
IF(LMTDSK.LT.INIPTH)GO TO 7
IF(LMTDSK.GT.LMTPTH)GO TO 7
LMTDSK=LMTPTH
GO TO 6
7 IF(LTRFIL(LMTDSK,LOCFIL).NE.LTRCLN)GO TO 6
INIDSK=1
IF(INIPTH.GT.LMTPTH)GO TO 9
IF(LMTDSK.GT.LMTPTH)INIDSK=LMTPTH+1
GO TO 9
8 INIDSK=LMTDSK+1
9 CONTINUE
C
C LOCATE FILE NAME
ININAM=0
IF(INIDSK.LE.LMTDSK)ININAM=LMTDSK
10 ININAM=ININAM+1
IF(ININAM.GT.MAXPRT)GO TO 12
IF(ININAM.GT.LMTPTH)GO TO 11
IF(ININAM.LT.INIPTH)GO TO 11
ININAM=LMTPTH
GO TO 10
11 IF(LTRFIL(ININAM,LOCFIL).EQ.LTRSPC)GO TO 10
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRTAB)GO TO 10
LMTNAM=MAXPRT
IF(INIPTH.GT.LMTPTH)GO TO 13
IF(ININAM.LT.INIPTH)LMTNAM=INIPTH-1
GO TO 13
12 LMTNAM=ININAM-1
13 LMTNAM=LMTNAM+1
C
C COLLECT LETTERS OF DEVICE NAME
LNGDVC=0
DO 17 INDEX=1,MAXDVC
LTRDVC(INDEX)=LTRSPC
14 IF(INIDSK.GE.LMTDSK)GO TO 17
IF(LTRFIL(INIDSK,LOCFIL).EQ.LTRSPC)GO TO 15
IF(LTRFIL(INIDSK,LOCFIL).NE.LTRTAB)GO TO 16
15 INIDSK=INIDSK+1
GO TO 14
16 LTRDVC(INDEX)=LTRFIL(INIDSK,LOCFIL)
LNGDVC=INDEX
INIDSK=INIDSK+1
17 CONTINUE
C
C COLLECT LETTERS OF FILE NAME
LNGNAM=0
DO 21 INDEX=1,MAXNAM
LTRNAM(INDEX)=LTRSPC
18 IF(ININAM.GE.LMTNAM)GO TO 21
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRSPC)GO TO 19
IF(LTRFIL(ININAM,LOCFIL).NE.LTRTAB)GO TO 20
19 ININAM=ININAM+1
GO TO 18
20 LTRNAM(INDEX)=LTRFIL(ININAM,LOCFIL)
LNGNAM=INDEX
ININAM=ININAM+1
21 CONTINUE
C
C COLLECT LETTERS OF ACCOUNT NAME
LNGPTH=0
INIPTH=INIPTH+1
DO 25 INDEX=1,MAXPTH
LTRPTH(INDEX)=LTRSPC
22 IF(INIPTH.GE.LMTPTH)GO TO 25
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTRSPC)GO TO 23
IF(LTRFIL(INIPTH,LOCFIL).NE.LTRTAB)GO TO 24
23 INIPTH=INIPTH+1
GO TO 22
24 LTRPTH(INDEX)=LTRFIL(INIPTH,LOCFIL)
LNGPTH=INDEX
INIPTH=INIPTH+1
25 CONTINUE
RETURN
END
SUBROUTINE REDATE(LTRTOP)
C RENBR(REDAT5/PDP10 INSERT DATE AND TIME INTO TITLE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS ROUTINE INSERTS CURRENT DATE AND TIME SIMILAR TO
C 29-JAN-79 10:15
C INTO LEFT 15 COLUMNS OF TITLE FOR LISTING. THIS
C INFORMATION IS RETURNED IN A10 AND A5 FORM BY THE
C DATE AND TIME ROUTINES, THEN CONVERTED TO A1 FORM BY
C READ STATEMENTS.
C
CHARACTER LTRTOP(117)*1,LA5DAT*10,LA5TIM*5
CALL DATE(LA5DAT)
CALL TIME(LA5TIM)
READ(LA5DAT,1)(LTRTOP(I),I=1,9)
1 FORMAT(9A1)
READ(LA5TIM,2)(LTRTOP(I),I=11,15)
2 FORMAT(5A1)
RETURN
END