.TITLE	XTRACT	PROGRAM TO READ DSC OR INCREMENTAL DUMP TAPES.
	.IDENT	/X02.01/	;X01 WAS IN CORAL 66
;
; PROGRAM SPECIFICATION
;
; TO READ FROM ONE OR BOTH TAPE DECKS,
; A / ALL DSC IMAGES ON A TAPE /TAPES
; TO COPY INTO USERS DIRECTORY/ALL DIRECTORIES 
; NORMALLY NOT SUPERCEEDING
;
; ALL FILES/FILES MATCHING SPEC/FILES MATCHING AND QUERIED WITH YES
;

	.MCALL	GCML$,GCMLB$,CSI$,CSI$1,CSI$2,CSI$ND,CSI$SW,CSI$SV
	.MCALL	FSRSZ$,FDBDF$,FDOP$A,FDAT$A,FDRC$A,CLOSE$,NMBLK$
	.MCALL	QIOW$,ALUN$S,DIR$,MRKT$S,WTSE$S
	.MCALL	OPEN$W,FHDOF$,QIOW$S,FINIT$
	.MCALL	OPEN$,WRITE$,WAIT$,PUT$,QIOW$C,ALUN$C,EXIT$S
	FHDOF$	DEF$L
	FSRSZ$	1		;FOR OPTIONAL LISTING FILE
				;UNITS ARE
				; 1	TI:
				; 2	MM:
				; 3	SY:
				; 4	SY:LISTING FILE
	.EVEN
GCLBLK:	GCMLB$	1,EXT,,1
	CSI$
CSIBLK:	.BLKB	C.SIZE
	D80BIT=1
	ALLBIT=2
	DIRBIT=4
	IMBIT =10
	MULBIT=20
	RDCBIT=40
	REWBIT=100
	NHDBIT=200
	SUPBIT=400
	SELBIT=1000
	LSTBIT=2000		;LISTING FILE PRESENT
	UICBIT=4000
	TMMBIT=10000		;TWO MAGTAPES
	FOBIT =20000		;SET FILE OWNER (IMPLIED BY UICBIT)
	EOTSN =40000
SWTBL:	CSI$SW	80,D80BIT,FLGS1,SET,NEG		;800 BPI (DEFAULT IS 1600)
	CSI$SW	AL,ALLBIT,FLGS1,SET,NEG		;ALL FILES CORRESPONDING(NO?)
	CSI$SW	DI,DIRBIT,FLGS1,SET,,DIRTBL	;DIRECTORIES ON TAPE
	CSI$SW	FO,FOBIT ,FLGS1,SET,NEG		;SET FILE OWNER TO SAY WHOSE FIL
	CSI$SW	IM,IMBIT,FLGS1,SET,,IMTBL	;IMAGE NAME ON TAPE
	CSI$SW	MU,MULBIT,FLGS1,SET,NEG		;MULTIPLE TAPE INCREMENTS
	CSI$SW	RC,RDCBIT,FLGS1,SET,NEG		;READ CHECK ONLY
	CSI$SW	RW,REWBIT,FLGS1,SET,NEG		;REWIND TAPES FIRST
	CSI$SW	NH,NHDBIT,FLGS1,SET,NEG		;NON ANSI FMT - IE AS IS
	CSI$SW	SU,SUPBIT,FLGS1,SET,NEG		;SUPERCEED FILES
	CSI$SW	SE,SELBIT,FLGS1,SET,,SELTBL	;SELECT FILES
	CSI$SW	UI,UICBIT,FLGS1,SET,NEG		;TO OWNING UIC
	CSI$ND


IMTBL:	CSI$SV	ASCII,IMNAME,12.
	CSI$ND
DIRTBL:	CSI$SV	OCTAL,UIC,2
	CSI$SV	OCTAL,MEM,2
	CSI$ND
SELTBL:	CSI$SV	ASCII,SELBUF,20
	CSI$ND
SELBUF:	.BLKB	20
MEM:	.WORD	0
UIC:	.WORD	0
IMNAME:	.BLKB	14.
FLGS1:	.WORD	0


