	.TITLE	GETDCK	GET A MAGTAPE DECK FOR INCREMENTAL DUMPER
	.IDENT	/X001.2/
;
;	THIS ROUTINE  SELECTS AN AVAILIABLE TAPE DECK OR COMPLAINS
;	ON THE CONSOLE.
;
;	THEN CHECKS THE TAPE FOR THE FOLLOWING:
;
;	1)	OWNER	[10,1]	DUMP SYSTEM
;	;****************************************************
;	;**** 		LATER HOPEFULLY			*****
;	;****************************************************
;
;	2)	TAPE NAME IN THE DIRECTORY MTFILE.DOC UNDER [1,7]
;
; LUN USAGE
;
;	1	TI:
;	2	MM:
;	3	INCDMPSTS.SYS
;
;	4	FILE BEING DUMPED.
;
;


	.MCALL	OFID$R,ALUN$C,QIOW$C,MRKT$C,EXIT$S,RUN$C,QIOW$S,WTSE$C
	.MCALL	FDBDF$,FSRSZ$,READ$,GET$R,PUT$R,CLOSE$
	.MCALL	WAIT$
	.MCALL	OPEN$M,FDRC$A,FDOP$A
	.MCALL	CSRQ$C,GTIM$C

	FSRSZ$	1	;1 FILES BEING ACCESSED  +INCDMPSTS.SYS
CNTFDB::
	FDBDF$
	FDRC$A	FD.RAN,FDMPNO,16.
	FDOP$A	3,CNTDSP,FO.MFY
CNTDSP::.WORD	3,CNTDEV,6,CNTUIC,15.,CNTFIL
CNTDEV::.ASCII	/SY::/
CNTUIC::.ASCII	/[10,1]/
CNTFIL::.ASCII	/INCDMPSTS.SYS;1/
	.EVEN
DMPFDB::FDBDF$			; FDB FOR FILE BEING DUMPED
	FDRC$A	FD.RWM
	FDOP$A	4,,,FO.RD
DMPSTS::.BLKW	2
FAIL:	.ASCII	/INC... -- CHECK FAIL  /
FILBF:	.BLKW	16.
HDROLD:	.WORD	2048.,1,5,0,5,5,0,0


TIMBF::	.BLKW	8.
MLST::	.WORD	0,31.,60.,91.,121.,152.,182.,213.,244.,276.,305.,335.
NBLK0:	.WORD	0
NBLK::	.WORD	0			;CURRENT BLOCK NUMBER IN FILE
NTBLKS::.WORD 	0			; TOTAL OF ALL BLOCKS WRITTEN
NFIL::	.WORD	6			; USE 6 AS FIRST FILE TO DUMP AS
FSIZ::	.WORD	0
FILNO::	.WORD	0
FDMPNO::.WORD	0
FSEQNO::.WORD	0
FUIC::	.WORD	0
FNAM1::	.WORD	0
FNAM2::	.WORD	0
fnam3::	.word	0
ftyp::	.WORD	0
FGEN::	.WORD	0
fSTATS::.BLKW	5
; BUFFERS FOR IO TO TAPE
;
TY1HDR::.WORD 2048.,1,0,0,0,0,0,0
TY1BLK::.BLKB	2048.
TY4HDR::.WORD	512.,4,0,0,0,0,0,0
TY4BLK::.BLKB 	512.
CINFO::	.BLKW	8.
STS::	.BLKW	2
TRIED::	.WORD	0	; TAPE DECK NUMBER / NUMBER OF REPEATS IN CALLS OF OP
error::	.word	0	;error flag set by magtape routines **** 2 ****


