	.TITLE	JTexedel ;set this process exempt from eacf etc.
	.IDENT	'V001'
; Copyright (c) 1994 Glenn C. Everhart. All Rights Reserved.
;x$$$dt=0	;knl dbg
;
; FACILITY:
; Provides servicing of security filtering, file moving, and so on
; for JTdriver.
; Note: This set of code only connects to JT: units and lets the actual
; work be done by HOL routines of some sort.
; Mods:
; 6/30/94 GCE - support 2K bitmap for kernel-marked files. This will let
; us mark basically EVERY file with an ACE in kernel mode as well as
; in ACEs so if someone deletes an ACE it won't drop protection.
; 
;
; Note: define VMS$V5 to build for Version 5.x of VMS.
VMS$V5=1
;
; 
; AUTHOR:
; 
; G. EVERHART
;
; 04-Aug-1989	D. HITTNER	Cleaned up definitions, added messages
; 29-Aug-1989   G. Everhart	Added more flexible device geometry selection
; 01-Dec-1993	G. Everhart	Build JTdriver misc. daemon
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

	.LIBRARY /SYS$SHARE:LIB/
; 
; EXTERNAL SYMBOLS
; 

	$dyndef
	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$ATRDEF
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$ddtdef				;define driver dispatch tbl
	.if df,step2
	ddt$l_fdt=ddt$ps_fdt_2
	.endc
	$DEVDEF				;DEFINE DEVICE CHARACTERISTICS
	$DPTDEF				;DEFINE DRIVER PROLOGUE TABLE
	$DVIDEF				;Symbols for $GETDVI service.
	$EMBDEF				;DEFINE ERROR MESSAGE BUFFER
	$FABDEF
	$FATDEF
	$pcbdef
	$acbdef
	$ccbdef
	$FIBDEF				;Symbols for file information block.
	$IDBDEF				;DEFINE INTERRUPT DATA BLOCK
	$IODEF				;DEFINE I/O FUNCTION CODES
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$NAMDEF
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$RMSDEF
	$SBDEF
	$SCSDEF
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$STSDEF				;Symbols for returned status.
	$TPADEF				;Symbols for LIB$TPARSE calls.
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	.if	df,step2
	$fdt_contextdef
	$fdtargdef
	$fdtdef
	.endc
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$XABDEF

; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; DEFINE THESE SO WE KNOW WHERE IN THE UCB TO ACCESS. WE MUST
; SET THE ONLINE BIT OR CLEAR IT, AND ALSO SET
; UCB$HUCB (HOST UCB ADDRESS), UCB$HFSZ (HOST FILE SIZE),
; AND UCB$HLBN (HOST LOGICAL BLOCK NUMBER OF FILE START)
;

	$DEFINI	UCB			;START OF UCB DEFINITIONS
;.=UCB$W_BCR+2				;BEGIN DEFINITIONS AT END OF UCB
.=UCB$K_LCL_DISK_LENGTH	;v4 def end of ucb
; USE THESE FIELDS TO HOLD OUR LOCAL DATA FOR VIRT DISK.
; Add our stuff at the end to ensure we don't mess some fields up that some
; areas of VMS may want.
; Leave thisfield first so we can know all diskswill have it at the
; same offset.
;
;
$def	ucb$l_hucbs	.blkl	1	;host ucb table
;
; Add other fields here if desired.
;
$def	ucb$l_exdmn	.blkl	1	;extend dmn pid
$def	ucb$l_exmbx	.blkl	1	;extend dmn mbx ucb
$def	ucb$l_deldmn	.blkl	1	;delete daemon pid
$def	ucb$l_delmbx	.blkl	1	;delete dmn mailbox ucb
;
;
$def	ucb$l_ctlflgs	.blkl	1		;flags to control modes
;
;
$def	ucb$l_prcvec	.blkl	1		;process local data tbl
$def	ucb$l_daemon	.blkl	1		;daemon pid for open daemon
$def	ucb$l_mbxucb	.blkl	1		;mailbox for input to daemon
$def	ucb$l_keycry	.blkl	2		;ucb resident "key" for ACEs
						;use as part of authenticator
						;for security-relevant fcns.
		;auth=f(file id, key, priv-info), match ace and computed
		;auth tag.
