;*; Updated on 22-Apr-95 at 9:09 PM by ; edit time: 4:52:59
;
;	TPTOTP.M68	Transfer files between tape devices
;
;	AUTHOR		Eric Fletcher, Tele-Tax, Inc
;			2020 NE 163 ST  Suite 206
;			North Miami Beach, Fl., 33162
;			305 944-4054
;			1 800 797 6687 if you're desperate
;
; This pgm adapted from WRDISK which read a tape and wrote directly to disk.
; WRDISK was inspired by ALPHA's TAPE program because it was soooo Slooooooow
; and because I needed the ability to write data to random files. This pgm
; came about because I copy from one tape device to another quite frequently
; and to copy to disk then to tape is a colossal waste of time.
;
; The output section was left as being referenced as DSKxxx as this was the
; easiest (laziest?) thing to do. If you improve it (what pgm can't be im-
; proved?), let me know. One improvement that comes to mind is changing data 
; from ascii to ebcdic or ebcdic to ascii. Beware somebody doesn't slip in a 
; few comp-3 fields.
;
; It still needs some work - especially if you copy from MTU to MTX. You'll
; see what I mean if you try it. It's only cosmetic - it will not crash your
; system.
;
;	This program may be freely copied, modified and in general bad mouthed
;	in any way you like. You cannot sell it. You must give it away.
;
	MAYCREF
	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	MACLIB

	OBJNAM	TPTOTP.LIT

MTUPTR = A3
DSKPTR = A4
IMP = A5

TOTCNT = D0		;registers used as much as possible for speed
TAPCNT = D2		;bytes read in from tape during a read instruction
BLKSIZ = D3		;bytes requested for a tape write instruction
RECSIZ = D4		;size of tape logical record
BLKFCT = D5		;number of logical records to process as a block
INVCTR = D6			;interval accumulator

INTVAL = 20.			;every 20th write, display bytes written

T.BLOK = 32766.			;change if you want to handle blocks larger
				;than 32766 bytes
;
; Set up our work area so we are reentrant
;
.OFINI
.OFDEF	MTUDDB,	D.DDB		;input ddb
.OFDEF	DSKDDB,	D.DDB		;output ddb
.OFDEF	TAPBUF, T.BLOK		;input and output buffer. If you plan to do
				;reblocking, you may need to do a little
				;creative programming
.OFSIZ	IMPSIZ

	VMAJOR = 1
	VMINOR = 0
	VSUB   = 2
	VEDIT  = 4

	PHDR	-1,PV$RSM!PV$RPD,PH$REE!PH$REU	;reentrant and reusable

	GETIMP	IMPSIZ,A5

	CRLF
	TYPECR	TAPE COPY PROGRAM - This program copies files from one tape
	TYPECR	device to another.
	CTRLC	BYEBYE

	CALL	GETMTU
	CALL	GETDSK
	CALL	GETSIZ
	CLR	TOTCNT

LOOP:	CTRLC	CLOSER
	MOV	BLKFCT,D1	;get number of tape logical records to read
	DEC	D1		;decr to use with dbf instruction
	LEA	A0,TAPBUF(A5)	;index buffer
10$:	MOV	A0,D.BUF(MTUPTR);tell mtu where to put it
	CALL	READ		;go get a record
	ADD	RECSIZ,A0	;bump location in buffer
	DBF	D1,10$		;loop till done
	CTRLC	CLOSER
	LEA	A0,TAPBUF(A5)	;get buffer location
	MOV	A0,D.BUF(DSKPTR);tell our output ddb where it is
	MOV	BLKSIZ,D.SIZ(DSKPTR);number of bytes to write
	CALL	WRITE		;do it
	BR	LOOP		;loop till done

GETSIZ:	CRLF
	TYPESP	Enter the number of bytes in a tape block
	CTRLC	CLOSER
	KBD
	BYP
	GTDEC			;convert to binary
	MOV	D1,RECSIZ	;save it
