Trailing-Edge
-
PDP-10 Archives
-
decuslib10-13
-
reusr1.for
There are 6 other files named reusr1.for in the archive. Click here to see a list.
SUBROUTINE REUSER
C RENBR(REUSR1/PDP10 FILE SPECIFICATION DIALOG)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VERSION OF THE USER COMMAND DIALOG PROCESSOR
C FOR RENBR RUNS ON THE PDP-10 COMPUTER AND SHOULD BE
C COMPILED WITH VERSION 5 OR LATER OF THE FORTRAN-10
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 ITEMS WHICH MUST BE KEPT FROM LAST CALL OF REUSER
COMMON/RNBSEV/KIND,LCNRIT,LNGFIL(3)
COMMON/RNBEIG/LTRCMD(80),LTRFIL(40,3)
C
C ITEMS WHICH ARE NOT KEPT FROM LAST CALL OF REUSER
DIMENSION INILOC(3),KNTCHR(3)
DATA MAXFIL,MAXCHR,MAXSTR,MAXBFR/3,40,3,80/
DATA LTRMRK/1H'/
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(14H RENBR (03/85)/17H 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(30H Cannot write renumbered file ,100A1)
GO TO 3
68 I=LNGFIL(KNDTWO)
WRITE(ITTY,69)(LTRFIL(J,KNDTWO),J=1,I)
69 FORMAT(27H Cannot write listing file ,100A1)
GO TO 3
70 I=LNGFIL(LCNRIT)
WRITE(ITTY,71)(LTRFIL(J,LCNRIT),J=1,I)
71 FORMAT(25H Cannot read source file ,100A1)
GO TO 3
72 I=LNGFIL(LCNRIT)
WRITE(ITTY,73)(LTRFIL(J,LCNRIT),J=1,I)
73 FORMAT(25H Cannot read source file ,100A1)
GO TO 6
74 WRITE(ITTY,75)
75 FORMAT(31H Ambiguous output specification)
GO TO 3
76 WRITE(ITTY,77)
77 FORMAT(34H 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,16HAdd Block Indent,1I5)
IF(LTAB.NE.0)WRITE(ITTY,80)JTAB
80 FORMAT(2X,18HWidth OF Tab Stops,1I5)
IF(IPAGE.EQ.0)GO TO 94
WRITE(ITTY,81)
81 FORMAT(10X,15HListing 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,6HTitle ,54A1)
85 WRITE(ITTY,86)IPAGE
86 FORMAT(9X,11HPage Number,1I5)
IF(ISPACE.NE.0)WRITE(ITTY,87)ISPACE
87 FORMAT(2X,18HGap Interstatement,1I5)
IF(IFILL.EQ.0)WRITE(ITTY,88)JFORM
88 FORMAT(10X,10HForm Feeds,1I5)
IF(IFILL.NE.0)WRITE(ITTY,89)JFORM,IFORM
89 FORMAT(10X,10HLine Feeds,1I5,1H:,1I5)
IF((JMPBGN+JMPEND).NE.0)WRITE(ITTY,90)JMPBGN,JMPEND
90 FORMAT(2X,18HJump at Top/Bottom,1I5,1H:,1I5)
IF(ISPLIT.EQ.0)WRITE(ITTY,91)
91 FORMAT(3X,17HKeep Lines Intact)
I=ISPLIT-1
IF(ISPLIT.NE.0)WRITE(ITTY,92)I
92 FORMAT(4X,16HSplit Long Lines,1I5)
I=ITBL-1
IF(I.NE.0)WRITE(ITTY,93)I
93 FORMAT(1X,19HExtra Table Content,1I5)
IF(INCR.EQ.0)GO TO 106
94 WRITE(ITTY,95)
95 FORMAT(6X,19HRenumbering Options)
IF(KMDMIN.GT.0)GO TO 97
IF(KMDMIN.EQ.0)GO TO 99
WRITE(ITTY,96)
96 FORMAT(2X,18HMaintain Numbering)
GO TO 102
97 WRITE(ITTY,98)KMDMIN,KMDMAX
98 FORMAT(3X,17HModify Only Range,1I5,1H:,1I5)
99 WRITE(ITTY,100)INCR
100 FORMAT(11X,9HIncrement,1I5)
IF(IBASE.NE.0)WRITE(ITTY,101)IBASE
101 FORMAT(16X,4HBase,1I5)
102 IF(ITAB.LT.0)WRITE(ITTY,103)
103 FORMAT(20H Uniform Left Margin)
IF(ITAB.EQ.0)WRITE(ITTY,104)
104 FORMAT(7X,13HColumn Format)
IF(ITAB.GT.0)WRITE(ITTY,105)
105 FORMAT(10X,10HTab 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/15H Position paper,
137H (carriage return or local line feed)/
230H then type non-space character,
320H 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(1H )
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(REFIL1/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),
2KOLECT(10),NUMTWO(2)
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(2H *,$)
GO TO 4
2 WRITE(ITTY,3)
3 FORMAT(2H &,$)
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(26H 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(REFLG1/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
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/1H[,1H]/
C
DATA LTRCLN,LTRCMA,LTRSLA,LTRQOT,LTRSEM,
1LTRAND,LTREXC,LTREQL,LTRATS/
21H:,1H,,1H/,1H',1H;,1H&,1H!,1H=,1H@/
DATA LTRSPC/1H /,LTRTAB/1H /
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(REOPN1/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
COMMON/RNBTEN/MISONE,MISTWO
COMMON/RNBELE/LTRFIV(5),LTRSIX(6),LTRPTH(6)
DOUBLE PRECISION LA5NAM,LA5PTH(3)
DIMENSION LNGFIL(MAXFIL),LTRFIL(MAXCHR,MAXFIL),
1LTRDVC(5),LTRNAM(10),LTRSFD(6),LTREXT(15),LTRRNB(6),
2LTRTTY(5),LWRTTY(3),LTRDSK(5),LTRLPT(5),LWRLPT(3),
3NUMPTH(2)
EQUIVALENCE(NUMPTH(1),LA5PTH(1))
DATA LTREXT/1HR,1HN,1HB,
1 1HF,1HO,1HR,
2 1HN,1HE,1HW,
3 1HL,1HP,1HT,
4 1HF,1HO,1HR/
DATA LTRRNB/1HR,1HE,1HN,1HB,1HR,1H /
DATA LTRTTY/1HT,1HT,1HY,1H ,1H /
DATA LWRTTY/1Ht,1Ht,1Hy/
DATA LTRDSK/1HD,1HS,1HK,1H ,1H /
DATA LTRLPT/1HL,1HP,1HT,1H ,1H /
DATA LWRLPT/1Hl,1Hp,1Ht/
DATA LTRDOT,LTRSPC/1H.,1H /
C
C PARSE DECSYSTEM10 FILE SPECIFICATION
CALL REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1LTRDVC,LTRNAM,NUMONE,NUMTWO,LTRSFD)
C
C SUPPLY DEFAULT FILE NAME IF NEEDED
IF(LTRNAM(1).EQ.LTRSPC)GO TO 2
IF(KNDFIL.NE.2)GO TO 7
DO 1 I=1,6
1 LTRSIX(I)=LTRNAM(I)
GO TO 7
2 GO TO(3,38,5,5,38),KNDFIL
3 DO 4 I=1,6
4 LTRNAM(I)=LTRRNB(I)
GO TO 7
5 DO 6 I=1,6
6 LTRNAM(I)=LTRSIX(I)
C
C SUPPLY DEFAULT EXTENSION IF NEEDED
7 IF(LTRNAM(7).EQ.LTRDOT)GO TO 9
LTRNAM(7)=LTRDOT
J=(3*KNDFIL)-2
DO 8 I=8,10
LTRNAM(I)=LTREXT(J)
8 J=J+1
C
C SUPPLY DEFAULT DEVICE IF NEEDED
9 IF(LTRDVC(1).EQ.LTRSPC)GO TO 15
GO TO(26,22,26,10,22),KNDFIL
10 DO 11 I=1,3
IF(LTRDVC(I).EQ.LTRTTY(I))GO TO 11
IF(LTRDVC(I).NE.LWRTTY(I))GO TO 12
11 CONTINUE
LPTTTY=1
GO TO 26
12 DO 13 I=1,3
IF(LTRDVC(I).EQ.LTRLPT(I))GO TO 13
IF(LTRDVC(I).NE.LWRLPT(I))GO TO 14
13 CONTINUE
LPTTTY=-1
GO TO 26
14 LPTTTY=0
GO TO 26
15 GO TO(20,20,20,16,24),KNDFIL
16 IF(LPTTTY.GT.0)GO TO 18
DO 17 I=1,5
17 LTRDVC(I)=LTRLPT(I)
LPTTTY=-1
GO TO 26
18 DO 19 I=1,5
19 LTRDVC(I)=LTRTTY(I)
GO TO 26
20 DO 21 I=1,5
21 LTRDVC(I)=LTRDSK(I)
IF(KNDFIL.NE.2)GO TO 26
22 DO 23 I=1,5
23 LTRFIV(I)=LTRDVC(I)
GO TO 26
24 DO 25 I=1,5
25 LTRDVC(I)=LTRFIV(I)
C
C SUPPLY DEFAULT PATH IF NEEDED
26 GO TO(31,29,31,31,27),KNDFIL
27 IF(NUMONE.NE.0)GO TO 29
NUMONE=MISONE
NUMTWO=MISTWO
DO 28 I=1,6
28 LTRSFD(I)=LTRPTH(I)
29 MISONE=NUMONE
MISTWO=NUMTWO
DO 30 I=1,6
30 LTRPTH(I)=LTRSFD(I)
C
C CONVERT USER SPECIFIED INFORMATION TO A5 FORM
31 ENCODE(5,32,LA5DVC)LTRDVC
32 FORMAT(5A1)
ENCODE(10,33,LA5NAM)LTRNAM
33 FORMAT(10A1)
DO 34 I=1,3
34 LA5PTH(I)=0
IF(NUMONE.EQ.0)GO TO 36
NUMPTH(1)=NUMONE
NUMPTH(2)=NUMTWO
IF(LTRSFD(1).EQ.LTRSPC)GO TO 36
ENCODE(6,35,LA5PTH(2))LTRSFD
35 FORMAT(6A1)
C
C ATTEMPT TO OPEN THE FILE
36 NOTOPN=0
IF(KNDFIL.EQ.3)GO TO 37
IF(KNDFIL.EQ.4)GO TO 37
C
C OPEN INPUT FILE
OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1DIRECTORY=LA5PTH,ACCESS='SEQIN',ERR=38)
GO TO 39
C
C OPEN OUTPUT FILE
37 OPEN(UNIT=IUNIT,DEVICE=LA5DVC,FILE=LA5NAM,
1DIRECTORY=LA5PTH,ACCESS='SEQOUT',ERR=38)
GO TO 39
C
C RETURN TO CALLING PROGRAM
38 NOTOPN=1
39 IF(ITRACE.NE.0)WRITE(ITTY,40)KNDFIL,NOTOPN,LA5DVC,
1LA5NAM,NUMPTH,LA5PTH(2)
40 FORMAT(1X,3HKND,1I2,1X,3HERR,I2,1X,1A5,1H:,1A10,
11H[,1O6,1H,,1O6,1H,,1A6,1H])
RETURN
END
SUBROUTINE REPART(MAXFIL,LTRFIL,MAXCHR,LOCFIL,LNGFIL,
1LTRDVC,LTRNAM,NUMONE,NUMTWO,LTRSFD)
C RENBR(REPRT1/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 LTRDVC = RETURNED CONTAINING CHARACTERS FORMING
C DEVICE NAME.
C LTRNAM = RETURNED CONTAINING CHARACTERS FORMING FILE
C NAME AND EXTENSION.
C NUMONE = RETURNED CONTAINING VALUE OF FIRST NUMBER IN
C DIRECTORY INSIDE BRACKETS.
C NUMTWO = RETURNED CONTAINING VALUE OF SECOND NUMBER
C IN DIRECTORY INSIDE BRACKETS.
C LTRSFD = RETURNED CONTAINING CHARACTERS FORMING THIRD
C ITEM INSIDE BRACKETS.
C
DIMENSION LTRFIL(MAXCHR,MAXFIL),LTRNAM(10),LTRDVC(5),
1LTRSFD(6),LTRDGT(8),LNGFIL(MAXFIL)
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/
C
DATA LTROPN,LTRCLS/1H[,1H]/
DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7/
DATA LTRDOT,LTRCLN,LTRCMA/
11H.,1H:,1H,/
DATA LTRSPC/1H /,LTRTAB/1H /
MAXPRT=0
IF(LOCFIL.GT.0)MAXPRT=LNGFIL(LOCFIL)
C
C LOCATE DIRECTORY INSIDE BRACKETS
INIPTH=0
1 INIPTH=INIPTH+1
IF(INIPTH.GT.MAXPRT)GO TO 3
IF(LTRFIL(INIPTH,LOCFIL).NE.LTROPN)GO TO 1
LMTPTH=INIPTH
2 LMTPTH=LMTPTH+1
IF(LMTPTH.GT.MAXPRT)GO TO 4
IF(LTRFIL(LMTPTH,LOCFIL).NE.LTRCLS)GO TO 2
GO TO 4
3 LMTPTH=INIPTH-1
C
C LOCATE DEVICE NAME TO LEFT OF COLON
4 LMTDSK=0
5 LMTDSK=LMTDSK+1
IF(LMTDSK.GT.MAXPRT)GO TO 8
IF(LMTDSK.LT.INIPTH)GO TO 6
IF(LMTDSK.GT.LMTPTH)GO TO 6
LMTDSK=LMTPTH
GO TO 5
6 IF(LTRFIL(LMTDSK,LOCFIL).NE.LTRCLN)GO TO 5
7 INIDSK=1
IF(INIPTH.GT.LMTPTH)GO TO 9
IF(LMTDSK.GT.LMTPTH)INIDSK=LMTPTH+1
GO TO 9
8 INIDSK=LMTDSK+1
C
C LOCATE FILE NAME
9 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
C
C COLLECT 5 LETTERS OF DEVICE NAME
13 DO 17 INDEX=1,5
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)
INIDSK=INIDSK+1
17 CONTINUE
C
C COLLECT 6 LETTERS OF NAME, PERIOD AND EXTENSION
DO 22 INDEX=1,10
LTRNAM(INDEX)=LTRSPC
IF(INDEX.NE.7)GO TO 19
18 IF(ININAM.GT.LMTNAM)GO TO 22
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRDOT)GO TO 21
ININAM=ININAM+1
GO TO 18
19 IF(ININAM.GT.LMTNAM)GO TO 22
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRDOT)GO TO 22
IF(LTRFIL(ININAM,LOCFIL).EQ.LTRSPC)GO TO 20
IF(LTRFIL(ININAM,LOCFIL).NE.LTRTAB)GO TO 21
20 ININAM=ININAM+1
GO TO 19
21 LTRNAM(INDEX)=LTRFIL(ININAM,LOCFIL)
ININAM=ININAM+1
22 CONTINUE
C
C EVALUATE PROJECT AND PROGRAMMER NUMBERS
IPART=0
23 NUMTWO=0
24 INIPTH=INIPTH+1
IF(INIPTH.GE.LMTPTH)GO TO 26
LTRNOW=LTRFIL(INIPTH,LOCFIL)
DO 25 I=1,8
IF(LTRDGT(I).NE.LTRNOW)GO TO 25
NUMTWO=(8*NUMTWO)+I-1
GO TO 24
25 CONTINUE
IF(LTRNOW.NE.LTRCMA)GO TO 24
26 IF(IPART.NE.0)GO TO 27
IPART=1
NUMONE=NUMTWO
GO TO 23
C
C COLLECT 6 LETTERS OF SUBFILE DIRECTORY NAME
27 DO 29 INDEX=1,6
LTRSFD(INDEX)=LTRSPC
28 INIPTH=INIPTH+1
IF(INIPTH.GE.LMTPTH)GO TO 29
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTRSPC)GO TO 28
IF(LTRFIL(INIPTH,LOCFIL).EQ.LTRTAB)GO TO 28
LTRSFD(INDEX)=LTRFIL(INIPTH,LOCFIL)
29 CONTINUE
RETURN
END
SUBROUTINE REDATE(LTRTOP)
C RENBR(REDAT1/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 A5 HOLLERITH FORM BY THE
C DATE AND TIME ROUTINES, THEN CONVERTED TO A1 FORM BY
C DECODE STATEMENTS.
C
DIMENSION LTRTOP(117),LA5DAT(2)
CALL DATE(LA5DAT)
CALL TIME(LA5TIM)
DECODE(9,1,LA5DAT)(LTRTOP(I),I=1,9)
1 FORMAT(9A1)
DECODE(5,2,LA5TIM)(LTRTOP(I),I=11,15)
2 FORMAT(5A1)
RETURN
END