Trailing-Edge
-
PDP-10 Archives
-
decuslib20-09
-
decus/20-34/reusr6.for
There are 3 other files named reusr6.for in the archive. Click here to see a list.
SUBROUTINE REUSER
C RENBR(REUSR6/DIALOG OF SWITCHES THEN NAMES 1 PER LINE
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. COMMAND TYPED
C BY THE USER CONSISTS OF 1 OR SEVERAL SWITCHES WITH
C NUMERIC ARGUMENTS. FILE NAMES WILL BE ACCEPTED 1 PER
C LINE IF A /D SWITCH IS ISSUED. ONLY A SINGLE INPUT
C FILE CAN BE PROCESSED DURING A SINGLE EXECUTION OF
C THIS PROGRAM.
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
CHARACTER*10 FILSRC,FILRNB,FILLPT,FILSPC
DATA FILSPC/' '/
C
C CLEAR DEFAULT VALUES
JPASS=1
IF(MASTER.EQ.0)GO TO 2
IF(MASTER.NE.1)GO TO 78
WRITE(ITTY,1)
1 FORMAT(' RENBR (03/85)'/' Type /H for Help')
2 JIN=JTAB
JBGN=IFORM
JEND=JFORM
3 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
ITRACE=0
WRITE(ITTY,4)
4 FORMAT(' OPTIONS: ',$)
READ(JTTY,5)(LTRBIG(I),I=1,70)
5 FORMAT(70A1)
C
C INTERPRET OPTIONS
INDEX=0
LPTTTY=0
6 INDEX=INDEX+1
7 IF(INDEX.GT.70)GO TO 46
LTRNOW=LTRBIG(INDEX)
IF(LTRNOW.EQ.LTRSPC)GO TO 6
IF(LTRNOW.EQ.LTRTAB)GO TO 6
C
C TEST LETTER TO DETERMINE WHAT OPTION IS DESIRED
8 KNDFLG=0
9 KNDFLG=KNDFLG+1
IF(KNDFLG.GT.26)GO TO 6
IF(LTRABC(KNDFLG).EQ.LTRNOW)GO TO 10
IF(LWRABC(KNDFLG).NE.LTRNOW)GO TO 9
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
10 GO TO(21,19,14, 6,20,20,20,45,21,20,
1 12,20,19, 6, 6,21, 6, 6,20,13,
2 15,17,21, 6, 6,11),KNDFLG
11 ITRACE=1
GO TO 6
12 ISPLIT=0
GO TO 18
13 ITAB=1
GO TO 16
14 ITAB=0
GO TO 16
15 ITAB=-1
16 IF(INCR.EQ.0)INCR=1
GO TO 6
17 LPTTTY=1
18 IF(IPAGE.EQ.0)IPAGE=1
GO TO 6
19 IF(INCR.EQ.0)INCR=1
GO TO 21
20 IF(IPAGE.EQ.0)IPAGE=1
C
C EVALUATE NUMBER TO RIGHT OF LETTER
21 NUMFLG=0
KNDNUM=0
22 INDEX=INDEX+1
IF(INDEX.GT.70)GO TO 27
LTRNOW=LTRBIG(INDEX)
IF(LTRNOW.EQ.LTRSPC)GO TO 23
IF(LTRNOW.NE.LTRTAB)GO TO 24
23 IF(KNDNUM.LE.0)GO TO 22
GO TO 27
24 DO 26 L=1,10
IF(LTRDGT(L).NE.LTRNOW)GO TO 26
IF(KNDNUM.GT.1)GO TO 25
KNDNUM=1
NUMFLG=(10*NUMFLG)+L-1
GO TO 22
25 NUMFLG=(10*NUMFLG)-L+1
GO TO 22
26 CONTINUE
IF(KNDNUM.GT.0)GO TO 27
IF(LTRNOW.EQ.LTRPLS)KNDNUM=1
IF(LTRNOW.EQ.LTRMNS)KNDNUM=2
IF(KNDNUM.GT.0)GO TO 22
IF(KNDNUM.NE.0)GO TO 27
IF(LTRNOW.EQ.LTRCLN)KNDNUM=-1
IF(KNDNUM.NE.0)GO TO 22
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
27 INDEX=INDEX-1
IF(KNDFLG.EQ.9)GO TO 39
IF(NUMFLG.LT.0)NUMFLG=0
GO TO(29,31, 6, 6,43,40,30, 6,39,32,
1 7,41,33, 6, 6,28, 6, 6,44, 6,
2 7, 6,37, 6, 6, 6,38,34,35),KNDFLG
28 IPAGE=NUMFLG
IF(IPAGE.EQ.0)IPAGE=1
GO TO 6
29 INDENT=NUMFLG
IF(INDENT.EQ.0)INDENT=1
GO TO 6
30 ISPACE=NUMFLG
IF(ISPACE.EQ.0)ISPACE=1
GO TO 6
31 IBASE=NUMFLG
GO TO 6
32 JMPBGN=NUMFLG
KNDFLG=28
GO TO 21
33 KMDMIN=NUMFLG
KNDFLG=29
GO TO 21
34 JMPEND=NUMFLG
GO TO 6
35 IF(NUMFLG.GT.0)GO TO 36
IF(KMDMIN.GT.0)NUMFLG=99999
IF(KMDMIN.EQ.0)KMDMIN=-1
36 IF(KMDMIN.EQ.0)KMDMIN=1
KMDMAX=NUMFLG
GO TO 6
37 JTAB=NUMFLG
IF(JTAB.EQ.0)JTAB=JIN
LTAB=1
GO TO 6
38 IF(NUMFLG.GT.10)IFORM=NUMFLG
GO TO 6
39 INCR=NUMFLG
IF(INCR.EQ.0)INCR=1
GO TO 6
40 IFILL=0
GO TO 42
41 IFILL=1
42 JFORM=NUMFLG
IF(JFORM.LE.10)JFORM=JEND
IFORM=JBGN
IF(IFILL.EQ.0)GO TO 6
IF(ISPLIT.EQ.0)ISPLIT=1
IF(INDEX.GT.70)GO TO 6
KNDFLG=27
GO TO 21
43 ITBL=NUMFLG+1
IF(ITBL.EQ.1)ITBL=2
GO TO 6
44 ISPLIT=NUMFLG+1
GO TO 6
C
C ISSUE HELP MESSAGE
45 CALL REHELP(ITTY)
GO TO 3
C
C REPORT OPTIONS SELECTED
46 IF(IPAGE.NE.0)GO TO 47
IF(INCR.NE.0)GO TO 47
IF(MASTER.EQ.0)GO TO 89
GO TO 3
47 IF(INDENT.GT.0)WRITE(ITTY,48)INDENT
48 FORMAT(4X,'Add Block Indent',1I5)
IF(LTAB.NE.0)WRITE(ITTY,49)JTAB
49 FORMAT(2X,'Width of Tab Stops',1I5)
IF(IPAGE.EQ.0)GO TO 58
WRITE(ITTY,50)IPAGE
50 FORMAT(10X,'Listing Options'/9X,'Page Number',1I5)
IF(ISPACE.NE.0)WRITE(ITTY,51)ISPACE
51 FORMAT(2X,'Gap Interstatement',1I5)
IF(IFILL.EQ.0)WRITE(ITTY,52)JFORM
52 FORMAT(10X,'Form Feeds',1I5)
IF(IFILL.NE.0)WRITE(ITTY,53)JFORM,IFORM
53 FORMAT(10X,'Line Feeds',1I5,':',1I5)
IF((JMPBGN+JMPEND).NE.0)WRITE(ITTY,54)JMPBGN,JMPEND
54 FORMAT(2X,'Jump at Top/Bottom',1I5,':',1I5)
IF(ISPLIT.EQ.0)WRITE(ITTY,55)
55 FORMAT(3X,'Keep Lines Intact')
I=ISPLIT-1
IF(ISPLIT.NE.0)WRITE(ITTY,56)I
56 FORMAT(4X,'Split Long Lines',1I5)
I=ITBL-1
IF(I.NE.0)WRITE(ITTY,57)I
57 FORMAT(1X,'Extra Table Content',1I5)
IF(INCR.EQ.0)GO TO 70
58 WRITE(ITTY,59)
59 FORMAT(6X,'Renumbering Options')
IF(KMDMIN.GT.0)GO TO 61
IF(KMDMIN.EQ.0)GO TO 63
WRITE(ITTY,60)
60 FORMAT(2X,'Maintain Numbering')
GO TO 66
61 WRITE(ITTY,62)KMDMIN,KMDMAX
62 FORMAT(3X,'Modify Only Range',1I5,':',1I5)
63 WRITE(ITTY,64)INCR
64 FORMAT(11X,'Increment',1I5)
IF(IBASE.NE.0)WRITE(ITTY,65)IBASE
65 FORMAT(16X,'Base',1I5)
66 IF(ITAB.LT.0)WRITE(ITTY,67)
67 FORMAT(' Uniform Left Margin')
IF(ITAB.EQ.0)WRITE(ITTY,68)
68 FORMAT(7X,'Column Format')
IF(ITAB.GT.0)WRITE(ITTY,69)
69 FORMAT(10X,'Tab Format')
C
C OPEN LISTING FILE
70 IF(IPAGE.LE.0)GO TO 76
WRITE(ITTY,71)
71 FORMAT(' Listing Title: ',$)
READ(JTTY,72)(LTRTOP(I),I=1,54)
72 FORMAT(54A1)
IF(LPTTTY.NE.0)GO TO 75
73 WRITE(ITTY,74)
74 FORMAT(' Output Listing File: ',$)
READ(JTTY,81)FILLPT
IF(FILLPT.EQ.FILSPC)GO TO 73
OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT',
1DEVICE='LPT')
GO TO 76
75 OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT',
1DEVICE='TTY')
C
C OPEN RENUMBERED OUTPUT FILE
76 IF(INCR.EQ.0)GO TO 79
WRITE(ITTY,77)
77 FORMAT(' Output Renumbered File: ',$)
READ(JTTY,81)FILRNB
IF(FILRNB.EQ.FILSPC)GO TO 76
OPEN(UNIT=IOUT,FILE=FILRNB,ACCESS='SEQOUT')
GO TO 79
C
C OPEN INPUT FILE
78 CLOSE(UNIT=IIN)
IF(LPTTTY.NE.0)GO TO 89
79 WRITE(ITTY,80)
80 FORMAT(' Input Source File: ',$)
READ(JTTY,81)FILSRC
81 FORMAT(1A10)
IF(FILSRC.EQ.FILSPC)GO TO 84
OPEN(UNIT=IIN,FILE=FILSRC,ACCESS='SEQIN',ERR=82)
IF(MASTER.EQ.1)GO TO 86
GO TO 90
82 WRITE(ITTY,83)
83 FORMAT(' File cannot be read')
GO TO 79
84 IF(MASTER.NE.1)GO TO 89
WRITE(ITTY,85)
85 FORMAT(' First input file must be specified')
GO TO 79
C
C POSITION PAPER IF TELETYPE OUTPUT
86 IF(IPAGE.EQ.0)GO TO 90
IF(LPTTTY.EQ.0)GO TO 90
IF(IFILL.EQ.0)GO TO 90
WRITE(ITTY,87)
87 FORMAT(1X/' Position paper',
1' (carriage return or local line feed)'/
2' then type non-space character',
3' and carriage return')
88 READ(JTTY,5)LTRNOW
IF(LTRNOW.EQ.LTRSPC)GO TO 88
GO TO 90
C
C RETURN TO CALLING PROGRAM
89 JPASS=0
90 RETURN
END