LSTFDB:	FDBDF$			;FOR LISTING FILE
	FDAT$A	R.VAR,FD.CR
	FDRC$A	,LSTBUF,132.
	FDOP$A	4,CSIBLK+C.DSDS,LSDFNB,FO.WRT
LSDFNB:	NMBLK$	DSCTAPE,LST,0,SY,0
LSTBUF:	.BLKB	132.
OUTFDB:	FDBDF$				;FDB FOR WRITING OUT FILES
	FDAT$A	R.VAR
	FDRC$A	FD.RWM
	FDOP$A	3,,OUTFNB,FO.WRT
OUTFNB:	NMBLK$	,,,SY,0

TMPBF:	.BLKB	80.
FSIZ:	.WORD	0
WRTBLK:	.WORD	0,0
OLDHDR:	.BLKW	8.
BLK7:	.BLKW	7			;FOR FILE CLOSE INFO
BUFFER:
BLKSIZ:	.WORD	0		;FIRST WORD OF HEADER - HOW MUCH DATA
BLKTYP:	.WORD	0		;RECOGNISE 1,2,4
BLKNUM:	.WORD	0		;BLOCK NO OF FIRST BLOCK IN THIS UNIT
	.WORD	0
BLKFID:	.WORD	0		;FILE ID
BLKFSQ:	.WORD	0		;FILE SEQ NO
	.BLKW	2		;SPARE
DATBUF:	.BLKW	2048.		;DATA BUFFER
IOSTAT:	.BLKW	2		;STATUS OF MM TRANSFERS
IN1:	NMBLK$	,,,MM,0
IN2:	NMBLK$	,,,MM,1		;FOR INSERTION OF INPUT DEVICES
				;BY .PRSDV
MMUNIT:	.WORD	0
MMFDB:	FDBDF$			;FOR .ASLUN / .PRSDV
	FDOP$A	2,,IN1,FO.RD
QIOW:	QIOW$	IO.RLB,2,2,,IOSTAT,,<BUFFER,2064.>
SYNERR:	.ASCIZ	/EXTRACT -- SYNTAX ERROR/
OPFERR:	.ASCII	/EXTRACT -- OPEN FAILURE : FILE:/
OPFILE:	.ASCIZ	/ABCDEFGHI.JKL;          /
VOLERR:	.ASCIZ	/EXTRACT -- NOT AN ANSI TAPE/
MMERR:	.ASCII	/EXTRACT -- MAGTAPE ERROR /
MM1ERR:	.ASCIZ	/000000/
NOIMAG:	.ASCIZ	/EXTRACT -- NO SUCH IMAGE ON TAPE/
	.EVEN
HDRNM:	.ASCII	/IMAGE:/
HDR1NM:	.BLKB	18.

VOLHDR:	.ASCII	/VOLUME LABEL :/
VOLLBL:	.ASCIZ	/      /
SIZERR:	.ASCIZ	/EXTRACT -- SIZE CHECK FAIL/
SYNCR:	.ASCIZ	/EXTRACT -- SYNCH CHECK FAIL/
FILERR:	.ASCIZ	%EXTRACT -- FILE ID/SEQ CHECK FAIL%
BLKERR:	.ASCIZ	/EXTRACT -- BLOCK TYPE UNRECOGNISED/
NEXTMS:	.ASCIZ	/EXTRACT -- MOUNT NEXT INPUT TAPE AND TYPE CR/
ERRBF:	.BLKB	80.
	.EVEN


;SUBROUTINES FOR WRITING THE FILES OUT
;
;
CLS:	MOV	#BLK7,R1	;GET ADDRESS OF WORDS FOR FDB
	MOV	#OUTFDB,R2	;AND ADDR FDB
	MOV	#7,R0
1$:	MOV	(R1)+,(R2)+
	SOB	R0,1$		;COPY ALL 7
	CLOSE$	#OUTFDB
	RTS	PC

;
; TO OPEN FILE
;
OPN:	MOV	FSIZ,OUTFDB+F.CNTG	;SET SIZE FROM R0
	MOV	#FO.WRT,R5
	BIT	#SUPBIT,FLGS1		;SUPERCEED
	BNE	1$			;YES
	BIS	#FA.NSP,R5	;SET NO SUPERCEED.