GTSZAN:	CRLF
	TYPESP	YOU ENTERED
	DCVT	0,OT$TRM		;show it
	TYPESP	. Is this right? Y or N
	KBD
	CTRLC	CLOSER
	BYP
	UCS
	CMPB	@A2,#'Y
	BEQ	GETBKF
	CMPB	@A2,#'N
	JEQ	GETSIZ
	MOV	RECSIZ,D1
	BR	GTSZAN

GETBKF:	MOV	RECSIZ,BLKSIZ
	CRLF
	TYPESP	Do you want to change the blocking factor? Y or N
	KBD	BYEBYE
	BYP
	UCS
	CMPB	@A2,#'N
	REQ
	CMPB	@A2,#'Y
	BNE	GETBKF
GETBK5:	CRLF
	TYPESP	Enter blocking factor
	KBD	BYEBYE
	BYP
	GTDEC
	MOV	D1,BLKFCT

CHKSIZ:	MOV	RECSIZ,D1
	MUL	D1,BLKFCT
	CMPW	D1,#T.BLOK
	JLOS	90$
	CRLF
	TYPESP	NEW SIZE IS
	DCVT	0,OT$TRM		;show it
	CRLF
	DCVT	0,OT$TRM		;show it
	TYPESP
	TYPESP	is too large.
	MOV	#T.BLOK,D1
	DCVT	0,OT$TRM		;show it
	TYPECR	is the largest size allowed.
	CRLF
	TYPESP	The largest blocking factor you can use with this tape is
	MOV	#T.BLOK,D1		;get current max buffer size
	DIV	D1,RECSIZ		;divide by input block size
	AND	#^H0FFFF,D1		;mask off fractional part
	DCVT	0,OT$TRM		;show it
	CRLF
	TYPESP	Press return to continue
	KBD	BYEBYE
	JMP	GETBK5
90$:	MOV	D1,BLKSIZ
92$:	CRLF
	TYPESP	Output block size is
	DCVT	0,OT$TRM		;show it
	TYPESP
	TYPESP	bytes. Is this ok? Y or N
	KBD	BYEBYE
	BYP
	UCS
	CMPB	@A2,#'N
	JEQ	CHKSIZ
	CMPB	@A2,#'Y
	BNE	92$
	CALL	SKIP
	CLEAR
	HEADER	TAPE COPY ROUTINE,MTX0 TO MTU0	
	CURSOR	#5,#21.
	TYPESP	COPY
	MOV	BLKSIZ,D1
	DCVT	0,OT$TRM		;show it
	TYPESP
	TYPESP	BYTES PER OUTPUT BLOCK
99$:	RTN

GETMTU:	LEA	MTUPTR,MTUDDB(IMP)
	CRLF
	TYPESP	ENTER INPUT TAPE DRIVE ID
	KBD
	BYP
	FSPEC	@MTUPTR			;do the setup on the tape drive
	LEA	A0,TAPBUF(A5)		;get buffer address
	MOV	A0,D.BUF(MTUPTR)	;move it to ddb
	ORB	#D$INI,D.FLG(MTUPTR)	;set inited flag
	ORB	#D$OPNI,D.OPN(MTUPTR)	;set open mode flag
	ORB	#D$ERC,D.FLG(MTUPTR)	;set error flag
7$:	ASSIGN	@MTUPTR			;claim this device
	TSTB	D.ERR(MTUPTR)		;any problems
	JEQ	60$
10$:	ERRMSG	D.ERR(MTUPTR),OT$TRM,OT$LDQ
	CRLF
	BTST	#D$EUSE,D.ERR(MTUPTR)
	BNE	30$
	TYPESP	PRESS RETURN TO RE ASSIGN DEVICE
	KBD	BYEBYE
	JMP	7$
30$:	TYPESP	SOLVE YOUR ERROR BEFORE CONTINUING. Press return to continue.
	KBD
	JMP	BYEBYE
60$:	RTN