MSSG1:	.ASCIZ	<7>/INC... -- NO TAPE DECK AVAILABLE FOR INCREMENT/
MSSG2:	.ASCIZ	<7>/INC... -- RESCHEDULING TAPE INCREMENT./
MSSG3:	.ASCIZ	<7>/INC... -- PLEASE FREE A TAPE DECK FOR INCREMENT/
MSSG4:	.ASCII	<7>/INC... *** PLEASE MOUNT A TAPE FOR INCREMENTAL DUMP /
MSSG4B:	.ASCII	/ON MM/
mSSG4C:	.ASCIZ	/0: ***/
MSSG5:	.ASCIZ	<7>/INC... -- TAPE IS WRITE LOCKED - TRY AGAIN!/
MSSG6:	.ASCII	<7>/MM: ERROR - CHARACTERISTICS:/
MSSG6B:	.ASCIZ	/000000   ./
MSSG7:	.ASCII	<7>/INC... -- ILLEGAL TAPE FOR INCREMENTAL DUMP  : /
MSSG7B:	.ASCIZ	/A?????/
errmss:	.asciz	<7>/ /<7><7>/inc... -- exiting due to magtape error :/
bbe:	.asciz	/ie.bbe/
dao:	.asciz	/ie.dao/
dnr:	.asciz	/ie.dnr/
eot:	.asciz	/ie.eot/
fhe:	.asciz	/ie.fhe/
ofl:	.asciz	/ie.ofl/
ver:	.asciz	/ie.ver/
wlk:	.asciz	/ie.wlk/
unkn:	.asciz	/unknown magtape error code./
	.EVEN
msslst:	.word	bbe,dao,dnr,eot,fhe,ofl,ver,wlk,unkn
errlst:	.word	ie.bbe,ie.dao,ie.dnr,ie.eot,ie.fhe,ie.ofl,ie.ver,ie.wlk,0
ER1:	.ASCIZ	/UNKNOWN RECORD/
er2:	.asciz	/unknown type/
er3:	.asciz	/wrong size block/
er4:	.asciz	/missing data blocks/
er5:	.asciz	/fileid -- sequence error/
er6:	.asciz	/missing index block/
er7:	.asciz	/missing backup block/
	.even

HDRBF:	.BLKB	80.	;FOR TAPE HEADER.
VOLHDR:	.ASCII	/VOL1A?????      /
	.ASCII	/                /
	.ASCII	/     D%B44110080/
	.ASCII	/011             /
	.ASCII	/               1/
FILH1:	.ASCII	/HDR1INCR/
ITEXT1:	.ASCII	/00000.SYS    /
TTEXT1:	.ASCII	/A?????00010001000100 00000 00000 000000DECFILE11A/
	.ASCII	/          /
FILH2:	.ASCII	/HDR2U0206402064                     M/
	.ASCII	/             00                            /
STSMS:	.ASCII	/INC... -- START OF INCREMENT /
ITEXT2:	.ASCII	/00000 ON MM/
IDECK2:	.ASCII	/0:/
INAM2:	.ASCII	/A????? ON /
IDAT:	.ASCIZ	/00-JAN-77 AT 00:00/
ENDMS:	.ASCIZ	/INC... -- END OF INCREMENT /
BKP:	.ASCII	/BACKUP/<1><0><0><0>/DB0:[126,342]/
	.even


	.sbttl	main program
start:	csrq$c	incr..
	csrq$c	inc...
	alun$c	1,ti,0
	alun$c	2,mm,0
	;		set up for tty and mm0 
	;	if mm0 fails come past here with mm1:
ndck:	qiow$c	io.att,2,1,,sts	;attach device?
	cmpb	sts,#1		;successful
	beq	gotmm		;yes
	tst 	tried		;here before
	bne	nodeck		;yes - none avail
	inc	tried		;no - set flag
	alun$c	2,mm,1
	br	ndck		;and go again for other deck
nodeck:	
	mov	#mssg1,r0	;complain about no deck
	call	typeit
	mov	#mssg2,r0	; and more
	call	typeit
	mov	#mssg3,r0	;again
	call	typeit
	run$c	inc...,,,,,5,3	;come round again in 5 mins.
	exit$s
;go away this time


	.sbttl	found tape deck
GOTMM:
	tst	tried
	beq	1$
	incb	mssg4c
	incb	ideck2		;make messages say correct deck
1$:
	
again:	qiow$c	io.sec,2,1,,sts
	bit	#400,sts+2		;offline
	beq	gotdek			;no - good
	mov	#mssg4,r0
	call	typeit
	mrkt$c	1,1,3
	wtse$c	1
	inc	tried
	cmp	tried,#10
	bne	again
	mov	#mssg1,r0
	call	typeit
	mov	#mssg2,r0
	call	typeit
	mov	#mssg3,r0
	call	typeit
	run$c	inc...,,,,,3,4	;try in 3 hours if you cant wake an op.
	exit$s


	.sbttl	got tape and tape deck - tape ok?