1$:	MOV	#BLK7,R1
	MOV	#DATBUF+16,R0
	MOV	#OUTFDB,R2
	MOV	#7,R3
2$:	MOV	(R0),(R2)+
	MOV	(R0)+,(R1)+
	SOB	R3,2$
	MOV	10+DATBUF,R1	;GET UIC
	BIT	#FOBIT!UICBIT,FLGS1
	BEQ	31$
	CALL	.WFOWN
31$:	BIT	#UICBIT,FLGS1
	BEQ	3$
	CALL	.WDFUI
	clr	outfnb+n.did
	clr	outfnb+n.did+2
	clr	outfnb+n.did+4
3$:	MOV	#DATBUF+46.,R2
	MOV	#OUTFNB+N.FNAM,R1
	MOV	#5,R3
4$:	MOV	(R2)+,(R1)+
	SOB	R3,4$
	OPEN$	#OUTFDB,R5
	BCS	5$
	RTS	PC		;GOOD RETURN CARRY CLEAR
5$:	MOV	#OPFILE,R0
	MOV	#DATBUF+46.,R3
	MOV	#3,R4
6$:	MOV	(R3)+,R1
	CALL	$C5TA
	SOB	R4,6$
	MOVB	#'.,(R0)+
	MOV	(R3)+,R1
	CALL	$C5TA
	MOVB	#';,(R0)+
	MOV	(R3)+,R1
	MOV	R3,R2
	CALL	$CBOMG
	CLRB	(R0)+
	MOV	#OPFERR,R0
	CALL	TYPEIT
	SEC
	RTS	PC

; WRITE TO FILE
;
;
WRT:	MOV	BLKSIZ,R1
	BEQ 	1$
	MOV	BLKNUM,WRTBLK+2
	MOV	BLKNUM+2,WRTBLK
	WRITE$	#OUTFDB,#DATBUF,R1,#WRTBLK
1$:	RTS	PC
;
; MAGTAPE ROUTINES USING DPB "QIOW"
;
MTSNC:	MOV	#IO.SEC,R1
	BR	MMFIN
MTSTC:	MOV	#IO.STC,R1
	BR	MMFIN
MTRWD:	MOV	#IO.RWD,R1
	BR	MMFIN
MTRWU:	MOV	#IO.RWU,R1
	BR	MMFIN
MTSPF:	MOV	#IO.SPF,R1
	BR	MMFIN
MTRD:	MOV	#BUFFER,R0
	MOV	#2064.,Q.IOPL+2+QIOW
	MOV	#IO.RLB,R1
MMFIN:	MOV	R1,Q.IOFN+QIOW
	MOV	R0,Q.IOPL+QIOW
	DIR$	#QIOW
	RTS	PC

;
;
TYPEIT:	MOV	R1,-(SP)
	MOV	R0,R1
1$:	TSTB	(R1)+
	BNE	1$
	DEC	R1
	SUB	R0,R1
	QIOW$S	#IO.WLB,#1,#1,,,,<R0,R1,#40>
	MOV	(SP)+,R1
	RTS	PC

ERRMSS:	MOV	#OLDHDR,R4
	CALL	ERROUT
	MOV	#BUFFER,R4
	CALL	ERROUT
	RTS	PC
ERROUT:	MOV	#ERRBF,R0
	MOV	#8.,R3
1$:	MOV	(R4)+,R1
	MOV	R3,R2
	CALL	$CBOMG
	MOVB	#40,(R0)+
	SOB	R3,1$
	CLRB	(R0)
	MOV	#ERRBF,R0
	CALL	TYPEIT
	RTS	PC



START:	FINIT$
	ALUN$C	1,TI,0
RSTART:	CLR	FLGS1
	CLR	MEM
	CLR	UIC
	CLR	IMNAME
	CLR	SELBUF
	GCML$	#GCLBLK
	TSTB	G.ERR+GCLBLK
	BGE	1$
	EXIT$S
1$:	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD	;REMOVE SPACES AND JUNK
	BCC	2$
