C
C
C-----------------------------------------------------------------------------
C
C	PROGRAM:	R T C O P Y
C
C	AUTHOR:		Han Lasance
C
C	DATE:		1979
C
C	VERSION:	V1.1	7-JUL-82
C
C	MODIFIED BY:	Han Lasance	7-JUL-82	HL01	V1.1
C			Task does not stop any more on illegal record length.
C
C			Added wildcard facility together with question mark
C			which matches any character on that position in name
C			or filetype string.
C			Example:
C			ENTER MAX 10 FILES [<CR>= READY]
C
C			1: *.?L?
C			2: E????.*
C			3:
C
C			COPIED:		SMAC.MLS resp. ERMSG.MAC
C
C	PURPOSE:	Transfer of RT11 files from MM: to RSX-11M format.
C			
C	NOTE:		This option is not supported by FLX in RSX11M V3.2
C
C	INPUT FILE:	RT11 formatted file
C
C	OUTPUT FILE:	FILES 11 file on system disk
C
C	LUNS:		1	DM:
C			2	MM:
C			5	TI:
C			
C	CALLS TO:	ASKTT,  CHKCOP, NEXTBL (concatenated with RTCOPY)
C			ASSIGN, CLOSE,  GETADR, GETLUN, OPEN, QIO
C
C	BUILDING:	TKB RTCOPY=RTCOPY
C
C-----------------------------------------------------------------------------
C
C

	PROGRAM		R T C O P Y
C
C
	LOGICAL ILLLEN,SOMFIL,COPY,WILD
	LOGICAL*1 IBYTE(512),IREC(140),FNAME(11)
	LOGICAL*1 VOLID(6),OWNER(9),F
	DIMENSION IPARAM(6),IOSB(2),IBUF(256),IBUF1(256),MMDAT(6)
	COMMON /ASKDAT/SOMFIL,WILD,F(10,10),NC(10),NFIL
	COMMON /FOUND/IFOUND(10),NFO
	EQUIVALENCE (IBUF(1),IBYTE(1)),(RTLAB,IBYTE(1))
	EQUIVALENCE (IBT1T2,IBYTE(1)),(BYT1T4,IBYTE(1))
	EQUIVALENCE (VOLID(1),IBYTE(5)),(OWNER(1),IBYTE(41))
	DATA RTLAB1/'VOL1'/,HEADER/'HDR1'/,EOF/'EOF1'/
C
C
C
	CALL ASSIGN(2,'MM:')