$def	ucb$l_cbtctr	.blkl	1		;how many extents
$def	ucb$l_cbtini	.blkl	1		;init for counter
; preceding 2 fields allow specifying of contig-best-try extents
; on every Nth extend, not every one. This should still help keep
; file extensions from preferentially picking up chaff
$def	ucb$JTcontfil	.blkb	80
$def	ucb$l_asten	.blkl	1		;ast enable mask store
;
$DEF	ucb$l_minxt	.blkl	1		;min. extent
$def	ucb$l_maxxt	.blkl	1		;max extent
$def	ucb$l_frac	.blkl	1		;fraction to extend by
$def	ucb$l_slop	.blkl	1		;slop blocks to leave free
; DDT intercept fields
; following must be contiguous.
$def    ucb$s_ppdbgn            ;add any more prepended stuff after this
$def    ucb$l_uniqid    .blkl   1       ;driver-unique ID, gets filled in
                                        ; by DPT address for easy following
                                        ; by SDA
$def    ucb$l_intcddt   .blkl   1       ; Our interceptor's DDT address if
                                        ; we are intercepted
$def    ucb$l_prevddt   .blkl   1       ; previous DDT address
$def    ucb$l_icsign    .blkl   1       ; unique pattern that identifies
                                        ; this as a DDT intercept block
; NOTE: Jon Pinkley suggests that the DDT size should be encoded in part of this
; unique ID so that incompatible future versions will be guarded against.
$DEF    UCB$L_ICPFGS    .BLKL   2       ; Flags. Reserve 2 longs so we need
                                        ; not mess with this later.
        $VIELD UCB,0,<-
                <FI8OK,,M>,-            ; 1 if this intercept and all
                        >               ; below understand finipl8.
$def    ucb$l_ufil1     .blkl   8       ; for others' intercepts if needed
$def    ucb$s_ppdend
$def    ucb$a_vicddt    .blkb   ddt$k_length
                                        ; space for victim's DDT
			.blkl	4	;safety
$def	ucb$l_backlk	.blkl	1	;backlink to victim ucb
; Make the "unique magic number" depend on the DDT length, and on the
; length of the prepended material. If anything new is added, be sure that
; this magic number value changes.
magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
;magic=^xF013F000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn-16>>
;p.magic=^xF013F000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn-16>>
	.iif ndf,f.nsiz,f.nsiz=2048
	.iif	ndf,f.nums,f.nums=16
	.iif	ndf,f.nsiz,f.nsiz=2048
ucb$l_fnums:	.blkw	f.nums	;store for file numbers to inspect whether
				;an ACE is there or not.
$DEF	UCB$L_JT_HOST_DESCR	.BLKL	2	;host dvc desc.
;
; Store copy of victim FDT table here for step 2 Alpha driver.
; assumes FDT table is 64+2 longs long (+ 2 more longs if 64bit)
	.if	df,irp$q_qio_p1
$def	ucb$l_myfdt	.blkl	<<FDT$K_LENGTH/4>+4>	;user FDT tbl copy + slop for safety
	.iff
$def	ucb$l_myfdt	.blkl	70	;user FDT tbl copy + slop for safety
	.endc
$def	ucb$l_oldfdt	.blkl	1	;fdt tbl of prior fdt chain
$def	ucb$l_vict	.blkl	1	;victim ucb, for unmung check
$def	ucb$l_mungd	.blkl	1	;munged flag, 1 if numg'd
$def	ucb$l_exempt	.blkl	4	;exempt PIDs
$def	ucb$l_exedel	.blkl	4	;pids exempt from delete checks only
$def	ucb$l_ktrln	.blkl	1
$def	ucb$l_k2tnm	.blkl	1
	.if	df,msetrp
; mousetrap trace cells
$def	mtp$fmt		.blkl	1	;mousetrap get into format 
$def	mtp$irp		.blkl	1
$def	mtp$ldt		.blkl	1
$def	mtp$trace	.blkl	1
$def	mtp$ccb		.blkl	1
$def	mtp$chan	.blkl	1
$def	mtp$ior0	.blkl	1
$def	mtp$r1		.blkl	2	;findldt tst
$def	mtp$r0		.blkl	1
$def	mtp$trc2	.blkl	1
$def	mtp$trc3	.blkl	2
	.endc
$DEF	UCB$K_JT_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_JT_LEN=.				;LENGTH OF UCB
	$DEFEND	UCB			;END OF UCB DEFINITONS

; TO SET ONLINE:
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE

; Macro to check return status of system calls.
;
	.MACRO	ON_ERR	THERE,?HERE
	BLBS	R0,HERE
	BRW	THERE