3$:	MOV	#SYNERR,R0
	CALL	TYPEIT
	BR	RSTART
2$:				;HERE TO START PICKING UP BITS
	TST	CSIBLK+C.CMLD
	BLE	RSTART
	BITB	#CS.EQU,C.STAT+CSIBLK
	BEQ	3$
	CSI$2	#CSIBLK,INPUT,#SWTBL
	BCS	3$
	MOV	#MMFDB,R0
	MOV	#IN1,R1
	MOV	#CSIBLK+C.DSDS,R2
	CLR	R3
	CALL	.PRSDV
	BCS	3$
	BITB	#CS.MOR,C.STAT+CSIBLK
	BEQ	4$
	BIS	#TMMBIT,FLGS1
	CSI$2	#CSIBLK,INPUT,#SWTBL
	BCS	3$
	MOV	#MMFDB,R0
	MOV	#IN2,R1
	CALL	.PRSDV
	BCS	3$
4$:	;GOT SWITCHES AND INPUT
	CSI$2	#CSIBLK,OUTPUT
	BCS	3$
	BITB	#CS.DIF!CS.NMF!CS.DVF,C.STAT+CSIBLK
	BEQ	5$			;NO FILE
	BIS	#LSTBIT,FLGS1
	OPEN$W	#LSTFDB
	BCS	3$
5$:	MOV	#IN1,R1
	MOV	#MMFDB,R0
	CALL	.ASLUN
	MOV	#IN1+N.UNIT,MMUNIT

;***HERE BEGINS THE PROGRAM !****
;
;
; SET DENSITY AND DO REWIND
	MOV	#4000,R0
	BIT	#D80BIT,FLGS1
	BEQ	7$
	CLR	R0
7$:	CALL	MTSTC
	BIT	#REWBIT,FLGS1
	BEQ	8$
	CALL	MTRWD
8$:	BIT	#NHDBIT,FLGS1
	BNE	9$	;SKIP CHECK FOR RIGHT TAPEFILE.
	CALL	MTRD
	CMP	BUFFER,#"VO
	BNE	71$
	CMP	BUFFER+2,#"L1
	BEQ	72$
71$:	MOV	#VOLERR,R0
	CALL	TYPEIT
	BR	99$
72$:	MOV	#VOLLBL,R0
	MOV	#BUFFER+4,R1
	MOV	#6,R3
81$:	MOVB	(R1)+,(R0)+
	SOB	R3,81$
	MOV	#VOLHDR,R0
	CALL	TYPEIT
	BIT	#LSTBIT,FLGS1
	BEQ	82$
	PUT$	#LSTFDB,#VOLHDR,#20.
82$:	CALL MTRD
	CMP	IOSTAT,#1
	BEQ	87$
	CMPB	IOSTAT,#IE.EOF
	BEQ	88$
	MOV	#MMERR,R0
	CALL	TYPEIT
	BR	99$
88$:	BIT	#EOTSN,FLGS1
	BNE	99$
	BIS	#EOTSN,FLGS1
	BR	82$
87$:	BIC	#EOTSN,FLGS1
	CMP	BUFFER,#"HD
	BNE	82$
	CMP	BUFFER+2,#"R1
	BNE	82$
	BIT	#IMBIT,FLGS1
	BEQ	85$		;MUST BE OK
	MOV	#BUFFER+4,R0
	MOV	#IMNAME,R1
	MOV	#12.,R2
84$:	TSTB	(R1)
	BEQ	85$
	CMPB	(R0)+,(R1)+
	BNE	82$
	SOB	R2,84$


85$:	;OK FOUND A SUITABLE HDR TYPEIT OUT & TO FILE
	MOV	#BUFFER+4,R0
	MOV	#HDR1NM,R1
	MOV	#17.,R2
89$:	MOVB	(R0)+,(R1)+
	SOB	R2,89$
	MOV	#HDRNM,R0
	CALL	TYPEIT
	BIT	#LSTBIT,FLGS1
	BEQ	83$
	PUT$	#LSTFDB,#HDRNM,#23.
83$:	MOV	#1,R0
	CALL	MTSPF