READ:	MOV	RECSIZ,D.SIZ(MTUPTR)	;set byte count to read
	READ	@MTUPTR			;read tape
	TST	D.SIZ(MTUPTR)		;did we read anything?
	BEQ	MTUEOF			;if not, br to end of tape rtn. Else..
	MOV	D.SIZ(MTUPTR),TAPCNT	;get number of records read
	RTN

MTUEOF:	PUSH	D1			;save D1
	MOVB	#7,D1			;get the alert signal
	TTY				;and send it
	REWIND	@MTUPTR			;rewind input tape and
	CRLF				;go tell 'em about it.
	TYPECR	THROUGH READING INPUT TAPE.
	CRLF
	TYPESP	Mount new tape & press return when ready. CTRL C to abort.
	CTRLC	CLOSER
	KBD
	CALL	SKIP
	POP	D1
	JMP	READ

SKIP:	CRLF
	TYPESP	Enter Y and press return if you want to skip a label record >
	KBD
	CTRLC	BYEBYE
	BYP
	CMPB	@A2,#'Y
	BNE	30$
	FMARK	@MTUPTR
30$:	RTN

GETDSK:	LEA	DSKPTR,DSKDDB(IMP)
	CRLF
	TYPESP	ENTER OUTPUT TAPE DRIVE ID
	KBD
	CTRLC	CLOSER
	BYP
	FSPEC	@DSKPTR			;do the setup on the tape drive
	LEA	A0,TAPBUF(A5)		;get buffer address
	MOV	A0,D.BUF(DSKPTR)	;move it to ddb
	ORB	#D$INI,D.FLG(DSKPTR)	;set inited flag
	ORB	#D$OPNO,D.OPN(DSKPTR)	;set open mode flag
	ORB	#D$ERC,D.FLG(DSKPTR)	;set error flag
	ASSIGN	@DSKPTR			;claim this device
	RTN

WRITE:	WRITE	@DSKPTR			;read tape
	TSTB	D.ERR(DSKPTR)		;any problems
	JEQ	WRTOK			;no
WRT.ER:	CRLF
	MOVB	D.ERR(DSKPTR),D1
	ANDB	#D$EFUL,D1
	JEQ	10$
	CRLF
	TYPECR	This tape is full. Mount another and press return to continue
	TYPESP	or press CONTROL C to end this program
	KBD
	CTRLC	CLOSER 
	JMP	WRTOK	

10$:	ERRMSG	D.ERR(DSKPTR),OT$TRM,OT$LDQ
	CRLF
	TYPESP	Enter R for Retry or Q for Quit
	KBD
	BYP
	UCS
	CMPB	@A2,#'R		;retry?
	JEQ	WRITE		;yes
	CMPB	@A2,#'Q		;quit?
	JEQ	CLOSER		;yes
	JMP	WRT.ER		;anything else, make 'em put in correct answer

WRTOK:	ADD	D.SIZ(DSKPTR),TOTCNT	;add bytes written to accumulator
	DEC	INVCTR
	BNE	10$
	CURSOR	#20.,#1
	TYPESP	WRITE
	MOV	TOTCNT,D1	;get number of bytes written and
	DCVT	0,OT$TRM	;show it
	TYPESP
	TYPECR	BYTES
	MOV	#INTVAL,INVCTR	;initialize interval counter

10$:	TAPST	@DSKPTR,D1	;check tape status in MTSTAT.SYS
	AND	#377,D1		;mask off upper half of D1
	BTST	#TP$EOT,D1	;end of tape mark detected
	BNE	REWDSK		;yep, go take care of it
	RTN			;no, continue processing
;
REWDSK:	REWIND	@DSKPTR		;rewind output tape
	TYPECR	OUTPUT TAPE IS FULL.
	CRLF
	TYPESP	Mount new tape & press return when ready. CTRL C to abort.
	KBD
	CTRLC	CLOSER
	RTN

CLOSER:	CLOSE	@DSKPTR
	CLOSE	@MTUPTR

BYEBYE:	EXIT

	END