C BIGTAPE.FTN
C TAPE POSITION CONTROL TASK AND TAPE-DISK UTILITY FOR
C FIXED RECORD LENGTH RECORDS IN ASCII/EBCDIC.
C  THIS PROGRAM HAS MANY OPTIONS (TYPE 'HELP' TO LIST)
C AND ALLOWS MANUAL CONTROL OF TAPE MOTION AND READ/WRITE
C ACCESS TO FILES ON TAPE. BEST AT CARD IMAGE FILES BLOCKED
C UP TO 100. TAPE MAY BE IN ASCII OR EBCDIC AND CAN BE READ
C OR WRITTEN IN EITHER. ALSO CAN READ RECORD LENGTHS OTHER
C THAN 80 USING THE "B UNIT,BLKSIZE" COMMAND.
C
C THIS VERSION ALLOWS THE CREATION OF FILES FROM A UNIX (V6) TAR
C TAPE (3/1/82) CRUDELY. 2 OUTPUT FILES WILL BE CREATED; THE
C FIRST WILL BE CALLED "TARDIR.DIR" AND WILL CONTAIN JUST THE
C FULL UNIX PATHNAME ON THE TAPE IN THE ORDER THE PATHS ARE
C ENCOUNTERED. THE SECOND NAMES WILL BE THE LAST (NAME) PART
C OF THE PATHNAME AND THESE WILL BE ENTERED INTO THE CURRENT
C DIRECTORY AS FOUND. IT IS EXPECTED THAT THE TARDIR.DIR
C MAY BE EDITED TO COPY FILES FROM THE CURRENT ACCOUNT
C (POSSIBLY USING A PIP /BR DIRECTORY TO GET VERSION NUMBERS
C IN THE SAME ORDER) INTO ACCOUNTS WANTED. THIS IS A VERY VERY
C CRUDE METHOD BUT ALLOWS ONE TO CAPTURE FILES AS ONE
C DESIRES.
C  NOTE THAT THE DIMENSION OF LLN IS NOW 11000 BYTES TO
C ALLOW DEFAULT UNIX STYLE BLOCKS TO FIT.
C   ===> SINCE 1ST DATA BYTE IS 407,410,411 FOR MOST UNIX BINARY
C FILES, TRY AND KEEP TRACK OF THIS AND FILL IN AN * INTO TARDIR.DIR
C ENTRY FOR SUCH CASES. THIS SHOULD FACILITATE LISTING ONLY SOURCE
C FILES (UNIX DOES A POOR JOB KEEPING THESE IDENTIFIABLE OTHERWISE)
C AND WILL RESULT IN NOT TREATING LF AS A SEPARATOR FOR BINARY DATA
C ALSO.
C
C ROOT FOR TPP TASK
C	TAPE POSITION CONTROLLER AND 80-BYTE/RECORD DATA COPIER
	INTEGER*2 IPTRS
	DIMENSION IPTRS(4),IDESC(7)
	DIMENSION LINE(132,100),LLN(13200)
	BYTE LINE,LLN,LLINE(8000)
	EQUIVALENCE(LLN(1),LINE(1,1))
	EQUIVALENCE(LLN(1),LLINE(1))
	DIMENSION IBF(4200)
	INTEGER *2 IBF
C	NOTE LINE AND IBF ARE THE SAME AREA AND THEIR DIMENSIONS
C	MUST BE COMPATIBLE!
	BYTE OLINE
	DIMENSION OLINE(514)
	DIMENSION RBF(110)
	REAL * 4 RBF
	EQUIVALENCE(RBF(1),IBF(1))
	EQUIVALENCE(IBF(1),LINE(1))
	BYTE AA,BB
	BYTE CCC
	DIMENSION CCC(2)
	EQUIVALENCE (AA,CCC(1)),(BB,CCC(2))
	EQUIVALENCE (JJJ,CCC(1))
	INTEGER*4 IGRN,NFILKK
	INTEGER * 4 IRECCT
	INTEGER*4 NFILBY,NFILB2,BPBK
	BYTE LFNM(100),UFNM(100)
	BYTE DFNM(50)
	INTEGER*4 IVAL
	EXTERNAL IVAL
	DATA BPBK/512/
C	DO TAPE OPERATIONS
C SET FLAG THAT UNIX BINARY FLAG NOT SEEN (FOR T MODE)
	IUXBN=0
	KSZ=80
C MVBIT <> 0 MEANS REVERSE 4 BIT GROUPS OFF TAPE.
C ACTUALLY GETS NEXT INT., READS IN THAT.
	MVBIT=0
	MULTRC=1
20	CONTINUE
	IBCDFG=0
	DO 22 I4300=1,5000
22	IBF(I4300)=0
	CALL GETCML(LINE,3HTPP,MCRSZ,72)
	IRECCT=0
	CALL FFINIT(IPTRS,LINE,MCRSZ,IERR)
	CALL FFSTR(IPTRS,JJJ,2)
D	JJJJ=JJJ
	BB=32
	ICMD=JJJ
	CALL FFINTG(IPTRS,IUNIT)