9$:	;AFTER TYPING OUT FILE NAME COMMON WITH NO HEADER.
	CLR	BLKTYP
	CALL	UNDUMP
	BIT	#MULBIT,FLGS1
	BEQ	99$
	MOV	#1,R0
	CALL	MTSPF
	CMPB	IOSTAT,#1
	BEQ	82$		;GOTO NXT INC
99$:	BIT	#LSTBIT,FLGS1
	BEQ	100$
	CLOSE$	#LSTFDB
100$:	JMP	RSTART




UNDUMP:	;CALL TO UNDUMP A FILE OF FILES
	CMP	BLKTYP,#2
	BEQ	1$		;A VAILD STARTER
	CALL	RBLK
	BCC	UNDUMP
	RTS	PC
1$:	MOV	#TMPBF,R0
	MOV	#4,R2
	MOV	#DATBUF+12,R1
2$:	MOVB	(R1)+,(R0)+
	SOB	R2,2$
	MOV	#9.,R2
3$:	MOVB	#40,(R0)+
	SOB	R2,3$
4$:	CMPB	(R1)+,#']
	BNE	4$
; POINTING NOW AT FILENAME
;
5$:	TSTB	(R1)
	BEQ	6$
	MOVB	(R1)+,(R0)+
	BR	5$
6$:	MOVB	#'(,(R0)+
; NOW SET UP FSIZ AND CONVERT IT TO DEC FOR HEADER.
;
	MOV	DATBUF+90.,R1
	MOV	R1,FSIZ
	CLR	R2
	CALL	$CBDMG
	MOVB	#'),(R0)+
	CLRB	(R0)
	MOV	R0,-(SP)
	CALL	RBLK
	BCC	7$
	RTS	PC
7$:	MOV	DATBUF+10,R3
	MOV	#1,R4
	MOV	#TMPBF+4,R2
	CALL	.PPASC
	MOV	(SP)+,R0
9$:	MOVB	#40,(R0)+
	CMP	R0,#TMPBF+45.
	BLO	9$
	MOVB	#'?,(R0)+
	BIT	#LSTBIT,FLGS1
	BEQ	10$
	PUT$	#LSTFDB,#TMPBF,#44.
10$:
	BIT	#RDCBIT,FLGS1
	BNE	90$
; ATTEMPT TO MATCH FILE
;	TRY FILENAME MATCH
	BIT	#SELBIT,FLGS1
	BEQ	60$
	MOV	#TMPBF+13.,R0
	MOV	#SELBUF,R1
	MOV	#13.,R2
50$:	TSTB	(R1)
	BEQ	60$	;SUCCESS FOR ENTIRE KEY
	CMPB	(R0)+,(R1)+
	BEQ	50$
51$:	CMPB	#'?,-1(R1)
	BEQ	50$		;WILD SUCEEDS
	CMPB	#'.,-1(R1)
	BNE	90$		;NOT . SO FAILED
52$:	CMPB	(R0)+,#'.
	BNE	52$
	BR	50$
;TRY DIR MATCH
60$:	BIT	#DIRBIT,FLGS1
	BEQ	70$
	TSTB	UIC
	BEQ	61$
	CMPB	UIC,DATBUF+11
	BNE	UNDUMP
61$:	TSTB	MEM
	BEQ	70$
	CMPB	MEM,DATBUF+10
	BNE	UNDUMP

; WRITE OOUT FILE IF MATCHES
70$:	;TRY DO WE WANT IT
	BIT	#ALLBIT,FLGS1
	BNE	80$
	CLR	ERRBF
	QIOW$S	#IO.RPR,#1,#1,,#IOSTAT,,<#ERRBF,#20,,#TMPBF,#46.,#44>
	CMPB	IOSTAT,#1
	BEQ	71$
	RTS	PC	;USER SAID GIVE UP
71$:	CMPB	ERRBF,#'Y
	BEQ	80$
	CMPB	ERRBF,#'Y+40
	BNE	90$
80$:	CALL	OPN
	BCS	90$
81$:	CALL	RBLK
	BCC	85$
	CALL	CLS
	RTS	PC