gotdek:
	;CAN WE  accept the tape??
	qiow$c	io.rwd,2,1
	qiow$c	io.stc,2,1,,sts,,<4000>
	qiow$c	io.sec,2,1,,sts
; rewind tape - ask for 1600 bpi - what is state ?
	mov	sts+2,r1
	bic	#25000,r1		;ignore 1600,rewinding , bot
	tst	r1			;any others
	beq	1$			;no - good
	bit	#2000,r1		;write protected?
	beq	2$			;no
	MOV	#mssg5,r0		;tell the idiot
	jmp	twiter			;and go again
2$:	mov	#mssg6b,r0
	mov	r1,r2
	call	$cbomg			;print status word
	mov	#mssg6,r0
	jmp	twiter			;tel usr news
1$:	open$m	#cntfdb			;open control file
	get$r	#cntfdb,#cinfo,#16.
; now ready to try tape label


;read label and check its ours
	qiow$c	io.rlb,2,1,,sts,,<hdrbf,80.>
	cmpb	sts,#1
	beq	goodhd
badhd:	mov	sts,r1
	mov	#mssg6b,r0
	mov	r0,r2
	call	$cbomg
	mov	#mssg6,r0
	call	typeit
	mov	#mssg7,r0
	jmp	twiter
goodhd:	mov	#6,r3
	mov	#hdrbf+4,r0
	mov	#volhdr+4,r1
	mov	#ttext1,r2
	mov	#mssg7b,r4
	mov	#inam2,r5
1$:	movb	(r0),(r1)+
	movb	(r0),(r2)+
	movb	(r0),(r4)+
	movb	(r0)+,(r5)+
	sob	r3,1$
	mov	#80.,r3
	mov	#volhdr,r0
	mov	#hdrbf,r1
2$:	cmpb	(r0)+,(r1)+
	bne	badhd
	sob	r3,2$



; accepted tape header -- must be ours
; should check tape in mtfile .doc sometime?
;
;	now fix up file headers
	INC	CINFO
	PUT$R	#CNTFDB,#CINFO,#16.,#1
	gtim$c	timbf		;need date
	mov	#filh1+42.,r0
	mov	timbf+g.tiyr,r1
	call	$cbdat
	mov	timbf+g.timo,r1
	asl	r1
	mov	mlst-2(r1),r1
	add	timbf+g.tida,r1
	mov	#015012,r2
	call	$cbta
	MOV	#IDAT,R0
	MOV	#TIMBF,R1
	CALL	$DAT
	MOV	#2,R2
	ADD	#4,R0
	CALL	$TIM
; odd tricks to convertt date to yyddd - ignore leap yr error.
;
	qiow$c	io.spf,2,1,,sts,,<40000>
	cmpb	sts,#ie.eov		;hit eov i hope
	beq	100$
	jmp	errx			;error if not
100$:	cmp	sts+2,#1
	bne	ateov
	qiow$c	io.spf,2,1,,,,<-1>
	qiow$c	io.spb,2,1,,,,<-1>
; tricks to back over eof and dummy header.


ateov:	;now in position to write out
	mov	cinfo,r1
	mov	#itext2,r0
	mov	r0,r2
	call	$cbdmg
	mov	#stsms,r0
	call	typeit
	mov	#itext1,r0
	mov	cinfo,r1
	mov	r0,r2
	call	$cbdmg
	mov	#filh1,r0
	call	wrthdr
	mov	#filh2,r0
	call	wrthdr
	call	weof
	clr	ntblks		;set none wriiten
	mov	#6,filno
1$:	call	nxtrec
	bcs	2$
	call	wrtty2
	call	wrtty4
	mov	#1,nblk
	clr	nblk0
3$:	tst	error
	bne	2$
	qiow$s	#io.rvb,#4,#1,,#dmpsts,,<#ty1blk,#2048.,,#0,nblk>
	bcs	2$
	cmpb	dmpsts,#1
	bne	5$			;assume eof
	call	wrtty1
	add	#4,nblk
	br	3$