C  FREE FORMAT COMMANDS:
C	LETTER,NUMBER[,NUMBER]
C	WHERE
C	LETTER=R,REWIND UNIT (0 OR 1)
C	      =E, WRITE ENDFILE ON UNIT 0 OR 1
C	      =S, SKIP +- N RECORDS ON UNIT 0 OR 1
C	      =F, SKIP +- N FILES ON UNIT 0 OR 1
C	      =C, COPY PDP11 FILE TO TAPE
C	      =W, WRITE TAPE FILE TO DISK.
C	      =P, COPY PDP11 FIILE TO TAPE IN EBCDIC FOR PUNCH
C	      =I, COPY TAPE FILE TO PDP11, TAPE IN EBCDIC
C	      =G, GET DG FORMAT TAPE FILE, DUMP TO PDP11
C			(200 BIT CLEARED ON INPUT IN ALL BYTES)
C	      =O, OUTPUT TAPE WITH RECORDS TERMINATED BY C.R.
C			O UNIT,BLKFACTOR,FLAG  (FLAG=1 MEANS SET 200
C				BIT IN ALL OUTPUT CHARS, =ANYTHING ELSE
C				MEANS LEAVE 200 BIT OFF ALWAYS.
C	      =A,CHARAC  ALTER TAPE CHARAC TO VALUE CHARAC
C (FOR OTHERS SEE "HELP" PRINTOUT)
	IEBFLG=0
C	IF EBCDIC, SET IEBFLG NONZERO.
	CALL ALUN(IUNIT)
C	ASSIGN 'MAGLUN' (GLOBAL) TO MT0: OR MT1:
	IF (ICMD.EQ.'X') CALL EXIT
	IF (ICMD.NE.'H') GO TO 28
C	WRITE HELP MESSAGE
	WRITE (6,24)
24	FORMAT(' CMD UNIT COUNT,EXTRA INFO ',/,
     1 ' CMD=R  REWIND UNIT',/,
     2 '    =E  WRITE EOF ON UNIT',/,
     3 '    =S  SKIP COUNT RECORDS (+ OR -)',/,
     4 '    =F  SKIP COUNT FILES (+ OR -)',/,
     5 '    =C  COPY PDP11 FILE TO TAPE IN ASCII, BLK FACTOR=COUNT',/,
     6 '    =W  WRITE TAPE FILE TO DISK IN ASCII,BLK FACTOR=COUNT',/,
     7 '    =P  WRITE PDP11 FILE TO TAPE IN EBCDIC, BLK FAC=COUNT',/,
     8 '    =I  INPUT EBCDIC FILE TAPE TO PDP11, BLK FAC. = COUNT',/,
     9 '    =A  ALTER TAPE CHARAC. TO COUNT',/,
     A '    =B  SET RECORD SIZE TO COUNT')
	WRITE(6,26)
26	FORMAT('    =Z  ENTER UNIT RECORD MODE',/,
     1 '    =G  GET DG FORMAT TAPE FILE, DUMP TO PDP11',/,
     1 '    =J  GET DG FORMAT TAPE AND READ IN AS 7TRK',/,
     2 '    =O  WRITE TAPE, RCRDS TERM BY CR;FLAG=1==>SET 200 BIT',/,
     3 '    =U  READ IN AS G OPTION BUT BIG RECORDS ALLOWED',/,
     A '    =V  SET BIT REVERSE FLAG TO COUNT. 0=NONE, 1=SWAP 4BITS',/,
     C '    =M  SET MULTIPLE RECORD MODE(DEFAULT)',/,
     D '    =D  ENTER TAPE DUMP MODE (ASKS MORE QUESTIONS)',/,
     E '    =X  EXIT',/,
     F '    =H  PRINT THIS MESSAGE',/,
     G '    =Y  READ BCD TAPE INTO PDP11 FILE, BLK FACTOR=COUNT',/,
     H '    =T  READ U.V6 TAR TAPES TO PDP & CREATE TARDIR.DIR',/,
     I ' UNIT = 0 OR 1 FOR MT0: OR MT1:',/,
     J ' COUNT, EXTRA=EXTRA NUMERIC INFORMATION AS REQUIRED')
28	CONTINUE
	IF (ICMD.NE.'Z') GO TO 30
	MULTRC=0
30	CONTINUE
	IF (ICMD.NE.'M') GO TO 32
	MULTRC=1
32	CONTINUE
	IF (ICMD.NE.'A') GO TO 34
C	ALTER CHARACTERISTICS OF TAPE
	CALL FFINTG(IPTRS,ICHARA)
	CALL MSETCH(ICHARA)
34	CONTINUE
	IF (ICMD.NE.'B') GOTO 36
	CALL FFINTG(IPTRS,KSZ)
	IF(KSZ.LT.1.OR.KSZ.GT.160)KSZ=80
36	CONTINUE
	IF (ICMD.NE.'V') GOTO 38
	CALL FFINTG(IPTRS,MVBIT)
38	CONTINUE
	IF (ICMD.NE.'I') GO TO 40
	IRECCT=0
	IEBFLG=1
	GO TO 132
40	CONTINUE
	IF (ICMD.NE.'Y') GO TO 42
	IRECCT=0
	IBCDFG=1
	GO TO 132
42	CONTINUE
	IF (ICMD.NE.'P') GO TO 44
	IRECCT=0
	IEBFLG=1
	GO TO 152
44	CONTINUE
	IF (ICMD.NE.'D') GO TO 84
C	DUMP TAPE
C	MUST FIND OUT HOW TO DO IT. ASK FOLLOWING OPTIONS:
C	1. SWAP BYTES?
C	2. SWAP WORDS?
C	3. DUMP OCTAL 16/OCTAL 32/DECIMAL 32/FLOATING PDP11/FLOATING IBM
C	ASSUME OCTAL DUMP AT FIRST
CCCCCC
	WRITE(6,46)
46	FORMAT(' TO SWAP BYTES ENTER 1, ELSE 0')
	READ (5,48)ISWPF
48	FORMAT(I1)
	WRITE(6,50)
50	FORMAT(' TO SWAP WORDS ENTER 1, ELSE 0')
	READ(5,48)IWDSF
	WRITE(6,52)
52	FORMAT(' ENTER 0 FOR OCTAL, 1 FOR DECIMAL 16,2=DEC 32,3=IBM FP')
	READ(5,48)IDSPF
54	CONTINUE
	CALL BCLR(IBF,5000)
	CALL MREAD(IBF,10400,JRECCT,JFLG)
	CALL ERFLG(JFLG,JFLG)
	IF (JFLG.EQ.1.OR.JFLG.EQ.2.OR.JFLG.EQ.3.OR.JFLG.EQ.6)GOTO 82
	IF (ISWPF.NE.0)CALL SWPBYT(IBF,JRECCT)
	IF (IWDSF.NE.0)CALL WRDSWP(IBF,JRECCT)
	NWD2=JRECCT/4
C	NWD2 IS NO. 32 BIT WORDS
	IF (NWD2.LT.1) GO TO 82
	IF (IDSPF.NE.3) GO TO 58
	DO 56 III=1,NWD2
	RBF(III)=FLTIBM(RBF(III))
56	CONTINUE
58	CONTINUE
C	NOW HAVE DATA IN FROM RECORD
C	NOW DISPLAY DATA (MAKE IT OK FOR A TERMINAL)
	N2DO=JRECCT/2
	IF (IDSPF.EQ.3)N2DO=JRECCT/4
C	IF DISPLAY TTPE=4, DUMP ASCII
	IF (IDSPF.EQ.4)NN2D=JRECCT/80
	IF (IDSPF.NE.4)NN2D=N2DO/8
	IDSPF1=IDSPF+1
	MMM0=1
	DO 80 III=1,NN2D
	GO TO (60,64,68,72,76),IDSPF1
60	CONTINUE
C	16 BIT OCTAL
	MMMM=MMM0+7
	WRITE(6,62)MMM0,(IBF(IV),IV=MMM0,MMMM)
	MMM0=MMM0+8
62	FORMAT(1X,I4,8O7)
	GO TO 80
64	CONTINUE
C	16 BIT DECIMAL
	MMMM=MMM0+7
	WRITE(6,66)MMM0,(IBF(IV),IV=MMM0,MMMM)
	MMM0=MMM0+8
66	FORMAT(1X,I4,8I7)
	GO TO 80
68	CONTINUE
C	32 BIT DECIMAL
	MMMM=MMM0+7
	WRITE(6,70)MMM0,(IBF(IV),IV=MMM0,MMMM)
	MMM0=MMM0+8
70	FORMAT(1X,I4,8I9)
	GO TO 80
72	CONTINUE
C	IBM F.P.
	MMMM=MMM0+8
	WRITE(6,74)MMM0,(RBF(IV),IV=MMM0,MMMM)
	MMMM=MMMM+8
74	FORMAT(1X,8F10.4)
	GO TO 80
76	CONTINUE
C	ASCII
	MMMM=MMM0+40
	WRITE(6,78)(IBF(IV),IV=MMM0,MMMM)
	MMM0=MMM0+40
78	FORMAT(1X,40A2)
	GO TO 80
80	CONTINUE
	IF (MULTRC.NE.0)GO TO 54
82	CONTINUE
	GO TO 188
84	CONTINUE
	IF (ICMD.NE.'O') GO TO 92
C	OUTPUT DATA TERMINATED BY C.R. ONLY
	CALL FFINTG(IPTRS,IBLKF)
	IF (IBLKF.LE.0)IBLKF=1
	IF (IBLKF.GT.100)IBLKF=100
C	OUTPUT 0,1 FOR 1 72 CHAR RECORD. A 3RD PARAMETER WILL SEE IF
C	WE NEED TO SET 200 BIT IN WHOLE RECORD
	IBITST=0
	CALL FFINTG(IPTRS,IBITST)
C	IF WE SEE OUTPUT 0,1,1 THEN SET BIT. OTHER VALUES LEAVE IT OFF.
	CALL GETCML(LINE,3HDGO,MCRSZ,72)
	CALL ASSIGN(3,LINE,MCRSZ)
	ITXTI=1
86	CONTINUE
	ITXTI=1
	ITXTI2=ITXTI+68
	DO 88 IREC=1,IBLKF
	READ(3,156,END=90,ERR=90)(LLINE(IIII),IIII=ITXTI,ITXTI2)
	LLINE(ITXTI2+1)=13
	ITXTI=ITXTI+70
	ITXTI2=ITXTI2+70
88	CONTINUE
	NWRTB=72*IBLKF
	LLINE(NWRTB+1)=0
C	NO. BYTES IN 3 RECORDS (INCLUDING 3 C.R. CHARACTERS), +1 TO MAKE EVEN
	IF (IBITST.EQ.1)CALL SET8(LINE,NWRTB)
	CALL MWRITE(LINE,NWRTB,NFLAG)
	CALL ERFLG(NFLAG,NFLAG)
	IF (NFLAG.EQ.6.OR.NFLAG.EQ.1.OR.NFLAG.EQ.3
     1  .OR.NFLAG.EQ.2)GOTO 188
	GO TO 86
90	CONTINUE
C	ENDFILE SEEN...CLOSE AND GO AWAY
	CALL CLOSE(3)
	GO TO 188
92	CONTINUE
	IF (ICMD.EQ. 'U') GOTO 94
	IF ((ICMD.NE.'J').AND.(ICMD.NE.'G')) GO TO 112
C	GET DG TAPE DATA (RECORDS TERMINATED BY C.R.)
C
C	NOTE: FORMAT OF DATA GENERAL (RDOS) TAPES IS
C	255 WORDS DATA CHARACTERS
C	1 WORD FILE NUMBER (0-99=LEGAL RANGE)
C	1 WORD FILE NUMBER (0-99=LEGAL RANGE)
C		TOTAL 257 WORDS
	IUUUU=0
	GO TO 96
94	CONTINUE
	IUUUU=1
96	CONTINUE
C
	CALL GETCML(LINE,3HDGI,MCRSZ,72)
C	CALL ASSIGN(3,LINE,MCRSZ)
	LINE(MCRSZ+1,1)=0
	OPEN (UNIT=3,TYPE='NEW',CARRIAGECONTROL='LIST',DISPOSE='SAVE',
     1  RECORDSIZE=180,
     2  NAME=LINE,INITIALSIZE=10,EXTENDSIZE=12)
	ITXTO=1
98	CONTINUE
C	READ TAPE, THEN OUTPUT TO PDP11 WITH RECORD BOUNDARIES AT C.R.
	ITXTI=1
	CALL BCLR(LINE,5100)
	CALL MREAD(LINE,10200,NREAD,MFLAG)
	CALL ERFLG(MFLAG,MFLAG)
	IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO 110
C SWAP NIBBLES IF 7TRK INPUT USED (DUMP MODE OF COURSE.)
	IF (ICMD.EQ.'J')CALL BITSWP(LINE,NREAD)
C	REMOVE H.O. BIT FROM ALL TEXT BYTES...
	CALL OFF8(LINE,NREAD)
C	NREAD=NUMBER BYTES FOUND IN BUFFER
C	COPY DATA TO OLINE UNTIL:
C	1. A C.R. CHAR IS ENCOUNTERED IN OUTPUT, OR
C	2. TAPE DATA IS EXHAUSTED
C	THROW OUT CONTROL CHARACTERS (ZERO FILL)
C
C	THE FOLLOWING WILL ENSURE ONLY 255 WORDS (510 BYTES) ARE USED AS TEXT
	IF (IUUUU.NE.1)NREAD=510
C
100	CONTINUE
	ISAVE=LLINE(ITXTI)
	ITXTI=ITXTI+1
	IF (ISAVE.EQ.13) GO TO 102
C CHECK PRINTABLE CHARACTERS AND FILTER OUT EVERYTHING ELSE.
	IF (((ISAVE.NE.9).AND.(ISAVE.NE.12)).AND.
     1  ((ISAVE.LT.32).OR.(ISAVE.GT.127))) ISAVE=0
	OLINE(ITXTO)=ISAVE
	IF (ITXTO.LT.130)ITXTO=ITXTO+1
	IF (ITXTI.LT.NREAD) GO TO 100
C	READ MORE TAPE IF WE MUST, TO GET NEXT PART OF LINE
	GO TO 98
102	CONTINUE
C	HERE EMIT OUTPUT LINE AND CLEAR ITXTO POINTER
	WRITE (3,104)(OLINE(I95),I95=1,ITXTO)
104	FORMAT(131A1)
	ITXTO=1
106	DO 108 I95=1,132
	OLINE(I95)=0
108	CONTINUE
C	WHEN DONE WRITING THIS RECORD, GO TRY FOR MORE.
	GO TO 100
110	CALL CLOSE(3)
	GO TO 188
112	CONTINUE

	IF (ICMD.NE.'T') GO TO 130
C HANDLE UNIX TAR INPUT TAPES
C NOTE: FORMAT IS EMPIRICALLY DERIVED FROM DUMP OF UNIX V6 TAR TAPE
	IFRST=0
	IUXBN=0
	IUUUU=1
	IGRN=512
	IHDRSZ=512
	WRITE(6,9159)
9159	FORMAT(' ENTER C=COPY+DIR,D=DIR,Q=QUERY COPY:')
	READ(5,9158)DFNM
	IKP=0
	IF(DFNM(1).EQ.'D')IKP=1
	IF(DFNM(1).EQ.'Q')IKP=2
C READ REPLIES ON LUN 2 FILE FOR SELECTED COPY IN...
	IF(IKP.EQ.2)CALL ASSIGN(2,'SY:TARFIL.LST')
9167	WRITE(6,9157)
9157	FORMAT(' ENTER DEV:UIC>')
	READ(5,9158)DFNM
9158	FORMAT(80A1)
	IF(IKP.NE.1)GOTO 9160
C IF ONLY DIRECTORY WANTED, SHOVE TO NL:
	DFNM(1)='N'
	DFNM(2)='L'
	DFNM(3)=':'
	DO 9161 NV=4,50
9161	DFNM(NV)=0
9160	CONTINUE
	DO 9162 NV=1,50
	NN=51-NV
	IF(DFNM(NN).GT.32)GOTO 9163
	DFNM(NN)=0
9162	CONTINUE
9163	CONTINUE
C NN HAS NAME LENGTH.
	NDFNM=NN+1
C IGRN=GRANULARITY OF DATA. ASSUME IT'S RECORDED IN 512 BYTE BLKS
C ON TAPE SO A NEW FILE WILL BEGIN ATTHE NEXT 'IGRN' BYTE
C BOUNDARY.
	CALL ASSIGN(4,'SY:TARDIR.LIS')
C ENTRY POINT EITHER INITIALLY OR WHERE WE SAW EOF AND EXHAUSTED TAPE
C RECORD. NOTE WE ASSUME 512 BYTE MULTIPLES...
114	CONTINUE
C
	CALL BCLR(LINE,5480)
C TAR FORMAT BLOCKS 10240 BYTES, SO WE ALLOW A LITTLE EXTRA JUST FOR LAUGHS
	CALL MREAD(LINE,10900,NREAD,MFLAG)
	CALL ERFLG(MFLAG,MFLAG)
C CHECK FOR EOF,EOT, ETC.
C NOTE WE PROCESS TO 1ST EOF ALWAYS
	IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO5020
	NFILB2=NREAD
C ENTRY POINT WHERE WE GOT TO ENDFILE BUT DIDN'T EXHAUST TAPE RECORD
C RECORD HAS BEEN MOVED UP (TO NEXT 'IGRN' BDY) AND NREAD IS SET UP
C AS THE AMOUNT LEFT IN THE BUFFER AFTER EXHAUSTING THE LAST FILE
C (WHOSE SIZE IS ROUNDED UP TO THE NEXT 'IGRN' BYTES FROM TAPE).
6567	CONTINUE
	KFRST=1
C WRITE OUT UNIX PATHNAME
	DO 6570 IV=1,100
6570	UFNM(IV)=LLINE(IV)
C	WRITE(4,5000)(LLINE(III),III=1,64)
5000	FORMAT(1X,32A1,40A1)
	CALL OFF8(LINE,NREAD)
C MASSAGE THE FILE NAME TO GET THE LAST PART
	LSLSH=0
	LSTN=1
	KPER=0
C FIND FILENAME FROM PATH NAME
C THIS ACCOUNTS FOR THE FILENAME SYNTAX DIFFERENCE BETWEEN THE SYSTEMS.
C  BASICALLY IT USES THE LAST PART OF THE PATHNAME AS THE FILENAME,
C  WITH SPECIAL TREATMENT FOR EXTRA EMBEDDED PERIODS, DOLLAR SIGNS,
C  AND UNDERSCORES. UNIX ALLOWS ALL KINDS OF WEIRD CHARACTER FILENAMES
C  WHICH WE DON'T WANT TO LET RSX TRY TO HANDLE.
C
C FOR VMS, PERMIT FILE 3 TO BE WRITTEN WHICH HAS DERIVED NAMES IN ORDER
C SO THEY MAY BE ASSOICATED WITH TARDIR
C
	IF(LLINE(1).EQ.'.')LLINE(1)=32
	DO 5001 N5001=1,99
	IF(LLINE(N5001).EQ.'/')LSLSH=N5001
C END SCAN ON ANY CONTROL CHARACTERS
	IF(LLINE(N5001).LE.31)GO TO 5002
C FOLD FUNNY CHARACTERS INTO VALID RSX ONES FOR FILESPECS
	IF(LLINE(N5001).EQ.'_')LLINE(N5001)='0'
	IF(LLINE(N5001).EQ.'$')LLINE(N5001)='1'
C ELIMINATE ALL BUT LAST PERIOD OF FILENAME
	IF(LLINE(N5001).EQ.'.'.AND.KPER.NE.0)LLINE(KPER)='2'
	IF(LLINE(N5001).EQ.'.')KPER=N5001
C MAKE FILENAMES UPPER CASE
	IF(LLINE(N5001).GT.96)LLINE(N5001)=LLINE(N5001)-32
C MUNGE ALL OTHER INVALID CHARACTERS INTO 3'S
	IF(.NOT.((LLINE(N5001).GE.'0'.AND.LLINE(N5001).LE.'9')
     1  .OR.(LLINE(N5001).EQ.'.')
     2  .OR.(LLINE(N5001).GE.'A'.AND.LLINE(N5001).LE.'Z')))
     3  LLINE(N5001)='3'
5001	CONTINUE
5002	LSTN=N5001
	IF(LSLSH+1.NE.LSTN)GOTO 6741
C FIXUP CASES OF TOTALLY NULL NAMES...USE RSX NULL NAMES.
	LLINE(LSTN)='.'
	LSTN=LSTN+1
6741	CONTINUE
	LLINE(LSTN)=0
C FORCE LEGAL LENGTH FILE NAME BY ZEROING BYTE AFTER TOO MANY CHARS
	IF(KPER.GT.LSLSH)GOTO 6500
C HERE THERE IS NO PERIOD AFTER THE LAST SLASH... ZERO THE 9TH CHAR
C AFTER THE BUFFER
C THUS LLINE(LSLSH+1) THRU LLINE(LSLSH+9) ARE FILE NAME
C THIS INCLUDES THE CASE KPER=LSLSH=0.
	LLINE(LSLSH+10)=0
	GOTO 6502
6500	CONTINUE
C HERE THERE IS A PERIOD IN THE FILENAME. CLR THE 3RD CHAR AFTER IT
C SO ALL'S WELL...
	IF(KPER.GT.0)LLINE(KPER+4)=0
C SINCE FILE NAME MIGHT STILL BE TOO LONG, CHECK THAT (KPER-LSLSH_
C DOES NOT EXCEED MAX RSX LIMIT OF 10 AND ZERO FILENAME IF IT DOES
C AFTER 9 CHARS
	IF((KPER-LSLSH).GT.10)LLINE(LSLSH+10)=0
6502	CONTINUE
C LINE(125) ON IS LENGTH OF FILE IN BYTES (IN OCTAL)
C FIND END OF FILENAME
	KDTT=LSLSH
6561	IF(LLINE(KDTT+1).LE.0)GOTO 6562
	KDTT=KDTT+1
	GOTO 6561
6562	CONTINUE
	DO 6564 IV=1,20
6564	LFNM(IV)=32
	IVV=0
	IVVVV=LSLSH+1
	DO 6563 IV=IVVVV,KDTT
	IVV=IVV+1
	LFNM(IVV)=LLINE(IV)
6563	CONTINUE
6560	FORMAT(20A1)
C LENGTH IS 12 BYTE DECIMAL. ZERO AT END AS FLAG.
C	LLINE(137)=0
	NFILBY=IVAL(LLINE(125))
	IVVVV=NDFNM-1
	DO 9168 NV=1,20
	DFNM(IVVVV+NV)=LLINE(LSLSH+NV)
9168	CONTINUE
	NOPNF=1
C FIND OUT IF WE WANT TO REALLY WANT TO OPEN FILE
	IF(IKP.EQ.0)GOTO 9169
	IF(IKP.EQ.1)GOTO 9171
C IKP=2 IS QUERY MODE. ONLY ACCEPT FILES WITH COL 1 HAVING Y
C IN IT ON READIN...
C OLINE IS FREE AT THIS POINT SO USE IT FOR SCRATCH...
	READ(2,9158,END=9171,ERR=9171)(OLINE(IVVVV),IVVVV=1,80)
	IF(OLINE(1).EQ.'Y')GOTO 9169
9171	CONTINUE
C HERE FOR DIRECTORY OR IF QUERY FILE IS SHORTER THAN TAPE...
	OPEN(UNIT=3,RECORDSIZE=512,NAME='NL:',TYPE='NEW')
	GOTO 9170
9169	CONTINUE
	OPEN (UNIT=3,TYPE='NEW',CARRIAGECONTROL='LIST',DISPOSE='SAVE',
     1  RECORDSIZE=512,
     2  NAME=DFNM)
9170	CONTINUE
C FLAG FIRST RECORD SITUATION AND NONBINARY FOR STARTERS.
	IFRST=0
	IUXBN=0
	ITXTO=1
116	CONTINUE
C	READ TAPE, THEN OUTPUT TO PDP11 WITH RECORD BOUNDARIES AT C.R.
	ITXTI=1
C ACCOUNT FOR HEADER'S IHDRSZ BYTES IN FILE...
	NREAD=NFILB2-IHDRSZ
	IF(KFRST.EQ.0.OR.NREAD.LE.0)GOTO 9315
C MOVE BUFFER UP BY IHDRSZ AND GO ON
	KFF=IHDRSZ
	DO 9317 IVV=1,NREAD
	KFF=KFF+1
9317	LLINE(IVV)=LLINE(KFF)
	GOTO 9316
9315	CONTINUE
C NEED TO READ ANOTHER TAPE RECORD SINCE HEADER WAS IN END OF LAST ONE
C BCLR WILL ZERO BUFFER PRIOR TO REFILL.
	CALL BCLR(LINE,5490)
	CALL MREAD(LINE,10900,NREAD,MFLAG)
C KFRST FLAG SET ONLY WHEN WE READ A HDR (OR GET A HDR)
9316	KFRST=0
	NFILB2=NREAD
C CHECK FOR BINARY FILE.
	IF (IFRST.NE.0) GOTO 6430
	IFRST=1
C LOOK FOR MAGIC NUMBERS THAT TELL US FILE IS BINARY...
	IF (IBF(1).LT."407.OR.IBF(1).GT."411) GOTO 6465
C FLAG THIS A BINARY FILE
	NFILKK=NFILBY+IGRN-1
	NFILKK=NFILKK/IGRN
	WRITE(4,5008)(UFNM(IV),IV=1,64),
     1   (LFNM(IV),IV=1,20),IBF(1),NFILKK
5008	FORMAT(1X,14A1,50A1,' -> ',20A1,' BIN, FLG=',O6,' ',I7)
	IUXBN=1
	GOTO 6430
6465	CONTINUE
	NFILKK=NFILBY+IGRN-1
	NFILKK=NFILKK/IGRN
	WRITE(4,6466)(UFNM(IV),IV=1,64),
     1   (LFNM(IV),IV=1,20),NFILKK
6466	FORMAT(1X,14A1,50A1,' -> ',20A1,' ASCII ',I7)
6430	CONTINUE
C COMPUTE BYTES LEFT THIS FILE
	IF(NFILB2.GT.NFILBY)GOTO 6001
C NFILB2 = ACTUAL NUMBER BYTES READ OFF TAPE.
	NFILBY=NFILBY-NFILB2
	ILSTBK=0
	GOTO 6002
6001	CONTINUE
	NREAD=NFILBY
C FLAG LAST BLOCK OF FILE FOR READING NEW TAPE RECORD
C ILSTBK = LENGTH LEFT IN BUFFER
	ILSTBK=NFILB2-NFILBY
	NFILBY=0
	IF(ILSTBK.LT.IGRN)ILSTBK=0
6002	CONTINUE
	CALL ERFLG(MFLAG,MFLAG)
	IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO5020
C	REMOVE H.O. BIT FROM ALL TEXT BYTES...
C	CALL OFF8(LINE,NREAD)
C	NREAD=NUMBER BYTES FOUND IN BUFFER
C	COPY DATA TO OLINE UNTIL:
C	1. A C.R. CHAR IS ENCOUNTERED IN OUTPUT, OR
C	2. TAPE DATA IS EXHAUSTED
C	THROW OUT CONTROL CHARACTERS (ZERO FILL)
C
118	CONTINUE
	ISAVE=LLINE(ITXTI)
	ITXTI=ITXTI+1
C ALLOW END OF RECORD IF EITHER C.R. OR L.F. SEEN
C UNIX USES LF AS END OF RECORD BUT ALLOW EITHER.
C NOTE IF FILE WAS BINARY, JUST TREAT AS 512 BYTE IMAGES.
	IF (IUXBN.NE.0) GOTO 6347
	IF (ISAVE.EQ.10) GO TO 120
	IF (ISAVE.EQ.13) GO TO 120
6347	CONTINUE
	OLINE(ITXTO)=ISAVE
C WRITE OUTPUT AFTER 512 BYTES EVEN IF NO LF SEEN YET.
	IF (ITXTO.GE.512) GOTO 120
	ITXTO=ITXTO+1
C	READ MORE TAPE IF WE MUST, TO GET NEXT PART OF LINE
	IF (ITXTI.LE.NREAD)GO TO 118
	IF(NFILBY.LE.0) GOTO 120
C THE ABOVE CLOSES THE FILE IF WE GOT TO END OF THE INPUT FILE ON THE TAR
	GO TO 116
120	CONTINUE
C	HERE EMIT OUTPUT LINE AND CLEAR ITXTO POINTER
	WRITE (3,122)(OLINE(I95),I95=1,ITXTO)
122	FORMAT(132A1,132A1,132A1,120A1)
	ITXTO=1
C ZERO OUTPUT RECORD AGAIN.
124	DO 126 I95=1,512
	OLINE(I95)=0
126	CONTINUE
C	WHEN DONE WRITING THIS RECORD, GO TRY FOR MORE.
C CONTINUE TO USE BUFFER UNLESS WE REACHED END FILE ON LAST WRITE
	IF (ITXTI.GT.NREAD.AND.NFILBY.LE.0)GOTO 128
	GO TO 118
128	CALL CLOSE(3)
C GO TRY ANOTHER FILE TILL EOF
C FIRST BE SURE WE DON'T HAVE DATA LEFT IN THIS RECORD.	
	IF(ILSTBK.EQ.0)GOTO 114
C MOVE DATA UP BY (ILSTBK/IGRN) * IGRN BYTES
C AND ADJUST NREAD TO WHAT WAS LEFT.
	NREAD=IGRN*(ILSTBK/IGRN)
	KBFCT=NFILB2/IGRN
	LSTART=IGRN*KBFCT-NREAD
C LSTART,NREAD ARE START, SIZE OF AREA TO MOVE
	L00=LSTART
	DO 6569 IV=1,NREAD
	L00=L00+1
	LLINE(IV)=LLINE(L00)
6569	CONTINUE
C NOW WHOLE AREA IS MOVED UP SO THAT WE APPEAR TO HAVE READ IN A
C "SHORT" TAPE RECORD AND HAVE UPDATED NREAD TO THE RECORD.
C  TO FIX UP FOR OTHER BLOCK SIZES WE NEED ONLY UPDATE
C  IGRN, WHICH MUST BE 1 AT LEAST. HOWEVER, ONE EXPECTS
C  THAT IT WILL BE 512. OR MAYBE 1024. OR 2048. FOR OTHER FLAVORS
C  OF UNIX. (PROBABLY CORRESPONDS TO DISK BLOCK SIZE).
C ALSO FIX UP NFILB2 TO NEW LENGTH AND SET NREAD UP ALSO AS AMOUNT
C LEFT IN BUFFER.
	NFILB2=NREAD
	GO TO 6567
5020	CALL CLOSE(4)
	CALL CLOSE(3)
	CALL CLOSE(2)
	GO TO 188
130	CONTINUE

	IF (ICMD.NE.'W') GO TO 150
C	WRITE PDP11 FILE FROM TAPE FILE. USER GIVES NAME.
	IRECCT=0
132	CALL FFINTG(IPTRS,IBKFAC)
	IF (IBKFAC.LT.1)IBKFAC=1
	IF (IBKFAC.GT.120)IBKFAC=120
C ALLOW FOR CASE OF LONG RECORDS BY HAND HERE. CRUDE SOLUTION ONLY!
	IF ((IBKFAC*KSZ).GT.10400)WRITE(6,134)KSZ
134	FORMAT(' ** BLOCK FACTOR TOO LONG FOR RECORD SIZE ',I4)
	IF ((IBKFAC*KSZ).GT.10400)IBKFAC=10400/KSZ
	CALL GETCML(LINE,3HINP,MCRSZ,72)
	LINE(MCRSZ+1,1)=0
C	CALL ASSIGN(3,LINE,MCRSZ)
	OPEN (UNIT=3,TYPE='NEW',CARRIAGECONTROL='LIST',DISPOSE='SAVE',
     1  RECORDSIZE=180,
     2  NAME=LINE,INITIALSIZE=10,EXTENDSIZE=12)
136	CONTINUE
	CALL BCLR(LINE,5200)
	CALL MREAD(LINE,10500,NREAD,MFLAG)
	IF (MVBIT.NE.0)CALL BITSWP(LINE,NREAD)
	CALL ERFLG(MFLAG,MFLAG)
	IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO 146
C	TRANSLATE EBCDIC TO ASCII
	IRECCT=IRECCT+1
	KTMP=IBKFAC*KSZ
	IF (IEBFLG.NE.0)CALL EA(LINE(1,1),LINE(1,1),KTMP)
	IF (IBCDFG.NE.0)CALL BCDASC(LINE(1,1),KTMP)
	DO 144 ICNT=1,IBKFAC
C FIND END OF RECORD AND CHOP OFF TRAILING SPACES.
C CHOP OFF TRAILING WHITESPACE REGARDLESS...
	IWW=KSZ
CD	IF(KSZ.NE.80)GOTO 140
	KQ1=KSZ-2
	KQ2=KSZ+1
	DO 138 IW=1,KQ1
	IWW=KQ2-IW
	IF (LINE(IWW,ICNT).NE.32) GOTO 140
138	CONTINUE
140	CONTINUE
	KTMP=KSZ*(ICNT-1)+1
	KTMP2=KTMP+KSZ-1
CD	IF(KSZ.EQ.80)KTMP2=KTMP+IWW-1
	KTMP2=KTMP+IWW-1
	WRITE(3,142)(LLN(III),III=KTMP,KTMP2)
142	FORMAT(180A1)
144	CONTINUE
	IF (MULTRC.EQ.0) GO TO 146
C	SINGLE INPUT IF UNIT MODE SELECTED.
	GO TO 136
146	CONTINUE
	WRITE(6,148)IRECCT
148	FORMAT(' TPP-- ',I10,' RECORDS PROCESSED')
	CLOSE(UNIT=3)
C	CALL CLOSE(3)
	GO TO 188
150	CONTINUE
	IF (ICMD.NE.'C') GO TO 170
C	COPY FILE. GET PDP11 FILE SPECS FIRST.
	IRECCT=0
152	CONTINUE
	CALL FFINTG(IPTRS,IBKFAC)
	IF (IBKFAC.LT.1)IBKFAC=1
	IF (IBKFAC.GT.120)IBKFAC=120
	CALL GETCML(LINE,3HWRT,MCRSZ,72)
C	READ IN FILE SPECS.
	CALL ASSIGN(3,LINE,MCRSZ)
	CALL FDBSET(3,'READONLY','SHARE')
C	SET UP ONLY READ ACCESS NEEDED FOR FILE.
C	WRITE 1ST RECORD=FILE NAME SPECS
C	*********
C	GO TO 110
154	CONTINUE
	isb=1
	DO 160 ICNT=1,IBKFAC
	lsb=isb+ksz-1
	READ(3,156,END=162,ERR=166)(lln(kkkk),kkkk=isb,lsb)
156	FORMAT(2(132a1:))
158	CONTINUE
C	TRANSLATE ASCII TO EBCDIC
	IF (IEBFLG.NE.0)CALL AE(LINE(1,ICNT),lln(isb),ksz)
	isb=isb+ksz
160	CONTINUE
	IRECCT=IRECCT+1
	CALL MWRITE(LINE,ksz*IBKFAC,NFLAG)
	CALL ERFLG(NFLAG,NFLAG)
	IF (NFLAG.EQ.3.OR.NFLAG.EQ.6) GO TO 166
	GO TO 154
162	CONTINUE
	WRITE(6,148)IRECCT
	IF (IBKFAC.EQ.1) GO TO 164
	CALL MWRITE(LINE,80*IBKFAC,NFLAG)
	CALL ERFLG(NFLAG,NFLAG)
164	CONTINUE
C	READ TO END-OF-FILE
C	WRITE 2 EOF ON TAPE AND BACKSPACE OVER ONE OF THEM.
	CALL MEOF(2)
	CALL MSKIPR(-1)
C	THAT DOES IT.
	CALL CLOSE(3)
	GO TO 188
166	CONTINUE
	WRITE (6,168)
168	FORMAT(' TPP--WRITE ERROR FOR SOME REASON--OPERATION ABORTED.')
	CALL CLOSE(3)
	GO TO 188
170	CONTINUE
	IF (ICMD.NE.'R') GO TO 172
C	REWIND TAPE
	CALL MREWIN
	GO TO 178
172	CONTINUE
	IF (ICMD.NE.'E') GO TO 174
C	WRITE AN EOF ON TAPE
	CALL MEOF(1)
	GO TO 178
174	CONTINUE
	IF (ICMD.NE.'S') GO TO 176
C	SKIP RECORDS. GET RECORD COUNT FROM STRING
	CALL FFINTG(IPTRS,NRECS)
	CALL MSKIPR(NRECS)
	GO TO 178
176	IF (ICMD.NE.'F') GO TO 184
C	SKIP FILES. GET FILE COUNT FROM STRING.
	CALL FFINTG(IPTRS,NRECS)
	CALL MSKIPF(NRECS)
178	CONTINUE
C	HERE HAVE DONE A TAPE I/O OP. TEST STATUS.
	CALL MSTAT(JERR)
C	DECODE ERRORS
	CALL ERFLG(JERR,JERR)
	IF (JERR.LE.0) GO TO 184
	IF (JERR.EQ.6) WRITE (6,182)IUNIT
	IF (JERR.NE.6) WRITE (6,180)IUNIT
180	FORMAT(' TPP -- I/O ERROR ON UNIT MT',I1,': -OPERATION ABORTED')
182	FORMAT(' TPP -- TAPE UNIT MT',I1,': UNMOUNTED')
184	CONTINUE
CD	WRITE (6,186)JJJJ,IUNIT,NRECS
CD186	FORMAT(' ICMD=',A2,' IUNIT= ',I4,'NRECS= ',I4 )
188	GO TO 20
	END
	INTEGER*4 FUNCTION IVAL(LIADDR)
	INTEGER*4 IACC,IWRK,I10
	BYTE LIADDR(12)
C I10 IS RADIX.
	DATA I10/8/
C COMPUTE A NUMBER IN OCTAL
	IACC=0
	KSW=0
	DO 1000 N1000=1,12
	II=0
C MASK TO 7 BIT ASCII
	II=LIADDR(N1000).AND.127
C CHECK LEGAL NUMERIC RANGE CHARS
	IF(II.GE.48.AND.II.LT.58)GOTO 1001
C IGNORE LEADING NON NUMERICS BUT END ON TRAILING ONES
	IF(KSW.NE.0)GOTO 1002
	IWRK=0
	GOTO 1000
1001	IWRK=II-48
	IACC=IACC*I10+IWRK
	KSW=1
1000	CONTINUE
1002	IVAL=IACC
	RETURN
	END