HERE:	.ENDM	ON_ERR
; Define LDT offsets here.
ldt$l_fwd	=	0		;forward link. (LDTs are singly linked)
ldt$l_ccb	=	4		;CCB address so we can check ID
ldt$l_accmd	=	8		;accmd from user FIB (tells how open)
ldt$l_wprv	=	12		;working privs
ldt$l_aprv	=	20		;auth privs
ldt$l_bprio	=	28		;process base priority
ldt$l_prcstr	=	32		;pointer to per-process delblk count block
ldt$l_synch	=	36		;address of "iosb" block used to
					;end process waits & deallocated at
					;end of those waits.
ldt$l_iosb	=	40		;iosb for internal $qio
ldt$l_jtucb	=	48		;pointer to jt: ucb
ldt$l_fresiz	=	52		;length of LDT left since we will chop
					;off unused parts of ACE after we read
					;it to regain pool
; Keep chnucb in "permanent" part of LDT since it hangs around till close
; if we do a softlink. It will be zero unless there is a softlink so
; it acts as a flag to restore the channel, too.
ldt$l_chnucb	=	56		;original channel UCB address
ldt$l_softf	=	60		;flag if nonzero that we have softlink
ldt$l_ace	=	64		;start of our ACE, up to 256 bytes long
; chop off what's below here, as we need it no more after the file is open.
ldt$l_regs	=	320		;register save, r0 to r15
ldt$l_flgs	=	376		;slop storage for flags
ldt$l_parm	=	380		;storage for up to 6 params (6 longs)
ldt$l_fib	=	404		;FIB we use for OUR I/O
; 72 bytes max for our FIB
ldt$l_acl	=	476		;storage for ACL read-in; 512 bytes
ldt$l_itmlst	=	988		;item list to read the ACL all in if
					;we can.
ldt$l_aclsiz	=	1020		;size of the ACL on the file
ldt$l_rtnsts	=	1024		;status back from daemon
ldt$l_myfid	=	1032		;file id from read-acl call
ldt$l_mydid	=	1040		;dir id in user's fib
ldt$l_psl	=	1048		;psl of original i/o
ldt$l_fnd	=	1056		;filename desc of orig i/o (p2 arg)
					;2 longs
ldt$l_fndd	=	1064		;data area for filename (256 bytes)
ldt$l_fdtctx	=	1324		;save area for user's FDT context ptr
ldt$l_size	=       1336
ldt$k_clrsiz	=	1332		;allocate a little slop.

; ACE format:
;ace:	.byte	length
;	.byte	type = ace$c_info ;application ACE
;	.word	flags		;stuff like hidden, protected...
;	.long	info-flags	;use 1 bit to mean call the daemon
;	.ascii	/GCEV/		;my identifier
;	.blkb	data		;up to 244 bytes of data.

; data is a variable length list of stuff.
; Codes are as follows:
; 00 - nothing. Terminates list.
; 01 - starts "inspectme" record. Nothing more. We send FID from the LDT
;		in this case. This makes these real fast to forge.
; 02 - "moveme" record. Again we send FID from LDT and need nothing more.
;		We use info from the daemon to find the actual file based
;		on the file ID here.
; 03 - "bprio" record. Format:
;	03, prio, <long auth info>	;total 6 bytes
; 04 - "priv" record. Format:
;	04, <priv quadword> <auth quadword>	;total 17 bytes
; 05 - "ident" record, format:
;	05, <ident quadword> <auth quadword>	;total 17 bytes
; 06 - "softlink" record, format:
;	06, len, flgs, <file id to link to> <devicename> ;variable len
; flags for softlinks:
;	0 = normal
;	1 = softlink only on read, act like moveme record if r/w open
;	2 = directory file softlink, pass to daemon for special
;		handling so we can pull the dir in.
; more flags later as I think of them.
; more types as needed too.

;
;
;
	.PSECT	ADVDD_DATA,RD,WRT,NOEXE,LONG
;
; KERNEL ARG LIST
;
lla:	.long	1
	.address	gotit
gotit:	.long	0
K_ARG:
	.LONG	4			;4 ARGS: HOST-DVC NAME, VD DVC NAME
	.ADDRESS	DEV_BUF_DESC
	.ADDRESS	VDV_BUF_DESC
	.address	mbx_buf_desc
	.address	shfnm	;shared JT device name
;	.ADDRESS	DDFNM
;	.ADDRESS	VDFNM
swpal:	.long	2
	.long	0,0
DEFAULT_DEVICE:
	.ASCID	/SYS$DISK/

	.ALIGN LONG
mbx_BUF:			; Buffer to hold mbxice name.
	.BLKB	40