5$:	cmpb	dmpsts,#ie.eof
	beq	6$
	mov	#mssg6b,r0
	mov	dmpsts,r1
	mov	r0,r2
	call	$cbomg
	mov	#mssg6,r0
	call	typeit
	mov	#mssg6b,r0
	mov	dmpsts+2,r1
	call	$cbomg
	mov	#mssg6,r0
	call	typeit
	br	7$
6$:	call	wrtty1
7$:	close$	#dmpfdb
	put$r	#cntfdb,#fdmpno,#16.,filno
	br	1$
2$:	call	weof
	mov	ntblks,r1
	mov	#filh1+55.,r0
	mov	r0,r2
	call	$cbdmg
	mov	#filh1,r0
	mov	#"EO,(r0)
	mov	#"F1,2(r0)
	call	wrthdr
	mov	#filh2,r0
	mov	#"EO,(r0)
	mov	#"F2,2(r0)
	call	wrthdr
	call	weof
	call	weof
	; now say done and exit
	close$	#cntfdb
	tst	error
	bne	errx
	call	chkit
	mov	#endms,r0
	call	typeit
	run$c	incr..,,,,,24.,4		;run other half in 24 hours
	qiow$c	io.rwd,2,1
	exit$s				;and go away

errx:	mov	#errmss,r0
	call	typeit
	call	errout
	qiow$c	io.rwu,2,1
	run$c	INC...,,,,,5,3		;back in 5 minutes to try again
	exit$s
errout:	clr	r2
1$:	cmpb	errlst(r2),sts
	beq	2$
	inc	r2
	inc	r2
	tst	errlst(r2)
	bne	1$
2$:	mov	msslst(r2),r0
	call	typeit
	rts	pc



	.sbttl	subroutines
wrthdr::	
	mov	#80.,r1
wbk::	inc	ntblks
	qiow$s	#io.wlb,#2,#1,,#sts,,<r0,r1>
	cmpb	sts,#1
	beq	1$
	inc	error
1$:	rts	pc

weof:	qiow$c	io.eof,2,1
	rts	pc


twiter:	call	typeit
	qiow$c	io.rwu,2,1
	jmp	again
typeit:	mov	r1,-(sp)
	mov	r0,r1
1$:	tstb	(r1)+
	bne	1$
	sub	r0,r1
	qiow$s	#io.wlb,#1,#1,,,,<r0,r1,#40>
	mov	(sp)+,r1
	rts	pc



wrtty1:	;write data blocks - assumes header record set by type 2
	mov	#ty1hdr,r0
	mov	r0,r1
	add	#4,r1
	tst	(r1)
	beq	1$
	inc	(r1)
	inc	(r1)
	inc	(r1)
1$:	inc	(r1)
	mov	dmpsts+2,r1
	mov	#1,2(r0)
	mov	r1,(r0)
	add	#16.,r1
	call	wbk
	rts	pc


wrtty4:	;write index file block
	mov	ty1hdr+10,ty4hdr+10
	mov	ty1hdr+12,ty4hdr+12
	mov	#ty4hdr,r0
	mov	#528.,r1
	call	wbk
	rts 	pc



wrtty2:;	write type 2 backup block
	mov	#ty1hdr,r0
	mov	#4000,(R0)+
	mov	#2,(r0)+
	clr	(r0)+
	clr	(r0)+
	mov	filno,(r0)+
	mov	fseqno,(r0)+
	mov	#2002,r1
1$:	clr	(r0)+
	sob	r1,1$
	mov	fsiz,ty1blk+90.
	mov	#bkp,r0
	mov	#ty1blk,r2
	mov	#6,r1
	mov	#ty1blk+3776,r3
2$:	movb	(r0),(r2)+
	movb	(r0)+,-(r3)
	sob	r1,2$
	mov	#21,r1
3$:	movb	(r0)+,(r2)+
	sob	r1,3$
	mov	r2,r0
	mov	fnam1,r1
	call	$c5ta
	mov	fnam2,r1
	call	$c5ta
	mov	fnam3,r1
	call	$c5ta
	movb	#'.,(r0)+
	mov	ftyp,r1
	call	$c5ta
	movb	#';,(r0)+
	mov	fgen,r1
	clr	r2
	call	$cbomg
	mov	#ty1blk+10,r2
	sub	#2,r0
	sub	r2,r0
	mov	r0,(r2)
	mov	#ty1hdr,r0
	mov	#2064.,r1
	call	wbk
	rts	pc