C
C		GET LUN PARAMETERS AND CHECK IF DRIVER RESIDENT
C
	CALL GETLUN(2,MMDAT,IDS)
	IF(IAND("100000,MMDAT(2)).NE.0) GO TO 5
	WRITE(5,1)
1	FORMAT(/' *** FATAL *** MM: DRIVER NOT RESIDENT'/)
	STOP
C
C		INIT SOME VARIABLES
C
5	IFIL=0
	DO 6 I=1,10
6	IFOUND(I)=0
	COPY=.TRUE.
	NFO=0
	ILLLEN=.FALSE.
	IPARAM(2)=512
	CALL GETADR(IPARAM(1),IBUF)
	NB=0
C
C		REWIND TAPE AND CHECK FOR HARD ERRORS
C
	CALL QIO("2400,2,,,IOSB)
	IF(IOSB(1).EQ.1) GO TO 8
	WRITE(5,7) IOSB(1),IOSB(2)
7	FORMAT(/' *** FATAL *** -- TAPE ERROR, STATUS CODES: ',O6,3X,O6)
	STOP
C
C		ASK FOR PARAMETERS
C
8	CALL ASKTT
C
C		TEST IF REWIND IS READY
C
10	CALL QIO("2520,2,,,IOSB)
	IF(IAND("1000,IOSB(2)).NE.0) GO TO 10
C
C		READ FIRST BLOCK FROM MAGTAPE
C
	CALL NEXTBL(IPARAM,IOSB,NB)
C
C		TEST IF THIS BLOCK CONTAINS VALID VOLUME LABEL
C
	IF(RTLAB.EQ.RTLAB1) GO TO 30
	WRITE(5,20)
20	FORMAT(/' *** FATAL ***  --  NO RT11 VOLUME'//)
	STOP
C
C		IF VALID, PRINT LABEL AND OWNER NAME
C
30	WRITE(5,40) VOLID,OWNER
40	FORMAT(/' ***** VOLUME IDENTIFIER: ',6A1,
     $/' ***** OWNER NAME       : ',9A1//)
C
C		THIS BLOCK SHOULD BE A HEADER
C
50	CALL NEXTBL(IPARAM,IOSB,NB)
	IF(BYT1T4.NE.HEADER) GO TO 265
C
C		SAVE FILE NAME
C
	DO 60 I=1,10
60	FNAME(I)=IBYTE(I+4)
C
C		COPY THIS FILE???
C
	IF(SOMFIL) CALL CHKCOP(COPY,FNAME)
C
C		THIS BLOCK SHOULD BE A TAPE MARK, IF NOT... WARNING
C
	CALL NEXTBL(IPARAM,IOSB,NB)
	IF(IBT1T2.NE."11423) WRITE(5,65) NB,(FNAME(I),I=1,10)
65	FORMAT(/' *** WARNING *** -- NO TAPE MARK AFTER HEADER IN BLOCK
     $ #',I5,' [',10A1,']'/)
C
C		FIRST DATA BLOCK
C
	CALL NEXTBL(IPARAM,IOSB,NB)
C
C		IF THIS ONE NOT WANTED, FIND EOF
C
90	IF(.NOT.COPY) GO TO 170
C
C		OPEN FILE ON DISK
C
	OPEN(UNIT=1,NAME=FNAME,CARRIAGECONTROL='LIST',
     $ACCESS='SEQUENTIAL',TYPE='NEW')
	ILLLEN=.FALSE.
	K=0
C
C		START CONVERSION OF BLOCKS INTO RECORDS
C
100	DO 150 I=1,512
	IF(IBYTE(I).EQ."15) GO TO 130		!IF <CR>, END OF RECORD
	IF(IBYTE(I).EQ."12) GO TO 150		!SKIP LINEFEEDS AND
	IF(IBYTE(I).EQ.0) GO TO 150		!0'S
	K=K+1
	IREC(K)=IBYTE(I)			!SAVE THIS CHARACTER
	IF(K.LE.132) GO TO 150			!MAX RECORD SIZE = 132
C
C		HERE, IF RECORD SIZE > 132
C
	ILLLEN=.TRUE.
	WRITE(5,110) NB,FNAME
110	FORMAT(/' *** WARNING ***  --  ILLEGAL RECORD LENGTH IN BLOCK #',I5,
     $' [',11A1,']'/)
	CLOSE(UNIT=1)
120	CALL NEXTBL(IPARAM,IOSB,NB)		!KEEP LOOKING FOR EOF ..
	IF(IBT1T2.NE."11423) GO TO 120		!WITHOUT COPYING
	GO TO 180
C
C		WRITE THIS RECORD TO FILE ON DISK
C
130	WRITE(1,140) (IREC(J),J=1,K)
140	FORMAT(132A1)
	K=0
150	CONTINUE
160	CALL NEXTBL(IPARAM,IOSB,NB)		!READ NEXT BLOCK
170	IF(IBT1T2.EQ."11423) GO TO 175		!TAPEMARK?
	IF(.NOT.COPY) GO TO 160		!IF NO COPY, KEEP LOOPING
	GO TO 100			!CONVERT THIS DATA BLOCK
C
C		HERE, IF TAPEMARK DISCOVERED AFTER DATABLOCK
C
175	IF(COPY) CLOSE(UNIT=1)
C
C		IF NEXT BLOCK DOESN'T CONTAIN EOF... WARNING
C
180	CALL NEXTBL(IPARAM,IOSB,NB)
	IF(BYT1T4.NE.EOF) WRITE(5,210) NB,FNAME
190	FORMAT(/' *** WARNING *** -- NO EOF AFTER TAPEMARK IN BLOCK #',
     $I5,' [',11A1,']'/)
C
C		IF NEXT BLOCK ISN'T A TAPEMARK... WARNING
C
200	CALL NEXTBL(IPARAM,IOSB,NB)
	IF(IBT1T2.NE."11423) WRITE(5,210) NB,FNAME
210	FORMAT(/' *** WARNING *** -- NO TAPEMARK AFTER EOF IN BLOCK #',
     $I5,' [',11A1,']'/)
C
C		IF NO COPY NEEDED, TRY NEXT FILE ON TAPE
C
220	IF(.NOT.COPY) GO TO 50
C
C		HERE, IF FILE WAS COPIED. PRINT SOME CHARACTERISTICS
C
230	IFIL=IFIL+1
	IF(IFIL.EQ.1) WRITE(5,240)
240	FORMAT(/' ----- FILES COPIED: -----'//)
	IF(.NOT.ILLLEN) WRITE(5,250) IFIL,FNAME
250	FORMAT(1X,I4,': ',11A1)
	IF(ILLLEN) WRITE(5,260) IFIL,(FNAME(I),I=1,10)
260	FORMAT(1X,I4,': ',10A1,' *** COPY NOT COMPLETED ***'/)
C
C		IF NR FILES WANTED = NR OF FILES COPIED... READY
C
	IF(WILD) GO TO 50
	IF(NFIL-IFIL) 50,500,50
C
C		HERE, IF EXPECTED HEADER BLOCK DIDN'T APPEAR
C
265	IF(NB.GT.2) GO TO 267		!2ND BLOCK?... VOLUME EMPTY!
	WRITE(5,266)
266	FORMAT(/' *** WARNING *** -- VOLUME EMPTY'/)
	GO TO 500
C
C		IF ALL WANTED FILES ARE COPIED, READY
C
267	IF(.NOT.SOMFIL) GO TO 500
C
C		PRINT ALL FILES NOT FOUND
C
	WRITE(5,270)
270	FORMAT(//)
	DO 300 K=1,NFIL
	IF(IFOUND(K).NE.0) GO TO 300
	WRITE(5,290) (F(K,L),L=1,NC(K))
290	FORMAT(' *** WARNING *** -- DID NOT FIND FILE: ',10A1)
300	CONTINUE
C
C		REWIND TAPE
C
500	CALL QIO("2400,2)
	IF(IFIL.GT.0) WRITE(5,510)
510	FORMAT(//' -------------------------'//)
	STOP
	END
C
C
C -------------------------------------------------------

C
C
	SUBROUTINE	A S K T T
C
C
	LOGICAL*1 F,YN,Y
	LOGICAL SOMFIL,WILD
	COMMON /ASKDAT/SOMFIL,WILD,F(10,10),NC(10),NFIL
	DATA Y/'Y'/
C
C
	NFIL=0
	WILD=.FALSE.
	DO 5 I=1,10
5	NC(I)=0
	WRITE(5,10)
10	FORMAT(/'$COPY ALL FILES? [Y/N]: ')
	READ(5,20) YN
20	FORMAT(A1)
	SOMFIL=.FALSE.
	IF(YN.EQ.Y) GO TO 70
	WRITE(5,30)
30	FORMAT(/' ENTER MAX 10 FILES [<CR> = READY]'//)

40	NFIL=NFIL+1
	WRITE(5,50) NFIL
50	FORMAT('$',I2,': ')
	READ(5,60) NC(NFIL),(F(NFIL,I),I=1,NC(NFIL))
60	FORMAT(Q,10A1)
	DO 65 I=1,NC(NFIL)
65	IF(F(NFIL,I).EQ.'*'.OR.F(NFIL,I).EQ.'?') WILD=.TRUE.
	IF(NC(NFIL).NE.0.AND.NFIL.LT.10) GO TO 40

	IF(NC(10).EQ.0) NFIL=NFIL-1
	IF(NFIL.GT.0) SOMFIL=.TRUE.
70	RETURN
	END
C
C
C---------------------------------------------------------

C
C
	SUBROUTINE	N E X T B L	(IPARAM,IOSB,NB)
C
C
	DIMENSION IPARAM(6),IOSB(2)
C
C
	CALL QIO("1000,2,2,,IOSB,IPARAM)
	NB=NB+1
	CALL WAITFR(2)
	RETURN
	END
C
C
C-------------------------------------------------------

C
C
	SUBROUTINE	C H K C O P	(COPY,FNAME)
C
C
	LOGICAL*1 FNAME(11),F
	LOGICAL SOMFIL,COPY,WILD
	COMMON /ASKDAT/SOMFIL,WILD,F(10,10),NC(10),NFIL
	COMMON /FOUND/IFOUND(10),NFO
C
C
	COPY=.FALSE.
	DO 50 I=1,NFIL
	K=0
	IF(F(I,K+1).NE.'*') GO TO 15
	K=K+1
	GO TO 20

15	DO 10 J=1,6
	IF(FNAME(J).EQ.32) GO TO 10
	K=K+1
	IF(F(I,K).NE.FNAME(J).AND.F(I,K).NE.'?') GO TO 50
10	CONTINUE

20	K=K+1					!SKIP '.'
	IF(F(I,K+1).EQ.'*') GO TO 40
	DO 30 J=8,10
	IF(FNAME(J).EQ.32) GO TO 30
	K=K+1
	IF(F(I,K).NE.FNAME(J).AND.F(I,K).NE.'?') GO TO 50
30	CONTINUE

40	COPY=.TRUE.
	IFOUND(I)=1
	GO TO 100

50	CONTINUE

100	RETURN
	END