85$:	CMP	BLKTYP,#1
	BNE	84$
	CALL	WRT
	BR	81$
84$:	CALL	CLS
90$:	JMP	UNDUMP


;SUBROUTINES
;
RBLK:	BIT	#EOTSN,FLGS1
	BEQ	NBLK
	CALL	MTRWU
	BIT	#TMMBIT,FLGS1
	BEQ	1$
	INC	MMUNIT
	BIC	#177776,MMUNIT
	ALUN$S	#2,#"MM,MMUNIT
	BR	21$
1$:	MOV	#NEXTMS,R0
	CALL	TYPEIT
2$:	CALL	MTSNC
	BIT	#400,IOSTAT+2
	BEQ	21$
	MRKT$S	#1,#10.,#2
	WTSE$S	#1
	BR	2$
21$:	CALL MTRWD
	MOV	#4000,R0
	BIT	#D80BIT,FLGS1
	BEQ	23$
	CLR	R0
23$:	CALL	MTSTC
	MOV	#1,R0
	CALL	MTSPF
NBLK:	;READ A BLOCK AND SET EOTSN IF SEEN EOT.
	BIC	#EOTSN,FLGS1
	CALL	MTRD
	CMPB	IOSTAT,#IE.EOT
	BNE	1$
	BIS	#EOTSN,FLGS1
	MOV	#1,IOSTAT		;MAKE EOT LOOK LIKE GOOD READ.
1$:
					;CHECK BLOCK SEQ VALIDITY
					; REPORT ON MMERRORS
	CMP	IOSTAT,#1
	BEQ	10$
	CMPB	IOSTAT,#IE.EOF		;END OF THIS FILE OF FILES
	BEQ	90$			;YES
					;	SET CARRY SO KNOWS DONE
	MOVB	IOSTAT,R1
	MOV	R1,R2
	MOV	#MM1ERR,R0
	CALL	$CBOMG
	MOV	#MMERR,R0
	CALL	TYPEIT
	BR	RBLK
10$:	;HERE WITH BLOCK TO CHECK FOR SEQUENCE & SIZE
	;REPORT BUT PASS IT BACK ANYWAY.
	SUB	#16.,IOSTAT+2		;CORRECT TO DATA LENGTH
	BEQ	RBLK			;NULL BLOCK
	CMP	IOSTAT+2,BLKSIZ
	BEQ	11$
	MOV	#SIZERR,R0
	CALL	TYPEIT
11$:	CMP	#2,BLKTYP
	BEQ	80$			;TYPE 2 CAN GO ANYWHERE - IS STARTER
	CMP	BLKTYP,#4
	BNE	12$
	MOV	#OLDHDR+2,R0
	MOV	#BUFFER+4,R1
	MOV	#6,R2
	CMP	(R0)+,#2
	BNE	87$
13$:	CMP	(R0)+,(R1)+
	BNE	87$
	SOB	R2,13$
	CMP	BLKSIZ,#512.
	BEQ	80$
	MOV	#SIZERR,R0
	CALL	TYPEIT
	BR	80$
12$:	;TYPE 1 WE HOPE
	CMP	BLKTYP,#1
	BNE	30$
	MOV	#OLDHDR+2,R0
	MOV	#BUFFER+4,R1
	CMP	(R0)+,#1
	BEQ	21$
	CMP	(R1)+,#1
	BNE	87$
	TST	(R0)+
	BR	22$
21$:	ADD	#4,(R0)
	CMP	(R1)+,(R0)+
	BNE	87$
22$:	MOV	#4,R2
23$:	CMP	(R1)+,(R0)+
	BNE	87$
	SOB	R2,23$
	BR	80$
30$:	MOV	#BLKERR,R0
	BR	88$
87$:	MOV	#FILERR,R0
88$:	CALL	TYPEIT
	CALL	ERRMSS
80$:	MOV	#8.,R2
	MOV	#OLDHDR,R1
	MOV	#BLKSIZ,R0
81$:	MOV	(R0)+,(R1)+
	SOB	R2,81$
	CLC
	RTS	PC
90$:	SEC
	RTS	PC
	.END	START