mbx_BUF_SIZ = . - mbx_BUF

mbx_BUF_DESC:			; Descriptor pointing to mbxice name.
	.LONG	 mbx_BUF_SIZ
	.ADDRESS mbx_BUF

mPID:				; Owner of mbxice (if any).
	.BLKL	1

lpct:	.long	0	;scratch

dvl:	.long	0
mbx_ITEM_LIST:			; mbxice list for $GETDVI.
	.WORD	 mbx_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS mbx_BUF
	.ADDRESS mbx_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS mPID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS mbx_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

mbx_CLASS:
	.LONG	1
ioprog:	.long	0	;i/o in progress flag
nedast:	.long	0	;need skast flg
mbchn:	.long	0	;chnl for mailbox to jtdriver
vchn:	.long	0	;chnl used to open dvc
nlchn:	.long	0
nlucb:	.long	0
nlccb:	.long	0
iosb:	.long	0,0
IOSTATUS: .BLKQ 1
BUFG:	.long	1		;bash flag
	.long	1000		;
DEV_BUF:			; Buffer to hold device name.
	.BLKB	40
DEV_BUF_SIZ = . - DEV_BUF
busz=.-bufg
DEV_BUF_DESC:			; Descriptor pointing to device name.
	.LONG	 DEV_BUF_SIZ
	.ADDRESS DEV_BUF

PID:				; Owner of device (if any).
	.BLKL	1

DEV_ITEM_LIST:			; Device list for $GETDVI.
	.WORD	 DEV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS DEV_BUF
	.ADDRESS DEV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS PID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS DEV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

DEV_CLASS:
	.LONG	1
;**
vbufg:	.long	2	;deassign bash flag. Deassign victim dvc, not JT: dvc.
	.long	1000
VDV_BUF:			; Buffer to hold VDVice name.
	.BLKB	40
VDV_BUF_SIZ = . - VDV_BUF
vbusz=.-vbufg
VDV_BUF_DESC:			; Descriptor pointing to VDVice name.
	.LONG	 VDV_BUF_SIZ
	.ADDRESS VDV_BUF

VPID:				; Owner of VDVice (if any).
	.BLKL	1

VDV_ITEM_LIST:			; VDVice list for $GETDVI.
	.WORD	 VDV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS VDV_BUF
	.ADDRESS VDV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS VPID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS VDV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

VDV_CLASS:
	.LONG	1
;**
DEFNAM:

WRK:	.BLKL	1	;SCRATCH INTEGER
; DESCRIPTOR FOR VDn: "FILENAME"
	.ALIGN LONG
VDFNM:	.WORD	 255.	;LENGTH
VDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
	.ADDRESS	VDFNMD
VDFNMD:	.BLKB	256.	; DATA AREA
	.align long
wrkstr:	.word	20	;length
	.byte	dsc$k_dtype_t	;text
	.byte	1	;static
	.address	wrkdat
wrkdat:	.blkb	20
	.byte	0,0,0,0	;safety
;
; DESCRIPTOR FOR NODE$FWAN: DEVICE NAME
	.ALIGN LONG
DDFNM:	.WORD	 255.	;LENGTH
DDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
DDFNA:	.ADDRESS	DDFNMD
DDFNMD:	.BLKB	256.	; DATA AREA
DDCHN:	.LONG	0
VDCHN:	.LONG	0	;CHANNEL HOLDERS
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
deads:	.ascid	/NORMAL/	;deassign JT: from disk (turn off)
nldsc:	.ascid	/NLA0:/
	.align long
; DESCRIPTOR FOR filenum file
RWFNM:	.WORD	255
	.BYTE	DSC$K_DTYPE_T,1
	.ADDRESS	RWFND
RWFND:	.BLKB	256
RWFNL:	.LONG	0
	.iif ndf,f.nums,f.nums=16
	.iif	ndf,f.nsiz,f.nsiz=2048 ;bytes of mask
	.iif df,wd.lst,f.nsiz=f.nums*2
	maxnums=f.nsiz/2
fnmx:	.long	maxnums
fnums:	.blkw	maxnums		;storage for file numbers
fnumct:	.long	0		;no. filenums in store
fn.arg:	.long	4		;4 args
	.address	rwfnm	;rw filename arg
	.address	fnums	;storage for file numbers
	.address	fnmx	;size of file number array
	.address	fnumct	;output count nums added
; share dvc desc.
shfnm:	.word	255
	.BYTE	DSC$K_DTYPE_T,1
	.address shfnd
