.TITLE	PSEUDO
	.IDENT	/R01/
;
; PSD ODX:=NDX:
;
; PSUEDO IS A PROGRAM WHICH CREATES A PSEUDO-DEVICE UCB & DCB
; THE NEW DEVICE IS GIVEN THE NAME NDX:
; THE OLD DEVICE TO WHICH IT IS REDIRECTED IS ODX:
;
; THE ATTRIBUTES ARE COPIED FROM THE OLD DEVICE WITH PSEUDO ADDED
;
	.MCALL	UCBDF$,DCBDF$,GCML$,GCMLB$,CSI$,CSI$1,CSI$2
	.MCALL	FSRSZ$
	.MCALL	QIOW$,DIR$,EXIT$S,ALUN$,ALUN$S

	FSRSZ$	1
ALUN:	ALUN$	1,TI,0
DEVE:	QIOW$	IO.WLB,1,1,,,,<DEVET,DEVEL,40>
SYNE:	QIOW$	Io.WLB,1,1,,,,<SYNET,SYNEL,40>
	.ENABL	LC
SYNET:	.ASCII	"PSD -- Syntax error"
SYNEL=.-SYNET
DEVET:	.ASCII	"PSD -- Unable to find old device"
DEVEL=.-DEVET
	.EVEN
	CSI$
CSIBLK:	.BLKB	C.SIZE
GCLBLK:	GCMLB$	,PSD,,1
TUCB:	.WORD	0		;target UCB
TDNAM:	.WORD	0		;name of target device
TUNIT:	.WORD	0		;unit no of target device
NDCB:	.WORD	0		;Pointer to newly alloc DCB/UCB
SUNIT:	.WORD	0		;unit no for pseudo dev
SDNAM:	.WORD	0		;name for pseudo device
	UCBDF$
	DCBDF$
	.MCALL	HDRDF$
	HDRDF$
START:
	DIR$	#ALUN
	GCML$	#GCLBLK
	BCC	1$
	EXIT$S
1$:	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD
	BCS	20$
	TST	C.CMLD(R0)	;empty line?
	BEQ	START
	BITB	#CS.EQU,C.STAT(R0); = seen
	BEQ	20$
	CSI$2	,OUTPUT
	BCS	20$
	BITB	#CS.NMF!CS.DIF!CS.WLD!CS.MOR,C.STAT(R0)
	BNE	20$
	MOV	R0,R1
	ADD	#C.DSDS,R1
	MOV	(R1)+,R2	;get length in R2, addr text @R1
	BEQ	20$
	MOV	(R1),R1
	MOVB	(R1)+,TDNAM
	MOVB	(R1)+,TDNAM+1
	MOV	R1,R0
	CLR	TUNIT
	CMPB	(R0),#':
	BEQ	3$
	CALL	$COTB
	MOV	R1,TUNIT
	CMPB	R2,#':
	BNE	20$
3$:	CSI$2	#CSIBLK,INPUT
	BCS	20$
	BITB	#CS.NMF!CS.DIF!CS.MOR!CS.WLD,C.STAT(R0)
	BNE	20$
	MOV	R0,R1
	ADD	#C.DSDS,R1
	MOV	(R1)+,R2
	BEQ	20$
	MOV	(R1),R0
	MOVB	(R0)+,SDNAM
	MOVB	(R0)+,SDNAM+1
	CLR	SUNIT
	CMPB	(R0),#':
	BEQ	30$
	CALL	$COTB
	MOV	R1,SUNIT
	CMPB	R2,#':
	BEQ	30$
20$:	DIR$	#SYNE
	JMp	START
30$:
	ALUN$S	#2,TDNAM,TUNIT
	BCC	40$
	DIR$	#DEVE
	JMP	START
40$:	CALL	$SWSTK,100$
	MOV	$HEADR,R5
	MOV	H.LUN+4(R5),TUCB	;get LUn2 UCB from header
	MOV	#20.,R1
	CALL	$ALOCB
	MOV	R0,NDCB
	RETURN
100$:	MOV	TUCB,R0
	MOV	NDCB,R3
	MOV	R3,R4
	ADD	#12,R4			;point to U.DCB
	MOV	R4,D.UCB(R3)		;point to UCB in DCB
	CLR	D.LNK(R3)
	MOV	SDNAM,D.NAM(R3)
	MOVB	SUNIT,D.UNIT(R3)
	MOVB	SUNIT,D.UNIT+1(R3)
	MOV	#12,D.UCBL(R3)		;set size of UCB in DCB
	MOV	R3,(R4)+		;set DCB ptr in UCB
	MOV	R0,(R4)+		;redirect to real device
	CLR	(R4)+
	CLR	(R4)+
	MOV	#DV.PSE,(R4)		;note it is Pseudo dev
;
; now we just need to link it in to chain
;
	MOV	$DEVHD,R0
102$:	TST	(R0)			;last ptr?
	BEQ	200$
	MOV	(R0),R0
	BR	102$
200$:	MOV	NDCB,(R0)
	JMP	START
	.END	START