	.TITLE	TAB
	.MCALL	.DSTAT	.FETCH
	.MCALL	.PURGE	.LOOKU	.READW
	.MCALL	.SCMDF
 	.DSABL	GBL
	.GLOBL	RAD
	.GLOBL	SWORDS	SBLOCKS	TOP	..	...
	.GLOBL	AREA	ADDR	FILE	FILEF2
	.GLOBL	T.DH

	.INCLU	"SCRMAC"
	.INCLU	"DIAMAC"

	.SCMDF

$TAB	=	404

MAXDEV	=	10.

DEF$TAB::
	MOV	@#SYSPTR,R0
	ADD	$TAB(R0),R0
TAB$ADR	=	. + 2
	MOV	R0,#0
1$:	CMP	#-1,(R0)+
	BNE	1$
	SUB	TAB$ADR,R0
	ASR	R0
	DEC	R0
TAB$SIZ	=	. + 2
	MOV	R0,#0
	RETURN

	.ENABL	LSB
DEF$07::
	MOV	#..,TOP
	MOV	TAB$SIZ,R2
	MOV	R2,R4
	INC	R4
	ASL	R4
	MOV	TAB$ADR,R3
	ADD	R3,R4

	CLR	R0
	MOV	#DEVTAB,R1
1$:	TST	(R4)+
	BPL	2$
	MOV	@R3,@R1
	ADD	#^R  0,(R1)+
	INC	R0
	CMP	R0,#MAXDEV
	BEQ	3$
2$:	TST	(R3)+
	SOB	R2,1$

3$:
NDEV	==	. + 2
	MOV	R0,#0
	MOV	R0,R2
	MOV	#DEVTAB,R3
	MOV	#D07TAB,R4
	MOV	#...,R5

4$:	MOV	(R3)+,SDEV

	CALL	PRISDEV

	.DSTAT	#ADDR,#SDEV

 	TST	ADDR+4
	BNE	100$

	MOV	R5,R0
	ADD	ADDR+2,R0
	CMP	R0,@#USERTOP
	BHI	CANCEL

FETCH:	.FETCH	TOP,#SDEV
	BCS	ERROR

	MOV	R0,TOP
	ADD	ADDR+2,R5

100$:	MOV	#10,R1

5$:	CALL	PRISDEV

	MOV	#INCL,R0
10$:	CMP	SDEV,(R0)+
	BEQ	12$
	TST	(R0)
	BNE	10$

	MOV	#EXCL,R0
11$:	CMP	SDEV,(R0)+
	BEQ	13$
	TST	(R0)
	BNE	11$

	.PURGE	#0
	.LOOKU	#AREA,#0,#SDEV
	BCS	13$
	.READW	#AREA,#0,#0,#0,#0
	BCS	13$
12$:	MOV	SDEV,(R4)+
	BR	14$

13$:	CLR	(R4)+
14$:	INC	SDEV
	SOB	R1,5$
15$:	DEC	R2
	BNE	4$

	MOV	@#USERTOP,R0
	SUB	TOP,R0

	BIC	#777,R0
	ASR	R0
	MOV	R0,SWORDS
	SWAB	R0
	MOV	R0,SBLOCKS

	.WCLR	#WIDTH-5,#0,#5
	RETURN

ERROR:	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	CALL	DNAME
	.DIALOG	#D.FETC
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	DEC	R1
	BEQ	FETCH

	ADD	#10*2,R4
	BR	15$

CANCEL:	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	CALL	DNAME
	.DIALOG	#D.ABRT
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2

	ADD	#10*2,R4
	BR	15$

DNAME:	CLRB	T.DH

	MOV	#^RSY ,R0
	CALL	CNVDEV
	MOV	#FILE,R4
	MOV	R0,(R4)+
	MOV	SDEV,(R4)
	SUB	#^R  0,(R4)+
	CLR	(R4)+
	MOV	#^RSYS,(R4)
	CALL	FILEF2
	RETURN

PRISDE:	MOV	R1,-(SP)
	MOV	SDEV,R0
	MOV	#T.DEV,R1
	CALL	RAD
	.WATTR	#^B1000
	.WCLR	#WIDTH-5,#0,#2
	.WPUT	R1,#WIDTH-3,#0,#3
	MOV	(SP)+,R1
	RETURN

	.ENABL	LSB
ASSDK::
	MOV	R4,-(SP)
	.WORD	12767
	MOV	R4,-(R1)
	.WORD	3$-.-2

	MOV	R0,R4
	MOV	#^RDK,R0
	CALL	CNVDEV

	.WORD	12767
	MOV	-(R1),R0
	.WORD	3$-.-2
	MOV	(SP)+,R4
	RETURN

CNVDEV::
	CMP	R0,#^RSY0
	BEQ	SUB0
	CMP	R0,#^RDK0
	BNE	CNV
SUB0:	SUB	#^R  0,R0

CNV:	MOV	TAB$SIZ,R2
	CMP	(R2)+,(R2)+
	MOV	R2,R3
	MOV	TAB$ADR,R1
	SUB	R2,R1
	ASR	R2
1$:	CMP	R0,(R1)+
	BEQ	2$
	SOB	R2,1$
	BR	4$
2$:	SUB	R3,R1
3$:	MOV	-(R1),R0
4$:	MOV	R0,-(SP)
	MOV	R0,R1
	CLR	R0
	DIV	#50,R0
	MOV	(SP)+,R0
	TST	R1
	BEQ	5$
	BR	6$
5$:	ADD	#^R  0,R0

6$:	MOV	#D07TAB,R1
	MOV	#<MAXDEV*10>,R2
7$:	CMP	R0,(R1)+
	BEQ	8$
	SOB	R2,7$
	SEC
	RETURN
8$:	CLC
	RETURN

SDEV:	.RAD50	"XZ0         "

INCL::	.RAD50	"            "
	.WORD
EXCL:	.RAD50	"MZ0MZ1MZ2MZ3"
	.WORD

DEVTAB::	.BLKW	MAXDEV
D07TAB::	.BLKW	MAXDEV*10

T.DEV:	.ASCII	"XZ0"
	.EVEN

	.END
           