shfnd:	.blkb	256
shfnl:	.long	0
; UCB data area
shrflg:	.long	0	;share flag, nonzero if using another JT data
shucb:	.long	0	;shared jt ucb
fcnmsk:	.long	0
modmsk:	.long	0	;mode selection
deafg:	.long	0
cbtct:	.long	1	;/cbt:n contig best tries every n opens
frac:	.long	3
min:	.long	10
max:	.long	2000
adflg:	.long	0	;set flg if aldef only
HSTUCB:	.LONG	0	;SERVED UCB ADDRESS
VDUCB: .LONG 0		;LOCAL JT UCB ADDRESS
mbxucb:	.long	0	;mailbox ucb storage
;
;
ERROR:	.LONG	2
MESS:	.LONG	SS$_ABORT
	.LONG	0
kyfnm:	.word	255
	.byte dsc$k_dtype_t,1
	.address kyfnmd
kyfnmd:	.blkl	64
binkey:	.long	0,0		;binary key val for jt ucb
	.macro	beqlw	lbl,?lbl2
	bneq	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bneqw	lbl,?lbl2
	beql	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bgtrw	lbl,?lbl2
	bleq	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bleqw	lbl,?lbl2
	bgtr	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bgeqw	lbl,?lbl2
	blss	lbl2
	brw	lbl
lbl2:
	.endm
; allocate does not zero its result area.
	.macro	zapz	addr,size
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	movc5	#0,addr,#0,size,addr
	popr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	.endm
	.if	ndf,evax
	.macro .jsb_entry
; entry
	.endm
	.endc
BUFHDR:	.LONG	0,0,0,0,0
BUF:	.BLKL	8192.	; DATA AREA
gcelit:	.ascii	/GCEV/	;special literal
rtnst:	.long	0	;return status
ainbf:	.blkb	4	;hdr here
	.blkl	1	;my "call dmn" flg or 0
gcetgt:	.long	0	;will be "GCEV" for my ACEs
	.blkl	224	;data
	.blkl	8	;safety
fid:	.long	0,0	;file id scratch storage
; scratch FIB to read acl with an entry at a time
myfib:	.long	<fib$m_nolock+fib$m_norecord>
fibfid:	.blkw	3	;fid
fibdid:	.blkw	3	;did
fibctx:	.long	0	;wc context
	.long	0	;nmctl/exctl
	.long	0,0,0,0,0,0
fibacx:	.long	0	;acl context
fibast:	.long	0	;acl status
fibgst:	.long	0	;status
myfibl=.-myfib-2	;size
; descriptors for io$_access
mf3tp1:	.word	255
	.word	atr$c_addaclent
	.globl	myfdsc
myfdsc:
mfdsc:	.long	myfibl
	.address	myfib	;open by file id
; Itemlist to get old ace, delete it, add replacement one.
myil3:	.word	255	;length of itemlist item
	.word	atr$c_fndacetyp	;find ace
	.address	uace		;of our type
myin2:	.word	255
	.word	atr$c_delaclent	;delete an acl entry...
	.address	uace	;namely the old one
; locs to zero if the ace is empty now (0 in byte 16)
mf3b1:	.word	255
	.word	atr$c_addaclent	;add new ace
mf3b2:	.address	mdace	;modified ace
	.long	0,0	;null terminate the list
	.long	0
uace:	.blkb	256	;copy of our ACE
mdace:	.blkb	256
	.PSECT	ADVDD_CODE,RD,NOWRT,EXE,LONG
	.ENTRY	ADVDD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	clrl	adflg
	clrl	deafg	;not deassign
	movl	#1,cbtct	;contig best try every time
	movl	#4,frac
	movl	#10,min
	movl	#2000,max
	pushab	deads
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	100$
	incl	deafg
100$:
290$:
; Keep a channel to nla0: around. We will bash its UCB
; pointer to other devices when we need channels to them so we need
; not continually assign & deassign channels.
; We do this so we can set vchn to the current unit when we get a
; message from some JT unit of work to do; we actually point at the
; host device with it (ucb address is in the msg to us)
; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE.
        PUSHAB  WRK             ;PUSH LONGWORD ADDR FOR RETLENGTH
        PUSHAB  VDFNM           ;ADDRESS OF DESCRIPTOR TO RETURN
        PUSHAB  P1DSC           ; GET P1 (FDn: UNIT)
        CALLS   #3,G^CLI$GET_VALUE      ;GET VALUE OF NAME TO VDFNM
        ON_ERR  ADVDD_EXIT
	$ASSIGN_S -
		DEVNAM=VDFNM,-		; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	ADVDD_EXIT		; SKIP OUT IF ERROR
	$GETDVI_S -
		CHAN=vdchn,-		; Command line has device name.
		ITMLST=VDV_ITEM_LIST
	BLBS	R0,140$
	BRW	advdd_EXIT