nxtrec:
	inc	filno
	get$r	#cntfdb,#fdmpno,#16.,filno
	bcs	ret1
	tst	fdmpno			;already dumped
	bne	nxtrec
	tst	fseqno
	beq	nxtrec			;not real file
	tst	fgen			;real f]generation
	beq	nxtrec
	mov	#fstats,dmpfdb+f.stbk
	mov	#"SY,dmpfdb+n.dvnm+f.fnb
	clr	dmpfdb+f.fnb+n.unit
	clr	dmpfdb+f.fnb+n.fid+4
	mov	filno,dmpfdb+f.fnb+n.fid
	mov	fseqno,dmpfdb+f.fnb+n.fid+2
	qiow$c	io.rat,4,1,,,,<dmpfdb+f.fnb+n.fid,attlst>
	bcs	nxtrec
	ofid$r	#dmpfdb,#4
	bcs	nxtrec
	mov	fstats+6,fsiz
	mov	cinfo,fdmpno
ret1:	return
attlst:
	.byte	-10.,0
	.word	ty4blk
	.word	0


chkit:	qiow$c	io.spf,2,1,,,,<-4>
	qiow$c	io.spf,2,1,,,,<1>	;get to start of data
	
rblk:	qiow$c	io.rlb,2,1,,sts,,<ty1hdr,2064.>
	cmpb	sts,#ie.eof
	bne	11$
	rts	pc
11$:	cmpb	sts,#1
	beq	12$
	mov	#fail,r0
	call	typeit
	call	errout
	br	rblk
12$:	mov	sts+2,r0
	sub	#16.,r0
	cmp	r0,ty1hdr
	beq	1$
	call	tyer3
1$:	mov	ty1hdr+2,r0
	cmp	r0,#1
	beq	ty1
	cmp	r0,#4
	beq	ty4
	cmp	r0,#2
	beq	ty2
	call	tyer2
	br	rblk
ty1:	cmp	ty1hdr+8.,hdrold+8.
	bne	1$
	cmp	ty1hdr+10.,hdrold+10.
	bne	1$
	tst	ty1hdr+12.
	bne	1$
	tst	ty1hdr+14.
	bne	1$
	tst	ty1hdr+6
	bne	1$			;count all above as fileid
	cmp	hdrold+2,#4
	beq	2$
	add	#4,hdrold+4
	cmp	hdrold+4,ty1hdr+4
	bne	3$
	br	copyit			;block seems good
2$:	cmp	ty1hdr+4,#1
	bne	3$
	br	copyit
3$:	call	tyer4
	br	copyit
1$:	call	tyer5
	br	copyit
4$:	call	tyer6
	br	copyit
ty4:	cmp	hdrold+2,#2
	beq	1$
	call	tyer7
1$:	cmp	ty1hdr,#512.
	beq	2$
	call	tyer3
2$:	tst	ty1hdr+4
	beq	3$
	call	tyer1
3$:	cmp	ty1hdr+10,hdrold+10
	bne	4$
	cmp	ty1hdr+12,hdrold+12
	beq	5$
4$:	call	tyer5
5$:	br copyit
ty2:	cmp	hdrold+2,#1
	beq	1$
	call	tyer4
1$:	mov	#ty1blk+27,r0
	mov	#filbf,r1
	mov	#40,r2
2$:	movb	(r0)+,(r1)+
	sob	r2,2$
copyit:	mov	#hdrold,r0
	mov	#ty1hdr,r1
	mov	#8.,r2
1$:	mov	(r1)+,(r0)+
	sob	r2,1$
	jmp	rblk
tyer:	mov	#fail,r0
	call	typeit
	mov	r4,r0
	call	typeit
	rts	pc
tyer1:	mov	#er1,r4
	br	tyer
tyer2:	mov	#er2,r4
	br	tyer
tyer3:	mov	#er3,r4
	br	tyer
tyer4:	mov	#er4,r4
	br tyer
tyer5:	mov	#er5,r4
	br tyer
tyer6:	mov	#er6,r4
	br	tyer
tyer7:	mov	#er7,r4
	br	tyer
	.end	start