140$:
; Here do the real work in kernel mode, having now the device
; descriptions and channels to the devces even!
;
	tstl	deafg		; reenabling? if so no msg
	bneq	145$
; if disabling eacf, log the fact.
	calls #0,g^jtemitlog	; send info about who's doing it...
145$:
	$CMKRNL_S -
		ROUTIN=BASHUCB,ARGLST=K_ARG
	CMPL	R0,#SS$_NORMAL				;Any errors?
	BEQL	300$					;No, skip error routine
	MOVL	R0,MESS					;Move error to message
;;;	BRW	300$
301$:
; ERROR RETURN ... CLOSE FAB & LEAVE
	$PUTMSG_S	MSGVEC=ERROR			;Pump out error message
; deassign logic
478$:	$DASSGN_S CHAN=VDCHN
	ret
300$:
	RET
fdhostd_exit:
advdd_exit:
	$DASSGN_S CHAN=VDCHN
	RET
	.ENTRY	BASHUCB,^M<R2,R3,R4,R5,R6,R7,R8,r9,r10,r11>
; TAKEN LOOSELY FROM ZERO.MAR
	.if	ndf,vms$v5
	MOVL	G^SCH$GL_CURPCB,R4	;;; NEED OUR PCB
	.iff
	MOVL	G^CTL$GL_PCB,R4		;;; NEED OUR PCB (VMS V5)
	.endc
	clrl	hstucb
	JSB	G^SCH$IOLOCKW		;;; LOCK I/O DATABASE
	MOVL	8(AP),R1		;;; ADDRESS VDn NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,160$
	BRW	BSH_XIT
1176$:
166$:	movl	#8,r0
	brw	bsh_xit
160$:
	movl	r1,r5			;use r5 for local ucb (JT dvc)
	beql	166$			;fail if no ucb...
; BUGGER THE UCB
1164$:
; be sure this IS a JT device
	cmpl	ucb$l_icsign(r5),#magic	;got right magic no.?
	bneq	1176$		;if not then not JTdriver
	movl	g^ctl$gl_pcb,r4		;get our pcb, for safety
	tstl	deafg		;deassigning ourselves?
	beql	1178$		;if not branch
; UNset "exempt" status
	movl	pcb$l_pid(r4),r6	;get our pid
	cmpl	r6,ucb$l_exedel+00(r5)
	bneq	1179$		;this ours?
	clrl	ucb$l_exedel+00(r5)
1179$:
	cmpl	r6,ucb$l_exedel+04(r5)
	bneq	1180$		;this ours?
	clrl	ucb$l_exedel+04(r5)
1180$:
	cmpl	r6,ucb$l_exedel+08(r5)
	bneq	1181$		;this ours?
	clrl	ucb$l_exedel+08(r5)
1181$:
	cmpl	r6,ucb$l_exedel+12(r5)
	bneq	1182$		;this ours?
	clrl	ucb$l_exedel+12(r5)
1182$:
	movl	#1,r0
	brw	bsh_xit
1178$:
; SET "exempt" status
	movl	pcb$l_pid(r4),r6	;get our pid
;fill in an empty slot in any, else use first
	tstl	ucb$l_exedel+00(r5)
	bneq	1183$
1190$:	movl	r6,ucb$l_exedel+00(r5)
	brb	1182$
1183$:
	tstl	ucb$l_exedel+04(r5)
	bneq	1184$
	movl	r6,ucb$l_exedel+04(r5)
	brb	1182$
1184$:
	tstl	ucb$l_exedel+08(r5)
	bneq	1185$
	movl	r6,ucb$l_exedel+08(r5)
	brb	1182$
1185$:
	tstl	ucb$l_exedel+12(r5)
	bneq	1186$
	movl	r6,ucb$l_exedel+12(r5)
	brb	1182$
1186$:	brb	1190$
	MOVL	#SS$_NORMAL,R0
BSH_XIT:
	PUSHL	R0
	JSB	G^SCH$IOUNLOCK		;;; UNLOCK I/O DATABASE (DROP IPL)
	POPL	R0			;;; REMEMBER R0
	RET	;;; BACK TO USER MODE NOW
	.END ADVDD
